# 1 "_3647yfw.for"
      SUBROUTINE ZZSPCS(ZZSPEC ,IZIDSP ,IZNSPE ,ZZSAMP ,IZNSAM ,
     1                  ZZPART ,IZNPAR ,IZPRCO ,IZKPSP ,IZNRKP ,
     2                  IZMCKP ,IZICNV ,IZNRIC ,IZMCIC ,IZIOFF ,
     3                  IZNIOF ,ZZUNCO ,IZNUNC ,IZKPSA ,IZNKPS ,
     4                  ZZCONV ,IZNCON ,KOUNT  ,IZIVTY ,IZLIVT ,
     5                  IZNMCN ,IZNRNM ,IZMCNM ,NHSTRY ,NTRMNL ,
     6                  ZZLOWR ,ZZUPPR ,ZZTOLR ,IZCODE ,IZNMSP ,
     7                  IZNRNS ,IZMCNS ,IMISS  ,RMISS  ,NRPT   ,
     8                  IZVRLV ,IZTVLV                         )
C
C     NAME OF MODULE: ZZSPCS                                  
C
C     PURPOSE: CALCULATES VALUES OF DESIGN SPEC RESIDUALS     
C
C     WRITTEN BY: WRSPEC (UNDER THE GUIDANCE OF F.R. ZIEGLER) 
C
C       VARIABLE  I/O  TYPE  DIMENSION  DESCRIPTION           
C
C       ZZSPEC     O    R     IZNSPE    VECTOR OF SPEC RESID. 
C
C** DOUBLE PRECISION                                          
      IMPLICIT REAL*8 (A-H,O-Z)                                 
      INTEGER DMS_LOCATI, DMS_LOCATR, DMS_LOCATM
      INTEGER DMS_LENTHI, DMS_LENTHR, DMS_LENTHM
# 1 "C:\PROGRA~2\ASPENT~1\APRSYS~1.1\Engine\commons\dms_rptglb.cmn"






# 16 "C:\PROGRA~2\ASPENT~1\APRSYS~1.1\Engine\commons\dms_rptglb.cmn"

      INTEGER RPTGLB_IREPFL, RPTGLB_ISUB(10),
     +        RPTGLB_IRGSUM
      REAL*8 RPTGLB_RSCALE
      COMMON  /DMS_RPTGLB [DLLIMPORT] /
     +                  RPTGLB_IREPFL, RPTGLB_ISUB,   RPTGLB_IRGSUM,  
     +                     RPTGLB_RSCALE

# 25 "_3647yfw.for"

      EQUIVALENCE (IRGSUM, RPTGLB_IRGSUM)
      EQUIVALENCE (RSCALE, RPTGLB_RSCALE)
      DIMENSION ZZSPEC(IZNSPE) ,IZIDSP(IZNSPE)  ,ZZSAMP(IZNSAM),
     1          ZZPART(IZNPAR) ,IZPRCO(IZNPAR)  ,IZIOFF(IZNIOF),
     2          IZKPSP(IZNRKP ,IZMCKP) ,IZICNV(IZNRIC ,IZMCIC), 
     3          ZZUNCO(IZNUNC) ,IZKPSA(IZNKPS) ,ZZCONV(IZNCON), 
     4          IZIVTY(IZLIVT) ,IZNMCN(IZNRNM,IZMCNM),          
     5          ZZLOWR(IZNSPE) ,ZZUPPR(IZNSPE)  ,ZZTOLR(IZNSPE),
     6          IZNMSP(IZNRNS ,IZMCNS)                          
# 1 "C:\PROGRA~2\ASPENT~1\APRSYS~1.1\Engine\commons\dms_plex.cmn"






# 16 "C:\PROGRA~2\ASPENT~1\APRSYS~1.1\Engine\commons\dms_plex.cmn"

      INTEGER IB(1), IB_RESERVE_SPACE(16)
      EQUIVALENCE (IB(1), IB_RESERVE_SPACE(1))
      COMMON  /DMS_PLEX [DLLIMPORT] /
     +                  IB  

