/[MITgcm]/MITgcm/pkg/fizhi/fizhi_moist.F
ViewVC logotype

Diff of /MITgcm/pkg/fizhi/fizhi_moist.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.7 by molod, Tue Jul 13 21:18:41 2004 UTC revision 1.11 by molod, Fri Jul 16 20:11:04 2004 UTC
# Line 13  C $Name$ Line 13  C $Name$
13       .   nlwcld,cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,       .   nlwcld,cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,
14       .   lpnt,myid)       .   lpnt,myid)
15    
16           implicit none
17    
18  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
19    #include "SIZE.h"
20    #include "diagnostics_SIZE.h"
21  #include "diagnostics.h"  #include "diagnostics.h"
22  #endif  #endif
23    
24  c Input Variables  c Input Variables
25  c ---------------  c ---------------
26          integer im,jm,lm
27        integer ndmoist,istrip,npcs        integer ndmoist,istrip,npcs
28          integer bi,bj,ntracer,ptracer        
29        integer lowlevel,midlevel,nltop,nsubmin,nsubmax,Lup        integer lowlevel,midlevel,nltop,nsubmin,nsubmax,Lup
30        real pz(im,jm),plz(im,jm,lm),plze(im,jm,lm+1),dpres(im,jm,lm)        real pz(im,jm),plz(im,jm,lm),plze(im,jm,lm+1),dpres(im,jm,lm)
31        real pkht(im,jm,lm+1),pkl(im,jm,lm)        real pkht(im,jm,lm+1),pkl(im,jm,lm)
32        real tz(im,jm,lm),qz(im,jm,lm,ntracer)              real tz(im,jm,lm),qz(im,jm,lm,ntracer)      
       integer bi,bj,ntracer,ptracer          
33        real qqz(im,jm,lm)        real qqz(im,jm,lm)
34        real dumoist(im,jm,lm),dvmoist(im,jm,lm)        real dumoist(im,jm,lm),dvmoist(im,jm,lm)
35        real dtmoist(im,jm,lm),dqmoist(im,jm,lm,ntracer)        real dtmoist(im,jm,lm),dqmoist(im,jm,lm,ntracer)
       integer im,jm,lm  
36        real ptop        real ptop
37        integer iras        integer iras
38        real rainlsp(im,jm),rainconv(im,jm),snowfall(im,jm)        real rainlsp(im,jm),rainconv(im,jm),snowfall(im,jm)
# Line 45  c Local Variables Line 49  c Local Variables
49  c ---------------  c ---------------
50        integer    ncrnd,nsecf        integer    ncrnd,nsecf
51    
52        real       fracqq, rh,temp1,temp2,dum        real       fracqq, dum
53        integer    snowcrit        integer    snowcrit
54        parameter (fracqq = 0.1)        parameter (fracqq = 0.1)
55    
# Line 53  c --------------- Line 57  c ---------------
57        real   srcld(istrip,lm)        real   srcld(istrip,lm)
58    
59        real plev        real plev
60        real cldnow,cldlsp_mem,cldras_mem,cldras,watnow,watmin,cldmin        real cldnow,cldlsp_mem,cldlsp,cldras_mem,cldras
61          real watnow,watmin,cldmin
62        real cldprs(im,jm),cldtmp(im,jm)        real cldprs(im,jm),cldtmp(im,jm)
63        real cldhi (im,jm),cldlow(im,jm)        real cldhi (im,jm),cldlow(im,jm)
64        real cldmid(im,jm),totcld(im,jm)        real cldmid(im,jm),totcld(im,jm)
# Line 98  c --------------- Line 103  c ---------------
103        real saveu  (istrip,lm,ntracer)        real saveu  (istrip,lm,ntracer)
104        real usubcl (istrip,   ntracer)        real usubcl (istrip,   ntracer)
105    
106        real     ple(istrip,lm+1), gam(istrip,lm)        real     ple(istrip,lm+1)
107        real      dp(istrip,lm)        real      dp(istrip,lm)
108        real      TL(ISTRIP,lm)  , SHL(ISTRIP,lm)        real      TL(ISTRIP,lm)  , SHL(ISTRIP,lm)
109        real      PL(ISTRIP,lm)  , PLK(ISTRIP,lm)        real      PL(ISTRIP,lm)  , PLK(ISTRIP,lm)
110        real    PLKE(ISTRIP,lm+1)        real    PLKE(ISTRIP,lm+1)
111        real      TH(ISTRIP,lm)  ,CVTH(ISTRIP,lm)        real      TH(ISTRIP,lm)  ,CVTH(ISTRIP,lm)
112        real   SHSAT(ISTRIP,lm)  , CVQ(ISTRIP,lm)        real   CVQ(ISTRIP,lm)
113        real      UL(ISTRIP,lm,ntracer)        real      UL(ISTRIP,lm,ntracer)
114        real     cvu(istrip,lm,ntracer)        real     cvu(istrip,lm,ntracer)
115        real  CLMAXO(ISTRIP,lm),CLBOTH(ISTRIP,lm)        real  CLMAXO(ISTRIP,lm),CLBOTH(ISTRIP,lm)
# Line 113  c --------------- Line 118  c ---------------
118        real    TMP3(ISTRIP,lm),  TMP4(ISTRIP,lm+1)        real    TMP3(ISTRIP,lm),  TMP4(ISTRIP,lm+1)
119        real    TMP5(ISTRIP,lm+1)        real    TMP5(ISTRIP,lm+1)
120        integer   ITMP1(ISTRIP,lm), ITMP2(ISTRIP,lm)        integer   ITMP1(ISTRIP,lm), ITMP2(ISTRIP,lm)
       integer   ITMP3(ISTRIP,lm)  
