CFPRIME FLOPSF                                                          FLOPSF      1
C***********************************************************************RIGHTE      1
C*                                                                     *RIGHTE      2
C*        Extended Transient-Midterm Stability Program (ETMSP)         *RIGHTE      3
C*        ====================================================         *RIGHTE      4
C*                                                                     *RIGHTE      5
C*       Copyright (C) (1993) Electric Power Research Institute        *RIGHTE      6
C*                                                                     *RIGHTE      7
C* EPRI reserves all rights in the software and associated             *RIGHTE      8
C* documentation as delivered. The software and its associated         *RIGHTE      9
C* documention or any portion thereof may not be reproduced in any form*RIGHTE     10
C* whatsoever without the consent of EPRI, except as explicity provided*RIGHTE     11
C* for by license. Licensee shall submit a detailed description to EPRI*RIGHTE     12
C* of any changes or modifications to the software within two (2)      *RIGHTE     13
C* months after such changes or modifications are made. At EPRI's sole *RIGHTE     14
C* discretion, the software, as changed or modified, shall be given a  *RIGHTE     15
C* new designation sufficiently different from its then current        *RIGHTE     16
C* designation as to prevent mistake,confusion, or deception as between*RIGHTE     17
C* the current software as changed or modified.                        *RIGHTE     18
C*                                                                     *RIGHTE     19
C* A license under EPRI's rights in the software can be obtained       *RIGHTE     20
C* directly from EPRI.                                                 *RIGHTE     21
C*                                                                     *RIGHTE     22
C* This program and supporting materials may be independently available*RIGHTE     23
C* from Electric Power Software centre (EPSC) for an appropriate       *RIGHTE     24
C* distribution fee. The EPSC is a service of                          *RIGHTE     25
C*                                                                     *RIGHTE     26
C*                    Power Computing Company                          *RIGHTE     27
C*                    1930 Hi Line                                     *RIGHTE     28
C*                    Dallas, Tx 75207                                 *RIGHTE     29
C*                                                                     *RIGHTE     30
C* NEITHER EPRI, ANY MEMBER OF EPRI, NOR ANY PERSON OR  ORGANIZATION   *RIGHTE     31
C* ACTING ON BEHAVE OF THEM:                                           *RIGHTE     32
C*                                                                     *RIGHTE     33
C* 1. MAKE ANY WARRANTY OR REPRESENTATION WHATSOEVER, EXPRESS OR       *RIGHTE     34
C*    IMPLIED, INCLUDING ANY WARRANTY OF MERCHANTABILITY OR FITNESS OR *RIGHTE     35
C*    ANY PURPOSE WITH RESPECT TO THE SOFTWARE OR ITS ASSOCIATED       *RIGHTE     36
C*    DOCUMENTATION; OR                                                *RIGHTE     37
C*                                                                     *RIGHTE     38
C* 2. ASSUMES ANY LIABILITY WHATSOEVER WITH RESPECT TO ANY USE OF THE  *RIGHTE     39
C*    SOFTWARE OR ITS ASSOCIATED DOCUMENTATION OR ANY PORTION THEREOF  *RIGHTE     40
C*    OR WITH RESPECT TO ANY DAMAGES WHICH MAY RESULT FROM SUCH USE.   *RIGHTE     41
C*                                                                     *RIGHTE     42
C* THIS NOTICE MAY NOT BE REMOVED FROM THE SOFTWARE BY ANY USER        *RIGHTE     43
C* THEREOF.                                                            *RIGHTE     44
C*                                                                     *RIGHTE     45
C***********************************************************************RIGHTE     46
      SUBROUTINE FLOPSF (LDUMP,LFILE,KDEB,IUX,IEBK)                     FLOPSF      3
CD                                                                      FLOPSF      4
CD    THIS SUBROUTINE READS THE LOAD FLOW DATA FROM THE NEW EPRI        FLOPSF      5
CD    LOAD FLOW PSF FILE.                                               FLOPSF      6
CD                                                                      FLOPSF      7
CD    THE LOAD FLOW DATA IS STORED IN THE PROGRAM IN THE FOLLOWING FORM:FLOPSF      8
CD                                                                      FLOPSF      9
CD BUS DATA:                                                            FLOPSF     10
CD --------                                                             FLOPSF     11
CD                                                                      FLOPSF     12
CD LET K BE THE LOADFLOW BUS NUMBER A BUS AND JJ=MNEW(K),THEN JJ        FLOPSF     13
CD CAN BE USED TO RETRIEVE INFORMATION FROM THE FOLLOWING ARRAYS.       FLOPSF     14
CD                                                                      FLOPSF     15
CD GMWX(NB*2)  : ARRAY STORES THE GENERATOR REAL AND REACTIVE POWER.    FLOPSF     16
CD               IT IS EQUIVALANCE TO ARRAYS GMW AND GMX.               FLOPSF     17
CD                                                                      FLOPSF     18
CD GMW(JJ+1)   : REAL POWER OF THE GENERATOR IN MW                      FLOPSF     19
CD BMX(JJ+2)   : REACTIVE POWER OF THE GENERATOR IN MVAR                FLOPSF     20
CD                                                                      FLOPSF     21
CD BMWX(NB*4)  : ARRAY STORES THE LOAD BUS INFORMATION. IT IS           FLOPSF     22
CD               EQUIVALENCE TO ARRAYS BMW ,BMX,IBAR AND XBASKV.        FLOPSF     23
CD                                                                      FLOPSF     24
CD BMW(JJ+1)   : REAL POWER IN MW                                       FLOPSF     25
CD BMX(JJ+2)   : REACTIVE POWER IN MVAR                                 FLOPSF     26
CD IBAR(JJ+3)  : AREA AND ZONE                                          FLOPSF     27
CD XBASKV(JJ+4): BASE KV                                                FLOPSF     28
CD                                                                      FLOPSF     29
CD BUDAT(NB8)  : ARRAY STORES THE BUS INFORMATION. IT IS EQUIVALENCE    FLOPSF     30
CD               TO ARRAYS ERBUS,EIBUS,BSTC,RYGR,RIYGR AND NAMES.       FLOPSF     31
CD                                                                      FLOPSF     32
CD ERBUS(JJ+1) : REAL PART OF BUS VOLTAGE                               FLOPSF     33
CD EIBUS(JJ+2) : IMAGINARY PART OF BUS VOLTAGE                          FLOPSF     34
CD BSTC(JJ+3)  : SWITCHING SHUNT                                        FLOPSF     35
CD RYGR(JJ+4)  : REAL PART OF BUS SHUNT                                 FLOPSF     36
CD RIYGR(JJ+5) : IMAGINARY PART OF BUS SHUNT                            FLOPSF     37
CD NAMES(JJ+6) : FIRST 4 CHARACTERS OF THE BUS NAME                     FLOPSF     38
CD NAMES(JJ+7) : SECOND 4 CHARACTERS OF THE BUS NAME                    FLOPSF     39
CD NAMES(JJ+8) : LAST 4 CHARACTERS OF THE BUS NAME                      FLOPSF     40
CD                                                                      FLOPSF     41
CD                                                                      FLOPSF     42
CD BRANCH DATA:                                                         FLOPSF     43
CD -----------                                                          FLOPSF     44
CD                                                                      FLOPSF     45
CD LET N = THE N'TH BRANCH AND  JL = 5*N - 5 ,THEN                      FLOPSF     46
CD                                                                      FLOPSF     47
CD GBFT(NPL*5)   :  ARRAY STORES THE LINE INFORMATION. IT IS EQUIVALENCEFLOPSF     48
CD                  TO ARRAYS LFTB,GA,BA AND BCHG.                      FLOPSF     49
CD LFTB(JL+1)  : CIRCUIT ID, IN SERIVE STATUS                           FLOPSF     50
CD LFTB(JL+2)  : FROM AND TO BUS NO.                                    FLOPSF     51
CD GA(JL+3)    : LINE ADMITTANCE                                        FLOPSF     52
CD BA(JL+4)    : LINE SUSCEPTANCE                                       FLOPSF     53
CD BCHG(JL+5)  : LINE CHARGING                                          FLOPSF     54
CD                                                                      FLOPSF     55
CD ITRAN(NTR)    :  ARRAY STORES THE LOAD FLOW BUS NO. TRANSFORMER      FLOPSF     56
CD ITRORD(NTR)   :  RESERVE FOR FUTURE USE                              FLOPSF     57
CD TRANS(NTRX2)  :  ARRAY STORES THE TRANSFORMER INFORMATION.           FLOPSF     58
CD                  IT IS EQUIVALENCE TO ARRAYS RANG AND RATIO          FLOPSF     59
CD                                                                      FLOPSF     60
CD LET N = THE N'TH TRANFORMER  AND JL = 2*N-2, THEN                    FLOPSF     61
CD                                                                      FLOPSF     62
CD RATIO(JL+1) : TRANSFORMER ONR                                        FLOPSF     63
CD RANG(JL+2)  : PHASE SHIFTER ANGLE                                    FLOPSF     64
CD                                                                      FLOPSF     65
CD                                                                      FLOPSF     66
CD ONRX(NB*9/6) :  ARRAY STORES THE ULTC INFORMATION. IT IS             FLOPSF     67
CD                 EQUIVALENCE TO ARRAYS ISCFRM,ISCTO,ISCCID,           FLOPSF     68
CD                 ISCCON, ONRMAX,ONRMIN,VOLMAX,VOLMIN AND STEP.        FLOPSF     69
CD                                                                      FLOPSF     70
CD LET N = THE N'TH ULTC AND  JL = 9*N-9, THEN                          FLOPSF     71
CD                                                                      FLOPSF     72
CD ISCFRM(JL+1) : FROM-BUS NO.                                          FLOPSF     73
CD ISCTO(JL+2)  : TO-BUS NO.                                            FLOPSF     74
CD ISCCID(JL+3) : CIRCUIT ID                                            FLOPSF     75
CD ISCCON(JL+4) : CONTROL BUS NO.                                       FLOPSF     76
CD ONRMAX(JL+5) : MAXIMUM ONR                                           FLOPSF     77
CD ONRMIN(JL+6) : MINIMUM ONR                                           FLOPSF     78
CD VOLMAX(JL+7) : MAXIMUM ULTC VOLTAGE                                  FLOPSF     79
CD VOLMIN(JL+8) : MINUMUM ULTC VOLTAGE                                  FLOPSF     80
CD STEP(JL+9)   : ULTC STEP SIZE                                        FLOPSF     81
CD                                                                      FLOPSF     82
CD CORTBL(220)   : ARRAY STORE THE IMPEDANCE CORRECTION TABLE           FLOPSF     83
CD                                                                      FLOPSF     84
      INCLUDE 'PARX.INS'                                                FLOPSF     85
      INCLUDE 'CNPARX.INS'                                              FLOPSF     86
      INCLUDE 'CNB19.INS'                                               FLOPSF     87
      INCLUDE 'CNMNEW.INS'                                              FLOPSF     88
      INCLUDE 'CNIPTR.INS'                                              FLOPSF     89
      INCLUDE 'CNLFDA.INS'                                              FLOPSF     90
      INCLUDE 'CNSELI.INS'                                              FLOPSF     91
      INCLUDE 'CNREC1.INS'                                              FLOPSF     92
      INCLUDE 'CNPT.INS'                                                FLOPSF     93
      INCLUDE 'CNFLAG.INS'                                              FLOPSF     94
      INCLUDE 'CNUNIT.INS'                                              FLOPSF     95
      INCLUDE 'GRDC01.INS'                                              FLOPSF     96
      INCLUDE 'GRDC03.INS'                                              FLOPSF     97
      INCLUDE 'GRPDCS.INS'                                              FLOPSF     98
      INCLUDE 'UDCF.INS'                                                FLOPSF     99
      INCLUDE 'EPBUS.INS'                                               FLOPSF    100
      INCLUDE 'CNULTC.INS'                                              FLOPSF    101
      INCLUDE 'CNMSG.INS'                                               FLOPSF    102
C                                                                       FLOPSF    103
      CHARACTER*50 LFILE                                                FLOPSF    104
C                                                                       FLOPSF    105
      DIMENSION JDCC(NDCC*2)                                            FLOPSF    106
      LOGICAL LDEB1,FOUND                                               FLOPSF    107
C                                                                       FLOPSF    108
C                                                                       FLOPSF    109
      LDEB=(JDEB(2).NE.0)                                               FLOPSF    110
      LDEB1=(JDEB(250).NE.0)                                            FLOPSF    111
C                                                                       FLOPSF    112
C IF LDUMP=9           LOAD FLOW DATA FROM POWER SYSTEM FILE            FLOPSF    113
C                                                                       FLOPSF    114
C                                                                       FLOPSF    115
      IEBK=0                                                            FLOPSF    116
      LDUMPO=LDUMP                                                      FLOPSF    117
C                                                                       FLOPSF    118
      NSEL=0                                                            FLOPSF    119
      IPOS=0                                                            FLOPSF    120
      NLINES=0                                                          FLOPSF    121
      LBUSNO=0                                                          FLOPSF    122
      MDCLK=0                                                           FLOPSF    123
C                                                                       FLOPSF    124
      LUN=IUX                                                           FLOPSF    125
      CALL PSFINT (LUN, IFLNO, IEBK)                                    FLOPSF    126
C                                                                       FLOPSF    127
      IF(LDUMP .LT. 9)GOTO 7600                                         FLOPSF    128
C                                                                       FLOPSF    129
C ================================================                      FLOPSF    130
C                                                                       FLOPSF    131
C    READ TITLE                                                         FLOPSF    132
C                                                                       FLOPSF    133
      CALL PSADSC (TEXT, IFLNO)                                         FLOPSF    134
      IF (LDEB) THEN                                                    FLOPSF    135
        WRITE (IUD6, 1050) (TEXT(K), K = 1, 20)                         FLOPSF    136
        WRITE (IUD6, 1050) (TEXT(K), K = 21, 40)                        FLOPSF    137
        WRITE (IUD6, 1050) (TEXT(K), K = 41, 60)                        FLOPSF    138
      ENDIF                                                             FLOPSF    139
C                                                                       FLOPSF    140
C                                                                       FLOPSF    141
C     READ BUS DATA (INCLUDING LOADS, SHUNTS AND GENERATORS)            FLOPSF    142
C                                                                       FLOPSF    143
      CALL PSABUS (LBUSNO, IFLNO, IEBK)                                 FLOPSF    144
C                                                                       FLOPSF    145
      IF (LDUMP .EQ. 10) CALL BSORT2                                    FLOPSF    146
C                                                                       FLOPSF    147
C ==================================                                    FLOPSF    148
C                                                                       FLOPSF    149
C     READ LINES                                                        FLOPSF    150
C                                                                       FLOPSF    151
      IBTYPE = 1                                                        FLOPSF    152
      CALL PSFBRN (IBTYPE, IPOS, NLINES, IFLNO, IEBK)                   FLOPSF    153
C                                                                       FLOPSF    154
C ==================================                                    FLOPSF    155
C                                                                       FLOPSF    156
C    READ FIXED TRANSFORMERS                                            FLOPSF    157
C                                                                       FLOPSF    158
      IBTYPE = 2                                                        FLOPSF    159
      CALL PSFBRN (IBTYPE, IPOS, NLINES, IFLNO, IEBK)                   FLOPSF    160
C                                                                       FLOPSF    161
C  ==================================                                   FLOPSF    162
C                                                                       FLOPSF    163
C    READ ULTC TRANSFORMERS                                             FLOPSF    164
C                                                                       FLOPSF    165
      IBTYPE = 3                                                        FLOPSF    166
      CALL PSFBRN (IBTYPE, IPOS, NLINES, IFLNO, IEBK)                   FLOPSF    167
C                                                                       FLOPSF    168
C  ==================================                                   FLOPSF    169
C                                                                       FLOPSF    170
C    READ FIXED SERIES CAPACITORS AS LINES                              FLOPSF    171
C                                                                       FLOPSF    172
      IBTYPE = -10                                                      FLOPSF    173
      CALL PSFBRN (IBTYPE, IPOS, NLINES, IFLNO, IEBK)                   FLOPSF    174
C                                                                       FLOPSF    175
C  ==================================                                   FLOPSF    176
C                                                                       FLOPSF    177
C    READ SWITCHABLE SERIES CAPACITORS AS LINES                         FLOPSF    178
C                                                                       FLOPSF    179
      IBTYPE = -11                                                      FLOPSF    180
      CALL PSFBRN (IBTYPE, IPOS, NLINES, IFLNO, IEBK)                   FLOPSF    181
C                                                                       FLOPSF    182
C  ==================================                                   FLOPSF    183
C                                                                       FLOPSF    184
C    READ FACTS DEVICES AS FIXED PHASE SHIFTERS                         FLOPSF    185
C                                                                       FLOPSF    186
      IBTYPE = 4                                                        FLOPSF    187
      CALL PSFBRN (IBTYPE, IPOS, NLINES, IFLNO, IEBK)                   FLOPSF    188
C                                                                       FLOPSF    189
C  =================================                                    FLOPSF    190
C                                                                       FLOPSF    191
C     READ TRANSFORMER IMPEDANCE CORRECTION TABLES                      FLOPSF    192
C                                                                       FLOPSF    193
      CALL FMOVE (0, CORTBL, CORTBL, 220)                               FLOPSF    194
C                                                                       FLOPSF    195
      CALL PSATIC (IFLNO)                                               FLOPSF    196
C                                                                       FLOPSF    197
C =======================================================               FLOPSF    198
C                                                                       FLOPSF    199
C                                                                       FLOPSF    200
C     READING MTDC IN THE PSF LOAD FLOW                                 FLOPSF    201
C                                                                       FLOPSF    202
      DO 290 I = 1, NDCC                                                FLOPSF    203
      IDC(I) = 0                                                        FLOPSF    204
      IDCFRE(I) = 0                                                     FLOPSF    205
      IDCNOD(I) = ' '                                                   FLOPSF    206
      NODIDX(I) = I                                                     FLOPSF    207
      DCCNAM(I) = ' '                                                   FLOPSF    208
      DCCNA2(I) = ' '                                                   FLOPSF    209
      DCCNMR(I) = ' '                                                   FLOPSF    210
      BDIND(I) = .FALSE.                                                FLOPSF    211
      BZIND(I) = .FALSE.                                                FLOPSF    212
  290 CONTINUE                                                          FLOPSF    213
C                                                                       FLOPSF    214
      DO 295 I = 1, NDCL                                                FLOPSF    215
      IDCL(I) = 0                                                       FLOPSF    216
      IDCFRL(I) = 0                                                     FLOPSF    217
      DCLNAM(I) = ' '                                                   FLOPSF    218
      DCLNMR(I) = ' '                                                   FLOPSF    219
  295 CONTINUE                                                          FLOPSF    220
C                                                                       FLOPSF    221
      DO 300 I = 1, NDCB                                                FLOPSF    222
      IDCFRB(I) = 0                                                     FLOPSF    223
      IDCB(I) = 0                                                       FLOPSF    224
      DCBNAM(I) = ' '                                                   FLOPSF    225
      DCBNMR(I) = ' '                                                   FLOPSF    226
  300 CONTINUE                                                          FLOPSF    227
C                                                                       FLOPSF    228
      CALL PSFRDC (IFLNO)                                               FLOPSF    229
C                                                                       FLOPSF    230
      IF(NONODR.GT.NUMNOD) THEN                                         FLOPSF    231
         DO 314 I = NUMNOD+1, NONODR                                    FLOPSF    232
         VDCNOD(I) = VDCNOD(NODIDX(I))                                  FLOPSF    233
         XDNODE(I) = XDNODE(NODIDX(I))                                  FLOPSF    234
  314    CONTINUE                                                       FLOPSF    235
      END IF                                                            FLOPSF    236
C                                                                       FLOPSF    237
      NUMNOD = NONODR                                                   FLOPSF    238
C                                                                       FLOPSF    239
      DO 315 I = 1, NDCC                                                FLOPSF    240
      DCCNAM(I) = DCCNMR(I)                                             FLOPSF    241
  315 CONTINUE                                                          FLOPSF    242
C                                                                       FLOPSF    243
      DO 316 I = 1, NDCL                                                FLOPSF    244
      DCLNAM(I) = DCLNMR(I)                                             FLOPSF    245
  316 CONTINUE                                                          FLOPSF    246
C                                                                       FLOPSF    247
      DO 317 I = 1, NDCB                                                FLOPSF    248
      DCBNAM(I) = DCBNMR(I)                                             FLOPSF    249
  317 CONTINUE                                                          FLOPSF    250
C                                                                       FLOPSF    251
C                                                                       FLOPSF    252
      DO 318 I=1,ICDC                                                   FLOPSF    253
      IF(IDC(I).NE.0)THEN                                               FLOPSF    254
         IPOSN = IDC(I)                                                 FLOPSF    255
         PAHVDC(IPOSN)=PAHVDC(IPOSN)*PABASE/BASPC                       FLOPSF    256
         QAHVDC(IPOSN)=QAHVDC(IPOSN)*PABASE/BASPC                       FLOPSF    257
         IF(ICTYPE(IPOSN).EQ.1) THEN                                    FLOPSF    258
            XACURR(IPOSN)=XACURR(IPOSN)*PABASE/BASPC                    FLOPSF    259
         ELSE                                                           FLOPSF    260
            Q2HVDC(IPOSN)=Q2HVDC(IPOSN)*PABASE/BASPC                    FLOPSF    261
         ENDIF                                                          FLOPSF    262
C                                                                       FLOPSF    263
         IF(LDEB1) THEN                                                 FLOPSF    264
            IF(ICTYPE(IPOSN).EQ.1) THEN                                 FLOPSF    265
               WRITE(IUD6,1500) CALPHA(IPOSN), CGAMMA(IPOSN),           FLOPSF    266
     1         XACURR(IPOSN),TAPPOS(IPOSN), PHIDC(IPOSN), PAHVDC(IPOSN),FLOPSF    267
     2         QAHVDC(IPOSN), VDCONV(IPOSN), XDCONV(IPOSN)              FLOPSF    268
            ELSE                                                        FLOPSF    269
               WRITE(IUD6,1500) CALPHA(IPOSN), CGAMMA(IPOSN),           FLOPSF    270
     1         TAPPOS(IPOSN),PHIDC(IPOSN), PAHVDC(IPOSN), QAHVDC(IPOSN),FLOPSF    271
     2         Q2HVDC(IPOSN), VDCONV(IPOSN), XDCONV(IPOSN),GAINKC(IPOSN)FLOPSF    272
            ENDIF                                                       FLOPSF    273
         ENDIF                                                          FLOPSF    274
      ENDIF                                                             FLOPSF    275
C                                                                       FLOPSF    276
      PABASE=BASPC                                                      FLOPSF    277
  318 CONTINUE                                                          FLOPSF    278
C                                                                       FLOPSF    279
      IF(NUMNOD.GT.0)THEN                                               FLOPSF    280
         IF(LDEB1) WRITE(IUD6,1500) (VDCNOD(I), I = 1, NUMNOD)          FLOPSF    281
         IF(LDEB1) WRITE(IUD6,1500) (XDNODE(I), I = 1, NUMNOD)          FLOPSF    282
      ENDIF                                                             FLOPSF    283
C                                                                       FLOPSF    284
      IF(LDEB1) WRITE(IUD6,1500) PABASE, VDBASE, PDBASE                 FLOPSF    285
C                                                                       FLOPSF    286
C     MTDC IN THE PSF LOAD FLOW                                         FLOPSF    287
C                                                                       FLOPSF    288
      MCON=0                                                            FLOPSF    289
      NACBUS=0                                                          FLOPSF    290
      NACBU2=0                                                          FLOPSF    291
      IF(ICDC.NE.0)THEN                                                 FLOPSF    292
      CALL GTDCNA (ACNAME, JDCC, IFLNO)                                 FLOPSF    293
      IF(LDUMP.EQ.9)THEN                                                FLOPSF    294
       MCON=ICDC                                                        FLOPSF    295
       DO 450 I=1,ICDC                                                  FLOPSF    296
         IPOSN=IDC(I)                                                   FLOPSF    297
         DCCNAM(IPOSN)(25:28)='0.  '                                    FLOPSF    298
         DCCNA2(IPOSN)(9:12)='0.  '                                     FLOPSF    299
  450  CONTINUE                                                         FLOPSF    300
      ELSEIF(LDUMP.EQ.10)THEN                                           FLOPSF    301
  500    MCON=MCON+1                                                    FLOPSF    302
         IPOSN=IDC(MCON)                                                FLOPSF    303
         IF(ACNAME(IPOSN).EQ.' ') THEN                                  FLOPSF    304
            JDCC(IPOSN)=0                                               FLOPSF    305
            JDCC(ICDC+IPOSN)=0                                          FLOPSF    306
            ACNAME(ICDC+IPOSN) = ' '                                    FLOPSF    307
         ELSE                                                           FLOPSF    308
            CALL CHKBUS(ACNAME(IPOSN),IBUSOK)                           FLOPSF    309
            IF(IBUSOK.LE.0)THEN                                         FLOPSF    310
               IEBK=1                                                   FLOPSF    311
               WRITE(MSG(1),1510) IPOSN,DCCNAM(IPOSN)(17:28)            FLOPSF    312
            ENDIF                                                       FLOPSF    313
            JDCC(IPOSN)=IBUSOK                                          FLOPSF    314
C                                                                       FLOPSF    315
            IF(ACNAME(ICDC+IPOSN).EQ.' ') THEN                          FLOPSF    316
               JDCC(ICDC+IPOSN)=0                                       FLOPSF    317
            ELSE                                                        FLOPSF    318
               CALL CHKBUS(ACNAME(ICDC+IPOSN),IBU2OK)                   FLOPSF    319
               IF(IBU2OK.LE.0)THEN                                      FLOPSF    320
                  IEBK=1                                                FLOPSF    321
                  WRITE(MSG(1),1510) IPOSN,DCCNA2(IPOSN)                FLOPSF    322
               ENDIF                                                    FLOPSF    323
               JDCC(ICDC+IPOSN)=IBU2OK                                  FLOPSF    324
            ENDIF                                                       FLOPSF    325
         ENDIF                                                          FLOPSF    326
          DCCNMR(IPOSN)(17:28) =ACNAME(IPOSN)                           FLOPSF    327
          DCCNAM(IPOSN)=DCCNMR(IPOSN)                                   FLOPSF    328
          DCCNA2(IPOSN)=ACNAME(ICDC+IPOSN)                              FLOPSF    329
         IF(MCON.LT.ICDC) GO TO 500                                     FLOPSF    330
       ENDIF                                                            FLOPSF    331
C                                                                       FLOPSF    332
C     INITIALIZE UDC ARRAYS, STRUCTURE ARRAYS AND FIXED ARRAYS.         FLOPSF    333
C                                                                       FLOPSF    334
         DO 550 KI=1,LCDC                                               FLOPSF    335
         IPOSN=IDC(KI)                                                  FLOPSF    336
         NLF=JDCC(IPOSN)                                                FLOPSF    337
         IF(NLF.EQ.0) GO TO 550                                         FLOPSF    338
         FOUND =.FALSE.                                                 FLOPSF    339
         I = 1                                                          FLOPSF    340
  520    IF(FOUND.OR.I.GT.NACBUS) GOTO 530                              FLOPSF    341
         IF(NLF.EQ.IUQABU(I))THEN                                       FLOPSF    342
            FOUND =.TRUE.                                               FLOPSF    343
         ELSE                                                           FLOPSF    344
            I = I + 1                                                   FLOPSF    345
         ENDIF                                                          FLOPSF    346
         GOTO 520                                                       FLOPSF    347
  530    CONTINUE                                                       FLOPSF    348
         IF(.NOT.FOUND)THEN                                             FLOPSF    349
            NACBUS = NACBUS+1                                           FLOPSF    350
            IUQABU(NACBUS) = NLF                                        FLOPSF    351
            IF(LDEB)WRITE(IUD6,1540) NACBUS,NLF                         FLOPSF    352
         ENDIF                                                          FLOPSF    353
C                                                                       FLOPSF    354
  550    CONTINUE                                                       FLOPSF    355
         NACBU2=NACBUS                                                  FLOPSF    356
C                                                                       FLOPSF    357
         DO 552 KI1=1,2                                                 FLOPSF    358
         DO 551 KI=LCDC+1,ICDC                                          FLOPSF    359
         IPOSN=IDC(KI)                                                  FLOPSF    360
         NLF=JDCC((KI1-1)*ICDC+IPOSN)                                   FLOPSF    361
         IF(NLF.EQ.0) GO TO 551                                         FLOPSF    362
         FOUND =.FALSE.                                                 FLOPSF    363
         I = 1                                                          FLOPSF    364
  521    IF(FOUND.OR.I.GT.NACBU2) GOTO 531                              FLOPSF    365
         IF(NLF.EQ.IUQABU(I))THEN                                       FLOPSF    366
            FOUND =.TRUE.                                               FLOPSF    367
         ELSE                                                           FLOPSF    368
            I = I + 1                                                   FLOPSF    369
         ENDIF                                                          FLOPSF    370
         GOTO 521                                                       FLOPSF    371
  531    CONTINUE                                                       FLOPSF    372
         IF(.NOT.FOUND)THEN                                             FLOPSF    373
            NACBU2 = NACBU2+1                                           FLOPSF    374
            IUQABU(NACBU2) = NLF                                        FLOPSF    375
            IF(LDEB)WRITE(IUD6,1541) NACBU2,NLF                         FLOPSF    376
         ENDIF                                                          FLOPSF    377
C                                                                       FLOPSF    378
  551    CONTINUE                                                       FLOPSF    379
  552    CONTINUE                                                       FLOPSF    380
      ENDIF                                                             FLOPSF    381
C                                                                       FLOPSF    382
      NACTOT=NACBU2                                                     FLOPSF    383
      KCDC=ICDC                                                         FLOPSF    384
C                                                                       FLOPSF    385
      IF(IEBK.EQ.0) RETURN                                              FLOPSF    386
      MSG(1)='  *** ERROR IN PSF LOADFLOW FILE'                         FLOPSF    387
      CALL PRTMSG(1)                                                    FLOPSF    388
      MSG(1)='ROUTINE FLOPSF PSF LOADFLOW FILE ERROR'                   FLOPSF    389
      CALL ASTOP(MSG(1),38)                                             FLOPSF    390
C                                                                       FLOPSF    391
C                                                                       FLOPSF    392
C  END READING THE POWER SYSTEM FILE                                    FLOPSF    393
C                                                                       FLOPSF    394
C ======================================================                FLOPSF    395
C                                                                       FLOPSF    396
 7600 CONTINUE                                                          FLOPSF    397
C                                                                       FLOPSF    398
      IF(IEBK.NE.0)THEN                                                 FLOPSF    399
         MSG(1)='  *** WARNING LOADFLOW DATA FILE ERROR'                FLOPSF    400
         CALL PRTMSG(1)                                                 FLOPSF    401
      ENDIF                                                             FLOPSF    402
C                                                                       FLOPSF    403
      RETURN                                                            FLOPSF    404
C                                                                       FLOPSF    405
 1050 FORMAT(2X,'ERRH=',F10.5,'ERIH=',F10.5,'ANGR=',F10.6,              FLOPSF    406
     +'EIIH=',F10.5,'EIRH=',F10.5,'ANGI=',F10.5)                        FLOPSF    407
 1500 FORMAT(10F10.5)                                                   FLOPSF    408
 1510 FORMAT(' *** WARNING CONVERTER BUS DCCNAM(',I2,')=',A12           FLOPSF    409
     *,' NOT IN THE BASE CASE LOADFLOW')                                FLOPSF    410
 1540 FORMAT(1X,'NACBUS,NLF:',2I6)                                      FLOPSF    411
 1541 FORMAT(1X,'NACBU2,NLF:',2I6)                                      FLOPSF    412
C                                                                       FLOPSF    413
        END                                                             FLOPSF    414
C*********************************************************************  FLOPSF    415
       SUBROUTINE PSFINT (LUN, IFLNO, IEBK)                             FLOPSF    416
C---------------------------------------------------------------------  FLOPSF    417
CD  FUNCTION                                                            FLOPSF    418
CD  ========                                                            FLOPSF    419
CD  THIS IS A PSF SUBROUTINE THAT READS THE FILE HEADER.                FLOPSF    420
CD  IT ALSO CALCULATES THE NEXT AND THE PREVIOUS PSF DATA POINTERS FOR  FLOPSF    421
CD  GENERATORS, LOADS AND SHUNTS IF THE PSF VERSION IS 1.0. OTHERWISE,  FLOPSF    422
CD  THESE POINTER ARRAYS ARE READ IN.                                   FLOPSF    423
CD                                                                      FLOPSF    424
CD  CALLING SEQUENCE                                                    FLOPSF    425
CD  ================                                                    FLOPSF    426
CD     ARGUMENT     TYPE     DESCRIPTION                                FLOPSF    427
CD     ========     ====     ===========                                FLOPSF    428
CD     LUN          I*4      I: PSF FILEW UNIT NUMBER                   FLOPSF    429
CD     IFLNO        I*4      O: FILE RECORD NUMBER                      FLOPSF    430
CD     IEBK         I*4      O: ERROR STATUS                            FLOPSF    431
CD                                                                      FLOPSF    432
C---------------------------------------------------------------------  FLOPSF    433
      INCLUDE 'PSFNAM.INS'                                              FLOPSF    434
      INCLUDE 'V1NDEF.INS'                                              FLOPSF    435
      INCLUDE 'PARX.INS'                                                FLOPSF    436
