C
C
C
      SUBROUTINE  ADPT (IS,IQ,MARKS,I)
C
C     ------------------------------------------------------------------
C
C       SUBROUTINE PURPOSES:
C       1) ADVANCING EXISTING C.V. IN AIRWAYS, UPDATING RELEVANT DATA.
C       2) UPDATING AIRWAY ENDING CONDITIONS.
C       3) CONDENSING DATA STORAGE ARRAYS IF THERE IS A C.V. EXCEEDING
C          THE AIRWAY ENDING.
C
C     ------------------------------------------------------------------
C
      INCLUDE 'CMMNW.DAT'
C
C     IS: NUMBER OF C.V. IN AIRWAY NO(I).
C
      CP=0.24
      IF (NSAC(I,2).EQ.0) RETURN
      DO 5 K=1,NJ
         IF (JS(I).EQ.JNO(K)) GO TO 8
5     CONTINUE
8     IF (MARKS.GT.0.AND.JCH(K).EQ.0) RETURN
      IF (IS.LE.0) GO TO 50
      IF (DPPA(IQ,IS+1,1).GT.LA(I)) GO TO 50
C
C       "MARKS" ACTS AS A TIMER. WHEN MARKS=0, THIS SUB. ADVANCES ALL
C     EXISTING C.V., WHILE MARKS>0, IT SEARCHES FOR THOSE C.VS. WHICH
C     WERE GENERATED IN THE PRESENT INTERVAL AND TRAVELLED MORE THAN
C     ONE AIRWAY IN THE PRESENT INTERVAL THEN UPDATES THE RELEVANT DATA.
C
C  ** MARKS=0, ADVANCING ALL EXISTING DATA POINTS, STARTING WITH THE C.V
C     CLOSEST TO THE BEGINNING JUNCTION OF THE AIRWAY.
C
      DO 40 K=1,IS
         JA=IS-K+1
         NN=0
         MK=0
         SEG=DPPA(IQ,JA+1,1)-DPPB(IQ,JA+1,1)
         IF (ABS(SEG).LT.1.E-3) SEG=0.001
         IF (NHM.EQ.0) THEN
C
C     FOR PURELY DRY CASE: (REFER TO THE RELEVANT PART OF SUB CDJN.)
C
            FA=XNEW(I)*ABS(SEG)/CP
C
C       DPPA RECORDS UPDATED DATA. THE DATA CORRESPONDING TO THE END
C     OF LAST INTERVAL IS STORED IN ITS BACKUP ARRAY DPPB WHICH DOES
C     NOT CHANGE WITHIN EACH TIME INCREMENT.
C       SEG: C.V. TRVELLING DISTANCE IN THE PRESENT INTERVAL.
C
            VL=SEG/LA(I)
            T0=TAUXB(IQ,JA)
            T2=DPPB(IQ,JA,2)
            IRV=0
            IF ((TAUXB(IQ,JA).LT.DPPB(IQ,JA,2).AND.TAUXB(IQ,JA).GT.
     .         TROCK(I)).OR.(TAUXB(IQ,JA).GT.DPPB(IQ,JA,2).AND.
     .         TAUXB(IQ,JA).LT.TROCK(I))) THEN
               T0=DPPB(IQ,JA,2)
               T2=TAUXB(IQ,JA)
               IRV=1
            ENDIF
            FAS=0.0
            IF (FA.LT.25.0) FAS=EXP(-FA)
            T1=TROCK(I)+(T0-TROCK(I))*FAS-
     .         (DZRD(I)*VL/(2*778.26*CP))*(1.0+FAS)
            TAUXA(IQ,JA)=T1
            CALL COLUMN (T1,SEG1,I,IQ,JA)
            SEG=DPPA(IQ,JA+1,1)+SEG1-DPPB(IQ,JA,1)
            FA=XNEW(I)*ABS(SEG)/CP
            VL=SEG/LA(I)
            FAS=0.0
            IF (FA.LT.25.0) FAS=EXP(-FA)
            DPPA(IQ,JA,2)=TROCK(I)+(T2-TROCK(I))*FAS-
     .                    (DZRD(I)*VL/(2*778.26*CP))*(1.0+FAS)
            IF (JA.EQ.1) TAUXC(IQ)=TROCK(I)+(TAUXD(IQ)-TROCK(I))*FAS-
     .                    (DZRD(I)*VL/(2*778.26*CP))*(1.0+FAS)
            IF (IRV.EQ.1) THEN
               TBW=DPPA(IQ,JA,2)
               DPPA(IQ,JA,2)=TAUXA(IQ,JA)
               TAUXA(IQ,JA)=TBW
            ENDIF
            DPPA(IQ,JA,1)=DPPB(IQ,JA,1)+SEG
         ELSE