121    
122        real   PRECIP(ISTRIP), PCMID(ISTRIP), PCNET(ISTRIP)        real   PRECIP(ISTRIP), PCNET(ISTRIP)
123        real   PCLOW (ISTRIP),    SP(ISTRIP),  PREP(ISTRIP)        real   SP(ISTRIP),  PREP(ISTRIP)
124        real   PCPEN (ISTRIP,lm)        real   PCPEN (ISTRIP,lm)
125        integer pbl(istrip),depths(lm)        integer pbl(istrip),depths(lm)
126    
# Line 241  c -------------------------------------- Line 245  c --------------------------------------
245         levgather(index) = levpbl(pblindex(index),1)         levgather(index) = levpbl(pblindex(index),1)
246          pigather(index) =     pz(pblindex(index),1)          pigather(index) =     pz(pblindex(index),1)
247          pkegather(index,lm+1) = pkht(pblindex(index),1,lm+1)          pkegather(index,lm+1) = pkht(pblindex(index),1,lm+1)
248          plegather(index,lm+1) = ple(pblindex(index),1,lm+1)          plegather(index,lm+1) = plze(pblindex(index),1,lm+1)
249        enddo        enddo
250    
251        do L = 1,lm        do L = 1,lm
# Line 771  C ************************************** Line 775  C **************************************
775  C                          BUMP DIAGNOSTICS  C                          BUMP DIAGNOSTICS
776  C **********************************************************************  C **********************************************************************
777    
 c Clear-Sky (Above 400mb) Temperature  
 c -----------------------------------  
       if( itmpuclr.ne.0 .or. isphuclr.ne.0 ) then  
       do j = 1,jm  
       do i = 1,im  
       totcld(i,j) = 0.0  
       enddo  
       enddo  
       do L = 1,midlevel  
       do j = 1,jm  
       do i = 1,im  
        if(cldls(i,j,L).ne.0.0.or.cpen(i,j,L).ne.0.0)totcld(i,j) = 1.0  
       enddo  
       enddo  
       enddo  
       do L = 1,lm  
        if( itmpuclr.ne.0 ) then  
         do i = 1,im*jm  
         if( totcld(i,1).eq.0.0 ) then  
          qdiag(i,1,itmpuclr +L-1,bi,bj) =  
      .         qdiag(i,1,itmpuclr +L-1,bi,bj) + tz(i,1,L)*pkzgather(i,L)  
          qdiag(i,1,itmpuclrc+L-1,bi,bj) =  
      .                            qdiag(i,1,itmpuclrc+L-1,bi,bj)+1.0  
         endif  
         enddo  
        endif  
   
        if( isphuclr.ne.0 ) then  
         do i = 1,im*jm  
         if( totcld(i,1).eq.0.0 ) then  
          qdiag(i,1,isphuclr +L-1,bi,bj) =  
      .              qdiag(i,1,isphuclr +L-1,bi,bj) + qz(i,1,L,1)*1000.0  
          qdiag(i,1,isphuclrc+L-1,bi,bj) =  
      .                      qdiag(i,1,isphuclrc+L-1,bi,bj) + 1.0  
         endif  
         enddo  
        endif  
       enddo  
       endif  
   
