C***********************************************************************
C  PROPATH V12.1 ----- AMMONIA-WATER MIXTURES (AWMX-SS.EXE)             
C***********************************************************************
      INTEGER KPA,MESS,KSTAN,KAS,NL,NM,NN,JT,JP,JZ
      REAL QNM
      CHARACTER UPT(0:3)*6,UA(0:1)*4,CSTAN(1:2)*16,DTAFIL*12,FNAME*40,
     &          CHA
      COMMON/PR01/JT,JP,JZ
      COMMON/PR03/KPA,MESS,KSTAN,KAS
c     DATA CSTAN/' Ibrahim & Klein',' IIR            '/
      DATA CSTAN/' T-Roth & Friend',' IIR            '/
      DATA UPT /' Pa, K','bar, C','bar, K',' Pa, C'/
      DATA UA  /'kmol',' kg '/
      CALL PRUNIT
C     ***** Initial Set *****
      NN=1
      DTAFIL='AWMX2-SS.DAT'
      OPEN(2,FILE=DTAFIL)
      READ(2,'(A7,I4)') CHA,KPA
      READ(2,'(A7,I4)') CHA,MESS
      READ(2,'(A7,I4)') CHA,KSTAN
      READ(2,'(A7,I4)') CHA,KAS
      READ(2,'(A7,I4)') CHA,JP
      READ(2,'(A7,I4)') CHA,JT
      READ(2,'(A7,I4)') CHA,JZ
      READ(2,'(A7,I4)') CHA,NL
      IF(NL.EQ.1)READ(2,'(A40)') FNAME
      CLOSE(2)
  111 CALL FMENU(NN,NL,FNAME,DTAFIL)
      OPEN(2,FILE=DTAFIL)
      WRITE(2,10) KPA
      WRITE(2,20) MESS
      WRITE(2,30) KSTAN
      WRITE(2,40) KAS
      WRITE(2,50) JP
      WRITE(2,60) JT
      WRITE(2,70) JZ
      WRITE(2,90) NL
      IF(NL.EQ.1)WRITE(2,'(A)')FNAME
      CLOSE(2)
      IF(NN.EQ.0) GOTO 999
 1000 CALL SMENU(6)
 1111 WRITE(6,'(1X,A)')'Input No.'
      READ(5,*) QNM
      NM=IFIX(QNM)
      IF(NM*(NM-10).LT.0) THEN
         CALL KPAMES(KPA,MESS)
         CALL STNKAS(KSTAN,KAS)
         GOTO(100,200,300,400,500,600,700,800,900),NM
      ENDIF
      IF(NM.EQ.0) GOTO 999
      IF(NM.EQ.99) GOTO 111
      IF(NM.NE.10) THEN
         WRITE(6,'(1X,A)')'***** Invalid No. *****'
         GOTO 1111
      ENDIF
      CALL MUNIT(UPT,UA,CSTAN)
      OPEN(2,FILE=DTAFIL)
      WRITE(2,10) KPA
      WRITE(2,20) MESS
      WRITE(2,30) KSTAN
      WRITE(2,40) KAS
      WRITE(2,50) JP
      WRITE(2,60) JT
      WRITE(2,70) JZ
      WRITE(2,90) NL
      IF(NL.EQ.1)WRITE(2,'(A)')FNAME
      CLOSE(2)
      GOTO 1000
  100 CALL M100(NL)
      GOTO 1000
  200 CALL M200(NL)
      GOTO 1000
  300 CALL M300(NL)
      GOTO 1000
  400 CALL M400(NL)
      GOTO 1000
  500 CALL M500(NL)
      GOTO 1000
  600 CALL M600(NL)
      GOTO 1000
  700 CALL M700(NL)
      GOTO 1000
  800 CALL M800(NL)
      GOTO 1000
  900 CALL M900(NL)
      GOTO 1000
  999 CONTINUE
      WRITE(6,'(/A)')' ***** See You Again ! *****'
      IF(NL.EQ.1) CLOSE(1)
   10 FORMAT('KPA   =',I4)
   20 FORMAT('MESS  =',I4)
   30 FORMAT('KSTAN =',I4)
   40 FORMAT('KAS   =',I4)
   50 FORMAT('JP    =',I4)
   60 FORMAT('JT    =',I4)
   70 FORMAT('JZ    =',I4)
   90 FORMAT('NL    =',I4)
      STOP
      END
C     ***** SET UNIT OF ENTHALPY AND ENTROPY *****
      INTEGER FUNCTION LUHS(A,JZ)
      INTEGER JZ,JU
      REAL A
      IF(ABS(A).GE.1.0E3) THEN
         A=A*1.0E-3
         JU=JZ+2
      ELSE
         JU=JZ
      ENDIF
      LUHS=JU
C
      RETURN
      END
C     ***** SET UNIT OF PRESSURE *****
      INTEGER FUNCTION LUPP(P,JP)
      INTEGER JP,JPP
      REAL P
      IF(JP.EQ.1) THEN
         JPP=JP
         IF(P.GT.1.0E6) THEN
            JPP=JP+3
            P=P*1.0E-6
         ELSEIF(P.GT.1.0E3) THEN
            JPP=JP+2
            P=P*1.0E-3
         ENDIF
      ELSE
         JPP=JP
      ENDIF
      LUPP=JPP
C
      RETURN
      END
