CFPRIME TABINI                                                          TABINI      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 TABINI(PARAM,LENPAR)                                   TABINI      3
CD                                                                      TABINI      4
CD    THIS IS THE MAIN DRIVER FOR INITIAL CONDITION TABULATION.         TABINI      5
CD                                                                      TABINI      6
CD    THE PRINTING FEATURES ARE:                                        TABINI      7
CD                                                                      TABINI      8
CD      (1) TABULATE GENERATOR                                          TABINI      9
CD      (2) TABULATE INDUCTION MOTOR                                    TABINI     10
CD      (3) TABULATE DEVICE STATE DERIVATIVES & STATES                  TABINI     11
CD      (4) PRINT ALL USER DEFINED MODELS IN GENERATORS                 TABINI     12
CD      (5) PRINT SVC                                                   TABINI     13
CD      (6) PRINT RANI                                                  TABINI     14
CD      (7) PRINT STP                                                   TABINI     15
CD      (8) PRINT SDB                                                   TABINI     16
CD      (9) TABULATE ULTC                                               TABINI     17
CD     (10) TABULATE MTDC                                               TABINI     18
CD     (11) TABULATE TSCL                                               TABINI     19
CD                                                                      TABINI     20
C---------------------------------------------------------------------- TABINI     21
      INCLUDE 'CNLSTA.INS'                                              TABINI     22
      INCLUDE 'PARX.INS'                                                TABINI     23
      INCLUDE 'CNB0.INS'                                                TABINI     24
      INCLUDE 'CNB4.INS'                                                TABINI     25
      INCLUDE 'CNPT.INS'                                                TABINI     26
      INCLUDE 'CNB19.INS'                                               TABINI     27
      INCLUDE 'CNUNIT.INS'                                              TABINI     28
      INCLUDE 'CNLUN.INS'                                               TABINI     29
      INCLUDE 'CNIMPR.INS'                                              TABINI     30
      INCLUDE 'CNFLAG.INS'                                              TABINI     31
      INCLUDE 'CNUDIC.INS'                                              TABINI     32
      INCLUDE 'CNMSG.INS'                                               TABINI     33
      INCLUDE 'CNFRUN.INS'                                              TABINI     34
C                                                                       TABINI     35
      CHARACTER*50 PARAM                                                TABINI     36
      CHARACTER*80 PMSG,EMSG,STRING                                     TABINI     37
      CHARACTER*50 FILENA                                               TABINI     38
      CHARACTER*7 SUBPMT                                                TABINI     39
      CHARACTER*3 KYWRDS(11)                                            TABINI     40
C                                                                       TABINI     41
      DATA KYWRDS / 'GEN', 'MOT', 'STA', 'UDM', 'SVC', 'RAN', 'STP',    TABINI     42
     +              'SDB', 'ULT', 'MTD', 'TCS' /                        TABINI     43
C                                                                       TABINI     44
      LDEB=.FALSE.                                                      TABINI     45
C                                                                       TABINI     46
      IF (CFLRUN) THEN                                                  TABINI     47
        IREC = IFSPTR(ITABIC)                                           TABINI     48
        GOTO 200                                                        TABINI     49
      ENDIF                                                             TABINI     50
C                                                                       TABINI     51
      SUBPMT=' TAINI '                                                  TABINI     52
      FILENA(1:1)=' '                                                   TABINI     53
C                                                                       TABINI     54
C                                                                       TABINI     55
      IF(.NOT.LUNITS(IU18))THEN                                         TABINI     56
C                                                                       TABINI     57
        PMSG='ENTER THE INITIAL CONDITION TABULATION FILE NAME:'        TABINI     58
        EMSG='ERROR IN OPENING INITIAL CONDITION TABULATION FILE'       TABINI     59
        LMSG=49                                                         TABINI     60
        LEMSG=50                                                        TABINI     61
        IKEY=6                                                          TABINI     62
        JLENG=0                                                         TABINI     63
        WRITE(LOUT,*)                                                   TABINI     64
        CALL FILEMG(IU18,LMSG,PMSG,LEMSG,EMSG,SUBPMT,IKEY,JLENG,IEBK)   TABINI     65
        IF(IEBK.NE.0)THEN                                               TABINI     66
        IF(PLAYBA)CALL PSTOP                                            TABINI     67
        RETURN                                                          TABINI     68
        ENDIF                                                           TABINI     69
        LUNITS(IU18)=.TRUE.                                             TABINI     70
        PMSG='INPUT DATA AND INITIAL CONDITION REPORT'                  TABINI     71
        CALL PHEAD(IU18,39,PMSG)                                        TABINI     72