778  c Sub-Cloud Layer  c Sub-Cloud Layer
779  c -------------------------  c -------------------------
780        if( ipsubcld.ne.0 ) then        if( ipsubcld.ne.0 ) then
# Line 1097  C ************************************** Line 1061  C **************************************
1061       *,               cp,grav,rkappa,alhl,rhfrac,rasmax )       *,               cp,grav,rkappa,alhl,rhfrac,rasmax )
1062  C  C
1063  C*********************************************************************  C*********************************************************************
 C*********************** ARIES   MODEL *******************************  
1064  C********************* SUBROUTINE  RAS   *****************************  C********************* SUBROUTINE  RAS   *****************************
1065  C********************** 16 MARCH   1988 ******************************  C********************** 16 MARCH   1988 ******************************
1066  C*********************************************************************  C*********************************************************************
1067  C  C
1068        PARAMETER (KRMIN=01)        implicit none
1069        PARAMETER (ICM=1000)  
1070        PARAMETER (CMB2PA=100.0)  C Argument List
1071        PARAMETER (rknob = 10.)        integer nn,len,lenc,k,nltop,nlayr
 C  
1072        integer ntracer        integer ntracer
1073        integer nltop,nlayr        integer ncrnd
1074        DIMENSION UOI(len,nlayr,ntracer),   POI(len,K)        real dt
1075        DIMENSION QOI(len,K), PRS(len,K+1), PRJ(len,K+1)        real UOI(len,nlayr,ntracer),   POI(len,K)
1076        dimension rnd(ncrnd)        real QOI(len,K), PRS(len,K+1), PRJ(len,K+1)
1077  C        real rnd(ncrnd)
1078        DIMENSION RAINS(len,K), CLN(len,K), CLF(len,K)        real RAINS(len,K), CLN(len,K), CLF(len,K)
1079        DIMENSION cldmas(len,K), detrain(len,K)        real cldmas(len,K), detrain(len,K)
1080        DIMENSION TCU(len,K), QCU(len,K)        real cp,grav,rkappa,alhl,rhfrac(len),rasmax
1081    
1082    C Local Variables
1083          real TCU(len,K), QCU(len,K)
1084        real ucu(len,K,ntracer)        real ucu(len,K,ntracer)
1085        DIMENSION ALF(len,K), BET(len,K), GAM(len,K)        real ALF(len,K), BET(len,K), GAM(len,K)
1086       *,         ETA(len,K), HOI(len,K)       *,         ETA(len,K), HOI(len,K)
1087       *,         PRH(len,K), PRI(len,K)       *,         PRH(len,K), PRI(len,K)
1088        DIMENSION HST(len,K), QOL(len,K), GMH(len,K)        real HST(len,K), QOL(len,K), GMH(len,K)
1089    
1090        DIMENSION TX1(len), TX2(len), TX3(len), TX4(len), TX5(len)        real TX1(len), TX2(len), TX3(len), TX4(len), TX5(len)
1091       *,         TX6(len), TX7(len), TX8(len), TX9(len)       *,         TX6(len), TX7(len), TX8(len), TX9(len)
1092       *,         TX11(len), TX12(len), TX13(len), TX14(len,ntracer)       *,         TX11(len), TX12(len), TX13(len), TX14(len,ntracer)
1093       *,         TX15(len), TX16(len)       *,         TX15(len)
1094       *,         WFN(len), IA1(len), IA2(len), IA3(len)       *,         WFN(len)
1095        DIMENSION cloudn(len), pcu(len)        integer IA1(len), IA2(len), IA3(len)
1096          real cloudn(len), pcu(len)
1097    
1098        real rhfrac(len),rasmax        integer krmin,icm
1099          real rknob, cmb2pa
1100        DIMENSION IC(ICM),   IRND(icm)        PARAMETER (KRMIN=01)
1101        dimension cmass(len,K)        PARAMETER (ICM=1000)
1102          PARAMETER (CMB2PA=100.0)
1103          PARAMETER (rknob = 10.)
1104    
1105          integer IC(ICM),   IRND(icm)
1106          real cmass(len,K)
1107        LOGICAL SETRAS        LOGICAL SETRAS
1108    
1109           do L = 1,k        integer i,L,nc,ib,nt
1110           do I = 1,LENC        integer km1,kp1,kprv,kcr,kfx,ncmx
1111           rains(i,l) = 0.        real p00, crtmsf, frac, rasblf
1112           enddo  
1113           enddo        do L = 1,k
1114          do I = 1,LENC
1115           rains(i,l) = 0.
1116          enddo
1117          enddo
1118    
1119        p00 = 1000.        p00 = 1000.
1120        crtmsf = 0.        crtmsf = 0.
# Line 1266  c -------------------------------------- Line 1241  c --------------------------------------
1241    
1242        RETURN        RETURN
1243        END        END
   