C                                                                       FLOPSF    437
       INTEGER*2     IBGNPT(NB), IGNXT(NB/3), IBLDPT(NB), ILDNXT(NB),   FLOPSF    438
     +               IBFSPT(NB), IFSNXT(NB), IBSSPT(NB), ISWNXT(NSS)    FLOPSF    439
C                                                                       FLOPSF    440
       COMMON /SCRAT3/ IBGNPT, IGNXT, IBLDPT, ILDNXT, IBFSPT, IFSNXT,   FLOPSF    441
     +                 IBSSPT, ISWNXT                                   FLOPSF    442
C                                                                       FLOPSF    443
       INTEGER*2     IBNUTG(NB), IBNMTG(NB), IBSCTN(MSEL)               FLOPSF    444
       INTEGER       IBLFN(NB), IBNAME(4*NB)                            FLOPSF    445
       COMMON /SCRAT2/ IBLFN, IBNAME, IBNUTG, IBNMTG, IBSCTN            FLOPSF    446
C                                                                       FLOPSF    447
       INTEGER*2     IBSRC(NB), ILSCT(NB2), IFTSCT(NB*9/6),             FLOPSF    448
     +               IULSCT(NB*9/6), IFCSCT(100), ISCSCT(100),          FLOPSF    449
     +               ISTSCT(100)                                        FLOPSF    450
       INTEGER       IBRN(MSEL)                                         FLOPSF    451
C                                                                       FLOPSF    452
       COMMON /SCRAT6/ IBSRC, ILSCT, IFTSCT, IULSCT, IFCSCT, ISCSCT,    FLOPSF    453
     +                 ISTSCT, IBRN                                     FLOPSF    454
C---------------------------------------------------------------------  FLOPSF    455
C      LOCAL VARIABLES                                                  FLOPSF    456
C      ===============                                                  FLOPSF    457
C                                                                       FLOPSF    458
       INTEGER       IPSFID(2)                                          FLOPSF    459
C                                                                       FLOPSF    460
       LOGICAL       FIRST                                              FLOPSF    461
C                                                                       FLOPSF    462
       CHARACTER*8   PSFID                                              FLOPSF    463
C                                                                       FLOPSF    464
       EQUIVALENCE   (IPSFID, PSFID)                                    FLOPSF    465
C                                                                       FLOPSF    466
       DATA FIRST / .TRUE. /                                            FLOPSF    467
C                                                                       FLOPSF    468
      INCLUDE 'V1NDAT.INS'                                              FLOPSF    469
C---------------------------------------------------------------------  FLOPSF    470
C                                                       INITIALIZATION  FLOPSF    471
C                                                                       FLOPSF    472
       IEBK = 0                                                         FLOPSF    473
C                                                                       FLOPSF    474
       IF (FIRST) THEN                                                  FLOPSF    475
         FIRST = .FALSE.                                                FLOPSF    476
         DO 1102 II = 1, 5                                              FLOPSF    477
           LUNPSF(II) = -1                                              FLOPSF    478
1102     CONTINUE                                                       FLOPSF    479
       ENDIF                                                            FLOPSF    480
C                                                                       FLOPSF    481
       DO 1202 II = 1, 5                                                FLOPSF    482
         IF (LUNPSF(II) .EQ. -1) THEN                                   FLOPSF    483
           LUNPSF(II) = LUN                                             FLOPSF    484
           IFLNO = II                                                   FLOPSF    485
           GOTO 2000                                                    FLOPSF    486
         ENDIF                                                          FLOPSF    487
1202   CONTINUE                                                         FLOPSF    488
C                                                                       FLOPSF    489
       IEBK = 1                                                         FLOPSF    490
       GOTO 9999                                                        FLOPSF    491
C---------------------------------------------------------------------  FLOPSF    492
C                                                     READ FILE HEADER  FLOPSF    493
C                                                                       FLOPSF    494
2000   IREC = 0                                                         FLOPSF    495
       I1 = 0                                                           FLOPSF    496
       IDONE = 0                                                        FLOPSF    497
       LENHDR(IFLNO) = 65                                               FLOPSF    498
2202   CONTINUE                                                         FLOPSF    499
       IREC = IREC + 1                                                  FLOPSF    500
       I0 = I1 + 1                                                      FLOPSF    501
       I1 = I0 + 63                                                     FLOPSF    502
       IF (I1 .GE. LENHDR(IFLNO)) THEN                                  FLOPSF    503
         I1 = LENHDR(IFLNO)                                             FLOPSF    504
         IDONE = 1                                                      FLOPSF    505
       ENDIF                                                            FLOPSF    506
       READ (LUN, REC = IREC) (HDRPSF(I, IFLNO), I = I0, I1)            FLOPSF    507
       LTRAY = HDRPSF(6, IFLNO) * 2 + 6                                 FLOPSF    508
       IF (LTRAY .GT. I1) THEN                                          FLOPSF    509
         LENHDR(IFLNO) = LENHDR(IFLNO) + 64                             FLOPSF    510
       ELSE                                                             FLOPSF    511
         LENHDR(IFLNO) = (HDRPSF(6, IFLNO) +                            FLOPSF    512
     +                   HDRPSF(LTRAY, IFLNO)) * 2 + 6                  FLOPSF    513
       ENDIF                                                            FLOPSF    514
       IF (IDONE .EQ. 0) GOTO 2202                                      FLOPSF    515
C---------------------------------------------------------------------  FLOPSF    516
C                                                         CHECK IF PSF  FLOPSF    517
C                                                                       FLOPSF    518
       IPSFID(1) = HDRPSF(1, IFLNO)                                     FLOPSF    519
       IPSFID(2) = HDRPSF(2, IFLNO)                                     FLOPSF    520
C                                                                       FLOPSF    521
       IF (PSFID(1:3) .NE. 'PSF') THEN                                  FLOPSF    522
         LUNPSF(IFLNO) = -1                                             FLOPSF    523
         IEBK = 1                                                       FLOPSF    524
         GOTO 9999                                                      FLOPSF    525
       ENDIF                                                            FLOPSF    526
C---------------------------------------------------------------------  FLOPSF    527
C                                  GET ARRAY ACCESS DATA FROM THE FILE  FLOPSF    528
C                                                                       FLOPSF    529
       IF (PSFID .EQ. 'PSF01.00') THEN                                  FLOPSF    530
C                                  MOVE ARRAY NUMBERS FROM THE V1 DATA  FLOPSF    531
         IREC = 0                                                       FLOPSF    532
         IDEST = (IFLNO - 1) * 8                                        FLOPSF    533
         DO 3102 II = 1, 8                                              FLOPSF    534
           NAMHDR(IDEST + II) = V1HDR2(IREC + II)                       FLOPSF    535
3102     CONTINUE                                                       FLOPSF    536
C                                MOVE SECTION NUMBERS FROM THE V1 DATA  FLOPSF    537
         IREC = IREC + 8                                                FLOPSF    538
         IDEST = (IFLNO - 1) * 8 + 40                                   FLOPSF    539
         DO 3202 II = 1, 8                                              FLOPSF    540
           NAMHDR(IDEST + II) = V1HDR2(IREC + II)                       FLOPSF    541
3202     CONTINUE                                                       FLOPSF    542
C                                MOVE THE ARRAY NAMES FROM THE V1 DATA  FLOPSF    543
         IREC = IREC + 8                                                FLOPSF    544
         IDEST = (IFLNO - 1) * 12 + 80                                  FLOPSF    545
         DO 3302 II = 1, 12                                             FLOPSF    546
           NAMHDR(IDEST + II) = V1HDR2(IREC + II)                       FLOPSF    547
3302     CONTINUE                                                       FLOPSF    548
C                              MOVE THE SECTION NAMES FORM THE V1 DATA  FLOPSF    549
         IREC = IREC + 12                                               FLOPSF    550
         IDEST = (IFLNO - 1) * 2 + 140                                  FLOPSF    551
         DO 3402 II = 1, 2                                              FLOPSF    552
           NAMHDR(IDEST + II) = V1HDR2(IREC + II)                       FLOPSF    553
3402     CONTINUE                                                       FLOPSF    554
C                                          SET FIRST AND NEXT POINTERS  FLOPSF    555
C                                     FOR GENERATORS, LOADS AND SHUNTS  FLOPSF    556
         CALL INVPSF (LUN, 'BSEC', NBUS, 1)                             FLOPSF    557
         CALL INVPSF (LUN, 'GSEC', NGEN, 1)                             FLOPSF    558
         CALL INVPSF (LUN, 'LDSEC', NLOAD, 1)                           FLOPSF    559
         CALL INVPSF (LUN, 'FSSEC', NFXSH, 1)                           FLOPSF    560
         CALL INVPSF (LUN, 'SWSEC', NSWSH, 1)                           FLOPSF    561
         DO 3502 II = 1, NBUS                                           FLOPSF    562
           IBGNPT(II) = 0                                               FLOPSF    563
           IBLDPT(II) = 0                                               FLOPSF    564
           IBFSPT(II) = 0                                               FLOPSF    565
           IBSSPT(II) = 0                                               FLOPSF    566
3502     CONTINUE                                                       FLOPSF    567
         CALL RDPSFI (LUN, 'GBUS', IBSRC)                               FLOPSF    568
         DO 3602 IGN = NGEN, 1, - 1                                     FLOPSF    569
           IGNXT(IGN) = IBGNPT(IBSRC(IGN))                              FLOPSF    570
           IBGNPT(IBSRC(IGN)) = IGN                                     FLOPSF    571
3602     CONTINUE                                                       FLOPSF    572
         CALL RDPSFI (LUN, 'LDBUS', IBSRC)                              FLOPSF    573
         DO 3702 ILD = NLOAD, 1, - 1                                    FLOPSF    574
           ILDNXT(ILD) = IBLDPT(IBSRC(ILD))                             FLOPSF    575
           IBLDPT(IBSRC(ILD)) = ILD                                     FLOPSF    576
3702     CONTINUE                                                       FLOPSF    577
         CALL RDPSFI (LUN, 'FSBUS', IBSRC)                              FLOPSF    578
         DO 3802 IFS = NFXSH, 1, - 1                                    FLOPSF    579
           IFSNXT(IFS) = IBFSPT(IBSRC(IFS))                             FLOPSF    580
           IBFSPT(IBSRC(IFS)) = IFS                                     FLOPSF    581
3802     CONTINUE                                                       FLOPSF    582
         CALL RDPSFI (LUN, 'SWBUS', IBSRC)                              FLOPSF    583
         DO 3902 ISW = NSWSH, 1, - 1                                    FLOPSF    584
           ISWNXT(ISW) = IBSSPT(IBSRC(ISW))                             FLOPSF    585
           IBSSPT(IBSRC(ISW)) = ISW                                     FLOPSF    586
3902     CONTINUE                                                       FLOPSF    587
C                                                                       FLOPSF    588
         CALL RDPSFJ (LUN, 'BLFN', IBLFN)                               FLOPSF    589
         CALL RDPSFJ (LUN, 'BNAME', IBNAME)                             FLOPSF    590
C                                                 BUILD THE TAG ARRAYS  FLOPSF    591
         CALL TAGSRT (NBUS, IBLFN, IBNUTG)                              FLOPSF    592
         CALL TGSRT4 (NBUS, IBNAME, IBNMTG)                             FLOPSF    593
C                                               BUILD THE IBSCTN ARRAY  FLOPSF    594
         CALL INVPSF (LUN, 'LSEC', NLINE, 1)                            FLOPSF    595
         CALL INVPSF (LUN, 'FTSEC', NTR1X, 1)                           FLOPSF    596
         CALL INVPSF (LUN, 'ULSEC', NTR2X, 1)                           FLOPSF    597
         CALL INVPSF (LUN, 'FCSEC', NFXSC, 1)                           FLOPSF    598
         CALL INVPSF (LUN, 'SCSEC', NSCAP, 1)                           FLOPSF    599
         CALL INVPSF (LUN, 'BSSEC', NSCBR, 1)                           FLOPSF    600
         CALL INVPSF (LUN, 'STPSEC', NSTP, 1)                           FLOPSF    601
         CALL RDPSFI (LUN, 'LSCT', ILSCT)                               FLOPSF    602
         CALL RDPSFI (LUN, 'FTSCT', IFTSCT)                             FLOPSF    603
         CALL RDPSFI (LUN, 'ULSCT', IULSCT)                             FLOPSF    604
         CALL RDPSFI (LUN, 'FCSCT', IFCSCT)                             FLOPSF    605
         CALL RDPSFI (LUN, 'SCSCT', ISCSCT)                             FLOPSF    606
         CALL RDPSFI (LUN, 'STSCT', ISTSCT)                             FLOPSF    607
         CALL RDPSFJ (LUN, 'BRN', IBRN)                                 FLOPSF    608
         N2 = NLINE + NTR1X                                             FLOPSF    609
         N3 = N2 + NTR2X                                                FLOPSF    610
         N4 = N3 + NFXSC                                                FLOPSF    611
         N5 = N4 + NSCAP                                                FLOPSF    612
         DO 3952 II = 1, NSCBR                                          FLOPSF    613
           IBR = IBRN(II)                                               FLOPSF    614
           IF (IBR .LE. NLINE) THEN                                     FLOPSF    615
             IREC = IBR                                                 FLOPSF    616
             IBSCTN(II) = ILSCT(IREC)                                   FLOPSF    617
           ELSE IF (IBR .LE. N2) THEN                                   FLOPSF    618
             IREC = IBR - NLINE                                         FLOPSF    619
             IBSCTN(II) = IFTSCT(IREC)                                  FLOPSF    620
           ELSE IF (IBR .LE. N3) THEN                                   FLOPSF    621
             IREC = IBR - N2                                            FLOPSF    622
             IBSCTN(II) = IULSCT(IREC)                                  FLOPSF    623
           ELSE IF (IBR .LE. N4) THEN                                   FLOPSF    624
             IREC = IBR - N3                                            FLOPSF    625
             IBSCTN(II) = IFCSCT(IREC)                                  FLOPSF    626
           ELSE IF (IBR .LE. N5) THEN                                   FLOPSF    627
             IREC = IBR - N4                                            FLOPSF    628
             IBSCTN(II) = ISCSCT(IREC)                                  FLOPSF    629
           ELSE                                                         FLOPSF    630
             IREC = IBR - N5                                            FLOPSF    631
             IBSCTN(II) = ISTSCT(IREC)                                  FLOPSF    632
           ENDIF                                                        FLOPSF    633
3952     CONTINUE                                                       FLOPSF    634
C                                                                       FLOPSF    635
       ELSE                                                             FLOPSF    636
C                                 READ THE ARRAY NUMBERS FROM THE FILE  FLOPSF    637
         IREC = (LENHDR(IFLNO) + 63) / 64                               FLOPSF    638
         IDEST = (IFLNO - 1) * 8                                        FLOPSF    639
         DO 4102 II = 1, 8                                              FLOPSF    640
           READ (UNIT = LUN, REC = IREC + II) NAMHDR(IDEST + II)        FLOPSF    641
4102     CONTINUE                                                       FLOPSF    642
C                               READ THE SECTION NUMBERS FROM THE FILE  FLOPSF    643
         IREC = IREC + 8                                                FLOPSF    644
         IDEST = (IFLNO - 1) * 8 + 40                                   FLOPSF    645
         DO 4202 II = 1, 8                                              FLOPSF    646
           READ (UNIT = LUN, REC = IREC + II) NAMHDR(IDEST + II)        FLOPSF    647
4202     CONTINUE                                                       FLOPSF    648
C                                   READ THE ARRAY NAMES FROM THE FILE  FLOPSF    649
         IREC = IREC + 8                                                FLOPSF    650
         IDEST = (IFLNO - 1) * 12 + 80                                  FLOPSF    651
         DO 4302 II = 1, 12                                             FLOPSF    652
           READ (UNIT = LUN, REC = IREC + II) NAMHDR(IDEST + II)        FLOPSF    653
4302     CONTINUE                                                       FLOPSF    654
C                                 READ THE SECTION NAMES FROM THE FILE  FLOPSF    655
         IREC = IREC + 12                                               FLOPSF    656
         IDEST = (IFLNO - 1) * 2 + 140                                  FLOPSF    657
         DO 4402 II = 1, 2                                              FLOPSF    658
           READ (UNIT = LUN, REC = IREC + II) NAMHDR(IDEST + II)        FLOPSF    659
4402     CONTINUE                                                       FLOPSF    660
C                                          SET FIRST AND NEXT POINTERS  FLOPSF    661
C                                     FOR GENERATORS, LOADS AND SHUNTS  FLOPSF    662
         CALL RDPSFI (LUN, 'BGNPT', IBGNPT)                             FLOPSF    663
         CALL RDPSFI (LUN, 'GNXT', IGNXT)                               FLOPSF    664
         CALL RDPSFI (LUN, 'BLDPT', IBLDPT)                             FLOPSF    665
         CALL RDPSFI (LUN, 'LDNXT', ILDNXT)                             FLOPSF    666
         CALL RDPSFI (LUN, 'BFSPT', IBFSPT)                             FLOPSF    667
         CALL RDPSFI (LUN, 'FSNXT', IFSNXT)                             FLOPSF    668
         CALL RDPSFI (LUN, 'BSSPT', IBSSPT)                             FLOPSF    669
         CALL RDPSFI (LUN, 'SWNXT', ISWNXT)                             FLOPSF    670
C                                 READ BUS NUMBERS, NAMES, TAG ARRAYS,  FLOPSF    671
C                            SECTION NUMBERS OF SECTIONALIZED BRANCHES  FLOPSF    672
         CALL RDPSFJ (LUN, 'BLFN', IBLFN)                               FLOPSF    673
         CALL RDPSFJ (LUN, 'BNAME', IBNAME)                             FLOPSF    674
         CALL RDPSFI (LUN, 'BNUTG', IBNUTG)                             FLOPSF    675
         CALL RDPSFI (LUN, 'BNMTG', IBNMTG)                             FLOPSF    676
         CALL RDPSFI (LUN, 'BSCTN', IBSCTN)                             FLOPSF    677
C                                                                       FLOPSF    678
       ENDIF                                                            FLOPSF    679
C---------------------------------------------------------------------  FLOPSF    680
9999   RETURN                                                           FLOPSF    681
       END                                                              FLOPSF    682
C*********************************************************************  FLOPSF    683
       SUBROUTINE PSADSC (TEXT, IFLNO)                                  FLOPSF    684
C---------------------------------------------------------------------  FLOPSF    685
CD  FUNCTION                                                            FLOPSF    686
CD  ========                                                            FLOPSF    687
CD  THIS SUBROUTINE READS THE PSF TITLE                                 FLOPSF    688
CD                                                                      FLOPSF    689
CD  CALLING SEQUENCE                                                    FLOPSF    690
CD  ================                                                    FLOPSF    691
CD     ARGUMENT     TYPE     DESCRIPTION                                FLOPSF    692
CD     ========     ====     ===========                                FLOPSF    693
CD     TITLE        A*4      O: PSF DESCRIPTION                         FLOPSF    694
CD     IFLNO        I*4      O: FILE RECORD NUMBER                      FLOPSF    695
CD                                                                      FLOPSF    696
C---------------------------------------------------------------------  FLOPSF    697
      INCLUDE 'PSFNAM.INS'                                              FLOPSF    698
C                                                                       FLOPSF    699
       CHARACTER*4   TEXT(145)                                          FLOPSF    700
C---------------------------------------------------------------------  FLOPSF    701
C      LOCAL VARIABLES                                                  FLOPSF    702
C      ===============                                                  FLOPSF    703
C                                                                       FLOPSF    704
       INTEGER       ISLDSC(60)                                         FLOPSF    705
C                                                                       FLOPSF    706
       CHARACTER*4   ASLDSC(60)                                         FLOPSF    707
C                                                                       FLOPSF    708
       EQUIVALENCE   (ASLDSC(1), ISLDSC(1))                             FLOPSF    709
C---------------------------------------------------------------------  FLOPSF    710
       LUN = LUNPSF(IFLNO)                                              FLOPSF    711
C                                                 READ PSF DESCRIPTION  FLOPSF    712
       CALL RDPSFJ (LUN, 'SLDSC', ISLDSC)                               FLOPSF    713
C                                                                       FLOPSF    714
       DO 1202 II = 1, 60                                               FLOPSF    715
         TEXT(II) = ASLDSC(II)                                          FLOPSF    716
1202   CONTINUE                                                         FLOPSF    717
C---------------------------------------------------------------------  FLOPSF    718
       RETURN                                                           FLOPSF    719
       END                                                              FLOPSF    720
C*********************************************************************  FLOPSF    721
       SUBROUTINE PSABUS (LBUSNO, IFLNO, IEBK)                          FLOPSF    722
C---------------------------------------------------------------------  FLOPSF    723
CD  FUNCTION                                                            FLOPSF    724
CD  ========                                                            FLOPSF    725
CD  THIS SUBROUTINE LOADS PSF DATA INTO ETMSP BUS ARRAYS                FLOPSF    726
CD                                                                      FLOPSF    727
CD  CALLING SEQUENCE                                                    FLOPSF    728
CD  ================                                                    FLOPSF    729
CD     ARGUMENT     TYPE     DESCRIPTION                                FLOPSF    730
CD     ========     ====     ===========                                FLOPSF    731
CD     LBUSNO       I*4      O: LARGEST LOAD FLOW BUS NUMBER            FLOPSF    732
CD     IFLNO        I*4      O: FILE RECORD NUMBER                      FLOPSF    733
CD     IEBK         I*4      O: ERROR FLAG                              FLOPSF    734
CD                                                                      FLOPSF    735
C---------------------------------------------------------------------  FLOPSF    736
      INCLUDE 'PSFNAM.INS'                                              FLOPSF    737
      INCLUDE 'PARX.INS'                                                FLOPSF    738
      INCLUDE 'CNPARX.INS'                                              FLOPSF    739
      INCLUDE 'CNLFDA.INS'                                              FLOPSF    740
      INCLUDE 'CNUNIT.INS'                                              FLOPSF    741
      INCLUDE 'CNFLAG.INS'                                              FLOPSF    742
      INCLUDE 'CNMNEW.INS'                                              FLOPSF    743
      INCLUDE 'CNIPTR.INS'                                              FLOPSF    744
      INCLUDE 'EPBUS.INS'                                               FLOPSF    745
      INCLUDE 'CNMSG.INS'                                               FLOPSF    746
      INCLUDE 'CNB19.INS'                                               FLOPSF    747
      INCLUDE 'CNGSRC.INS'                                              FLOPSF    748
      INCLUDE 'CNPT.INS'                                                FLOPSF    749
C                                                                       FLOPSF    750
       INTEGER*2     IBGNPT(NB), IGNXT(NB/3), IBLDPT(NB), ILDNXT(NB),   FLOPSF    751
     +               IBFSPT(NB), IFSNXT(NB), IBSSPT(NB), ISWNXT(NSS)    FLOPSF    752
C                                                                       FLOPSF    753
       COMMON /SCRAT3/ IBGNPT, IGNXT, IBLDPT, ILDNXT, IBFSPT, IFSNXT,   FLOPSF    754
     +                 IBSSPT, ISWNXT                                   FLOPSF    755
C                                                                       FLOPSF    756
       INTEGER*2     IBNUTG(NB), IBNMTG(NB), IBSCTN(MSEL)               FLOPSF    757
       INTEGER       IBLFN(NB), IBNAME(4*NB)                            FLOPSF    758
       COMMON /SCRAT2/ IBLFN, IBNAME, IBNUTG, IBNMTG, IBSCTN            FLOPSF    759
C                                                                       FLOPSF    760
       INTEGER*2     ILDMDL(5*NB), ILDBUS(NB), IIMBUS(NB)               FLOPSF    761
       INTEGER       ILDID(2*NB), IIMLID(2*NB)                          FLOPSF    762
       REAL          RLMA(300), RLMB(300), RLMM(300), RLMN(300),        FLOPSF    763
     +               RIMBKV(NB), RIMMVA(NB), RIMSTR(NB), RIMSTX(NB),    FLOPSF    764
     +               RIMRTR(NB), RIMRTX(NB), RIMMGX(NB)                 FLOPSF    765
       COMPLEX       CLDPQ(5*NB)                                        FLOPSF    766
       COMMON /SCRAT6/ CLDPQ, ILDMDL, ILDBUS, ILDID, RLMA, RLMB,        FLOPSF    767
     +                 RLMM, RLMN, NMIMTR, IIMBUS, IIMLID, RIMBKV,      FLOPSF    768
     +                 RIMMVA, RIMSTR, RIMSTX, RIMRTR, RIMRTX, RIMMGX   FLOPSF    769
C---------------------------------------------------------------------  FLOPSF    770
C      LOCAL VARIABLES                                                  FLOPSF    771
C      ===============                                                  FLOPSF    772
C                                                                       FLOPSF    773
       INTEGER*2   IGINUM(200), IZNNUM(200), IBAREA(NB),                FLOPSF    774
     +             IBZONE(6*NB), IBTYPE(NB), IGSTAT(NB/3), ISWSTA(NSS), FLOPSF    775
     +             IAZTG(JZN)                                           FLOPSF    776
C                                                                       FLOPSF    777
       INTEGER       TRMLEN                                             FLOPSF    778
       INTEGER       IGI1ID(4*JAR), IZNID(4*JZN), IFLID(20),            FLOPSF    779
     +               IFLNAM(300), IGID(2*NB/3), IAZID(4*JZN)            FLOPSF    780
C                                                                       FLOPSF    781
       INTEGER       IPSFID(2)                                          FLOPSF    782
C                                                                       FLOPSF    783
       LOGICAL       PRTFLG                                             FLOPSF    784
C                                                                       FLOPSF    785
       REAL          PP, QQ, TT(2), RBKV(NB), RGP(NB/3), RGQ(NB/3),     FLOPSF    786
     +               RSLBAS(100), RGMVA(NB/3), RGTAPR(NB/3)             FLOPSF    787
C                                                                       FLOPSF    788
       COMPLEX       PQ, CBV(NB), CFSY(NB/2), CSWY(NSS), CGZS(NB/3),    FLOPSF    789
     +               CGZT(NB/3)                                         FLOPSF    790
C                                                                       FLOPSF    791
       CHARACTER*2   GUNID                                              FLOPSF    792
C                                                                       FLOPSF    793
       CHARACTER*8   PSFID, CGID(NB/3)                                  FLOPSF    794
C                                                                       FLOPSF    795
       EQUIVALENCE   (PQ, PP, TT(1)), (QQ, TT(2))                       FLOPSF    796
       EQUIVALENCE   (IPSFID, PSFID)                                    FLOPSF    797
       EQUIVALENCE   (IGID(1), CGID(1))                                 FLOPSF    798
C                                                                       FLOPSF    799
       COMMON /SCRAT0/ IGI1ID, IZNID, RBKV, IGINUM, IZNNUM, IBAREA,     FLOPSF    800
     +                 IBZONE, IBTYPE, CBV, CFSY, IGSTAT, RGP, RGQ,     FLOPSF    801
     +                 ISWSTA, CSWY, IFLID, IFLNAM, RGMVA, CGZS, CGZT,  FLOPSF    802
     +                 RGTAPR, IGID, IAZID, IAZTG                       FLOPSF    803
C                                                                       FLOPSF    804
       INTEGER         JFILID, JFILNM(15)                               FLOPSF    805
       CHARACTER*4     FILID                                            FLOPSF    806
       CHARACTER*60    FILNAM                                           FLOPSF    807
C                                                                       FLOPSF    808
       EQUIVALENCE     (FILID, JFILID)                                  FLOPSF    809
       EQUIVALENCE     (FILNAM, JFILNM(1))                              FLOPSF    810
C---------------------------------------------------------------------  FLOPSF    811
C                                                       INITIALIZATION  FLOPSF    812
C                                                                       FLOPSF    813
       LUN = LUNPSF(IFLNO)                                              FLOPSF    814
       PRTFLG = .TRUE.                                                  FLOPSF    815
       NBS = 0                                                          FLOPSF    816
C                                                                       FLOPSF    817
       LDEB = (JDEB(2) .NE. 0)                                          FLOPSF    818
C                                                                       FLOPSF    819
       IPSFID(1) = HDRPSF(1, IFLNO)                                     FLOPSF    820
       IPSFID(2) = HDRPSF(2, IFLNO)                                     FLOPSF    821
C                                                                       FLOPSF    822
       NGSREC = 0                                                       FLOPSF    823
       CALL FMOVE (0, GMWX, GMWX, NB*2)                                 FLOPSF    824
       CALL MOVE (0, LFGEN, LFGEN, NB/3)                                FLOPSF    825
       CALL MOVE (0, IGENST, IGENST, NB/3)                              FLOPSF    826
       CALL MOVE (0, NSORDE, NSORDE, NB/3)                              FLOPSF    827
C---------------------------------------------------------------------  FLOPSF    828
C                                             LOAD AREA AND ZONE NAMES  FLOPSF    829
C                                                                       FLOPSF    830
       CALL INVPSF (LUN, 'GISEC', NAREA, 1)                             FLOPSF    831
       CALL RDPSFJ (LUN, 'GI1ID', IGI1ID)                               FLOPSF    832
       CALL RDPSFI (LUN, 'GINUM', IGINUM)                               FLOPSF    833
C                                                      SORT AREA NAMES  FLOPSF    834
       DO 1202 II = 1, NAREA                                            FLOPSF    835
         IOFSET = (II - 1) * 4                                          FLOPSF    836
         IAZID(IOFSET + 1) = IGI1ID(IOFSET + 1)                         FLOPSF    837
         IAZID(IOFSET + 2) = IGI1ID(IOFSET + 2)                         FLOPSF    838
         IAZID(IOFSET + 3) = IGI1ID(IOFSET + 3)                         FLOPSF    839
         IAZID(IOFSET + 4) = IGI1ID(IOFSET + 4)                         FLOPSF    840
1202   CONTINUE                                                         FLOPSF    841
C                                                                       FLOPSF    842
       CALL TGSRT4 (NAREA, IAZID, IAZTG)                                FLOPSF    843
C                                   LOAD AREA NAMES INTO IARE IN ORDER  FLOPSF    844
       DO 1252 IIX = 1, NAREA                                           FLOPSF    845
         II = IAZTG(IIX)                                                FLOPSF    846
         IOFSET = (II - 1) * 4                                          FLOPSF    847
         IARE(IIX, 1) = IGI1ID(IOFSET + 1)                              FLOPSF    848
         IARE(IIX, 2) = IGI1ID(IOFSET + 2)                              FLOPSF    849
         IARE(IIX, 3) = IGI1ID(IOFSET + 3)                              FLOPSF    850
         INTARA(IIX) = IGINUM(II)                                       FLOPSF    851
         MNEWA(IGINUM(II))=IIX                                          FLOPSF    852
1252   CONTINUE                                                         FLOPSF    853
C                                                                       FLOPSF    854
       NMAREA = NAREA                                                   FLOPSF    855
C                                                                       FLOPSF    856
       CALL INVPSF (LUN, 'ZONSEC', NZONE, 1)                            FLOPSF    857
       CALL RDPSFJ (LUN, 'ZNID', IZNID)                                 FLOPSF    858
       CALL RDPSFI (LUN, 'ZNNUM', IZNNUM)                               FLOPSF    859
C                                                      SORT ZONE NAMES  FLOPSF    860
       DO 1302 II = 1, NZONE                                            FLOPSF    861
         IOFSET = (II - 1) * 4                                          FLOPSF    862
         IAZID(IOFSET + 1) = IZNID(IOFSET + 1)                          FLOPSF    863
         IAZID(IOFSET + 2) = IZNID(IOFSET + 2)                          FLOPSF    864
         IAZID(IOFSET + 3) = IZNID(IOFSET + 3)                          FLOPSF    865
         IAZID(IOFSET + 4) = IZNID(IOFSET + 4)                          FLOPSF    866
1302   CONTINUE                                                         FLOPSF    867
C                                                                       FLOPSF    868
       CALL TGSRT4 (NZONE, IAZID, IAZTG)                                FLOPSF    869