C     ***** FIRST MENU *****
      SUBROUTINE FMENU(NN,NL,FNAME,DTAFIL)
      INTEGER NN,NL,N,I,KPA,MESS,KSTAN,KAS,JT,JP,JZ
      REAL QN,QNL
      CHARACTER FNAME*40,HLP(16)*45,GKEY,DTAFIL*11
      COMMON/PR01/JT,JP,JZ
      COMMON/PR03/KPA,MESS,KSTAN,KAS
      DATA HLP/'This is help for this program (AWMX-SS2.EXE)',
     &'  Nomenclature                              ',
     &' ==== First Charactor ====                  ',
     &'   H : Enthalpy                             ',
     &'   P : Pressure                             ',
     &'   S : Entropy                              ',
     &'   T : Temperature                          ',
     &'   V : Volume                               ',
     &'   X : Ammonia Composition of Liquid        ',
     &'   Y : Ammonia Composition of Vapor         ',
     &'   Z : Total Composition of Ammonia         ',
     &' ==== Second Charactor ====                 ',
     &'   B : Bubble Point                         ',
     &'   D : Dew Point                            ',
     &'   L : Liquid                               ',
     &'   V : Vapor                                '/
 1000 WRITE(6,10)'======================================================
     &==================',
     &'|   Single Shot Program for Ammonia-Water Mixture,         ','|',
     &'|   an Application Program by M-PROPATH Ver.12.1           ','|',
     &'|   Thermophysical Properties of Ammonia-Water Mixtures    ','|',
     &'|----------------------------------------------------------------
     &------|',
     &'|  ## First Menu ##                                        ','|',
     &'| No.                      Current                         ','|',
     &'| 1 --> Go to Second Menu                                  ','|',
     &'| 2 --> Read Help                                          ','|'
   10 FORMAT(1X,A/,3(1X,A,12X,A/),1X,A/,3(1X,A,12X,A/),1X,A,12X,A)
      IF(NL.EQ.2) WRITE(6,'(1X,A,40X,A)')'| 3 --> Set Logfile       [OFF
     &]','|'
      IF(NL.EQ.1) WRITE(6,'(1X,3A)')'| 3 --> Set Logfile       [ON] '
     &,FNAME,'|'
      WRITE(6,50)'| 0 --> Quit                                          
     &                 |'
      WRITE(6,50)'======================================================
     &=================='
  111 WRITE(6,50)'Input No.'
      READ(5,*) QN
      N=IFIX(QN)
      IF(N*(N-4).LT.0) GOTO(100,200,300),N
      IF(N.EQ.0) THEN
         NN=0
         IF(NL.EQ.1) CLOSE(1)
         GOTO 999
      ENDIF
      WRITE(6,50)'***** Invalid No. *****'
      GOTO 111
  100 IF(NL.EQ.1) THEN
      OPEN(1,FILE=FNAME)
      WRITE(1,20)'======================================================
     &=========',
     &'|   Single Shot Program for Ammonia-Water Mixture,            |',
     &'|   an Application Program by M-PROPATH Ver.12.1              |',
     &'|   Thermophysical Properties of Ammonia-Water Mixtures       |',
     &'==============================================================='
      WRITE(1,30) (HLP(I),I=1,16)
      CALL SMENU(1)
      ENDIF
      GOTO 999
  200 WRITE(6,30) (HLP(I),I=1,16)
      WRITE(6,'(A)')' ----- Hit RETURN Key -----'
      READ(5,'(A)') GKEY
      GOTO 1000
  300 IF(NL.EQ.1) CLOSE(1)
      WRITE(6,'(/,1X,A)') ' 1: Logfile ON'
      WRITE(6,50) ' 2: Logfile OFF'
  333 WRITE(6,50)'Input No.'
      READ(5,*) QNL
      NL=IFIX(QNL)
      IF(NL*(NL-3).LT.0) GOTO(310,320),NL
      WRITE(6,50)'***** Invalid No. *****'
      GOTO 333
  310 WRITE(6,50) 'Input Filename'
      READ(5,'(A40)') FNAME
      IF(FNAME.EQ.DTAFIL) THEN
         WRITE(6,50) 'Sorry, This filename is used as DATA filename. Ple
     &ase input another filename.'
         GOTO 310
      ENDIF
  320 GOTO 1000
   20 FORMAT(4(1X,A,/),1X,A)
   30 FORMAT(/,16(1X,A,/))
   40 FORMAT(1X,A,I2,5A)
   50 FORMAT(1X,A)
C
  999 RETURN
      END
C     ***** SECOND MENU *****
      SUBROUTINE SMENU(NF)
      INTEGER NF
      WRITE(NF,10)'=====================================================
     &==========',
     &'| ## Second Menu ##                                           |',
     &'|  <Single and Two Phase States>                              |',
     &'| No.  Input                    Output                        |',
     &'| 1 --(P,T,Z)-->    H  HL HV S  SL SV V  VL VV X  Y  QUALITY  |',
     &'| 2 --(P,Z,H)--> T     HL HV S  SL SV V  VL VV X  Y  QUALITY  |',
     &'| 3 --(P,Z,S)--> T  H  HL HV    SL SV V  VL VV X  Y  QUALITY  |',
     &'| 4 --(P,Z,V)--> T  H  HL HV S  SL SV    VL VV X  Y  QUALITY  |',
     &'|-------------------------------------------------------------|',
     &'|  <Two Phase State>                                          |',
     &'| 5 --(P,Z)----> X=Z : TB HB SB VB    Y=Z : TD HD SD VD       |'
      WRITE(NF,10)'| 6 --(T,Z)----> X=Z : PB HB SB VB    Y=Z : PD HD SD 
     &VD       |',
     &'| 7 --(P,T)----> Coexisting Phases: X  Y  HL HV SL SV VL VV   |',
     &'|-------------------------------------------------------------|',
     &'| 8 -----------> Fundamental Constants                        |',
     &'| 9 -----------> Conversion of Composition and Relative       |',
     &'|                Molcular Mass of Mixture                     |',
     &'|10 -----------> Change System of Unit, and Standard Values of|',
     &'|                Enthalpy and Entropy                         |',
     &'|99 -----------> Return to First Menu                         |',
     &'| 0 -----------> Quit                                         |',
     &'==============================================================='
   10 FORMAT(10(1X,A,/),1X,A)
      RETURN
      END