1244        subroutine rndcloud (iras,nrnd,rnd,myid)        subroutine rndcloud (iras,nrnd,rnd,myid)
1245        implicit none        implicit none
1246        integer n,iras,nrnd,myid        integer n,iras,nrnd,myid
# Line 1333  c -------------------------------------- Line 1307  c --------------------------------------
1307        iras0 = iras        iras0 = iras
1308        return        return
1309        end        end
1310          function random_numbx()
       real function random_numbx()  
1311        implicit none        implicit none
1312  #if CRAY        real random_numbx
1313          random_numbx = 0
1314    #ifdef CRAY
1315        real ranf        real ranf
1316        random_numbx = ranf()        random_numbx = ranf()
1317  #endif  #endif
1318  #if SGI  #ifdef SGI
1319        real rand        real rand
1320        random_numbx = rand()        random_numbx = rand()
1321  #endif  #endif
# Line 1349  c -------------------------------------- Line 1324  c --------------------------------------
1324        subroutine random_seedx (iseed)        subroutine random_seedx (iseed)
1325        implicit none        implicit none
1326        integer  iseed        integer  iseed
1327  #if CRAY  #ifdef CRAY
1328        call ranset (iseed)        call ranset (iseed)
1329  #endif  #endif
1330  #if SGI  #ifdef SGI
1331        integer*4   seed        integer*4   seed
1332                    seed = iseed                    seed = iseed
1333        call srand (seed)        call srand (seed)
1334  #endif  #endif
1335        return        return
1336        end        end
1337          SUBROUTINE CLOUD(nn,LEN, LENC, K, NLTOP, nlayr, IC, RASALF
       SUBROUTINE CLOUD(nn,LEN, LENC, K, NLTOP, nlayr, IC, RASALF,  
1338       *,                 SETRAS, FRAC       *,                 SETRAS, FRAC
1339       *,                 CP,  ALHL, RKAP, GRAV, P00, CRTMSF       *,                 CP,  ALHL, RKAP, GRAV, P00, CRTMSF
1340       *,                 POI, QOI, UOI, Ntracer, PRS,  PRJ       *,                 POI, QOI, UOI, Ntracer, PRS,  PRJ
# Line 1494  C    IA, I1, and I2 are temporary intege Line 1468  C    IA, I1, and I2 are temporary intege
1468  C  C
1469  C  C
1470  C************************************************************************  C************************************************************************
1471  C        implicit none
1472  C  C Argument List declarations
1473          integer nn,LEN,LENC,K,NLTOP,nlayr,ic,ntracer
1474          real rasalf
1475          LOGICAL SETRAS
1476          real frac, cp,  alhl, rkap, grav, p00, crtmsf
1477          real POI(LEN,K),QOI(LEN,K),PRS(LEN,K+1),PRJ(LEN,K+1)
1478          real uoi(len,nlayr,ntracer)
1479          real PCU(LENC), CLN(LEN)
1480          real TCU(LEN,K),  QCU(LEN,K),  ucu(len,k,ntracer), CMASS(LEN,K)
1481          real ALF(LEN,K), BET(LEN,K),  GAM(LEN,K), PRH(LEN,K), PRI(LEN,K)
1482          real HOL(LENC,K), ETA(LENC,K), HST(LENC,K), QOL(LENC,K)
1483          real GMH(LENC,K)
1484          real TX1(LENC), TX2(LENC), TX3(LENC), TX4(LENC)
1485          real TX5(LENC), TX6(LENC), TX7(LENC), TX8(LENC)
1486          real ALM(LENC), WFN(LENC), AKM(LENC), QS1(LENC)
1487          real WLQ(LENC), CLF(LENC)
1488          real uht(len,ntracer)
1489          integer IA(LENC), I1(LENC),I2(LENC)
1490          real      rhfrac(len)
1491    
1492    C Local Variables
1493          real daylen,half,one,zero,cmb2pa,rhmax
1494        PARAMETER (DAYLEN=86400.0,  HALF=0.5,  ONE=1.0, ZERO=0.0)        PARAMETER (DAYLEN=86400.0,  HALF=0.5,  ONE=1.0, ZERO=0.0)
1495        PARAMETER (CMB2PA=100.0)        PARAMETER (CMB2PA=100.0)
1496        PARAMETER (RHMAX=0.9999)        PARAMETER (RHMAX=0.9999)
1497          real rkapp1,onebcp,albcp,onebg,cpbg,twobal
1498  C  C
1499        integer nltop,ntracer,nlayr        integer nt,km1,ic1,i,L,len1,len2,isav,len11,ii
1500        DIMENSION POI(LEN,K),  QOI(LEN,K),  PRS(LEN,K+1)        integer lena,lena1,lenb,tem,tem1
      *,         PRJ(LEN,K+1)  
      *,         TCU(LEN,K),  QCU(LEN,K),  CMASS(LEN,K), CLN(LEN)  
       real uoi(len,nlayr,ntracer)  
       DIMENSION ALF(LEN,K), BET(LEN,K),  GAM(LEN,K)  
      *,         PRH(LEN,K), PRI(LEN,K)  
       DIMENSION AKM(LENC),   WFN(LENC)  
       DIMENSION HOL(LENC,K), QOL(LENC,K),  ETA(LENC,K), HST(LENC,K)  
      *,         GMH(LENC,K), ALM(LENC),    WLQ(LENC),   QS1(LENC)  
      *,         TX1(LENC),   TX2(LENC), TX3(LENC),   TX4(LENC)  
      *,         TX5(LENC),   TX6(LENC), TX7(LENC),   TX8(LENC)  
      *,         CLF(LENC),   PCU(LENC)  
       DIMENSION IA(LENC),    I1(LENC),  I2(LENC)  
       real      rhfrac(len)  
       real ucu(len,k,ntracer),uht(len,ntracer)  
       LOGICAL SETRAS  
   
       integer nt  
1501    
1502  c Explicit Inline Directives  c Explicit Inline Directives
1503  c --------------------------  c --------------------------
1504  #if CRAY  #ifdef CRAY
1505  #if f77  #ifdef f77
1506  cfpp$ expand (qsat)  cfpp$ expand (qsat)
1507  #endif  #endif
1508  #endif  #endif
# Line 1539  C Line 1517  C
1517        KM1 = K  - 1        KM1 = K  - 1
1518        IC1 = IC + 1        IC1 = IC + 1
1519  C  C
1520  C      SETTIING ALF, BET, GAM, PRH, AND PRI : DONE ONLY WHEN SETRAS=.T.  C      SETTING ALF, BET, GAM, PRH, AND PRI : DONE ONLY WHEN SETRAS=.T.
1521  C  C
1522    
1523        IF (SETRAS) THEN        IF (SETRAS) THEN
# Line 2104  C Line 2082  C
2082        END        END
2083        SUBROUTINE RNCL(LEN, PL, RNO, CLF)        SUBROUTINE RNCL(LEN, PL, RNO, CLF)
2084  C  C
 C  
2085  C*********************************************************************  C*********************************************************************
2086  C********************** Relaxed Arakawa-Schubert *********************  C********************** Relaxed Arakawa-Schubert *********************
2087  C************************   SUBROUTINE  RNCL  ************************  C************************   SUBROUTINE  RNCL  ************************
2088  C**************************** 23 July 1992 ***************************  C**************************** 23 July 1992 ***************************
2089  C*********************************************************************  C*********************************************************************
2090          implicit none
2091    C Argument List declarations
2092          integer len
2093          real PL(LEN),  RNO(LEN), CLF(LEN)
2094    
2095    C Local Variables
2096          real p5,p8,pt8,pt2,pfac,p4,p6,p7,p9,cucld,cfac
2097        PARAMETER (P5=500.0,  P8=800.0, PT8=0.8, PT2=0.2)        PARAMETER (P5=500.0,  P8=800.0, PT8=0.8, PT2=0.2)
2098        PARAMETER (PFAC=PT2/(P8-P5))        PARAMETER (PFAC=PT2/(P8-P5))
 C  
2099        PARAMETER (P4=400.0,    P6=401.0)        PARAMETER (P4=400.0,    P6=401.0)
2100        PARAMETER (P7=700.0,    P9=900.0)        PARAMETER (P7=700.0,    P9=900.0)
2101        PARAMETER (CUCLD=0.5,CFAC=CUCLD/(P6-P4))        PARAMETER (CUCLD=0.5,CFAC=CUCLD/(P6-P4))
2102    
2103          integer i
2104  C  C
       DIMENSION PL(LEN),  RNO(LEN), CLF(LEN)  
   
2105        DO 10 I=1,LEN        DO 10 I=1,LEN
2106                             rno(i) = 1.0                             rno(i) = 1.0
2107  ccc   if( pl(i).le.400.0 ) rno(i) = max( 0.75, 1.0-0.0025*(400.0-pl(i)) )  ccc   if( pl(i).le.400.0 ) rno(i) = max( 0.75, 1.0-0.0025*(400.0-pl(i)) )
# Line 2158  C****  Note:  Data obtained from January Line 2140  C****  Note:  Data obtained from January
2140  C****         from 4x5 46-layer GEOS Assimilation                *****  C****         from 4x5 46-layer GEOS Assimilation                *****
2141  C****                                                            *****  C****                                                            *****
2142  C*********************************************************************  C*********************************************************************
2143          implicit none
2144    C Argument List declarations
2145          integer len
2146        real PL(LEN), PLB(LEN), ACR(LEN)        real PL(LEN), PLB(LEN), ACR(LEN)
2147    
2148    C Local variables
2149          integer lma
2150        parameter  (lma=18)        parameter  (lma=18)
2151        real      p(lma)        real p(lma)
2152        real      a(lma)        real a(lma)
2153          integer i,L
2154          real temp
2155    
2156        data p  / 93.81, 111.65, 133.46, 157.80, 186.51,        data p  / 93.81, 111.65, 133.46, 157.80, 186.51,
2157       .         219.88, 257.40, 301.21, 352.49, 409.76,       .         219.88, 257.40, 301.21, 352.49, 409.76,
# Line 2201  C*************************************** Line 2189  C***************************************
2189       1   PLK,TH,TEMP1,TEMP2,TEMP3,ITMP1,ITMP2,RCON,RLAR,CLSBTH,tmscl,       1   PLK,TH,TEMP1,TEMP2,TEMP3,ITMP1,ITMP2,RCON,RLAR,CLSBTH,tmscl,
2190       2   tmfrc,cp,gravity,alhl,gamfac,cldlz,RHCRIT,offset,alpha)       2   tmfrc,cp,gravity,alhl,gamfac,cldlz,RHCRIT,offset,alpha)
2191    
2192          implicit none
2193    C Argument List declarations
2194          integer nn,irun,nlay
2195          real TL(IRUN,NLAY),QL(IRUN,NLAY),RAIN(IRUN,NLAY),
2196         . PL(IRUN,NLAY),CLFRAC(IRUN,NLAY),SP(IRUN),TEMP1(IRUN,NLAY),
2197         . TEMP2(IRUN,NLAY),PLKE(IRUN,NLAY+1),
2198         . RCON(IRUN),RLAR(IRUN),DP(IRUN,NLAY),PLK(IRUN,NLAY),TH(IRUN,NLAY),
2199         . TEMP3(IRUN,NLAY)
2200          integer ITMP1(IRUN,NLAY),ITMP2(IRUN,NLAY)
2201          real CLSBTH(IRUN,NLAY)
2202          real tmscl,tmfrc,cp,gravity,alhl,gamfac,offset,alpha
2203          real cldlz(irun,nlay)
2204          real rhcrit(irun,nlay)
2205    C
2206    C Local Variables
2207          real zm1p04,zero,two89,zp44,zp01,half,zp578,one,thousand,z3600
2208          real zp1,zp001
2209        PARAMETER (ZM1P04 = -1.04E-4 )        PARAMETER (ZM1P04 = -1.04E-4 )
2210        PARAMETER (ZERO = 0.)        PARAMETER (ZERO = 0.)
2211        PARAMETER (TWO89= 2.89E-5)        PARAMETER (TWO89= 2.89E-5)
# Line 2214  C*************************************** Line 2219  C***************************************
2219        PARAMETER ( THOUSAND = 1000.)        PARAMETER ( THOUSAND = 1000.)
2220        PARAMETER ( Z3600 = 3600.)        PARAMETER ( Z3600 = 3600.)
2221  C  C
2222         DIMENSION TL(IRUN,NLAY),QL(IRUN,NLAY),RAIN(IRUN,NLAY),        real EVP9(IRUN,NLAY)
2223       $ PL(IRUN,NLAY),CLFRAC(IRUN,NLAY),SP(IRUN),TEMP1(IRUN,NLAY),        real water(irun),crystal(irun)
2224       $ TEMP2(IRUN,NLAY),PLKE(IRUN,NLAY+1),        real watevap(irun),iceevap(irun)
2225       $ RCON(IRUN),RLAR(IRUN),DP(IRUN,NLAY),PLK(IRUN,NLAY),TH(IRUN,NLAY),        real fracwat,fracice, tice,rh,fact,dum
2226       $ TEMP3(IRUN,NLAY),ITMP1(IRUN,NLAY),        real rainmax(irun)
2227       $ ITMP2(IRUN,NLAY),CLSBTH(IRUN,NLAY)        real getcon,rphf,elocp,cpog,relax
2228  C        real exparg,arearat,rpow
2229         DIMENSION EVP9(IRUN,NLAY)  
2230         real water(irun),crystal(irun)        integer i,L,n,nlaym1,irnlay,irnlm1
        real watevap(irun),iceevap(irun)  
        real fracwat,fracice, tice,rh,fact,dum  
   
        real cldlz(irun,nlay)  
        real rhcrit(irun,nlay), rainmax(irun)  
        real offset, alpha  