# 35 "_3647yfw.for"

      REAL*8 B(1)
      EQUIVALENCE (IB(1),B(1))
# 1 "C:\PROGRA~2\ASPENT~1\APRSYS~1.1\Engine\commons\dms_maxwrt.cmn"






# 16 "C:\PROGRA~2\ASPENT~1\APRSYS~1.1\Engine\commons\dms_maxwrt.cmn"

      CHARACTER*80 MAXWRT_MAXBUF(20)
      COMMON  /DMS_MAXWRT [DLLIMPORT] /
     +                  MAXWRT_MAXBUF  

# 38 "_3647yfw.for"

      CHARACTER*80 MAXBUF(20)
      EQUIVALENCE(MAXBUF, MAXWRT_MAXBUF)
C
C     BEGIN EXECUTABLE CODE                                   
C
C
C     RETRIEVE THE SAMPLED VARIABLES FROM THE PLEX AND DO THE 
C     UNITS CONVERSION BACK TO THE USER'S UNITS               
C
      CALL VAU_APLX2S (ZZSAMP ,IZNSAM ,IZKPSP ,IZNRKP ,IZMCKP , 
     1             IZIDSP ,IZNSPE ,IZICNV ,IZNRIC ,IZMCIC ,     
     2             IZIOFF ,IZNIOF ,ZZUNCO ,IZNUNC ,IZKPSA ,     
     3             IZNKPS , 0     ,IZIVTY ,IZLIVT ,IZNMCN ,     
     3             IZNRNM ,IZMCNM )                             
      IZKFRZ = 1                                                
C
C IZSJAV POINTS TO NEXT VARIABLE TO PRINT                     
C
      IZGJAV = 1                                                
      IF (KOUNT.EQ.0) IZGJAV = 7                                
      IZSJAV = 1                                                
      DO 99998 IZJFRZ = 1,IZNSPE                                
        IZCFRZ = IZIDSP(IZJFRZ)                                 
        IZMFRZ = IZKPSP(4,IZCFRZ)                               
        IZGFRZ = IZKPSP(11,IZCFRZ)                              
        IZNPCO = 0                                              
        IF (IZMFRZ .NE. 0) IZNPCO = IZICNV(6,IZMFRZ)            
        IZINCR = IZKPSP(12,IZCFRZ)                              
C
C CALL FORDPR IF THIS IS A SPEC CALL (NOT REPORT-SCALE)       
C
        IF (IZGFRZ .NE. -1) THEN                                
          IZNJAV = IZKPSP(1,IZCFRZ)                             
          IZNBDF = IZKPSP(19,IZCFRZ)                            
          IZLBDF = DMS_LOCATR(IZNBDF)                           
          IZLDFV = DMS_LENTHR(IZNBDF)                           
          IF (IZVRLV.GE.5) THEN                                 
            IF (IZNMSP(13,IZCFRZ).NE.0) THEN                    
            WRITE(NHSTRY,91000)IZNMSP(1,IZCFRZ),IZNMSP(2,IZCFRZ)
91000         FORMAT(/,7X,'CONSTRAINT: ',2A4)                 
            ELSE                                                
            WRITE(NHSTRY,91010)IZNMSP(1,IZCFRZ),IZNMSP(2,IZCFRZ)
91010         FORMAT(/,7X,'DESIGN-SPEC: ',2A4)                
            ENDIF                                               
          ENDIF                                                 
          IF (IZTVLV.GE.5) THEN                                 
            IF (IZNMSP(13,IZCFRZ).NE.0) THEN                    
              WRITE(MAXWRT_MAXBUF,91020) IZNMSP(1,IZCFRZ),      
     2                           IZNMSP(2,IZCFRZ)               
