CFPRIME IUDB48                                                          IUDB48      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 IUDB48(IORD,NLF,KN,CID)                                IUDB48      3
CD                                                                      IUDB48      4
CD    TO PERFORM INITIALIZATION FOR USER DEFINED BLOCK TYPE 48 (TYPE    IUDB48      5
CD    OF2 END BLOCK) IN A USER DEFINED FACTS MODEL.                     IUDB48      6
CD                                                                      IUDB48      7
CD    EACH ENTRY POINT IN THIS SUBROUTINE HAS SIMILAR FUNCTION AND IS   IUDB48      8
CD    FOR A DIFFERENT TYPE OF FACTS DEVICE END BLOCK APPLICABLE TO A    IUDB48      9
CD    USER DEFINED FACTS MODEL (SVC, RANI, STC/SPS, SDB).               IUDB48     10
CD                                                                      IUDB48     11
      INCLUDE 'PARX.INS'                                                IUDB48     12
      INCLUDE 'CNMDAT.INS'                                              IUDB48     13
      INCLUDE 'CNMSTA.INS'                                              IUDB48     14
      INCLUDE 'CNXSTA.INS'                                              IUDB48     15
      INCLUDE 'CNSTN.INS'                                               IUDB48     16
      INCLUDE 'CNYVAR.INS'                                              IUDB48     17
      INCLUDE 'CNUNIT.INS'                                              IUDB48     18
      INCLUDE 'CNFLAG.INS'                                              IUDB48     19
      INCLUDE 'CNUDM.INS'                                               IUDB48     20
      INCLUDE 'CNMSG.INS'                                               IUDB48     21
C                                                                       IUDB48     22
      CHARACTER*2 CID                                                   IUDB48     23
C                                                                       IUDB48     24
      LDEB=(JDEB(262).NE.0)                                             IUDB48     25
C                                                                       IUDB48     26
      NINP=0                                                            IUDB48     27
      NEXTB=0                                                           IUDB48     28
      JORD=JUDE(IORD)                                                   IUDB48     29
      KORD=JSTATE+KUDE(IORD)+1                                          IUDB48     30
      JEI=JEB+2                                                         IUDB48     31
      UHX=DDAT(JEI+1)                                                   IUDB48     32
      UMX=DDAT(JEI+2)                                                   IUDB48     33
      ULX=DDAT(JEI+3)                                                   IUDB48     34
      XLX=DDAT(JEI+4)                                                   IUDB48     35
      TFX=DDAT(JEI+5)                                                   IUDB48     36
      IF(UHX.LE.UMX.OR.UMX.LT.ULX.OR.ULX.LT.0.0.OR.XLX.LE.0.0.OR.       IUDB48     37
     &   TFX.LE.0.0) THEN                                               IUDB48     38
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48     39
         WRITE(MSG(2),1060) IORD,BLNAM1,BLNAM2                          IUDB48     40
         WRITE(MSG(3),1061)                                             IUDB48     41
         WRITE(MSG(4),1062) UHX,UMX,ULX,XLX,TFX                         IUDB48     42
         CALL PRTMSG(4)                                                 IUDB48     43
         MSG(1)='IUDB48: UDM ERROR'                                     IUDB48     44
         CALL ASTOP(MSG(1),17)                                          IUDB48     45
      ENDIF                                                             IUDB48     46
      J2=JE5-2                                                          IUDB48     47
      DO 110 J=1,INTUD                                                  IUDB48     48
      J2=J2+2                                                           IUDB48     49
      IDD=IDDAT(J2+2)                                                   IUDB48     50
      IDD=IABS(IDD)                                                     IUDB48     51
      IF(IDD.EQ.IORD) THEN                                              IUDB48     52
         XDAT=1.0                                                       IUDB48     53
         IF(IDDAT(J2+2).LT.0) XDAT=-1.0                                 IUDB48     54
         IOUT=IDDAT(J2+1)                                               IUDB48     55
         IF(NINP.EQ.0) THEN                                             IUDB48     56
            IF(JUDE(IOUT).EQ.0) THEN                                    IUDB48     57
               NEXTB=IOUT                                               IUDB48     58
               XDATN=XDAT                                               IUDB48     59
               NINP=NINP+1                                              IUDB48     60
            ELSE                                                        IUDB48     61
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48     62
         WRITE(MSG(2),1030) IORD,BLNAM1,BLNAM2                          IUDB48     63
         CALL PRTMSG(2)                                                 IUDB48     64
         MSG(1)='IUDB48: UDM ERROR'                                     IUDB48     65
         CALL ASTOP(MSG(1),17)                                          IUDB48     66
            ENDIF                                                       IUDB48     67
         ELSE                                                           IUDB48     68
            NINP=NINP+1                                                 IUDB48     69
         ENDIF                                                          IUDB48     70
      ENDIF                                                             IUDB48     71
  110 CONTINUE                                                          IUDB48     72
      J3=JE6-3                                                          IUDB48     73
      DO 120 J=1,INPUD                                                  IUDB48     74
      J3=J3+3                                                           IUDB48     75
      IF(IDDAT(J3+1).EQ.IORD) THEN                                      IUDB48     76
         IIN=IDDAT(J3+2)                                                IUDB48     77
         IF(NINP.EQ.0) THEN                                             IUDB48     78
            IF(IIN.EQ.20) THEN                                          IUDB48     79
               XDATN=DDAT(J3+3)                                         IUDB48     80
               NINP=NINP+1                                              IUDB48     81
            ELSE                                                        IUDB48     82
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48     83
         WRITE(MSG(2),1001) IORD,BLNAM1,BLNAM2                          IUDB48     84
         WRITE(MSG(3),1002)                                             IUDB48     85
         CALL PRTMSG(3)                                                 IUDB48     86
         MSG(1)='IUDB48: UDM ERROR'                                     IUDB48     87
         CALL ASTOP(MSG(1),17)                                          IUDB48     88
            ENDIF                                                       IUDB48     89
         ELSE                                                           IUDB48     90
            IF(IIN.EQ.20)THEN                                           IUDB48     91
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48     92
         WRITE(MSG(2),1001) IORD,BLNAM1,BLNAM2                          IUDB48     93
         WRITE(MSG(3),1070)                                             IUDB48     94
         CALL PRTMSG(3)                                                 IUDB48     95
         MSG(1)='IUDB48: UDM ERROR'                                     IUDB48     96
         CALL ASTOP(MSG(1),17)                                          IUDB48     97
            ELSE                                                        IUDB48     98
               NINP=NINP+1                                              IUDB48     99
            ENDIF                                                       IUDB48    100
         ENDIF                                                          IUDB48    101
      ENDIF                                                             IUDB48    102
  120 CONTINUE                                                          IUDB48    103
      IF(NINP.EQ.0) THEN                                                IUDB48    104
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    105
         WRITE(MSG(2),1010) IORD,BLNAM1,BLNAM2                          IUDB48    106
         CALL PRTMSG(2)                                                 IUDB48    107
         MSG(1)='IUDB48: UDM ERROR'                                     IUDB48    108
         CALL ASTOP(MSG(1),17)                                          IUDB48    109
      ENDIF                                                             IUDB48    110
      IF(NINP.GT.2) THEN                                                IUDB48    111
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    112
         WRITE(MSG(2),1050) IORD,BLNAM1,BLNAM2                          IUDB48    113
         CALL PRTMSG(2)                                                 IUDB48    114
         MSG(1)='IUDB48: UDM ERROR'                                     IUDB48    115
         CALL ASTOP(MSG(1),17)                                          IUDB48    116
      ENDIF                                                             IUDB48    117
C                                                                       IUDB48    118
C     DATA PREPARATIONS AND INPUT DATA PRINTOUT                         IUDB48    119
C                                                                       IUDB48    120
      VALO=VALOUT(IORD)                                                 IUDB48    121
      XSTATE(KORD)=-XLX                                                 IUDB48    122
      IF(NEXTB.NE.0) THEN                                               IUDB48    123
         VALOUT(NEXTB)=VALO                                             IUDB48    124
      ELSE                                                              IUDB48    125
         VALIN(20)=VALO                                                 IUDB48    126
      ENDIF                                                             IUDB48    127
C                                                                       IUDB48    128
      IDDAT(JEI+6)=0                                                    IUDB48    129
      IDDAT(JEI+7)=0                                                    IUDB48    130
      DDAT(JEI+8)=1.0                                                   IUDB48    131
      IF(LDEB)WRITE(IUD6,1040) JORD                                     IUDB48    132
C                                                                       IUDB48    133
      RETURN                                                            IUDB48    134
C                                                                       IUDB48    135
C-----------------------------------------------------------------------IUDB48    136
C                                                                       IUDB48    137
      ENTRY IUDB49(IORD,NLF,KN,CID)                                     IUDB48    138
CD                                                                      IUDB48    139
CD    FOR BLOCK TYPE 49 (TYPE OF1 END BLOCK).                           IUDB48    140
CD                                                                      IUDB48    141
      LDEB=(JDEB(262).NE.0)                                             IUDB48    142
C                                                                       IUDB48    143
      NINP=0                                                            IUDB48    144
      NEXTB=0                                                           IUDB48    145
      JORD=JUDE(IORD)                                                   IUDB48    146
      JEI=JEB+2                                                         IUDB48    147
      DVH=DDAT(JEI+1)                                                   IUDB48    148
      DVL=DDAT(JEI+2)                                                   IUDB48    149
      IF(DVH.LE.DVL) THEN                                               IUDB48    150
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    151
         WRITE(MSG(2),1180) IORD,BLNAM1,BLNAM2                          IUDB48    152
         WRITE(MSG(3),1181) DVH,DVL                                     IUDB48    153
         CALL PRTMSG(3)                                                 IUDB48    154
         MSG(1)='IUDB49: UDM ERROR'                                     IUDB48    155
         CALL ASTOP(MSG(1),17)                                          IUDB48    156
      ENDIF                                                             IUDB48    157
      J2=JE5-2                                                          IUDB48    158
      DO 130 J=1,INTUD                                                  IUDB48    159
      J2=J2+2                                                           IUDB48    160
      IDD=IDDAT(J2+2)                                                   IUDB48    161
      IDD=IABS(IDD)                                                     IUDB48    162
      IF(IDD.EQ.IORD) THEN                                              IUDB48    163
         XDAT=1.0                                                       IUDB48    164
         IF(IDDAT(J2+2).LT.0) XDAT=-1.0                                 IUDB48    165
         IOUT=IDDAT(J2+1)                                               IUDB48    166
         IF(NINP.EQ.0) THEN                                             IUDB48    167
            IF(JUDE(IOUT).EQ.0) THEN                                    IUDB48    168
               NEXTB=IOUT                                               IUDB48    169
               XDATN=XDAT                                               IUDB48    170
               NINP=NINP+1                                              IUDB48    171
            ELSE                                                        IUDB48    172
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    173
         WRITE(MSG(2),1030) IORD,BLNAM1,BLNAM2                          IUDB48    174
         CALL PRTMSG(2)                                                 IUDB48    175
         MSG(1)='IUDB49: UDM ERROR'                                     IUDB48    176
         CALL ASTOP(MSG(1),17)                                          IUDB48    177
            ENDIF                                                       IUDB48    178
         ELSE                                                           IUDB48    179
            NINP=NINP+1                                                 IUDB48    180
         ENDIF                                                          IUDB48    181
      ENDIF                                                             IUDB48    182
  130 CONTINUE                                                          IUDB48    183
      J3=JE6-3                                                          IUDB48    184
      DO 140 J=1,INPUD                                                  IUDB48    185
      J3=J3+3                                                           IUDB48    186
      IF(IDDAT(J3+1).EQ.IORD) THEN                                      IUDB48    187
         IIN=IDDAT(J3+2)                                                IUDB48    188
         IF(NINP.EQ.0) THEN                                             IUDB48    189
            IF(IIN.EQ.20) THEN                                          IUDB48    190
               XDATN=DDAT(J3+3)                                         IUDB48    191
               NINP=NINP+1                                              IUDB48    192
            ELSE                                                        IUDB48    193
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    194
         WRITE(MSG(2),1001) IORD,BLNAM1,BLNAM2                          IUDB48    195
         WRITE(MSG(3),1002)                                             IUDB48    196
         CALL PRTMSG(3)                                                 IUDB48    197
         MSG(1)='IUDB49: UDM ERROR'                                     IUDB48    198
         CALL ASTOP(MSG(1),17)                                          IUDB48    199
            ENDIF                                                       IUDB48    200
         ELSE                                                           IUDB48    201
            IF(IIN.EQ.20)THEN                                           IUDB48    202
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    203
         WRITE(MSG(2),1001) IORD,BLNAM1,BLNAM2                          IUDB48    204
         WRITE(MSG(3),1190)                                             IUDB48    205
         CALL PRTMSG(3)                                                 IUDB48    206
         MSG(1)='IUDB49: UDM ERROR'                                     IUDB48    207
         CALL ASTOP(MSG(1),17)                                          IUDB48    208
            ELSE                                                        IUDB48    209
               NINP=NINP+1                                              IUDB48    210
            ENDIF                                                       IUDB48    211
         ENDIF                                                          IUDB48    212
      ENDIF                                                             IUDB48    213
  140 CONTINUE                                                          IUDB48    214
      IF(NINP.EQ.0) THEN                                                IUDB48    215
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    216
         WRITE(MSG(2),1010) IORD,BLNAM1,BLNAM2                          IUDB48    217
         CALL PRTMSG(2)                                                 IUDB48    218
         MSG(1)='IUDB49: UDM ERROR'                                     IUDB48    219
         CALL ASTOP(MSG(1),17)                                          IUDB48    220
      ENDIF                                                             IUDB48    221
      IF(NINP.GT.2) THEN                                                IUDB48    222
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    223
         WRITE(MSG(2),1050) IORD,BLNAM1,BLNAM2                          IUDB48    224
         CALL PRTMSG(2)                                                 IUDB48    225
         MSG(1)='IUDB49: UDM ERROR'                                     IUDB48    226
         CALL ASTOP(MSG(1),17)                                          IUDB48    227
      ENDIF                                                             IUDB48    228
