home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / D2SOURCE.ZIP / EVAP3.FOR < prev    next >
Encoding:
Text File  |  1985-11-18  |  3.9 KB  |  113 lines
  1. C  EVAPORATION FROM A PUDDLE W/AREA W/STILL AIR /CGW
  2.       SUBROUTINE EVAP (AGNT,QT,PMM,U,TC,TS,SUR,IL)
  3.       COMMON EDM(52),QS,TEVP,SA,FL,FMWT,FMVT,VP,BPT,ED2(50)
  4.       CHARACTER*3 SUR   
  5.       CHARACTER*2 AGN,AGNT  
  6.       DIMENSION AGN(15),FMW(16),FMV(16),BP(16),A(15),B(15),C(15),FP(15) 
  7.       DATA AGN/'GB','VX','HD','AC','CG','CK','GA','GD','GF','H1','H3',  
  8.      1'HT','L ','HY','UD'/  
  9.       DATA FMW/140.1,267.4,159.1,27.02,98.92,61.48,162.18,182.18,180.2, 
  10.      1170.08,204.54,189.4,207.35,32.05,60.1,0./ 
  11.       DATA FMV/150.3,342.2,149.7,39.6,70.4,51.4,188.,211.4,196.8,184.3, 
  12.      1202.8,150.,130.1,34.5,81.7,0./
  13.       DATA BP/431.,571.,490.,298.7,281.4,285.8,518.,471.,512.,467.,529.,
  14.      1501.,463.,386.6,337.1,0./ 
  15.       DATA A/8.5916,7.281,7.47009,7.7446,7.460,8.6642,8.305,10.1174,
  16.      110.8872,9.0715,8.986,0.,6.40361,9.0347,8.2223/
  17.       DATA B/-2424.5,-2072.1,-1935.47,-1453.1,-1289.2,-1654.6,-2820.,-  
  18.      13136.,-3590.5,-2890.7,-3232.,0.,-1237.037,-2348.18,-1799.31/  
  19.       DATA C/273.,172.5,204.2,273.,273.,273.,273.,273.,273.,273.,273.2, 
  20.      1273.,155.2,273.,273./
  21.       DATA FP/-56.,-51.,14.45,-13.3,-128.,-6.9,-50.,-42.,-30.,-34.,-3.7,
  22.      1-14.,-18.,1.4,-58./   
  23.       IF(U.EQ.0) U=.03
  24.       DO 10 IA=1,15 
  25.       IF(AGNT.EQ.AGN(IA)) GO TO 15  
  26.   10  CONTINUE  
  27.   15  IF (IL.NE.12) GO TO 40
  28. C     16. ATMOSPHERIC PRESSURE  
  29.   20  CALL READA (16,IRT,IA,PMM)
  30.       IF (IRT.LT.0) GO TO 20
  31. C     17. SURFACE CODE  
  32.   40  CALL DEF(17,IRT)  
  33.       IF(IRT.EQ.0) READ(*,'(A3)') SUR   
  34. C     18. TIME OF EVAPORATION   
  35.   60  CALL READA (18,IRT,IA,TEVP)   
  36.       IF (IRT.LT.0) GO TO 60
  37.       P=PMM/760.
  38.       TA=TC+273.
  39.       RHOA=.3487*P/TA   
  40.       FMUA=EXP(4.36+.002844*TA)*1.E-6   
  41.       SCD=FMUA/RHOA 
  42.       IF (SUR.EQ.'GRA') GO TO 120   
  43.       IF (SUR.EQ.'NPR') GO TO 130
  44.       IF (SUR.EQ.'NDF') GO TO 80
  45.       WRITE(*,70)   
  46.   70  FORMAT (' SURFACE CODE NOT DEFINED')
  47.       CALL DEF (57,IRT) 
  48.       GO TO 40  
  49. C     19. AREA OF WETTED SURFACE
  50.   80  CALL READA (19,IRT,IA,SA) 
  51.       IF (IRT.LT.0) GO TO 80
  52. C     20. LENGTH OF SURFACE DOWNWIND
  53.  100  CALL READA (20,IRT,IA,FL) 
  54.       IF (IRT.LT.0) GO TO 100   
  55.       GO TO 150 
  56.  120  SA=.153E-6*QT 
  57.       GO TO 140 
  58.  130  SA=1.21E-6*QT 
  59.  140  FL=SA**.5 
  60.  150  IF (IA.LT.15) GO TO 180   
  61. C     21. FMW,FMV,VAP,BPT   
  62.  160  CALL DEF (21,IRT) 
  63.       IF (IRT.EQ.0) READ(*,*) FMWT,FMVT,VP,BPT  
  64.       GO TO 230 
  65.  180  IF (TC.GT.FP(IA)) GO TO 200   
  66.       WRITE(*,190)
  67.  190  FORMAT (' TEMPERATURE LESS THAN FREEZING')
  68.       TS=1.E36  
  69.       QT=0.
  70.       RETURN
  71.  200  IF (IA.EQ.12) GO TO 160   
  72.       VP=10.**(A(IA)+B(IA)/(TC+C(IA)))  
  73.       IF (VP.LT.PMM) GO TO 220  
  74.       WRITE(*,210)  
  75.  210  FORMAT (' TEMPERATURE GREATER THAN BPT')  
  76.       TS=.1 
  77.       RETURN
  78.  220  FMWT=FMW(IA)  
  79.       FMVT=FMV(IA)  
  80.       BPT=BP(IA)
  81.  230  TS=TEVP   
  82.       FD=TA**1.5*(.03448+1./FMWT)**.5/P 
  83.       D=FD*.0043/(3.1034+FMVT**.3333)**2
  84.       RE=FL*U/SCD*1.E4  
  85.       FJM=.036/RE**.2   
  86.       IF (RE.LE.20000.) FJM=.664/RE**.5 
  87.       GM=U*RHOA*3.448   
  88.       FKG=GM*FJM/(SCD/D)**.667  
  89.       EVR=FKG*FMWT*VP/PMM*6.E8
  90.       AK=.1025*TA/BPT**.5   
  91.       OM=(1.075*AK**(-.1615))+2.*(10.*AK)**(-.74*ALOG10(10.*AK))
  92.       CD=1.18*FMVT**.3333
  93.       DS=FD*.00205/(OM*((3.711+CD)/2.)**2)  
  94.       FLC=(4.*SA/3.14159)**.5   
  95.       RES=FLC*.03/SCD*1.E4  
  96.       EVRS=292.*(1.+.51*RES**.5*(SCD/DS)**.3333)*ALOG(1./(1.-VP/PMM))*  
  97.      1FMWT/TA*DS/FLC*2./3.14159*1000.   
  98.       IF (EVRS.GT.EVR) EVR=EVRS 
  99.       IF (EVRS.EQ.EVR) WRITE(*,240) 
  100.  240  FORMAT (' STILL AIR') 
  101.  250  FORMAT(1X,A3,'  EVR='1PE9.3,'(mg/min-sq m)  AREA='E9.3,'(sq m)',  
  102.      1'  VPR='E9.3/,' Q='E9.3,'(mg)  '3HQ'=E9.3,'(mg)  ',   
  103.      2'  TEV='E9.3,'(min)') 
  104.       Q=SA*TEVP*EVR 
  105.       TS=TEVP   
  106.       IF (Q.LE.QT) GO TO 260
  107.       TS=QT/EVR/SA  
  108.       Q=QT  
  109.  260  WRITE(*,250) SUR,EVR,SA,VP,QT,Q,TS
  110.       QT=Q  
  111.       RETURN
  112.       END
  113.