91020         FORMAT(/,3X,'CONSTRAINT: ',2A4)                 
            ELSE                                                
              WRITE(MAXWRT_MAXBUF,91030) IZNMSP(1,IZCFRZ),      
     2                           IZNMSP(2,IZCFRZ)               
91030         FORMAT(/,3X,'DESIGN-SPEC: ',2A4)                
            ENDIF                                               
            CALL DMS_WRTTRM(2)                                  
          ENDIF                                                 
          CALL FT_FORDPR (ZZSAMP(IZSJAV),IZINCR,IZICNV,IZNRIC,  
     2                 IZMCIC,                                  
     2                IZKPSA, IZNKPS, IZNMCN, IZNRNM, IZMCNM,   
     3                IZGJAV, IZIDSP(IZJFRZ), IZVRLV, IZTVLV,   
     3                IZIVTY,                                   
     4                IZLIVT, IZKPSP, IZNRKP, IZMCKP, IZNJAV,   
     5                IZVALU, B(IZLBDF), IZLDFV)                
          IZSJAV = IZSJAV + IZVALU                              
        ENDIF                                                   
        IF(IZNMSP(12,IZCFRZ) .NE. 0)                            
     1    ZZDUMZ = VAU_RLOAD1(IZNMSP(12,IZCFRZ),1,ZZSAMP,       
     2                    IZKPSP(13,IZCFRZ))                    
C
C     SEE IF STANDARD, PRE WRITTEN ROUTINE CAN BE USED        
C
      IF(IZGFRZ .GT. 0) GO TO 99997                             
      IF(IZGFRZ .EQ.-1) CALL FT_STDRSC(IZKFRZ,IZCFRZ,ZZSAMP,    
     1                IZNMSP,IZNRNS,IZINCR,IZKPSP,IZNRKP)       
      IF(IZGFRZ .EQ.-2) CALL FT_STDSPC(IZKFRZ,IZCFRZ,ZZSAMP,    
     1         IZNMSP,IZNRNS,IZCODE,IZJFRZ,ZZCONV,IZNPCO,       
     2         ZZSPEC,ZZTOLR,ZZLOWR,ZZUPPR,IZINCR,IZKPSP,       
     3         IZNRKP)                                          
      GO TO 99998                                               
99997 CONTINUE                                                
      GO TO (
     *10001, 
     *99999), IZGFRZ
      GO TO 99998
10001 CONTINUE
      CALL Z1001S(ZZSPEC ,IZIDSP ,IZNSPE ,ZZSAMP ,IZNSAM ,
     1                  ZZPART ,IZNPAR ,IZPRCO ,IZKPSP ,IZNRKP ,
     2                  IZMCKP ,IZICNV ,IZNRIC ,IZMCIC ,IZIOFF ,
     3                  IZNIOF ,ZZUNCO ,IZNUNC ,IZKPSA ,IZNKPS ,
     4                  ZZCONV ,IZNCON ,KOUNT  ,IZIVTY ,IZLIVT ,
     5                  IZNMCN ,IZNRNM ,IZMCNM ,NHSTRY ,NTRMNL ,
     6                  ZZLOWR ,ZZUPPR ,ZZTOLR ,IZCODE ,IZNMSP ,
     7                  IZNRNS ,IZMCNS ,IMISS  ,RMISS          ,
     8                  IZKFRZ ,IZJFRZ ,IZMFRZ ,IZNPCO ,NRPT   ,
     9                  IZCFRZ ,IZVRLV ,IZTVLV )
99998 CONTINUE
      IF (IZVRLV.GE.5) THEN                                     
        WRITE(NHSTRY,91040)                                     
91040   FORMAT(1X)
      ENDIF                                                     
      IF (IZTVLV.GE.5) THEN                                     
        WRITE(MAXWRT_MAXBUF,91040)                              
        CALL DMS_WRTTRM(1)                                      
      ENDIF                                                     
