CFPRIME UDDBLK                                                          UDDBLK      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 UDDBLK (BLKNAM,PRTFLG,INPNAM)                          UDDBLK      3
CD -------------------------------------------------------------------  UDDBLK      4
CD                                                                      UDDBLK      5
CD              *****     UDDBLK  ROUTINE   *****                       UDDBLK      6
CD                                                                      UDDBLK      7
CD -------------------------------------------------------------------  UDDBLK      8
CD                                                                      UDDBLK      9
CD       PURPOSE:  This subroutine creates a block of type 'DUMMY' to   UDDBLK     10
CD                 hold the output from the associated fortran routine. UDDBLK     11
CD                                                                      UDDBLK     12
CD                                                                      UDDBLK     13
CD       DEFINITION OF LOCAL VARIABLES:                                 UDDBLK     14
CD                 BLKNAM -  name of the new block                      UDDBLK     15
CD                 DONE   -  indicates end of udc data                  UDDBLK     16
CD                 INPNAM -  name of the associated FORTRAN block       UDDBLK     17
CD                 LEN    -  length of the new block name               UDDBLK     18
CD                 PRTFLG -  print flag for block                       UDDBLK     19
CD                 SUBNAM -  subroutine name                            UDDBLK     20
CD                 VALID  -  indicates if new block name is unique      UDDBLK     21
CD                                                                      UDDBLK     22
CD -------------------------------------------------------------------  UDDBLK     23
C                                                                       UDDBLK     24
      INCLUDE 'CNUNIT.INS'                                              UDDBLK     25
      INCLUDE 'CNMSG.INS'                                               UDDBLK     26
      INCLUDE 'PARX.INS'                                                UDDBLK     27
      INCLUDE 'UDCA.INS'                                                UDDBLK     28
C                                                                       UDDBLK     29
      LOGICAL      VALID,DONE,PRTFLG                                    UDDBLK     30
      CHARACTER*20 SUBNAM                                               UDDBLK     31
      CHARACTER*30 BLKNAM                                               UDDBLK     32
      CHARACTER*17 INPNAM                                               UDDBLK     33
C                                                                       UDDBLK     34
C---------------------------------------------------------------------  UDDBLK     35
C                                                                       UDDBLK     36
      IF (SDBG) THEN                                                    UDDBLK     37
         SUBNAM = 'UDDBLK ROUTINE'                                      UDDBLK     38
      ELSE                                                              UDDBLK     39
         SUBNAM = ' '                                                   UDDBLK     40
      END IF                                                            UDDBLK     41
C                                                                       UDDBLK     42
C     Check for duplicate or invalid block name.                        UDDBLK     43
C                                                                       UDDBLK     44
      DONE = .FALSE.                                                    UDDBLK     45
      VALID = .FALSE.                                                   UDDBLK     46
      CALL VALNAM(BLKNAM,LEN,'DUMBLK',VALID,DONE)                       UDDBLK     47
C                                                                       UDDBLK     48
      IF (VALID) THEN                                                   UDDBLK     49
         IUDC = IUDC + 1                                                UDDBLK     50
         IF (IUDC .GT. NUDC) THEN                                       UDDBLK     51
            WRITE(MSG(1),9012) SUBNAM                                   UDDBLK     52
            WRITE(MSG(2),9013) NUDC                                     UDDBLK     53
            WRITE(MSG(3),9014)                                          UDDBLK     54
            CALL PRTMSG(3)                                              UDDBLK     55
            MSG(1)='UDDBLK: TERMINATED DUE TO ARRAY DIMENSIONS OF UDC'  UDDBLK     56
            CALL ASTOP(MSG(1),49)                                       UDDBLK     57
         END IF                                                         UDDBLK     58
C                                                                       UDDBLK     59
C        Initialize new block.                                          UDDBLK     60
C                                                                       UDDBLK     61
         IUDLEN(IUDC) = LEN                                             UDDBLK     62
         UDNAME(IUDC) = BLKNAM(1:LEN)                                   UDDBLK     63
         UDPRNT(IUDC) = PRTFLG                                          UDDBLK     64
         IUDTYP(IUDC) = IUDUMY                                          UDDBLK     65
         IUNIPT(IUDC) = 0                                               UDDBLK     66
         IUDPPT(IUDC) = 0                                               UDDBLK     67
         IUDRPT(IUDC) = 0                                               UDDBLK     68
C                                                                       UDDBLK     69
         CALL ADDINT(IUDC,IADDI,LASTI)                                  UDDBLK     70
         UIDENT(IADDI) = INPNAM                                         UDDBLK     71
         IUDSUB(IUDC) = 0                                               UDDBLK     72
         UDVAL(IUDC) = 0.0                                              UDDBLK     73
         UDVA3(IUDC) = 0.0                                              UDDBLK     74
C                                                                       UDDBLK     75
         UDOU2(IUDC) = ' '                                              UDDBLK     76
         UDOU4(IUDC) = ' '                                              UDDBLK     77
         IUDINV(IUDC) = 0                                               UDDBLK     78
      END IF                                                            UDDBLK     79
C                                                                       UDDBLK     80
C---------------------------------------------------------------------  UDDBLK     81
C                                                                       UDDBLK     82
      RETURN                                                            UDDBLK     83
C                                                                       UDDBLK     84
C---------------------------------------------------------------------  UDDBLK     85
C                                                                       UDDBLK     86
9012  FORMAT(' *** ERROR',5X, A)                                        UDDBLK     87
9013  FORMAT(11X,'THE MAXIMUM NUMBER OF UDC BLOCKS ', I4                UDDBLK     88
     *, ' HAS BEEN EXCEEDED.')                                          UDDBLK     89
9014  FORMAT(11X,'CHANGE THE VALUE OF PARAMETER, NUDC,'                 UDDBLK     90
     *,' FOUND IN INCLUDE PARX.')                                       UDDBLK     91
C                                                                       UDDBLK     92
C---------------------------------------------------------------------  UDDBLK     93
C                                                                       UDDBLK     94
      END                                                               UDDBLK     95