C                                                                       TABINI     73
      ENDIF                                                             TABINI     74
C                                                                       TABINI     75
 100  IF (CFLRUN) GOTO 200                                              TABINI     76
C                                                                       TABINI     77
      WRITE(LOUT,2000)                                                  TABINI     78
C                                                                       TABINI     79
      PMSG='SELECT AN ITEM BY THE NUMBER (Q TO QUIT):'                  TABINI     80
      CALL REDLIN(LOUT,LIN,JERR,41,PMSG,SUBPMT,'TIN',STRING,RECORD,     TABINI     81
     &IREC,KLAYER,KEND,KREAD,PLAYBA)                                    TABINI     82
      IF (JERR.LT.0)THEN                                                TABINI     83
      IF(PLAYBA)CALL PSTOP                                              TABINI     84
      GOTO 100                                                          TABINI     85
      ENDIF                                                             TABINI     86
      IF (KLAYER.LT.0) RETURN                                           TABINI     87
      IF (STRING(1:1).EQ.'Q'.OR.STRING(1:1).EQ.'q') RETURN              TABINI     88
      READ(STRING,*,IOSTAT=IOS) NTYPE                                   TABINI     89
      IF (IOS.NE.0.OR.NTYPE.LE.0.OR.NTYPE.GT.11) THEN                   TABINI     90
        IF(PLAYBA)CALL PSTOP                                            TABINI     91
        KREAD=.TRUE.                                                    TABINI     92
        GOTO 100                                                        TABINI     93
      ELSE                                                              TABINI     94
        GOTO 250                                                        TABINI     95
      ENDIF                                                             TABINI     96
C                                                                       TABINI     97
C                                                     Control file run  TABINI     98
C                                                                       TABINI     99
 200  IF (IREC .EQ. 0) RETURN                                           TABINI    100
      READ (IU56, REC = IREC) STRING                                    TABINI    101
      IREC = INXPTR(IREC)                                               TABINI    102
C                                                                       TABINI    103
      DO 210 II = 1, 11                                                 TABINI    104
        IF (STRING(1:3) .EQ. KYWRDS(II)) THEN                           TABINI    105
          NTYPE = II                                                    TABINI    106
          GOTO 250                                                      TABINI    107
        ENDIF                                                           TABINI    108
 210  CONTINUE                                                          TABINI    109
C                                                                       TABINI    110
      MSG(1) = ' *** ERROR - INVALID KEYWORD IN IC '//                  TABINI    111
     +         'TABULATION SPECIFICATION.'                              TABINI    112
      MSG(2) = STRING                                                   TABINI    113
      CALL PRTMSG (2)                                                   TABINI    114
      IF(PLAYBA)CALL PSTOP                                              TABINI    115
      GOTO 200                                                          TABINI    116
C                                                                       TABINI    117
C           TGEINT PGCNIN TMOTIN PSVCIN PRANIN                          TABINI    118
 250  GOTO ( 300,   910,   400,   920,   940,                           TABINI    119
C                                                                       TABINI    120
C           PSTPIN PSDBIN TDCINT TTSCIN PULTIN PRXDOT                   TABINI    121
     *       930,   950,   500,   700,   960,   600 ) NTYPE             TABINI    122
C                                                                       TABINI    123
 300  CONTINUE                                                          TABINI    124
      CALL TGEINT(IU18)                                                 TABINI    125
      GOTO 100                                                          TABINI    126
C                                                                       TABINI    127
 400  CONTINUE                                                          TABINI    128
      CALL TMOTIN(IU18)                                                 TABINI    129
      GOTO 100                                                          TABINI    130
