/[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.9 by molod, Wed Jul 14 00:47:28 2004 UTC revision 1.15 by molod, Wed Jul 28 01:25:07 2004 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4  #include "PACKAGES_CONFIG.h"  #include "FIZHI_OPTIONS.h"
 #include "CPP_OPTIONS.h"  
5        subroutine moistio (ndmoist,istrip,npcs,        subroutine moistio (ndmoist,istrip,npcs,
6       .   lowlevel,midlevel,nltop,nsubmin,nsubmax,Lup,       .   lowlevel,midlevel,nltop,nsubmin,nsubmax,Lup,
7       .   pz,plz,plze,dpres,pkht,pkl,tz,qz,bi,bj,ntracer,ptracer,       .   pz,plz,plze,dpres,pkht,pkl,tz,qz,bi,bj,ntracer,ptracer,
# Line 27  c --------------- Line 26  c ---------------
26        integer ndmoist,istrip,npcs        integer ndmoist,istrip,npcs
27        integer bi,bj,ntracer,ptracer                integer bi,bj,ntracer,ptracer        
28        integer lowlevel,midlevel,nltop,nsubmin,nsubmax,Lup        integer lowlevel,midlevel,nltop,nsubmin,nsubmax,Lup
29        real pz(im,jm),plz(im,jm,lm),plze(im,jm,lm+1),dpres(im,jm,lm)        _RL pz(im,jm),plz(im,jm,lm),plze(im,jm,lm+1),dpres(im,jm,lm)
30        real pkht(im,jm,lm+1),pkl(im,jm,lm)        _RL pkht(im,jm,lm+1),pkl(im,jm,lm)
31        real tz(im,jm,lm),qz(im,jm,lm,ntracer)              _RL tz(im,jm,lm),qz(im,jm,lm,ntracer)      
32        real qqz(im,jm,lm)        _RL qqz(im,jm,lm)
33        real dumoist(im,jm,lm),dvmoist(im,jm,lm)        _RL dumoist(im,jm,lm),dvmoist(im,jm,lm)
34        real dtmoist(im,jm,lm),dqmoist(im,jm,lm,ntracer)        _RL dtmoist(im,jm,lm),dqmoist(im,jm,lm,ntracer)
35        real ptop        _RL ptop
36        integer iras        integer iras
37        real rainlsp(im,jm),rainconv(im,jm),snowfall(im,jm)        _RL rainlsp(im,jm),rainconv(im,jm),snowfall(im,jm)
38        integer nswcld,nswlz        integer nswcld,nswlz
39        real cldlsp_sw(im,jm,lm),cldras_sw(im,jm,lm)        _RL cldlsp_sw(im,jm,lm),cldras_sw(im,jm,lm)
40        real cldtot_sw(im,jm,lm),swlz(im,jm,lm)        _RL cldtot_sw(im,jm,lm),swlz(im,jm,lm)
41        integer nlwcld,nlwlz        integer nlwcld,nlwlz
42        real  cldlsp_lw(im,jm,lm),cldras_lw(im,jm,lm)        _RL  cldlsp_lw(im,jm,lm),cldras_lw(im,jm,lm)
43        real  cldtot_lw(im,jm,lm),lwlz(im,jm,lm)        _RL  cldtot_lw(im,jm,lm),lwlz(im,jm,lm)
44        logical lpnt        logical lpnt
45        integer myid        integer myid
46    
# Line 49  c Local Variables Line 48  c Local Variables
48  c ---------------  c ---------------
49        integer    ncrnd,nsecf        integer    ncrnd,nsecf
50    
51        real       fracqq, dum        _RL       fracqq, dum
52        integer    snowcrit        integer    snowcrit
53        parameter (fracqq = 0.1)        parameter (fracqq = 0.1)
54          _RL one
55          parameter (one=1.)
56    
57        real   cldsr(im,jm,lm)        _RL   cldsr(im,jm,lm)
58        real   srcld(istrip,lm)        _RL   srcld(istrip,lm)
59    
60        real plev        _RL plev
61        real cldnow,cldlsp_mem,cldlsp,cldras_mem,cldras        _RL cldnow,cldlsp_mem,cldlsp,cldras_mem,cldras
62        real watnow,watmin,cldmin        _RL watnow,watmin,cldmin
63        real cldprs(im,jm),cldtmp(im,jm)        _RL cldprs(im,jm),cldtmp(im,jm)
64        real cldhi (im,jm),cldlow(im,jm)        _RL cldhi (im,jm),cldlow(im,jm)
65        real cldmid(im,jm),totcld(im,jm)        _RL cldmid(im,jm),totcld(im,jm)
66    
67        real   CLDLS(im,jm,lm)  , CPEN(im,jm,lm)        _RL   CLDLS(im,jm,lm)  , CPEN(im,jm,lm)
68        real    tmpimjm(im,jm)        _RL    tmpimjm(im,jm)
69        real    lsp_new(im,jm)        _RL    lsp_new(im,jm)
70        real   conv_new(im,jm)        _RL   conv_new(im,jm)
71        real   snow_new(im,jm)        _RL   snow_new(im,jm)
72    
73        real  qqcolmin(im,jm)        _RL  qqcolmin(im,jm)
74        real  qqcolmax(im,jm)        _RL  qqcolmax(im,jm)
75        integer levpbl(im,jm)        integer levpbl(im,jm)
76    
77  c Gathered Arrays for Variable Cloud Base  c Gathered Arrays for Variable Cloud Base
78  c ---------------------------------------  c ---------------------------------------
79        real    raincgath(im*jm)        _RL    raincgath(im*jm)
80        real     pigather(im*jm)        _RL     pigather(im*jm)
81        real     thgather(im*jm,lm)        _RL     thgather(im*jm,lm)
82        real     shgather(im*jm,lm)        _RL     shgather(im*jm,lm)
83        real    pkzgather(im*jm,lm)        _RL    pkzgather(im*jm,lm)
84        real    pkegather(im*jm,lm+1)        _RL    pkegather(im*jm,lm+1)
85        real    plzgather(im*jm,lm)        _RL    plzgather(im*jm,lm)
86        real    plegather(im*jm,lm+1)        _RL    plegather(im*jm,lm+1)
87        real     dpgather(im*jm,lm)        _RL     dpgather(im*jm,lm)
88        real    tmpgather(im*jm,lm)        _RL    tmpgather(im*jm,lm)
89        real   deltgather(im*jm,lm)        _RL   deltgather(im*jm,lm)
90        real   delqgather(im*jm,lm)        _RL   delqgather(im*jm,lm)
91        real      ugather(im*jm,lm,ntracer)        _RL      ugather(im*jm,lm,ntracer)
92        real   delugather(im*jm,lm,ntracer)        _RL   delugather(im*jm,lm,ntracer)
93        real     deltrnev(im*jm,lm)        _RL     deltrnev(im*jm,lm)
94        real     delqrnev(im*jm,lm)        _RL     delqrnev(im*jm,lm)
95    
96        integer  nindeces(lm)        integer  nindeces(lm)
97        integer  pblindex(im*jm)        integer  pblindex(im*jm)
# Line 98  c -------------------------------------- Line 99  c --------------------------------------
99    
100  c Stripped Arrays  c Stripped Arrays
101  c ---------------  c ---------------
102        real saveth (istrip,lm)        _RL saveth (istrip,lm)
103        real saveq  (istrip,lm)        _RL saveq  (istrip,lm)
104        real saveu  (istrip,lm,ntracer)        _RL saveu  (istrip,lm,ntracer)
105        real usubcl (istrip,   ntracer)        _RL usubcl (istrip,   ntracer)
106    
107        real     ple(istrip,lm+1)        _RL     ple(istrip,lm+1)
108        real      dp(istrip,lm)        _RL      dp(istrip,lm)
109        real      TL(ISTRIP,lm)  , SHL(ISTRIP,lm)        _RL      TL(ISTRIP,lm)  , SHL(ISTRIP,lm)
110        real      PL(ISTRIP,lm)  , PLK(ISTRIP,lm)        _RL      PL(ISTRIP,lm)  , PLK(ISTRIP,lm)
111        real    PLKE(ISTRIP,lm+1)        _RL    PLKE(ISTRIP,lm+1)
112        real      TH(ISTRIP,lm)  ,CVTH(ISTRIP,lm)        _RL      TH(ISTRIP,lm)  ,CVTH(ISTRIP,lm)
113        real   CVQ(ISTRIP,lm)        _RL   CVQ(ISTRIP,lm)
114        real      UL(ISTRIP,lm,ntracer)        _RL      UL(ISTRIP,lm,ntracer)
115        real     cvu(istrip,lm,ntracer)        _RL     cvu(istrip,lm,ntracer)
116        real  CLMAXO(ISTRIP,lm),CLBOTH(ISTRIP,lm)        _RL  CLMAXO(ISTRIP,lm),CLBOTH(ISTRIP,lm)
117        real  CLSBTH(ISTRIP,lm)        _RL  CLSBTH(ISTRIP,lm)
118        real    TMP1(ISTRIP,lm),  TMP2(ISTRIP,lm)        _RL    TMP1(ISTRIP,lm),  TMP2(ISTRIP,lm)
119        real    TMP3(ISTRIP,lm),  TMP4(ISTRIP,lm+1)        _RL    TMP3(ISTRIP,lm),  TMP4(ISTRIP,lm+1)
120        real    TMP5(ISTRIP,lm+1)        _RL    TMP5(ISTRIP,lm+1)
121        integer   ITMP1(ISTRIP,lm), ITMP2(ISTRIP,lm)        integer   ITMP1(ISTRIP,lm), ITMP2(ISTRIP,lm)
122    
123        real   PRECIP(ISTRIP), PCNET(ISTRIP)        _RL   PRECIP(ISTRIP), PCNET(ISTRIP)
124        real   SP(ISTRIP),  PREP(ISTRIP)        _RL   SP(ISTRIP),  PREP(ISTRIP)
125        real   PCPEN (ISTRIP,lm)        _RL   PCPEN (ISTRIP,lm)
126        integer pbl(istrip),depths(lm)        integer pbl(istrip),depths(lm)
127    
128        real   cldlz(istrip,lm), cldwater(im,jm,lm)        _RL   cldlz(istrip,lm), cldwater(im,jm,lm)
129        real   rhfrac(istrip), rhmin, pup, ppbl, rhcrit(istrip,lm)        _RL   rhfrac(istrip), rhmin, pup, ppbl, rhcrit(istrip,lm)
130        real   offset, alpha, rasmax        _RL   offset, alpha, rasmax
131    
132        logical first        logical first
133        logical lras        logical lras
134        real    clfrac (istrip,lm)        _RL    clfrac (istrip,lm)
135        real    cldmas (istrip,lm)        _RL    cldmas (istrip,lm)
136        real    detrain(istrip,lm)        _RL    detrain(istrip,lm)
137        real    psubcld    (istrip), psubcldg (im,jm)        _RL    psubcld    (istrip), psubcldg (im,jm)
138        real    psubcld_cnt(istrip), psubcldgc(im,jm)        _RL    psubcld_cnt(istrip), psubcldgc(im,jm)
139        real rnd(lm/2)        _RL rnd(lm/2)
140        DATA      FIRST /.TRUE./        DATA      FIRST /.TRUE./
141    
142        integer imstp,nsubcl,nlras        integer imstp,nsubcl,nlras
143        integer i,j,iloop,index,l,nn,num,numdeps,nt        integer i,j,iloop,index,l,nn,num,numdeps,nt
144        real tmstp,tminv,sday,grav,alhl,cp,elocp,gamfac        _RL tmstp,tminv,sday,grav,alhl,cp,elocp,gamfac
145        real rkappa,p0kappa,p0kinv,ptopkap,pcheck        _RL rkappa,p0kappa,p0kinv,ptopkap,pcheck
146        real tice,getcon,pi        _RL tice,getcon,pi
147    
148  C **********************************************************************  C **********************************************************************
149  C ****                     INITIALIZATION                           ****  C ****                     INITIALIZATION                           ****
# Line 185  c Determine Total number of Random Cloud Line 186  c Determine Total number of Random Cloud
186  c ---------------------------------------------  c ---------------------------------------------
187        ncrnd = (lm-nltop+1)/2        ncrnd = (lm-nltop+1)/2
188    
189        if(first .and. myid.eq.0) then        if(first .and. myid.eq.1) then
190         print *         print *
191         print *,'Top Level Allowed for Convection : ',nltop         print *,'Top Level Allowed for Convection : ',nltop
192         print *,'          Highest Sub-Cloud Level: ',nsubmax         print *,'          Highest Sub-Cloud Level: ',nsubmax
# Line 603  C ************************************** Line 604  C **************************************
604    
605         CALL RNEVP (NN,ISTRIP,lm,TL,SHL,PCPEN,PL,CLFRAC,SP,DP,PLKE,         CALL RNEVP (NN,ISTRIP,lm,TL,SHL,PCPEN,PL,CLFRAC,SP,DP,PLKE,
606       .  PLK,TH,TMP1,TMP2,TMP3,ITMP1,ITMP2,PCNET,PRECIP,       .  PLK,TH,TMP1,TMP2,TMP3,ITMP1,ITMP2,PCNET,PRECIP,
607       .  CLSBTH,TMSTP,1.,cp,grav,alhl,gamfac,cldlz,rhcrit,offset,alpha)       .  CLSBTH,TMSTP,one,cp,grav,alhl,gamfac,cldlz,rhcrit,offset,alpha)
608    
609  C **********************************************************************  C **********************************************************************
610  C ****                     TENDENCY UPDATES                         ****  C ****                     TENDENCY UPDATES                         ****
# Line 1071  C Argument List Line 1072  C Argument List
1072        integer nn,len,lenc,k,nltop,nlayr        integer nn,len,lenc,k,nltop,nlayr
1073        integer ntracer        integer ntracer
1074        integer ncrnd        integer ncrnd
1075        real dt        _RL dt
1076        real UOI(len,nlayr,ntracer),   POI(len,K)        _RL UOI(len,nlayr,ntracer),   POI(len,K)
1077        real QOI(len,K), PRS(len,K+1), PRJ(len,K+1)        _RL QOI(len,K), PRS(len,K+1), PRJ(len,K+1)
1078        real rnd(ncrnd)        _RL rnd(ncrnd)
1079        real RAINS(len,K), CLN(len,K), CLF(len,K)        _RL RAINS(len,K), CLN(len,K), CLF(len,K)
1080        real cldmas(len,K), detrain(len,K)        _RL cldmas(len,K), detrain(len,K)
1081        real cp,grav,rkappa,alhl,rhfrac(len),rasmax        _RL cp,grav,rkappa,alhl,rhfrac(len),rasmax
1082    
1083  C Local Variables  C Local Variables
1084        real TCU(len,K), QCU(len,K)        _RL TCU(len,K), QCU(len,K)
1085        real ucu(len,K,ntracer)        _RL ucu(len,K,ntracer)
1086        real ALF(len,K), BET(len,K), GAM(len,K)        _RL ALF(len,K), BET(len,K), GAM(len,K)
1087       *,         ETA(len,K), HOI(len,K)       *,         ETA(len,K), HOI(len,K)
1088       *,         PRH(len,K), PRI(len,K)       *,         PRH(len,K), PRI(len,K)
1089        real HST(len,K), QOL(len,K), GMH(len,K)        _RL HST(len,K), QOL(len,K), GMH(len,K)
1090    
1091        real TX1(len), TX2(len), TX3(len), TX4(len), TX5(len)        _RL TX1(len), TX2(len), TX3(len), TX4(len), TX5(len)
1092       *,         TX6(len), TX7(len), TX8(len), TX9(len)       *,         TX6(len), TX7(len), TX8(len), TX9(len)
1093       *,         TX11(len), TX12(len), TX13(len), TX14(len,ntracer)       *,         TX11(len), TX12(len), TX13(len), TX14(len,ntracer)
1094       *,         TX15(len)       *,         TX15(len)
1095       *,         WFN(len)       *,         WFN(len)
1096        integer IA1(len), IA2(len), IA3(len)        integer IA1(len), IA2(len), IA3(len)
1097        real cloudn(len), pcu(len)        _RL cloudn(len), pcu(len)
1098    
1099        integer krmin,icm        integer krmin,icm
1100        real rknob, cmb2pa        _RL rknob, cmb2pa
1101        PARAMETER (KRMIN=01)        PARAMETER (KRMIN=01)
1102        PARAMETER (ICM=1000)        PARAMETER (ICM=1000)
1103        PARAMETER (CMB2PA=100.0)        PARAMETER (CMB2PA=100.0)
1104        PARAMETER (rknob = 10.)        PARAMETER (rknob = 10.)
1105    
1106        integer IC(ICM),   IRND(icm)        integer IC(ICM),   IRND(icm)
1107        real cmass(len,K)        _RL cmass(len,K)
1108        LOGICAL SETRAS        LOGICAL SETRAS
1109    
1110        integer i,L,nc,ib,nt        integer i,L,nc,ib,nt
1111        integer km1,kp1,kprv,kcr,kfx,ncmx        integer km1,kp1,kprv,kcr,kfx,ncmx
1112        real p00, crtmsf, frac, rasblf        _RL p00, crtmsf, frac, rasblf
1113    
1114        do L = 1,k        do L = 1,k
1115        do I = 1,LENC        do I = 1,LENC
# Line 1244  c -------------------------------------- Line 1245  c --------------------------------------
1245        subroutine rndcloud (iras,nrnd,rnd,myid)        subroutine rndcloud (iras,nrnd,rnd,myid)
1246        implicit none        implicit none
1247        integer n,iras,nrnd,myid        integer n,iras,nrnd,myid
1248        real random_numbx        _RL random_numbx
1249        real rnd(nrnd)        _RL rnd(nrnd)
1250        integer irm        integer irm
1251        parameter (irm = 1000)        parameter (irm = 1000)
1252        real random(irm)        _RL random(irm)
1253        integer i,mcheck,numrand,iseed,index        integer i,mcheck,numrand,iseed,index
1254        logical first        logical first
1255        data    first /.true./        data    first /.true./
# Line 1260  c -------------------------------------- Line 1261  c --------------------------------------
1261         do i = 1,nrnd         do i = 1,nrnd
1262          rnd(i) = 0          rnd(i) = 0
1263         enddo         enddo
1264         if(first .and. myid.eq.0) print *,' NO RANDOM CLOUDS IN RAS '         if(first .and. myid.eq.1) print *,' NO RANDOM CLOUDS IN RAS '
1265         go to 100         go to 100
1266        endif        endif
1267    
# Line 1269  c -------------------------------------- Line 1270  c --------------------------------------
1270  c First Time In From a Continuing RESTART (IRAS.GT.1) or Reading a New RESTART  c First Time In From a Continuing RESTART (IRAS.GT.1) or Reading a New RESTART
1271  c ----------------------------------------------------------------------------  c ----------------------------------------------------------------------------
1272        if( first.and.(iras.gt.1) .or. iras.ne.iras0+1 )then        if( first.and.(iras.gt.1) .or. iras.ne.iras0+1 )then
1273         if( myid.eq.0 ) print *, 'Recreating Rand Numb Array in RNDCLOUD'         if( myid.eq.1 ) print *, 'Recreating Rand Numb Array in RNDCLOUD'
1274         if( myid.eq.0 ) print *, 'IRAS: ',iras,'  IRAS0: ',iras0         if( myid.eq.1 ) print *, 'IRAS: ',iras,'  IRAS0: ',iras0
1275         numrand = mod(iras,irm/nrnd) * nrnd         numrand = mod(iras,irm/nrnd) * nrnd
1276         iseed   = iras * nrnd - numrand         iseed   = iras * nrnd - numrand
1277         call random_seedx(iseed)         call random_seedx(iseed)
1278         do i = 1,irm         do i = 1,irm
1279          random(i) = random_numbx()          random(i) = random_numbx(iseed)
1280         enddo         enddo
1281         index = (iras-1)*nrnd         index = (iras-1)*nrnd
1282    
# Line 1285  c -------------------------------------- Line 1286  c --------------------------------------
1286            iseed = (iras-1)*nrnd            iseed = (iras-1)*nrnd
1287            call random_seedx(iseed)            call random_seedx(iseed)
1288            do i = 1,irm            do i = 1,irm
1289             random(i) = random_numbx()             random(i) = random_numbx(iseed)
1290            enddo            enddo
1291            index = iseed            index = iseed
1292    
# Line 1307  c -------------------------------------- Line 1308  c --------------------------------------
1308        iras0 = iras        iras0 = iras
1309        return        return
1310        end        end
1311        function random_numbx()        function random_numbx(iseed)
1312        implicit none        implicit none
1313        real random_numbx        integer iseed
1314  #if CRAY        real *8 seed,port_rand
1315        real ranf        _RL random_numbx
1316          random_numbx = 0
1317    #ifdef CRAY
1318          _RL ranf
1319        random_numbx = ranf()        random_numbx = ranf()
1320  #endif  #else
1321  #if SGI  #ifdef SGI
1322        real rand        _RL rand
1323        random_numbx = rand()        random_numbx = rand()
1324  #endif  #endif
1325          random_numbx = port_rand(seed)
1326    #endif
1327        return        return
1328        end        end
1329        subroutine random_seedx (iseed)        subroutine random_seedx (iseed)
1330        implicit none        implicit none
1331        integer  iseed        integer  iseed
1332  #if CRAY  #ifdef CRAY
1333        call ranset (iseed)        call ranset (iseed)
1334  #endif  #endif
1335  #if SGI  #ifdef SGI
1336        integer*4   seed        integer*4   seed
1337                    seed = iseed                    seed = iseed
1338        call srand (seed)        call srand (seed)
# Line 1470  C*************************************** Line 1476  C***************************************
1476        implicit none        implicit none
1477  C Argument List declarations  C Argument List declarations
1478        integer nn,LEN,LENC,K,NLTOP,nlayr,ic,ntracer        integer nn,LEN,LENC,K,NLTOP,nlayr,ic,ntracer
1479        real rasalf        _RL rasalf
1480        LOGICAL SETRAS        LOGICAL SETRAS
1481        real frac, cp,  alhl, rkap, grav, p00, crtmsf        _RL frac, cp,  alhl, rkap, grav, p00, crtmsf
1482        real POI(LEN,K),QOI(LEN,K),PRS(LEN,K+1),PRJ(LEN,K+1)        _RL POI(LEN,K),QOI(LEN,K),PRS(LEN,K+1),PRJ(LEN,K+1)
1483        real uoi(len,nlayr,ntracer)        _RL uoi(len,nlayr,ntracer)
1484        real PCU(LENC), CLN(LEN)        _RL PCU(LENC), CLN(LEN)
1485        real TCU(LEN,K),  QCU(LEN,K),  ucu(len,k,ntracer), CMASS(LEN,K)        _RL TCU(LEN,K),  QCU(LEN,K),  ucu(len,k,ntracer), CMASS(LEN,K)
1486        real ALF(LEN,K), BET(LEN,K),  GAM(LEN,K), PRH(LEN,K), PRI(LEN,K)        _RL ALF(LEN,K), BET(LEN,K),  GAM(LEN,K), PRH(LEN,K), PRI(LEN,K)
1487        real HOL(LENC,K), ETA(LENC,K), HST(LENC,K), QOL(LENC,K)        _RL HOL(LENC,K), ETA(LENC,K), HST(LENC,K), QOL(LENC,K)
1488        real GMH(LENC,K)        _RL GMH(LENC,K)
1489        real TX1(LENC), TX2(LENC), TX3(LENC), TX4(LENC)        _RL TX1(LENC), TX2(LENC), TX3(LENC), TX4(LENC)
1490        real TX5(LENC), TX6(LENC), TX7(LENC), TX8(LENC)        _RL TX5(LENC), TX6(LENC), TX7(LENC), TX8(LENC)
1491        real ALM(LENC), WFN(LENC), AKM(LENC), QS1(LENC)        _RL ALM(LENC), WFN(LENC), AKM(LENC), QS1(LENC)
1492        real WLQ(LENC), CLF(LENC)        _RL WLQ(LENC), CLF(LENC)
1493        real uht(len,ntracer)        _RL uht(len,ntracer)
1494        integer IA(LENC), I1(LENC),I2(LENC)        integer IA(LENC), I1(LENC),I2(LENC)
1495        real      rhfrac(len)        _RL      rhfrac(len)
1496    
1497  C Local Variables  C Local Variables
1498        real daylen,half,one,zero,cmb2pa,rhmax        _RL daylen,half,one,zero,cmb2pa,rhmax
1499        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)
1500        PARAMETER (CMB2PA=100.0)        PARAMETER (CMB2PA=100.0)
1501        PARAMETER (RHMAX=0.9999)        PARAMETER (RHMAX=0.9999)
1502        real rkapp1,onebcp,albcp,onebg,cpbg,twobal        _RL rkapp1,onebcp,albcp,onebg,cpbg,twobal
1503  C  C
1504        integer nt,km1,ic1,i,L,len1,len2,isav,len11,ii        integer nt,km1,ic1,i,L,len1,len2,isav,len11,ii
1505        integer lena,lena1,lenb,tem,tem1        integer lena,lena1,lenb,tem,tem1
1506    
1507  c Explicit Inline Directives  c Explicit Inline Directives
1508  c --------------------------  c --------------------------
1509  #if CRAY  #ifdef CRAY
1510  #if f77  #ifdef f77
1511  cfpp$ expand (qsat)  cfpp$ expand (qsat)
1512  #endif  #endif
1513  #endif  #endif
# Line 2089  C*************************************** Line 2095  C***************************************
2095        implicit none        implicit none
2096  C Argument List declarations  C Argument List declarations
2097        integer len        integer len
2098        real PL(LEN),  RNO(LEN), CLF(LEN)        _RL PL(LEN),  RNO(LEN), CLF(LEN)
2099    
2100  C Local Variables  C Local Variables
2101        real p5,p8,pt8,pt2,pfac,p4,p6,p7,p9,cucld,cfac        _RL p5,p8,pt8,pt2,pfac,p4,p6,p7,p9,cucld,cfac
2102        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)
2103        PARAMETER (PFAC=PT2/(P8-P5))        PARAMETER (PFAC=PT2/(P8-P5))
2104        PARAMETER (P4=400.0,    P6=401.0)        PARAMETER (P4=400.0,    P6=401.0)
# Line 2142  C*************************************** Line 2148  C***************************************
2148        implicit none        implicit none
2149  C Argument List declarations  C Argument List declarations
2150        integer len        integer len
2151        real PL(LEN), PLB(LEN), ACR(LEN)        _RL PL(LEN), PLB(LEN), ACR(LEN)
2152    
2153  C Local variables  C Local variables
2154        integer lma        integer lma
2155        parameter  (lma=18)        parameter  (lma=18)
2156        real p(lma)        _RL p(lma)
2157        real a(lma)        _RL a(lma)
2158        integer i,L        integer i,L
2159        real temp        _RL temp
2160    
2161        data p  / 93.81, 111.65, 133.46, 157.80, 186.51,        data p  / 93.81, 111.65, 133.46, 157.80, 186.51,
2162       .         219.88, 257.40, 301.21, 352.49, 409.76,       .         219.88, 257.40, 301.21, 352.49, 409.76,
# Line 2191  C Local variables Line 2197  C Local variables
2197        implicit none        implicit none
2198  C Argument List declarations  C Argument List declarations
2199        integer nn,irun,nlay        integer nn,irun,nlay
2200        real TL(IRUN,NLAY),QL(IRUN,NLAY),RAIN(IRUN,NLAY),        _RL TL(IRUN,NLAY),QL(IRUN,NLAY),RAIN(IRUN,NLAY),
2201       . PL(IRUN,NLAY),CLFRAC(IRUN,NLAY),SP(IRUN),TEMP1(IRUN,NLAY),       . PL(IRUN,NLAY),CLFRAC(IRUN,NLAY),SP(IRUN),TEMP1(IRUN,NLAY),
2202       . TEMP2(IRUN,NLAY),PLKE(IRUN,NLAY+1),       . TEMP2(IRUN,NLAY),PLKE(IRUN,NLAY+1),
2203       . RCON(IRUN),RLAR(IRUN),DP(IRUN,NLAY),PLK(IRUN,NLAY),TH(IRUN,NLAY),       . RCON(IRUN),RLAR(IRUN),DP(IRUN,NLAY),PLK(IRUN,NLAY),TH(IRUN,NLAY),
2204       . TEMP3(IRUN,NLAY)       . TEMP3(IRUN,NLAY)
2205        integer ITMP1(IRUN,NLAY),ITMP2(IRUN,NLAY)        integer ITMP1(IRUN,NLAY),ITMP2(IRUN,NLAY)
2206        real CLSBTH(IRUN,NLAY)        _RL CLSBTH(IRUN,NLAY)
2207        real tmscl,tmfrc,cp,gravity,alhl,gamfac,offset,alpha        _RL tmscl,tmfrc,cp,gravity,alhl,gamfac,offset,alpha
2208        real cldlz(irun,nlay)        _RL cldlz(irun,nlay)
2209        real rhcrit(irun,nlay)        _RL rhcrit(irun,nlay)
2210  C  C
2211  C Local Variables  C Local Variables
2212        real zm1p04,zero,two89,zp44,zp01,half,zp578,one,thousand,z3600        _RL zm1p04,zero,two89,zp44,zp01,half,zp578,one,thousand,z3600
2213        real zp1,zp001        _RL zp1,zp001
2214        PARAMETER (ZM1P04 = -1.04E-4 )        PARAMETER (ZM1P04 = -1.04E-4 )
2215        PARAMETER (ZERO = 0.)        PARAMETER (ZERO = 0.)
2216        PARAMETER (TWO89= 2.89E-5)        PARAMETER (TWO89= 2.89E-5)
# Line 2218  C Local Variables Line 2224  C Local Variables
2224        PARAMETER ( THOUSAND = 1000.)        PARAMETER ( THOUSAND = 1000.)
2225        PARAMETER ( Z3600 = 3600.)        PARAMETER ( Z3600 = 3600.)
2226  C  C
2227        real EVP9(IRUN,NLAY)        _RL EVP9(IRUN,NLAY)
2228        real water(irun),crystal(irun)        _RL water(irun),crystal(irun)
2229        real watevap(irun),iceevap(irun)        _RL watevap(irun),iceevap(irun)
2230        real fracwat,fracice, tice,rh,fact,dum        _RL fracwat,fracice, tice,rh,fact,dum
2231        real rainmax(irun)        _RL rainmax(irun)
2232        real getcon,rphf,elocp,cpog,relax        _RL getcon,rphf,elocp,cpog,relax
2233        real exparg,arearat,rpow        _RL exparg,arearat,rpow
2234    
2235        integer i,L,n,nlaym1,irnlay,irnlm1        integer i,L,n,nlaym1,irnlay,irnlm1
2236    
2237  c Explicit Inline Directives  c Explicit Inline Directives
2238  c --------------------------  c --------------------------
2239  #if CRAY  #ifdef CRAY
2240  #if f77  #ifdef f77
2241  cfpp$ expand (qsat)  cfpp$ expand (qsat)
2242  #endif  #endif
2243  #endif  #endif
# Line 2432  C*************************************** Line 2438  C***************************************
2438        implicit none        implicit none
2439        integer  irun,irise        integer  irun,irise
2440    
2441        real   th(irun,irise)        _RL   th(irun,irise)
2442        real    q(irun,irise)        _RL    q(irun,irise)
2443        real  plk(irun,irise)        _RL  plk(irun,irise)
2444        real   pl(irun,irise)        _RL   pl(irun,irise)
2445        real plke(irun,irise+1)        _RL plke(irun,irise+1)
2446    
2447        real  cloud(irun,irise)        _RL  cloud(irun,irise)
2448        real cldwat(irun,irise)        _RL cldwat(irun,irise)
2449        real     qs(irun,irise)        _RL     qs(irun,irise)
2450    
2451        real cp, alhl, getcon, akap        _RL cp, alhl, getcon, akap
2452        real ratio, temp, elocp        _RL ratio, temp, elocp
2453        real rhcrit,rh,dum        _RL rhcrit,rh,dum
2454        integer i,L        integer i,L
2455    
2456        real rhc(irun,irise)        _RL rhc(irun,irise)
2457        real offset,alpha        _RL offset,alpha
2458    
2459  c Explicit Inline Directives  c Explicit Inline Directives
2460  c --------------------------  c --------------------------
2461  #if CRAY  #ifdef CRAY
2462  #if f77  #ifdef f77
2463  cfpp$ expand (qsat)  cfpp$ expand (qsat)
2464  #endif  #endif
2465  #endif  #endif
# Line 2494  c -------------------------------------- Line 2500  c --------------------------------------
2500        subroutine ctei ( th,q,cldfrc,cldwat,pl,plk,plke,im,lm )        subroutine ctei ( th,q,cldfrc,cldwat,pl,plk,plke,im,lm )
2501        implicit none        implicit none
2502        integer im,lm        integer im,lm
2503        real  th(im,lm),q(im,lm),plke(im,lm+1),cldwat(im,lm)        _RL  th(im,lm),q(im,lm),plke(im,lm+1),cldwat(im,lm)
2504        real plk(im,lm),pl(im,lm),cldfrc(im,lm)        _RL plk(im,lm),pl(im,lm),cldfrc(im,lm)
2505        integer i,L        integer i,L
2506        real    getcon,cp,alhl,elocp,cpoel,t,p,s,qs,dqsdt,dq        _RL    getcon,cp,alhl,elocp,cpoel,t,p,s,qs,dqsdt,dq
2507        real    k,krd,kmm,f        _RL    k,krd,kmm,f
2508    
2509        cp     = getcon('CP')        cp     = getcon('CP')
2510        alhl   = getcon('LATENT HEAT COND')        alhl   = getcon('LATENT HEAT COND')
# Line 2535  c -------------------------------------- Line 2541  c --------------------------------------
2541        subroutine back2grd(gathered,indeces,scattered,irun)        subroutine back2grd(gathered,indeces,scattered,irun)
2542        implicit none        implicit none
2543        integer i,irun,indeces(irun)        integer i,irun,indeces(irun)
2544        real gathered(irun),scattered(irun)        _RL gathered(irun),scattered(irun)
2545        real temp(irun)        _RL temp(irun)
2546        do i = 1,irun        do i = 1,irun
2547         temp(indeces(i)) = gathered(i)         temp(indeces(i)) = gathered(i)
2548        enddo        enddo
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22