C                                  LOAD ZONE NAMES INTO NAMZN IN ORDER  FLOPSF    870
       DO 1352 IIX = 1, NZONE                                           FLOPSF    871
         II = IAZTG(IIX)                                                FLOPSF    872
         IOFSET = (II - 1) * 4                                          FLOPSF    873
         NAMZN(IIX, 1) = IZNID(IOFSET + 1)                              FLOPSF    874
         NAMZN(IIX, 2) = IZNID(IOFSET + 2)                              FLOPSF    875
         NAMZN(IIX, 3) = IZNID(IOFSET + 3)                              FLOPSF    876
         INTZON(IIX) = IZNNUM(II)                                       FLOPSF    877
         MNEWZ(IZNNUM(II)+1)=IIX                                        FLOPSF    878
1352   CONTINUE                                                         FLOPSF    879
C                                                                       FLOPSF    880
       NUMZON = NZONE                                                   FLOPSF    881
C---------------------------------------------------------------------  FLOPSF    882
C                                                    LOAD THE BUS DATA  FLOPSF    883
C                                                                       FLOPSF    884
       CALL RDPSFR (LUN, 'SLBAS', RSLBAS)                               FLOPSF    885
       SBASE = RSLBAS(1)                                                FLOPSF    886
       BASPC = SBASE                                                    FLOPSF    887
C                                                                       FLOPSF    888
       CALL INVPSF (LUN, 'BSEC', NBUS, 1)                               FLOPSF    889
C                                                                       FLOPSF    890
       CALL RDPSFI (LUN, 'BTYPE', IBTYPE)                               FLOPSF    891
       CALL RDPSFR (LUN, 'BKV', RBKV)                                   FLOPSF    892
       CALL RDPSFI (LUN, 'BAREA', IBAREA)                               FLOPSF    893
       CALL RDPSFI (LUN, 'BZONE', IBZONE)                               FLOPSF    894
       CALL RDPSFX (LUN, 'BV', CBV)                                     FLOPSF    895
C                                                                       FLOPSF    896
       CALL RDPSFX (LUN, 'FSY', CFSY)                                   FLOPSF    897
C                                                                       FLOPSF    898
       CALL RDPSFI (LUN, 'GSTAT', IGSTAT)                               FLOPSF    899
       CALL RDPSFR (LUN, 'GP', RGP)                                     FLOPSF    900
       CALL RDPSFR (LUN, 'GQ', RGQ)                                     FLOPSF    901
       CALL RDPSFR (LUN, 'GMVA', RGMVA)                                 FLOPSF    902
C                                                                       FLOPSF    903
       CALL RDPSFX (LUN, 'GZS', CGZS)                                   FLOPSF    904
       CALL RDPSFX (LUN, 'GZT', CGZT)                                   FLOPSF    905
       CALL RDPSFR (LUN, 'GTAPR', RGTAPR)                               FLOPSF    906
       CALL RDPSFI (LUN, 'GID', IGID)                                   FLOPSF    907
C                                                                       FLOPSF    908
       CALL RDPSFX (LUN, 'LDPQ', CLDPQ)                                 FLOPSF    909
       CALL RDPSFI (LUN, 'LDMDL', ILDMDL)                               FLOPSF    910
       CALL RDPSFI (LUN, 'LDBUS', ILDBUS)                               FLOPSF    911
       CALL RDPSFJ (LUN, 'LDID', ILDID)                                 FLOPSF    912
C                                                                       FLOPSF    913
       CALL RDPSFR (LUN, 'LMA', RLMA)                                   FLOPSF    914
       CALL RDPSFR (LUN, 'LMB', RLMB)                                   FLOPSF    915
       CALL RDPSFR (LUN, 'LMM', RLMM)                                   FLOPSF    916
       CALL RDPSFR (LUN, 'LMN', RLMN)                                   FLOPSF    917
C                                                                       FLOPSF    918
       CALL RDPSFI (LUN, 'SWSTA', ISWSTA)                               FLOPSF    919
       CALL RDPSFX (LUN, 'SWY', CSWY)                                   FLOPSF    920
C---------------------------------------------------------------------  FLOPSF    921
C                               READ INDUCTION MOTOR DATA IF IT EXISTS  FLOPSF    922
C                                                                       FLOPSF    923
       IF (PSFID .EQ. 'PSF01.00') THEN                                  FLOPSF    924
         NFILE = 0                                                      FLOPSF    925
       ELSE                                                             FLOPSF    926
         CALL INVPSF (LUN, 'FLSEC', NFILE, 1)                           FLOPSF    927
       ENDIF                                                            FLOPSF    928
C                                                                       FLOPSF    929
       IF (NFILE .GT. 0) THEN                                           FLOPSF    930
C                                                                       FLOPSF    931
         CALL RDPSFJ (LUN, 'FLID', IFLID)                               FLOPSF    932
         CALL RDPSFJ (LUN, 'FLNAM', IFLNAM)                             FLOPSF    933
C                                                                       FLOPSF    934
         DO 1402 II = 1, NFILE                                          FLOPSF    935
C                                                                       FLOPSF    936
           JFILID = IFLID(II)                                           FLOPSF    937
           IF (FILID(1:3) .EQ. 'IMT') THEN                              FLOPSF    938
C                                                                       FLOPSF    939
             READ (FILID(4:4), '(I1)') IBCODE                           FLOPSF    940
             IOFSET = (II - 1) * 15                                     FLOPSF    941
             DO 1102 IJ = 1, 15                                         FLOPSF    942
               JFILNM(IJ) = IFLNAM(IOFSET + IJ)                         FLOPSF    943
1102         CONTINUE                                                   FLOPSF    944
C                                                                       FLOPSF    945
             LEN = TRMLEN (FILNAM)                                      FLOPSF    946
             CALL OPENRE (IU26, FILNAM, 0, 8, IERR, LEN)                FLOPSF    947
C                                                                       FLOPSF    948
             IF (IERR .NE. 0) THEN                                      FLOPSF    949
               MSG(1) = ' *** ERROR OPENING INDUCTION ' //              FLOPSF    950
     +                  'MOTOR LOAD DATA FILE'                          FLOPSF    951
               CALL PRTMSG(1)                                           FLOPSF    952
               IEBK = 1                                                 FLOPSF    953
               GOTO 1500                                                FLOPSF    954
             ENDIF                                                      FLOPSF    955
C                                                                       FLOPSF    956
             CALL RDIMT (IU26, IBCODE, SBASE)                           FLOPSF    957
C                                                                       FLOPSF    958
           ENDIF                                                        FLOPSF    959
C                                                                       FLOPSF    960
1402     CONTINUE                                                       FLOPSF    961
C                                                                       FLOPSF    962
       ENDIF                                                            FLOPSF    963
C---------------------------------------------------------------------  FLOPSF    964
1500   DO 5002 IIX = 1, NBUS                                            FLOPSF    965
         II = IBNMTG(IIX)                                               FLOPSF    966
         LFBSN = IBLFN(II)                                              FLOPSF    967
C                                                                       FLOPSF    968
         IF (MNEW(LFBSN) .NE. 0) THEN                                   FLOPSF    969
C                                    SKIP IF BUS NUMBER ALREADY EXISTS  FLOPSF    970
           WRITE (MSG(1), 6104) LFBSN                                   FLOPSF    971
           CALL PRTMSG (1)                                              FLOPSF    972
           IEBK = 1                                                     FLOPSF    973
           GOTO 5002                                                    FLOPSF    974
C                                                                       FLOPSF    975
         ELSE                                                           FLOPSF    976
C                             SKIP IF NO. OF BUSES EXCEEDS THE MAXIMUM  FLOPSF    977
           NBS = NBS + 1                                                FLOPSF    978
           IF (NBS .GE. NXB) THEN                                       FLOPSF    979
             IF (PRTFLG) THEN                                           FLOPSF    980
               WRITE (MSG(1), 6204) NXB, NBS                            FLOPSF    981
               CALL PRTMSG (1)                                          FLOPSF    982
               PRTFLG = .FALSE.                                         FLOPSF    983
               IEBK = 1                                                 FLOPSF    984
             ENDIF                                                      FLOPSF    985
             GOTO 5002                                                  FLOPSF    986
           ENDIF                                                        FLOPSF    987
C                                                                       FLOPSF    988
         ENDIF                                                          FLOPSF    989
C                                                                       FLOPSF    990
         MNEW(LFBSN) = NBS                                              FLOPSF    991
         NOLD(NBS) = LFBSN                                              FLOPSF    992
         INTNUM(NBS) = LFBSN                                            FLOPSF    993
C                                                      COMPUTE OFFSETS  FLOPSF    994
         IOFST2 = (NBS - 1) * 2                                         FLOPSF    995
         IOFST4 = (NBS - 1) * 4                                         FLOPSF    996
         IOFST8 = (NBS - 1) * 8                                         FLOPSF    997
C                                                           BUS STATUS  FLOPSF    998
         IF (IBTYPE(II) .GT. 4 .OR. IBTYPE(II) .LE. 0) THEN             FLOPSF    999
           WRITE (MSG(1), 6704) LFBSN, IBTYPE(II)                       FLOPSF   1000
           CALL PRTMSG(1)                                               FLOPSF   1001
           IEBK = 1                                                     FLOPSF   1002
           JBSTAT(NBS) = 4                                              FLOPSF   1003
         ELSEIF (IBTYPE(II) .EQ. 3) THEN                                FLOPSF   1004
           JBSTAT(NBS) = 2                                              FLOPSF   1005
         ELSE                                                           FLOPSF   1006
           JBSTAT(NBS) = IBTYPE(II)                                     FLOPSF   1007
         ENDIF                                                          FLOPSF   1008
C                                                              BASE KV  FLOPSF   1009
         XBASKV(IOFST4 + 4) = RBKV(II)                                  FLOPSF   1010
C                                                AREA AND ZONE NUMBERS  FLOPSF   1011
         IAZ1 = IGINUM(IBAREA(II))                                      FLOPSF   1012
         IOFSET = (II - 1) * 6                                          FLOPSF   1013
         IZRN = IBZONE(IOFSET + 1)                                      FLOPSF   1014
         IAZ2 = IZNNUM(IZRN)                                            FLOPSF   1015
         K1=IAZ2                                                        FLOPSF   1016
         K2=IAZ1                                                        FLOPSF   1017
         CALL PACKII(K1,K2,ITFK)                                        FLOPSF   1018
         IBAR(IOFST4 + 3) = ITFK                                        FLOPSF   1019
C                                                           BUS NAMES   FLOPSF   1020
         IOFSET = (II - 1) * 4                                          FLOPSF   1021
         NAMES(IOFST8 + 6) = IBNAME(IOFSET + 1)                         FLOPSF   1022
         NAMES(IOFST8 + 7) = IBNAME(IOFSET + 2)                         FLOPSF   1023
         NAMES(IOFST8 + 8) = IBNAME(IOFSET + 3)                         FLOPSF   1024
C                                STORE BUS NAMES IN EPBUS INAMES ARRAY  FLOPSF   1025
         INAMES(1, NBS) = IBNAME(IOFSET + 1)                            FLOPSF   1026
         INAMES(2, NBS) = IBNAME(IOFSET + 2)                            FLOPSF   1027
         INAMES(3, NBS) = IBNAME(IOFSET + 3)                            FLOPSF   1028
C                                                         BUS VOLTAGES  FLOPSF   1029
         PQ = CBV(II)                                                   FLOPSF   1030
         ERBUS(IOFST8 + 1) = PP                                         FLOPSF   1031
         EIBUS(IOFST8 + 2) = QQ                                         FLOPSF   1032
         VM = CABS (PQ)                                                 FLOPSF   1033
C                                                            BUS LOADS  FLOPSF   1034
         BMW(IOFST4 + 1) = 0.0                                          FLOPSF   1035
         BMX(IOFST4 + 2) = 0.0                                          FLOPSF   1036
         ILD = IBLDPT(II)                                               FLOPSF   1037
2202     IF (ILD .NE. 0) THEN                                           FLOPSF   1038
           CALL GTLDPQ (ILD, VM, SBASE, PL, QL)                         FLOPSF   1039
           BMW(IOFST4 + 1) = BMW(IOFST4 + 1) + PL                       FLOPSF   1040
           BMX(IOFST4 + 2) = BMX(IOFST4 + 2) + QL                       FLOPSF   1041
           ILD = ILDNXT(ILD)                                            FLOPSF   1042
           GOTO 2202                                                    FLOPSF   1043
         ENDIF                                                          FLOPSF   1044
         BMW(IOFST4 + 1) = BMW(IOFST4 + 1) * SBASE                      FLOPSF   1045
         BMX(IOFST4 + 2) = BMX(IOFST4 + 2) * SBASE                      FLOPSF   1046
C                                SWITCHABLE SHUNTS WILL BE ADDED LATER  FLOPSF   1047
C                                                      AS FIXED SHUNTS  FLOPSF   1048
         BSTC(IOFST8 + 3) = 0.0                                         FLOPSF   1049
C                                                     FIXED BUS SHUNTS  FLOPSF   1050
         RYGR(IOFST8 + 4) = 0.0                                         FLOPSF   1051
         RIYGR(IOFST8 + 5) = 0.0                                        FLOPSF   1052
         IFS = IBFSPT(II)                                               FLOPSF   1053
2402     IF (IFS .NE. 0) THEN                                           FLOPSF   1054
           PQ = CFSY(IFS)                                               FLOPSF   1055
           RYGR(IOFST8 + 4) = RYGR(IOFST8 + 4) + PP                     FLOPSF   1056
           RIYGR(IOFST8 + 5) = RIYGR(IOFST8 + 5) - QQ                   FLOPSF   1057
           IFS = IFSNXT(IFS)                                            FLOPSF   1058
           GOTO 2402                                                    FLOPSF   1059
         ENDIF                                                          FLOPSF   1060
C                                                                       FLOPSF   1061
         IF (LFBSN .GT. LBUSNO) LBUSNO = LFBSN                          FLOPSF   1062
         IF (LDEB .AND. NBS .EQ. 1) WRITE (IUD6, 6304)                  FLOPSF   1063
         IF (LDEB)                                                      FLOPSF   1064
     +      WRITE (IUD6, 6404)                                          FLOPSF   1065
     +            LFBSN, IBTYPE(II),                                    FLOPSF   1066
     +            BMW(IOFST4 + 1), BMX(IOFST4 + 2),                     FLOPSF   1067
     +            RYGR(IOFST8 + 4), RIYGR(IOFST8 + 5),                  FLOPSF   1068
     +            IAZ1, ERBUS (IOFST8 + 1), EIBUS (IOFST8 + 2),         FLOPSF   1069
     +            NAMES(IOFST8 + 6), NAMES(IOFST8 + 7),                 FLOPSF   1070
     +            NAMES(IOFST8 + 8), IAZ2                               FLOPSF   1071
C                                                           GENERATORS  FLOPSF   1072
         IGN = IBGNPT(II)                                               FLOPSF   1073
3202     IF (IGN .NE. 0) THEN                                           FLOPSF   1074
           IF (CGID(IGN)(2:2) .EQ. ' ') THEN                            FLOPSF   1075
             GUNID(1:1) = CGID(IGN)(2:2)                                FLOPSF   1076
             GUNID(2:2) = CGID(IGN)(1:1)                                FLOPSF   1077
           ELSE                                                         FLOPSF   1078
             GUNID = CGID(IGN)(1:2)                                     FLOPSF   1079
           ENDIF                                                        FLOPSF   1080
           JGSTAT = IGSTAT(IGN)                                         FLOPSF   1081
           IF (LDEB) WRITE (IUD6, 6504)                                 FLOPSF   1082
     +               RGP(IGN) * SBASE, RGQ(IGN) * SBASE, IGSTAT(IGN)    FLOPSF   1083
           IF (IBTYPE(II) .NE. 1 .AND. IBTYPE(II) .NE. 4 .AND.          FLOPSF   1084
     +         JGSTAT .EQ. 1) THEN                                      FLOPSF   1085
             GMW(IOFST2 + 1) = GMW(IOFST2 + 1) + RGP(IGN)               FLOPSF   1086
             GMX(IOFST2 + 2) = GMX(IOFST2 + 2) + RGQ(IGN)               FLOPSF   1087
           ENDIF                                                        FLOPSF   1088
           IF (IBTYPE(II) .EQ. 1) JGSTAT = 3                            FLOPSF   1089
           IF (IBTYPE(II) .EQ. 4) JGSTAT = 4                            FLOPSF   1090
C                                         FILL UP THE GENERATOR ARRAYS  FLOPSF   1091
C                                                                       FLOPSF   1092
           CALL ADFGEN (0, KFOUND, NGSREC, LFBSN, GUNID, LFGEN, XGEID,  FLOPSF   1093
     +                  NSORDE)                                         FLOPSF   1094
           IGENST(NGSREC) = JGSTAT                                      FLOPSF   1095
           GSRCD(1, NGSREC) = RGP(IGN) * SBASE                          FLOPSF   1096
           GSRCD(2, NGSREC) = RGQ(IGN) * SBASE                          FLOPSF   1097
           GSRCD(3, NGSREC) = RGMVA(IGN)                                FLOPSF   1098
           PQ = CGZS(IGN)                                               FLOPSF   1099
           GSRCD(4, NGSREC) = PP                                        FLOPSF   1100
           GSRCD(5, NGSREC) = QQ                                        FLOPSF   1101
           PQ = CGZT(IGN)                                               FLOPSF   1102
           GSRCD(6, NGSREC) = PP                                        FLOPSF   1103
           GSRCD(7, NGSREC) = QQ                                        FLOPSF   1104
           GSRCD(8, NGSREC) = RGTAPR(IGN)                               FLOPSF   1105
C                                                                       FLOPSF   1106
           IGN = IGNXT(IGN)                                             FLOPSF   1107
           GOTO 3202                                                    FLOPSF   1108
         ENDIF                                                          FLOPSF   1109
C                                                                       FLOPSF   1110
         GMW(IOFST2 + 1) = GMW(IOFST2 + 1) * SBASE                      FLOPSF   1111
         GMW(IOFST2 + 2) = GMW(IOFST2 + 2) * SBASE                      FLOPSF   1112
C                                                    SWITCHABLE SHUNTS  FLOPSF   1113
         ISW = IBSSPT(II)                                               FLOPSF   1114
3402     IF (ISW .NE. 0) THEN                                           FLOPSF   1115
           IF (LDEB) WRITE (IUD6, 6604) CSWY(ISW), ISWSTA(ISW)          FLOPSF   1116
           IF (ISWSTA(ISW) .EQ. 1) THEN                                 FLOPSF   1117
             PQ = CSWY(ISW)                                             FLOPSF   1118
             RYGR(IOFST8 + 4) = RYGR(IOFST8 + 4) + PP                   FLOPSF   1119
             RIYGR(IOFST8 + 5) = RIYGR(IOFST8 + 5) - QQ                 FLOPSF   1120
           ENDIF                                                        FLOPSF   1121
           ISW = ISWNXT(ISW)                                            FLOPSF   1122
           GOTO 3402                                                    FLOPSF   1123
         ENDIF                                                          FLOPSF   1124
C                                                                       FLOPSF   1125
5002   CONTINUE                                                         FLOPSF   1126
C---------------------------------------------------------------------  FLOPSF   1127
       NLFBUS = NBS                                                     FLOPSF   1128
       NOBUS = NBS                                                      FLOPSF   1129
       IF(IBGSTA.NE.0)THEN                                              FLOPSF   1130
         IBGSTA=-NGSREC                                                 FLOPSF   1131
         NGSREC=0                                                       FLOPSF   1132
       ENDIF                                                            FLOPSF   1133
C---------------------------------------------------------------------  FLOPSF   1134
6104   FORMAT (' *** ERROR - BUS ', I6, 'HAS DUPLICATED DATA - ',       FLOPSF   1135
     +         'CHECK YOUR LOAD FLOW DATA.')                            FLOPSF   1136
6204   FORMAT (' *** ERROR - NO OF BUSES EXCEEDS THE LIMIT OF ', I5,    FLOPSF   1137
     +         ' AT BUS: ', I6)                                         FLOPSF   1138
6304   FORMAT (' ***** READING BUS DATA ***** ')                        FLOPSF   1139
6404   FORMAT (1X, I6, 1X, I1, 4F9.3, I4, F8.5, F10.4, 2X, 3A4, 1X,     FLOPSF   1140
     +         I4)                                                      FLOPSF   1141
6504   FORMAT (' GENERATOR: ', 2F14.6, 1X, I2)                          FLOPSF   1142
6604   FORMAT (' SWITCHABLE SHUNT: ', 2F14.6, 1X, I2)                   FLOPSF   1143
6704   FORMAT (' *** ERROR - BUS ', I6, ' HAS INVALID BUSTYPE - ', I4)  FLOPSF   1144
C---------------------------------------------------------------------  FLOPSF   1145
       RETURN                                                           FLOPSF   1146
       END                                                              FLOPSF   1147
C*********************************************************************  FLOPSF   1148
       SUBROUTINE GTLDPQ (ILD, VM, SBASE, PL, QL)                       FLOPSF   1149
C---------------------------------------------------------------------  FLOPSF   1150
CD  FUNCTION                                                            FLOPSF   1151
CD  ========                                                            FLOPSF   1152
CD  THIS SUBROUTINE LOADS PSF DATA INTO ETMSP BUS ARRAYS                FLOPSF   1153
CD                                                                      FLOPSF   1154
CD  CALLING SEQUENCE                                                    FLOPSF   1155
CD  ================                                                    FLOPSF   1156
CD     ARGUMENT     TYPE     DESCRIPTION                                FLOPSF   1157
CD     ========     ====     ===========                                FLOPSF   1158
CD       ILD          I*4      I: LOAD RECORD NUMBER                    FLOPSF   1159
CD       VM           R*4      I: BUS VOLTAGE MAGNITUDE IN PU.          FLOPSF   1160
CD       SBASE        R*4      I: BASE MVA OF THW SYSTEM                FLOPSF   1161
CD       PL           R*4      O: TOTAL REAL POWER LOAD IN PU.          FLOPSF   1162
CD       QL           R*4      O: TOTAL REACTIVE POWER LOAD IN PU.      FLOPSF   1163
CD                                                                      FLOPSF   1164
C---------------------------------------------------------------------  FLOPSF   1165
C                                                                       FLOPSF   1166
      INCLUDE 'CNMSG.INS'                                               FLOPSF   1167
      INCLUDE 'PARX.INS'                                                FLOPSF   1168
C                                                                       FLOPSF   1169
       INTEGER*2     ILDMDL(5*NB), ILDBUS(NB), IIMBUS(NB)               FLOPSF   1170
       INTEGER       ILDID(2*NB), IIMLID(2*NB)                          FLOPSF   1171
       REAL          RLMA(300), RLMB(300), RLMM(300), RLMN(300),        FLOPSF   1172
     +               RIMBKV(NB), RIMMVA(NB), RIMSTR(NB), RIMSTX(NB),    FLOPSF   1173
     +               RIMRTR(NB), RIMRTX(NB), RIMMGX(NB)                 FLOPSF   1174
       COMPLEX       CLDPQ(5*NB)                                        FLOPSF   1175
       COMMON /SCRAT6/ CLDPQ, ILDMDL, ILDBUS, ILDID, RLMA, RLMB,        FLOPSF   1176
     +                 RLMM, RLMN, NMIMTR, IIMBUS, IIMLID, RIMBKV,      FLOPSF   1177
     +                 RIMMVA, RIMSTR, RIMSTX, RIMRTR, RIMRTX, RIMMGX   FLOPSF   1178
C---------------------------------------------------------------------  FLOPSF   1179
C      LOCAL VARIABLES                                                  FLOPSF   1180
C      ===============                                                  FLOPSF   1181
C                                                                       FLOPSF   1182
       REAL          PQ(2), PP, QQ                                      FLOPSF   1183
C                                                                       FLOPSF   1184
       COMPLEX       CPQ, PQLOAD                                        FLOPSF   1185
C                                                                       FLOPSF   1186
       EQUIVALENCE   (CPQ, PQ(1), PP), (PQ(2), QQ)                      FLOPSF   1187
C---------------------------------------------------------------------  FLOPSF   1188
C                                                       INITIALIZATION  FLOPSF   1189
C                                                                       FLOPSF   1190
       CPQ = CMPLX (0.0, 0.0)                                           FLOPSF   1191
C---------------------------------------------------------------------  FLOPSF   1192
       VM2 = VM * VM                                                    FLOPSF   1193
C                                                                       FLOPSF   1194
       IOFSL5 = (ILD - 1) * 5                                           FLOPSF   1195
       IOFSL2 = (ILD - 1) * 2                                           FLOPSF   1196
C                                                        LOOP ON LOADS  FLOPSF   1197
       DO 2002 II = 1, 5                                                FLOPSF   1198
         IMDLNO = ILDMDL(IOFSL5 + II)                                   FLOPSF   1199
         PQLOAD = CLDPQ(IOFSL5 + II)                                    FLOPSF   1200
C                                                     CONSTANT PQ LOAD  FLOPSF   1201
         IF (IMDLNO .EQ. -1) THEN                                       FLOPSF   1202
           CPQ = CPQ + PQLOAD                                           FLOPSF   1203
C                                                      CONSTANT I LOAD  FLOPSF   1204
         ELSE IF (IMDLNO .EQ. -2) THEN                                  FLOPSF   1205
           CPQ = CPQ + PQLOAD * VM                                      FLOPSF   1206
C                                                      CONSTANT Z LOAD  FLOPSF   1207
         ELSE IF (IMDLNO .EQ. -3) THEN                                  FLOPSF   1208
           CPQ = CPQ + CONJG (PQLOAD) * VM2                             FLOPSF   1209
C                                                 INDUCTION MOTOR LOAD  FLOPSF   1210
         ELSE IF (IMDLNO .EQ. -4) THEN                                  FLOPSF   1211
           IBUS = ILDBUS(ILD)                                           FLOPSF   1212
           DO 1202 JJ = 1, NMIMTR                                       FLOPSF   1213
             IOFSM2 = (JJ - 1) * 2                                      FLOPSF   1214
             IF (IBUS .EQ. IIMBUS(JJ) .AND.                             FLOPSF   1215
     +           ILDID(IOFSL2 + 1) .EQ. IIMLID(IOFSM2 + 1) .AND.        FLOPSF   1216
     +           ILDID(IOFSL2 + 2) .EQ. IIMLID(IOFSM2 + 2)) THEN        FLOPSF   1217
               IMT = JJ                                                 FLOPSF   1218
               GOTO 1500                                                FLOPSF   1219
             ENDIF                                                      FLOPSF   1220
1202       CONTINUE                                                     FLOPSF   1221
C                         THE FOLLOWING ERROR IS NOT EXPECTED TO OCCUR  FLOPSF   1222
           MSG(1) = ' *** ERROR IN ROUTINE - GTLDPQ'                    FLOPSF   1223
           MSG(2) = ' *** CANNOT FIND INDUCTION MOTOR DATA'             FLOPSF   1224
           CALL PRTMSG (2)                                              FLOPSF   1225
           GOTO 2002                                                    FLOPSF   1226
C                                                                       FLOPSF   1227
1500       PIM = REAL (PQLOAD)                                          FLOPSF   1228
           CALL INMMDL (ILD, IMT, PIM, VM, SBASE, QIM, * 2002)          FLOPSF   1229
           CPQ = CPQ + CMPLX (PIM, QIM)                                 FLOPSF   1230
C                                               VOLTAGE DEPENDANT LOAD  FLOPSF   1231
         ELSE IF (IMDLNO .GT. 0) THEN                                   FLOPSF   1232
           IOFLM3 = (IMDLNO - 1) * 3                                    FLOPSF   1233
           PLV = REAL (PQLOAD) *                                        FLOPSF   1234
     +           (RLMA(IOFLM3 + 1) * VM ** RLMN(IOFLM3 + 1) +           FLOPSF   1235
     +            RLMA(IOFLM3 + 2) * VM ** RLMN(IOFLM3 + 2) +           FLOPSF   1236
     +            RLMA(IOFLM3 + 3) * VM ** RLMN(IOFLM3 + 3))            FLOPSF   1237
           QLV = AIMAG (PQLOAD) *                                       FLOPSF   1238
     +           (RLMB(IOFLM3 + 1) * VM ** RLMM(IOFLM3 + 1) +           FLOPSF   1239
     +            RLMB(IOFLM3 + 2) * VM ** RLMM(IOFLM3 + 2) +           FLOPSF   1240
     +            RLMB(IOFLM3 + 3) * VM ** RLMM(IOFLM3 + 3))            FLOPSF   1241
           CPQ = CPQ + CMPLX (PLV, QLV)                                 FLOPSF   1242
         ELSE IF (IMDLNO .NE. 0) THEN                                   FLOPSF   1243
           MSG(1) = ' *** ERROR - LOAD MODEL RECORD NUMBER ' //         FLOPSF   1244
     +              '------ IS INVALID'                                 FLOPSF   1245
           WRITE (MSG(1)(39:44), '(I6)') IMDLNO                         FLOPSF   1246
           CALL PRTMSG (1)                                              FLOPSF   1247
         ENDIF                                                          FLOPSF   1248
2002   CONTINUE                                                         FLOPSF   1249
C---------------------------------------------------------------------  FLOPSF   1250
       PL = PP                                                          FLOPSF   1251
       QL = QQ                                                          FLOPSF   1252
C---------------------------------------------------------------------  FLOPSF   1253
       RETURN                                                           FLOPSF   1254
       END                                                              FLOPSF   1255
C*********************************************************************  FLOPSF   1256
       SUBROUTINE RDIMT (IUNIT, IBCODE, SBASE)                          FLOPSF   1257
C---------------------------------------------------------------------  FLOPSF   1258
CD  FUNCTION                                                            FLOPSF   1259
CD  ========                                                            FLOPSF   1260
CD  THIS SUBROUTINE READS IM DATA FROM A FILE.                          FLOPSF   1261
CD                                                                      FLOPSF   1262
CD  CALLING SEQUENCE                                                    FLOPSF   1263
CD  ================                                                    FLOPSF   1264
CD     ARGUMENT     TYPE     DESCRIPTION                                FLOPSF   1265
CD     ========     ====     ===========                                FLOPSF   1266
CD     IUNIT        I*4      I: UNIT NUMBER                             FLOPSF   1267
CD     IBCODE       I*4      I: BUS SPECIFICATION CODE                  FLOPSF   1268
CD     SBASE        R*4      I: BASE MVA OF THE SYSTEM                  FLOPSF   1269
CD                                                                      FLOPSF   1270
C---------------------------------------------------------------------  FLOPSF   1271
      INCLUDE 'PARX.INS'                                                FLOPSF   1272
      INCLUDE 'CNMSG.INS'                                               FLOPSF   1273
C                                                                       FLOPSF   1274
       INTEGER*2     ILDMDL(5*NB), ILDBUS(NB), IIMBUS(NB)               FLOPSF   1275
       INTEGER       ILDID(2*NB), IIMLID(2*NB)                          FLOPSF   1276
       REAL          RLMA(300), RLMB(300), RLMM(300), RLMN(300),        FLOPSF   1277
     +               RIMBKV(NB), RIMMVA(NB), RIMSTR(NB), RIMSTX(NB),    FLOPSF   1278
     +               RIMRTR(NB), RIMRTX(NB), RIMMGX(NB)                 FLOPSF   1279
       COMPLEX       CLDPQ(5*NB)                                        FLOPSF   1280
       COMMON /SCRAT6/ CLDPQ, ILDMDL, ILDBUS, ILDID, RLMA, RLMB,        FLOPSF   1281
     +                 RLMM, RLMN, NMIMTR, IIMBUS, IIMLID, RIMBKV,      FLOPSF   1282
     +                 RIMMVA, RIMSTR, RIMSTX, RIMRTR, RIMRTX, RIMMGX   FLOPSF   1283
C                                                                       FLOPSF   1284
       INTEGER*2     IBNUTG(NB), IBNMTG(NB), IBSCTN(MSEL)               FLOPSF   1285
       INTEGER       IBLFN(NB), IBNAME(4*NB)                            FLOPSF   1286
       COMMON /SCRAT2/ IBLFN, IBNAME, IBNUTG, IBNMTG, IBSCTN            FLOPSF   1287
C---------------------------------------------------------------------  FLOPSF   1288
C      LOCAL VARIABLES                                                  FLOPSF   1289
C      ===============                                                  FLOPSF   1290
C                                                                       FLOPSF   1291
       INTEGER       TAGVAL, TGVAL4                                     FLOPSF   1292
       INTEGER       JIMTID(2)                                          FLOPSF   1293
C                                                                       FLOPSF   1294
       CHARACTER*8   CIMTID                                             FLOPSF   1295
       CHARACTER*16  BSNAM                                              FLOPSF   1296
       CHARACTER*132 BIN                                                FLOPSF   1297
C                                                                       FLOPSF   1298
       EQUIVALENCE   (CIMTID, JIMTID(1))                                FLOPSF   1299