C                                                                       TABINI    131
 500  CONTINUE                                                          TABINI    132
      CALL TDCINT(IU18)                                                 TABINI    133
      GOTO 100                                                          TABINI    134
C                                                                       TABINI    135
 600  CONTINUE                                                          TABINI    136
      CALL PRXDOT(IU18,-1.)                                             TABINI    137
      GOTO 100                                                          TABINI    138
C                                                                       TABINI    139
 700  CONTINUE                                                          TABINI    140
      CALL TTSCIN(IU18)                                                 TABINI    141
      GOTO 100                                                          TABINI    142
C                                                                       TABINI    143
 910  CONTINUE                                                          TABINI    144
      NVALIU=0                                                          TABINI    145
      NVALOU=0                                                          TABINI    146
      CALL PGCNIN(IU18)                                                 TABINI    147
      GOTO 100                                                          TABINI    148
C                                                                       TABINI    149
 920  CONTINUE                                                          TABINI    150
      NVALIU=NVALUS*80                                                  TABINI    151
      NVALOU=NVALUS*NXUDB                                               TABINI    152
      CALL PSVCIN(IU18)                                                 TABINI    153
      GOTO 100                                                          TABINI    154
C                                                                       TABINI    155
 930  CONTINUE                                                          TABINI    156
      NVALIU=NVALUT*80                                                  TABINI    157
      NVALOU=NVALUT*NXUDB                                               TABINI    158
      CALL PSTPIN(IU18)                                                 TABINI    159
      GOTO 100                                                          TABINI    160
C                                                                       TABINI    161
 940  CONTINUE                                                          TABINI    162
      NVALIU=NVALUR*80                                                  TABINI    163
      NVALOU=NVALUR*NXUDB                                               TABINI    164
      CALL PRANIN(IU18)                                                 TABINI    165
      GOTO 100                                                          TABINI    166
C                                                                       TABINI    167
 950  CONTINUE                                                          TABINI    168
      NVALIU=NVALUB*80                                                  TABINI    169
      NVALOU=NVALUB*NXUDB                                               TABINI    170
      CALL PSDBIN(IU18)                                                 TABINI    171
      GOTO 100                                                          TABINI    172
C                                                                       TABINI    173
 960  CALL PULTIN(IU18)                                                 TABINI    174
      GOTO 100                                                          TABINI    175
C                                                                       TABINI    176
 2000 FORMAT(//,                                                        TABINI    177
     17X,'SYSTEM INITIAL CONDITION TABULATION OPTIONS',/,               TABINI    178
     27X,'-------------------------------------------',//,              TABINI    179
     32X,' (1) TABULATION OF GENERATOR INITIAL CONDITION',/,            TABINI    180
     72X,' (2) TABULATION OF INITIAL CONDITION OF USER DEFINED',/,      TABINI    181
     82X,'                   MODELS IN GENERATORS',/,                   TABINI    182
     42X,' (3) TABULATION OF INDUCTION MOTOR INITIAL CONDITION',/,      TABINI    183
     92X,' (4) TABULATION OF SVC INITIAL CONDITION',/,                  TABINI    184
     *2X,' (5) TABULATION OF TCSC INITIAL CONDITION',/,                 TABINI    185
     12X,' (6) TABULATION OF TCTC/TCPR INITIAL CONDITION',/,            TABINI    186
     22X,' (7) TABULATION OF TCBR/TCBC INITIAL CONDITION',/,            TABINI    187
     42X,' (8) TABULATION OF MTDC INITIAL CONDITION',/,                 TABINI    188
     52X,' (9) TABULATION OF TSC LOAD INITIAL CONDITION',/,             TABINI    189
     32X,'(10) TABULATION OF ULTC INITIAL CONDITION',/,                 TABINI    190
     52X,'(11) TABULATION OF INITIAL SYSTEM STATES AND THEIR ',         TABINI    191
     6'DERIVATIVES',/)                                                  TABINI    192
C                                                                       TABINI    193
      END                                                               TABINI    194