C                                                                       IUDB48    229
C     DATA PREPARATIONS AND INPUT DATA PRINTOUT                         IUDB48    230
C                                                                       IUDB48    231
      VALO=VALOUT(IORD)                                                 IUDB48    232
      IF(NEXTB.NE.0) THEN                                               IUDB48    233
         VALOUT(NEXTB)=VALO                                             IUDB48    234
      ELSE                                                              IUDB48    235
         VALIN(20)=VALO                                                 IUDB48    236
      ENDIF                                                             IUDB48    237
C                                                                       IUDB48    238
      IDDAT(JEI+7)=0                                                    IUDB48    239
      DDAT(JEI+8)=1.0                                                   IUDB48    240
      IF(LDEB)WRITE(IUD6,1040) JORD                                     IUDB48    241
C                                                                       IUDB48    242
      RETURN                                                            IUDB48    243
C                                                                       IUDB48    244
C-----------------------------------------------------------------------IUDB48    245
C                                                                       IUDB48    246
      ENTRY IUDB50(IORD,NLF,KN,CID)                                     IUDB48    247
CD                                                                      IUDB48    248
CD    FOR BLOCK TYPE 50 (TYPE LF END BLOCK).                            IUDB48    249
CD                                                                      IUDB48    250
      LDEB=(JDEB(262).NE.0)                                             IUDB48    251
C                                                                       IUDB48    252
      NINP=0                                                            IUDB48    253
      NEXTB=0                                                           IUDB48    254
      JORD=JUDE(IORD)                                                   IUDB48    255
      JEI=JEB+2                                                         IUDB48    256
      J2=JE5-2                                                          IUDB48    257
      DO 150 J=1,INTUD                                                  IUDB48    258
      J2=J2+2                                                           IUDB48    259
      IDD=IDDAT(J2+2)                                                   IUDB48    260
      IDD=IABS(IDD)                                                     IUDB48    261
      IF(IDD.EQ.IORD) THEN                                              IUDB48    262
         XDAT=1.0                                                       IUDB48    263
         IF(IDDAT(J2+2).LT.0) XDAT=-1.0                                 IUDB48    264
         IOUT=IDDAT(J2+1)                                               IUDB48    265
         IF(JUDE(IOUT).EQ.0) THEN                                       IUDB48    266
            NEXTB=IOUT                                                  IUDB48    267
            XDATN=XDAT                                                  IUDB48    268
            NINP=NINP+1                                                 IUDB48    269
         ELSE                                                           IUDB48    270
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    271
         WRITE(MSG(2),1030) IORD,BLNAM1,BLNAM2                          IUDB48    272
         CALL PRTMSG(2)                                                 IUDB48    273
         MSG(1)='IUDB50: UDM ERROR'                                     IUDB48    274
         CALL ASTOP(MSG(1),17)                                          IUDB48    275
         ENDIF                                                          IUDB48    276
      ENDIF                                                             IUDB48    277
  150 CONTINUE                                                          IUDB48    278
      J3=JE6-3                                                          IUDB48    279
      DO 160 J=1,INPUD                                                  IUDB48    280
      J3=J3+3                                                           IUDB48    281
      IF(IDDAT(J3+1).EQ.IORD) THEN                                      IUDB48    282
         IIN=IDDAT(J3+2)                                                IUDB48    283
         IF(IIN.EQ.20) THEN                                             IUDB48    284
            XDATN=DDAT(J3+3)                                            IUDB48    285
            NINP=NINP+1                                                 IUDB48    286
         ELSE                                                           IUDB48    287
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    288
         WRITE(MSG(2),1001) IORD,BLNAM1,BLNAM2                          IUDB48    289
         WRITE(MSG(3),1002)                                             IUDB48    290
         CALL PRTMSG(3)                                                 IUDB48    291
         MSG(1)='IUDB50: UDM ERROR'                                     IUDB48    292
         CALL ASTOP(MSG(1),17)                                          IUDB48    293
         ENDIF                                                          IUDB48    294
      ENDIF                                                             IUDB48    295
  160 CONTINUE                                                          IUDB48    296
      IF(NINP.EQ.0) THEN                                                IUDB48    297
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    298
         WRITE(MSG(2),1010) IORD,BLNAM1,BLNAM2                          IUDB48    299
         CALL PRTMSG(2)                                                 IUDB48    300
         MSG(1)='IUDB50: UDM ERROR'                                     IUDB48    301
         CALL ASTOP(MSG(1),17)                                          IUDB48    302
      ENDIF                                                             IUDB48    303
      IF(NINP.GT.1) THEN                                                IUDB48    304
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    305
         WRITE(MSG(2),1250) IORD,BLNAM1,BLNAM2                          IUDB48    306
         CALL PRTMSG(2)                                                 IUDB48    307
         MSG(1)='IUDB50: UDM ERROR'                                     IUDB48    308
         CALL ASTOP(MSG(1),17)                                          IUDB48    309
      ENDIF                                                             IUDB48    310
C                                                                       IUDB48    311
C     DATA PREPARATIONS AND INPUT DATA PRINTOUT                         IUDB48    312
C                                                                       IUDB48    313
      PPI=4.0*ATAN(1.0)                                                 IUDB48    314
      YLF=VALOUT(IORD)                                                  IUDB48    315
      IF(YLF.LT.0.0.OR.YLF.GT.1.0) THEN                                 IUDB48    316
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    317
         WRITE(MSG(2),1260) IORD,BLNAM1,BLNAM2                          IUDB48    318
         WRITE(MSG(3),1261)                                             IUDB48    319
         WRITE(MSG(4),1262) YLF                                         IUDB48    320
         CALL PRTMSG(4)                                                 IUDB48    321
         MSG(1)='IUDB50: UDM ERROR'                                     IUDB48    322
         CALL ASTOP(MSG(1),17)                                          IUDB48    323
      ENDIF                                                             IUDB48    324
      XLF=YLF-SIN(PPI*YLF)/PPI                                          IUDB48    325
      IF(NEXTB.NE.0) THEN                                               IUDB48    326
         VALOUT(NEXTB)=XLF                                              IUDB48    327
      ELSE                                                              IUDB48    328
         VALIN(20)=XLF                                                  IUDB48    329
      ENDIF                                                             IUDB48    330
C                                                                       IUDB48    331
      IF(LDEB)WRITE(IUD6,1040) JORD                                     IUDB48    332
C                                                                       IUDB48    333
      RETURN                                                            IUDB48    334
C                                                                       IUDB48    335
C-----------------------------------------------------------------------IUDB48    336
C                                                                       IUDB48    337
      ENTRY IUDB51(IORD,NLF,KN,CID)                                     IUDB48    338
CD                                                                      IUDB48    339
CD    FOR BLOCK TYPE 51 (TYPE SD1 END BLOCK).                           IUDB48    340
CD                                                                      IUDB48    341
      LDEB=(JDEB(262).NE.0)                                             IUDB48    342
C                                                                       IUDB48    343
      NINP=0                                                            IUDB48    344
      NEXTB=0                                                           IUDB48    345
      JORD=JUDE(IORD)                                                   IUDB48    346
      JEI=JEB+2                                                         IUDB48    347
      QLB=DDAT(JEI+1)                                                   IUDB48    348
      QCB=DDAT(JEI+2)                                                   IUDB48    349
      J2=JE5-2                                                          IUDB48    350
      DO 170 J=1,INTUD                                                  IUDB48    351
      J2=J2+2                                                           IUDB48    352
      IDD=IDDAT(J2+2)                                                   IUDB48    353
      IDD=IABS(IDD)                                                     IUDB48    354
      IF(IDD.EQ.IORD) THEN                                              IUDB48    355
         XDAT=1.0                                                       IUDB48    356
         IF(IDDAT(J2+2).LT.0) XDAT=-1.0                                 IUDB48    357
         IOUT=IDDAT(J2+1)                                               IUDB48    358
         IF(JUDE(IOUT).EQ.0) THEN                                       IUDB48    359
            NEXTB=IOUT                                                  IUDB48    360
            XDATN=XDAT                                                  IUDB48    361
            NINP=NINP+1                                                 IUDB48    362
         ELSE                                                           IUDB48    363
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    364
         WRITE(MSG(2),1030) IORD,BLNAM1,BLNAM2                          IUDB48    365
         CALL PRTMSG(2)                                                 IUDB48    366
         MSG(1)='IUDB51: UDM ERROR'                                     IUDB48    367
         CALL ASTOP(MSG(1),17)                                          IUDB48    368
         ENDIF                                                          IUDB48    369
      ENDIF                                                             IUDB48    370
  170 CONTINUE                                                          IUDB48    371
      J3=JE6-3                                                          IUDB48    372
      DO 180 J=1,INPUD                                                  IUDB48    373
      J3=J3+3                                                           IUDB48    374
      IF(IDDAT(J3+1).EQ.IORD) THEN                                      IUDB48    375
         IIN=IDDAT(J3+2)                                                IUDB48    376
         IF(IIN.EQ.20) THEN                                             IUDB48    377
            XDATN=DDAT(J3+3)                                            IUDB48    378
            NINP=NINP+1                                                 IUDB48    379
         ELSE                                                           IUDB48    380
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    381
         WRITE(MSG(2),1001) IORD,BLNAM1,BLNAM2                          IUDB48    382
         WRITE(MSG(3),1002)                                             IUDB48    383
         CALL PRTMSG(3)                                                 IUDB48    384
         MSG(1)='IUDB51: UDM ERROR'                                     IUDB48    385
         CALL ASTOP(MSG(1),17)                                          IUDB48    386
         ENDIF                                                          IUDB48    387
      ENDIF                                                             IUDB48    388
  180 CONTINUE                                                          IUDB48    389
      IF(NINP.EQ.0) THEN                                                IUDB48    390
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    391
         WRITE(MSG(2),1010) IORD,BLNAM1,BLNAM2                          IUDB48    392
         CALL PRTMSG(2)                                                 IUDB48    393
         MSG(1)='IUDB51: UDM ERROR'                                     IUDB48    394
         CALL ASTOP(MSG(1),17)                                          IUDB48    395
      ENDIF                                                             IUDB48    396
      IF(NINP.GT.1) THEN                                                IUDB48    397
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    398
         WRITE(MSG(2),1250) IORD,BLNAM1,BLNAM2                          IUDB48    399
         CALL PRTMSG(2)                                                 IUDB48    400
         MSG(1)='IUDB51: UDM ERROR'                                     IUDB48    401
         CALL ASTOP(MSG(1),17)                                          IUDB48    402
      ENDIF                                                             IUDB48    403