99999 RETURN
      END
      SUBROUTINE Z1001S(ZZSPEC ,IZIDSP ,IZNSPE ,ZZSAMP ,IZNSAM ,
     1                  ZZPART ,IZNPAR ,IZPRCO ,IZKPSP ,IZNRKP ,
     2                  IZMCKP ,IZICNV ,IZNRIC ,IZMCIC ,IZIOFF ,
     3                  IZNIOF ,ZZUNCO ,IZNUNC ,IZKPSA ,IZNKPS ,
     4                  ZZCONV ,IZNCON ,KOUNT  ,IZIVTY ,IZLIVT ,
     5                  IZNMCN ,IZNRNM ,IZMCNM ,NHSTRY ,NTRMNL ,
     6                  ZZLOWR ,ZZUPPR ,ZZTOLR ,IZCODE ,IZNMSP ,
     7                  IZNRNS ,IZMCNS ,IMISS  ,RMISS  ,        
     8                  IZKFRZ ,IZJFRZ ,IZMFRZ ,IZNPCO ,NRPT   ,
     9                  IZCFRZ ,IZVRLV ,IZTVLV )
C
C     NAME OF MODULE: ZZSPCS                                  
C
C     PURPOSE: CALCULATES VALUES OF DESIGN SPEC RESIDUALS     
C
C     WRITTEN BY: WRSPEC (UNDER THE GUIDANCE OF F.R. ZIEGLER) 
C
C       VARIABLE  I/O  TYPE  DIMENSION  DESCRIPTION           
C
C       ZZSPEC     O    R     IZNSPE    VECTOR OF SPEC RESID. 
C
C** DOUBLE PRECISION                                          
      IMPLICIT REAL*8 (A-H,O-Z)                                 
      INTEGER DMS_LOCATI, DMS_LOCATR, DMS_LOCATM
      INTEGER DMS_LENTHI, DMS_LENTHR, DMS_LENTHM
# 1 "C:\PROGRA~2\ASPENT~1\APRSYS~1.1\Engine\commons\dms_rptglb.cmn"






# 16 "C:\PROGRA~2\ASPENT~1\APRSYS~1.1\Engine\commons\dms_rptglb.cmn"

      INTEGER RPTGLB_IREPFL, RPTGLB_ISUB(10),
     +        RPTGLB_IRGSUM
      REAL*8 RPTGLB_RSCALE
      COMMON  /DMS_RPTGLB [DLLIMPORT] /
     +                  RPTGLB_IREPFL, RPTGLB_ISUB,   RPTGLB_IRGSUM,  
     +                     RPTGLB_RSCALE

# 171 "_3647yfw.for"

      EQUIVALENCE (IRGSUM, RPTGLB_IRGSUM)
      EQUIVALENCE (RSCALE, RPTGLB_RSCALE)
      DIMENSION ZZSPEC(IZNSPE) ,IZIDSP(IZNSPE)  ,ZZSAMP(IZNSAM),
     1          ZZPART(IZNPAR) ,IZPRCO(IZNPAR)  ,IZIOFF(IZNIOF),
     2          IZKPSP(IZNRKP ,IZMCKP) ,IZICNV(IZNRIC ,IZMCIC), 
     3          ZZUNCO(IZNUNC) ,IZKPSA(IZNKPS) ,ZZCONV(IZNCON), 
     4          IZIVTY(IZLIVT) ,IZNMCN(IZNRNM,IZMCNM),          
     5          ZZLOWR(IZNSPE) ,ZZUPPR(IZNSPE)  ,ZZTOLR(IZNSPE),
     6          IZNMSP(IZNRNS ,IZMCNS)                          
# 1 "C:\PROGRA~2\ASPENT~1\APRSYS~1.1\Engine\commons\dms_maxwrt.cmn"






# 16 "C:\PROGRA~2\ASPENT~1\APRSYS~1.1\Engine\commons\dms_maxwrt.cmn"

      CHARACTER*80 MAXWRT_MAXBUF(20)
      COMMON  /DMS_MAXWRT [DLLIMPORT] /
     +                  MAXWRT_MAXBUF  