C
C     FOR WET CASE: (REFER TO THE RELEVANT SECTION IN SUB. CDJN.)
C
            HC=BI(I)*HK(I)*O(I)/(2.0*A(I))
            HLW=1050.0
            DRR=DR
            NNA=20
            IF (DCOAGE(I).LT.1.E-5) THEN
               DCOAGE(I)=0.6
               NNA=3
            ENDIF
C
C       NSP(I): NUMBER OF FIXED STATIONS IN AIRWAY NO(I) AT WHICH
C     WET CASE TEMP. CORR. ARE EVALUATED.
C
            JLE=NSP(I)
            T0=TAUXB(IQ,JA)
            IF (T0.LT.DPPB(IQ,JA,2)) T0=DPPB(IQ,JA,2)
            TQ=T0-5.0
            T2=0.0
            TTSS=0.7*T0
            IF (T0.LT.200.0) TTSS=0.9*T0
25          TXM=DCOAGE(I)*(TROCK(I)-TTSS)/BI(I)+TTSS
            CALL MTCOEF (T0,TQ,I,BETA)
            WC=0.0
            WD=0.0
            NC=1
            DO 22 JL=JLE,1,-1
               SDL=LA(I)*(JL-1)/JLE
               IF (MK.EQ.0) THEN
                  DS=0.0
                  IF (JA.LT.IS) DS=DPPB(IQ,JA+1,1)
               ELSE
                  DS=DPPA(IQ,JA+1,1)
               ENDIF
               IF (SDL.LE.(DS+ABS(SEG))) THEN
                  WC=WC+WMTR(IQ,JL)
                  WD=WD+GFF(IQ,JL)
                  NC=NC+1
                  IF (DS.GE.SDL) GO TO 23
               ENDIF
22          CONTINUE
23          GADD=WC/NC
            GF=WD/NC
            IF (GF.LT.0.0) GF=0.0
            DRR=(DR+DR*GADD*18/28.98)*(TR+460)/((TTSS+460)*(1+GADD))
            GDP=GADD*DRR
            IF (GDP.LT.0.0) GDP=0.0
            CNT(I)=HC*WTCORR(IQ,JL)+HK(I)*DCOAGE(I)*TROCK(I)
     .             *O(I)/(2.0*A(I))+BETA*GDP*CP*(TXM-TQ)-
     .             HLW*QQ(I)*DR*GF/(O(I)*ABS(SEG))
            FAW(I)=HK(I)*DCOAGE(I)*O(I)*O(I)/(120.0*QQ(I)*A(I)*CP*DR)
            IF (MK.EQ.1) CALL COLUMN (T0,SEG,I,IQ,JA)
            IF (FAW(I)*SEG.LT.25.0) THEN
               EXPN(I)=EXP(-FAW(I)*SEG)
            ELSE
               EXPN(I)=0.0
            ENDIF
            T1=2*A(I)*(CNT(I)-(CNT(I)-HK(I)*DCOAGE(I)*O(I)
     .                    *T0/(2*A(I)))*EXPN(I))/(HK(I)*DCOAGE(I)*
     .                    O(I))-DZRD(I)*SEG/(LA(I)*778.26*CP)
            NN=NN+1
            IF (ABS(T1-T2).GT.1.0) THEN
               B=2*A(I)/(HK(I)*DCOAGE(I)*O(I)*FAW(I)*SEG)
               E=B*(CNT(I)-HK(I)*DCOAGE(I)*T0*O(I)/(2*A(I)))
     .           *(1.0-EXPN(I))
               TTSS=2*A(I)*CNT(I)/(HK(I)*DCOAGE(I)*O(I))-E-
     .              SEG*DZRD(I)/(2*778.26*LA(I)*CP)
               TQ=T1
               T2=T1
               IF (NN.LE.NNA) GO TO 25
               WRITE (8,*) 'SUB. ADPT  LINE 170',I,IS,MARKS
            ENDIF
            IF (MK.EQ.0) THEN
               MK=1
               NN=0
               TAUXA(IQ,JA)=T1
               T0=T1
               TQ=T1-5.0
               SEG=QQ(I)*DELTAT*(TTSS+460)/(A(I)*(TR+460)*60)-SEG
               IF (ABS(SEG).LT.1.E-3) SEG=0.001
               GO TO 25
            ENDIF
            DPPA(IQ,JA,1)=DPPA(IQ,JA+1,1)+SEG
            DPPA(IQ,JA,2)=T1
         ENDIF
         SE=ABS(DPPA(IQ,JA,1)-DPPB(IQ,JA,1))
         DPPA(IQ,JA,4)=(DPPB(IQ,JA,4)*QQ(I)+CH4V(I)*SE/LA(I))/
     .                 (QQ(I)+CH4V(I)*SE/LA(I))
         IF (DPPA(IQ,JA,1).GE.LA(I)) GO TO 50