C     ***** No.1 SECOND MENU *****
      SUBROUTINE M100(NL)
      INTEGER J,NL,JT,JP,JZ
      REAL T,P,Z,H,S,V
      CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13,
     &          LUV(2)*13
      COMMON/PR01/JT,JP,JZ
      COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV
      WRITE(6,'(/A)')' =============================='
      WRITE(6,'(A)') '  (P,T,Z) --> H, S, V, QUALITY'
      WRITE(6,'(A)') '              X, HL, SL, VL'
      WRITE(6,'(A)') '              Y, HV, SV, VV'
      WRITE(6,'(A)') ' =============================='
  100 WRITE(6,10) 'Input P',LUP(JP),' (P=0 : Second Menu)'
      READ(5,*) P
      IF(P.LE.0.) RETURN
      WRITE(6,20) 'Input T',LUT(JT)
      READ(5,*) T
      WRITE(6,20) 'Input Z',LUZ(JZ)
      READ(5,*) Z
      CALL SUBMIX(1,J,T,P,Z,V,H,S)
      IF(J.NE.0) THEN
C         WRITE(6,*) '***** Out of Range at SUBMIX *****'
         J=0
         GOTO 100
      ENDIF
      IF(NL.EQ.1) THEN
         WRITE(1,'(A)')'=============================='
         WRITE(1,'(A)')' (P,T,Z) --> H, S, V, QUALITY'
         WRITE(1,'(A)')'             X, HL, SL, VL'
         WRITE(1,'(A)')'             Y, HV, SV, VV'
         WRITE(1,'(A)')'=============================='
      ENDIF
      CALL OUTPUT(NL,T,P,Z,V,H,S)
      GOTO 100
   10 FORMAT(1X,3A)
   20 FORMAT(1X,2A)
      END
C     ***** No.2 SECOND MENU *****
      SUBROUTINE M200(NL)
      INTEGER J,NL,JT,JP,JZ
      REAL T,P,Z,H,S,V
      CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13,
     &          LUV(2)*13
      COMMON/PR01/JT,JP,JZ
      COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV
      WRITE(6,'(/A)')' =============================='
      WRITE(6,'(A)') '  (P,Z,H) --> T, S, V, QUALITY'
      WRITE(6,'(A)') '              X, HL, SL, VL'
      WRITE(6,'(A)') '              Y, HV, SV, VV'
      WRITE(6,'(A)') ' =============================='
  100 WRITE(6,10) 'Input P',LUP(JP),' (P=0 : Second Menu)'
      READ(5,*) P
      IF(P.LE.0.) RETURN
      WRITE(6,20) 'Input Z',LUZ(JZ)
      READ(5,*) Z
      WRITE(6,20) 'Input H',LUH(JZ+2)
      READ(5,*) H
      H=H*1.0E3
      CALL SUBMIX(2,J,T,P,Z,V,H,S)
      IF(J.NE.0) THEN
C         WRITE(6,*) '****** Out of Range at SUBMIX *****'
         J=0
         GOTO 100
      ENDIF
      IF(NL.EQ.1) THEN
         WRITE(1,'(A)')'=============================='
         WRITE(1,'(A)')' (P,Z,H) --> T, S, V, QUALITY'
         WRITE(1,'(A)')'             X, HL, SL, VL'
         WRITE(1,'(A)')'             Y, HV, SV, VV'
         WRITE(1,'(A)')'=============================='
      ENDIF
      CALL OUTPUT(NL,T,P,Z,V,H,S)
      GOTO 100
   10 FORMAT(1X,3A)
   20 FORMAT(1X,2A)
      END
C     ***** No.3 SECOND MENU *****
      SUBROUTINE M300(NL)
      INTEGER J,NL,JT,JP,JZ
      REAL T,P,Z,H,S,V
      CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13,
     &          LUV(2)*13
      COMMON/PR01/JT,JP,JZ
      COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV
      WRITE(6,'(/A)')' =============================='
      WRITE(6,'(A)') '  (P,Z,S) --> T, H, V, QUALITY'
      WRITE(6,'(A)') '              X, HL, SL, VL'
      WRITE(6,'(A)') '              Y, HV, SV, VV'
      WRITE(6,'(A)') ' =============================='
  100 WRITE(6,10) 'Input P',LUP(JP),' (P=0 : Second Menu)'
      READ(5,*) P
      IF(P.LE.0.) RETURN
      WRITE(6,20) 'Input Z',LUZ(JZ)
      READ(5,*) Z
      WRITE(6,20) 'Input S',LUS(JZ+2)
      READ(5,*) S
      S=S*1.0E3
      CALL SUBMIX(3,J,T,P,Z,V,H,S)
      IF(J.NE.0) THEN
C         WRITE(6,*) '***** Out of Range at SUBMIX *****'
         J=0
         GOTO 100
      ENDIF
      IF(NL.EQ.1) THEN
         WRITE(1,'(A)')'=============================='
         WRITE(1,'(A)')' (P,Z,S) --> T, H, V, QUALITY'
         WRITE(1,'(A)')'             X, HL, SL, VL'
         WRITE(1,'(A)')'             Y, HV, SV, VV'
         WRITE(1,'(A)')'=============================='
      ENDIF
      CALL OUTPUT(NL,T,P,Z,V,H,S)
      GOTO 100
   10 FORMAT(1X,3A)
   20 FORMAT(1X,2A)
      END