C                                                                       IUDB48    404
C     DATA PREPARATIONS AND INPUT DATA PRINTOUT                         IUDB48    405
C                                                                       IUDB48    406
      BDEVX=VALOUT(IORD)                                                IUDB48    407
      BCX=QCB/QLB                                                       IUDB48    408
      BTCRX=BDEVX+BCX                                                   IUDB48    409
      IF(BTCRX.LT.0.0.OR.BTCRX.GT.1.0) THEN                             IUDB48    410
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    411
         WRITE(MSG(2),1360) IORD,BLNAM1,BLNAM2                          IUDB48    412
         WRITE(MSG(3),1460)                                             IUDB48    413
         WRITE(MSG(4),1461) BTCRX,BDEVX                                 IUDB48    414
         CALL PRTMSG(4)                                                 IUDB48    415
         MSG(1)='IUDB51: UDM ERROR'                                     IUDB48    416
         CALL ASTOP(MSG(1),17)                                          IUDB48    417
      ENDIF                                                             IUDB48    418
      VALIN(5)=BDEVX                                                    IUDB48    419
      VALIN(6)=BTCRX                                                    IUDB48    420
      VALIN(11)=BTCRX                                                   IUDB48    421
      IF(NEXTB.NE.0) THEN                                               IUDB48    422
         VALOUT(NEXTB)=BTCRX                                            IUDB48    423
      ELSE                                                              IUDB48    424
         VALIN(20)=BTCRX                                                IUDB48    425
      ENDIF                                                             IUDB48    426
      DDAT(JEI+3)=BCX                                                   IUDB48    427
C                                                                       IUDB48    428
      IF(LDEB)WRITE(IUD6,1040) JORD                                     IUDB48    429
C                                                                       IUDB48    430
      RETURN                                                            IUDB48    431
C                                                                       IUDB48    432
C-----------------------------------------------------------------------IUDB48    433
C                                                                       IUDB48    434
      ENTRY IUDB52(IORD,NLF,KN,CID)                                     IUDB48    435
CD                                                                      IUDB48    436
CD    FOR BLOCK TYPE 52 (TYPE SD2 END BLOCK).                           IUDB48    437
CD                                                                      IUDB48    438
      LDEB=(JDEB(262).NE.0)                                             IUDB48    439
C                                                                       IUDB48    440
      NINP=0                                                            IUDB48    441
      NEXTB=0                                                           IUDB48    442
      JORD=JUDE(IORD)                                                   IUDB48    443
      KORD=JSTATE+KUDE(IORD)+1                                          IUDB48    444
      JEI=JEB+2                                                         IUDB48    445
      QLB=DDAT(JEI+1)                                                   IUDB48    446
      QCB=DDAT(JEI+2)                                                   IUDB48    447
      J2=JE5-2                                                          IUDB48    448
      DO 190 J=1,INTUD                                                  IUDB48    449
      J2=J2+2                                                           IUDB48    450
      IDD=IDDAT(J2+2)                                                   IUDB48    451
      IDD=IABS(IDD)                                                     IUDB48    452
      IF(IDD.EQ.IORD) THEN                                              IUDB48    453
         XDAT=1.0                                                       IUDB48    454
         IF(IDDAT(J2+2).LT.0) XDAT=-1.0                                 IUDB48    455
         IOUT=IDDAT(J2+1)                                               IUDB48    456
         IF(JUDE(IOUT).EQ.0) THEN                                       IUDB48    457
            NEXTB=IOUT                                                  IUDB48    458
            XDATN=XDAT                                                  IUDB48    459
            NINP=NINP+1                                                 IUDB48    460
         ELSE                                                           IUDB48    461
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    462
         WRITE(MSG(2),1030) IORD,BLNAM1,BLNAM2                          IUDB48    463
         CALL PRTMSG(2)                                                 IUDB48    464
            MSG(1)='IUDB52: UDM ERROR'                                  IUDB48    465
            CALL ASTOP(MSG(1),17)                                       IUDB48    466
         ENDIF                                                          IUDB48    467
      ENDIF                                                             IUDB48    468
  190 CONTINUE                                                          IUDB48    469
      J3=JE6-3                                                          IUDB48    470
      DO 200 J=1,INPUD                                                  IUDB48    471
      J3=J3+3                                                           IUDB48    472
      IF(IDDAT(J3+1).EQ.IORD) THEN                                      IUDB48    473
         IIN=IDDAT(J3+2)                                                IUDB48    474
         IF(IIN.EQ.20) THEN                                             IUDB48    475
            XDATN=DDAT(J3+3)                                            IUDB48    476
            NINP=NINP+1                                                 IUDB48    477
         ELSE                                                           IUDB48    478
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    479
         WRITE(MSG(2),1001) IORD,BLNAM1,BLNAM2                          IUDB48    480
         WRITE(MSG(3),1002)                                             IUDB48    481
         CALL PRTMSG(3)                                                 IUDB48    482
            MSG(1)='IUDB52: UDM ERROR'                                  IUDB48    483
            CALL ASTOP(MSG(1),17)                                       IUDB48    484
         ENDIF                                                          IUDB48    485
      ENDIF                                                             IUDB48    486
  200 CONTINUE                                                          IUDB48    487
      IF(NINP.EQ.0) THEN                                                IUDB48    488
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    489
         WRITE(MSG(2),1010) IORD,BLNAM1,BLNAM2                          IUDB48    490
         CALL PRTMSG(2)                                                 IUDB48    491
            MSG(1)='IUDB52: UDM ERROR'                                  IUDB48    492
            CALL ASTOP(MSG(1),17)                                       IUDB48    493
      ENDIF                                                             IUDB48    494
      IF(NINP.GT.1) THEN                                                IUDB48    495
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    496
         WRITE(MSG(2),1250) IORD,BLNAM1,BLNAM2                          IUDB48    497
         CALL PRTMSG(2)                                                 IUDB48    498
            MSG(1)='IUDB52: UDM ERROR'                                  IUDB48    499
            CALL ASTOP(MSG(1),17)                                       IUDB48    500
      ENDIF                                                             IUDB48    501
C                                                                       IUDB48    502
C     DATA PREPARATIONS AND INPUT DATA PRINTOUT                         IUDB48    503
C                                                                       IUDB48    504
      BDEVX=VALOUT(IORD)                                                IUDB48    505
      BCX=QCB/QLB                                                       IUDB48    506
      BTCRX=BDEVX+BCX                                                   IUDB48    507
      IF(BTCRX.LT.0.0.OR.BTCRX.GT.1.0) THEN                             IUDB48    508
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    509
         WRITE(MSG(2),1360) IORD,BLNAM1,BLNAM2                          IUDB48    510
         WRITE(MSG(3),1460)                                             IUDB48    511
         WRITE(MSG(4),1461) BTCRX,BDEVX                                 IUDB48    512
         CALL PRTMSG(4)                                                 IUDB48    513
         MSG(1)='IUDB52: UDM ERROR'                                     IUDB48    514
         CALL ASTOP(MSG(1),17)                                          IUDB48    515
      ENDIF                                                             IUDB48    516
      PPI=4.0*ATAN(1.0)                                                 IUDB48    517
      VALIN(5)=BDEVX                                                    IUDB48    518
      VALIN(6)=BTCRX                                                    IUDB48    519
      SIGMA=BTCRX                                                       IUDB48    520
      IF((SIGMA.LE.0.0.AND.SIGMA.GE.0.0).OR.                            IUDB48    521
     *   (SIGMA.LE.1.0.AND.SIGMA.GE.1.0)) GO TO 220                     IUDB48    522
      NN=0                                                              IUDB48    523
  210 SIGMAX=SIGMA                                                      IUDB48    524
      NN=NN+1                                                           IUDB48    525
      SIGMA=BTCRX+SIN(PPI*SIGMAX)/PPI                                   IUDB48    526
      IF(ABS(SIGMA-SIGMAX).GT.0.0001.AND.NN.LT.200)GOTO 210             IUDB48    527
  220 VALIN(11)=SIGMA                                                   IUDB48    528
      XSTATE(KORD)=SIGMA                                                IUDB48    529
      IF(NEXTB.NE.0) THEN                                               IUDB48    530
         VALOUT(NEXTB)=SIGMA                                            IUDB48    531
      ELSE                                                              IUDB48    532
         VALIN(20)=SIGMA                                                IUDB48    533
      ENDIF                                                             IUDB48    534
      DDAT(JEI+4)=BCX                                                   IUDB48    535
C                                                                       IUDB48    536
      IF(LDEB)WRITE(IUD6,1040) JORD                                     IUDB48    537
C                                                                       IUDB48    538
      RETURN                                                            IUDB48    539
C                                                                       IUDB48    540
C-----------------------------------------------------------------------IUDB48    541
C                                                                       IUDB48    542
      ENTRY IUDB53(IORD,NEXTB1,NLF,KN,CID)                              IUDB48    543
CD                                                                      IUDB48    544
CD    FOR BLOCK TYPE 53 (TYPE SD3 END BLOCK).                           IUDB48    545
CD                                                                      IUDB48    546
      LDEB=(JDEB(262).NE.0)                                             IUDB48    547
C                                                                       IUDB48    548
      NINP=0                                                            IUDB48    549
      NEXTB1=0                                                          IUDB48    550
      JORD=JUDE(IORD)                                                   IUDB48    551
      KORD=JSTATE+KUDE(IORD)+1                                          IUDB48    552
      JEI=JEB+2                                                         IUDB48    553
      QLB=DDAT(JEI+1)                                                   IUDB48    554
      QCB=DDAT(JEI+2)                                                   IUDB48    555
      NCS=IDDAT(JEI+6)                                                  IUDB48    556
      XNCS=NCS                                                          IUDB48    557
      SOUTX=DDAT(JEI+7)                                                 IUDB48    558
      SINX=DDAT(JEI+8)                                                  IUDB48    559
      IF(SOUTX.LE.SINX) THEN                                            IUDB48    560
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    561
         WRITE(MSG(2),1580) IORD,BLNAM1,BLNAM2                          IUDB48    562
         WRITE(MSG(3),1581) SOUTX,SINX                                  IUDB48    563
         CALL PRTMSG(3)                                                 IUDB48    564
         MSG(1)='IUDB53: UDM ERROR'                                     IUDB48    565
         CALL ASTOP(MSG(1),17)                                          IUDB48    566
      ENDIF                                                             IUDB48    567
      IF(IDDAT(JEI+1).EQ.0) THEN                                        IUDB48    568
         QLB0=QCB/XNCS                                                  IUDB48    569
         XHI=1.0                                                        IUDB48    570
         XLO=0.0                                                        IUDB48    571
      ELSE                                                              IUDB48    572
         IF(SOUTX.GT.1.0.OR.SINX.LT.0.0) THEN                           IUDB48    573
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    574
         WRITE(MSG(2),1600) IORD,BLNAM1,BLNAM2                          IUDB48    575
         WRITE(MSG(3),1610)                                             IUDB48    576
         WRITE(MSG(4),1620) SOUTX,SINX,QLB                              IUDB48    577
         CALL PRTMSG(4)                                                 IUDB48    578
         MSG(1)='IUDB53: UDM ERROR'                                     IUDB48    579
         CALL ASTOP(MSG(1),17)                                          IUDB48    580
         ENDIF                                                          IUDB48    581
         QLB0=QLB                                                       IUDB48    582
         XHI=SOUTX                                                      IUDB48    583
         XLO=SINX                                                       IUDB48    584
      ENDIF                                                             IUDB48    585
      IF(NCS.EQ.0) THEN                                                 IUDB48    586
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    587
         WRITE(MSG(2),1570) IORD,BLNAM1,BLNAM2                          IUDB48    588
         CALL PRTMSG(2)                                                 IUDB48    589
         MSG(1)='IUDB53: UDM ERROR'                                     IUDB48    590
         CALL ASTOP(MSG(1),17)                                          IUDB48    591
      ENDIF                                                             IUDB48    592
      J2=JE5-2                                                          IUDB48    593
      DO 230 J=1,INTUD                                                  IUDB48    594
      J2=J2+2                                                           IUDB48    595
      IDD=IDDAT(J2+2)                                                   IUDB48    596
      IDD=IABS(IDD)                                                     IUDB48    597
      IF(IDD.EQ.IORD) THEN                                              IUDB48    598
         XDAT=1.0                                                       IUDB48    599
         IF(IDDAT(J2+2).LT.0) XDAT=-1.0                                 IUDB48    600
         IOUT=IDDAT(J2+1)                                               IUDB48    601
         IF(NINP.EQ.0) THEN                                             IUDB48    602
            IF(JUDE(IOUT).EQ.0) THEN                                    IUDB48    603
               NEXTB1=IOUT                                              IUDB48    604
               XDATN=XDAT                                               IUDB48    605
               NINP=NINP+1                                              IUDB48    606
            ELSE                                                        IUDB48    607
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    608
         WRITE(MSG(2),1030) IORD,BLNAM1,BLNAM2                          IUDB48    609
         CALL PRTMSG(2)                                                 IUDB48    610
         MSG(1)='IUDB53: UDM ERROR'                                     IUDB48    611
         CALL ASTOP(MSG(1),17)                                          IUDB48    612
            ENDIF                                                       IUDB48    613
         ELSE                                                           IUDB48    614
            NINP=NINP+1                                                 IUDB48    615
         ENDIF                                                          IUDB48    616
      ENDIF                                                             IUDB48    617
  230 CONTINUE                                                          IUDB48    618
      J3=JE6-3                                                          IUDB48    619
      DO 240 J=1,INPUD                                                  IUDB48    620
      J3=J3+3                                                           IUDB48    621
      IF(IDDAT(J3+1).EQ.IORD) THEN                                      IUDB48    622
         IIN=IDDAT(J3+2)                                                IUDB48    623
         IF(NINP.EQ.0) THEN                                             IUDB48    624
            IF(IIN.EQ.20) THEN                                          IUDB48    625
               XDATN=DDAT(J3+3)                                         IUDB48    626
               NINP=NINP+1                                              IUDB48    627
            ELSE                                                        IUDB48    628
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    629
         WRITE(MSG(2),1001) IORD,BLNAM1,BLNAM2                          IUDB48    630
         WRITE(MSG(3),1002)                                             IUDB48    631
         CALL PRTMSG(3)                                                 IUDB48    632
         MSG(1)='IUDB53: UDM ERROR'                                     IUDB48    633
         CALL ASTOP(MSG(1),17)                                          IUDB48    634
            ENDIF                                                       IUDB48    635
         ELSE                                                           IUDB48    636
            IF(IIN.EQ.20)THEN                                           IUDB48    637
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    638
         WRITE(MSG(2),1001) IORD,BLNAM1,BLNAM2                          IUDB48    639
         WRITE(MSG(3),1590)                                             IUDB48    640
         CALL PRTMSG(3)                                                 IUDB48    641
         MSG(1)='IUDB53: UDM ERROR'                                     IUDB48    642
         CALL ASTOP(MSG(1),17)                                          IUDB48    643
            ELSE                                                        IUDB48    644
               NINP=NINP+1                                              IUDB48    645
            ENDIF                                                       IUDB48    646
         ENDIF                                                          IUDB48    647
      ENDIF                                                             IUDB48    648
  240 CONTINUE                                                          IUDB48    649
      IF(NINP.EQ.0) THEN                                                IUDB48    650
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    651
         WRITE(MSG(2),1010) IORD,BLNAM1,BLNAM2                          IUDB48    652
         CALL PRTMSG(2)                                                 IUDB48    653
         MSG(1)='IUDB53: UDM ERROR'                                     IUDB48    654
         CALL ASTOP(MSG(1),17)                                          IUDB48    655
      ENDIF                                                             IUDB48    656
      IF(NINP.GT.2) THEN                                                IUDB48    657
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    658
         WRITE(MSG(2),1050) IORD,BLNAM1,BLNAM2                          IUDB48    659
         CALL PRTMSG(2)                                                 IUDB48    660
         MSG(1)='IUDB53: UDM ERROR'                                     IUDB48    661
         CALL ASTOP(MSG(1),17)                                          IUDB48    662
      ENDIF                                                             IUDB48    663