40    CONTINUE
      FA=XNEW(I)*ABS(DPPA(IQ,1,1)-DPPB(IQ,1,1))/CP
      FAS=0.0
      IF (FA.LT.25.0) FAS=EXP(-FA)
      VL=(DPPA(IQ,1,1)-DPPB(IQ,1,1))/LA(I)
      TAUXC(IQ)=TROCK(I)+(TAUXD(IQ)-TROCK(I))*FAS-(DZRD(I)*VL/
     .          (2.0*778.26*CP))*(1.0+FAS)
50    ISS=NSAC(I,2)
      DO 52 K=1,ISS
         JA=ISS-K+1
         IF (DPPA(IQ,JA,1).GE.LA(I)) GO TO 54
52    CONTINUE
      IF (NSAC(I,1).EQ.1) THEN
         IF (NHM.GT.0.AND.RDH2O(I).LT.1.E-10) THEN
            TU=TRD(I)
            TU=DCOAGE(I)*(TROCK(I)-TU)/BI(I)+TU
            IF (TU.GT.210.0) TU=210.0
            IF (TU.LE.122.0) THEN
               PVW=-1.608+0.07946*TU-0.00129*TU*TU+1.26E-5*TU**3
            ELSE
               PVW=-33.786+0.97*TU-9.305E-3*TU*TU+3.65E-5*TU**3
            ENDIF
            GAW=0.622*PVW/(101.35-PVW)
            GAWS=GAW*PSI(I)
            RDH2O(I)=(GAW+GAWS)/2.0
         ENDIF
         RETURN
      ENDIF
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      DO 51 K=1,ISS
         JA=ISS-K+1
         IF (DPPA(IQ,JA,3).NE.0) GO TO 53
51    CONTINUE
      RDPROP(I)=0.
      RETURN
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     IF NO C.V. EXCEEDS THE ENDING, THEN SUBROUTINE RETURNS AFTER
C     UPDATING AIRWAY ENDING CONDITIONS.
C
53    SEG=LA(I)-DPPA(IQ,1,1)
      SSL=LA(I)-DPPB(IQ,1,1)
      IF (SSL.LE.SEG) SSL=SEG
      IF (NHM.EQ.0) THEN
         FA=XNEW(I)*SEG/CP
         IF (FA.LE.25.0) THEN
            FAS=EXP(-FA)
         ELSE
            FAS=0.0
         ENDIF
         TT=DPPA(IQ,1,2)
         ENDT=TROCK(I)+(TT-TROCK(I))*FAS-(DZRD(I)*SEG/
     .        (2*778.26*CP*LA(I)))*(1.0+FAS)
      ELSE
         FA=FAW(I)*SEG
         IF (FA.LE.25.0) THEN
            FAS=EXP(-FA)
         ELSE
            FAS=0.0
         ENDIF
         TT=DPPA(IQ,1,2)
         ENDT=2*A(I)*(CNT(I)-(CNT(I)-HK(I)*DCOAGE(I)*O(I)
     .        *TT/(2*A(I)))*FAS)/(HK(I)*DCOAGE(I)*
     .        O(I))-DZRD(I)*SEG/(LA(I)*778.26*CP)
      ENDIF
      TRD(I)=TTRD(I)+(ENDT-TTRD(I))*(SSL-SEG)/SSL
      RDPROP(I)=RDOP(I)+(DPPA(IQ,1,3)-RDOP(I))*(SSL-SEG)/SSL
      RETURN
C
C  ** C.V. EXCEEDS THE ENDING, UPDATE OF AIRWAY ENDING CONDITIONS
C     IS CALLED FOR.
C     TLEFT(J): TIME LEFT AT JUNCTION JNO(J) FOR WAVE FRONT (C.V.)
C               TO TRAVEL INTO THE DOWN-STREAM AIRWAY.
C
54    DO 56 LL=1,NJ
         IF (IABS(JF(I)).EQ.JNO(LL)) KL=LL
         IF (IABS(JS(I)).EQ.JNO(LL)) ML=LL
56    CONTINUE
      FL=DPPA(IQ,JA,1)-LA(I)
C***  FBN(I)=FL/(DPPA(IQ,JA,1)-DPPB(IQ,JA,1))
      TK=DELTAT*FL/((DPPA(IQ,JA,1)-DPPB(IQ,JA,1))*60.0)
      IF (TK.GT.TLEFT(KL)) TLEFT(KL)=TK