# 181 "_3647yfw.for"

      EQUIVALENCE(MAXBUF, MAXWRT_MAXBUF)
      CHARACTER*80 MAXBUF(20)
      INTEGER IOS_ZZ
      REAL*8 ACETON  
      NTERM = NTRMNL
      NH = NHSTRY
      ACETON   = ZZSAMP(IZKFRZ)
      IZKFRZ = IZKFRZ +      1
      IF (IZCODE.EQ.0) ZZSPEC(IZJFRZ) = 
     *ACETONE 
     * - VAU_RLOAD1(IABS(IZNMSP(7,IZCFRZ)),0,ZZSAMP,  
     *          IZKPSP(13,IZCFRZ)) 
      IF (IZMFRZ.NE.0 .AND. IZCODE .EQ. 0) 
     * ZZSPEC(IZJFRZ) = ZZSPEC(IZJFRZ) / ZZCONV(IZNPCO + 1)
      ZZTOLR(IZJFRZ) = 
     * VAU_RLOAD1(IABS(IZNMSP(10,IZCFRZ)),0,ZZSAMP,   
     *          IZKPSP(13,IZCFRZ)) 
      IF (IZCODE .EQ. 0) GO TO 99998
      ZZLOWR(IZJFRZ) = 
     * VAU_RLOAD1(IABS(IZNMSP(8 ,IZCFRZ)),0,ZZSAMP,   
     *          IZKPSP(13,IZCFRZ)) 
      ZZUPPR(IZJFRZ) = 
     * VAU_RLOAD1(IABS(IZNMSP(9 ,IZCFRZ)),0,ZZSAMP,   
     *          IZKPSP(13,IZCFRZ)) 
99998 CONTINUE
      IF (IZVRLV.GE.5) THEN                                     
        WRITE(NHSTRY,91040)                                     
91040   FORMAT(1X)
      ENDIF                                                     
      IF (IZTVLV.GE.5) THEN                                     
        WRITE(MAXWRT_MAXBUF,91040)                              
        CALL DMS_WRTTRM(1)                                      
      ENDIF                                                     
99999 RETURN
      END
      SUBROUTINE FPTABX
C  THIS ROUTINE IS GENERATED BY WRFPTB
# 1 "C:\PROGRA~2\ASPENT~1\APRSYS~1.1\Engine\commons\dms_global.cmn"