2231    
2232  c Explicit Inline Directives  c Explicit Inline Directives
2233  c --------------------------  c --------------------------
2234  #if CRAY  #ifdef CRAY
2235  #if f77  #ifdef f77
2236  cfpp$ expand (qsat)  cfpp$ expand (qsat)
2237  #endif  #endif
2238  #endif  #endif
# Line 2430  C  ======= Line 2429  C  =======
2429  C    cloud ...... Cloud Fraction        (irun,irise)  C    cloud ...... Cloud Fraction        (irun,irise)
2430  C  C
2431  C***********************************************************************  C***********************************************************************
 C*                  GODDARD LABORATORY FOR ATMOSPHERES                 *  
 C***********************************************************************  
2432    
2433        implicit none        implicit none
2434        integer  irun,irise        integer  irun,irise
# Line 2442  C*************************************** Line 2439  C***************************************
2439        real   pl(irun,irise)        real   pl(irun,irise)
2440        real plke(irun,irise+1)        real plke(irun,irise+1)
2441    
       real tempth(irun)  
       real tempqs(irun)  
       real dhstar(irun)  
2442        real  cloud(irun,irise)        real  cloud(irun,irise)
2443        real cldwat(irun,irise)        real cldwat(irun,irise)
2444        real     qs(irun,irise)        real     qs(irun,irise)
2445    
2446        real cp, alhl, getcon, akap, pcheck        real cp, alhl, getcon, akap
2447        real ratio, temp, pke, elocp        real ratio, temp, elocp
2448        real rhcrit,rh,dum,pbar,tbar        real rhcrit,rh,dum
2449        integer i,L,ntradesu,ntradesl        integer i,L
2450    
       real factor  
2451        real rhc(irun,irise)        real rhc(irun,irise)
2452        real offset,alpha        real offset,alpha
2453    
2454  c Explicit Inline Directives  c Explicit Inline Directives
2455  c --------------------------  c --------------------------
2456  #if CRAY  #ifdef CRAY
2457  #if f77  #ifdef f77
2458  cfpp$ expand (qsat)  cfpp$ expand (qsat)
2459  #endif  #endif
2460  #endif  #endif
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22