C---------------------------------------------------------------------  FLOPSF   1300
C                                                       INITIALIZATION  FLOPSF   1301
C                                                                       FLOPSF   1302
       NMIMTR = 0                                                       FLOPSF   1303
       CALL INVPSF (LUN, 'BSEC', NBUS, 1)                               FLOPSF   1304
C---------------------------------------------------------------------  FLOPSF   1305
C                   READ A RECORD OF IM DATA AND STORE IN COMMON BLOCK  FLOPSF   1306
C                                                                       FLOPSF   1307
1202   READ (IUNIT, '(A)', ERR = 8999, END = 9999) BIN                  FLOPSF   1308
C                                                                       FLOPSF   1309
       IF (BIN .EQ. ' ') GOTO 1202                                      FLOPSF   1310
       IF (BIN .EQ. 'ENDDAT') GOTO 9999                                 FLOPSF   1311
C                                                                       FLOPSF   1312
       IPFA = 0                                                         FLOPSF   1313
       STR = 0.01                                                       FLOPSF   1314
       STX = 0.12                                                       FLOPSF   1315
       RTR = 0.025                                                      FLOPSF   1316
       RTX = 0.1                                                        FLOPSF   1317
       XMG = 2.0                                                        FLOPSF   1318
       CLM = 2.0                                                        FLOPSF   1319
       BMCMVA = SBASE                                                   FLOPSF   1320
       BKVMC = 1.0                                                      FLOPSF   1321
C                                                                       FLOPSF   1322
       IF (IBCODE .EQ. 2) THEN                                          FLOPSF   1323
         READ (BIN, *, ERR = 8999, END = 1210)                          FLOPSF   1324
     +         BSNAM, CIMTID, IPFA, STR, STX, RTR, RTX, XMG,            FLOPSF   1325
     +         CLM, BMCMVA, BKVMC                                       FLOPSF   1326
1210     IBUS = TGVAL4 (BSNAM, NBUS, IBNAME, IBNMTG, NDX)               FLOPSF   1327
       ELSE                                                             FLOPSF   1328
         IF (IBCODE .EQ. 1) THEN                                        FLOPSF   1329
           READ (BIN, *, ERR = 8999, END = 1220)                        FLOPSF   1330
     +         LFBNO, CIMTID, IPFA, STR, STX, RTR, RTX, XMG,            FLOPSF   1331
     +         CLM, BMCMVA, BKVMC                                       FLOPSF   1332
         ELSE                                                           FLOPSF   1333
           READ (BIN, *, ERR = 8999, END = 1220)                        FLOPSF   1334
     +         LFBNO, BSNAM, CIMTID, IPFA, STR, STX, RTR, RTX, XMG,     FLOPSF   1335
     +         CLM, BMCMVA, BKVMC                                       FLOPSF   1336
         ENDIF                                                          FLOPSF   1337
1220     IBUS = TAGVAL (LFBNO, NBUS, IBLFN, IBNUTG, NDX)                FLOPSF   1338
       ENDIF                                                            FLOPSF   1339
C---------------------------------------------------------------------  FLOPSF   1340
C                                       ENTER THE INDUCTION MOTOR DATA  FLOPSF   1341
C                                                                       FLOPSF   1342
5200   NMIMTR = NMIMTR + 1                                              FLOPSF   1343
       IMT = NMIMTR                                                     FLOPSF   1344
       IIMBUS(IMT) = IBUS                                               FLOPSF   1345
       IOFSET = (NMIMTR - 1) * 2                                        FLOPSF   1346
       IIMLID(IOFSET + 1) = JIMTID(1)                                   FLOPSF   1347
       IIMLID(IOFSET + 2) = JIMTID(2)                                   FLOPSF   1348
       RIMSTR(IMT) = STR                                                FLOPSF   1349
       RIMSTX(IMT) = STX                                                FLOPSF   1350
       RIMRTR(IMT) = RTR                                                FLOPSF   1351
       RIMRTX(IMT) = RTX                                                FLOPSF   1352
       RIMMGX(IMT) = XMG                                                FLOPSF   1353
       RIMMVA(IMT) = BMCMVA                                             FLOPSF   1354
       RIMBKV(IMT) = BKVMC                                              FLOPSF   1355
       GOTO 1202                                                        FLOPSF   1356
C---------------------------------------------------------------------  FLOPSF   1357
C                                                       ERROR HANDLING  FLOPSF   1358
C                                                                       FLOPSF   1359
8999   MSG(1) = ' ERROR READING THE FOLLOWING RECORD IN THE ' //        FLOPSF   1360
     +              'INDUCTION MOTOR DATA FILE.'                        FLOPSF   1361
       MSG(2) = BIN                                                     FLOPSF   1362
       CALL PRTMSG (2)                                                  FLOPSF   1363
       GOTO 1202                                                        FLOPSF   1364
C---------------------------------------------------------------------  FLOPSF   1365
9999   RETURN                                                           FLOPSF   1366
       END                                                              FLOPSF   1367
C*********************************************************************  FLOPSF   1368
       SUBROUTINE INMMDL (ILD, IMT, PIM, V1, SBASE, QIM, *)             FLOPSF   1369
C---------------------------------------------------------------------  FLOPSF   1370
CD  FUNCTION                                                            FLOPSF   1371
CD  ========                                                            FLOPSF   1372
CD  THIS SUBROUTINE COMPUTES THE REACTIVE POWER CONSUMED BY THE         FLOPSF   1373
CD  INDUCTION MOTOR AT THE SPECIFIED REAL POWER LOADING AND TERMINAL    FLOPSF   1374
CD  VOLTAGE.                                                            FLOPSF   1375
CD                                                                      FLOPSF   1376
CD  CALLING SEQUENCE                                                    FLOPSF   1377
CD  ================                                                    FLOPSF   1378
CD     ARGUMENT     TYPE     DESCRIPTION                                FLOPSF   1379
CD     ========     ====     ===========                                FLOPSF   1380
CD     ILD          I*4      I: LOAD RECORD NUMBER                      FLOPSF   1381
CD     IMT          I*4      I: INDUCTION MOTOR RECORD NUMBER           FLOPSF   1382
CD     PIM          R*4      I: INDUCTION MOTOR REAL POWER IN PU        FLOPSF   1383
CD     V1           R*4      I: INDUCTION MOTOR TERMINAL VOLTAGE        FLOPSF   1384
CD                              MAGNITUDE IN PU                         FLOPSF   1385
CD     SBASE        R*4      I: BASE MVA OF THE SYSTEM                  FLOPSF   1386
CD     QIM          R*4      O: INDUCTION MOTOR REACTIVE POWER IN PU    FLOPSF   1387
CD     *                        ERROR RETURN                            FLOPSF   1388
CD                                                                      FLOPSF   1389
C---------------------------------------------------------------------  FLOPSF   1390
C                                                                       FLOPSF   1391
      INCLUDE 'CNMSG.INS'                                               FLOPSF   1392
      INCLUDE 'PARX.INS'                                                FLOPSF   1393
C                                                                       FLOPSF   1394
C                                                                       FLOPSF   1395
       INTEGER*2     ILDMDL(5*NB), ILDBUS(NB), IIMBUS(NB)               FLOPSF   1396
       INTEGER       ILDID(2*NB), IIMLID(2*NB)                          FLOPSF   1397
       REAL          RLMA(300), RLMB(300), RLMM(300), RLMN(300),        FLOPSF   1398
     +               RIMBKV(NB), RIMMVA(NB), RIMSTR(NB), RIMSTX(NB),    FLOPSF   1399
     +               RIMRTR(NB), RIMRTX(NB), RIMMGX(NB)                 FLOPSF   1400
       COMPLEX       CLDPQ(5*NB)                                        FLOPSF   1401
       COMMON /SCRAT6/ CLDPQ, ILDMDL, ILDBUS, ILDID, RLMA, RLMB,        FLOPSF   1402
     +                 RLMM, RLMN, NMIMTR, IIMBUS, IIMLID, RIMBKV,      FLOPSF   1403
     +                 RIMMVA, RIMSTR, RIMSTX, RIMRTR, RIMRTX, RIMMGX   FLOPSF   1404
C                                                                       FLOPSF   1405
       INTEGER*2     IBNUTG(NB), IBNMTG(NB), IBSCTN(MSEL)               FLOPSF   1406
       INTEGER       IBLFN(NB), IBNAME(4*NB)                            FLOPSF   1407
       COMMON /SCRAT2/ IBLFN, IBNAME, IBNUTG, IBNMTG, IBSCTN            FLOPSF   1408
C---------------------------------------------------------------------  FLOPSF   1409
C      LOCAL VARIABLES                                                  FLOPSF   1410
C      ===============                                                  FLOPSF   1411
C                                                                       FLOPSF   1412
       INTEGER       IBSNAM(4), ILODID(2)                               FLOPSF   1413
C                                                                       FLOPSF   1414
       CHARACTER*8   CLODID                                             FLOPSF   1415
       CHARACTER*16  BUSNAM                                             FLOPSF   1416
C                                                                       FLOPSF   1417
       EQUIVALENCE   (BUSNAM, IBSNAM(1))                                FLOPSF   1418
       EQUIVALENCE   (CLODID, ILODID(1))                                FLOPSF   1419
C---------------------------------------------------------------------  FLOPSF   1420
C                                                       INITIALIZATION  FLOPSF   1421
C                                                                       FLOPSF   1422
       IF (PIM .LE. 0.0) THEN                                           FLOPSF   1423
         QIM = 0.0                                                      FLOPSF   1424
         GOTO 9999                                                      FLOPSF   1425
       ENDIF                                                            FLOPSF   1426
C                                                                       FLOPSF   1427
       IBUS = IIMBUS(IMT)                                               FLOPSF   1428
       DLTPC = -1.0                                                     FLOPSF   1429
       PCNEW = 0.0                                                      FLOPSF   1430
C                                                                       FLOPSF   1431
       IOFSET = (IBUS - 1) * 4                                          FLOPSF   1432
       DO 1102 II = 1, 4                                                FLOPSF   1433
         IBSNAM(II) = IBNAME(IOFSET + II)                               FLOPSF   1434
1102   CONTINUE                                                         FLOPSF   1435
C                                                                       FLOPSF   1436
       IOFSET = (ILD - 1) * 2                                           FLOPSF   1437
       ILODID(1) = ILDID(IOFSET + 1)                                    FLOPSF   1438
       ILODID(2) = ILDID(IOFSET + 2)                                    FLOPSF   1439
C---------------------------------------------------------------------  FLOPSF   1440
C                               CHANGE MOTOR PARAMETERS TO SYSTEM BASE  FLOPSF   1441
C                                                                       FLOPSF   1442
       ZFACTR = RIMBKV(IMT) * RIMBKV(IMT) * SBASE  / RIMMVA(IMT)        FLOPSF   1443
C                                                                       FLOPSF   1444
       RS = RIMSTR(IMT) * ZFACTR                                        FLOPSF   1445
       XS = RIMSTX(IMT) * ZFACTR                                        FLOPSF   1446
       RR = RIMRTR(IMT) * ZFACTR                                        FLOPSF   1447
       XR = RIMRTX(IMT) * ZFACTR                                        FLOPSF   1448
       XM = RIMMGX(IMT) * ZFACTR                                        FLOPSF   1449
C---------------------------------------------------------------------  FLOPSF   1450
C                             ENSURE THAT INDUCTION MOTOR POWER DEMAND  FLOPSF   1451
C                                    IS LESS THAN THE MAXIMUM POSSIBLE  FLOPSF   1452
C                                                                       FLOPSF   1453
       X1 = XR + (RS * RS * XM + XS * XM * (XS + XM)) /                 FLOPSF   1454
     +      (RS * RS + (XS + XM) * (XS + XM))                           FLOPSF   1455
       PMAX = V1 * V1 / (2 * X1)                                        FLOPSF   1456
C                                                                       FLOPSF   1457
       IF (PIM .GT. PMAX) THEN                                          FLOPSF   1458
         MSG(1) = 'FOR THE MOTOR AT BUS : ------     ' //               FLOPSF   1459
     +            '----------------     LOAD ID : --------'             FLOPSF   1460
         WRITE (MSG(1)(24:29), '(I6)') IBLFN(IBUS)                      FLOPSF   1461
         MSG(1)(35:50) = BUSNAM                                         FLOPSF   1462
         MSG(1)(66:73) = CLODID                                         FLOPSF   1463
         MSG(2) = ' POWER DEMAND EXCEEDS MAXIMUM POWER'                 FLOPSF   1464
         CALL PRTMSG (2)                                                FLOPSF   1465
         GOTO 8999                                                      FLOPSF   1466
       ENDIF                                                            FLOPSF   1467
C---------------------------------------------------------------------  FLOPSF   1468
C              INITIAL ESTIMATION OF THE ROTOR RESISTANCE (RRR = RR/S)  FLOPSF   1469
C                                          ASSUMING RS = 0 AND XE = XR  FLOPSF   1470
C                                                                       FLOPSF   1471
       FACTOR = V1 ** 4 - 4 * (XS + XR) * (XS + XR) * PIM * PIM         FLOPSF   1472
       IF (FACTOR .GT. 0.0) THEN                                        FLOPSF   1473
         RRR = (V1 * V1 + SQRT (FACTOR)) / (2.0 * PIM)                  FLOPSF   1474
       ELSE                                                             FLOPSF   1475
         RRR = V1 * V1 / (2.0 * PIM)                                    FLOPSF   1476
       ENDIF                                                            FLOPSF   1477
C---------------------------------------------------------------------  FLOPSF   1478
C                   SOLVE FOR ROTOR RESISTANCE IN AN ITERATIVE FASHION  FLOPSF   1479
C                                                                       FLOPSF   1480
       ITN = 0                                                          FLOPSF   1481
1200   ITN = ITN + 1                                                    FLOPSF   1482
C                                                                       FLOPSF   1483
       IF (ITN .GT. 50) THEN                                            FLOPSF   1484
         MSG(1) = 'FOR THE MOTOR AT BUS : ------     ' //               FLOPSF   1485
     +            '----------------     LOAD ID : --------'             FLOPSF   1486
         WRITE (MSG(1)(24:29), '(I6)') IBLFN(IBUS)                      FLOPSF   1487
         MSG(1)(35:50) = BUSNAM                                         FLOPSF   1488
         MSG(1)(66:73) = CLODID                                         FLOPSF   1489
         MSG(2) = ' NUMBER OF ITERATIONS FOR COMPUTING THE ' //         FLOPSF   1490
     +            'MVAR EXCEEDS THE MAXIMUM'                            FLOPSF   1491
         CALL PRTMSG(2)                                                 FLOPSF   1492
         GOTO 8999                                                      FLOPSF   1493
       ENDIF                                                            FLOPSF   1494
C                                                SQUARE OF ROTOR EQ. Z  FLOPSF   1495
       RZE2 = (RRR * RRR + (XR + XM) * (XR + XM))                       FLOPSF   1496
       RE = (RRR * XM * XM) / RZE2                                      FLOPSF   1497
       XE = (RRR * RRR * XM + XR * XM * (XR + XM)) / RZE2               FLOPSF   1498
C                                               SQUARE OF STATOR EQ. Z  FLOPSF   1499
       SZE2 = (RS + RE) * (RS + RE) + (XS + XE) * (XS + XE)             FLOPSF   1500
C                                           COMPUTED INPUT POWER TO IM  FLOPSF   1501
       PCOLD = PCNEW                                                    FLOPSF   1502
       PCNEW = (V1 * V1 / SZE2) * (RS + RE)                             FLOPSF   1503
       FACTOR = DLTPC * (PCNEW - PCOLD)                                 FLOPSF   1504
       IF (FACTOR .GT. 0) THEN                                          FLOPSF   1505
         MSG(1) = 'FOR THE MOTOR AT BUS : ------     ' //               FLOPSF   1506
     +            '----------------     LOAD ID : --------'             FLOPSF   1507
         WRITE (MSG(1)(24:29), '(I6)') IBLFN(IBUS)                      FLOPSF   1508
         MSG(1)(35:50) = BUSNAM                                         FLOPSF   1509
         MSG(1)(66:73) = CLODID                                         FLOPSF   1510
         MSG(2) = ' POWER DEMAND IS TOO HIGH - CONVERGENCE ' //         FLOPSF   1511
     +            'WILL NOT OCCUR'                                      FLOPSF   1512
         CALL PRTMSG (2)                                                FLOPSF   1513
         GOTO 8999                                                      FLOPSF   1514
       ENDIF                                                            FLOPSF   1515
C                                  DENOMINATOR FOR COMPUTING A3 AND A4  FLOPSF   1516
       DNMTR = RRR * RRR + (XR + XM) * (XR + XM)                        FLOPSF   1517
       DNMTR = DNMTR * DNMTR                                            FLOPSF   1518
C                                                               DP/DRE  FLOPSF   1519
       A1 = ((XS + XE) * (XS + XE) - (RS + RE) * (RS + RE)) * V1 * V1   FLOPSF   1520
     +      / (SZE2 * SZE2)                                             FLOPSF   1521
C                                                               DP/DXE  FLOPSF   1522
       A2 = (-2.0 * (RS + RE) * (XS + XE) * V1 * V1) / (SZE2 * SZE2)    FLOPSF   1523
C                                                             DRE/DRRR  FLOPSF   1524
       A3 = (XM * XM) * ((XR + XM) * (XR * XM) - RRR * RRR) / DNMTR     FLOPSF   1525
C                                                             DXE/DRRR  FLOPSF   1526
       A4 = 2.0 * RRR * XM * XM * (XR + XM) / DNMTR                     FLOPSF   1527
C                                                              DP/DRRR  FLOPSF   1528
       DPDRRR = A1 * A3 + A2 * A4                                       FLOPSF   1529
C                                                                       FLOPSF   1530
       DLTPC = PCNEW - PIM                                              FLOPSF   1531
       DLTRRR = DLTPC / DPDRRR                                          FLOPSF   1532
       IF (ABS (DLTRRR) .GT. 0.0001) THEN                               FLOPSF   1533
         RRR = RRR - DLTRRR                                             FLOPSF   1534
         GOTO 1200                                                      FLOPSF   1535
       ENDIF                                                            FLOPSF   1536
C---------------------------------------------------------------------  FLOPSF   1537
C                                          CHECK IF THE SLIP IS NORMAL  FLOPSF   1538
C                                                                       FLOPSF   1539
       SLIP = RR / RRR                                                  FLOPSF   1540
       IF (SLIP .LE. 0.0 .OR. SLIP .GT. 1.0) THEN                       FLOPSF   1541
         MSG(1) = 'FOR THE MOTOR AT BUS : ------     ' //               FLOPSF   1542
     +            '----------------     LOAD ID : --------'             FLOPSF   1543
         WRITE (MSG(1)(24:29), '(I6)') IBLFN(IBUS)                      FLOPSF   1544
         MSG(1)(35:50) = BUSNAM                                         FLOPSF   1545
         MSG(1)(66:73) = CLODID                                         FLOPSF   1546
         MSG(2) = ' SLIP IS NOT BETWEEN 0.0 AND 1.0'                    FLOPSF   1547
         CALL PRTMSG (2)                                                FLOPSF   1548
         GOTO 8999                                                      FLOPSF   1549
       ENDIF                                                            FLOPSF   1550
C---------------------------------------------------------------------  FLOPSF   1551
C                                                  COMPUTE THE IM MVAR  FLOPSF   1552
C                                                                       FLOPSF   1553
       QIM = (V1 * V1 / SZE2) * (XS + XE)                               FLOPSF   1554
       GOTO 9999                                                        FLOPSF   1555
C---------------------------------------------------------------------  FLOPSF   1556
C                                                         ERROR RETURN  FLOPSF   1557
C                                                                       FLOPSF   1558
8999   MSG(1) = ' THE ABOVE INDUCTION MOTOR LOAD WILL BE IGNORED'       FLOPSF   1559
       MSG(2) = ' PLEASE CHECK THE DATA'                                FLOPSF   1560
       CALL PRTMSG (2)                                                  FLOPSF   1561
       RETURN 1                                                         FLOPSF   1562
C---------------------------------------------------------------------  FLOPSF   1563
9999   RETURN                                                           FLOPSF   1564
       END                                                              FLOPSF   1565
C*********************************************************************  FLOPSF   1566
       SUBROUTINE PSFBRN (IBTYPE, IPOS, NLINES, IFLNO, IEBK)            FLOPSF   1567
C---------------------------------------------------------------------  FLOPSF   1568
CD  FUNCTION                                                            FLOPSF   1569
CD  ========                                                            FLOPSF   1570
CD  THIS SUBROUTINE LOADS PSF DATA INTO ETMSP BRANCH ARRAYS             FLOPSF   1571
CD                                                                      FLOPSF   1572
CD  CALLING SEQUENCE                                                    FLOPSF   1573
CD  ================                                                    FLOPSF   1574
CD     ARGUMENT     TYPE     DESCRIPTION                                FLOPSF   1575
CD     ========     ====     ===========                                FLOPSF   1576
CD     IBTYPE       I*4      I: BRANCH TYPE                             FLOPSF   1577
CD     IPOS         I*4      I/O:                                       FLOPSF   1578
CD     NLINES       I*4      I/O:                                       FLOPSF   1579
CD     IFLNO        I*4      O: FILE RECORD NUMBER                      FLOPSF   1580
CD     IEBK         I*4      O: ERROR FLAG                              FLOPSF   1581
CD                                                                      FLOPSF   1582
C---------------------------------------------------------------------  FLOPSF   1583
      INCLUDE 'PSFNAM.INS'                                              FLOPSF   1584
      INCLUDE 'PARX.INS'                                                FLOPSF   1585
      INCLUDE 'CNPARX.INS'                                              FLOPSF   1586
      INCLUDE 'CNMNEW.INS'                                              FLOPSF   1587
      INCLUDE 'CNIPTR.INS'                                              FLOPSF   1588
      INCLUDE 'CNLFDA.INS'                                              FLOPSF   1589
      INCLUDE 'CNSELI.INS'                                              FLOPSF   1590
      INCLUDE 'CNPT.INS'                                                FLOPSF   1591
      INCLUDE 'CNFLAG.INS'                                              FLOPSF   1592
      INCLUDE 'CNB19.INS'                                               FLOPSF   1593
      INCLUDE 'CNUNIT.INS'                                              FLOPSF   1594
      INCLUDE 'CNULTC.INS'                                              FLOPSF   1595
      INCLUDE 'CNMSG.INS'                                               FLOPSF   1596
C                                                                       FLOPSF   1597
       INTEGER*2     IBNUTG(NB), IBNMTG(NB), IBSCTN(MSEL)               FLOPSF   1598
       INTEGER       IBLFN(NB), IBNAME(4*NB)                            FLOPSF   1599
       COMMON /SCRAT2/ IBLFN, IBNAME, IBNUTG, IBNMTG, IBSCTN            FLOPSF   1600
C---------------------------------------------------------------------  FLOPSF   1601
C      LOCAL VARIABLES                                                  FLOPSF   1602
C      ===============                                                  FLOPSF   1603
C                                                                       FLOPSF   1604
       INTEGER*2     ILNFEN(NPL*2), ISECPT(NB2*2), IBRSTA(NB2),         FLOPSF   1605
     +               ILSCT(NB2), INSEC(MSEL/2+1), IULMEN (NB*9/6),      FLOPSF   1606
     +               IULCB1(NB*9/6), IULCFL(NB*9/6), IULTB1(NB*9/6),    FLOPSF   1607
     +               IULAS1(NB*9/6), ITCTBL(200)                        FLOPSF   1608
       INTEGER*2     ISTTBT(100), ISTTBP(100)                           FLOPSF   1609
C                                                                       FLOPSF   1610
       INTEGER       IBRNID(NB2*2), IBRN(MSEL)                          FLOPSF   1611
       INTEGER       JCKID                                              FLOPSF   1612
C                                                                       FLOPSF   1613
       LOGICAL       PRTFLG                                             FLOPSF   1614
C                                                                       FLOPSF   1615
       REAL          RTRONR(NB2), RTRAN1(NB2), RULSTP(NB*9/6),          FLOPSF   1616
     +               RULMXR(NB*9/6), RULMNR(NB*9/6), RULXA1(NB*9/6),    FLOPSF   1617
     +               RULNA1(NB*9/6), RULVH1(NB*9/6), RULVL1(NB*9/6),    FLOPSF   1618
     +               RULPH1(NB*9/6), RULPL1(NB*9/6), RULQH1(NB*9/6),    FLOPSF   1619
     +               RULQL1(NB*9/6), RFCX(100), RSCX(100)               FLOPSF   1620
C                                                                       FLOPSF   1621
       REAL          RTCT(440), RTCF(440), RSTTCR(100), RSTATT(100),    FLOPSF   1622
     +               RSTPSR(100), RSTATP(100), RSTXTT(100),             FLOPSF   1623
     +               RSTXTP(100)                                        FLOPSF   1624
C                                                                       FLOPSF   1625
       REAL          PI, PP, QQ, TT(2)                                  FLOPSF   1626
C                                                                       FLOPSF   1627
       COMPLEX       CBRZ(NB2), CBRCHR(NB2), CBRSHF(NB2), CBRSHT(NB2)   FLOPSF   1628
       COMPLEX       ZCX(20), Y1CX(20), Y2CX(20)                        FLOPSF   1629
       COMPLEX       PQ, A1, A2, CRATIO                                 FLOPSF   1630
C                                                                       FLOPSF   1631
       CHARACTER*2   ALFA(9), ID                                        FLOPSF   1632
       CHARACTER*8   CKTID(NB2)                                         FLOPSF   1633
C                                                                       FLOPSF   1634
       COMMON /SCRAT0/ ILNFEN, ISECPT, IBRSTA, CBRZ, RFCX, RSCX         FLOPSF   1635
       COMMON /SCRAT3/ CBRCHR, CBRSHF, CBRSHT, IBRNID, IBRN, ILSCT,     FLOPSF   1636
     +                 INSEC                                            FLOPSF   1637
       COMMON /SCRAT6/ RTRONR, RTRAN1, IULMEN, IULCB1, IULCFL, IULTB1,  FLOPSF   1638
     +                 IULAS1, RULSTP, RULMXR, RULMNR, RULXA1, RULNA1,  FLOPSF   1639
     +                 RULVH1, RULVL1, RULPH1, RULPL1, RULQH1, RULQL1,  FLOPSF   1640
     +                 ITCTBL, ISTTBT, ISTTBP, RSTTCR, RSTATT, RSTPSR,  FLOPSF   1641
     +                 RSTATP,  RSTXTT, RSTXTP, RTCT, RTCF              FLOPSF   1642
C                                                                       FLOPSF   1643
       EQUIVALENCE   (CKTID(1), IBRNID(1))                              FLOPSF   1644
       EQUIVALENCE   (PQ, PP, TT(1)), (QQ, TT(2))                       FLOPSF   1645
C                                                                       FLOPSF   1646
       DATA ALFA / '1', '2', '3', '4', '5', '6', '7', '8', '9' /        FLOPSF   1647
C---------------------------------------------------------------------  FLOPSF   1648
C                                                       INITIALIZATION  FLOPSF   1649
C                                                                       FLOPSF   1650
       LUN = LUNPSF(IFLNO)                                              FLOPSF   1651
C                                                                       FLOPSF   1652
       LDEB = (JDEB(2) .NE. 0)                                          FLOPSF   1653
C                                                                       FLOPSF   1654
       REQ = 0.0                                                        FLOPSF   1655
       XEQ = 0.0                                                        FLOPSF   1656
       RMA = 0.0                                                        FLOPSF   1657
       RMI = 0.0                                                        FLOPSF   1658
       VMA = 0.0                                                        FLOPSF   1659
       VMI = 0.0                                                        FLOPSF   1660
       STEPI = 0.0                                                      FLOPSF   1661
C                                                                       FLOPSF   1662
       RADG = 180.0 / 3.141592654                                       FLOPSF   1663
C                                                                       FLOPSF   1664
       PRTFLG = .TRUE.                                                  FLOPSF   1665
C                                                                       FLOPSF   1666
       CALL INVPSF (LUN, 'LSEC', NLINE, 1)                              FLOPSF   1667
       CALL INVPSF (LUN, 'FTSEC', NTR1X, 1)                             FLOPSF   1668
       CALL INVPSF (LUN, 'ULSEC', NTR2X, 1)                             FLOPSF   1669
       CALL INVPSF (LUN, 'FCSEC', NFXSC, 1)                             FLOPSF   1670
       CALL INVPSF (LUN, 'SCSEC', NSCAP, 1)                             FLOPSF   1671
       CALL INVPSF (LUN, 'STPSEC', NSTP, 1)                             FLOPSF   1672
C---------------------------------------------------------------------  FLOPSF   1673
C                                         READ THE REQUIRED PSF ARRAYS  FLOPSF   1674
C                                                                       FLOPSF   1675
       IF (IBTYPE .EQ. 1) THEN                                          FLOPSF   1676
C                                                                       FLOPSF   1677
         CALL RDPSFI (LUN, 'LNFEN', ILNFEN)                             FLOPSF   1678
         CALL RDPSFI (LUN, 'SECPT', ISECPT)                             FLOPSF   1679
C                                                                       FLOPSF   1680
         NBR = NLINE                                                    FLOPSF   1681
         IOFSET = 0                                                     FLOPSF   1682
         NL = 0                                                         FLOPSF   1683
C                                                                       FLOPSF   1684
         CALL RDPSFI (LUN, 'LSTAT', IBRSTA)                             FLOPSF   1685
         CALL RDPSFX (LUN, 'LZ', CBRZ)                                  FLOPSF   1686
         CALL RDPSFX (LUN, 'LCHRG', CBRCHR)                             FLOPSF   1687
         CALL RDPSFX (LUN, 'LSHFR', CBRSHF)                             FLOPSF   1688
         CALL RDPSFX (LUN, 'LSHTO', CBRSHT)                             FLOPSF   1689
         CALL RDPSFJ (LUN, 'LCID', IBRNID)                              FLOPSF   1690
         CALL RDPSFI (LUN, 'LSCT', ILSCT)                               FLOPSF   1691
C                                                                       FLOPSF   1692
         CALL RDPSFR (LUN, 'FCX', RFCX)                                 FLOPSF   1693
         CALL RDPSFR (LUN, 'SCX', RSCX)                                 FLOPSF   1694
C                                                                       FLOPSF   1695
         CALL RDPSFI (LUN, 'NSEC', INSEC)                               FLOPSF   1696
         CALL RDPSFJ (LUN, 'BRN', IBRN)                                 FLOPSF   1697
C                                                                       FLOPSF   1698
       ELSE IF (IBTYPE .EQ. 2) THEN                                     FLOPSF   1699
C                                                                       FLOPSF   1700
         NBR = NTR1X                                                    FLOPSF   1701
         IOFSET = NLINE                                                 FLOPSF   1702
         ITRF = 0                                                       FLOPSF   1703
         ITRF2 = 0                                                      FLOPSF   1704
         IF (NTR1X .EQ. 0) GOTO 9999                                    FLOPSF   1705
C                                                                       FLOPSF   1706
         CALL RDPSFI (LUN, 'FTSTA', IBRSTA)                             FLOPSF   1707
         CALL RDPSFX (LUN, 'FTZ', CBRZ)                                 FLOPSF   1708
         CALL RDPSFX (LUN, 'FTCHR', CBRCHR)                             FLOPSF   1709
         CALL RDPSFX (LUN, 'FTMG1', CBRSHF)                             FLOPSF   1710
         CALL RDPSFX (LUN, 'FTMG2', CBRSHT)                             FLOPSF   1711
         CALL RDPSFJ (LUN, 'FTBID', IBRNID)                             FLOPSF   1712
C                                                                       FLOPSF   1713
         CALL RDPSFR (LUN, 'FTONR', RTRONR)                             FLOPSF   1714
         CALL RDPSFR (LUN, 'FTAN1', RTRAN1)                             FLOPSF   1715
C                                                                       FLOPSF   1716
       ELSE IF (IBTYPE .EQ. 3) THEN                                     FLOPSF   1717
C                                                                       FLOPSF   1718
         NBR = NTR2X                                                    FLOPSF   1719
         IOFSET = NLINE + NTR1X                                         FLOPSF   1720
         NSC = 0                                                        FLOPSF   1721
         NSC9 = 0                                                       FLOPSF   1722
         IF (NTR2X .EQ. 0) GOTO 9999                                    FLOPSF   1723
C                                                                       FLOPSF   1724
         CALL RDPSFI (LUN, 'ULSTA', IBRSTA)                             FLOPSF   1725
         CALL RDPSFX (LUN, 'ULZ', CBRZ)                                 FLOPSF   1726
         CALL RDPSFX (LUN, 'ULCHR', CBRCHR)                             FLOPSF   1727
         CALL RDPSFX (LUN, 'ULMG1', CBRSHF)                             FLOPSF   1728
         CALL RDPSFX (LUN, 'ULMG2', CBRSHT)                             FLOPSF   1729
         CALL RDPSFJ (LUN, 'ULBID', IBRNID)                             FLOPSF   1730