C                                                                       IUDB48    664
C     DATA PREPARATIONS AND INPUT DATA PRINTOUT                         IUDB48    665
C                                                                       IUDB48    666
      BDEVX=VALOUT(IORD)                                                IUDB48    667
      QBAS=QCB+QLB                                                      IUDB48    668
      NTSC=0                                                            IUDB48    669
      BTSCX=0.0                                                         IUDB48    670
      BTCRX=BDEVX*QBAS/QLB0                                             IUDB48    671
  250 IF(BTCRX.LE.XHI.AND.BTCRX.GE.XLO) GO TO 260                       IUDB48    672
      IF(BTCRX.LT.XLO) THEN                                             IUDB48    673
         IF(NTSC.LT.NCS)THEN                                            IUDB48    674
            NTSC=NTSC+1                                                 IUDB48    675
            BTSCX=NTSC/XNCS                                             IUDB48    676
            BTCRX=(BDEVX+BTSCX*QCB/QBAS)*QBAS/QLB0                      IUDB48    677
            GO TO 250                                                   IUDB48    678
         ELSE                                                           IUDB48    679
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    680
         WRITE(MSG(2),1560) IORD,BLNAM1,BLNAM2                          IUDB48    681
         WRITE(MSG(3),1561)                                             IUDB48    682
         WRITE(MSG(4),1562) BTCRX,BDEVX,XHI,XLO                         IUDB48    683
         CALL PRTMSG(4)                                                 IUDB48    684
         MSG(1)='IUDB53: UDM ERROR'                                     IUDB48    685
         CALL ASTOP(MSG(1),17)                                          IUDB48    686
         ENDIF                                                          IUDB48    687
      ELSE                                                              IUDB48    688
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    689
         WRITE(MSG(2),1560) IORD,BLNAM1,BLNAM2                          IUDB48    690
         WRITE(MSG(3),1561)                                             IUDB48    691
         WRITE(MSG(4),1562) BTCRX,BDEVX,XHI,XLO                         IUDB48    692
         CALL PRTMSG(4)                                                 IUDB48    693
         MSG(1)='IUDB53: UDM ERROR'                                     IUDB48    694
         CALL ASTOP(MSG(1),17)                                          IUDB48    695
      ENDIF                                                             IUDB48    696
  260 CONTINUE                                                          IUDB48    697
      PPI=4.0*ATAN(1.0)                                                 IUDB48    698
      VALIN(5)=BDEVX                                                    IUDB48    699
      VALIN(6)=BTCRX                                                    IUDB48    700
      SIGMA=BTCRX                                                       IUDB48    701
      IF((SIGMA.LE.0.0.AND.SIGMA.GE.0.0).OR.                            IUDB48    702
     *   (SIGMA.LE.1.0.AND.SIGMA.GE.1.0)) GO TO 280                     IUDB48    703
      NN=0                                                              IUDB48    704
  270 SIGMAX=SIGMA                                                      IUDB48    705
      NN=NN+1                                                           IUDB48    706
      SIGMA=BTCRX+SIN(PPI*SIGMAX)/PPI                                   IUDB48    707
      IF(ABS(SIGMA-SIGMAX).GT.0.0001.AND.NN.LT.200)GOTO 270             IUDB48    708
  280 VALIN(11)=SIGMA                                                   IUDB48    709
      XSTATE(KORD)=SIGMA                                                IUDB48    710
      XSTATE(KORD+1)=BTSCX                                              IUDB48    711
      IF(NEXTB1.NE.0) THEN                                              IUDB48    712
         VALOUT(NEXTB1)=SIGMA                                           IUDB48    713
      ELSE                                                              IUDB48    714
         VALIN(20)=SIGMA                                                IUDB48    715
      ENDIF                                                             IUDB48    716
      IDDAT(JEI+9)=NTSC                                                 IUDB48    717
      DDAT(JEI+10)=0.0                                                  IUDB48    718
      DDAT(JEI+12)=0.0                                                  IUDB48    719
      DDAT(JEI+1)=QLB0/QBAS                                             IUDB48    720
      DDAT(JEI+2)=QCB/QBAS                                              IUDB48    721
C                                                                       IUDB48    722
      IF(LDEB)WRITE(IUD6,1040) JORD                                     IUDB48    723
C                                                                       IUDB48    724
      RETURN                                                            IUDB48    725
C                                                                       IUDB48    726
C-----------------------------------------------------------------------IUDB48    727
C                                                                       IUDB48    728
      ENTRY IUDB54(IORD,NLF,KN,CID)                                     IUDB48    729
CD                                                                      IUDB48    730
CD    FOR BLOCK TYPE 54 (TYPE SD4 END BLOCK).                           IUDB48    731
CD                                                                      IUDB48    732
      LDEB=(JDEB(262).NE.0)                                             IUDB48    733
C                                                                       IUDB48    734
      NINP=0                                                            IUDB48    735
      NEXTB=0                                                           IUDB48    736
      JORD=JUDE(IORD)                                                   IUDB48    737
      KORD=JSTATE+KUDE(IORD)+1                                          IUDB48    738
      JEI=JEB+2                                                         IUDB48    739
      TT=DDAT(JEI+1)                                                    IUDB48    740
      HYS=DDAT(JEI+2)                                                   IUDB48    741
      NTS=IDDAT(JEI+3)                                                  IUDB48    742
      IPATH=IDDAT(JEI+4)                                                IUDB48    743
      IF((IPATH.EQ.1.OR.IPATH.EQ.2).AND.NTS.LE.0) THEN                  IUDB48    744
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    745
         WRITE(MSG(2),1760) IORD,BLNAM1,BLNAM2                          IUDB48    746
         CALL PRTMSG(2)                                                 IUDB48    747
         MSG(1)='IUDB54: UDM ERROR'                                     IUDB48    748
         CALL ASTOP(MSG(1),17)                                          IUDB48    749
      ENDIF                                                             IUDB48    750
      J2=JE5-2                                                          IUDB48    751
      DO 290 J=1,INTUD                                                  IUDB48    752
      J2=J2+2                                                           IUDB48    753
      IDD=IDDAT(J2+2)                                                   IUDB48    754
      IDD=IABS(IDD)                                                     IUDB48    755
      IF(IDD.EQ.IORD) THEN                                              IUDB48    756
         XDAT=1.0                                                       IUDB48    757
         IF(IDDAT(J2+2).LT.0) XDAT=-1.0                                 IUDB48    758
         IOUT=IDDAT(J2+1)                                               IUDB48    759
         IF(JUDE(IOUT).EQ.0) THEN                                       IUDB48    760
            NEXTB=IOUT                                                  IUDB48    761
            XDATN=XDAT                                                  IUDB48    762
            NINP=NINP+1                                                 IUDB48    763
         ELSE                                                           IUDB48    764
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    765
         WRITE(MSG(2),1030) IORD,BLNAM1,BLNAM2                          IUDB48    766
         CALL PRTMSG(2)                                                 IUDB48    767
         MSG(1)='IUDB54: UDM ERROR'                                     IUDB48    768
         CALL ASTOP(MSG(1),17)                                          IUDB48    769
         ENDIF                                                          IUDB48    770
      ENDIF                                                             IUDB48    771
  290 CONTINUE                                                          IUDB48    772
      J3=JE6-3                                                          IUDB48    773
      DO 300 J=1,INPUD                                                  IUDB48    774
      J3=J3+3                                                           IUDB48    775
      IF(IDDAT(J3+1).EQ.IORD) THEN                                      IUDB48    776
         IIN=IDDAT(J3+2)                                                IUDB48    777
         IF(IIN.EQ.20) THEN                                             IUDB48    778
            XDATN=DDAT(J3+3)                                            IUDB48    779
            NINP=NINP+1                                                 IUDB48    780
         ELSE                                                           IUDB48    781
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    782
         WRITE(MSG(2),1001) IORD,BLNAM1,BLNAM2                          IUDB48    783
         WRITE(MSG(3),1002)                                             IUDB48    784
         CALL PRTMSG(3)                                                 IUDB48    785
         MSG(1)='IUDB54: UDM ERROR'                                     IUDB48    786
         CALL ASTOP(MSG(1),17)                                          IUDB48    787
         ENDIF                                                          IUDB48    788
      ENDIF                                                             IUDB48    789
  300 CONTINUE                                                          IUDB48    790
      IF(NINP.EQ.0) THEN                                                IUDB48    791
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    792
         WRITE(MSG(2),1010) IORD,BLNAM1,BLNAM2                          IUDB48    793
         CALL PRTMSG(2)                                                 IUDB48    794
         MSG(1)='IUDB54: UDM ERROR'                                     IUDB48    795
         CALL ASTOP(MSG(1),17)                                          IUDB48    796
      ENDIF                                                             IUDB48    797
      IF(NINP.GT.1) THEN                                                IUDB48    798
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    799
         WRITE(MSG(2),1250) IORD,BLNAM1,BLNAM2                          IUDB48    800
         CALL PRTMSG(2)                                                 IUDB48    801
         MSG(1)='IUDB54: UDM ERROR'                                     IUDB48    802
         CALL ASTOP(MSG(1),17)                                          IUDB48    803
      ENDIF                                                             IUDB48    804