C     ***** No.4 SECOND MENU *****
      SUBROUTINE M400(NL)
      INTEGER J,NL,JT,JP,JZ
      REAL T,P,Z,H,S,V
      CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13,
     &          LUV(2)*13
      COMMON/PR01/JT,JP,JZ
      COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV
      WRITE(6,'(/A)')' =============================='
      WRITE(6,'(A)') '  (P,Z,V) --> T, H, S, QUALITY'
      WRITE(6,'(A)') '              X, HL, SL, VL'
      WRITE(6,'(A)') '              Y, HV, SV, VV'
      WRITE(6,'(A)') ' =============================='
  100 WRITE(6,10) 'Input P',LUP(JP),' (P=0 : Second Menu)'
      READ(5,*) P
      IF(P.LE.0.) RETURN
      WRITE(6,20) 'Input Z',LUZ(JZ)
      READ(5,*) Z
      WRITE(6,20) 'Input V',LUV(JZ)
      READ(5,*) V
      CALL SUBMIX(4,J,T,P,Z,V,H,S)
      IF(J.NE.0) THEN
C         WRITE(6,*) '***** Out of Range at SUBMIX *****'
         J=0
         GOTO 100
      ENDIF
      IF(NL.EQ.1) THEN
         WRITE(1,'(A)')'=============================='
         WRITE(1,'(A)')' (P,Z,V) --> T, H, S, QUALITY'
         WRITE(1,'(A)')'             X, HL, SL, VL'
         WRITE(1,'(A)')'             Y, HV, SV, VV'
         WRITE(1,'(A)')'=============================='
      ENDIF
      CALL OUTPUT(NL,T,P,Z,V,H,S)
      GOTO 100
   10 FORMAT(1X,3A)
   20 FORMAT(1X,2A)
      END
C     ***** No.5 SECOND MENU *****
      SUBROUTINE M500(NL)
      INTEGER J,NL,JT,JP,JZ,JPP,JHB,JHD,JSB,JSD,LUPP,LUHS
      REAL TB,TD,P,Z,HB,HD,SB,SD,VB,VD
      CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13,
     &          LUV(2)*13
      COMMON/PR01/JT,JP,JZ
      COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV
      WRITE(6,'(/A)')' ================================'
      WRITE(6,'(A)') '  (P,Z) --> X=Z : TB, HB, SB, VB'
      WRITE(6,'(A)') '            Y=Z : TD, HD, SD, VD'
      WRITE(6,'(A)') ' ================================'
  100 WRITE(6,10) 'Input P',LUP(JP),' (P=0 : Second Menu)'
      READ(5,*) P
      IF(P.LE.0.) RETURN
      WRITE(6,20) 'Input Z',LUZ(JZ)
      READ(5,*) Z
      CALL SUBTB(J,TB,P,Z,VB,HB,SB)
      IF(J.NE.0) THEN
C         WRITE(6,*) '***** Out of Range at SUBTB *****'
         J=0
         GOTO 100
      ENDIF
      CALL SUBTD(J,TD,P,Z,VD,HD,SD)
      IF(J.NE.0) THEN
C         WRITE(6,*) '***** Out of Range at SUBTD *****'
         J=0
         GOTO 100
      ENDIF
      JPP=LUPP(P,JP)
      JHB=LUHS(HB,JZ)
      JHD=LUHS(HD,JZ)
      JSB=LUHS(SB,JZ)
      JSD=LUHS(SD,JZ)
      WRITE(6,30) P,LUP(JPP),Z,LUZ(JZ)
      WRITE(6,40) TB,LUT(JT),TD,LUT(JT)
      WRITE(6,50) HB,LUH(JHB),HD,LUH(JHD)
      WRITE(6,60) SB,LUS(JSB),SD,LUS(JSD)
      WRITE(6,70) VB,LUV(JZ),VD,LUV(JZ)
      IF(NL.EQ.1) THEN
         WRITE(1,'(A)')'================================'
         WRITE(1,'(A)')' (P,Z) --> X=Z : TB, HB, SB, VB'
         WRITE(1,'(A)')'           Y=Z : TD, HD, SD, VD'
         WRITE(1,'(A)')'================================'
         WRITE(1,30) P,LUP(JPP),Z,LUZ(JZ)
         WRITE(1,40) TB,LUT(JT),TD,LUT(JT)
         WRITE(1,50) HB,LUH(JHB),HD,LUH(JHD)
         WRITE(1,60) SB,LUS(JSB),SD,LUS(JSD)
         WRITE(1,70) VB,LUV(JZ),VD,LUV(JZ)
      ENDIF
      GOTO 100
   10 FORMAT(1X,3A)
   20 FORMAT(1X,2A)
   30 FORMAT(' P  = ',F16.8,A,'Z  = ',F16.8,A)
   40 FORMAT(' TB = ',F16.8,A,'TD = ',F16.8,A)
   50 FORMAT(' HB = ',F16.8,A,'HD = ',F16.8,A)
   60 FORMAT(' SB = ',F16.8,A,'SD = ',F16.8,A)
   70 FORMAT(' VB = ',E16.8,A,'VD = ',E16.8,A/)
      END
C     ***** No.6 SECOND MENU *****
      SUBROUTINE M600(NL)
      INTEGER J,NL,JT,JP,JPB,JPD,JZ,JHB,JHD,JSB,JSD,LUPP,LUHS
      REAL T,PB,PD,Z,HB,HD,SB,SD,VB,VD
      CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13,
     &          LUV(2)*13
      COMMON/PR01/JT,JP,JZ
      COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV
      WRITE(6,'(/A)')' ================================'
      WRITE(6,'(A)') '  (T,Z) --> X=Z : PB, HB, SB, VB'
      WRITE(6,'(A)') '            Y=Z : PD, HD, SD, VD'
      WRITE(6,'(A)') ' ================================'
  100 WRITE(6,10) 'Input Z',LUZ(JZ),' (Z < 0 : Second Menu)'
      READ(5,*) Z
      IF(Z.LT.0.) RETURN
      WRITE(6,20) 'Input T',LUT(JT)
      READ(5,*) T
      CALL SUBPB(J,T,PB,Z,VB,HB,SB)
      IF(J.NE.0) THEN