C                                                                       FLOPSF   1731
         CALL RDPSFR (LUN, 'ULONR', RTRONR)                             FLOPSF   1732
         CALL RDPSFR (LUN, 'ULAN1', RTRAN1)                             FLOPSF   1733
C                                                                       FLOPSF   1734
         CALL RDPSFI (LUN, 'ULMEN', IULMEN)                             FLOPSF   1735
         CALL RDPSFI (LUN, 'ULCB1', IULCB1)                             FLOPSF   1736
         CALL RDPSFI (LUN, 'ULCFL', IULCFL)                             FLOPSF   1737
         CALL RDPSFI (LUN, 'ULTB1', IULTB1)                             FLOPSF   1738
         CALL RDPSFI (LUN, 'ULAS1', IULAS1)                             FLOPSF   1739
         CALL RDPSFR (LUN, 'ULSTP', RULSTP)                             FLOPSF   1740
         CALL RDPSFR (LUN, 'ULMXR', RULMXR)                             FLOPSF   1741
         CALL RDPSFR (LUN, 'ULMNR', RULMNR)                             FLOPSF   1742
         CALL RDPSFR (LUN, 'ULXA1', RULXA1)                             FLOPSF   1743
         CALL RDPSFR (LUN, 'ULNA1', RULNA1)                             FLOPSF   1744
         CALL RDPSFR (LUN, 'ULVH1', RULVH1)                             FLOPSF   1745
         CALL RDPSFR (LUN, 'ULVL1', RULVL1)                             FLOPSF   1746
         CALL RDPSFR (LUN, 'ULPH1', RULPH1)                             FLOPSF   1747
         CALL RDPSFR (LUN, 'ULPL1', RULPL1)                             FLOPSF   1748
         CALL RDPSFR (LUN, 'ULQH1', RULQH1)                             FLOPSF   1749
         CALL RDPSFR (LUN, 'ULQL1', RULQL1)                             FLOPSF   1750
C                                                                       FLOPSF   1751
         CALL RDPSFI (LUN, 'TCTBL', ITCTBL)                             FLOPSF   1752
C                                                                       FLOPSF   1753
       ELSE IF (IBTYPE .EQ. -10) THEN                                   FLOPSF   1754
C                                                                       FLOPSF   1755
         NBR = NFXSC                                                    FLOPSF   1756
         IOFSET = NLINE + NTR1X + NTR2X                                 FLOPSF   1757
         IF (NFXSC .EQ. 0) GOTO 9999                                    FLOPSF   1758
C                                                                       FLOPSF   1759
         CALL RDPSFI (LUN, 'FCSTA', IBRSTA)                             FLOPSF   1760
         CALL RDPSFR (LUN, 'FCX', RSCX)                                 FLOPSF   1761
         CALL RDPSFJ (LUN, 'FCCID', IBRNID)                             FLOPSF   1762
         CALL RDPSFI (LUN, 'FCSCT', ILSCT)                              FLOPSF   1763
C                                                                       FLOPSF   1764
         CALL RDPSFX (LUN, 'LZ', CBRZ)                                  FLOPSF   1765
         CALL RDPSFX (LUN, 'LCHRG', CBRCHR)                             FLOPSF   1766
         CALL RDPSFX (LUN, 'LSHFR', CBRSHF)                             FLOPSF   1767
         CALL RDPSFX (LUN, 'LSHTO', CBRSHT)                             FLOPSF   1768
C                                                                       FLOPSF   1769
         CALL RDPSFR (LUN, 'SCX', RSCX)                                 FLOPSF   1770
C                                                                       FLOPSF   1771
       ELSE IF (IBTYPE .EQ. -11) THEN                                   FLOPSF   1772
C                                                                       FLOPSF   1773
         NBR = NSCAP                                                    FLOPSF   1774
         IOFSET = NLINE + NTR1X + NTR2X + NFXSC                         FLOPSF   1775
         IF (NSCAP .EQ. 0) GOTO 9999                                    FLOPSF   1776
C                                                                       FLOPSF   1777
         CALL RDPSFI (LUN, 'SCSTA', IBRSTA)                             FLOPSF   1778
         CALL RDPSFR (LUN, 'SCX', RSCX)                                 FLOPSF   1779
         CALL RDPSFJ (LUN, 'SCCID', IBRNID)                             FLOPSF   1780
         CALL RDPSFI (LUN, 'SCSCT', ILSCT)                              FLOPSF   1781
C                                                                       FLOPSF   1782
         CALL RDPSFX (LUN, 'LZ', CBRZ)                                  FLOPSF   1783
         CALL RDPSFX (LUN, 'LCHRG', CBRCHR)                             FLOPSF   1784
         CALL RDPSFX (LUN, 'LSHFR', CBRSHF)                             FLOPSF   1785
         CALL RDPSFX (LUN, 'LSHTO', CBRSHT)                             FLOPSF   1786
C                                                                       FLOPSF   1787
         CALL RDPSFR (LUN, 'FCX', RFCX)                                 FLOPSF   1788
C                                                                       FLOPSF   1789
       ELSE IF (IBTYPE .EQ. 4) THEN                                     FLOPSF   1790
C                                                                       FLOPSF   1791
         NBR = NSTP                                                     FLOPSF   1792
         IOFSET = NLINE + NTR1X + NTR2X + NFXSC + NSCAP                 FLOPSF   1793
         IF (NSTP .EQ. 0) GOTO 9999                                     FLOPSF   1794
         IBTYPE = 2                                                     FLOPSF   1795
C                                                                       FLOPSF   1796
         CALL RDPSFI (LUN, 'STSTA', IBRSTA)                             FLOPSF   1797
         CALL RDPSFX (LUN, 'STZ', CBRZ)                                 FLOPSF   1798
         CALL RDPSFX (LUN, 'STCHR', CBRCHR)                             FLOPSF   1799
         CALL RDPSFX (LUN, 'STMGF', CBRSHF)                             FLOPSF   1800
         CALL RDPSFX (LUN, 'STMGT', CBRSHT)                             FLOPSF   1801
         CALL RDPSFJ (LUN, 'STBID', IBRNID)                             FLOPSF   1802
         CALL RDPSFR (LUN, 'STTCR', RSTTCR)                             FLOPSF   1803
         CALL RDPSFR (LUN, 'STPSR', RSTPSR)                             FLOPSF   1804
         CALL RDPSFR (LUN, 'STATT', RSTATT)                             FLOPSF   1805
         CALL RDPSFR (LUN, 'STATP', RSTATP)                             FLOPSF   1806
         CALL RDPSFR (LUN, 'STXTT', RSTXTT)                             FLOPSF   1807
         CALL RDPSFR (LUN, 'STXTP', RSTXTP)                             FLOPSF   1808
         CALL RDPSFI (LUN, 'STTBT', ISTTBT)                             FLOPSF   1809
         CALL RDPSFI (LUN, 'STTBP', ISTTBP)                             FLOPSF   1810
C                                                                       FLOPSF   1811
         CALL RDPSFR (LUN, 'TCT', RTCT)                                 FLOPSF   1812
         CALL RDPSFR (LUN, 'TCF', RTCF)                                 FLOPSF   1813
C                          COMPUTE EQ. FIXED TRANS. ONR AND AN1 ARRAYS  FLOPSF   1814
C                            ALONG WITH CORRECTED STP SERIES IMPEDANCE  FLOPSF   1815
         DO 1202 II = 1, NSTP                                           FLOPSF   1816
           TRATIO = RSTTCR(II) * RSTATT(II)                             FLOPSF   1817
           PRATIO = RSTPSR(II) * RSTATP(II)                             FLOPSF   1818
           AR2 = 1 - TRATIO * RSTXTT(II)                                FLOPSF   1819
           AR1 = AR2 + TRATIO                                           FLOPSF   1820
           IF (PRATIO .NE. 0.0) THEN                                    FLOPSF   1821
             AI2 = - PRATIO * RSTXTP(II)                                FLOPSF   1822
             AI1 = AI2 + PRATIO                                         FLOPSF   1823
           ELSE                                                         FLOPSF   1824
             AI2 = 0.0                                                  FLOPSF   1825
             AI1 = 0.0                                                  FLOPSF   1826
           ENDIF                                                        FLOPSF   1827
           A1 = CMPLX (AR1, AI1)                                        FLOPSF   1828
           A2 = CMPLX (AR2, AI2)                                        FLOPSF   1829
           CRATIO = A1 / A2                                             FLOPSF   1830
           RTRONR(II) = CABS (CRATIO)                                   FLOPSF   1831
           RTRAN1(II) = ATAN2 (AIMAG (CRATIO), REAL (CRATIO))           FLOPSF   1832
C                                                                       FLOPSF   1833
           IF (ISTTBT(II) .NE. 0) THEN                                  FLOPSF   1834
             VERTX = RSTTCR(II)                                         FLOPSF   1835
             IRECT = (ISTTBT(II) - 1) * 11 + 1                          FLOPSF   1836
             IRECF = (ISTTBT(II) - 1) * 11 + 1                          FLOPSF   1837
             CALL TRFCOR (RTCT(IRECT), RTCF(IRECF), VERTX, FACTOR)      FLOPSF   1838
             CBRZ(II) = CBRZ(II) * FACTOR                               FLOPSF   1839
           ENDIF                                                        FLOPSF   1840
           IF (ISTTBP(II) .NE. 0) THEN                                  FLOPSF   1841
             VERTX = RSTPSR(II)                                         FLOPSF   1842
             IRECT = (ISTTBP(II) - 1) * 11 + 1                          FLOPSF   1843
             IRECF = (ISTTBP(II) - 1) * 11 + 1                          FLOPSF   1844
             CALL TRFCOR (RTCT(IRECT), RTCF(IRECF), VERTX, FACTOR)      FLOPSF   1845
             CBRZ(II) = CBRZ(II) * FACTOR                               FLOPSF   1846
           ENDIF                                                        FLOPSF   1847
C                                                                       FLOPSF   1848
           CBRZ(II) = CBRZ(II) * A2 * CONJG(A2)                         FLOPSF   1849
C                                                                       FLOPSF   1850
1202     CONTINUE                                                       FLOPSF   1851
C                                                                       FLOPSF   1852
       ENDIF                                                            FLOPSF   1853
C---------------------------------------------------------------------  FLOPSF   1854
C                                  ENTER BRANCH DATA INTO ETMSP ARRAYS  FLOPSF   1855
C                                                                       FLOPSF   1856
       DO 5002 II = 1, NBR                                              FLOPSF   1857
C                                                                       FLOPSF   1858
         ISFLAG = 0                                                     FLOPSF   1859
C                                                SKIP IF BRANCH IS O/S  FLOPSF   1860
         IF (IBRSTA(II) .NE. 1) GOTO 5002                               FLOPSF   1861
C                                                                       FLOPSF   1862
         IBR = (IOFSET + II)                                            FLOPSF   1863
         IFR = ILNFEN(IBR * 2)                                          FLOPSF   1864
         ITO = ILNFEN(IBR * 2 - 1)                                      FLOPSF   1865
C                                                                       FLOPSF   1866
         IBUS = IBLFN(IFR)                                              FLOPSF   1867
         JBUS = IBLFN(ITO)                                              FLOPSF   1868
         ID = CKTID(II)(1:2)                                            FLOPSF   1869
         IF (MNEW(IBUS) .EQ. 0 .OR. MNEW(JBUS) .EQ. 0) THEN             FLOPSF   1870
           WRITE (MSG(1), 6104) IBUS, JBUS, ID                          FLOPSF   1871
           CALL PRTMSG (1)                                              FLOPSF   1872
           IEBK = 1                                                     FLOPSF   1873
           GOTO 5002                                                    FLOPSF   1874
         ENDIF                                                          FLOPSF   1875
C                                                 SECTIONALIZED BRANCH  FLOPSF   1876
         IF (ISECPT(IBR) .GT. 0) THEN                                   FLOPSF   1877
C                                       BRANCH CANNOT BE A TRANSFORMER  FLOPSF   1878
           IF (IBTYPE .EQ. 2 .OR. IBTYPE .EQ. 3) THEN                   FLOPSF   1879
             WRITE (MSG(1), 6204)                                       FLOPSF   1880
             WRITE (MSG(2), 6304)                                       FLOPSF   1881
             WRITE (MSG(3), 6404) IBUS, JBUS                            FLOPSF   1882
             CALL PRTMSG (3)                                            FLOPSF   1883
             IEBK = 1                                                   FLOPSF   1884
             GOTO 5002                                                  FLOPSF   1885
           ENDIF                                                        FLOPSF   1886
C                                        SKIP IF NOT THE FIRST SECTION  FLOPSF   1887
           IF (ILSCT(II) .NE. 1) GOTO 5002                              FLOPSF   1888
C---------------------------------------------------------------------  FLOPSF   1889
C                      STORE SECTIONALIZED LINE DATA INTO ETMSP ARRAYS  FLOPSF   1890
C                                                                       FLOPSF   1891
           ISFLAG = 1                                                   FLOPSF   1892
           ISCPT = ISECPT(IBR)                                          FLOPSF   1893
           IHEAD = INSEC(ISCPT)                                         FLOPSF   1894
           ITAIL = INSEC(ISCPT + 1) - 1                                 FLOPSF   1895
           ISCT = 0                                                     FLOPSF   1896
C                                                                       FLOPSF   1897
           NSEL = NSEL + 1                                              FLOPSF   1898
C                                                                       FLOPSF   1899
           IK=MNEW(IBUS)                                                FLOPSF   1900
           IJ=MNEW(JBUS)                                                FLOPSF   1901
           LCONE(1, NSEL) = IK                                          FLOPSF   1902
           LCONE(2, NSEL) = IJ                                          FLOPSF   1903
           LCONE(3, NSEL) = 1                                           FLOPSF   1904
           CCONE(4, NSEL) = ID                                          FLOPSF   1905
           LCONE(5, NSEL) = IPOS + 1                                    FLOPSF   1906
           LCONE(6, NSEL) = ITAIL - IHEAD + 1                           FLOPSF   1907
C                                                                       FLOPSF   1908
           DO 3002 IJ = IHEAD, ITAIL                                    FLOPSF   1909
C                                                                       FLOPSF   1910
             ISCT = ISCT + 1                                            FLOPSF   1911
             IPOS = IPOS + 1                                            FLOPSF   1912
             IBRSC = IBRN(IJ)                                           FLOPSF   1913
C                                       BRANCH CANNOT BE A TRANSFORMER  FLOPSF   1914
             IF ((IBRSC .GT. NLINE .AND.                                FLOPSF   1915
     +           IBRSC .LE. (NLINE + NTR1X + NTR2X))                    FLOPSF   1916
     +           .OR.                                                   FLOPSF   1917
     +           (IBRSC .GT. (NLINE + NTR1X + NTR2X + NFXSC + NSCAP))   FLOPSF   1918
     +           )THEN                                                  FLOPSF   1919
               WRITE (MSG(1), 6204)                                     FLOPSF   1920
               WRITE (MSG(2), 6304)                                     FLOPSF   1921
               WRITE (MSG(3), 6404) IBUS, JBUS                          FLOPSF   1922
               CALL PRTMSG (3)                                          FLOPSF   1923
               IEBK = 1                                                 FLOPSF   1924
               GOTO 3002                                                FLOPSF   1925
             ENDIF                                                      FLOPSF   1926
C                                                                       FLOPSF   1927
             IF (IBRSC .LE. NLINE) THEN                                 FLOPSF   1928
               PQ = CBRZ(IBRSC)                                         FLOPSF   1929
               RX = PP                                                  FLOPSF   1930
               XI = QQ                                                  FLOPSF   1931
               ZMAG = RX * RX + XI * XI                                 FLOPSF   1932
               PQ = CBRSHF(IBRSC)                                       FLOPSF   1933
               GI = PP                                                  FLOPSF   1934
               BI = QQ                                                  FLOPSF   1935
               PQ = CBRSHT(IBRSC)                                       FLOPSF   1936
               GJ = PP                                                  FLOPSF   1937
               BJ = QQ                                                  FLOPSF   1938
               PQ = CBRCHR(IBRSC)                                       FLOPSF   1939
               CHRG = QQ / 2                                            FLOPSF   1940
               BI = BI + CHRG                                           FLOPSF   1941
               BJ = BJ + CHRG                                           FLOPSF   1942
             ELSE IF (IBRSC .LE. (NLINE + NTR1X + NTR2X + NFXSC)) THEN  FLOPSF   1943
               RX = 0.0                                                 FLOPSF   1944
               IREC = IBRSC - (NLINE + NTR1X + NTR2X)                   FLOPSF   1945
               XI = RFCX(IREC)                                          FLOPSF   1946
               GI = 0.0                                                 FLOPSF   1947
               BI = 0.0                                                 FLOPSF   1948
               GJ = 0.0                                                 FLOPSF   1949
               BJ = 0.0                                                 FLOPSF   1950
             ELSE                                                       FLOPSF   1951
               RX = 0.0                                                 FLOPSF   1952
               IREC = IBRSC - (NLINE + NTR1X + NTR2X + NFXSC)           FLOPSF   1953
               XI = RSCX(IREC)                                          FLOPSF   1954
               GI = 0.0                                                 FLOPSF   1955
               BI = 0.0                                                 FLOPSF   1956
               GJ = 0.0                                                 FLOPSF   1957
               BJ = 0.0                                                 FLOPSF   1958
             ENDIF                                                      FLOPSF   1959
C                                                                       FLOPSF   1960
             ZCX(ISCT) = CMPLX (RX, XI)                                 FLOPSF   1961
             Y1CX(ISCT) = CMPLX (GI, BI)                                FLOPSF   1962
             Y2CX(ISCT) = CMPLX (GJ, BJ)                                FLOPSF   1963
C                                                                       FLOPSF   1964
             IF (IJ .EQ. ITAIL) THEN                                    FLOPSF   1965
               NEXTSL(1, IPOS) = 0                                      FLOPSF   1966
             ELSE                                                       FLOPSF   1967
               NEXTSL(1, IPOS) = IPOS + 1                               FLOPSF   1968
             ENDIF                                                      FLOPSF   1969
             CNEXTS(2, IPOS) = ALFA(IBSCTN(IJ))                         FLOPSF   1970
             NEXTSL(3, IPOS) = 0                                        FLOPSF   1971
             PSELIN(1, IPOS) = RX / ZMAG                                FLOPSF   1972
             PSELIN(2, IPOS) = XI / ZMAG                                FLOPSF   1973
             PSELIN(3, IPOS) = GI                                       FLOPSF   1974
             PSELIN(4, IPOS) = BI                                       FLOPSF   1975
             PSELIN(5, IPOS) = GJ                                       FLOPSF   1976
             PSELIN(6, IPOS) = BJ                                       FLOPSF   1977
C                                                                       FLOPSF   1978
3002       CONTINUE                                                     FLOPSF   1979
C                                                                       FLOPSF   1980
           CALL ABCD (ISCT, ZCX, Y1CX, Y2CX, REQ, XEQ, G1EQ, B1EQ,      FLOPSF   1981
     +                G2EQ, B2EQ)                                       FLOPSF   1982
C                                                                       FLOPSF   1983
           ZMAG = REQ * REQ + XEQ * XEQ                                 FLOPSF   1984
           EQPI(1, NSEL) = REQ / ZMAG                                   FLOPSF   1985
           EQPI(2, NSEL) = XEQ / ZMAG                                   FLOPSF   1986
           EQPI(3, NSEL) = G1EQ                                         FLOPSF   1987
           EQPI(4, NSEL) = B1EQ                                         FLOPSF   1988
           EQPI(5, NSEL) = G2EQ                                         FLOPSF   1989
           EQPI(6, NSEL) = B2EQ                                         FLOPSF   1990
           EQPI(7, NSEL) = 0.0                                          FLOPSF   1991
           EQPI(8, NSEL) = 0.0                                          FLOPSF   1992
           EQPI(9, NSEL) = 0.0                                          FLOPSF   1993
           EQPI(10, NSEL) = 0.0                                         FLOPSF   1994
           EQPI(11, NSEL) = 0.0                                         FLOPSF   1995
           EQPI(12, NSEL) = 0.0                                         FLOPSF   1996
C                                                                       FLOPSF   1997
         ENDIF                                                          FLOPSF   1998
C---------------------------------------------------------------------  FLOPSF   1999
         NL = NL + 1                                                    FLOPSF   2000
         IF (NL .GT. NXPL) THEN                                         FLOPSF   2001
           IF (PRTFLG) THEN                                             FLOPSF   2002
             WRITE (MSG(1), 6504) IBUS, JBUS, ID, NXPL                  FLOPSF   2003
             CALL PRTMSG (1)                                            FLOPSF   2004
             PRTFLG = .FALSE.                                           FLOPSF   2005
             IEBK = 1                                                   FLOPSF   2006
           ENDIF                                                        FLOPSF   2007
           GOTO 5002                                                    FLOPSF   2008
         ENDIF                                                          FLOPSF   2009
C                                                                       FLOPSF   2010
         IF (ISFLAG .EQ. 0) THEN                                        FLOPSF   2011
           IF (IBTYPE .EQ. -10) THEN                                    FLOPSF   2012
             RX = 0.0                                                   FLOPSF   2013
             XI = RFCX(II)                                              FLOPSF   2014
             CHRG = 0.0                                                 FLOPSF   2015
           ELSE IF (IBTYPE .EQ. -11) THEN                               FLOPSF   2016
             RX = 0.0                                                   FLOPSF   2017
             XI = RSCX(II)                                              FLOPSF   2018
             CHRG = 0.0                                                 FLOPSF   2019
           ELSE                                                         FLOPSF   2020
             PQ = CBRZ(II)                                              FLOPSF   2021
             RX = PP                                                    FLOPSF   2022
             XI = QQ                                                    FLOPSF   2023
             PQ = CBRCHR(II)                                            FLOPSF   2024
             CHRG = QQ                                                  FLOPSF   2025
           ENDIF                                                        FLOPSF   2026
         ELSE                                                           FLOPSF   2027
           RX = REQ                                                     FLOPSF   2028
           XI = XEQ                                                     FLOPSF   2029
           CHRG = 0.0                                                   FLOPSF   2030
         ENDIF                                                          FLOPSF   2031
         ZMAG = RX * RX + XI * XI                                       FLOPSF   2032
C                                                  ETMSP BRANCH ARRAYS  FLOPSF   2033
         NLINES = NLINES + 5                                            FLOPSF   2034
         IK=MNEW(IBUS)                                                  FLOPSF   2035
         IJ=MNEW(JBUS)                                                  FLOPSF   2036
         CALL PACKII(IK,IJ,KJ)                                          FLOPSF   2037
         LFTB(NLINES - 3) = KJ                                          FLOPSF   2038
         GA(NLINES - 2) = RX / ZMAG                                     FLOPSF   2039
         BA(NLINES - 1) = XI / ZMAG                                     FLOPSF   2040
C                                                                       FLOPSF   2041
         IF (LDEB .AND. II .EQ. 1) THEN                                 FLOPSF   2042
           IF (IBTYPE .EQ. 1) THEN                                      FLOPSF   2043
             WRITE (IUD6, 6604)                                         FLOPSF   2044
           ELSE IF (IBTYPE .EQ. 2) THEN                                 FLOPSF   2045
             WRITE (IUD6, 6704)                                         FLOPSF   2046
           ELSE IF (IBTYPE .EQ. 3) THEN                                 FLOPSF   2047
             WRITE (IUD6, 6804)                                         FLOPSF   2048
           ENDIF                                                        FLOPSF   2049
         ENDIF                                                          FLOPSF   2050
C---------------------------------------------------------------------  FLOPSF   2051
C      IF BRANCH CONTAINS SHUNT ELEMENTS AND IS NOT SECTIONALIZED THEN  FLOPSF   2052
C      STORE BRANCH PARAMETERS AS THOUGH THE BRANCH IS SECTIONALIZED    FLOPSF   2053
C      AND HAS ONE SECTION                                              FLOPSF   2054
C---------------------------------------------------------------------  FLOPSF   2055
         IF (ISFLAG .EQ. 0) THEN                                        FLOPSF   2056
           JSEL=0                                                       FLOPSF   2057
           IF (IBTYPE .EQ. -10 .OR.                                     FLOPSF   2058
     +         IBTYPE .EQ. -11) THEN                                    FLOPSF   2059
             GI = 0.0                                                   FLOPSF   2060
             BI = 0.0                                                   FLOPSF   2061
             GJ = 0.0                                                   FLOPSF   2062
             BJ = 0.0                                                   FLOPSF   2063
           ELSE                                                         FLOPSF   2064
             PQ = CBRSHF(II)                                            FLOPSF   2065
             GI = PP                                                    FLOPSF   2066
             BI = QQ                                                    FLOPSF   2067
             PQ = CBRSHT(II)                                            FLOPSF   2068
             GJ = PP                                                    FLOPSF   2069
             BJ = QQ                                                    FLOPSF   2070
           ENDIF                                                        FLOPSF   2071
         ELSE                                                           FLOPSF   2072
           GI = 0.0                                                     FLOPSF   2073
           BI = 0.0                                                     FLOPSF   2074
           GJ = 0.0                                                     FLOPSF   2075
           BJ = 0.0                                                     FLOPSF   2076
           JSEL=NSEL                                                    FLOPSF   2077
         ENDIF                                                          FLOPSF   2078
C                                                                       FLOPSF   2079
         IF (GI .NE. 0.0 .OR. BI .NE. 0.0 .OR.                          FLOPSF   2080
     +       GJ .NE. 0.0. OR. BJ .NE. 0.0) THEN                         FLOPSF   2081
C                                                                       FLOPSF   2082
           NSEL = NSEL + 1                                              FLOPSF   2083
C                                                                       FLOPSF   2084
           IF (LDEB) WRITE (IUD6, 6904) NSEL, IBUS, JBUS, ID,           FLOPSF   2085
     +                                  GI, BI, GJ, BJ, CHRG            FLOPSF   2086
C                                                                       FLOPSF   2087
           IK=MNEW(IBUS)                                                FLOPSF   2088
           IJ=MNEW(JBUS)                                                FLOPSF   2089
           LCONE(1, NSEL) = IK                                          FLOPSF   2090
           LCONE(2, NSEL) = IJ                                          FLOPSF   2091
           LCONE(3, NSEL) = 1                                           FLOPSF   2092
           CCONE(4, NSEL) = ID                                          FLOPSF   2093
           LCONE(5, NSEL) = IPOS + 1                                    FLOPSF   2094
           LCONE(6, NSEL) = 1                                           FLOPSF   2095
C                                                                       FLOPSF   2096
           IPOS = IPOS + 1                                              FLOPSF   2097
           NEXTSL(1, IPOS) = 0                                          FLOPSF   2098
           CNEXTS(2, IPOS) = ID                                         FLOPSF   2099
           NEXTSL(3, IPOS) = 0                                          FLOPSF   2100
           PSELIN(1, IPOS) = RX / ZMAG                                  FLOPSF   2101
           PSELIN(2, IPOS) = XI / ZMAG                                  FLOPSF   2102
           PSELIN(3, IPOS) = GI                                         FLOPSF   2103
           PSELIN(4, IPOS) = BI + 0.5 * CHRG                            FLOPSF   2104
           PSELIN(5, IPOS) = GJ                                         FLOPSF   2105
           PSELIN(6, IPOS) = BJ + 0.5 * CHRG                            FLOPSF   2106
           EQPI(1, NSEL) = RX / ZMAG                                    FLOPSF   2107
           EQPI(2, NSEL) = XI / ZMAG                                    FLOPSF   2108
           EQPI(3, NSEL) = GI                                           FLOPSF   2109
           EQPI(4, NSEL) = BI + 0.5 * CHRG                              FLOPSF   2110
           EQPI(5, NSEL) = GJ                                           FLOPSF   2111
           EQPI(6, NSEL) = BJ + 0.5 * CHRG                              FLOPSF   2112
           EQPI(7, NSEL) = 0.0                                          FLOPSF   2113
           EQPI(8, NSEL) = 0.0                                          FLOPSF   2114
           EQPI(9, NSEL) = 0.0                                          FLOPSF   2115
           EQPI(10, NSEL) = 0.0                                         FLOPSF   2116
           EQPI(11, NSEL) = 0.0                                         FLOPSF   2117
           EQPI(12, NSEL) = 0.0                                         FLOPSF   2118
C                                                                       FLOPSF   2119
           JSEL=NSEL                                                    FLOPSF   2120
           CHRG = 0.0                                                   FLOPSF   2121
C                                                                       FLOPSF   2122
         ENDIF                                                          FLOPSF   2123
C                                                                       FLOPSF   2124
         CALL PACK(ID,JSEL,JLID)                                        FLOPSF   2125
         LFTB(NLINES - 4) = JLID                                        FLOPSF   2126
         BCHG(NLINES) = CHRG                                            FLOPSF   2127
C---------------------------------------------------------------------  FLOPSF   2128
C                                                   TRANSFORMER ARRAYS  FLOPSF   2129
C                                                                       FLOPSF   2130
         IF (IBTYPE .GT. 1) THEN                                        FLOPSF   2131
           ITRF = ITRF + 1                                              FLOPSF   2132
           ITRF2 = ITRF2 + 2                                            FLOPSF   2133
           ITRAN(ITRF) = NL                                             FLOPSF   2134
           RATIO(ITRF2 - 1) = RTRONR(II)                                FLOPSF   2135
           RANG(ITRF2) = RTRAN1(II) * RADG                              FLOPSF   2136
         ENDIF                                                          FLOPSF   2137
C---------------------------------------------------------------------  FLOPSF   2138
C                                  ULTC TRANSFORMER ADJUSTMMENT ARRAYS  FLOPSF   2139
C                                                                       FLOPSF   2140
         IF (IBTYPE .EQ. 3) THEN                                        FLOPSF   2141
C                                                                       FLOPSF   2142
           MEND = IULMEN(II)                                            FLOPSF   2143
           ICFL = IULCFL(II)                                            FLOPSF   2144
C                                                                       FLOPSF   2145
           IF (IABS(ICFL) .EQ. 1) THEN                                  FLOPSF   2146
C                                                                       FLOPSF   2147
             ICONT = IBLFN(IULCB1(II))                                  FLOPSF   2148
             IF (ICONT .NE. IBUS .AND. ICONT .NE. JBUS) THEN            FLOPSF   2149
               IF (IULMEN(II) .EQ. 0 .OR. IULMEN(II) .EQ. 1)            FLOPSF   2150
C                                    CONTROLLED BUS IS ON THE TAP SIDE  FLOPSF   2151
     +            ICONT = - ICONT                                       FLOPSF   2152
             ENDIF                                                      FLOPSF   2153
             RMA = RULMXR(II)                                           FLOPSF   2154
             RMI = RULMNR(II)                                           FLOPSF   2155
             VMA = RULQH1(II)                                           FLOPSF   2156
             VMI = RULQL1(II)                                           FLOPSF   2157
             STEPI = RULSTP(II)                                         FLOPSF   2158
C                                                                       FLOPSF   2159
           ELSE IF (IABS(ICFL) .EQ. 2) THEN                             FLOPSF   2160
C                                                                       FLOPSF   2161
             ICONT = 0                                                  FLOPSF   2162
             RMA = RULMXR(II)                                           FLOPSF   2163
             RMI = RULMNR(II)                                           FLOPSF   2164
             VMA = RULQH1(II)                                           FLOPSF   2165
             VMI = RULQL1(II)                                           FLOPSF   2166
             STEPI = RULSTP(II)                                         FLOPSF   2167
C                                                                       FLOPSF   2168
           ELSE IF (IABS(ICFL) .EQ. 10) THEN                            FLOPSF   2169
C                                                                       FLOPSF   2170
             ICONT = 0                                                  FLOPSF   2171
             RMA = RULXA1(II) * RADG                                    FLOPSF   2172
             RMI = RULNA1(II) * RADG                                    FLOPSF   2173
             VMA = RULPH1(II)                                           FLOPSF   2174
             VMI = RULPL1(II)                                           FLOPSF   2175
             IF (IULAS1(II) .EQ. 0) THEN                                FLOPSF   2176
               STEPI = 0.0                                              FLOPSF   2177
             ELSE                                                       FLOPSF   2178
               STEPI = (RMA - RMI) / IULAS1(II)                         FLOPSF   2179
             ENDIF                                                      FLOPSF   2180
C                                                                       FLOPSF   2181
           ENDIF                                                        FLOPSF   2182
C                                                                       FLOPSF   2183
           ITBLNO = IULTB1(II)                                          FLOPSF   2184
           IF (ITBLNO .NE. 0) ITBLNO = ITCTBL(ITBLNO)                   FLOPSF   2185