C                                                                       IUDB48    805
C     DATA PREPARATIONS AND INPUT DATA PRINTOUT                         IUDB48    806
C                                                                       IUDB48    807
      XDEV=VALOUT(IORD)                                                 IUDB48    808
      IF(XDEV.GT.1.0) THEN                                              IUDB48    809
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    810
         WRITE(MSG(2),1740) IORD,BLNAM1,BLNAM2                          IUDB48    811
         WRITE(MSG(3),1750)                                             IUDB48    812
         CALL PRTMSG(3)                                                 IUDB48    813
         MSG(1)='IUDB54: UDM ERROR'                                     IUDB48    814
         CALL ASTOP(MSG(1),17)                                          IUDB48    815
      ELSEIF(XDEV.LT.-1.0) THEN                                         IUDB48    816
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    817
         WRITE(MSG(2),1740) IORD,BLNAM1,BLNAM2                          IUDB48    818
         WRITE(MSG(3),1751)                                             IUDB48    819
         CALL PRTMSG(3)                                                 IUDB48    820
         MSG(1)='IUDB54: UDM ERROR'                                     IUDB48    821
         CALL ASTOP(MSG(1),17)                                          IUDB48    822
      ENDIF                                                             IUDB48    823
      VALIN(11)=XDEV                                                    IUDB48    824
      VALIN(12)=XDEV                                                    IUDB48    825
      IF(NEXTB.NE.0) THEN                                               IUDB48    826
         VALOUT(NEXTB)=XDEV                                             IUDB48    827
      ELSE                                                              IUDB48    828
         VALIN(20)=XDEV                                                 IUDB48    829
      ENDIF                                                             IUDB48    830
      IF(IPATH.EQ.1.OR.IPATH.EQ.2) THEN                                 IUDB48    831
         STEPS=NTS                                                      IUDB48    832
         STEPS=1.0/STEPS                                                IUDB48    833
         STEPS1=STEPS*NTS                                               IUDB48    834
  299    IF(STEPS1.GE.1.0) THEN                                         IUDB48    835
            STEPS=0.99999*STEPS                                         IUDB48    836
            STEPS1=STEPS*NTS                                            IUDB48    837
            GO TO 299                                                   IUDB48    838
         ENDIF                                                          IUDB48    839
         IF(HYS.LT.0.0) HYS=0.0                                         IUDB48    840
         IF(HYS.GT.STEPS) HYS=STEPS                                     IUDB48    841
         DDAT(JEI+2)=HYS                                                IUDB48    842
         DDAT(JEI+5)=STEPS                                              IUDB48    843
         DDAT(JEI+6)=XDEV                                               IUDB48    844
         TDEV=0.0                                                       IUDB48    845
         DO 301,I=1,NTS                                                 IUDB48    846
         IF(XDEV.GT.0.0) THEN                                           IUDB48    847
            IF(IPATH.EQ.2) THEN                                         IUDB48    848
               IF(XDEV.LT.TDEV+STEPS-HYS) THEN                          IUDB48    849
                  GO TO 302                                             IUDB48    850
               ELSE                                                     IUDB48    851
                  TDEV=TDEV+STEPS                                       IUDB48    852
               ENDIF                                                    IUDB48    853
            ELSE                                                        IUDB48    854
               IF(XDEV.LT.TDEV+STEPS) THEN                              IUDB48    855
                  GO TO 302                                             IUDB48    856
               ELSE                                                     IUDB48    857
                  TDEV=TDEV+STEPS                                       IUDB48    858
               ENDIF                                                    IUDB48    859
            ENDIF                                                       IUDB48    860
         ELSEIF(XDEV.LT.0.0) THEN                                       IUDB48    861
            IF(IPATH.EQ.2) THEN                                         IUDB48    862
               IF(XDEV.GT.TDEV-STEPS+HYS) THEN                          IUDB48    863
                  GO TO 302                                             IUDB48    864
               ELSE                                                     IUDB48    865
                  TDEV=TDEV-STEPS                                       IUDB48    866
               ENDIF                                                    IUDB48    867
            ELSE                                                        IUDB48    868
               IF(XDEV.GT.TDEV-STEPS) THEN                              IUDB48    869
                  GO TO 302                                             IUDB48    870
               ELSE                                                     IUDB48    871
                  TDEV=TDEV-STEPS                                       IUDB48    872
               ENDIF                                                    IUDB48    873
            ENDIF                                                       IUDB48    874
         ELSE                                                           IUDB48    875
            GO TO 302                                                   IUDB48    876
         ENDIF                                                          IUDB48    877
  301    CONTINUE                                                       IUDB48    878
  302    DDAT(JEI+7)=TDEV                                               IUDB48    879
      ELSE                                                              IUDB48    880
         TDEV=XDEV                                                      IUDB48    881
      ENDIF                                                             IUDB48    882
      XSTATE(KORD)=TDEV                                                 IUDB48    883
      VALOUT(IORD)=TDEV                                                 IUDB48    884
C                                                                       IUDB48    885
      IF(LDEB)WRITE(IUD6,1040) JORD                                     IUDB48    886
C                                                                       IUDB48    887
      RETURN                                                            IUDB48    888
C                                                                       IUDB48    889
C-----------------------------------------------------------------------IUDB48    890
C                                                                       IUDB48    891
      ENTRY IUDB55(IORD,NLF,KN,CID)                                     IUDB48    892
CD                                                                      IUDB48    893
CD    FOR BLOCK TYPE 55 (TYPE SD5 END BLOCK).                           IUDB48    894
CD                                                                      IUDB48    895
      LDEB=(JDEB(262).NE.0)                                             IUDB48    896
C                                                                       IUDB48    897
      NINP=0                                                            IUDB48    898
      JORD=JUDE(IORD)                                                   IUDB48    899
      KORD=JSTATE+KUDE(IORD)+1                                          IUDB48    900
      JEI=JEB+2                                                         IUDB48    901
      PT=DDAT(JEI+1)                                                    IUDB48    902
      TT=DDAT(JEI+2)                                                    IUDB48    903
      HYS=DDAT(JEI+3)                                                   IUDB48    904
      NYS=IDDAT(JEI+4)                                                  IUDB48    905
      IPATH=IDDAT(JEI+5)                                                IUDB48    906
      IF((IPATH.EQ.1.OR.IPATH.EQ.2).AND.NYS.LE.0) THEN                  IUDB48    907
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    908
         WRITE(MSG(2),1860) IORD,BLNAM1,BLNAM2                          IUDB48    909
         CALL PRTMSG(2)                                                 IUDB48    910
         MSG(1)='IUDB55: UDM ERROR'                                     IUDB48    911
         CALL ASTOP(MSG(1),17)                                          IUDB48    912
      ENDIF                                                             IUDB48    913
      J2=JE5-2                                                          IUDB48    914
      DO 310 J=1,INTUD                                                  IUDB48    915
      J2=J2+2                                                           IUDB48    916
      IDD=IDDAT(J2+2)                                                   IUDB48    917
      IDD=IABS(IDD)                                                     IUDB48    918
      IF(IDD.EQ.IORD) THEN                                              IUDB48    919
         XDAT=1.0                                                       IUDB48    920
         IF(IDDAT(J2+2).LT.0) XDAT=-1.0                                 IUDB48    921
         IOUT=IDDAT(J2+1)                                               IUDB48    922
         VALI=VALOUT(IOUT)*XDAT                                         IUDB48    923
         NINP=NINP+1                                                    IUDB48    924
      ENDIF                                                             IUDB48    925
  310 CONTINUE                                                          IUDB48    926
      J3=JE6-3                                                          IUDB48    927
      DO 320 J=1,INPUD                                                  IUDB48    928
      J3=J3+3                                                           IUDB48    929
      IF(IDDAT(J3+1).EQ.IORD) THEN                                      IUDB48    930
         IIN=IDDAT(J3+2)                                                IUDB48    931
         VALI=VALIN(IIN)*DDAT(J3+3)                                     IUDB48    932
         NINP=NINP+1                                                    IUDB48    933
      ENDIF                                                             IUDB48    934
  320 CONTINUE                                                          IUDB48    935
      IF(NINP.EQ.0) THEN                                                IUDB48    936
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    937
         WRITE(MSG(2),1010) IORD,BLNAM1,BLNAM2                          IUDB48    938
         CALL PRTMSG(2)                                                 IUDB48    939
         MSG(1)='IUDB55: UDM ERROR'                                     IUDB48    940
         CALL ASTOP(MSG(1),17)                                          IUDB48    941
      ENDIF                                                             IUDB48    942
      IF(NINP.GT.1) THEN                                                IUDB48    943
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    944
         WRITE(MSG(2),1250) IORD,BLNAM1,BLNAM2                          IUDB48    945
         CALL PRTMSG(2)                                                 IUDB48    946
         MSG(1)='IUDB55: UDM ERROR'                                     IUDB48    947
         CALL ASTOP(MSG(1),17)                                          IUDB48    948
      ENDIF                                                             IUDB48    949
C                                                                       IUDB48    950
C     DATA PREPARATIONS AND INPUT DATA PRINTOUT                         IUDB48    951
C                                                                       IUDB48    952
      IF(VALI.GT.0.01.OR.VALI.LT.-0.01) THEN                            IUDB48    953
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48    954
         WRITE(MSG(2),1830) IORD,BLNAM1,BLNAM2                          IUDB48    955
         CALL PRTMSG(2)                                                 IUDB48    956
         MSG(1)='IUDB55: UDM ERROR'                                     IUDB48    957
         CALL ASTOP(MSG(1),17)                                          IUDB48    958
      ENDIF                                                             IUDB48    959
      IF(IPATH.EQ.1.OR.IPATH.EQ.2) THEN                                 IUDB48    960
         STEPS=NYS                                                      IUDB48    961
         STEPS=1.0/STEPS                                                IUDB48    962
         STEPS1=STEPS*NYS                                               IUDB48    963
  329    IF(STEPS1.GE.1.0) THEN                                         IUDB48    964
            STEPS=0.99999*STEPS                                         IUDB48    965
            STEPS1=STEPS*NYS                                            IUDB48    966
            GO TO 329                                                   IUDB48    967
         ENDIF                                                          IUDB48    968
         IF(HYS.LT.0.0) HYS=0.0                                         IUDB48    969
         IF(HYS.GT.STEPS) HYS=STEPS                                     IUDB48    970
         DDAT(JEI+3)=HYS                                                IUDB48    971
         DDAT(JEI+6)=STEPS                                              IUDB48    972
         DDAT(JEI+7)=0.0                                                IUDB48    973
         DDAT(JEI+8)=0.0                                                IUDB48    974
      ENDIF                                                             IUDB48    975
      XSTATE(KORD)=0.0                                                  IUDB48    976
C                                                                       IUDB48    977
      IF(LDEB)WRITE(IUD6,1040) JORD                                     IUDB48    978
C                                                                       IUDB48    979
      RETURN                                                            IUDB48    980
C                                                                       IUDB48    981
C-----------------------------------------------------------------------IUDB48    982
C                                                                       IUDB48    983
      ENTRY IUDB56(IORD,NLF,KN,CID)                                     IUDB48    984
CD                                                                      IUDB48    985
CD    FOR BLOCK TYPE 56 (TYPE SD6 END BLOCK).                           IUDB48    986
CD                                                                      IUDB48    987
      LDEB=(JDEB(262).NE.0)                                             IUDB48    988