C         WRITE(6,*) '***** Out of Range at SUBPB'
         J=0
         GOTO 100
      ENDIF
      CALL SUBPD(J,T,PD,Z,VD,HD,SD)
      IF(J.NE.0) THEN
C         WRITE(6,*) '***** Out of Range at SUBPD'
         J=0
         GOTO 100
      ENDIF
      JPB=LUPP(PB,JP)
      JPD=LUPP(PD,JP)
      JHB=LUHS(HB,JZ)
      JHD=LUHS(HD,JZ)
      JSB=LUHS(SB,JZ)
      JSD=LUHS(SD,JZ)
      WRITE(6,30) T,LUT(JT),Z,LUZ(JZ)
      WRITE(6,40) PB,LUP(JPB),PD,LUP(JPD)
      WRITE(6,50) HB,LUH(JHB),HD,LUH(JHD)
      WRITE(6,60) SB,LUS(JSB),SD,LUS(JSD)
      WRITE(6,70) VB,LUV(JZ),VD,LUV(JZ)
      IF(NL.EQ.1) THEN
         WRITE(1,'(A)')'================================'
         WRITE(1,'(A)')' (T,Z) --> X=Z : PB, HB, SB, VB'
         WRITE(1,'(A)')'           Y=Z : PD, HD, SD, VD'
         WRITE(1,'(A)')'================================'
         WRITE(1,30) T,LUT(JT),Z,LUZ(JZ)
         WRITE(1,40) PB,LUP(JPB),PD,LUP(JPD)
         WRITE(1,50) HB,LUH(JHB),HD,LUH(JHD)
         WRITE(1,60) SB,LUS(JSB),SD,LUS(JSD)
         WRITE(1,70) VB,LUV(JZ),VD,LUV(JZ)
      ENDIF
      GOTO 100
   10 FORMAT(1X,3A)
   20 FORMAT(1X,2A)
   30 FORMAT(' T  = ',F16.8,A,'Z  = ',F16.8,A)
   40 FORMAT(' PB = ',F16.8,A,'PD = ',F16.8,A)
   50 FORMAT(' HB = ',F16.8,A,'HD = ',F16.8,A)
   60 FORMAT(' SB = ',F16.8,A,'SD = ',F16.8,A)
   70 FORMAT(' VB = ',E16.8,A,'VD = ',E16.8,A/)
      END
C     ***** No.7 SECOND MENU *****
      SUBROUTINE M700(NL)
      INTEGER J,NL,JT,JZ,JP,JPP,JHL,JHV,JSL,JSV,LUPP,LUHS
      REAL T,P,HL,HV,SL,SV,VL,VV,X,Y
      CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13,
     &          LUV(2)*13
      COMMON/PR01/JT,JP,JZ
      COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV
      WRITE(6,'(/A)')' ============================='
      WRITE(6,'(A)') '  (P,T) --> Coexisting Phases'
      WRITE(6,'(A)') '            X, HL, SL, VL'
      WRITE(6,'(A)') '            Y, HV, SV, VV'
      WRITE(6,'(A)') ' ============================='
  100 WRITE(6,10) 'Input P',LUP(JP),' (P=0 : Second Menu)'
      READ(5,*) P
      IF(P.LE.0.) RETURN
      WRITE(6,20) 'Input T',LUT(JT)
      READ(5,*) T
      CALL SUBXY(J,T,P,X,Y,VL,VV,HL,HV,SL,SV)
      IF(J.NE.0) THEN
C         WRITE(6,*) '***** Out of Range at SUBXY *****'
         J=0
         GOTO 100
      ENDIF
      JPP=LUPP(P,JP)
      JHL=LUHS(HL,JZ)
      JHV=LUHS(HV,JZ)
      JSL=LUHS(SL,JZ)
      JSV=LUHS(SV,JZ)
      WRITE(6,30) T,LUT(JT),P,LUP(JPP)
      WRITE(6,40) X,LUZ(JZ),Y,LUZ(JZ)
      WRITE(6,50) HL,LUH(JHL),HV,LUH(JHV)
      WRITE(6,60) SL,LUS(JSL),SV,LUS(JSV)
      WRITE(6,70) VL,LUV(JZ),VV,LUV(JZ)
      IF(NL.EQ.1) THEN
         WRITE(1,'(A)')'=============================='
         WRITE(1,'(A)')'  (P,T) --> Coexisting Phases'
         WRITE(1,'(A)')'            X, HL, SL, VL'
         WRITE(1,'(A)')'            Y, HV, SV, VV'
         WRITE(1,'(A)')' ============================='
         WRITE(1,30) T,LUT(JT),P,LUP(JPP)
         WRITE(1,40) X,LUZ(JZ),Y,LUZ(JZ)
         WRITE(1,50) HL,LUH(JHL),HV,LUH(JHV)
         WRITE(1,60) SL,LUS(JSL),SV,LUS(JSV)
         WRITE(1,70) VL,LUV(JZ),VV,LUV(JZ)
      ENDIF
      GOTO 100
   10 FORMAT(1X,3A)
   20 FORMAT(1X,2A)
   30 FORMAT(' T  = ',F16.8,A,'P  = ',F16.8,A)
   40 FORMAT(' X  = ',F16.8,A,'Y  = ',F16.8,A)
   50 FORMAT(' HL = ',F16.8,A,'HV = ',F16.8,A)
   60 FORMAT(' SL = ',F16.8,A,'SV = ',F16.8,A)
   70 FORMAT(' VL = ',E16.8,A,'VV = ',E16.8,A/)
      END