C
C     NSAC(I,1)=-1: AIRWAY NO(I) IS A FUME-FILLED ONE.
C
      IF (NSAC(I,1).NE.(-1)) NSAC(I,1)=-1
C
C     RDPROP(I): FUME CONCENTRATION AT AIRWAY ENDING.
C     RDCH4(I): CH4 CONCENTRATION AT AIRWAY ENDING.
C     RDH2O(I): HUMIDITY RATIO AT AIRWAY ENDING.
C     DPPA,DPPB: (1) DISTANCE, (2) TEMP. (3) FUME, (4) CH4,
C                (5) AIR MASS IN C.V.
C
      RDCH4A=DPPA(IQ,JA,4)-CH4V(I)*(DPPA(IQ,JA,1)-LA(I))/
     .       (LA(I)*QQ(I))
C
C     NSACB: BACKUP ARRAY OF NSAC. NSACB(I,2) INDICATES THE NUMBER
C            OF C.V. IN AIRWAY NO(I) IN THE LAST INTERVAL.
C
      IF (JA.EQ.NSAC(I,2)) THEN
         SECT=LA(I)
         TLAST=TJS(I)
         RDF=DPPA(IQ,JA,3)-PROP(ML)
         IF (NWTYP(I).EQ.10) RDF=0.0
         SSL=DPPA(IQ,JA,1)
      ELSE
         SECT=LA(I)-DPPA(IQ,JA+1,1)
         TLAST=TAUXA(IQ,JA)
         RDF=DPPA(IQ,JA,3)-DPPA(IQ,JA+1,3)
         SSL=DPPA(IQ,JA,1)-DPPA(IQ,JA+1,1)
      ENDIF
      RDPROP(I)=DPPA(IQ,JA,3)-RDF*FL/SSL
      RDCH4(I)=RDCH4A
      IF (NHM.EQ.0) THEN
C
C     AIR TEMP. AT AIRWAY ENDING IN DRY CASE.
C
         IF ((TAUXB(IQ,JA).LT.DPPB(IQ,JA,2).AND.TAUXB(IQ,JA).GT.
     .      TROCK(I)).OR.(TAUXB(IQ,JA).GT.DPPB(IQ,JA,2).AND.
     .      TAUXB(IQ,JA).LT.TROCK(I))) THEN
C
C     HANDLING REVERSED AIRFLOW
C
            FL1=DPPB(IQ,JA,1)-DPPB(IQ,JA+1,1)
            FLL=(DPPA(IQ,JA,1)-LA(I))/(DPPA(IQ,JA,1)-DPPA(IQ,JA+1,1))
            TLAST=DPPB(IQ,JA,2)+(TAUXB(IQ,JA)-DPPB(IQ,JA,2))*FLL
            SECT=LA(I)-DPPB(IQ,JA,1)+FL1*FLL
         ENDIF
         FA=XNEW(I)*SECT/CP
         FAS=0.0
         IF (FA.LT.25.0) FAS=EXP(-FA)
         VL=SECT/LA(I)
         TRD(I)=TROCK(I)+(TLAST-TROCK(I))*FAS-
     .          (DZRD(I)*VL/(2*778.26*CP))*(1.0+FAS)
      ELSE
C
C     AIR TEMP. AT AIRWAY ENDING IN WET CASE.
C
         EPF3=FAW(I)*SECT
         EXPN(I)=EXP(-EPF3)
         TRD(I)=2*A(I)*(CNT(I)-(CNT(I)-HK(I)*DCOAGE(I)*O(I)
     .          *TLAST/(2*A(I)))*EXPN(I))/(HK(I)*DCOAGE(I)*
     .          O(I))-DZRD(I)*SECT/(LA(I)*778.26*CP)
      ENDIF
C
C       WHEN A C.V EXCEEDS AIRWAY ENDING, THE DATA RELATED TO THAT C.V.
C     ARE DISCARDED AND DATA RECORDING ARRAYS ARE CONDENSED.
C
      JAA=JA+1
      DO 80 K=JAA,11
         IF (K.EQ.JAA) TAUXC(IQ)=TAUXA(IQ,K-1)
         IF (K.LE.10) THEN
            KA=K-JAA+1
            TAUXA(IQ,KA)=TAUXA(IQ,K)
            DO 60 L=1,5
               DPPA(IQ,KA,L)=DPPA(IQ,K,L)
60          CONTINUE
         ELSE
            TAUXA(IQ,10)=0.0
            DO 70 L=1,5
               DPPA(IQ,10,L)=0.0
70          CONTINUE
         ENDIF
80    CONTINUE
      NSAC(I,2)=NSAC(I,2)-JA
C
      RETURN
      END