# 16 "C:\PROGRA~2\ASPENT~1\APRSYS~1.1\Engine\commons\dms_global.cmn"

      INTEGER GLOBAL_KPFLG1, GLOBAL_KPFLG2,
     +        GLOBAL_KPFLG3, GLOBAL_LABORT, GLOBAL_NH,
     +        GLOBAL_LDIAG,  GLOBAL_NCHAR,  GLOBAL_IMISS,
     +        GLOBAL_MISSC1, GLOBAL_MISSC2,
     +        GLOBAL_LPDIAG, GLOBAL_IEBAL,  GLOBAL_IRFLAG
      INTEGER GLOBAL_MXBLKW, GLOBAL_ITYPRN, GLOBAL_LBNCP,
     +        GLOBAL_LBCP,   GLOBAL_LSDIAG, GLOBAL_MAXNE,
     +        GLOBAL_MAXNP1, GLOBAL_MAXNP2,
     +        GLOBAL_MAXNP3, GLOBAL_IUPDAT,
     +        GLOBAL_IRSTRT, GLOBAL_LSFLAG
      INTEGER GLOBAL_LRFLAG, GLOBAL_KBLK1,  GLOBAL_KBLK2,
     +        GLOBAL_KRFLAG, GLOBAL_IRNCLS,
     +        GLOBAL_LSTHIS, GLOBAL_IRETCD,
     +        GLOBAL_JRFLAG, GLOBAL_JSFLAG,
     +        GLOBAL_ICOMTP, GLOBAL_LCDIAG
      INTEGER GLOBAL_ILSBIT, GLOBAL_KWATER,
     +        GLOBAL_LVCOST, GLOBAL_LVECON,
     +        GLOBAL_ITRACE, GLOBAL_IFLBND,
     +        GLOBAL_MXFERR, GLOBAL_IAPFLG,
     +        GLOBAL_LSTERM, GLOBAL_LTERM,  GLOBAL_LPTERM
      INTEGER GLOBAL_LSTTRM, GLOBAL_LCTERM,
     +        GLOBAL_LTCOST, GLOBAL_LTECON,
     +        GLOBAL_IOSTYP, GLOBAL_NI2PR,  GLOBAL_ITACSK,
     +        GLOBAL_IAMMAX, GLOBAL_NBYTPW,
     +        GLOBAL_IEUSRM, GLOBAL_LVRLVL, GLOBAL_LTVLVL,
     +        GLOBAL_EOPDGM
      INTEGER GLOBAL_INEOSOLVE
      COMMON  /DMS_GLOBAL [DLLIMPORT] /
     +                  GLOBAL_KPFLG1, GLOBAL_KPFLG2, GLOBAL_KPFLG3,
     +                     GLOBAL_LABORT, GLOBAL_NH,     GLOBAL_LDIAG,
     +                     GLOBAL_NCHAR,  GLOBAL_IMISS,  GLOBAL_MISSC1,
     +                     GLOBAL_MISSC2, GLOBAL_LPDIAG, GLOBAL_IEBAL,
     +                     GLOBAL_IRFLAG, GLOBAL_MXBLKW, GLOBAL_ITYPRN,
     +                     GLOBAL_LBNCP,  GLOBAL_LBCP,   GLOBAL_LSDIAG,
     +                     GLOBAL_MAXNE,  GLOBAL_MAXNP1, GLOBAL_MAXNP2,
     +                     GLOBAL_MAXNP3, GLOBAL_IUPDAT, GLOBAL_IRSTRT,
     +                     GLOBAL_LSFLAG, GLOBAL_LRFLAG, GLOBAL_KBLK1,
     +                     GLOBAL_KBLK2,  GLOBAL_KRFLAG, GLOBAL_IRNCLS,
     +                     GLOBAL_LSTHIS, GLOBAL_IRETCD, GLOBAL_JRFLAG,
     +                     GLOBAL_JSFLAG, GLOBAL_ICOMTP, GLOBAL_LCDIAG,
     +                     GLOBAL_ILSBIT, GLOBAL_KWATER, GLOBAL_LVCOST,
     +                     GLOBAL_LVECON, GLOBAL_ITRACE, GLOBAL_IFLBND,
     +                     GLOBAL_MXFERR, GLOBAL_IAPFLG, GLOBAL_LSTERM,
     +                     GLOBAL_LTERM,  GLOBAL_LPTERM, GLOBAL_LSTTRM,
     +                     GLOBAL_LCTERM, GLOBAL_LTCOST, GLOBAL_LTECON,
     +                     GLOBAL_IOSTYP, GLOBAL_NI2PR,  GLOBAL_ITACSK,
     +                     GLOBAL_IAMMAX, GLOBAL_NBYTPW, GLOBAL_IEUSRM,
     +                     GLOBAL_LVRLVL, GLOBAL_LTVLVL, GLOBAL_EOPDGM,
     +                     GLOBAL_INEOSOLVE

# 219 "_3647yfw.for"

C     END COMMON /GLOBAL/ 21-JUL-1992
      EXTERNAL ZZSPCS  
      DIMENSION NAMES(     2)
      DATA NAMES /
     1  4HZZSP,4HCS  /
      CALL DMS_FPSAVE ( NAMES(     1), ZZSPCS  , GLOBAL_LSDIAG )
      RETURN
      END