C                                                                       IUDB48    989
      NINP=0                                                            IUDB48    990
      NEXTB=0                                                           IUDB48    991
      JORD=JUDE(IORD)                                                   IUDB48    992
      KORD=JSTATE+KUDE(IORD)+1                                          IUDB48    993
      JEI=JEB+2                                                         IUDB48    994
      PG=DDAT(JEI+1)                                                    IUDB48    995
      TG=DDAT(JEI+2)                                                    IUDB48    996
      HYS=DDAT(JEI+3)                                                   IUDB48    997
      NGS=IDDAT(JEI+4)                                                  IUDB48    998
      IPATH=IDDAT(JEI+5)                                                IUDB48    999
      IF((IPATH.EQ.1.OR.IPATH.EQ.2).AND.NGS.LE.0) THEN                  IUDB48   1000
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1001
         WRITE(MSG(2),1960) IORD,BLNAM1,BLNAM2                          IUDB48   1002
         CALL PRTMSG(2)                                                 IUDB48   1003
         MSG(1)='IUDB56: UDM ERROR'                                     IUDB48   1004
         CALL ASTOP(MSG(1),17)                                          IUDB48   1005
      ENDIF                                                             IUDB48   1006
      J2=JE5-2                                                          IUDB48   1007
      DO 330 J=1,INTUD                                                  IUDB48   1008
      J2=J2+2                                                           IUDB48   1009
      IDD=IDDAT(J2+2)                                                   IUDB48   1010
      IDD=IABS(IDD)                                                     IUDB48   1011
      IF(IDD.EQ.IORD) THEN                                              IUDB48   1012
         XDAT=1.0                                                       IUDB48   1013
         IF(IDDAT(J2+2).LT.0) XDAT=-1.0                                 IUDB48   1014
         IOUT=IDDAT(J2+1)                                               IUDB48   1015
         IF(JUDE(IOUT).EQ.0) THEN                                       IUDB48   1016
            NEXTB=IOUT                                                  IUDB48   1017
            XDATN=XDAT                                                  IUDB48   1018
            NINP=NINP+1                                                 IUDB48   1019
         ELSE                                                           IUDB48   1020
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1021
         WRITE(MSG(2),1030) IORD,BLNAM1,BLNAM2                          IUDB48   1022
         CALL PRTMSG(2)                                                 IUDB48   1023
         MSG(1)='IUDB56: UDM ERROR'                                     IUDB48   1024
         CALL ASTOP(MSG(1),17)                                          IUDB48   1025
         ENDIF                                                          IUDB48   1026
      ENDIF                                                             IUDB48   1027
  330 CONTINUE                                                          IUDB48   1028
      J3=JE6-3                                                          IUDB48   1029
      DO 340 J=1,INPUD                                                  IUDB48   1030
      J3=J3+3                                                           IUDB48   1031
      IF(IDDAT(J3+1).EQ.IORD) THEN                                      IUDB48   1032
         IIN=IDDAT(J3+2)                                                IUDB48   1033
         IF(IIN.EQ.20) THEN                                             IUDB48   1034
            XDATN=DDAT(J3+3)                                            IUDB48   1035
            NINP=NINP+1                                                 IUDB48   1036
         ELSE                                                           IUDB48   1037
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1038
         WRITE(MSG(2),1001) IORD,BLNAM1,BLNAM2                          IUDB48   1039
         WRITE(MSG(3),1002)                                             IUDB48   1040
         CALL PRTMSG(3)                                                 IUDB48   1041
         MSG(1)='IUDB56: UDM ERROR'                                     IUDB48   1042
         CALL ASTOP(MSG(1),17)                                          IUDB48   1043
         ENDIF                                                          IUDB48   1044
      ENDIF                                                             IUDB48   1045
  340 CONTINUE                                                          IUDB48   1046
      IF(NINP.EQ.0) THEN                                                IUDB48   1047
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1048
         WRITE(MSG(2),1010) IORD,BLNAM1,BLNAM2                          IUDB48   1049
         CALL PRTMSG(2)                                                 IUDB48   1050
         MSG(1)='IUDB56: UDM ERROR'                                     IUDB48   1051
         CALL ASTOP(MSG(1),17)                                          IUDB48   1052
      ENDIF                                                             IUDB48   1053
      IF(NINP.GT.1) THEN                                                IUDB48   1054
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1055
         WRITE(MSG(2),1250) IORD,BLNAM1,BLNAM2                          IUDB48   1056
         CALL PRTMSG(2)                                                 IUDB48   1057
         MSG(1)='IUDB56: UDM ERROR'                                     IUDB48   1058
         CALL ASTOP(MSG(1),17)                                          IUDB48   1059
      ENDIF                                                             IUDB48   1060
C                                                                       IUDB48   1061
C     DATA PREPARATIONS AND INPUT DATA PRINTOUT                         IUDB48   1062
C                                                                       IUDB48   1063
      GDEV=VALOUT(IORD)                                                 IUDB48   1064
      IF(GDEV.LT.0.0) THEN                                              IUDB48   1065
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1066
         WRITE(MSG(2),1930) IORD,BLNAM1,BLNAM2                          IUDB48   1067
         WRITE(MSG(3),1941)                                             IUDB48   1068
         CALL PRTMSG(3)                                                 IUDB48   1069
         MSG(1)='IUDB56: UDM ERROR'                                     IUDB48   1070
         CALL ASTOP(MSG(1),17)                                          IUDB48   1071
      ELSEIF(GDEV.GT.1.0) THEN                                          IUDB48   1072
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1073
         WRITE(MSG(2),1930) IORD,BLNAM1,BLNAM2                          IUDB48   1074
         WRITE(MSG(3),1940)                                             IUDB48   1075
         CALL PRTMSG(3)                                                 IUDB48   1076
         MSG(1)='IUDB56: UDM ERROR'                                     IUDB48   1077
         CALL ASTOP(MSG(1),17)                                          IUDB48   1078
      ENDIF                                                             IUDB48   1079
C                                                                       IUDB48   1080
      VALIN(12)=GDEV                                                    IUDB48   1081
      IF(NEXTB.NE.0) THEN                                               IUDB48   1082
         VALOUT(NEXTB)=GDEV                                             IUDB48   1083
      ELSE                                                              IUDB48   1084
         VALIN(20)=GDEV                                                 IUDB48   1085
      ENDIF                                                             IUDB48   1086
      IF(IPATH.EQ.1.OR.IPATH.EQ.2) THEN                                 IUDB48   1087
         STEPS=NGS                                                      IUDB48   1088
         STEPS=1.0/STEPS                                                IUDB48   1089
         STEPS1=STEPS*NGS                                               IUDB48   1090
  339    IF(STEPS1.GE.1.0) THEN                                         IUDB48   1091
            STEPS=0.99999*STEPS                                         IUDB48   1092
            STEPS1=STEPS*NGS                                            IUDB48   1093
            GO TO 339                                                   IUDB48   1094
         ENDIF                                                          IUDB48   1095
         IF(HYS.LT.0.0) HYS=0.0                                         IUDB48   1096
         IF(HYS.GT.STEPS) HYS=STEPS                                     IUDB48   1097
         DDAT(JEI+3)=HYS                                                IUDB48   1098
         DDAT(JEI+6)=STEPS                                              IUDB48   1099
         DDAT(JEI+7)=GDEV                                               IUDB48   1100
         TDEV=0.0                                                       IUDB48   1101
         IF(GDEV.GT.0.0) THEN                                           IUDB48   1102
            DO 341,I=1,NGS                                              IUDB48   1103
            IF(IPATH.EQ.2) THEN                                         IUDB48   1104
               IF(GDEV.LT.TDEV+STEPS-HYS) THEN                          IUDB48   1105
                  GO TO 342                                             IUDB48   1106
               ELSE                                                     IUDB48   1107
                  TDEV=TDEV+STEPS                                       IUDB48   1108
               ENDIF                                                    IUDB48   1109
            ELSE                                                        IUDB48   1110
               IF(GDEV.LT.TDEV+STEPS) THEN                              IUDB48   1111
                  GO TO 342                                             IUDB48   1112
               ELSE                                                     IUDB48   1113
                  TDEV=TDEV+STEPS                                       IUDB48   1114
               ENDIF                                                    IUDB48   1115
            ENDIF                                                       IUDB48   1116
  341       CONTINUE                                                    IUDB48   1117
  342       DDAT(JEI+8)=TDEV                                            IUDB48   1118
         ENDIF                                                          IUDB48   1119
      ELSE                                                              IUDB48   1120
         TDEV=GDEV                                                      IUDB48   1121
      ENDIF                                                             IUDB48   1122
      VALIN(15)=TDEV                                                    IUDB48   1123
      XSTATE(KORD)=TDEV                                                 IUDB48   1124
      VALOUT(IORD)=TDEV                                                 IUDB48   1125
C                                                                       IUDB48   1126
      IF(LDEB)WRITE(IUD6,1040) JORD                                     IUDB48   1127
C                                                                       IUDB48   1128
      RETURN                                                            IUDB48   1129
C                                                                       IUDB48   1130
C-----------------------------------------------------------------------IUDB48   1131
C                                                                       IUDB48   1132
      ENTRY IUDB57(IORD,NLF,KN,CID)                                     IUDB48   1133
CD                                                                      IUDB48   1134
CD    FOR BLOCK TYPE 57 (TYPE SD7 END BLOCK).                           IUDB48   1135
CD                                                                      IUDB48   1136
      LDEB=(JDEB(262).NE.0)                                             IUDB48   1137
C                                                                       IUDB48   1138
      NINP=0                                                            IUDB48   1139
      NEXTB=0                                                           IUDB48   1140
      JORD=JUDE(IORD)                                                   IUDB48   1141
      KORD=JSTATE+KUDE(IORD)+1                                          IUDB48   1142
      JEI=JEB+2                                                         IUDB48   1143
      QLB=DDAT(JEI+1)                                                   IUDB48   1144
      QCB=DDAT(JEI+2)                                                   IUDB48   1145
      AX=DDAT(JEI+3)                                                    IUDB48   1146
      BX=DDAT(JEI+4)                                                    IUDB48   1147
      VCO=DDAT(JEI+5)                                                   IUDB48   1148
      IF(AX.LT.0.0.OR.BX.LT.0.0.OR.AX+BX.LE.0.0) THEN                   IUDB48   1149
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1150
         WRITE(MSG(2),1362) IORD,BLNAM1,BLNAM2                          IUDB48   1151
         WRITE(MSG(3),1464) AX,BX                                       IUDB48   1152
         CALL PRTMSG(3)                                                 IUDB48   1153
         MSG(1)='IUDB57: UDM ERROR'                                     IUDB48   1154
         CALL ASTOP(MSG(1),17)                                          IUDB48   1155
      ENDIF                                                             IUDB48   1156
      J2=JE5-2                                                          IUDB48   1157
      DO 350 J=1,INTUD                                                  IUDB48   1158
      J2=J2+2                                                           IUDB48   1159
      IDD=IDDAT(J2+2)                                                   IUDB48   1160
      IDD=IABS(IDD)                                                     IUDB48   1161
      IF(IDD.EQ.IORD) THEN                                              IUDB48   1162
         XDAT=1.0                                                       IUDB48   1163
         IF(IDDAT(J2+2).LT.0) XDAT=-1.0                                 IUDB48   1164
         IOUT=IDDAT(J2+1)                                               IUDB48   1165
         IF(JUDE(IOUT).EQ.0) THEN                                       IUDB48   1166
            NEXTB=IOUT                                                  IUDB48   1167
            XDATN=XDAT                                                  IUDB48   1168
            NINP=NINP+1                                                 IUDB48   1169
         ELSE                                                           IUDB48   1170
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1171
         WRITE(MSG(2),1030) IORD,BLNAM1,BLNAM2                          IUDB48   1172
         CALL PRTMSG(2)                                                 IUDB48   1173
         MSG(1)='IUDB57: UDM ERROR'                                     IUDB48   1174
         CALL ASTOP(MSG(1),17)                                          IUDB48   1175
         ENDIF                                                          IUDB48   1176
      ENDIF                                                             IUDB48   1177
  350 CONTINUE                                                          IUDB48   1178
      J3=JE6-3                                                          IUDB48   1179
      DO 360 J=1,INPUD                                                  IUDB48   1180
      J3=J3+3                                                           IUDB48   1181
      IF(IDDAT(J3+1).EQ.IORD) THEN                                      IUDB48   1182
         IIN=IDDAT(J3+2)                                                IUDB48   1183
         IF(IIN.EQ.20) THEN                                             IUDB48   1184
            XDATN=DDAT(J3+3)                                            IUDB48   1185
            NINP=NINP+1                                                 IUDB48   1186
         ELSE                                                           IUDB48   1187
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1188
         WRITE(MSG(2),1001) IORD,BLNAM1,BLNAM2                          IUDB48   1189
         WRITE(MSG(3),1002)                                             IUDB48   1190
         CALL PRTMSG(3)                                                 IUDB48   1191
         MSG(1)='IUDB57: UDM ERROR'                                     IUDB48   1192
         CALL ASTOP(MSG(1),17)                                          IUDB48   1193
         ENDIF                                                          IUDB48   1194
      ENDIF                                                             IUDB48   1195
  360 CONTINUE                                                          IUDB48   1196
      IF(NINP.EQ.0) THEN                                                IUDB48   1197
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1198
         WRITE(MSG(2),1010) IORD,BLNAM1,BLNAM2                          IUDB48   1199
         CALL PRTMSG(2)                                                 IUDB48   1200
         MSG(1)='IUDB57: UDM ERROR'                                     IUDB48   1201
         CALL ASTOP(MSG(1),17)                                          IUDB48   1202
      ENDIF                                                             IUDB48   1203
      IF(NINP.GT.1) THEN                                                IUDB48   1204
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1205
         WRITE(MSG(2),1250) IORD,BLNAM1,BLNAM2                          IUDB48   1206
         CALL PRTMSG(2)                                                 IUDB48   1207
         MSG(1)='IUDB57: UDM ERROR'                                     IUDB48   1208
         CALL ASTOP(MSG(1),17)                                          IUDB48   1209
      ENDIF                                                             IUDB48   1210
