CFPRIME UIPRT                                                           UIPRT       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  UIPRT (JBLK)                                          UIPRT       3
CD                                                                      UIPRT       4
CD    TO INITIALIZE THE UDC BLOCK TYPE PRINT                            UIPRT       5
CD                                                                      UIPRT       6
      INCLUDE 'PARX.INS'                                                UIPRT       7
      INCLUDE 'CNUNIT.INS'                                              UIPRT       8
      INCLUDE 'CNMSG.INS'                                               UIPRT       9
      INCLUDE 'CNPARX.INS'                                              UIPRT      10
      INCLUDE 'UDCA.INS'                                                UIPRT      11
      INCLUDE 'UDCC.INS'                                                UIPRT      12
      INCLUDE 'UDCE.INS'                                                UIPRT      13
      INCLUDE 'UDCF.INS'                                                UIPRT      14
      INCLUDE 'UDCG.INS'                                                UIPRT      15
      INCLUDE 'UDCH.INS'                                                UIPRT      16
      INCLUDE 'UDCI.INS'                                                UIPRT      17
      INCLUDE 'UDCJ.INS'                                                UIPRT      18
      INCLUDE 'GRDC01.INS'                                              UIPRT      19
      INCLUDE 'GRDC03.INS'                                              UIPRT      20
C                                                                       UIPRT      21
      CHARACTER*72  MESSAC                                              UIPRT      22
      CHARACTER*20  SUBNAM                                              UIPRT      23
      CHARACTER*17  BNAME                                               UIPRT      24
      CHARACTER*15  MISS                                                UIPRT      25
      CHARACTER*8   TNAME                                               UIPRT      26
C                                                                       UIPRT      27
      INTEGER       IPRTU                                               UIPRT      28
C                                                                       UIPRT      29
      INCLUDE 'GRPRT.INS'                                               UIPRT      30
C                                                                       UIPRT      31
C---------------------------------------------------------------------  UIPRT      32
C                                                                       UIPRT      33
      IF(SDBG)THEN                                                      UIPRT      34
         SUBNAM = 'UIPRT ROUTINE.'                                      UIPRT      35
      ELSE                                                              UIPRT      36
         SUBNAM = ' '                                                   UIPRT      37
      END IF                                                            UIPRT      38
      TNAME = TPNAME(IPRTR)                                             UIPRT      39
      BNAME = UDNAME(JBLK)                                              UIPRT      40
      LEN = IUDLEN(JBLK)                                                UIPRT      41
C                                                                       UIPRT      42
C     Retrieve input values.                                            UIPRT      43
C                                                                       UIPRT      44
      NEXTI = IUNIPT(JBLK)                                              UIPRT      45
      NEXTP = IUDPPT(JBLK)                                              UIPRT      46
      NEXTC = IUDCPT(JBLK)                                              UIPRT      47
C                                                                       UIPRT      48
      IF(NEXTI.EQ.0 )THEN                                               UIPRT      49
C                                                                       UIPRT      50
C        No unit # was stored.                                          UIPRT      51
C                                                                       UIPRT      52
         MISS = 'DESTINATION'                                           UIPRT      53
         WRITE(MSG(1),9000) SUBNAM                                      UIPRT      54
         WRITE(MSG(2),9001) TNAME                                       UIPRT      55
         WRITE(MSG(3),9002) MISS                                        UIPRT      56
         WRITE(MSG(4),9003) BNAME(1:LEN)                                UIPRT      57
         WRITE(MSG(5),9004)                                             UIPRT      58
         CALL PRTMSG(5)                                                 UIPRT      59
         IERCNT = IERCNT + 1                                            UIPRT      60
      ELSE                                                              UIPRT      61
         IF (IUDSUB(JBLK) .EQ. IMESS) THEN                              UIPRT      62
            IPRTU = IUDINT(NEXTI)                                       UIPRT      63
            NEXTI = IUDINX(NEXTI)                                       UIPRT      64
C                                                                       UIPRT      65
C                                                                       UIPRT      66
            IF(NEXTI.EQ.0 .OR. NEXTP.EQ.0)THEN                          UIPRT      67
C                                                                       UIPRT      68
C        No input was stored.                                           UIPRT      69
C                                                                       UIPRT      70
               MISS = 'INPUT'                                           UIPRT      71
               WRITE(MSG(1),9000) SUBNAM                                UIPRT      72
               WRITE(MSG(2),9001) TNAME                                 UIPRT      73
               WRITE(MSG(3),9002) MISS                                  UIPRT      74
               WRITE(MSG(4),9003) BNAME(1:LEN)                          UIPRT      75
               WRITE(MSG(5),9004)                                       UIPRT      76
               CALL PRTMSG(5)                                           UIPRT      77
               IERCNT = IERCNT + 1                                      UIPRT      78
            ELSE                                                        UIPRT      79
               IF(UIDENT(NEXTI) .NE. ' ')THEN                           UIPRT      80
                  VALUE1 = UDVAL(IUDINT(NEXTI))                         UIPRT      81
               ELSE                                                     UIPRT      82
                  VALUE1 = UDPARM(NEXTP)                                UIPRT      83
               END IF                                                   UIPRT      84
            END IF                                                      UIPRT      85
