C
C
      SUBROUTINE EVHT (MARKX,MARKP,MARKL,MARKR,QSUM,QS)
C
C     ------------------------------------------------------------------
C
C       SUBROUTINE PURPOSES:
C       1) EVALUATION OF WATER EVAPORATION CONDITIONS FOR EACH STATION
C          IN AIRWAYS WHICH HAVE THEIR DETAILED DATA RECORDS.
C       2) EVALUATION OF TEMP. CORR. AT STATIONS.
C       3) DATA REARRAGEMENT FOR AIRWAYS IN WHICH AIRFLOW REVERSAL
C          HAPPENED IN THE PRESENT TIME INCREMENT.
C       4) DATA STORAGE ARRAY CONDENSATION FOR ARRAYS WHOSE CAPACITIES
C          ARE SATURATED.
C       5) UPDATING BACKUP ARRAYS TO SET UP THE INITIAL CONDITIONS FOR
C          THE NEXT TIME INCREMENT.
C
C     ------------------------------------------------------------------
C
      INCLUDE 'CMMNW.DAT'
C
C  ** EVALUATION OF WATER EVAPORATION CONDITIONS AT STATIONS.
C
      MARKP=1
      TACC=TACC+DELTAT
      IF (NHM.NE.0) THEN
         DO 40 IC=1,NB
            KQ=IBTN(IC)
            IF (KQ.GT.0) THEN
               JLE=NSP(IC)
               NPP(KQ)=1
               DO 30 IP=1,JLE
                  HABS1(KQ,IP)=HABS(KQ,IP)
                  SL=LA(IC)*(IP-1)/FLOAT(JLE)
                  IF (SL.GT.DPPA(KQ,1,1).AND.NSAC(IC,1).EQ.1) GO TO 30
                  CALL TCORR (KQ,IP,IC)
30             CONTINUE
            ENDIF
40       CONTINUE
      ENDIF
C
C  ** DATA REARRANGEMENT IF AIRFLOW REVERSAL HAPPENED. THEN MESH WILL
C     BE REFORMED.
C
      CALL DTTR (MARKL,MARKP)
      IF (MARKL.NE.0) THEN
         CALL BASE (NSTOP)
         CALL MSLIST
      ENDIF
C
C  ** CONDENSATION OF ARRAY DPPA AS ITS CAPACITY IS SATURATED FOR AN
C     AIRWAY. IT IS DONE BY ABANDONING SOME OF THE MOST CLOSELY LOCATED
C     DATA POINTS.
C
      DO 90 I=1,NB
         IQ=IBTN(I)
         IF (IQ.NE.0) THEN
            NS=NSAC(I,2)
            IF (NS.GE.9) THEN
               DO 84 JB=1,2
                  JG=NSAC(I,2)
                  SS1=1.E5
                  JEE=1
                  DO 70 JD=1,JG-1
                     SS2=DPPA(IQ,JD,1)-DPPA(IQ,JD+1,1)
                     IF (SS2.LT.SS1) THEN
                        SS1=SS2
                        JEE=JD
                     ENDIF
70                CONTINUE
                  IF (JEE.EQ.1) THEN
                     JE=2
                  ELSE
                     SS1=DPPA(IQ,JEE-1,1)-DPPA(IQ,JEE,1)
                     SS2=DPPA(IQ,JEE+1,1)-DPPA(IQ,JEE+2,1)
                     JE=JEE
                     IF (SS1.GE.SS2) JE=JEE+1
                  ENDIF
                  NSAC(I,2)=NSAC(I,2)-1
                  NX=NSAC(I,2)
                  TAUXA(IQ,JE-1)=TAUXA(IQ,JE)
                  DPPA(IQ,JE-1,5)=DPPA(IQ,JE-1,5)+DPPA(IQ,JE,5)
                  DO 82 JC=JE,NX+1
                     IF (JC.LE.NX) THEN
                        TAUXA(IQ,JC)=TAUXA(IQ,JC+1)
                        DO 80 JD=1,5
                           DPPA(IQ,JC,JD)=DPPA(IQ,JC+1,JD)
80                      CONTINUE
                     ELSE
                        TAUXA(IQ,JC)=0.0
                        DO 81 JD=1,5
                           DPPA(IQ,JC,JD)=0.0
81                      CONTINUE
                     ENDIF
82                CONTINUE
84             CONTINUE
            ENDIF
         ENDIF
90    CONTINUE
C
C     QSUM: SUM OF ABS. AIRFLOW VARIATION IN AIRWAYS, CRITERION FOR
C           OUTPUT DURING DYNAMIC SIMULATION.
C     DELTAQ(I): AIRFLOW VARIATION FOR AIRWAY NO(I) BETWEEN TWO
C                SUCCESSIVE OUTPUT.
C     MARKR=0: REGULAR OUTPUT WAS GIVEN IN THE LAST TIME INTERVAL.
C              DELTAQ(I) MUST BE INITIATED TO ZERO.
C     MARKR=1: THE OUTPUT FOR THE PRESENT INTERVAL HAS BEEN OMITTED.
C              DELTAQ(I) HAS ITS CUMULATIVE EFFECT.
C
      QS=QSUM
      QSUM=0.0
      DO 110 I=1,NB
         NSACB(I,1)=NSAC(I,1)
         NSACB(I,2)=NSAC(I,2)
         IF (MARKR.EQ.0) DELTAQ(I)=0.0
         DELTAQ(I)=DELTAQ(I)+Q(I)-QTP(I)
         QSUM=QSUM+ABS(DELTAQ(I))
         IF (IBTN(I).NE.0) THEN
            IQ=IBTN(I)
            TAUXD(IQ)=TAUXC(IQ)
            DO 100 J=1,10
               TAUXB(IQ,J)=TAUXA(IQ,J)
               DO 100 K=1,5
                  DPPB(IQ,J,K)=DPPA(IQ,J,K)
100         CONTINUE
         ENDIF
110   CONTINUE
      QS=ABS(QS-QSUM)
C
      RETURN
      END