C                                                                       IUDB48   1211
C     DATA PREPARATIONS                                                 IUDB48   1212
C                                                                       IUDB48   1213
      V1R=VALIN(7)*COS(VALIN(9))                                        IUDB48   1214
      V1I=VALIN(7)*SIN(VALIN(9))                                        IUDB48   1215
      V2R=VALIN(8)*COS(VALIN(10))                                       IUDB48   1216
      V2I=VALIN(8)*SIN(VALIN(10))                                       IUDB48   1217
      VDEV2=(V1R-V2R)**2+(V1I-V2I)**2                                   IUDB48   1218
      IF(VCO.GT.0.00001) THEN                                           IUDB48   1219
         VDEV=SQRT(VDEV2)/VCO                                           IUDB48   1220
         IF(VDEV.GT.1.0) VDEV=1.0                                       IUDB48   1221
      ELSE                                                              IUDB48   1222
         VDEV=1.0                                                       IUDB48   1223
      ENDIF                                                             IUDB48   1224
      XLOW=-QCB/(QLB+QCB)                                               IUDB48   1225
      DDAT(JEI+10)=XLOW                                                 IUDB48   1226
      XLOW=XLOW*VDEV                                                    IUDB48   1227
      XHIG=QLB/(QLB+QCB)                                                IUDB48   1228
      DDAT(JEI+9)=XHIG                                                  IUDB48   1229
      XHIG=XHIG*VDEV                                                    IUDB48   1230
      VALI=VALOUT(IORD)                                                 IUDB48   1231
      IF(VALI.LT.XLOW) THEN                                             IUDB48   1232
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1233
         WRITE(MSG(2),1361) IORD,BLNAM1,BLNAM2                          IUDB48   1234
         WRITE(MSG(3),1462)                                             IUDB48   1235
         CALL PRTMSG(3)                                                 IUDB48   1236
         MSG(1)='IUDB57: UDM ERROR'                                     IUDB48   1237
         CALL ASTOP(MSG(1),17)                                          IUDB48   1238
      ELSEIF(VALI.GT.XHIG) THEN                                         IUDB48   1239
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1240
         WRITE(MSG(2),1361) IORD,BLNAM1,BLNAM2                          IUDB48   1241
         WRITE(MSG(3),1463)                                             IUDB48   1242
         CALL PRTMSG(3)                                                 IUDB48   1243
         MSG(1)='IUDB57: UDM ERROR'                                     IUDB48   1244
         CALL ASTOP(MSG(1),17)                                          IUDB48   1245
      ENDIF                                                             IUDB48   1246
      XSTATE(KORD)=VALI                                                 IUDB48   1247
      VALI=VALI*BX                                                      IUDB48   1248
      VALIN(12)=VALI                                                    IUDB48   1249
      IF(NEXTB.NE.0) THEN                                               IUDB48   1250
         VALOUT(NEXTB)=VALI                                             IUDB48   1251
      ELSE                                                              IUDB48   1252
         VALIN(20)=VALI                                                 IUDB48   1253
      ENDIF                                                             IUDB48   1254
      DDAT(JEI+11)=XHIG                                                 IUDB48   1255
      DDAT(JEI+12)=XLOW                                                 IUDB48   1256
C                                                                       IUDB48   1257
      IF(LDEB)WRITE(IUD6,1040) JORD                                     IUDB48   1258
C                                                                       IUDB48   1259
      RETURN                                                            IUDB48   1260
C                                                                       IUDB48   1261
C-----------------------------------------------------------------------IUDB48   1262
C                                                                       IUDB48   1263
      ENTRY IUDB58(IORD,NLF,KN,CID,NSD)                                 IUDB48   1264
CD                                                                      IUDB48   1265
CD    FOR BLOCK TYPE 58 AND 59 (TYPE SD8 AND SD9 END BLOCKS).           IUDB48   1266
CD                                                                      IUDB48   1267
      LDEB=(JDEB(262).NE.0)                                             IUDB48   1268
C                                                                       IUDB48   1269
      NINP=0                                                            IUDB48   1270
      NEXTB=0                                                           IUDB48   1271
      JORD=JUDE(IORD)                                                   IUDB48   1272
      KORD=JSTATE+KUDE(IORD)+1                                          IUDB48   1273
      JEI=JEB+2                                                         IUDB48   1274
      QT=DDAT(JEI+1)                                                    IUDB48   1275
      TT=DDAT(JEI+2)                                                    IUDB48   1276
      HYS=DDAT(JEI+3)                                                   IUDB48   1277
      NLS=IDDAT(JEI+4)                                                  IUDB48   1278
      NCS=IDDAT(JEI+5)                                                  IUDB48   1279
      NTS=NLS+NCS                                                       IUDB48   1280
      IPATH=IDDAT(JEI+6)                                                IUDB48   1281
      IF(NLS.LT.0.OR.NCS.LT.0.OR.NTS.EQ.0) THEN                         IUDB48   1282
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1283
         WRITE(MSG(2),2010) IORD,BLNAM1,BLNAM2                          IUDB48   1284
         WRITE(MSG(3),2020)                                             IUDB48   1285
         CALL PRTMSG(3)                                                 IUDB48   1286
         MSG(1)='IUDB58: UDM ERROR'                                     IUDB48   1287
         CALL ASTOP(MSG(1),17)                                          IUDB48   1288
      ENDIF                                                             IUDB48   1289
      J2=JE5-2                                                          IUDB48   1290
      DO 370 J=1,INTUD                                                  IUDB48   1291
      J2=J2+2                                                           IUDB48   1292
      IDD=IDDAT(J2+2)                                                   IUDB48   1293
      IDD=IABS(IDD)                                                     IUDB48   1294
      IF(IDD.EQ.IORD) THEN                                              IUDB48   1295
         XDAT=1.0                                                       IUDB48   1296
         IF(IDDAT(J2+2).LT.0) XDAT=-1.0                                 IUDB48   1297
         IOUT=IDDAT(J2+1)                                               IUDB48   1298
         IF(JUDE(IOUT).EQ.0) THEN                                       IUDB48   1299
            NEXTB=IOUT                                                  IUDB48   1300
            XDATN=XDAT                                                  IUDB48   1301
            NINP=NINP+1                                                 IUDB48   1302
         ELSE                                                           IUDB48   1303
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1304
         WRITE(MSG(2),1030) IORD,BLNAM1,BLNAM2                          IUDB48   1305
         CALL PRTMSG(2)                                                 IUDB48   1306
         MSG(1)='IUDB58: UDM ERROR'                                     IUDB48   1307
         CALL ASTOP(MSG(1),17)                                          IUDB48   1308
         ENDIF                                                          IUDB48   1309
      ENDIF                                                             IUDB48   1310
  370 CONTINUE                                                          IUDB48   1311
      J3=JE6-3                                                          IUDB48   1312
      DO 380 J=1,INPUD                                                  IUDB48   1313
      J3=J3+3                                                           IUDB48   1314
      IF(IDDAT(J3+1).EQ.IORD) THEN                                      IUDB48   1315
         IIN=IDDAT(J3+2)                                                IUDB48   1316
         IF(IIN.EQ.20) THEN                                             IUDB48   1317
            XDATN=DDAT(J3+3)                                            IUDB48   1318
            NINP=NINP+1                                                 IUDB48   1319
         ELSE                                                           IUDB48   1320
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1321
         WRITE(MSG(2),1001) IORD,BLNAM1,BLNAM2                          IUDB48   1322
         WRITE(MSG(3),1002)                                             IUDB48   1323
         CALL PRTMSG(3)                                                 IUDB48   1324
         MSG(1)='IUDB58: UDM ERROR'                                     IUDB48   1325
         CALL ASTOP(MSG(1),17)                                          IUDB48   1326
         ENDIF                                                          IUDB48   1327
      ENDIF                                                             IUDB48   1328
  380 CONTINUE                                                          IUDB48   1329
      IF(NINP.EQ.0) THEN                                                IUDB48   1330
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1331
         WRITE(MSG(2),1010) IORD,BLNAM1,BLNAM2                          IUDB48   1332
         CALL PRTMSG(2)                                                 IUDB48   1333
         MSG(1)='IUDB58: UDM ERROR'                                     IUDB48   1334
         CALL ASTOP(MSG(1),17)                                          IUDB48   1335
      ENDIF                                                             IUDB48   1336
      IF(NINP.GT.1) THEN                                                IUDB48   1337
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1338
         WRITE(MSG(2),1250) IORD,BLNAM1,BLNAM2                          IUDB48   1339
         CALL PRTMSG(2)                                                 IUDB48   1340
         MSG(1)='IUDB58: UDM ERROR'                                     IUDB48   1341
         CALL ASTOP(MSG(1),17)                                          IUDB48   1342
      ENDIF                                                             IUDB48   1343
C                                                                       IUDB48   1344
C     DATA PREPARATIONS AND INPUT DATA PRINTOUT                         IUDB48   1345
C                                                                       IUDB48   1346
      XDEV=VALOUT(IORD)                                                 IUDB48   1347
      XX1=NTS                                                           IUDB48   1348
      XHIG=NLS                                                          IUDB48   1349
      XHIG=XHIG/XX1                                                     IUDB48   1350
      XLOW=NCS                                                          IUDB48   1351
      XLOW=-XLOW/XX1                                                    IUDB48   1352
      IF(XDEV.GT.XHIG) THEN                                             IUDB48   1353
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1354
         WRITE(MSG(2),1741) NSD,IORD,BLNAM1,BLNAM2                      IUDB48   1355
         IF(NSD.EQ.8) THEN                                              IUDB48   1356
            WRITE(MSG(3),1742) XHIG                                     IUDB48   1357
         ELSE                                                           IUDB48   1358
            WRITE(MSG(3),1743) XHIG                                     IUDB48   1359
         ENDIF                                                          IUDB48   1360
         CALL PRTMSG(3)                                                 IUDB48   1361
         MSG(1)='IUDB58: UDM ERROR'                                     IUDB48   1362
         CALL ASTOP(MSG(1),17)                                          IUDB48   1363
      ELSEIF(XDEV.LT.XLOW) THEN                                         IUDB48   1364
         WRITE(MSG(1),1000) NLF,INAME(KN-2),INAME(KN-1),INAME(KN),CID   IUDB48   1365
         WRITE(MSG(2),1741) NSD,IORD,BLNAM1,BLNAM2                      IUDB48   1366
         IF(NSD.EQ.8) THEN                                              IUDB48   1367
            WRITE(MSG(3),1744) XLOW                                     IUDB48   1368
         ELSE                                                           IUDB48   1369
            WRITE(MSG(3),1745) XLOW                                     IUDB48   1370
         ENDIF                                                          IUDB48   1371
         CALL PRTMSG(3)                                                 IUDB48   1372
         MSG(1)='IUDB58: UDM ERROR'                                     IUDB48   1373
         CALL ASTOP(MSG(1),17)                                          IUDB48   1374
      ENDIF                                                             IUDB48   1375
      VALIN(12)=XDEV                                                    IUDB48   1376
      IF(NEXTB.NE.0) THEN                                               IUDB48   1377
         VALOUT(NEXTB)=XDEV                                             IUDB48   1378
      ELSE                                                              IUDB48   1379
         VALIN(20)=XDEV                                                 IUDB48   1380
      ENDIF                                                             IUDB48   1381
      IF(IPATH.EQ.1.OR.IPATH.EQ.2) THEN                                 IUDB48   1382
         STEPS=NTS                                                      IUDB48   1383
         STEPS=1.0/STEPS                                                IUDB48   1384
         STEPS1=STEPS*NTS                                               IUDB48   1385
  379    IF(STEPS1.GE.1.0) THEN                                         IUDB48   1386
            STEPS=0.99999*STEPS                                         IUDB48   1387
            STEPS1=STEPS*NTS                                            IUDB48   1388
            GO TO 379                                                   IUDB48   1389
         ENDIF                                                          IUDB48   1390
         IF(HYS.LT.0.0) HYS=0.0                                         IUDB48   1391
         IF(HYS.GT.STEPS) HYS=STEPS                                     IUDB48   1392
         DDAT(JEI+3)=HYS                                                IUDB48   1393
         DDAT(JEI+7)=STEPS                                              IUDB48   1394
         DDAT(JEI+8)=XDEV                                               IUDB48   1395
         TDEV=0.0                                                       IUDB48   1396
         IF(XDEV.GT.0.0) THEN                                           IUDB48   1397
            DO 381,I=1,NLS                                              IUDB48   1398
            IF(IPATH.EQ.2) THEN                                         IUDB48   1399
               IF(XDEV.LT.TDEV+STEPS-HYS) THEN                          IUDB48   1400
                  GO TO 383                                             IUDB48   1401
               ELSE                                                     IUDB48   1402
                  TDEV=TDEV+STEPS                                       IUDB48   1403
               ENDIF                                                    IUDB48   1404
            ELSE                                                        IUDB48   1405
               IF(XDEV.LT.TDEV+STEPS) THEN                              IUDB48   1406
                  GO TO 383                                             IUDB48   1407
               ELSE                                                     IUDB48   1408
                  TDEV=TDEV+STEPS                                       IUDB48   1409
               ENDIF                                                    IUDB48   1410
            ENDIF                                                       IUDB48   1411
  381       CONTINUE                                                    IUDB48   1412
         ELSEIF(XDEV.LT.0.0) THEN                                       IUDB48   1413
            DO 382,I=1,NCS                                              IUDB48   1414
            IF(IPATH.EQ.2) THEN                                         IUDB48   1415
               IF(XDEV.GT.TDEV-STEPS+HYS) THEN                          IUDB48   1416
                  GO TO 383                                             IUDB48   1417
               ELSE                                                     IUDB48   1418
                  TDEV=TDEV-STEPS                                       IUDB48   1419
               ENDIF                                                    IUDB48   1420
            ELSE                                                        IUDB48   1421
               IF(XDEV.GT.TDEV-STEPS) THEN                              IUDB48   1422
                  GO TO 383                                             IUDB48   1423
               ELSE                                                     IUDB48   1424
                  TDEV=TDEV-STEPS                                       IUDB48   1425
               ENDIF                                                    IUDB48   1426
            ENDIF                                                       IUDB48   1427
  382       CONTINUE                                                    IUDB48   1428
         ENDIF                                                          IUDB48   1429
  383    DDAT(JEI+9)=TDEV                                               IUDB48   1430
      ELSE                                                              IUDB48   1431
         TDEV=XDEV                                                      IUDB48   1432
      ENDIF                                                             IUDB48   1433
      XSTATE(KORD)=TDEV                                                 IUDB48   1434
      VALOUT(IORD)=TDEV                                                 IUDB48   1435
      DDAT(JEI+11)=XHIG                                                 IUDB48   1436
      DDAT(JEI+12)=XLOW                                                 IUDB48   1437