C                                                                       FLOPSF   2186
           IF (IABS(ITBLNO) .GT. 10) THEN                               FLOPSF   2187
             WRITE (MSG(1), 7004) IABS(ITBLNO), IBUS, JBUS, ID          FLOPSF   2188
             CALL PRTMSG (1)                                            FLOPSF   2189
             ITBLNO = 0                                                 FLOPSF   2190
             IEBK = 1                                                   FLOPSF   2191
           ENDIF                                                        FLOPSF   2192
C                                                                       FLOPSF   2193
           NSC = NSC + 1                                                FLOPSF   2194
           NSC9 = NSC9 + 9                                              FLOPSF   2195
           ISCFRM(NSC9 - 8) = IBUS                                      FLOPSF   2196
           ISCTO(NSC9 - 7) = JBUS                                       FLOPSF   2197
           IF(ITBLNO.LT.0)ITBLNO=IABS(ITBLNO)+1000                      FLOPSF   2198
           CALL PACK(ID,ITBLNO,JCKID)                                   FLOPSF   2199
           ISCCID(NSC9 - 6) = JCKID                                     FLOPSF   2200
           ISCCON(NSC9 - 5) = ICONT                                     FLOPSF   2201
           ONRMAX(NSC9 - 4) = RMA                                       FLOPSF   2202
           ONRMIN(NSC9 - 3) = RMI                                       FLOPSF   2203
           VOLMAX(NSC9 - 2) = VMA                                       FLOPSF   2204
           VOLMIN(NSC9 - 1) = VMI                                       FLOPSF   2205
           STEP(NSC9) = STEPI                                           FLOPSF   2206
C                                                                       FLOPSF   2207
         ENDIF                                                          FLOPSF   2208
C                                                                       FLOPSF   2209
5002   CONTINUE                                                         FLOPSF   2210
C---------------------------------------------------------------------  FLOPSF   2211
6104   FORMAT (' *** ERROR - BRANCH: ', 2I7, 1X, A2,                    FLOPSF   2212
     +         ' BUS IS NOT IN LOAD FLOW.')                             FLOPSF   2213
6204   FORMAT (' *** ERROR - SECTIONALIZED TRANSFORMER/ULTC BRANCH')    FLOPSF   2214
6304   FORMAT ('             WHICH IS NOT ALLOWED BY ETMSP HAS BEEN ',  FLOPSF   2215
     +         'DETECTED.')                                             FLOPSF   2216
6404   FORMAT ('             FROM BUS: ', I6, '   TO BUS: ', I6)        FLOPSF   2217
6504   FORMAT (' *** ERROR - BRANCH: ', 2I7, 1X, A2,                    FLOPSF   2218
     +         ' EXCEEDS PROGRAM LIMIT OF ', I10, ' BRANCHES')          FLOPSF   2219
6604   FORMAT (' *** READING LINE DATA ***')                            FLOPSF   2220
6704   FORMAT (' *** READING FIXED TRANSFORMER DATA ***')               FLOPSF   2221
6804   FORMAT (' *** READING ULTC TRANSFORMER DATA ***')                FLOPSF   2222
6904   FORMAT (' FLOPSF NSEL ETC. ', 3I7, 1X, A2, 5F12.5)               FLOPSF   2223
7004   FORMAT (' *** ERROR - Z-CORR TABLE ', I4, ' FOR ULTC BRANCH: ',  FLOPSF   2224
     +         2I7, 1X, A2, 'WILL BE IGNORED.')                         FLOPSF   2225
C---------------------------------------------------------------------  FLOPSF   2226
9999   RETURN                                                           FLOPSF   2227
       END                                                              FLOPSF   2228
C*********************************************************************  FLOPSF   2229
       SUBROUTINE PSATIC (IFLNO)                                        FLOPSF   2230
C---------------------------------------------------------------------  FLOPSF   2231
CD  FUNCTION                                                            FLOPSF   2232
CD  ========                                                            FLOPSF   2233
CD  THIS SUBROUTINE LOADS PSF Z-CORR TABLES INTO AN ETMSP ARRAY.        FLOPSF   2234
CD                                                                      FLOPSF   2235
CD  CALLING SEQUENCE                                                    FLOPSF   2236
CD  ================                                                    FLOPSF   2237
CD     ARGUMENT     TYPE     DESCRIPTION                                FLOPSF   2238
CD     ========     ====     ===========                                FLOPSF   2239
CD     IFLNO        I*4      O: FILE RECORD NUMBER                      FLOPSF   2240
CD                                                                      FLOPSF   2241
C---------------------------------------------------------------------  FLOPSF   2242
      INCLUDE 'PSFNAM.INS'                                              FLOPSF   2243
      INCLUDE 'PARX.INS'                                                FLOPSF   2244
      INCLUDE 'CNLFDA.INS'                                              FLOPSF   2245
C---------------------------------------------------------------------  FLOPSF   2246
C      LOCAL VARIABLES                                                  FLOPSF   2247
C      ===============                                                  FLOPSF   2248
C                                                                       FLOPSF   2249
       INTEGER*2     ITCTBL(40)                                         FLOPSF   2250
C                                                                       FLOPSF   2251
       REAL          RTCT(440), RTCF(440)                               FLOPSF   2252
C                                                                       FLOPSF   2253
       COMMON /SCRAT0/ ITCTBL, RTCT, RTCF                               FLOPSF   2254
C---------------------------------------------------------------------  FLOPSF   2255
C                                                       INITIALIZATION  FLOPSF   2256
C                                                                       FLOPSF   2257
       LUN = LUNPSF(IFLNO)                                              FLOPSF   2258
C                                                                       FLOPSF   2259
       CALL INVPSF (LUN, 'TCSEC', NTIC, 1)                              FLOPSF   2260
C                                                                       FLOPSF   2261
       IF (NTIC .EQ. 0) GOTO 9999                                       FLOPSF   2262
C                                                                       FLOPSF   2263
       RADG = 180.0 / 3.141592654                                       FLOPSF   2264
C---------------------------------------------------------------------  FLOPSF   2265
C                                     READ THE PSF Z-CORRECTION TABLES  FLOPSF   2266
C                                                                       FLOPSF   2267
       CALL RDPSFI (LUN, 'TCTBL', ITCTBL)                               FLOPSF   2268
       CALL RDPSFR (LUN, 'TCT', RTCT)                                   FLOPSF   2269
       CALL RDPSFR (LUN, 'TCF', RTCF)                                   FLOPSF   2270
C---------------------------------------------------------------------  FLOPSF   2271
C                                     ENTER DATA INTO CORTBL FOR ETMSP  FLOPSF   2272
C                                                                       FLOPSF   2273
       DO 1502 IREC = 1, NTIC                                           FLOPSF   2274
C                                                                       FLOPSF   2275
         ITBL = ITCTBL(IREC)                                            FLOPSF   2276
C                                 IGNORE THE TABLE IF THE TABLE NUMBER  FLOPSF   2277
C                                                   IS GREATER THAN 10  FLOPSF   2278
         IF (IABS(ITBL) .GT. 10) GOTO 1502                              FLOPSF   2279
         IODD = 0                                                       FLOPSF   2280
         IEVEN = 1                                                      FLOPSF   2281
C                                                           PSF OFFSET  FLOPSF   2282
         IOFS11 = (IREC - 1) * 11                                       FLOPSF   2283
C                                                         ETMSP OFFSET  FLOPSF   2284
         IOFS22 = (IABS(ITBL) - 1) * 22                                 FLOPSF   2285
C                                                                       FLOPSF   2286
         DO 1202 II = 1, 11                                             FLOPSF   2287
           IF (ITBL .LT. 0) THEN                                        FLOPSF   2288
             CORTBL(IOFS22 + II + IODD) = RTCT(IOFS11 + II) * RADG      FLOPSF   2289
           ELSE                                                         FLOPSF   2290
             CORTBL(IOFS22 + II + IODD) = RTCT(IOFS11 + II)             FLOPSF   2291
           ENDIF                                                        FLOPSF   2292
           CORTBL(IOFS22 + II + IEVEN) = RTCF(IOFS11 + II)              FLOPSF   2293
           IODD = IODD + 1                                              FLOPSF   2294
           IEVEN = IEVEN + 1                                            FLOPSF   2295
1202     CONTINUE                                                       FLOPSF   2296
C                                                                       FLOPSF   2297
1502   CONTINUE                                                         FLOPSF   2298
C---------------------------------------------------------------------  FLOPSF   2299
9999   RETURN                                                           FLOPSF   2300
       END                                                              FLOPSF   2301
C*********************************************************************  FLOPSF   2302
        SUBROUTINE TRFCOR  (TCT, TCF, XR, FACT)                         FLOPSF   2303
C---------------------------------------------------------------------  FLOPSF   2304
CD  FUNCTION                                                            FLOPSF   2305
CD  ========                                                            FLOPSF   2306
CD  THIS ROUTINE COMPUTES THE TRANSFORMER IMPEDANCE CORRECTION FACTOR.  FLOPSF   2307
CD                                                                      FLOPSF   2308
CD  CALLING SEQUENCE                                                    FLOPSF   2309
CD  ================                                                    FLOPSF   2310
CD     ARGUMENT     TYPE     DESCRIPTION                                FLOPSF   2311
CD     ========     ====     ===========                                FLOPSF   2312
CD     TCT          R*4      I: VERTEX VALUE                            FLOPSF   2313
CD     TCF          R*4      I: VERTEX FACTOR                           FLOPSF   2314
CD     XR           R*4      I: RATIO OR ANGLE                          FLOPSF   2315
CD     FACT         R*4      O: CORRECTION FACTOR                       FLOPSF   2316
C---------------------------------------------------------------------  FLOPSF   2317
      INCLUDE 'CNMSG.INS'                                               FLOPSF   2318
C                                                                       FLOPSF   2319
       REAL          TCT(*), TCF(*)                                     FLOPSF   2320
C---------------------------------------------------------------------  FLOPSF   2321
C      LOCAL VARIABLES                                                  FLOPSF   2322
C      ===============                                                  FLOPSF   2323
C                                                                       FLOPSF   2324
       DATA IPRFLG / 1 /                                                FLOPSF   2325
C---------------------------------------------------------------------  FLOPSF   2326
C                                             GET # OF POINTS IN TABLE  FLOPSF   2327
C                                                                       FLOPSF   2328
       DO 1102 I = 1, 11                                                FLOPSF   2329
         IF (TCF(I) .EQ. 0.0) GOTO 1500                                 FLOPSF   2330
1102   CONTINUE                                                         FLOPSF   2331
       I = 12                                                           FLOPSF   2332
C                                                                       FLOPSF   2333
1500   NPT = I - 1                                                      FLOPSF   2334
C                                                                       FLOPSF   2335
       IF (XR .LT. TCT(1) .OR. XR .GT. TCT(NPT)) THEN                   FLOPSF   2336
C                                                                       FLOPSF   2337
         IF (IPRFLG .EQ. 1) THEN                                        FLOPSF   2338
           WRITE (MSG(1), 1704) XR, NPT, TCT(1), TCT(NPT)               FLOPSF   2339
           CALL PRTMSG (1)                                              FLOPSF   2340
           IPRFLG = 0                                                   FLOPSF   2341
         END IF                                                         FLOPSF   2342
C                                                                       FLOPSF   2343
         IF (XR .LT. TCT(1)) THEN                                       FLOPSF   2344
           II = 1                                                       FLOPSF   2345
         ELSE                                                           FLOPSF   2346
           II = NPT                                                     FLOPSF   2347
         END IF                                                         FLOPSF   2348
C                                                                       FLOPSF   2349
         FACT = TCF(II)                                                 FLOPSF   2350
         GOTO 9999                                                      FLOPSF   2351
       END IF                                                           FLOPSF   2352
C---------------------------------------------------------------------  FLOPSF   2353
C                                                        CHECK IF LAST  FLOPSF   2354
C                                                                       FLOPSF   2355
       IF (XR .EQ. TCT(NPT)) THEN                                       FLOPSF   2356
         FACT =  TCF(NPT)                                               FLOPSF   2357
         GOTO 9999                                                      FLOPSF   2358
       END IF                                                           FLOPSF   2359
C---------------------------------------------------------------------  FLOPSF   2360
C                                                          INTERPOLATE  FLOPSF   2361
C                                                                       FLOPSF   2362
       DO 2202 I = 2, NPT                                               FLOPSF   2363
         IF (XR .LT. TCT(I)) THEN                                       FLOPSF   2364
           XM = TCT(I)                                                  FLOPSF   2365
           XX = TCT(I - 1)                                              FLOPSF   2366
           YM = TCF(I)                                                  FLOPSF   2367
           YX = TCF(I - 1)                                              FLOPSF   2368
           FACT = YX + (YM - YX) * (XR - XX) / (XM - XX)                FLOPSF   2369
           GOTO 9999                                                    FLOPSF   2370
         END IF                                                         FLOPSF   2371
2202   CONTINUE                                                         FLOPSF   2372
C---------------------------------------------------------------------  FLOPSF   2373
1704   FORMAT (/, 2X, 'WARNING (TRFCOR): '                              FLOPSF   2374
     +         , 'ONR OR ANGLE OUT OF RANGE: XR, NPT,'                  FLOPSF   2375
     +         , ' ONRS ', F9.4, 2X, I2, 2X, 2(F9.4, 2X))               FLOPSF   2376
C---------------------------------------------------------------------  FLOPSF   2377
9999   RETURN                                                           FLOPSF   2378
       END                                                              FLOPSF   2379
C*********************************************************************  FLOPSF   2380
        SUBROUTINE  GTDCNA (ACBNAM, JDCC, IFLNO)                        FLOPSF   2381
CD -------------------------------------------------------------------  FLOPSF   2382
CD                                                                      FLOPSF   2383
CD              *****     GTDCNA  ROUTINE   *****                       FLOPSF   2384
CD                                                                      FLOPSF   2385
CD -------------------------------------------------------------------  FLOPSF   2386
CD                                                                      FLOPSF   2387
CD       PURPOSE:  THIS SUBROUTINE SETS UP A VECTOR TO GET THE          FLOPSF   2388
CD                 AC BUS NAME                                          FLOPSF   2389
CD                                                                      FLOPSF   2390
CD                                                                      FLOPSF   2391
CD       DEFINITION OF LOCAL VARIABLES:                                 FLOPSF   2392
CD                 ABEND  -  INDICATES THAT THE BUS NAME WAS NOT FOUND. FLOPSF   2393
CD                 ACBNAM - BUS NAME FROM AC SYSTEM                     FLOPSF   2394
CD                 CBUS   -  BUS NUMBER FROM AC SYSTEM                  FLOPSF   2395
CD                 I      - 'DO' LOOP INDEX.                            FLOPSF   2396
CD                 J      - 'DO' LOOP INDEX.                            FLOPSF   2397
CD                 POSN   -  INTERNAL NUMBER FOR THE NAME.              FLOPSF   2398
CD                                                                      FLOPSF   2399
CD -------------------------------------------------------------------  FLOPSF   2400
      INCLUDE 'PARX.INS'                                                FLOPSF   2401
      INCLUDE 'PSFUNT.INS'                                              FLOPSF   2402
      INCLUDE 'GRDC01.INS'                                              FLOPSF   2403
      INCLUDE 'GRDC02.INS'                                              FLOPSF   2404
C                                                                       FLOPSF   2405
      INTEGER*2     IBNUTG(NB), IBNMTG(NB), IBSCTN(MSEL)                FLOPSF   2406
      INTEGER       IBLFN(NB), IBNAME(4*NB)                             FLOPSF   2407
      COMMON /SCRAT2/ IBLFN, IBNAME, IBNUTG, IBNMTG, IBSCTN             FLOPSF   2408
C                                                                       FLOPSF   2409
        LOGICAL       ABEND                                             FLOPSF   2410
C                                                                       FLOPSF   2411
        INTEGER       CBUS, CBU2, I,IC,II, J, POSN                      FLOPSF   2412
        INTEGER       INAM(4*NB)                                        FLOPSF   2413
C                                                                       FLOPSF   2414
        CHARACTER*24 FRMT                                               FLOPSF   2415
        CHARACTER*16  NAM(NB)                                           FLOPSF   2416
        CHARACTER*12  ACBNAM(*)                                         FLOPSF   2417
        DIMENSION JDCC(NDCC*2)                                          FLOPSF   2418
C                                                                       FLOPSF   2419
        EQUIVALENCE   (INAM(1), NAM(1))                                 FLOPSF   2420
C                                                                       FLOPSF   2421
        COMMON /SCRAT0/ INAM                                            FLOPSF   2422
C                                                                       FLOPSF   2423
      INCLUDE 'PSFNAM.INS'                                              FLOPSF   2424
C                                                                       FLOPSF   2425
C---------------------------------------------------------------------  FLOPSF   2426
C                                                                       FLOPSF   2427
        LUN = LUNPSF(IFLNO)                                             FLOPSF   2428
C                                                                       FLOPSF   2429
        ABEND = .FALSE.                                                 FLOPSF   2430
C                                         READ IN BUS LF NUMBER & NAME  FLOPSF   2431
        CALL INVPSF (LUN, 'BSEC', NBUS, 1)                              FLOPSF   2432
        CALL RDPSFJ (LUN, 'BNAME', INAM)                                FLOPSF   2433
C                                                                       FLOPSF   2434
        DO 1062 I = 1, ICDC                                             FLOPSF   2435
C                                                                       FLOPSF   2436
          IF (IDC(I) .NE. 0) THEN                                       FLOPSF   2437
            POSN = IDC(I)                                               FLOPSF   2438
C                                   FIND THE FORMAT TO READ ACBUS #     FLOPSF   2439
         DO 1012 II=1,5                                                 FLOPSF   2440
            IC=17+II                                                    FLOPSF   2441
            IF(DCCNAM(POSN)(IC:IC).EQ.' ')GOTO 1015                     FLOPSF   2442
 1012    CONTINUE                                                       FLOPSF   2443
 1015    FRMT='(I1)'                                                    FLOPSF   2444
         WRITE(FRMT(3:3), '(I1)')II                                     FLOPSF   2445
C                                                                       FLOPSF   2446
            READ (DCCNAM(POSN)(17:21),FRMT ) CBUS                       FLOPSF   2447
C                                                                       FLOPSF   2448
         DO 1013 II=1,5                                                 FLOPSF   2449
            IC=1+II                                                     FLOPSF   2450
            IF(DCCNA2(POSN)(IC:IC).EQ.' ')GOTO 1014                     FLOPSF   2451
 1013    CONTINUE                                                       FLOPSF   2452
 1014    FRMT='(I1)'                                                    FLOPSF   2453
         WRITE(FRMT(3:3), '(I1)')II                                     FLOPSF   2454
C                                                                       FLOPSF   2455
            READ (DCCNA2(POSN)(1:5),FRMT ) CBU2                         FLOPSF   2456
C                                                                       FLOPSF   2457
            IF (CBUS .EQ. 0) THEN                                       FLOPSF   2458
               ACBNAM(POSN) = ' '                                       FLOPSF   2459
               JDCC(POSN) = 0                                           FLOPSF   2460
               ACBNAM(ICDC+POSN) = ' '                                  FLOPSF   2461
               JDCC(ICDC+POSN) = 0                                      FLOPSF   2462
               GO TO 1062                                               FLOPSF   2463
            ELSE                                                        FLOPSF   2464
               DO 1022 J = 1, NBUS                                      FLOPSF   2465
               IBUS = IBLFN(J)                                          FLOPSF   2466
               IF (IBUS .EQ. CBUS) THEN                                 FLOPSF   2467
                  ACBNAM(POSN) = NAM(J)(1:12)                           FLOPSF   2468
                  JDCC(POSN)=CBUS                                       FLOPSF   2469
                  GO TO 1023                                            FLOPSF   2470
               END IF                                                   FLOPSF   2471
1022           CONTINUE                                                 FLOPSF   2472
C                                                                       FLOPSF   2473
               WRITE( JTAPE, 9002) CBUS                                 FLOPSF   2474
               ABEND = .TRUE.                                           FLOPSF   2475
               GO TO 1062                                               FLOPSF   2476
C                                                                       FLOPSF   2477
1023           CONTINUE                                                 FLOPSF   2478
               IF (CBU2 .EQ. 0) THEN                                    FLOPSF   2479
                  ACBNAM(ICDC+POSN) = ' '                               FLOPSF   2480
                  JDCC(ICDC+POSN) = 0                                   FLOPSF   2481
                  GO TO 1062                                            FLOPSF   2482
               ELSE                                                     FLOPSF   2483
                  DO 1024 J = 1, NBUS                                   FLOPSF   2484
                  IBUS = IBLFN(J)                                       FLOPSF   2485
                  IF (IBUS .EQ. CBU2) THEN                              FLOPSF   2486
                     ACBNAM(ICDC+POSN) = NAM(J)(1:12)                   FLOPSF   2487
                     JDCC(ICDC+POSN)=CBU2                               FLOPSF   2488
                     GO TO 1062                                         FLOPSF   2489
                  END IF                                                FLOPSF   2490
1024              CONTINUE                                              FLOPSF   2491
               END IF                                                   FLOPSF   2492
C                                                                       FLOPSF   2493
               WRITE( JTAPE, 9002) CBU2                                 FLOPSF   2494
               ABEND = .TRUE.                                           FLOPSF   2495
            ENDIF                                                       FLOPSF   2496
          END IF                                                        FLOPSF   2497
1062    CONTINUE                                                        FLOPSF   2498
C                                                                       FLOPSF   2499
        IF (ABEND) THEN                                                 FLOPSF   2500
          STOP 'FAILURE DUE TO INVALID AC BUS NAME IN DC SYSTEM'        FLOPSF   2501
        END IF                                                          FLOPSF   2502
C                                                                       FLOPSF   2503
C---------------------------------------------------------------------  FLOPSF   2504
C                                                                       FLOPSF   2505
        RETURN                                                          FLOPSF   2506
C                                                                       FLOPSF   2507
C---------------------------------------------------------------------  FLOPSF   2508
C                                                                       FLOPSF   2509
9002    FORMAT (/, ' *** ERROR   ***  BUS NAME, ', I5, ' WAS NOT ',     FLOPSF   2510
     +        'FOUND IN THE AC SYSTEM.')                                FLOPSF   2511
C                                                                       FLOPSF   2512
C---------------------------------------------------------------------  FLOPSF   2513
C                                                                       FLOPSF   2514
        END                                                             FLOPSF   2515
C*********************************************************************  FLOPSF   2516
      SUBROUTINE  PSFRDC (IFLNO)                                        FLOPSF   2517
CD ---------------------------------------------------------------------FLOPSF   2518
CD                                                                      FLOPSF   2519
CD               *****     SAVEDC  ROUTINE   *****                      FLOPSF   2520
CD                                                                      FLOPSF   2521
CD ---------------------------------------------------------------------FLOPSF   2522
CD                                                                      FLOPSF   2523
CD        PURPOSE:  THIS SUBROUTINE READS THE DC INFORMATION, THE       FLOPSF   2524
CD                  NODE NAME ARRAY, GROUP ARRAY, AND THE SOLUTION.     FLOPSF   2525
CD                                                                      FLOPSF   2526
CD                  LUN    - LOGICAL UNIT NUMBER FOR PSF                FLOPSF   2527
CD                  LASREC   - LAST RECORD NUMBER IN PSF                FLOPSF   2528
CD                  DCWRT  - FLAG TO INDICATE DC SOLVED CASE SHOULD BE  FLOPSF   2529
CD                           ADDED                                      FLOPSF   2530
CD                  POSN   -  INTERNAL NUMBER FOR THE NAME.             FLOPSF   2531
CD                                                                      FLOPSF   2532
CD ---------------------------------------------------------------------FLOPSF   2533
      INCLUDE 'PARX.INS'                                                FLOPSF   2534
      INCLUDE 'CNPT.INS'                                                FLOPSF   2535
      INCLUDE 'GRDC01.INS'                                              FLOPSF   2536
      INCLUDE 'GRDC03.INS'                                              FLOPSF   2537
      INCLUDE 'GRPDCS.INS'                                              FLOPSF   2538
      INCLUDE 'CNFLAG.INS'                                              FLOPSF   2539
C                                                                       FLOPSF   2540
      LOGICAL LDEB1                                                     FLOPSF   2541
      INTEGER       I, POSN                                             FLOPSF   2542
C                                                                       FLOPSF   2543
      INCLUDE 'PSFNAM.INS'                                              FLOPSF   2544
C                                                                       FLOPSF   2545
C---------------------------------------------------------------------  FLOPSF   2546
C                                                                       FLOPSF   2547
C      RECOVER THE LAST RECORD NO. , LOGICAL UNIT                       FLOPSF   2548
C                                                                       FLOPSF   2549
C---------------------------------------------------------------------  FLOPSF   2550
       LDEB=.FALSE.                                                     FLOPSF   2551
       LDEB1=(JDEB(280).NE.0)                                           FLOPSF   2552
       POSN=0                                                           FLOPSF   2553
       IPOSN=0                                                          FLOPSF   2554
       TEMP=0.0                                                         FLOPSF   2555
C                                                                       FLOPSF   2556
       LASREC = HDRPSF(5, IFLNO)                                        FLOPSF   2557
       IF (LASREC .EQ. 0) RETURN                                        FLOPSF   2558
       LUN = LUNPSF(IFLNO)                                              FLOPSF   2559
C                                                                       FLOPSF   2560
C                                                                       FLOPSF   2561
      READ (UNIT=LUN, REC=LASREC) IDCWRT, ICDC,ISIZEC, ILDC, ISIZEL,    FLOPSF   2562
     1       IBDC, ISIZEB, NUMNOD, NONODR, NUMGRP                       FLOPSF   2563
C                                                                       FLOPSF   2564
      IF(LDEB1) WRITE(IUD6,1450) ICDC,ISIZEC,ILDC,ISIZEL,IBDC,ISIZEB    FLOPSF   2565
     &,NUMNOD,NONODR,NUMGRP                                             FLOPSF   2566
C                                                                       FLOPSF   2567
      KCDC=ICDC                                                         FLOPSF   2568
      IVDC=0                                                            FLOPSF   2569
      IF(ISIZEC.LT.0) IVDC=-ISIZEC                                      FLOPSF   2570
      LCDC=ICDC-IVDC                                                    FLOPSF   2571
C                                                                       FLOPSF   2572
      IF (IDCWRT .EQ. 0) GO TO 999                                      FLOPSF   2573
C                                                                       FLOPSF   2574
      IF (ICDC .GT. 0) THEN                                             FLOPSF   2575
         DCEXST=.TRUE.                                                  FLOPSF   2576
         LASREC = LASREC + 1                                            FLOPSF   2577
         READ (UNIT=LUN, REC=LASREC)  (IDC(I), I = 1, ICDC)             FLOPSF   2578
         IF(LDEB1) WRITE(IUD6,1450) (IDC(I), I = 1, ICDC)               FLOPSF   2579
      ELSE                                                              FLOPSF   2580
         DCEXST=.FALSE.                                                 FLOPSF   2581
      END IF                                                            FLOPSF   2582
      LASREC = LASREC + 1                                               FLOPSF   2583
      READ (UNIT=LUN, REC=LASREC)  (IDCFRE(I), I = 1, NDCC)             FLOPSF   2584
      IF(LDEB1) WRITE(IUD6,1450) (IDCFRE(I), I = 1, NDCC)               FLOPSF   2585
C                                                                       FLOPSF   2586
C                                                                       FLOPSF   2587
      DO 20 I = 1, LCDC                                                 FLOPSF   2588
C                                                                       FLOPSF   2589
         IF (IDC(I) .NE. 0) THEN                                        FLOPSF   2590
            POSN = IDC(I)                                               FLOPSF   2591
               LASREC = LASREC + 1                                      FLOPSF   2592
               READ (UNIT=LUN, REC=LASREC)  DCCNMR(POSN), BDIND(POSN),  FLOPSF   2593
     1               VABASE(POSN), CNGRP(POSN), CNZONE(POSN),           FLOPSF   2594
     2               NSBRDG(POSN), XCOHMS(POSN), TAPNOM(POSN),          FLOPSF   2595
     3               TAPSTP(POSN), AMINTP(POSN), AMAXTP(POSN),          FLOPSF   2596
     4               ALPMIN(POSN), ALPMAX(POSN), GAMMIN(POSN),          FLOPSF   2597
     5               TEMP                                               FLOPSF   2598
C                                                                       FLOPSF   2599
               LASREC = LASREC + 1                                      FLOPSF   2600
               READ (UNIT=LUN, REC=LASREC)  BZIND(POSN), SPTYPE(POSN),  FLOPSF   2601
     1                USERD(1,POSN),USERD(2,POSN), QINV(POSN),          FLOPSF   2602
     2                CNVMVA(POSN), DCPMIN(POSN), DCPMAX(POSN),         FLOPSF   2603
     3                DCQMIN(POSN), DCQMAX(POSN), BIASO(POSN)           FLOPSF   2604
            SPTYP3(POSN) = 'NO'                                         FLOPSF   2605
            ICTYPE(POSN) = 1                                            FLOPSF   2606
         END IF                                                         FLOPSF   2607
C                                                                       FLOPSF   2608
C                                                                       FLOPSF   2609
      IF(LDEB1)THEN                                                     FLOPSF   2610
          IPOSN=POSN                                                    FLOPSF   2611
         WRITE(IUD6,1450) IPOSN                                         FLOPSF   2612
         WRITE(IUD6,1460) DCCNMR(IPOSN),BDIND(IPOSN),VABASE(IPOSN),     FLOPSF   2613
     1   CNGRP(IPOSN), CNZONE(IPOSN), NSBRDG(IPOSN),                    FLOPSF   2614
     2   XCOHMS(IPOSN), TAPNOM(IPOSN), TAPSTP(IPOSN),                   FLOPSF   2615
     3   AMINTP(IPOSN), AMAXTP(IPOSN), ALPMIN(IPOSN),                   FLOPSF   2616
     4   ALPMAX(IPOSN), GAMMIN(IPOSN), TEMP                             FLOPSF   2617
C                                                                       FLOPSF   2618
         WRITE(IUD6,1470) BZIND(IPOSN),SPTYPE(IPOSN),USERD(1,IPOSN)     FLOPSF   2619
     1   ,USERD(2,IPOSN), QINV(IPOSN), CNVMVA(IPOSN)                    FLOPSF   2620
     2   ,DCPMIN(IPOSN), DCPMAX(IPOSN), DCQMIN(IPOSN)                   FLOPSF   2621
     3   ,DCQMAX(IPOSN), BIASO(IPOSN)                                   FLOPSF   2622
      ENDIF                                                             FLOPSF   2623
C                                                                       FLOPSF   2624
20    CONTINUE                                                          FLOPSF   2625
C                                                                       FLOPSF   2626
C                                                                       FLOPSF   2627
      IF (ILDC .GT. 0) THEN                                             FLOPSF   2628
         LASREC = LASREC + 1                                            FLOPSF   2629
         READ (UNIT=LUN, REC=LASREC)  (IDCL(I), I = 1, ILDC)            FLOPSF   2630
         IF(LDEB1) WRITE(IUD6,1450) (IDCL(I), I = 1, ILDC)              FLOPSF   2631
      END IF                                                            FLOPSF   2632
      LASREC = LASREC + 1                                               FLOPSF   2633
      READ (UNIT=LUN, REC=LASREC)  (IDCFRL(I), I = 1, NDCC)             FLOPSF   2634
      IF(LDEB1) WRITE(IUD6,1450) (IDCFRL(I), I = 1, NDCC)               FLOPSF   2635
C                                                                       FLOPSF   2636
C                                                                       FLOPSF   2637
      DO 40  I = 1, ILDC                                                FLOPSF   2638
C                                                                       FLOPSF   2639
         IF (IDCL(I) .NE. 0) THEN                                       FLOPSF   2640
            POSN = IDCL(I)                                              FLOPSF   2641
            LASREC = LASREC + 1                                         FLOPSF   2642
         IF(LDEB1) WRITE(IUD6,1450) IPOSN                               FLOPSF   2643
            READ (UNIT=LUN, REC=LASREC)  DCLNMR(POSN), DLGRP(POSN),     FLOPSF   2644
     1             DLOWN(POSN), DLZONE(POSN), RDCOHM(POSN), XLDC(POSN), FLOPSF   2645
     2             CDCA(POSN), CDCB(POSN), DCIMAX(POSN)                 FLOPSF   2646
         IF(LDEB1) WRITE(IUD6,1480) DCLNMR(IPOSN), DLGRP(IPOSN),        FLOPSF   2647
     1   DLOWN(IPOSN),                                                  FLOPSF   2648
     2   DLZONE(IPOSN), RDCOHM(IPOSN), XLDC(IPOSN),                     FLOPSF   2649
     3   CDCA(IPOSN),CDCB(IPOSN), DCIMAX(IPOSN)                         FLOPSF   2650
         END IF                                                         FLOPSF   2651