C     ***** No.8 SECOND MENU *****
      SUBROUTINE M800(NL)
      INTEGER NL,JT,JZ,JP,KPA,MESS,KSTAN,KAS
      REAL MA,MW,RA,RW,TCA,TCW,TKA,TKW,PA,PW,VGA,VGW,VMA,VMW,FCM
      CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13,
     &          LUV(2)*13,GKEY
      COMMON/PR01/JT,JP,JZ
      COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV
      COMMON/PR03/KPA,MESS,KSTAN,KAS
      WRITE(6,'(/A)')' ======================='
      WRITE(6,'(A)')'  Fundamental Constants'
      WRITE(6,'(A)')' ======================='
      CALL KPAMES(1,1)
      CALL STNKAS(1,1)
      MA=FCM(1,'M')
      RA=FCM(1,'R')
      TCA=FCM(1,'T')
      PA=FCM(1,'P')
      VGA=FCM(1,'V')
      MW=FCM(2,'M')
      RW=FCM(2,'R')
      TCW=FCM(2,'T')
      PW=FCM(2,'P')
      VGW=FCM(2,'V')
      CALL KPAMES(0,1)
      CALL STNKAS(1,0)
      TKA=FCM(1,'T')
      VMA=FCM(1,'V')
      TKW=FCM(2,'T')
      VMW=FCM(2,'V')
      WRITE(6,30)'<Constants>','<Ammonia>','<Water>'
      WRITE(6,40)MA,MW
      WRITE(6,50)RA,RW,LUS(2)
      WRITE(6,60)TKA,TKW,LUT(1)
      WRITE(6,61)TCA,TCW,LUT(2)
      WRITE(6,70)PA,PW,LUP(2)
      WRITE(6,80)VMA,VMW,LUV(1)
      WRITE(6,81)VGA,VGW,LUV(2)
      IF(NL.EQ.1) THEN
         WRITE(1,'(A)')'======================='
         WRITE(1,'(A)')' Fundamental Constants'
         WRITE(1,'(A)')'======================='
         WRITE(1,30)'<Constants>','<Ammonia>','<Water>'
         WRITE(1,40)MA,MW
         WRITE(1,50)RA,RW,LUS(2)
         WRITE(1,60)TKA,TKW,LUT(1)
         WRITE(1,61)TCA,TCW,LUT(2)
         WRITE(1,70)PA,PW,LUP(2)
         WRITE(1,80)VMA,VMW,LUV(1)
         WRITE(1,81)VGA,VGW,LUV(2)
      ENDIF
      WRITE(6,'(A)')' ----- Hit RETURN Key -----'
      READ(5,'(A)') GKEY
      CALL KPAMES(KPA,MESS)
      CALL STNKAS(KSTAN,KAS)
      RETURN
   10 FORMAT(1X,3A)
   20 FORMAT(1X,2A)
   30 FORMAT(5X,A,16X,A,7X,A)
   40 FORMAT(' Relative Molecular Mass  ',F16.8,F16.8,'  [kg/kmol]')
   50 FORMAT(' Gas Constants            ',F16.8,F16.8,2X,A)
   60 FORMAT(' Critical Temperature     ',F16.8,F16.8,2X,A)
   61 FORMAT(26X,F16.8,F16.8,2X,A)
   70 FORMAT(' Critical Pressure        ',F16.8,F16.8,2X,A)
   80 FORMAT(' Critical Volume          ',E16.8,E16.8,2X,A)
   81 FORMAT(26X,E16.8,E16.8,2X,A)
      END
C     ***** No.9 SECOND MENU *****
      SUBROUTINE M900(NL)
      INTEGER NL,JT,JZ,JP,NZ
      REAL NA,NW,NMIX,Z,ZZ,QNZ,FCM,AKG,AKMOL
      CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13,
     &          LUV(2)*13
      COMMON/PR01/JT,JP,JZ
      COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV
      NA=FCM(1,'M')
      NW=FCM(2,'M')
      WRITE(6,'(/A)')' =================================================
     &================='
      WRITE(6,'(A)') '  Conversion of Composition and Relative Molecular
     & Mass of Mixture'
      WRITE(6,'(A)') ' =================================================
     &================='
  100 WRITE(6,'(/A)')'  1: [kmol/kmol] --> [kg/kg]     and Relative Mole
     &cular Mass of Mixture'
      WRITE(6,'(A)') '  2: [kg/kg]     --> [kmol/kmol] and Relative Mole
     &cular Mass of Mixture'
      WRITE(6,'(A)') '  0: Return to Second Menu'
      WRITE(6,'(1X,A)') 'Input No.'
      READ(5,*) QNZ
      NZ=IFIX(QNZ)
      IF(NZ*(NZ-3).GT.0) GOTO 100
      IF(NZ.EQ.0) RETURN
      WRITE(6,10) 'Input Z',LUZ(NZ)
      READ(5,*) Z
      IF(NZ.EQ.1) THEN
         ZZ=AKG(Z)
         NMIX=NA*Z+NW*(1-Z)
      ENDIF
      IF(NZ.EQ.2) THEN
         ZZ=AKMOL(Z)
         NMIX=NA*ZZ+NW*(1-ZZ)
      ENDIF
      WRITE(6,20) Z,LUZ(NZ)
      WRITE(6,20) ZZ,LUZ(2-NZ/2)
      WRITE(6,30) NMIX
      WRITE(6,40) NA
      WRITE(6,50) NW
      IF(NL.EQ.1) THEN
         WRITE(1,'(A)')'================================================
     &=================='
         WRITE(1,'(A)')' Conversion of Composition and Relative Molecula
     &r Mass of Mixture'
         WRITE(1,'(A)')'================================================
     &=================='
         WRITE(1,20) Z,LUZ(NZ)
         WRITE(1,20) ZZ,LUZ(2-NZ/2)
         WRITE(1,30) NMIX
         WRITE(1,40) NA
         WRITE(1,50) NW
      ENDIF
      GOTO 100
   10 FORMAT(1X,2A)
   20 FORMAT(1X,' Z  = ',F12.8,A)
   30 FORMAT(1X,' Relative Molecular Mass of Mixture = ',F16.8,
     &       '[kg/kmol]')
   40 FORMAT(1X,' Relative Molecular Mass of Ammonia = ',F16.8,
     &       '[kg/kmol]')
   50 FORMAT(1X,' Relative Molecular Mass of Water   = ',F16.8,
     &       '[kg/kmol]',/)
      END