C                                                                       IUDB48   1438
      IF(LDEB)WRITE(IUD6,1040) JORD                                     IUDB48   1439
C                                                                       IUDB48   1440
      RETURN                                                            IUDB48   1441
C                                                                       IUDB48   1442
C-----------------------------------------------------------------------IUDB48   1443
C                                                                       IUDB48   1444
 1000 FORMAT(' *** ERROR USER DEFINED MODEL AT BUS:',I5,' STATION: '    IUDB48   1445
     *,3A4,' ID:',A4)                                                   IUDB48   1446
 1001 FORMAT(11X,'BLOCK#',I3,'(',2A4,') HAS WRONG INPUT SIGNAL.')       IUDB48   1447
 1002 FORMAT(11X,'THE ONLY POSSIBLE INPUT IS "VREF".')                  IUDB48   1448
 1010 FORMAT(11X,'BLOCK#',I3,'(',2A4,') HAS NO INPUT CONNECTION')       IUDB48   1449
 1030 FORMAT(11X,'BLOCK#',I3,'(',2A4                                    IUDB48   1450
     *,')  VREF IS NOT CONNECTED TO REG. PATH')                         IUDB48   1451
 1040 FORMAT(1X,'JORD: ',I5)                                            IUDB48   1452
 1050 FORMAT(11X,'BLOCK#',I3,'(',2A4                                    IUDB48   1453
     *,') HAS MORE THAN TWO INPUT CONNECTIONS')                         IUDB48   1454
 1060 FORMAT(11X,'OF2 BLOCK#',I3,'(',2A4                                IUDB48   1455
     *,') UH MUST BE LARGER THAN UM,')                                  IUDB48   1456
 1061 FORMAT(11X                                                        IUDB48   1457
     *,'UM NOT LESS THAN UL, UL NON-NEGATIVE, AND XL AND TF POSITIVE.') IUDB48   1458
 1062 FORMAT(11X                                                        IUDB48   1459
     *,'UH=',F8.3,' UM=',F8.3,' UL=',F8.3,' XL=',F8.3,' TF=',F8.3)      IUDB48   1460
 1070 FORMAT(11X                                                        IUDB48   1461
     &,'"VREF" CANNOT BE CONNECTED TO THE SECOND INPUT OF OF2.')        IUDB48   1462
 1180 FORMAT(11X,'OF1 BLOCK#',I3,'(',2A4                                IUDB48   1463
     *,') DVH MUST BE LARGER THAN DVL.')                                IUDB48   1464
 1181 FORMAT(11X,'DVH=',F10.5,' DVL=',F10.5)                            IUDB48   1465
 1190 FORMAT(11X                                                        IUDB48   1466
     &,'"VREF" CANNOT BE CONNECTED TO THE SECOND INPUT OF OF1.')        IUDB48   1467
 1250 FORMAT(11X,'BLOCK#',I3,'(',2A4                                    IUDB48   1468
     *,') HAS MORE THAN ONE INPUT CONNECTIONS')                         IUDB48   1469
 1260 FORMAT(11X,'IN LF BLOCK#',I3,'(',2A4                              IUDB48   1470
     *,') OUTPUT IS OUTSIDE 0.0 AND 1.0 PU')                            IUDB48   1471
 1261 FORMAT(11X                                                        IUDB48   1472
     *,'LIMITS. THIS BLOCK SHOULD NORMALLY BE CONNECTED TO.')           IUDB48   1473
 1262 FORMAT(11X,'THE END BLOCK SD2. OUTPUT=',F10.5)                    IUDB48   1474
 1360 FORMAT(11X,'IN SD1 BLOCK#',I3,'(',2A4                             IUDB48   1475
     *,') BTCR TRUNS OUT OUTSIDE 0.0 AND')                              IUDB48   1476
 1460 FORMAT(11X,'1.0 PU LIMITS. CHECK QL AND QC AND/OR %Q.')           IUDB48   1477
 1461 FORMAT(11X,'BTCR=',F10.5,' BDEV=',F10.5,' PU.')                   IUDB48   1478
 1361 FORMAT(11X,'IN SD7 BLOCK#',I3,'(',2A4                             IUDB48   1479
     *,') INITIAL OUTPUT IS')                                           IUDB48   1480
 1463 FORMAT(11X,'ABOVE THE UPPER LIMIT. CHECK QL QC AND/OR %Q.')       IUDB48   1481
 1462 FORMAT(11X,'BELOW THE LOWER LIMIT. CHECK QL QC AND/OR %Q.')       IUDB48   1482
 1362 FORMAT(11X,'IN SD7 BLOCK#',I3,'(',2A4                             IUDB48   1483
     *,') A OR B CANNOT BE NEGATIVE OR A+B ZERO.')                      IUDB48   1484
 1464 FORMAT(11X,'A=',F10.5,' B=',F10.5)                                IUDB48   1485
 1560 FORMAT(11X,'IN SD3 BLOCK#',I3,'(',2A4                             IUDB48   1486
     *,') BTCR TRUNS OUT OUTSIDE ITS LIMITS.')                          IUDB48   1487
 1561 FORMAT(11X,'CHECK QL QC SOUT AND SIN AND/OR %Q.')                 IUDB48   1488
 1562 FORMAT(11X,'BTCR=',F10.5,' BDEV=',F10.5,' PU  HI=',F10.5          IUDB48   1489
     *,' LO=',F10.5)                                                    IUDB48   1490
 1570 FORMAT(11X,'IN SD3 BLOCK#',I3,'(',2A4,') NCS MUST BE NON-ZERO.')  IUDB48   1491
 1580 FORMAT(11X,'IN SD3 BLOCK#',I3,'(',2A4                             IUDB48   1492
     *,') SOUT MUST BE LARGER THAN SIN.')                               IUDB48   1493
 1581 FORMAT(11X,'SOUT=',F8.3,' SIN=',F8.3)                             IUDB48   1494
 1590 FORMAT(11X                                                        IUDB48   1495
     &,'"VREF" CANNOT BE CONNECTED TO THE SECOND INPUT OF SD3.')        IUDB48   1496
 1600 FORMAT(11X,'IN SD3 BLOCK#',I3,'(',2A4                             IUDB48   1497
     *,') SOUT SHOULD NOT BE LARGER THAN')                              IUDB48   1498
 1610 FORMAT(11X,'1.0 AND SIN LESS THAN 0.0 WHEN QL IS NON-ZERO.')      IUDB48   1499
 1620 FORMAT(11X,'SOUT=',F8.3,' SIN=',F8.3,' QL=',F9.2)                 IUDB48   1500
 1730 FORMAT(' *** WARNING: USER DEFINED MODEL AT BUS:',I5,' STATION: ' IUDB48   1501
     *,3A4,'ID:',A4)                                                    IUDB48   1502
 1740 FORMAT(14X,'IN BLOCK SD4#',I3,'(',2A4,') INITIAL OUTPUT IS')      IUDB48   1503
 1741 FORMAT(14X,'IN BLOCK SD',I1,'#',I3,'(',2A4,') INITIAL OUTPUT IS') IUDB48   1504
 1742 FORMAT(14X,'ABOVE THE UPPER LIMIT OF',F6.3,' CHECK QT AND/OR'     IUDB48   1505
     *,' %Q.')                                                          IUDB48   1506
 1743 FORMAT(14X,'ABOVE THE UPPER LIMIT OF',F6.3,' CHECK INITIAL %X'    IUDB48   1507
     *,' AND/OR RANGE %X.')                                             IUDB48   1508
 1744 FORMAT(14X,'BELOW THE LOWER LIMIT OF',F6.3,' CHECK QT AND/OR'     IUDB48   1509
     *,' %Q.')                                                          IUDB48   1510
 1745 FORMAT(14X,'BELOW THE LOWER LIMIT OF',F6.3,' CHECK INITIAL %X'    IUDB48   1511
     *,' AND/OR RANGE %X.')                                             IUDB48   1512
 1750 FORMAT(14X,'ABOVE THE UPPER LIMIT OF 1.0. CHECH THE GENERAL'      IUDB48   1513
     *,' DATA.')                                                        IUDB48   1514
 1751 FORMAT(14X,'BELOW THE LOWER LIMIT OF -1.0. CHECH THE GENERAL'     IUDB48   1515
     *,' DATA.')                                                        IUDB48   1516
 1760 FORMAT(11X,'IN SD4 BLOCK#',I3,'(',2A4,') NS MUST BE POSITIVE.')   IUDB48   1517
 1780 FORMAT(14X,'IN BLOCK SD4#',I3,'(',2A4                             IUDB48   1518
     *,') INITIAL OUTPUT IS BETWEEN STEPS.')                            IUDB48   1519
 1781 FORMAT(14X,'THE OUTPUT MAY MOVE AT 1ST TIME STEP.')               IUDB48   1520
 1830 FORMAT(14X,'IN SD5 BLOCK#',I3,'(',2A4                             IUDB48   1521
     *,') INITIAL INPUT IS NON-ZERO.')                                  IUDB48   1522
 1860 FORMAT(11X,'IN SD5 BLOCK#',I3,'(',2A4,') NYS MUST BE POSITIVE.')  IUDB48   1523
 1930 FORMAT(14X,'IN BLOCK SD6#',I3,'(',2A4                             IUDB48   1524
     *,') INITIAL OUTPUT IS')                                           IUDB48   1525
 1940 FORMAT(14X,'ABOVE THE UPPER LIMIT OF 1.0. CHECK MY AND/OR %Y')    IUDB48   1526
 1941 FORMAT(14X,'BELOW THE LOWER LIMIT OF 0.0. CHECK MY AND/OR %Y')    IUDB48   1527
 1960 FORMAT(11X,'IN SD6 BLOCK#',I3,'(',2A4,') NGS MUST BE POSITIVE.')  IUDB48   1528
 1980 FORMAT(14X,'IN BLOCK SD6#',I3,'(',2A4                             IUDB48   1529
     *,') INITIAL OUTPUT IS BETWEEN STEPS.')                            IUDB48   1530
 1990 FORMAT(14X,'THE OUTPUT MAY MOVE AT 1ST TIME STEP.')               IUDB48   1531
 2010 FORMAT(11X,'IN SD8 BLOCK#',I3,'(',2A4,') NL OR NC CANNOT BE')     IUDB48   1532
 2020 FORMAT(11X,'NEGATIVE AND NL+NC MUST BE NON-ZERO.')                IUDB48   1533
      END                                                               IUDB48   1534