C                                                                       FLOPSF   2652
40    CONTINUE                                                          FLOPSF   2653
C                                                                       FLOPSF   2654
      IF (IBDC .GT. 0) THEN                                             FLOPSF   2655
         LASREC = LASREC + 1                                            FLOPSF   2656
         READ (UNIT=LUN, REC=LASREC)  (IDCB(I), I = 1, IBDC)            FLOPSF   2657
         IF(LDEB1) WRITE(IUD6,1450) (IDCB(I), I = 1, IBDC)              FLOPSF   2658
      END IF                                                            FLOPSF   2659
      LASREC = LASREC + 1                                               FLOPSF   2660
      READ (UNIT=LUN, REC=LASREC)  (IDCFRB(I), I = 1, NDCB)             FLOPSF   2661
      IF(LDEB1) WRITE(IUD6,1450) (IDCFRB(I), I = 1, NDCB)               FLOPSF   2662
C                                                                       FLOPSF   2663
C                                                                       FLOPSF   2664
      DO 60 I = 1, IBDC                                                 FLOPSF   2665
C                                                                       FLOPSF   2666
         IF (IDCB(I) .NE. 0) THEN                                       FLOPSF   2667
            POSN = IDCB(I)                                              FLOPSF   2668
            IF(LDEB1) WRITE(IUD6,1450) IPOSN                            FLOPSF   2669
            LASREC = LASREC + 1                                         FLOPSF   2670
            READ (UNIT=LUN, REC=LASREC)  DCBNMR(POSN), DBGRP(POSN),     FLOPSF   2671
     1             DBOWN(POSN), DBZONE(POSN), IBSTAT(POSN)              FLOPSF   2672
            IF(LDEB1)WRITE(IUD6,1580) DCBNMR(IPOSN), DBGRP(IPOSN)       FLOPSF   2673
     1      ,DBOWN(IPOSN),DBZONE(IPOSN), IBSTAT(IPOSN)                  FLOPSF   2674
         END IF                                                         FLOPSF   2675
C                                                                       FLOPSF   2676
60    CONTINUE                                                          FLOPSF   2677
C                                                                       FLOPSF   2678
C                                                                       FLOPSF   2679
      IF (NONODR .GT. 0) THEN                                           FLOPSF   2680
         I1=1                                                           FLOPSF   2681
 62      IF(I1 .LE. NONODR)THEN                                         FLOPSF   2682
          I2 = I1 + 31                                                  FLOPSF   2683
          IF(I2 .GT. NONODR) I2 =NONODR                                 FLOPSF   2684
          LASREC = LASREC + 1                                           FLOPSF   2685
          READ (UNIT=LUN, REC=LASREC)  (IDCNOD(I), I = I1, I2)          FLOPSF   2686
          IF(LDEB1) WRITE(IUD6,1490) (IDCNOD(I), I = I1, I2)            FLOPSF   2687
          I1 = I2 + 1                                                   FLOPSF   2688
          GOTO 62                                                       FLOPSF   2689
         ENDIF                                                          FLOPSF   2690
C                                                                       FLOPSF   2691
         LASREC = LASREC + 1                                            FLOPSF   2692
         READ (UNIT=LUN, REC=LASREC)  (NODIDX(I), I = 1, NONODR)        FLOPSF   2693
         IF(LDEB1) WRITE(IUD6,1450) (NODIDX(I), I = 1, NONODR)          FLOPSF   2694
      END IF                                                            FLOPSF   2695
C                                                                       FLOPSF   2696
      IF (NUMGRP .GT. 0) THEN                                           FLOPSF   2697
         LASREC = LASREC + 1                                            FLOPSF   2698
         READ (UNIT=LUN, REC=LASREC)  (GROUP(I), I = 1, NUMGRP)         FLOPSF   2699
         IF(LDEB1) WRITE(IUD6,1490) (GROUP(I), I = 1, NUMGRP)           FLOPSF   2700
      END IF                                                            FLOPSF   2701
C                                                                       FLOPSF   2702
C                                                                       FLOPSF   2703
      DO 80 I = 1, LCDC                                                 FLOPSF   2704
C                                                                       FLOPSF   2705
         IF (IDC(I) .NE. 0) THEN                                        FLOPSF   2706
            POSN = IDC(I)                                               FLOPSF   2707
            IF(LDEB1) WRITE(IUD6,1450) IPOSN                            FLOPSF   2708
            LASREC = LASREC + 1                                         FLOPSF   2709
            READ (UNIT=LUN, REC=LASREC)  CALPHA(POSN), CGAMMA(POSN),    FLOPSF   2710
     1             XACURR(POSN), TAPPOS(POSN), PHIDC(POSN),             FLOPSF   2711
     2             PAHVDC(POSN), QAHVDC(POSN), VDCONV(POSN),            FLOPSF   2712
     3             XDCONV(POSN)                                         FLOPSF   2713
         END IF                                                         FLOPSF   2714
C                                                                       FLOPSF   2715
80    CONTINUE                                                          FLOPSF   2716
C                                                                       FLOPSF   2717
C                                                                       FLOPSF   2718
      IF (NUMNOD .GT. 0) THEN                                           FLOPSF   2719
         LASREC = LASREC + 1                                            FLOPSF   2720
         READ (UNIT=LUN, REC=LASREC)  (VDCNOD(I), I = 1, NUMNOD)        FLOPSF   2721
         LASREC = LASREC + 1                                            FLOPSF   2722
         READ (UNIT=LUN, REC=LASREC)  (XDNODE(I), I = 1, NUMNOD)        FLOPSF   2723
      END IF                                                            FLOPSF   2724
      LASREC = LASREC + 1                                               FLOPSF   2725
      READ (UNIT=LUN, REC=LASREC)  PABASE, VDBASE, PDBASE               FLOPSF   2726
C                                                                       FLOPSF   2727
      IF (IVDC .EQ. 0) GO TO 999                                        FLOPSF   2728
C                                                                       FLOPSF   2729
      DO 81 I = 1, IVDC                                                 FLOPSF   2730
C                                                                       FLOPSF   2731
         IF (IDC(I+LCDC) .NE. 0) THEN                                   FLOPSF   2732
            POSN = IDC(I+LCDC)                                          FLOPSF   2733
            LASREC = LASREC + 1                                         FLOPSF   2734
            READ (UNIT=LUN, REC=LASREC)  DCCNMR(POSN), DCCNA2(POSN),    FLOPSF   2735
     1               BDIND(POSN), VABASE(POSN), CNGRP(POSN),            FLOPSF   2736
     2               CNZONE(POSN), NSBRDG(POSN), XCOHMS(POSN),          FLOPSF   2737
     3               XLOHMS(POSN), TAPNOM(POSN)                         FLOPSF   2738
C                                                                       FLOPSF   2739
            LASREC = LASREC + 1                                         FLOPSF   2740
            READ (UNIT=LUN, REC=LASREC)  BZIND(POSN), SPTYPE(POSN),     FLOPSF   2741
     1               SPTYP3(POSN), CNVMVA(POSN)                         FLOPSF   2742
C                                                                       FLOPSF   2743
            XCOHMS(POSN) = XCOHMS(POSN) + XLOHMS(POSN)                  FLOPSF   2744
            ICTYPE(POSN) = 2                                            FLOPSF   2745
C                                                                       FLOPSF   2746
            LASREC = LASREC + 1                                         FLOPSF   2747
            READ (UNIT=LUN, REC=LASREC)  CALPHA(POSN), CGAMMA(POSN),    FLOPSF   2748
     1              TAPPOS(POSN), PHIDC(POSN),PAHVDC(POSN),             FLOPSF   2749
     2              QAHVDC(POSN), Q2HVDC(POSN), VDCONV(POSN),           FLOPSF   2750
     3              XDCONV(POSN), GAINKC(POSN)                          FLOPSF   2751
         END IF                                                         FLOPSF   2752
C                                                                       FLOPSF   2753
81    CONTINUE                                                          FLOPSF   2754
C                                                                       FLOPSF   2755
C                                                                       FLOPSF   2756
C---------------------------------------------------------------------  FLOPSF   2757
C                                                                       FLOPSF   2758
999   RETURN                                                            FLOPSF   2759
C                                                                       FLOPSF   2760
 1450 FORMAT(I3)                                                        FLOPSF   2761
 1460 FORMAT(1X,'ICPT=',I3)                                             FLOPSF   2762
 1470 FORMAT(1X,I2,I2,F11.4,F11.2,F11.2,T43,F11.5)                      FLOPSF   2763
 1480 FORMAT(1X,I2,I2,F11.4,F11.2,F11.2,F11.2,F11.4,F11.5)              FLOPSF   2764
 1490 FORMAT(1X,I2,I2,F11.4,F11.2,F11.2,T41,F11.4,F11.5)                FLOPSF   2765
 1580 FORMAT(1X,'DC CONVERTERS POWER FACTOR ANGLES(RAD):',2F10.3)       FLOPSF   2766
C                                                                       FLOPSF   2767
C---------------------------------------------------------------------  FLOPSF   2768
C                                                                       FLOPSF   2769
      END                                                               FLOPSF   2770
C                                                                       FLOPSF   2771
C*********************************************************************  FLOPSF   2772
      SUBROUTINE INVPSF( LUN, SECT, NRECS, N )                          FLOPSF   2773
CD                                                                      FLOPSF   2774
CD     TO GET THE NUMBER OF RECORDS IN THE SPECIFIED SECTION OF THE PSF FLOPSF   2775
CD                                                                      FLOPSF   2776
      IMPLICIT INTEGER(A-Z)                                             FLOPSF   2777
      CHARACTER*(*) SECT(N)                                             FLOPSF   2778
      CHARACTER*6   LSECT                                               FLOPSF   2779
      INTEGER     NRECS(N)                                              FLOPSF   2780
      INCLUDE 'PSFNAM.INS'                                              FLOPSF   2781
C                                                                       FLOPSF   2782
C  WHICH HEADER TO USE                                                  FLOPSF   2783
C                                                                       FLOPSF   2784
      DO 100 I=1,5                                                      FLOPSF   2785
        IF( LUNPSF(I).EQ.LUN ) THEN                                     FLOPSF   2786
          NN = I                                                        FLOPSF   2787
          GOTO 200                                                      FLOPSF   2788
        END IF                                                          FLOPSF   2789
100   CONTINUE                                                          FLOPSF   2790
      RETURN                                                            FLOPSF   2791
200   CONTINUE                                                          FLOPSF   2792
C                                                                       FLOPSF   2793
      DO 1000 I=1,N                                                     FLOPSF   2794
        LSECT = SECT(I)                                                 FLOPSF   2795
        CALL SETCAP( LSECT )                                            FLOPSF   2796
        SECNO = ( INDEX(SECNAM(NN),LSECT)+5 ) / 6                       FLOPSF   2797
        IF( SECNO.GT.0 ) THEN                                           FLOPSF   2798
          NRECS(I) = HDRPSF( 6 + SECNO,NN  )                            FLOPSF   2799
        ELSE                                                            FLOPSF   2800
          NRECS(I) = -1                                                 FLOPSF   2801
        END IF                                                          FLOPSF   2802
1000  CONTINUE                                                          FLOPSF   2803
      RETURN                                                            FLOPSF   2804
      END                                                               FLOPSF   2805
C*********************************************************************  FLOPSF   2806
      SUBROUTINE RDPSFI( LUN, NAME, BUF )                               FLOPSF   2807
CD                                                                      FLOPSF   2808
CD     TO READ THE SPECIFIED I*2 PSF DATA ARRAY                         FLOPSF   2809
CD                                                                      FLOPSF   2810
      IMPLICIT INTEGER(A-Z)                                             FLOPSF   2811
      INTEGER NWORDS                                                    FLOPSF   2812
      INTEGER NSECT, DIMEN, SECNO, TARRAY, ARYOFF, DLEN, DPNTR          FLOPSF   2813
      INTEGER NREC, NDX1, NDX2, I, LUN, N                               FLOPSF   2814
C                                                                       FLOPSF   2815
C LUN - LOGICAL UNIT OF THE FILE                                        FLOPSF   2816
C                                                                       FLOPSF   2817
C NAME - NAME OF THE ARRAY TO BE READ                                   FLOPSF   2818
C                                                                       FLOPSF   2819
C BUF - DESTINATION BUFFER                                              FLOPSF   2820
C                                                                       FLOPSF   2821
C MAXDIM - MAXIMUM DIMENSION OF BUF                                     FLOPSF   2822
C                                                                       FLOPSF   2823
      INTEGER*2 BUF(*)                                                  FLOPSF   2824
C                                                                       FLOPSF   2825
      INCLUDE 'PSFNAM.INS'                                              FLOPSF   2826
      CHARACTER*(*) NAME                                                FLOPSF   2827
      CHARACTER*6   LNAME                                               FLOPSF   2828
      INTEGER DPOINT(2), STAT, NXTREC, NBITS(2)                         FLOPSF   2829
      EQUIVALENCE ( DPOINT(1), STAT )                                   FLOPSF   2830
      EQUIVALENCE ( DPOINT(2), NXTREC )                                 FLOPSF   2831
C                                                                       FLOPSF   2832
      DATA  NBITS /4,28/                                                FLOPSF   2833
C                                                                       FLOPSF   2834
C  WHICH HEADER TO USE                                                  FLOPSF   2835
C                                                                       FLOPSF   2836
      DO 100 I=1,5                                                      FLOPSF   2837
        IF( LUNPSF(I).EQ.LUN ) THEN                                     FLOPSF   2838
          NN = I                                                        FLOPSF   2839
          GOTO 200                                                      FLOPSF   2840
        END IF                                                          FLOPSF   2841
100   CONTINUE                                                          FLOPSF   2842
      RETURN                                                            FLOPSF   2843
200   CONTINUE                                                          FLOPSF   2844
      LNAME = NAME                                                      FLOPSF   2845
      CALL SETCAP(LNAME)                                                FLOPSF   2846
      ARYNO = (INDEX( ARYNAM(NN), LNAME )+5) / 6                        FLOPSF   2847
      A1 = ARYNO*6                                                      FLOPSF   2848
      A0 = A1 - 5                                                       FLOPSF   2849
      IF( ARYNAM(NN)(A0:A1).NE.LNAME ) RETURN                           FLOPSF   2850
C                                                                       FLOPSF   2851
C---------------------------------------------------------------------- FLOPSF   2852
C                                                                       FLOPSF   2853
C NUMBER OF DATA SECTIONS IN THE FILE                                   FLOPSF   2854
C                                                                       FLOPSF   2855
      NSECT = HDRPSF(6,NN)                                              FLOPSF   2856
C                                                                       FLOPSF   2857
C TOTAL NUMBER OF ARRAYS                                                FLOPSF   2858
C                                                                       FLOPSF   2859
      TARRAY = HDRPSF( 6 + NSECT*2,NN )                                 FLOPSF   2860
C                                                                       FLOPSF   2861
C SECTION NUMBER                                                        FLOPSF   2862
C                                                                       FLOPSF   2863
      SECNO = SECNUM( ARYNO,NN )                                        FLOPSF   2864
C                                                                       FLOPSF   2865
C ARRAY OFFSET                                                          FLOPSF   2866
C                                                                       FLOPSF   2867
      IF( SECNO.EQ.1 ) THEN                                             FLOPSF   2868
        ARYOFF = ARYNUM(ARYNO,NN)                                       FLOPSF   2869
      ELSE                                                              FLOPSF   2870
        ARYOFF = HDRPSF(6+NSECT+SECNO-1,NN)+ARYNUM(ARYNO,NN)            FLOPSF   2871
      ENDIF                                                             FLOPSF   2872
C                                                                       FLOPSF   2873
C DIMENSION OF THE SECTION BEING READ                                   FLOPSF   2874
C                                                                       FLOPSF   2875
      DIMEN = HDRPSF( 6 + SECNO,NN  )                                   FLOPSF   2876
C                                                                       FLOPSF   2877
C DATA LENGTH OF DATA BEING READ                                        FLOPSF   2878
C                                                                       FLOPSF   2879
      DLEN = HDRPSF(6 + 2*NSECT + ARYOFF,NN )                           FLOPSF   2880
C                                                                       FLOPSF   2881
C DATA POINTER FOR ARRAY BEING READ                                     FLOPSF   2882
C                                                                       FLOPSF   2883
      DPNTR = HDRPSF(6 + 2*NSECT + TARRAY + ARYOFF,NN )                 FLOPSF   2884
C                                                                       FLOPSF   2885
      CALL DECODE( DPNTR, 2, NBITS, DPOINT )                            FLOPSF   2886
C                                                                       FLOPSF   2887
C IF FIRST RECORD POINTER IS <=1 , NOTHING TO READ                      FLOPSF   2888
C                                                                       FLOPSF   2889
      IF( NXTREC.LE.1 ) RETURN                                          FLOPSF   2890
C                                                                       FLOPSF   2891
C NUMBER OF WORDS TO READ                                               FLOPSF   2892
C                                                                       FLOPSF   2893
      NWORDS = (DIMEN * DLEN + 3) / 4                                   FLOPSF   2894
C                                                                       FLOPSF   2895
C NUMBER OF RECORDS TO READ                                             FLOPSF   2896
C                                                                       FLOPSF   2897
      NREC = (NWORDS+62) / 63                                           FLOPSF   2898
C                                                                       FLOPSF   2899
C CHECK FOR ENOUGH ROOM                                                 FLOPSF   2900
C                                                                       FLOPSF   2901
C     CHECK = MAXDIM - DIMEN                                            FLOPSF   2902
C     IF( CHECK.LT.0 ) RETURN                                           FLOPSF   2903
C                                                                       FLOPSF   2904
      NDX1 = 1                                                          FLOPSF   2905
      NDX2 = 126                                                        FLOPSF   2906
      DO 300 I = 1, NREC                                                FLOPSF   2907
        READ(UNIT=LUN,REC=NXTREC)                                       FLOPSF   2908
     +      ( BUF(N),N=NDX1,NDX2 ), NXTREC                              FLOPSF   2909
        IF( NXTREC.LE.1 ) RETURN                                        FLOPSF   2910
        NDX1 = NDX1 + 126                                               FLOPSF   2911
        NDX2 = NDX2 + 126                                               FLOPSF   2912
300   CONTINUE                                                          FLOPSF   2913
      RETURN                                                            FLOPSF   2914
      END                                                               FLOPSF   2915
C*********************************************************************  FLOPSF   2916
      SUBROUTINE RDPSFJ( LUN, NAME, BUF )                               FLOPSF   2917
CD                                                                      FLOPSF   2918
CD     TO READ THE SPECIFIED I*4 PSF DATA ARRAY                         FLOPSF   2919
CD                                                                      FLOPSF   2920
      IMPLICIT INTEGER(A-Z)                                             FLOPSF   2921
      INTEGER NWORDS                                                    FLOPSF   2922
      INTEGER NSECT, DIMEN, SECNO, TARRAY, ARYOFF, DLEN, DPNTR          FLOPSF   2923
      INTEGER NREC, NDX1, NDX2, I, LUN, N                               FLOPSF   2924
C                                                                       FLOPSF   2925
C LUN - LOGICAL UNIT OF THE FILE                                        FLOPSF   2926
C                                                                       FLOPSF   2927
C NAME - NAME OF THE ARRAY TO BE READ                                   FLOPSF   2928
C                                                                       FLOPSF   2929
C BUF - DESTINATION BUFFER                                              FLOPSF   2930
C                                                                       FLOPSF   2931
C MAXDIM - MAXIMUM DIMENSION OF BUF                                     FLOPSF   2932
C                                                                       FLOPSF   2933
      INTEGER BUF(*)                                                    FLOPSF   2934
C                                                                       FLOPSF   2935
      INCLUDE 'PSFNAM.INS'                                              FLOPSF   2936
      CHARACTER*(*) NAME                                                FLOPSF   2937
      CHARACTER*6   LNAME                                               FLOPSF   2938
      INTEGER DPOINT(2), STAT, NXTREC, NBITS(2)                         FLOPSF   2939
      EQUIVALENCE ( DPOINT(1), STAT )                                   FLOPSF   2940
      EQUIVALENCE ( DPOINT(2), NXTREC )                                 FLOPSF   2941
C                                                                       FLOPSF   2942
      DATA  NBITS /4,28/                                                FLOPSF   2943
C                                                                       FLOPSF   2944
C  WHICH HEADER TO USE                                                  FLOPSF   2945
C                                                                       FLOPSF   2946
      DO 100 I=1,5                                                      FLOPSF   2947
        IF( LUNPSF(I).EQ.LUN ) THEN                                     FLOPSF   2948
          NN = I                                                        FLOPSF   2949
          GOTO 200                                                      FLOPSF   2950
        END IF                                                          FLOPSF   2951
100   CONTINUE                                                          FLOPSF   2952
      RETURN                                                            FLOPSF   2953
200   CONTINUE                                                          FLOPSF   2954
      LNAME = NAME                                                      FLOPSF   2955
      CALL SETCAP(LNAME)                                                FLOPSF   2956
      ARYNO = (INDEX( ARYNAM(NN), LNAME )+5) / 6                        FLOPSF   2957
      A1 = ARYNO*6                                                      FLOPSF   2958
      A0 = A1 - 5                                                       FLOPSF   2959
      IF( ARYNAM(NN)(A0:A1).NE.LNAME ) RETURN                           FLOPSF   2960
C                                                                       FLOPSF   2961
C---------------------------------------------------------------------- FLOPSF   2962
C                                                                       FLOPSF   2963
C NUMBER OF DATA SECTIONS IN THE FILE                                   FLOPSF   2964
C                                                                       FLOPSF   2965
      NSECT = HDRPSF(6,NN)                                              FLOPSF   2966
C                                                                       FLOPSF   2967
C TOTAL NUMBER OF ARRAYS                                                FLOPSF   2968
C                                                                       FLOPSF   2969
      TARRAY = HDRPSF( 6 + NSECT*2,NN )                                 FLOPSF   2970
C                                                                       FLOPSF   2971
C SECTION NUMBER                                                        FLOPSF   2972
C                                                                       FLOPSF   2973
      SECNO = SECNUM( ARYNO,NN )                                        FLOPSF   2974
C                                                                       FLOPSF   2975
C ARRAY OFFSET                                                          FLOPSF   2976
C                                                                       FLOPSF   2977
      IF( SECNO.EQ.1 ) THEN                                             FLOPSF   2978
        ARYOFF = ARYNUM(ARYNO,NN)                                       FLOPSF   2979
      ELSE                                                              FLOPSF   2980
        ARYOFF = HDRPSF(6+NSECT+SECNO-1,NN)+ARYNUM(ARYNO,NN)            FLOPSF   2981
      ENDIF                                                             FLOPSF   2982
C                                                                       FLOPSF   2983
C DIMENSION OF THE SECTION BEING READ                                   FLOPSF   2984
C                                                                       FLOPSF   2985
      DIMEN = HDRPSF( 6 + SECNO,NN  )                                   FLOPSF   2986
C                                                                       FLOPSF   2987
C DATA LENGTH OF DATA BEING READ                                        FLOPSF   2988
C                                                                       FLOPSF   2989
      DLEN = HDRPSF(6 + 2*NSECT + ARYOFF,NN )                           FLOPSF   2990
C                                                                       FLOPSF   2991
C DATA POINTER FOR ARRAY BEING READ                                     FLOPSF   2992
C                                                                       FLOPSF   2993
      DPNTR = HDRPSF(6 + 2*NSECT + TARRAY + ARYOFF,NN )                 FLOPSF   2994
C                                                                       FLOPSF   2995
      CALL DECODE( DPNTR, 2, NBITS, DPOINT )                            FLOPSF   2996
C                                                                       FLOPSF   2997
C IF FIRST RECORD POINTER IS <=1 , NOTHING TO READ                      FLOPSF   2998
C                                                                       FLOPSF   2999
      IF( NXTREC.LE.1 ) RETURN                                          FLOPSF   3000
C                                                                       FLOPSF   3001
C NUMBER OF WORDS TO READ                                               FLOPSF   3002
C                                                                       FLOPSF   3003
      NWORDS = (DIMEN * DLEN + 3) / 4                                   FLOPSF   3004
C                                                                       FLOPSF   3005
C NUMBER OF RECORDS TO READ                                             FLOPSF   3006
C                                                                       FLOPSF   3007
      NREC = (NWORDS+62) / 63                                           FLOPSF   3008
C                                                                       FLOPSF   3009
C CHECK FOR ENOUGH ROOM                                                 FLOPSF   3010
C                                                                       FLOPSF   3011
C     CHECK = MAXDIM - DIMEN                                            FLOPSF   3012
C     IF( CHECK.LT.0 ) RETURN                                           FLOPSF   3013
C                                                                       FLOPSF   3014
      NDX1 = 1                                                          FLOPSF   3015
      NDX2 = 63                                                         FLOPSF   3016
      DO 300 I = 1, NREC                                                FLOPSF   3017
        READ(UNIT=LUN,REC=NXTREC)                                       FLOPSF   3018
     +      ( BUF(N),N=NDX1,NDX2 ), NXTREC                              FLOPSF   3019
        IF( NXTREC.LE.1 ) RETURN                                        FLOPSF   3020
        NDX1 = NDX1 + 63                                                FLOPSF   3021
        NDX2 = NDX2 + 63                                                FLOPSF   3022
300   CONTINUE                                                          FLOPSF   3023
      RETURN                                                            FLOPSF   3024
      END                                                               FLOPSF   3025
C*********************************************************************  FLOPSF   3026
      SUBROUTINE RDPSFR( LUN, NAME, BUF )                               FLOPSF   3027
CD                                                                      FLOPSF   3028
CD     TO READ THE SPECIFIED R*4 PSF DATA ARRAY                         FLOPSF   3029
CD                                                                      FLOPSF   3030
      IMPLICIT INTEGER(A-Z)                                             FLOPSF   3031
      INTEGER NWORDS                                                    FLOPSF   3032
      INTEGER NSECT, DIMEN, SECNO, TARRAY, ARYOFF, DLEN, DPNTR          FLOPSF   3033
      INTEGER NREC, NDX1, NDX2, I, LUN, N                               FLOPSF   3034
C                                                                       FLOPSF   3035
C LUN - LOGICAL UNIT OF THE FILE                                        FLOPSF   3036
C                                                                       FLOPSF   3037
C NAME - NAME OF THE ARRAY TO BE READ                                   FLOPSF   3038
C                                                                       FLOPSF   3039
C BUF - DESTINATION BUFFER                                              FLOPSF   3040
C                                                                       FLOPSF   3041
C MAXDIM - MAXIMUM DIMENSION OF BUF                                     FLOPSF   3042
C                                                                       FLOPSF   3043
      REAL BUF(*)                                                       FLOPSF   3044
C                                                                       FLOPSF   3045
      INCLUDE 'PSFNAM.INS'                                              FLOPSF   3046
      CHARACTER*(*) NAME                                                FLOPSF   3047
      CHARACTER*6   LNAME                                               FLOPSF   3048
      INTEGER DPOINT(2), STAT, NXTREC, NBITS(2)                         FLOPSF   3049
      EQUIVALENCE ( DPOINT(1), STAT )                                   FLOPSF   3050
      EQUIVALENCE ( DPOINT(2), NXTREC )                                 FLOPSF   3051
C                                                                       FLOPSF   3052
      DATA  NBITS /4,28/                                                FLOPSF   3053
C                                                                       FLOPSF   3054
C  WHICH HEADER TO USE                                                  FLOPSF   3055
C                                                                       FLOPSF   3056
      DO 100 I=1,5                                                      FLOPSF   3057
        IF( LUNPSF(I).EQ.LUN ) THEN                                     FLOPSF   3058
          NN = I                                                        FLOPSF   3059
          GOTO 200                                                      FLOPSF   3060
        END IF                                                          FLOPSF   3061
100   CONTINUE                                                          FLOPSF   3062
      RETURN                                                            FLOPSF   3063
200   CONTINUE                                                          FLOPSF   3064
      LNAME = NAME                                                      FLOPSF   3065
      CALL SETCAP(LNAME)                                                FLOPSF   3066
      ARYNO = (INDEX( ARYNAM(NN), LNAME )+5) / 6                        FLOPSF   3067
      A1 = ARYNO*6                                                      FLOPSF   3068
      A0 = A1 - 5                                                       FLOPSF   3069
      IF( ARYNAM(NN)(A0:A1).NE.LNAME ) RETURN                           FLOPSF   3070
C                                                                       FLOPSF   3071
C---------------------------------------------------------------------- FLOPSF   3072
C                                                                       FLOPSF   3073
C NUMBER OF DATA SECTIONS IN THE FILE                                   FLOPSF   3074
C                                                                       FLOPSF   3075
      NSECT = HDRPSF(6,NN)                                              FLOPSF   3076
C                                                                       FLOPSF   3077
C TOTAL NUMBER OF ARRAYS                                                FLOPSF   3078
C                                                                       FLOPSF   3079
      TARRAY = HDRPSF( 6 + NSECT*2,NN )                                 FLOPSF   3080
C                                                                       FLOPSF   3081
C SECTION NUMBER                                                        FLOPSF   3082
C                                                                       FLOPSF   3083
      SECNO = SECNUM( ARYNO,NN )                                        FLOPSF   3084
C                                                                       FLOPSF   3085
C ARRAY OFFSET                                                          FLOPSF   3086
C                                                                       FLOPSF   3087
      IF( SECNO.EQ.1 ) THEN                                             FLOPSF   3088
        ARYOFF = ARYNUM(ARYNO,NN)                                       FLOPSF   3089
      ELSE                                                              FLOPSF   3090
        ARYOFF = HDRPSF(6+NSECT+SECNO-1,NN)+ARYNUM(ARYNO,NN)            FLOPSF   3091
      ENDIF                                                             FLOPSF   3092
C                                                                       FLOPSF   3093
C DIMENSION OF THE SECTION BEING READ                                   FLOPSF   3094
C                                                                       FLOPSF   3095
      DIMEN = HDRPSF( 6 + SECNO,NN  )                                   FLOPSF   3096
C                                                                       FLOPSF   3097
C DATA LENGTH OF DATA BEING READ                                        FLOPSF   3098
C                                                                       FLOPSF   3099
      DLEN = HDRPSF(6 + 2*NSECT + ARYOFF,NN )                           FLOPSF   3100
C                                                                       FLOPSF   3101
C DATA POINTER FOR ARRAY BEING READ                                     FLOPSF   3102
C                                                                       FLOPSF   3103
      DPNTR = HDRPSF(6 + 2*NSECT + TARRAY + ARYOFF,NN )                 FLOPSF   3104
C                                                                       FLOPSF   3105
      CALL DECODE( DPNTR, 2, NBITS, DPOINT )                            FLOPSF   3106
C                                                                       FLOPSF   3107
C IF FIRST RECORD POINTER IS <=1 , NOTHING TO READ                      FLOPSF   3108
C                                                                       FLOPSF   3109
      IF( NXTREC.LE.1 ) RETURN                                          FLOPSF   3110
C                                                                       FLOPSF   3111
C NUMBER OF WORDS TO READ                                               FLOPSF   3112
C                                                                       FLOPSF   3113
      NWORDS = (DIMEN * DLEN + 3) / 4                                   FLOPSF   3114
C                                                                       FLOPSF   3115
C NUMBER OF RECORDS TO READ                                             FLOPSF   3116
C                                                                       FLOPSF   3117
      NREC = (NWORDS+62) / 63                                           FLOPSF   3118
C                                                                       FLOPSF   3119
C CHECK FOR ENOUGH ROOM                                                 FLOPSF   3120
C                                                                       FLOPSF   3121
C     CHECK = MAXDIM - DIMEN                                            FLOPSF   3122
C     IF( CHECK.LT.0 ) RETURN                                           FLOPSF   3123
C                                                                       FLOPSF   3124
      NDX1 = 1                                                          FLOPSF   3125
      NDX2 = 63                                                         FLOPSF   3126
      DO 300 I = 1, NREC                                                FLOPSF   3127
        READ(UNIT=LUN,REC=NXTREC)                                       FLOPSF   3128
     +      ( BUF(N),N=NDX1,NDX2 ), NXTREC                              FLOPSF   3129
        IF( NXTREC.LE.1 ) RETURN                                        FLOPSF   3130
        NDX1 = NDX1 + 63                                                FLOPSF   3131
        NDX2 = NDX2 + 63                                                FLOPSF   3132
300   CONTINUE                                                          FLOPSF   3133
      RETURN                                                            FLOPSF   3134
      END                                                               FLOPSF   3135
C*********************************************************************  FLOPSF   3136
      SUBROUTINE RDPSFX( LUN, NAME, BUF )                               FLOPSF   3137