C     ***** No.10 SECOND MENU *****
      SUBROUTINE MUNIT(UPT,UA,CSTAN)
      INTEGER JT,JZ,JP,KPA,MESS,KSTAN,KAS,NU,NSTAN,NPA,NAS
      REAL QNU,QSTAN,QPA,QAS
      CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13,
     &          LUV(2)*13,UPT(0:3)*6,UA(0:1)*4,CSTAN(1:2)*16
      COMMON/PR01/JT,JP,JZ
      COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV
      COMMON/PR03/KPA,MESS,KSTAN,KAS
  100 WRITE(6,*)' '
      WRITE(6,10)
      WRITE(6,20)
      WRITE(6,10)
      WRITE(6,30) UPT(KPA)
      WRITE(6,40) UA(KAS)
      WRITE(6,50) KSTAN+1,CSTAN(KSTAN+1)
      WRITE(6,60)
      WRITE(6,10)
  200 WRITE(6,'(1X,A)')'Input No.'
      READ(5,*) QNU
      NU=IFIX(QNU)
      IF(NU*(NU-4).LT.0) GOTO(110,120,130),NU
      IF(NU.EQ.0) RETURN
      WRITE(6,'(1X,A)')'***** Invalid No. *****'
      GOTO 200
  110 WRITE(6,'(/A)')' ==============================='
      WRITE(6,'(A)') '  No.  <Pressure> <Temperature>'
      WRITE(6,'(A)') ' ==============================='
      WRITE(6,'(A)') '  1 -->   Pa            K      '
      WRITE(6,'(A)') '  2 -->   bar           C      '
      WRITE(6,'(A)') '  3 -->   bar           K      '
      WRITE(6,'(A)') '  4 -->   Pa            C      '
      WRITE(6,'(A)') ' ==============================='
  111 WRITE(6,'(1X,A)')'Input No.'
      READ(5,*) QPA
      NPA=IFIX(QPA)
      IF(NPA*(NPA-5).GE.0) THEN
         WRITE(6,'(1X,A)')'***** Invalid No. *****'
         GOTO 111
      ENDIF
      KPA=NPA-1
      IF(KPA.EQ.0.OR.KPA.EQ.3) JP=1
      IF(KPA.EQ.1.OR.KPA.EQ.2) JP=2
      IF(KPA.EQ.0.OR.KPA.EQ.2) JT=1
      IF(KPA.EQ.1.OR.KPA.EQ.3) JT=2
      GOTO 100
  120 WRITE(6,'(/A)')' ==========================='
      WRITE(6,'(A)') '  No.   Amount of Substance'
      WRITE(6,'(A)') '  1 -->   kmol'
      WRITE(6,'(A)') '  2 -->   kg'
      WRITE(6,'(A)') ' ==========================='
  121 WRITE(6,'(1H ,A)')'Input No.'
      READ(5,*) QAS
      NAS=IFIX(QAS)
      IF(NAS*(NAS-3).GE.0) THEN
         WRITE(6,'(1X,A)')'***** Invalid No. *****'
         GOTO 121
      ENDIF
      KAS=NAS-1
      JZ=NAS
      GOTO 100
  130 WRITE(6,'(/A)')' ================================================'
      WRITE(6,'(A)') '  No.   Standard States and Values of h and s'
c      WRITE(6,'(A)') '  1 --> As defined in:'
c      WRITE(6,'(A)') '        O.M.Ibrahim and S.A.Klein, Thermodynamic'
c      WRITE(6,'(A)') '        Properties  of  Ammonia-Water  Mixtures,'
c      WRITE(6,'(A)') '        ASHRAE Transactions: Symposia, vol.99,'
c      WRITE(6,'(A)') '        1993, pp.1495'
      WRITE(6,'(A)') '  1 --> As defined in :'
      WRITE(6,'(A)') '        Reiner Tillner-Roth and Daniel G. Friend'
      WRITE(6,'(A)') '        A Helmholtz  Free Energy Formulation  of'
      WRITE(6,'(A)') '        the  Thermodynamic Properties  of  the'
      WRITE(6,'(A)') '        Mixtures {Water + Ammonia}, Journal of'
      WRITE(6,'(A)') '        Physical and Chemical Reference Data,'
      WRITE(6,'(A)') '        27-1,(1996),pp63-96'
      WRITE(6,'(A)') '  2 --> Convention of International Institute of'
      WRITE(6,'(A)') '        Refrigeration(IIR):'
      WRITE(6,'(A)') '        h=200[kJ/kg], s=1.0[kJ/(kg*K)]'
      WRITE(6,'(A)') '        Saturated Pure Liquids at 0[C]'
      WRITE(6,'(A)') ' ================================================'
  131 WRITE(6,'(1X,A)')'Input No.'
      READ(5,*) QSTAN
      NSTAN=IFIX(QSTAN)
      IF(NSTAN*(NSTAN-3).GT.0) THEN
         WRITE(6,'(1X,A)')'***** Invalid No. *****'
         GOTO 131
      ENDIF
      KSTAN=NSTAN-1
      GOTO 100
   10 FORMAT(' =======================================================')
   20 FORMAT('  No.                                current')
   30 FORMAT('  1 --> Pressure and Temperature    ','[',A,']')
   40 FORMAT('  2 --> Amount of Substance         ','[',A,']')
   50 FORMAT('  3 --> Standard Values of h and s  '
     &      ,'[',I1,']',A)
   60 FORMAT('  0 --> Return to Second Menu')
      END
