C  EVAPORATION FROM A PUDDLE W/AREA W/STILL AIR /CGW
      SUBROUTINE EVAP (AGNT,QT,PMM,U,TC,TS,SUR,IL)
      COMMON EDM(52),QS,TEVP,SA,FL,FMWT,FMVT,VP,BPT,ED2(50)
      CHARACTER*3 SUR   
      CHARACTER*2 AGN,AGNT  
      DIMENSION AGN(15),FMW(16),FMV(16),BP(16),A(15),B(15),C(15),FP(15) 
      DATA AGN/'GB','VX','HD','AC','CG','CK','GA','GD','GF','H1','H3',  
     1'HT','L ','HY','UD'/  
      DATA FMW/140.1,267.4,159.1,27.02,98.92,61.48,162.18,182.18,180.2, 
     1170.08,204.54,189.4,207.35,32.05,60.1,0./ 
      DATA FMV/150.3,342.2,149.7,39.6,70.4,51.4,188.,211.4,196.8,184.3, 
     1202.8,150.,130.1,34.5,81.7,0./
      DATA BP/431.,571.,490.,298.7,281.4,285.8,518.,471.,512.,467.,529.,
     1501.,463.,386.6,337.1,0./ 
      DATA A/8.5916,7.281,7.47009,7.7446,7.460,8.6642,8.305,10.1174,
     110.8872,9.0715,8.986,0.,6.40361,9.0347,8.2223/
      DATA B/-2424.5,-2072.1,-1935.47,-1453.1,-1289.2,-1654.6,-2820.,-  
     13136.,-3590.5,-2890.7,-3232.,0.,-1237.037,-2348.18,-1799.31/  
      DATA C/273.,172.5,204.2,273.,273.,273.,273.,273.,273.,273.,273.2, 
     1273.,155.2,273.,273./
      DATA FP/-56.,-51.,14.45,-13.3,-128.,-6.9,-50.,-42.,-30.,-34.,-3.7,
     1-14.,-18.,1.4,-58./   
      IF(U.EQ.0) U=.03
      DO 10 IA=1,15 
      IF(AGNT.EQ.AGN(IA)) GO TO 15  
  10  CONTINUE  
  15  IF (IL.NE.12) GO TO 40
C     16. ATMOSPHERIC PRESSURE  
  20  CALL READA (16,IRT,IA,PMM)
      IF (IRT.LT.0) GO TO 20
C     17. SURFACE CODE  
  40  CALL DEF(17,IRT)  
      IF(IRT.EQ.0) READ(*,'(A3)') SUR   
C     18. TIME OF EVAPORATION   
  60  CALL READA (18,IRT,IA,TEVP)   
      IF (IRT.LT.0) GO TO 60
      P=PMM/760.
      TA=TC+273.
      RHOA=.3487*P/TA   
      FMUA=EXP(4.36+.002844*TA)*1.E-6   
      SCD=FMUA/RHOA 
      IF (SUR.EQ.'GRA') GO TO 120   
      IF (SUR.EQ.'NPR') GO TO 130
      IF (SUR.EQ.'NDF') GO TO 80
      WRITE(*,70)   
  70  FORMAT (' SURFACE CODE NOT DEFINED')
      CALL DEF (57,IRT) 
      GO TO 40  
C     19. AREA OF WETTED SURFACE
  80  CALL READA (19,IRT,IA,SA) 
      IF (IRT.LT.0) GO TO 80
C     20. LENGTH OF SURFACE DOWNWIND
 100  CALL READA (20,IRT,IA,FL) 
      IF (IRT.LT.0) GO TO 100   
      GO TO 150 
 120  SA=.153E-6*QT 
      GO TO 140 
 130  SA=1.21E-6*QT 
 140  FL=SA**.5 
 150  IF (IA.LT.15) GO TO 180   
C     21. FMW,FMV,VAP,BPT   
 160  CALL DEF (21,IRT) 
      IF (IRT.EQ.0) READ(*,*) FMWT,FMVT,VP,BPT  
      GO TO 230 
 180  IF (TC.GT.FP(IA)) GO TO 200   
      WRITE(*,190)
 190  FORMAT (' TEMPERATURE LESS THAN FREEZING')
      TS=1.E36  
      QT=0.
      RETURN
 200  IF (IA.EQ.12) GO TO 160   
      VP=10.**(A(IA)+B(IA)/(TC+C(IA)))  
      IF (VP.LT.PMM) GO TO 220  
      WRITE(*,210)  
 210  FORMAT (' TEMPERATURE GREATER THAN BPT')  
      TS=.1 
      RETURN
 220  FMWT=FMW(IA)  
      FMVT=FMV(IA)  
      BPT=BP(IA)
 230  TS=TEVP   
      FD=TA**1.5*(.03448+1./FMWT)**.5/P 
      D=FD*.0043/(3.1034+FMVT**.3333)**2
      RE=FL*U/SCD*1.E4  
      FJM=.036/RE**.2   
      IF (RE.LE.20000.) FJM=.664/RE**.5 
      GM=U*RHOA*3.448   
      FKG=GM*FJM/(SCD/D)**.667  
      EVR=FKG*FMWT*VP/PMM*6.E8
      AK=.1025*TA/BPT**.5   
      OM=(1.075*AK**(-.1615))+2.*(10.*AK)**(-.74*ALOG10(10.*AK))
      CD=1.18*FMVT**.3333
      DS=FD*.00205/(OM*((3.711+CD)/2.)**2)  
      FLC=(4.*SA/3.14159)**.5   
      RES=FLC*.03/SCD*1.E4  
      EVRS=292.*(1.+.51*RES**.5*(SCD/DS)**.3333)*ALOG(1./(1.-VP/PMM))*  
     1FMWT/TA*DS/FLC*2./3.14159*1000.   
      IF (EVRS.GT.EVR) EVR=EVRS 
      IF (EVRS.EQ.EVR) WRITE(*,240) 
 240  FORMAT (' STILL AIR') 
 250  FORMAT(1X,A3,'  EVR='1PE9.3,'(mg/min-sq m)  AREA='E9.3,'(sq m)',  
     1'  VPR='E9.3/,' Q='E9.3,'(mg)  '3HQ'=E9.3,'(mg)  ',   
     2'  TEV='E9.3,'(min)') 
      Q=SA*TEVP*EVR 
      TS=TEVP   
      IF (Q.LE.QT) GO TO 260
      TS=QT/EVR/SA  
      Q=QT  
 260  WRITE(*,250) SUR,EVR,SA,VP,QT,Q,TS
      QT=Q  
      RETURN
      END