CD                                                                      FLOPSF   3138
CD     TO READ THE SPECIFIED C*8 PSF DATA ARRAY                         FLOPSF   3139
CD                                                                      FLOPSF   3140
      IMPLICIT INTEGER(A-Z)                                             FLOPSF   3141
      INTEGER NWORDS                                                    FLOPSF   3142
      INTEGER NSECT, DIMEN, SECNO, TARRAY, ARYOFF, DLEN, DPNTR          FLOPSF   3143
      INTEGER NREC, NDX1, NDX2, I, LUN, N                               FLOPSF   3144
C                                                                       FLOPSF   3145
C LUN - LOGICAL UNIT OF THE FILE                                        FLOPSF   3146
C                                                                       FLOPSF   3147
C NAME - NAME OF THE ARRAY TO BE READ                                   FLOPSF   3148
C                                                                       FLOPSF   3149
C BUF - DESTINATION BUFFER                                              FLOPSF   3150
C                                                                       FLOPSF   3151
C MAXDIM - MAXIMUM DIMENSION OF BUF                                     FLOPSF   3152
C                                                                       FLOPSF   3153
      COMPLEX BUF(*)                                                    FLOPSF   3154
C                                                                       FLOPSF   3155
      REAL*4 RPART, IPART                                               FLOPSF   3156
      INCLUDE 'PSFNAM.INS'                                              FLOPSF   3157
      CHARACTER*(*) NAME                                                FLOPSF   3158
      CHARACTER*6   LNAME                                               FLOPSF   3159
      INTEGER DPOINT(2), STAT, NXTREC, NBITS(2)                         FLOPSF   3160
      EQUIVALENCE ( DPOINT(1), STAT )                                   FLOPSF   3161
      EQUIVALENCE ( DPOINT(2), NXTREC )                                 FLOPSF   3162
C                                                                       FLOPSF   3163
      DATA  NBITS /4,28/                                                FLOPSF   3164
C                                                                       FLOPSF   3165
C  WHICH HEADER TO USE                                                  FLOPSF   3166
C                                                                       FLOPSF   3167
      DO 100 I=1,5                                                      FLOPSF   3168
        IF( LUNPSF(I).EQ.LUN ) THEN                                     FLOPSF   3169
          NN = I                                                        FLOPSF   3170
          GOTO 200                                                      FLOPSF   3171
        END IF                                                          FLOPSF   3172
100   CONTINUE                                                          FLOPSF   3173
      RETURN                                                            FLOPSF   3174
200   CONTINUE                                                          FLOPSF   3175
      LNAME = NAME                                                      FLOPSF   3176
      CALL SETCAP(LNAME)                                                FLOPSF   3177
      ARYNO = (INDEX( ARYNAM(NN), LNAME )+5) / 6                        FLOPSF   3178
      A1 = ARYNO*6                                                      FLOPSF   3179
      A0 = A1 - 5                                                       FLOPSF   3180
      IF( ARYNAM(NN)(A0:A1).NE.LNAME ) RETURN                           FLOPSF   3181
C                                                                       FLOPSF   3182
C---------------------------------------------------------------------- FLOPSF   3183
C                                                                       FLOPSF   3184
C NUMBER OF DATA SECTIONS IN THE FILE                                   FLOPSF   3185
C                                                                       FLOPSF   3186
      NSECT = HDRPSF(6,NN)                                              FLOPSF   3187
C                                                                       FLOPSF   3188
C TOTAL NUMBER OF ARRAYS                                                FLOPSF   3189
C                                                                       FLOPSF   3190
      TARRAY = HDRPSF( 6 + NSECT*2,NN )                                 FLOPSF   3191
C                                                                       FLOPSF   3192
C SECTION NUMBER                                                        FLOPSF   3193
C                                                                       FLOPSF   3194
      SECNO = SECNUM( ARYNO,NN )                                        FLOPSF   3195
C                                                                       FLOPSF   3196
C ARRAY OFFSET                                                          FLOPSF   3197
C                                                                       FLOPSF   3198
      IF( SECNO.EQ.1 ) THEN                                             FLOPSF   3199
        ARYOFF = ARYNUM(ARYNO,NN)                                       FLOPSF   3200
      ELSE                                                              FLOPSF   3201
        ARYOFF = HDRPSF(6+NSECT+SECNO-1,NN)+ARYNUM(ARYNO,NN)            FLOPSF   3202
      ENDIF                                                             FLOPSF   3203
C                                                                       FLOPSF   3204
C DIMENSION OF THE SECTION BEING READ                                   FLOPSF   3205
C                                                                       FLOPSF   3206
      DIMEN = HDRPSF( 6 + SECNO,NN  )                                   FLOPSF   3207
C                                                                       FLOPSF   3208
C DATA LENGTH OF DATA BEING READ                                        FLOPSF   3209
C                                                                       FLOPSF   3210
      DLEN = HDRPSF(6 + 2*NSECT + ARYOFF,NN )                           FLOPSF   3211
C                                                                       FLOPSF   3212
C DATA POINTER FOR ARRAY BEING READ                                     FLOPSF   3213
C                                                                       FLOPSF   3214
      DPNTR = HDRPSF(6 + 2*NSECT + TARRAY + ARYOFF,NN )                 FLOPSF   3215
C                                                                       FLOPSF   3216
      CALL DECODE( DPNTR, 2, NBITS, DPOINT )                            FLOPSF   3217
C                                                                       FLOPSF   3218
C IF FIRST RECORD POINTER IS <=1 , NOTHING TO READ                      FLOPSF   3219
C                                                                       FLOPSF   3220
      IF( NXTREC.LE.1 ) RETURN                                          FLOPSF   3221
C                                                                       FLOPSF   3222
C NUMBER OF WORDS TO READ                                               FLOPSF   3223
C                                                                       FLOPSF   3224
      NWORDS = (DIMEN * DLEN + 3) / 4                                   FLOPSF   3225
C                                                                       FLOPSF   3226
C NUMBER OF RECORDS TO READ                                             FLOPSF   3227
C                                                                       FLOPSF   3228
      NREC = (NWORDS+62) / 63                                           FLOPSF   3229
C                                                                       FLOPSF   3230
C CHECK FOR ENOUGH ROOM                                                 FLOPSF   3231
C                                                                       FLOPSF   3232
C     CHECK = MAXDIM - DIMEN                                            FLOPSF   3233
C     IF( CHECK.LT.0 ) RETURN                                           FLOPSF   3234
C                                                                       FLOPSF   3235
      NDX1 = 1                                                          FLOPSF   3236
      NDX2 = 31                                                         FLOPSF   3237
      PASS = 0                                                          FLOPSF   3238
      DO 300 I = 1, NREC                                                FLOPSF   3239
        IF( PASS.EQ.0 ) THEN                                            FLOPSF   3240
          READ(UNIT=LUN,REC=NXTREC)                                     FLOPSF   3241
     +      ( BUF(N),N=NDX1,NDX2 ), RPART, NXTREC                       FLOPSF   3242
        ELSE                                                            FLOPSF   3243
          READ(UNIT=LUN,REC=NXTREC)                                     FLOPSF   3244
     +      IPART, ( BUF(N),N=NDX1,NDX2 ), NXTREC                       FLOPSF   3245
            BUF( NDX1-1 ) = CMPLX(RPART,IPART)                          FLOPSF   3246
        END IF                                                          FLOPSF   3247
        PASS = 1 - PASS                                                 FLOPSF   3248
        IF( NXTREC.LE.1 ) RETURN                                        FLOPSF   3249
        NDX1 = NDX1 + 31 + PASS                                         FLOPSF   3250
        NDX2 = NDX2 + 31 + PASS                                         FLOPSF   3251
300   CONTINUE                                                          FLOPSF   3252
      RETURN                                                            FLOPSF   3253
      END                                                               FLOPSF   3254
C*********************************************************************  FLOPSF   3255
      SUBROUTINE  DECODE( IVAL, NVAL, NBITS, VALS )                     FLOPSF   3256
CD                                                                      FLOPSF   3257
CD    THIS SUBROUTINE EXTRACTS DECODE VALUES FROM A SINGLE INTEGER AND  FLOPSF   3258
CD    PLACES THE RESULTS IN TWO OR MORE ELEMENTS OF AN INTEGER ARAY.    FLOPSF   3259
CD                                                                      FLOPSF   3260
CD    IVAL INTEGER I - THE VALUE TO BE DECODED                          FLOPSF   3261
CD    NVAL INTEGER I - THE NUMBER OFG VALUES TO BE DECODED              FLOPSF   3262
CD    NBITS INTEGER I - ARRAY OF BIT LENGTHS FOR EACH VALUE             FLOPSF   3263
CD    VALS INTEGER O - DECODED RESULT ARRAY                             FLOPSF   3264
CD                                                                      FLOPSF   3265
      INTEGER NVAL, I, BY0, BY1, K, J, BY                               FLOPSF   3266
      INTEGER     NBITS(NVAL), VALS(NVAL)                               FLOPSF   3267
      INTEGER     IVAL                                                  FLOPSF   3268
      CHARACTER*1 CRSLT(4)                                              FLOPSF   3269
      INTEGER     RESULT                                                FLOPSF   3270
      LOGICAL     ODD                                                   FLOPSF   3271
      EQUIVALENCE ( RESULT, CRSLT )                                     FLOPSF   3272
      INTEGER     BITS(32)                                              FLOPSF   3273
      INTEGER     CALC                                                  FLOPSF   3274
      CHARACTER*4 CCALC                                                 FLOPSF   3275
      EQUIVALENCE ( CALC, CCALC )                                       FLOPSF   3276
      INTEGER XBIT                                                      FLOPSF   3277
      LOGICAL FIRST                                                     FLOPSF   3278
      COMMON /ENCDEC/ XBIT                                              FLOPSF   3279
      DATA FIRST/.TRUE./                                                FLOPSF   3280
      IF( FIRST ) THEN                                                  FLOPSF   3281
        FIRST = .FALSE.                                                 FLOPSF   3282
        CALC = 32                                                       FLOPSF   3283
        DO 987 I = 1, 4                                                 FLOPSF   3284
          IF( ICHAR( CCALC(I:I) ) .EQ. 32 ) XBIT = I                    FLOPSF   3285
987     CONTINUE                                                        FLOPSF   3286
      END IF                                                            FLOPSF   3287
C                                                                       FLOPSF   3288
      RESULT = IVAL                                                     FLOPSF   3289
      DO 20 I = 1 , 4                                                   FLOPSF   3290
        BY0 = (I-1)*8 + 1                                               FLOPSF   3291
        BY1 = BY0 + 7                                                   FLOPSF   3292
        CALC = 0                                                        FLOPSF   3293
        K = 5-I                                                         FLOPSF   3294
        CCALC(XBIT:XBIT) = CRSLT(K)                                     FLOPSF   3295
        DO 10 J = BY1, BY0, -1                                          FLOPSF   3296
          IF( ODD(CALC) ) THEN                                          FLOPSF   3297
            BITS(J) = 1                                                 FLOPSF   3298
          ELSE                                                          FLOPSF   3299
            BITS(J) = 0                                                 FLOPSF   3300
          ENDIF                                                         FLOPSF   3301
          CALC = CALC / 2                                               FLOPSF   3302
10      CONTINUE                                                        FLOPSF   3303
20    CONTINUE                                                          FLOPSF   3304
C                                                                       FLOPSF   3305
      BY1 = 0                                                           FLOPSF   3306
      DO 40 I=1,NVAL                                                    FLOPSF   3307
        BY0 = BY1 + 1                                                   FLOPSF   3308
        BY1 = BY1 + NBITS(I)                                            FLOPSF   3309
        VALS(I) = 0                                                     FLOPSF   3310
        DO 30 BY = BY0, BY1                                             FLOPSF   3311
          VALS(I) = VALS(I) * 2 + BITS(BY)                              FLOPSF   3312
30      CONTINUE                                                        FLOPSF   3313
40    CONTINUE                                                          FLOPSF   3314
C                                                                       FLOPSF   3315
      RETURN                                                            FLOPSF   3316
      END                                                               FLOPSF   3317
C*********************************************************************  FLOPSF   3318
      INTEGER FUNCTION TAGVAL( KEY, N, DAT, TAG, NDX )                  FLOPSF   3319
CD                                                                      FLOPSF   3320
CD     TO GET THE RECORD NUMBER AND THE INDEX GIVEN                     FLOPSF   3321
CD     THE DATA AND THE TAG ARRAYS (ORIGINALLY SORTED BT TAGSRT)        FLOPSF   3322
CD                                                                      FLOPSF   3323
      IMPLICIT NONE                                                     FLOPSF   3324
C                                                                       FLOPSF   3325
      INTEGER KEY                                                       FLOPSF   3326
      INTEGER N, FOUND, FIRST, LAST, POINT, NDX                         FLOPSF   3327
      INTEGER*2 TAG(N)                                                  FLOPSF   3328
      INTEGER DAT(N)                                                    FLOPSF   3329
C                                                                       FLOPSF   3330
      LOGICAL ODD                                                       FLOPSF   3331
C                                                                       FLOPSF   3332
      FOUND = 0                                                         FLOPSF   3333
      FIRST = 1                                                         FLOPSF   3334
      LAST = N                                                          FLOPSF   3335
100   CONTINUE                                                          FLOPSF   3336
      POINT = (FIRST + LAST) / 2                                        FLOPSF   3337
      IF( DAT(TAG(POINT)) .EQ. KEY ) THEN                               FLOPSF   3338
        FOUND = 1                                                       FLOPSF   3339
      ELSE IF( DAT(TAG(POINT)) .GT. KEY ) THEN                          FLOPSF   3340
        LAST = POINT                                                    FLOPSF   3341
      ELSE                                                              FLOPSF   3342
        FIRST = POINT                                                   FLOPSF   3343
      ENDIF                                                             FLOPSF   3344
      IF( .NOT. ODD(FOUND) ) THEN                                       FLOPSF   3345
        IF( LAST-FIRST .GT. 1 ) GOTO 100                                FLOPSF   3346
        IF( DAT(TAG(FIRST)) .EQ. KEY ) THEN                             FLOPSF   3347
          POINT = FIRST                                                 FLOPSF   3348
          FOUND = 1                                                     FLOPSF   3349
        ENDIF                                                           FLOPSF   3350
        IF( DAT(TAG(LAST)) .EQ. KEY ) THEN                              FLOPSF   3351
          POINT = LAST                                                  FLOPSF   3352
          FOUND = 1                                                     FLOPSF   3353
        ENDIF                                                           FLOPSF   3354
      ENDIF                                                             FLOPSF   3355
200   IF( ODD(FOUND) ) THEN                                             FLOPSF   3356
        IF( POINT.GT.1 ) THEN                                           FLOPSF   3357
          IF( DAT(TAG(POINT-1)) .EQ. KEY ) THEN                         FLOPSF   3358
            POINT = POINT - 1                                           FLOPSF   3359
            GOTO 200                                                    FLOPSF   3360
          ENDIF                                                         FLOPSF   3361
        ENDIF                                                           FLOPSF   3362
        TAGVAL = TAG(POINT)                                             FLOPSF   3363
      ELSE                                                              FLOPSF   3364
        IF( POINT.GT.0 ) THEN                                           FLOPSF   3365
          IF( DAT(TAG(POINT)) .GE. KEY ) THEN                           FLOPSF   3366
            POINT = POINT - 1                                           FLOPSF   3367
            GOTO 200                                                    FLOPSF   3368
          ENDIF                                                         FLOPSF   3369
        ENDIF                                                           FLOPSF   3370
        TAGVAL = 0                                                      FLOPSF   3371
      ENDIF                                                             FLOPSF   3372
      NDX = POINT                                                       FLOPSF   3373
C                                                                       FLOPSF   3374
      RETURN                                                            FLOPSF   3375
      END                                                               FLOPSF   3376
C*********************************************************************  FLOPSF   3377
      INTEGER FUNCTION TGVAL4( KEY, N, DAT, TAG, NDX )                  FLOPSF   3378
CD                                                                      FLOPSF   3379
CD     TO GET THE RECORD NUMBER AND THE INDEX GIVEN                     FLOPSF   3380
CD     THE DATA AND THE TAG ARRAYS (ORIGINALLY SORTED BT TGSRT4)        FLOPSF   3381
CD                                                                      FLOPSF   3382
      IMPLICIT NONE                                                     FLOPSF   3383
      INTEGER N, FOUND, FIRST, LAST, POINT, NDX, I                      FLOPSF   3384
      CHARACTER*16 KEY, LDAT                                            FLOPSF   3385
      INTEGER*4         DATL(4)                                         FLOPSF   3386
      EQUIVALENCE       ( LDAT, DATL )                                  FLOPSF   3387
      INTEGER*2 TAG(N)                                                  FLOPSF   3388
      INTEGER DAT(4,N)                                                  FLOPSF   3389
      LOGICAL ODD                                                       FLOPSF   3390
C                                                                       FLOPSF   3391
      FOUND = 0                                                         FLOPSF   3392
      FIRST = 1                                                         FLOPSF   3393
      LAST = N                                                          FLOPSF   3394
100   CONTINUE                                                          FLOPSF   3395
      POINT = (FIRST + LAST) / 2                                        FLOPSF   3396
      DO 901 I = 1, 4                                                   FLOPSF   3397
        DATL(I) = DAT(I,TAG(POINT))                                     FLOPSF   3398
901   CONTINUE                                                          FLOPSF   3399
      IF( LDAT .EQ. KEY ) THEN                                          FLOPSF   3400
        FOUND = 1                                                       FLOPSF   3401
      ELSE IF( LDAT .GT. KEY ) THEN                                     FLOPSF   3402
        LAST = POINT                                                    FLOPSF   3403
      ELSE                                                              FLOPSF   3404
        FIRST = POINT                                                   FLOPSF   3405
      ENDIF                                                             FLOPSF   3406
      IF( .NOT. ODD(FOUND) ) THEN                                       FLOPSF   3407
        IF( LAST-FIRST .GT. 1 ) GOTO 100                                FLOPSF   3408
        DO 902 I = 1, 4                                                 FLOPSF   3409
          DATL(I) = DAT(I,TAG(FIRST))                                   FLOPSF   3410
902     CONTINUE                                                        FLOPSF   3411
        IF( LDAT .EQ. KEY ) THEN                                        FLOPSF   3412
          POINT = FIRST                                                 FLOPSF   3413
          FOUND = 1                                                     FLOPSF   3414
        ENDIF                                                           FLOPSF   3415
        DO 903 I = 1, 4                                                 FLOPSF   3416
          DATL(I) = DAT(I,TAG(LAST))                                    FLOPSF   3417
903     CONTINUE                                                        FLOPSF   3418
        IF( LDAT .EQ. KEY ) THEN                                        FLOPSF   3419
          POINT = LAST                                                  FLOPSF   3420
          FOUND = 1                                                     FLOPSF   3421
        ENDIF                                                           FLOPSF   3422
      ENDIF                                                             FLOPSF   3423
200   IF( ODD(FOUND) ) THEN                                             FLOPSF   3424
        IF( POINT.GT.1 ) THEN                                           FLOPSF   3425
          DO 904 I = 1, 4                                               FLOPSF   3426
            DATL(I) = DAT(I,TAG(POINT-1))                               FLOPSF   3427
904       CONTINUE                                                      FLOPSF   3428
          IF( LDAT .EQ. KEY ) THEN                                      FLOPSF   3429
            POINT = POINT - 1                                           FLOPSF   3430
            GOTO 200                                                    FLOPSF   3431
          ENDIF                                                         FLOPSF   3432
        ENDIF                                                           FLOPSF   3433
        TGVAL4 = TAG(POINT)                                             FLOPSF   3434
      ELSE                                                              FLOPSF   3435
        IF( POINT.GT.0 ) THEN                                           FLOPSF   3436
          IF( LDAT .GE. KEY ) THEN                                      FLOPSF   3437
            POINT = POINT - 1                                           FLOPSF   3438
            GOTO 200                                                    FLOPSF   3439
          ENDIF                                                         FLOPSF   3440
        ENDIF                                                           FLOPSF   3441
        TGVAL4 = 0                                                      FLOPSF   3442
      ENDIF                                                             FLOPSF   3443
      NDX = POINT                                                       FLOPSF   3444
C                                                                       FLOPSF   3445
      RETURN                                                            FLOPSF   3446
      END                                                               FLOPSF   3447
C*********************************************************************  FLOPSF   3448
      INTEGER FUNCTION TRMLEN( STRNG )                                  FLOPSF   3449
CD                                                                      FLOPSF   3450
CD     TO GET THE LENGTH OF A CHARACTER STRING                          FLOPSF   3451
CD     AFTER TRIMMING THE TRAILING BLANKS                               FLOPSF   3452
CD                                                                      FLOPSF   3453
      INTEGER MAXLEN, L, J                                              FLOPSF   3454
      CHARACTER*(*) STRNG                                               FLOPSF   3455
      CHARACTER*1   SPCE10(10)                                          FLOPSF   3456
      CHARACTER*10  SPACES                                              FLOPSF   3457
      EQUIVALENCE ( SPACES,SPCE10 )                                     FLOPSF   3458
C                                                                       FLOPSF   3459
      DATA  SPCE10 /10*' '/                                             FLOPSF   3460
C                                                                       FLOPSF   3461
      MAXLEN = LEN( STRNG )                                             FLOPSF   3462
      IF( MAXLEN.LE.10 ) THEN                                           FLOPSF   3463
        TRMLEN = 1                                                      FLOPSF   3464
        L = MAXLEN                                                      FLOPSF   3465
        GOTO 20                                                         FLOPSF   3466
      ENDIF                                                             FLOPSF   3467
      TRMLEN = MAXLEN - 9                                               FLOPSF   3468
C                                                                       FLOPSF   3469
10    CONTINUE                                                          FLOPSF   3470
      L = TRMLEN + 9                                                    FLOPSF   3471
      IF( STRNG(TRMLEN:L) .EQ. SPACES ) THEN                            FLOPSF   3472
        TRMLEN = TRMLEN - 10                                            FLOPSF   3473
        IF( TRMLEN .GT. 0 ) GOTO 10                                     FLOPSF   3474
        TRMLEN = 1                                                      FLOPSF   3475
      END IF                                                            FLOPSF   3476
C                                                                       FLOPSF   3477
      IF( TRMLEN .EQ. 0 ) THEN                                          FLOPSF   3478
        TRMLEN = 1                                                      FLOPSF   3479
        RETURN                                                          FLOPSF   3480
      ENDIF                                                             FLOPSF   3481
      L = TRMLEN + 9                                                    FLOPSF   3482
20    DO 100 J=L,TRMLEN,-1                                              FLOPSF   3483
        IF( STRNG(J:J) .NE. ' ' ) THEN                                  FLOPSF   3484
          TRMLEN = J                                                    FLOPSF   3485
          GOTO 150                                                      FLOPSF   3486
        ENDIF                                                           FLOPSF   3487
100   CONTINUE                                                          FLOPSF   3488
150   CONTINUE                                                          FLOPSF   3489
C                                                                       FLOPSF   3490
      RETURN                                                            FLOPSF   3491
      END                                                               FLOPSF   3492
C*********************************************************************  FLOPSF   3493
      SUBROUTINE SETCAP (STRNG)                                         FLOPSF   3494
CD                                                                      FLOPSF   3495
CD     TO SET A CHARACTER STRING TO ALL UPPERCASE                       FLOPSF   3496
CD                                                                      FLOPSF   3497
      IMPLICIT NONE                                                     FLOPSF   3498
      INTEGER LSTRNG, TRMLEN, I, V, DIFF, ICHAR                         FLOPSF   3499
      CHARACTER*(*) STRNG                                               FLOPSF   3500
C                                                                       FLOPSF   3501
      LSTRNG = TRMLEN (STRNG)                                           FLOPSF   3502
      DIFF = ICHAR ('A') - ICHAR ('A')                                  FLOPSF   3503
      DO 10 I=1, LSTRNG                                                 FLOPSF   3504
        V = ICHAR (STRNG(I:I))                                          FLOPSF   3505
        IF (V .GE. ICHAR ('A') .AND. V .LE. ICHAR ('Z'))                FLOPSF   3506
     +       STRNG(I:I) = CHAR (V-DIFF)                                 FLOPSF   3507
10    CONTINUE                                                          FLOPSF   3508
C                                                                       FLOPSF   3509
      RETURN                                                            FLOPSF   3510
      END                                                               FLOPSF   3511
C*********************************************************************  FLOPSF   3512
      SUBROUTINE TAGSRT( N, DAT, TAG )                                  FLOPSF   3513
CD                                                                      FLOPSF   3514
CD     TO SORT AN I*4 ARRAY IN INCREASING ORDER                         FLOPSF   3515
CD                                                                      FLOPSF   3516
      IMPLICIT INTEGER(A-Z)                                             FLOPSF   3517
      INTEGER N, I, J, L                                                FLOPSF   3518
      INTEGER*2 TAG(*)                                                  FLOPSF   3519
      INTEGER*4 DAT(*)                                                  FLOPSF   3520
      INTEGER IL(64), IU(64)                                            FLOPSF   3521
      TAG(1) = 0                                                        FLOPSF   3522
      ENTRY RESORT( N, DAT, TAG )                                       FLOPSF   3523
      IF( N.LT.2 ) THEN                                                 FLOPSF   3524
        TAG(1) = 1                                                      FLOPSF   3525
        RETURN                                                          FLOPSF   3526
      END IF                                                            FLOPSF   3527
      IF( TAG(1).LE.0 ) THEN                                            FLOPSF   3528
        DO 6 I=1,N                                                      FLOPSF   3529
          TAG(I) = I                                                    FLOPSF   3530
6       CONTINUE                                                        FLOPSF   3531
      END IF                                                            FLOPSF   3532
C                                                                       FLOPSF   3533
      M = 1                                                             FLOPSF   3534
      I = 1                                                             FLOPSF   3535
      II = 1                                                            FLOPSF   3536
      J = N                                                             FLOPSF   3537
10    IF( I.GE.J ) GOTO 130                                             FLOPSF   3538
20    K = I                                                             FLOPSF   3539
      IJ = (I+J)/2                                                      FLOPSF   3540
      TEST = TAG(IJ)                                                    FLOPSF   3541
      IF( DAT(TAG(I)) .LE. DAT(TEST) ) GOTO 40                          FLOPSF   3542
30    TAG(IJ) = TAG(I)                                                  FLOPSF   3543
      TAG(I) = TEST                                                     FLOPSF   3544
      TEST = TAG(IJ)                                                    FLOPSF   3545
40    L = J                                                             FLOPSF   3546
      IF( DAT(TAG(J)) .GE. DAT(TEST) ) GOTO 80                          FLOPSF   3547
50    TAG(IJ) = TAG(J)                                                  FLOPSF   3548
      TAG(J) = TEST                                                     FLOPSF   3549
      TEST = TAG(IJ)                                                    FLOPSF   3550
      IF( DAT(TAG(I)).LE.DAT(TEST) ) GOTO 80                            FLOPSF   3551
60    TAG(IJ) = TAG(I)                                                  FLOPSF   3552
      TAG(I) = TEST                                                     FLOPSF   3553
      TEST = TAG(IJ)                                                    FLOPSF   3554
      GOTO 80                                                           FLOPSF   3555
70    TAG(L) = TAG(K)                                                   FLOPSF   3556
      TAG(K) = TEST2                                                    FLOPSF   3557
80    L = L - 1                                                         FLOPSF   3558
      IF( DAT(TAG(L)).GT.DAT(TEST) ) GOTO 80                            FLOPSF   3559
90    TEST2 = TAG(L)                                                    FLOPSF   3560
100   K = K + 1                                                         FLOPSF   3561
      IF( DAT(TAG(K)).LT.DAT(TEST) ) GOTO 100                           FLOPSF   3562
110   IF( K.LE.L ) GOTO 70                                              FLOPSF   3563
      IF( L-I .LE. J-K ) GOTO 120                                       FLOPSF   3564
      IL(M) = I                                                         FLOPSF   3565
      IU(M) = L                                                         FLOPSF   3566
      I = K                                                             FLOPSF   3567
      M = M + 1                                                         FLOPSF   3568
      GOTO 140                                                          FLOPSF   3569
120   IL(M) = K                                                         FLOPSF   3570
      IU(M) = J                                                         FLOPSF   3571
      J = L                                                             FLOPSF   3572
      M = M + 1                                                         FLOPSF   3573
      GOTO 140                                                          FLOPSF   3574
130   M = M - 1                                                         FLOPSF   3575
      IF ( M.EQ.0 ) GOTO 190                                            FLOPSF   3576
      I = IL(M)                                                         FLOPSF   3577
      J = IU(M)                                                         FLOPSF   3578
140   IF( J-I.GE.11 ) GOTO 20                                           FLOPSF   3579
      IF( I.EQ.II ) GOTO 10                                             FLOPSF   3580
      I = I - 1                                                         FLOPSF   3581
150   I = I + 1                                                         FLOPSF   3582
      IF( I.GE.J ) GOTO 130                                             FLOPSF   3583
      TEST = TAG(I+1)                                                   FLOPSF   3584
      IF( DAT(TAG(I)).LE.DAT(TEST) ) GOTO 150                           FLOPSF   3585
160   K = I                                                             FLOPSF   3586
170   TAG(K+1) = TAG(K)                                                 FLOPSF   3587
      K = K - 1                                                         FLOPSF   3588
      IF( DAT(TEST).LT.DAT(TAG(K)) ) GOTO 170                           FLOPSF   3589
180   TAG(K+1) = TEST                                                   FLOPSF   3590
      GOTO 150                                                          FLOPSF   3591
190   RETURN                                                            FLOPSF   3592
      END                                                               FLOPSF   3593
C*********************************************************************  FLOPSF   3594
      SUBROUTINE TGSRT4( N, DAT, TAG )                                  FLOPSF   3595
CD                                                                      FLOPSF   3596
CD     TO SORT AN A*16 ARRAY (SEE PSFINT FOR USAGE)                     FLOPSF   3597
CD                                                                      FLOPSF   3598
      IMPLICIT NONE                                                     FLOPSF   3599
      INTEGER N, I, FIRST, LAST, DIR, SORT, J, LSWAP, X, K              FLOPSF   3600
      INTEGER*2 TAG(*)                                                  FLOPSF   3601
      INTEGER DAT(4,*)                                                  FLOPSF   3602
C                                                                       FLOPSF   3603
      CHARACTER*16 SORTI, SORTJ                                         FLOPSF   3604
      INTEGER*4    ISORT(4), JSORT(4)                                   FLOPSF   3605
      EQUIVALENCE ( SORTI, ISORT )                                      FLOPSF   3606
      EQUIVALENCE ( SORTJ, JSORT )                                      FLOPSF   3607
C                                                                       FLOPSF   3608
      IF( N.LT.1 ) RETURN                                               FLOPSF   3609
C                                                                       FLOPSF   3610
      DO 100 I=1,N                                                      FLOPSF   3611
        TAG(I) = I                                                      FLOPSF   3612
100   CONTINUE                                                          FLOPSF   3613
C                                                                       FLOPSF   3614
      IF( N.LT.2 ) RETURN                                               FLOPSF   3615
C                                                                       FLOPSF   3616
      FIRST = 2                                                         FLOPSF   3617
      LAST = N                                                          FLOPSF   3618
      DIR = 1                                                           FLOPSF   3619
150   SORT = 0                                                          FLOPSF   3620
      DO 200 J = FIRST, LAST, DIR                                       FLOPSF   3621
        I = J - 1                                                       FLOPSF   3622
        DO 901 K = 1, 4                                                 FLOPSF   3623
          ISORT(K) = DAT(K,TAG(I))                                      FLOPSF   3624
          JSORT(K) = DAT(K,TAG(J))                                      FLOPSF   3625
901     CONTINUE                                                        FLOPSF   3626
        IF( SORTI .GT. SORTJ ) THEN                                     FLOPSF   3627
          X = TAG(I)                                                    FLOPSF   3628
          TAG(I) = TAG(J)                                               FLOPSF   3629
          TAG(J) = X                                                    FLOPSF   3630
          LSWAP = J                                                     FLOPSF   3631
          SORT = 1                                                      FLOPSF   3632
        ENDIF                                                           FLOPSF   3633
200   CONTINUE                                                          FLOPSF   3634
C                                                                       FLOPSF   3635
      IF( SORT .EQ. 1 ) THEN                                            FLOPSF   3636
        LAST = FIRST                                                    FLOPSF   3637
        FIRST = LSWAP                                                   FLOPSF   3638
        DIR = 0 - DIR                                                   FLOPSF   3639
        IF( DIR.EQ.1 .AND. FIRST.LT.LAST ) GOTO 150                     FLOPSF   3640
        IF( DIR.EQ.-1 .AND. FIRST.GT.LAST ) GOTO 150                    FLOPSF   3641
      ENDIF                                                             FLOPSF   3642
C                                                                       FLOPSF   3643
      RETURN                                                            FLOPSF   3644
      END                                                               FLOPSF   3645