C     ***** UNIT DATA *****
      SUBROUTINE PRUNIT
      INTEGER I
      CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13,
     &          LUV(2)*13,LLUP(4)*13,LLUT(2)*13,LLUZ(2)*13,LLUH(4)*13,
     &          LLUS(4)*13,LLUV(2)*13
      COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV
      DATA LLUP /'[Pa]         ','[bar]        '
     &          ,'[kPa]        ','[MPa]        '/
      DATA LLUT /'[K]          ','[C]          '/
      DATA LLUZ /'[kmol/kmol]  ','[kg/kg]      '/
      DATA LLUH /'[J/kmol]     ','[J/kg]       ','[kJ/kmol]    '
     &          ,'[kJ/kg]      '/
      DATA LLUS /'[J/(kmol*K)] ','[J/(kg*K)]   ','[kJ/(kmol*K)]'
     &          ,'[kJ/(kg*K)]  '/
      DATA LLUV /'[m**3/kmol]  ','[m**3/kg]    '/
      DO 10 I=1,2
         LUT(I)=LLUT(I)
         LUZ(I)=LLUZ(I)
         LUV(I)=LLUV(I)
   10 CONTINUE
      DO 20 I=1,4
         LUP(I)=LLUP(I)
         LUH(I)=LLUH(I)
         LUS(I)=LLUS(I)
   20 CONTINUE
      RETURN
      END
C     ***** OUTPUT *****
      SUBROUTINE OUTPUT(NL,T,P,Z,V,H,S)
      INTEGER J,JT,JP,JPP,JZ,JH,JHL,JHV,JS,JSL,JSV,IP,IPHASE,LUPP,LUHS
      REAL T,P,Z,H,HL,HV,S,SL,SV,V,VL,VV,X,Y,QALTY,P0
      CHARACTER  LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUV(2)*13
     &          ,LUH(4)*13,LUS(4)*13
      COMMON/PR01/JT,JP,JZ
      COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV
      P0=P
      IP=IPHASE(T,P,Z)
      JPP=LUPP(P0,JP)
      JH=LUHS(H,JZ)
      JS=LUHS(S,JZ)
      WRITE(6,10) T,LUT(JT),P0,LUP(JPP)
      WRITE(6,20) Z,LUZ(JZ),H,LUH(JH)
      WRITE(6,30) S,LUS(JS),V,LUV(JZ)
      IF(IP.EQ.3) WRITE(6,'(A/)') ' Vapor Region'
      IF(IP.EQ.1) WRITE(6,'(A/)') ' Liquid Region'
      IF(IP.LT.0) WRITE(6,'(A/)') ' ?????????????'
      IF(NL.EQ.1) THEN
         WRITE(1,10) T,LUT(JT),P0,LUP(JPP)
         WRITE(1,20) Z,LUZ(JZ),H,LUH(JH)
         WRITE(1,30) S,LUS(JS),V,LUV(JZ)
         IF(IP.EQ.3) WRITE(1,'(A/)') ' Vapor Region'
         IF(IP.EQ.1) WRITE(1,'(A/)') ' Liquid Region'
         IF(IP.LT.0) WRITE(1,'(A/)') ' ?????????????'
      ENDIF
      IF(IP.EQ.2) THEN
         CALL SUBXY(J,T,P,X,Y,VL,VV,HL,HV,SL,SV)
         IF(J.NE.0) THEN
            J=0
            WRITE(1,'(A/)')'***** OUT OF RANGE AT SUBXY *****'
            GOTO 999
         ENDIF
         JHL=LUHS(HL,JZ)
         JHV=LUHS(HV,JZ)
         JSL=LUHS(SL,JZ)
         JSV=LUHS(SV,JZ)
         WRITE(6,40) X,LUZ(JZ),Y,LUZ(JZ)
         WRITE(6,50) HL,LUH(JHL),HV,LUH(JHV)
         WRITE(6,60) SL,LUS(JSL),SV,LUS(JSV)
         WRITE(6,70) VL,LUV(JZ),VV,LUV(JZ)
         QALTY=(Z-X)/(Y-X)
         WRITE(6,80) QALTY,LUZ(JZ)
         IF(NL.EQ.1) THEN
            WRITE(1,40) X,LUZ(JZ),Y,LUZ(JZ)
            WRITE(1,50) HL,LUH(JHL),HV,LUH(JHV)
            WRITE(1,60) SL,LUS(JSL),SV,LUS(JSV)
            WRITE(1,70) VL,LUV(JZ),VV,LUV(JZ)
            WRITE(1,80) QALTY,LUZ(JZ)
         ENDIF
      ENDIF
  999 CONTINUE
   10 FORMAT(' T  = ',F16.8,A,'P  = ',F16.8,A)
   20 FORMAT(' Z  = ',F16.8,A,'H  = ',F16.8,A)
   30 FORMAT(' S  = ',F16.8,A,'V  = ',E16.8,A)
   40 FORMAT(' X  = ',F16.8,A,'Y  = ',F16.8,A)
   50 FORMAT(' HL = ',F16.8,A,'HV = ',F16.8,A)
   60 FORMAT(' SL = ',F16.8,A,'SV = ',F16.8,A)
   70 FORMAT(' VL = ',E16.8,A,'VV = ',E16.8,A)
   80 FORMAT(' QUALITY =',F16.8,A/)
      RETURN
      END