C                                                                       UIPRT      86
C                                                                       UIPRT      87
            IF(NEXTC.EQ.0)THEN                                          UIPRT      88
C                                                                       UIPRT      89
C        No message was stored.                                         UIPRT      90
C                                                                       UIPRT      91
               MISS = 'MESSAGE'                                         UIPRT      92
               WRITE(MSG(1),9000) SUBNAM                                UIPRT      93
               WRITE(MSG(2),9001) TNAME                                 UIPRT      94
               WRITE(MSG(3),9002) MISS                                  UIPRT      95
               WRITE(MSG(4),9003) BNAME(1:LEN)                          UIPRT      96
               WRITE(MSG(5),9004)                                       UIPRT      97
               CALL PRTMSG(5)                                           UIPRT      98
               IERCNT = IERCNT + 1                                      UIPRT      99
            ELSE                                                        UIPRT     100
               MESSAC = UDCCHR(NEXTC)                                   UIPRT     101
            ENDIF                                                       UIPRT     102
C                                                                       UIPRT     103
C                                                                       UIPRT     104
C     Calculate UDVAL.                                                  UIPRT     105
C                                                                       UIPRT     106
            IF(VALUE1.GT.0.0) THEN                                      UIPRT     107
               WRITE(IPRTU,9005) MESSAC                                 UIPRT     108
               UDVAL(JBLK) = 1.0                                        UIPRT     109
            ELSE                                                        UIPRT     110
               UDVAL(JBLK) = 0.0                                        UIPRT     111
            ENDIF                                                       UIPRT     112
         ELSE                                                           UIPRT     113
C                                                                       UIPRT     114
C     Invalid subtype                                                   UIPRT     115
C                                                                       UIPRT     116
            WRITE(MSG(1),9000)                                          UIPRT     117
            WRITE(MSG(2),9006) SUBNAM                                   UIPRT     118
            WRITE(MSG(3),9007) TNAME                                    UIPRT     119
            WRITE(MSG(4),9008) BNAME(1:LEN)                             UIPRT     120
            WRITE(MSG(5),9009)                                          UIPRT     121
            IERCNT = IERCNT + 1                                         UIPRT     122
            CALL PRTMSG(5)                                              UIPRT     123
         END IF                                                         UIPRT     124
      ENDIF                                                             UIPRT     125
C                                                                       UIPRT     126
C                                                                       UIPRT     127
C                                                                       UIPRT     128
C                                                                       UIPRT     129
      RETURN                                                            UIPRT     130
C                                                                       UIPRT     131
C                                                                       UIPRT     132
C---------------------------------------------------------------------  UIPRT     133
C                                                                       UIPRT     134
C                                                                       UIPRT     135
9000  FORMAT(' *** MTDC ERROR', 5X, A)                                  UIPRT     136
9001  FORMAT(10X,'DURING THE INITIALIZATION OF UDC "',A                 UIPRT     137
     *,'" BLOCKS,')                                                     UIPRT     138
9002  FORMAT(10X,'THE VALUE OF "',A,'" CANNOT BE FOUND FOR BLOCK,')     UIPRT     139
9003  FORMAT(10X,'"',A,'".  THIS IS AN ERROR IN THE CODE,')             UIPRT     140
9004  FORMAT(10X,'THE UDC INFORMATION IS NOT BEING STORED CORRECTLY.')  UIPRT     141
9005  FORMAT(/,1X,'At initialization: ',A)                              UIPRT     142
9006  FORMAT (10X,'DURING THE INITIALIZATION OF UDC "',A,'" BLOCKS, ')  UIPRT     143
9007  FORMAT (10X,'AN INVALID SUBTYPE WAS FOUND FOR BLOCK, "',A,'".')   UIPRT     144
9008  FORMAT (10X,'THIS IS AN ERROR IN THE CODE, THE UDC INFORMATION')  UIPRT     145
9009  FORMAT (10X,'IS NOT BEING STORED CORRECTLY')                      UIPRT     146
                                                                        UIPRT     147
C                                                                       UIPRT     148
C---------------------------------------------------------------------  UIPRT     149
C                                                                       UIPRT     150
      END                                                               UIPRT     151
