/[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.11 by molod, Fri Jul 16 20:11:04 2004 UTC revision 1.16 by molod, Tue Aug 10 15:13:47 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,indx,indgath,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 229  c -------------------------------------- Line 230  c --------------------------------------
230    
231  c Set up the array of indeces of subcloud levels for the gathering  c Set up the array of indeces of subcloud levels for the gathering
232  c ----------------------------------------------------------------  c ----------------------------------------------------------------
233        index = 0        indx = 0
234        do L = nsubmin,nltop,-1        do L = nsubmin,nltop,-1
235         do j = 1,jm         do j = 1,jm
236         do i = 1,im         do i = 1,im
237          if(levpbl(i,j).eq.L) then          if(levpbl(i,j).eq.L) then
238           index = index + 1           indx = indx + 1
239           pblindex(index) = (j-1)*im + i           pblindex(indx) = (j-1)*im + i
240          endif          endif
241         enddo         enddo
242         enddo         enddo
243        enddo        enddo
244    
245        do index = 1,im*jm        do indx = 1,im*jm
246         levgather(index) = levpbl(pblindex(index),1)         levgather(indx) = levpbl(pblindex(indx),1)
247          pigather(index) =     pz(pblindex(index),1)          pigather(indx) =     pz(pblindex(indx),1)
248          pkegather(index,lm+1) = pkht(pblindex(index),1,lm+1)          pkegather(indx,lm+1) = pkht(pblindex(indx),1,lm+1)
249          plegather(index,lm+1) = plze(pblindex(index),1,lm+1)          plegather(indx,lm+1) = plze(pblindex(indx),1,lm+1)
250        enddo        enddo
251    
252        do L = 1,lm        do L = 1,lm
253         do index = 1,im*jm         do indx = 1,im*jm
254           thgather(index,L) = tz(pblindex(index),1,L)           thgather(indx,L) = tz(pblindex(indx),1,L)
255           shgather(index,L) = qz(pblindex(index),1,L,1)           shgather(indx,L) = qz(pblindex(indx),1,L,1)
256          pkegather(index,L) = pkht(pblindex(index),1,L)          pkegather(indx,L) = pkht(pblindex(indx),1,L)
257          pkzgather(index,L) = pkl(pblindex(index),1,L)          pkzgather(indx,L) = pkl(pblindex(indx),1,L)
258          plegather(index,L) = plze(pblindex(index),1,L)          plegather(indx,L) = plze(pblindex(indx),1,L)
259          plzgather(index,L) = plz(pblindex(index),1,L)          plzgather(indx,L) = plz(pblindex(indx),1,L)
260           dpgather(index,L) = dpres(pblindex(index),1,L)           dpgather(indx,L) = dpres(pblindex(indx),1,L)
261         enddo         enddo
262        enddo        enddo
263        do nt = 1,ntracer-ptracer        do nt = 1,ntracer-ptracer
264        do L = 1,lm        do L = 1,lm
265         do index = 1,im*jm         do indx = 1,im*jm
266          ugather(index,L,nt) = qz(pblindex(index),1,L,nt+ptracer)          ugather(indx,L,nt) = qz(pblindex(indx),1,L,nt+ptracer)
267         enddo         enddo
268        enddo        enddo
269        enddo        enddo
# 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 775  C ************************************** Line 776  C **************************************
776  C                          BUMP DIAGNOSTICS  C                          BUMP DIAGNOSTICS
777  C **********************************************************************  C **********************************************************************
778    
779    
780  c Sub-Cloud Layer  c Sub-Cloud Layer
781  c -------------------------  c -------------------------
782        if( ipsubcld.ne.0 ) then        if( ipsubcld.ne.0 ) then
# Line 806  c Moist Processes Heating Rate Line 808  c Moist Processes Heating Rate
808  c ----------------------------  c ----------------------------
809        if(imoistt.gt.0) then        if(imoistt.gt.0) then
810        do L = 1,lm        do L = 1,lm
811        do i = 1,im*jm        do j = 1,jm
812        qdiag(i,1,imoistt+L-1,bi,bj) = qdiag(i,1,imoistt+L-1,bi,bj) +        do i = 1,im
813       .                      (dtmoist(i,1,L)*sday*pkzgather(i,L)/pz(i,1))         indgath = (j-1)*im + i
814          qdiag(i,j,imoistt+L-1,bi,bj) = qdiag(i,j,imoistt+L-1,bi,bj) +
815         .    (dtmoist(i,j,L)*sday*pkzgather(indgath,L)/pz(i,j))
816          enddo
817        enddo        enddo
818        enddo        enddo
819        endif        endif
# Line 830  c Cloud Mass Flux Line 835  c Cloud Mass Flux
835  c ---------------  c ---------------
836        if(icldmas.gt.0) then        if(icldmas.gt.0) then
837        do L = 1,lm        do L = 1,lm
838        do i = 1,im*jm        do j = 1,jm
839        qdiag(i,1,icldmas+L-1,bi,bj) = qdiag(i,1,icldmas+L-1,bi,bj) +        do i = 1,im
840       .                                                  tmpgather(i,L)         indgath = (j-1)*im + i
841          qdiag(i,j,icldmas+L-1,bi,bj) = qdiag(i,j,icldmas+L-1,bi,bj) +
842         .                               tmpgather(indgath,L)
843          enddo
844        enddo        enddo
845        enddo        enddo
846        endif        endif
# Line 841  c Detrained Cloud Mass Flux Line 849  c Detrained Cloud Mass Flux
849  c -------------------------  c -------------------------
850        if(idtrain.gt.0) then        if(idtrain.gt.0) then
851        do L = 1,lm        do L = 1,lm
852        do i = 1,im*jm        do j = 1,jm
853        qdiag(i,1,idtrain+L-1,bi,bj) = qdiag(i,1,idtrain+L-1,bi,bj) +        do i = 1,im
854       .                                                  pkegather(i,L)         indgath = (j-1)*im + i
855          qdiag(i,j,idtrain+L-1,bi,bj) = qdiag(i,j,idtrain+L-1,bi,bj) +
856         .                                pkegather(indgath,L)
857          enddo
858        enddo        enddo
859        enddo        enddo
860        endif        endif
# Line 852  c Grid-Scale Condensational Heating Rate Line 863  c Grid-Scale Condensational Heating Rate
863  c --------------------------------------  c --------------------------------------
864        if(idtls.gt.0) then        if(idtls.gt.0) then
865        do L = 1,lm        do L = 1,lm
866        do i = 1,im*jm        do j = 1,jm
867        qdiag(i,1,idtls+L-1,bi,bj) = qdiag(i,1,idtls+L-1,bi,bj) +        do i = 1,im
868       .                                                  deltrnev(i,L)         indgath = (j-1)*im + i
869          qdiag(i,j,idtls+L-1,bi,bj) = qdiag(i,j,idtls+L-1,bi,bj) +
870         .                               deltrnev(indgath,L)
871          enddo
872        enddo        enddo
873        enddo        enddo
874        endif        endif
# Line 863  c Grid-Scale Condensational Moistening R Line 877  c Grid-Scale Condensational Moistening R
877  c -----------------------------------------  c -----------------------------------------
878        if(idqls.gt.0) then        if(idqls.gt.0) then
879        do L = 1,lm        do L = 1,lm
880        do i = 1,im*jm        do j = 1,jm
881        qdiag(i,1,idqls+L-1,bi,bj) = qdiag(i,1,idqls+L-1,bi,bj) +        do i = 1,im
882       .                                                  delqrnev(i,L)         indgath = (j-1)*im + i
883          qdiag(i,j,idqls+L-1,bi,bj) = qdiag(i,j,idqls+L-1,bi,bj) +
884         .                                delqrnev(indgath,L)
885          enddo
886        enddo        enddo
887        enddo        enddo
888        endif        endif
# Line 886  c ------------------- Line 903  c -------------------
903  c Convective Precipitation  c Convective Precipitation
904  c ------------------------  c ------------------------
905        if(iprecon.gt.0) then        if(iprecon.gt.0) then
906        do i = 1,im*jm        do j = 1,jm
907        qdiag(i,1,iprecon,bi,bj) = qdiag(i,1,iprecon,bi,bj) +        do i = 1,im
908       .                                         raincgath(i)*sday*tminv         indgath = (j-1)*im + i
909          qdiag(i,j,iprecon,bi,bj) = qdiag(i,j,iprecon,bi,bj) +
910         .                      raincgath(indgath)*sday*tminv
911          enddo
912        enddo        enddo
913        endif        endif
914    
# Line 1042  C ************************************** Line 1062  C **************************************
1062         nlwcld   = nlwcld   + 1         nlwcld   = nlwcld   + 1
1063         nswcld   = nswcld   + 1         nswcld   = nswcld   + 1
1064    
1065    #ifdef ALLOW_DIAGNOSTICS
1066           if( (bi.eq.1) .and. (bj.eq.1) ) then
1067         nmoistt  = nmoistt  + 1         nmoistt  = nmoistt  + 1
1068         nmoistq  = nmoistq  + 1         nmoistq  = nmoistq  + 1
1069         npreacc  = npreacc  + 1         npreacc  = npreacc  + 1
# Line 1052  C ************************************** Line 1074  C **************************************
1074    
1075         ndtls  = ndtls  + 1         ndtls  = ndtls  + 1
1076         ndqls  = ndqls  + 1         ndqls  = ndqls  + 1
1077           endif
1078    #endif
1079    
1080        RETURN        RETURN
1081        END        END
1082        SUBROUTINE RAS( NN, LEN, LENC, K, NLTOP, nlayr, DT        SUBROUTINE RAS( NN, LNG, LENC, K, NLTOP, nlayr, DT
1083       *,               UOI, ntracer, POI, QOI, PRS, PRJ, rnd, ncrnd       *,               UOI, ntracer, POI, QOI, PRS, PRJ, rnd, ncrnd
1084       *,               RAINS, CLN, CLF, cldmas, detrain       *,               RAINS, CLN, CLF, cldmas, detrain
1085       *,               cp,grav,rkappa,alhl,rhfrac,rasmax )       *,               cp,grav,rkappa,alhl,rhfrac,rasmax )
# Line 1068  C Line 1092  C
1092        implicit none        implicit none
1093    
1094  C Argument List  C Argument List
1095        integer nn,len,lenc,k,nltop,nlayr        integer nn,lng,lenc,k,nltop,nlayr
1096        integer ntracer        integer ntracer
1097        integer ncrnd        integer ncrnd
1098        real dt        _RL dt
1099        real UOI(len,nlayr,ntracer),   POI(len,K)        _RL UOI(lng,nlayr,ntracer),   POI(lng,K)
1100        real QOI(len,K), PRS(len,K+1), PRJ(len,K+1)        _RL QOI(lng,K), PRS(lng,K+1), PRJ(lng,K+1)
1101        real rnd(ncrnd)        _RL rnd(ncrnd)
1102        real RAINS(len,K), CLN(len,K), CLF(len,K)        _RL RAINS(lng,K), CLN(lng,K), CLF(lng,K)
1103        real cldmas(len,K), detrain(len,K)        _RL cldmas(lng,K), detrain(lng,K)
1104        real cp,grav,rkappa,alhl,rhfrac(len),rasmax        _RL cp,grav,rkappa,alhl,rhfrac(lng),rasmax
1105    
1106  C Local Variables  C Local Variables
1107        real TCU(len,K), QCU(len,K)        _RL TCU(lng,K), QCU(lng,K)
1108        real ucu(len,K,ntracer)        _RL ucu(lng,K,ntracer)
1109        real ALF(len,K), BET(len,K), GAM(len,K)        _RL ALF(lng,K), BET(lng,K), GAM(lng,K)
1110       *,         ETA(len,K), HOI(len,K)       *,         ETA(lng,K), HOI(lng,K)
1111       *,         PRH(len,K), PRI(len,K)       *,         PRH(lng,K), PRI(lng,K)
1112        real HST(len,K), QOL(len,K), GMH(len,K)        _RL HST(lng,K), QOL(lng,K), GMH(lng,K)
1113    
1114        real TX1(len), TX2(len), TX3(len), TX4(len), TX5(len)        _RL TX1(lng), TX2(lng), TX3(lng), TX4(lng), TX5(lng)
1115       *,         TX6(len), TX7(len), TX8(len), TX9(len)       *,         TX6(lng), TX7(lng), TX8(lng), TX9(lng)
1116       *,         TX11(len), TX12(len), TX13(len), TX14(len,ntracer)       *,         TX11(lng), TX12(lng), TX13(lng), TX14(lng,ntracer)
1117       *,         TX15(len)       *,         TX15(lng)
1118       *,         WFN(len)       *,         WFN(lng)
1119        integer IA1(len), IA2(len), IA3(len)        integer IA1(lng), IA2(lng), IA3(lng)
1120        real cloudn(len), pcu(len)        _RL cloudn(lng), pcu(lng)
1121    
1122        integer krmin,icm        integer krmin,icm
1123        real rknob, cmb2pa        _RL rknob, cmb2pa
1124        PARAMETER (KRMIN=01)        PARAMETER (KRMIN=01)
1125        PARAMETER (ICM=1000)        PARAMETER (ICM=1000)
1126        PARAMETER (CMB2PA=100.0)        PARAMETER (CMB2PA=100.0)
1127        PARAMETER (rknob = 10.)        PARAMETER (rknob = 10.)
1128    
1129        integer IC(ICM),   IRND(icm)        integer IC(ICM),   IRND(icm)
1130        real cmass(len,K)        _RL cmass(lng,K)
1131        LOGICAL SETRAS        LOGICAL SETRAS
1132    
1133        integer i,L,nc,ib,nt        integer i,L,nc,ib,nt
1134        integer km1,kp1,kprv,kcr,kfx,ncmx        integer km1,kp1,kprv,kcr,kfx,ncmx
1135        real p00, crtmsf, frac, rasblf        _RL p00, crtmsf, frac, rasblf
1136    
1137        do L = 1,k        do L = 1,k
1138        do I = 1,LENC        do I = 1,LENC
# Line 1162  C Line 1186  C
1186         ENDIF         ENDIF
1187         IB = IC(NC)         IB = IC(NC)
1188    
1189           print *,' Calling cloud for cloud ',nc,' det at ',ic(nc)
1190    
1191  c Initialize Cloud Fraction Array  c Initialize Cloud Fraction Array
1192  c -------------------------------  c -------------------------------
1193        do i = 1,lenc        do i = 1,lenc
1194        cloudn(i) = 0.0        cloudn(i) = 0.0
1195        enddo        enddo
1196    
1197         CALL CLOUD(nn,LEN, LENC, K, NLTOP, nlayr, IB, RASBLF,SETRAS,FRAC         CALL CLOUD(nn,lng, LENC, K, NLTOP, nlayr, IB, RASBLF,SETRAS,FRAC
1198       *,           CP,  ALHL, RKAPPA, GRAV, P00, CRTMSF       *,           CP,  ALHL, RKAPPA, GRAV, P00, CRTMSF
1199       *,           POI, QOI, UOI, Ntracer, PRS, PRJ       *,           POI, QOI, UOI, Ntracer, PRS, PRJ
1200       *,           PCU, CLOUDN, TCU, QCU, UCU, CMASS       *,           PCU, CLOUDN, TCU, QCU, UCU, CMASS
# Line 1244  c -------------------------------------- Line 1270  c --------------------------------------
1270        subroutine rndcloud (iras,nrnd,rnd,myid)        subroutine rndcloud (iras,nrnd,rnd,myid)
1271        implicit none        implicit none
1272        integer n,iras,nrnd,myid        integer n,iras,nrnd,myid
1273        real random_numbx        _RL random_numbx
1274        real rnd(nrnd)        _RL rnd(nrnd)
1275        integer irm        integer irm
1276        parameter (irm = 1000)        parameter (irm = 1000)
1277        real random(irm)        _RL random(irm)
1278        integer i,mcheck,numrand,iseed,index        integer i,mcheck,numrand,iseed,indx
1279        logical first        logical first
1280        data    first /.true./        data    first /.true./
1281        integer iras0        integer iras0
# Line 1260  c -------------------------------------- Line 1286  c --------------------------------------
1286         do i = 1,nrnd         do i = 1,nrnd
1287          rnd(i) = 0          rnd(i) = 0
1288         enddo         enddo
1289         if(first .and. myid.eq.0) print *,' NO RANDOM CLOUDS IN RAS '         if(first .and. myid.eq.1) print *,' NO RANDOM CLOUDS IN RAS '
1290         go to 100         go to 100
1291        endif        endif
1292    
# Line 1269  c -------------------------------------- Line 1295  c --------------------------------------
1295  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
1296  c ----------------------------------------------------------------------------  c ----------------------------------------------------------------------------
1297        if( first.and.(iras.gt.1) .or. iras.ne.iras0+1 )then        if( first.and.(iras.gt.1) .or. iras.ne.iras0+1 )then
1298         if( myid.eq.0 ) print *, 'Recreating Rand Numb Array in RNDCLOUD'         if( myid.eq.1 ) print *, 'Recreating Rand Numb Array in RNDCLOUD'
1299         if( myid.eq.0 ) print *, 'IRAS: ',iras,'  IRAS0: ',iras0         if( myid.eq.1 ) print *, 'IRAS: ',iras,'  IRAS0: ',iras0
1300         numrand = mod(iras,irm/nrnd) * nrnd         numrand = mod(iras,irm/nrnd) * nrnd
1301         iseed   = iras * nrnd - numrand         iseed   = iras * nrnd - numrand
1302         call random_seedx(iseed)         call random_seedx(iseed)
1303         do i = 1,irm         do i = 1,irm
1304          random(i) = random_numbx()          random(i) = random_numbx(iseed)
1305         enddo         enddo
1306         index = (iras-1)*nrnd         indx = (iras-1)*nrnd
1307    
1308  c Multiple Time In But have Used Up all 1000 numbers (MCHECK.EQ.0)  c Multiple Time In But have Used Up all 1000 numbers (MCHECK.EQ.0)
1309  c ----------------------------------------------------------------  c ----------------------------------------------------------------
# Line 1285  c -------------------------------------- Line 1311  c --------------------------------------
1311            iseed = (iras-1)*nrnd            iseed = (iras-1)*nrnd
1312            call random_seedx(iseed)            call random_seedx(iseed)
1313            do i = 1,irm            do i = 1,irm
1314             random(i) = random_numbx()             random(i) = random_numbx(iseed)
1315            enddo            enddo
1316            index = iseed            indx = iseed
1317    
1318  c Multiple Time In But have NOT Used Up all 1000 numbers (MCHECK.NE.0)  c Multiple Time In But have NOT Used Up all 1000 numbers (MCHECK.NE.0)
1319  c --------------------------------------------------------------------  c --------------------------------------------------------------------
1320        else        else
1321            index = (iras-1)*nrnd            indx = (iras-1)*nrnd
1322        endif        endif
1323    
1324            index = mod(index,irm)            indx = mod(indx,irm)
1325        if( index+nrnd.gt.1000 ) index=1000-nrnd        if( indx+nrnd.gt.1000 ) indx=1000-nrnd
1326    
1327        do n = 1,nrnd        do n = 1,nrnd
1328         rnd(n) = random(index+n)         rnd(n) = random(indx+n)
1329        enddo        enddo
1330    
1331   100  continue   100  continue
# Line 1307  c -------------------------------------- Line 1333  c --------------------------------------
1333        iras0 = iras        iras0 = iras
1334        return        return
1335        end        end
1336        function random_numbx()        function random_numbx(iseed)
1337        implicit none        implicit none
1338        real random_numbx        integer iseed
1339          real *8 seed,port_rand
1340          _RL random_numbx
1341        random_numbx = 0        random_numbx = 0
1342  #ifdef CRAY  #ifdef CRAY
1343        real ranf        _RL ranf
1344        random_numbx = ranf()        random_numbx = ranf()
1345  #endif  #else
1346  #ifdef SGI  #ifdef SGI
1347        real rand        _RL rand
1348        random_numbx = rand()        random_numbx = rand()
1349  #endif  #endif
1350          random_numbx = port_rand(seed)
1351    #endif
1352        return        return
1353        end        end
1354        subroutine random_seedx (iseed)        subroutine random_seedx (iseed)
# Line 1334  c -------------------------------------- Line 1364  c --------------------------------------
1364  #endif  #endif
1365        return        return
1366        end        end
1367        SUBROUTINE CLOUD(nn,LEN, LENC, K, NLTOP, nlayr, IC, RASALF        SUBROUTINE CLOUD(nn,lng, LENC, K, NLTOP, nlayr, IC, RASALF
1368       *,                 SETRAS, FRAC       *,                 SETRAS, FRAC
1369       *,                 CP,  ALHL, RKAP, GRAV, P00, CRTMSF       *,                 CP,  ALHL, RKAP, GRAV, P00, CRTMSF
1370       *,                 POI, QOI, UOI, Ntracer, PRS,  PRJ       *,                 POI, QOI, UOI, Ntracer, PRS,  PRJ
# Line 1376  C Line 1406  C
1406  C  Input:  C  Input:
1407  C  ------  C  ------
1408  C  C
1409  C     LEN     : The inner dimension of update and input arrays.  C     lng     : The inner dimension of update and input arrays.
1410  C  C
1411  C     LENC    : The run: the number of soundings processes in a single call.  C     LENC    : The run: the number of soundings processes in a single call.
1412  C               RAS works on the first LENC of the LEN soundings  C               RAS works on the first LENC of the lng soundings
1413  C               passed. This allows working on pieces of the world  C               passed. This allows working on pieces of the world
1414  C               say for multitasking, without declaring temporary arrays  C               say for multitasking, without declaring temporary arrays
1415  C               and copying the data to and from them.  This is an f77  C               and copying the data to and from them.  This is an f77
1416  C               version. An F90 version would have to allow more  C               version. An F90 version would have to allow more
1417  C               flexibility in the argument declarations.  Obviously  C               flexibility in the argument declarations.  Obviously
1418  C               (LENC<=LEN).    C               (LENC<=lng).  
1419  C  C
1420  C     K       : Number of vertical layers (increasing downwards).  C     K       : Number of vertical layers (increasing downwards).
1421  C               Need not be the same as the number of layers in the  C               Need not be the same as the number of layers in the
# Line 1416  C     CRTMSF  : Critical value of mass f Line 1446  C     CRTMSF  : Critical value of mass f
1446  C               the detrainment layer of that cloud-type is assumed.  C               the detrainment layer of that cloud-type is assumed.
1447  C               Affects only cloudiness calculation.  C               Affects only cloudiness calculation.
1448  C  C
1449  C     POI     : 2D array of dimension (LEN,K) containing potential  C     POI     : 2D array of dimension (lng,K) containing potential
1450  C               temperature. Updated but not initialized by RAS.  C               temperature. Updated but not initialized by RAS.
1451  C  C
1452  C     QOI     : 2D array of dimension (LEN,K) containing specific  C     QOI     : 2D array of dimension (lng,K) containing specific
1453  C               humidity. Updated but not initialized by RAS.  C               humidity. Updated but not initialized by RAS.
1454  C  C
1455  C     UOI     : 3D array of dimension (LEN,K,NTRACER) containing tracers  C     UOI     : 3D array of dimension (lng,K,NTRACER) containing tracers
1456  C               Updated but not initialized by RAS.  C               Updated but not initialized by RAS.
1457  C  C
1458  C     PRS     : 2D array of dimension (LEN,K+1) containing pressure  C     PRS     : 2D array of dimension (lng,K+1) containing pressure
1459  C               in hPa at the interfaces of K-layers from top of the  C               in hPa at the interfaces of K-layers from top of the
1460  C               atmosphere to the bottom. Not modified.  C               atmosphere to the bottom. Not modified.
1461  C  C
1462  C     PRJ     : 2D array of dimension (LEN,K+1) containing (PRS/P00) **  C     PRJ     : 2D array of dimension (lng,K+1) containing (PRS/P00) **
1463  C               RKAP.  i.e. Exner function at layer edges. Not modified.  C               RKAP.  i.e. Exner function at layer edges. Not modified.
1464  C  C
1465  C     rhfrac  : 1D array of dimension (LEN) containing a rel.hum. scaling  C     rhfrac  : 1D array of dimension (lng) containing a rel.hum. scaling
1466  C               fraction. Not modified.  C               fraction. Not modified.
1467  C  C
1468  C  Output:  C  Output:
1469  C  -------  C  -------
1470  C  C
1471  C     PCU     : 1D array of length LEN containing accumulated  C     PCU     : 1D array of length lng containing accumulated
1472  C               precipitation in mm/sec.  C               precipitation in mm/sec.
1473  C  C
1474  C     CLN     : 2D array of dimension (LEN,K) containing cloudiness  C     CLN     : 2D array of dimension (lng,K) containing cloudiness
1475  C               Note:  CLN is bumped but NOT initialized  C               Note:  CLN is bumped but NOT initialized
1476  C  C
1477  C     TCU     : 2D array of dimension (LEN,K) containing accumulated  C     TCU     : 2D array of dimension (lng,K) containing accumulated
1478  C               convective heating (K/sec).  C               convective heating (K/sec).
1479  C  C
1480  C     QCU     : 2D array of dimension (LEN,K) containing accumulated  C     QCU     : 2D array of dimension (lng,K) containing accumulated
1481  C               convective drying (kg/kg/sec).  C               convective drying (kg/kg/sec).
1482  C  C
1483  C     CMASS   : 2D array of dimension (LEN,K) containing the  C     CMASS   : 2D array of dimension (lng,K) containing the
1484  C               cloud mass flux (kg/sec). Filled from cloud top  C               cloud mass flux (kg/sec). Filled from cloud top
1485  C               to base.  C               to base.
1486  C  C
# Line 1470  C Line 1500  C
1500  C************************************************************************  C************************************************************************
1501        implicit none        implicit none
1502  C Argument List declarations  C Argument List declarations
1503        integer nn,LEN,LENC,K,NLTOP,nlayr,ic,ntracer        integer nn,lng,LENC,K,NLTOP,nlayr,ic,ntracer
1504        real rasalf        _RL rasalf
1505        LOGICAL SETRAS        LOGICAL SETRAS
1506        real frac, cp,  alhl, rkap, grav, p00, crtmsf        _RL frac, cp,  alhl, rkap, grav, p00, crtmsf
1507        real POI(LEN,K),QOI(LEN,K),PRS(LEN,K+1),PRJ(LEN,K+1)        _RL POI(lng,K),QOI(lng,K),PRS(lng,K+1),PRJ(lng,K+1)
1508        real uoi(len,nlayr,ntracer)        _RL uoi(lng,nlayr,ntracer)
1509        real PCU(LENC), CLN(LEN)        _RL PCU(LENC), CLN(lng)
1510        real TCU(LEN,K),  QCU(LEN,K),  ucu(len,k,ntracer), CMASS(LEN,K)        _RL TCU(lng,K),  QCU(lng,K),  ucu(lng,k,ntracer), CMASS(lng,K)
1511        real ALF(LEN,K), BET(LEN,K),  GAM(LEN,K), PRH(LEN,K), PRI(LEN,K)        _RL ALF(lng,K), BET(lng,K),  GAM(lng,K), PRH(lng,K), PRI(lng,K)
1512        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)
1513        real GMH(LENC,K)        _RL GMH(LENC,K)
1514        real TX1(LENC), TX2(LENC), TX3(LENC), TX4(LENC)        _RL TX1(LENC), TX2(LENC), TX3(LENC), TX4(LENC)
1515        real TX5(LENC), TX6(LENC), TX7(LENC), TX8(LENC)        _RL TX5(LENC), TX6(LENC), TX7(LENC), TX8(LENC)
1516        real ALM(LENC), WFN(LENC), AKM(LENC), QS1(LENC)        _RL ALM(LENC), WFN(LENC), AKM(LENC), QS1(LENC)
1517        real WLQ(LENC), CLF(LENC)        _RL WLQ(LENC), CLF(LENC)
1518        real uht(len,ntracer)        _RL uht(lng,ntracer)
1519        integer IA(LENC), I1(LENC),I2(LENC)        integer IA(LENC), I1(LENC),I2(LENC)
1520        real      rhfrac(len)        _RL      rhfrac(lng)
1521    
1522  C Local Variables  C Local Variables
1523        real daylen,half,one,zero,cmb2pa,rhmax        _RL daylen,half,one,zero,cmb2pa,rhmax
1524        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)
1525        PARAMETER (CMB2PA=100.0)        PARAMETER (CMB2PA=100.0)
1526        PARAMETER (RHMAX=0.9999)        PARAMETER (RHMAX=0.9999)
1527        real rkapp1,onebcp,albcp,onebg,cpbg,twobal        _RL rkapp1,onebcp,albcp,onebg,cpbg,twobal
1528  C  C
1529        integer nt,km1,ic1,i,L,len1,len2,isav,len11,ii        integer nt,km1,ic1,i,L,len1,len2,isav,len11,ii
1530        integer lena,lena1,lenb,tem,tem1        integer lena,lena1,lenb
1531          _RL tem,tem1
1532    
1533  c Explicit Inline Directives  c Explicit Inline Directives
1534  c --------------------------  c --------------------------
# Line 1546  C Line 1577  C
1577  C  C
1578  C  C
1579        DO 10 L=1,K        DO 10 L=1,K
1580        DO 10 I=1,LEN        DO 10 I=1,lng
1581        TCU(I,L) = 0.0        TCU(I,L) = 0.0
1582        QCU(I,L) = 0.0        QCU(I,L) = 0.0
1583        CMASS(I,L) = 0.0        CMASS(I,L) = 0.0
# Line 2080  C Line 2111  C
2111    
2112        RETURN        RETURN
2113        END        END
2114        SUBROUTINE RNCL(LEN, PL, RNO, CLF)        SUBROUTINE RNCL(lng, PL, RNO, CLF)
2115  C  C
2116  C*********************************************************************  C*********************************************************************
2117  C********************** Relaxed Arakawa-Schubert *********************  C********************** Relaxed Arakawa-Schubert *********************
# Line 2089  C**************************** 23 July 19 Line 2120  C**************************** 23 July 19
2120  C*********************************************************************  C*********************************************************************
2121        implicit none        implicit none
2122  C Argument List declarations  C Argument List declarations
2123        integer len        integer lng
2124        real PL(LEN),  RNO(LEN), CLF(LEN)        _RL PL(lng),  RNO(lng), CLF(lng)
2125    
2126  C Local Variables  C Local Variables
2127        real p5,p8,pt8,pt2,pfac,p4,p6,p7,p9,cucld,cfac        _RL p5,p8,pt8,pt2,pfac,p4,p6,p7,p9,cucld,cfac
2128        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)
2129        PARAMETER (PFAC=PT2/(P8-P5))        PARAMETER (PFAC=PT2/(P8-P5))
2130        PARAMETER (P4=400.0,    P6=401.0)        PARAMETER (P4=400.0,    P6=401.0)
# Line 2102  C Local Variables Line 2133  C Local Variables
2133    
2134        integer i        integer i
2135  C  C
2136        DO 10 I=1,LEN        DO 10 I=1,lng
2137                             rno(i) = 1.0                             rno(i) = 1.0
2138  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)) )
2139    
# Line 2129  CARIES Line 2160  CARIES
2160  C  C
2161        RETURN        RETURN
2162        END        END
2163        SUBROUTINE ACRITN ( LEN,PL,PLB,ACR )        SUBROUTINE ACRITN ( lng,PL,PLB,ACR )
2164    
2165  C*********************************************************************  C*********************************************************************
2166  C********************** Relaxed Arakawa-Schubert *********************  C********************** Relaxed Arakawa-Schubert *********************
# Line 2142  C**** Line 2173  C****
2173  C*********************************************************************  C*********************************************************************
2174        implicit none        implicit none
2175  C Argument List declarations  C Argument List declarations
2176        integer len        integer lng
2177        real PL(LEN), PLB(LEN), ACR(LEN)        _RL PL(lng), PLB(lng), ACR(lng)
2178    
2179  C Local variables  C Local variables
2180        integer lma        integer lma
2181        parameter  (lma=18)        parameter  (lma=18)
2182        real p(lma)        _RL p(lma)
2183        real a(lma)        _RL a(lma)
2184        integer i,L        integer i,L
2185        real temp        _RL temp
2186    
2187        data p  / 93.81, 111.65, 133.46, 157.80, 186.51,        data p  / 93.81, 111.65, 133.46, 157.80, 186.51,
2188       .         219.88, 257.40, 301.21, 352.49, 409.76,       .         219.88, 257.40, 301.21, 352.49, 409.76,
# Line 2165  C Local variables Line 2196  C Local variables
2196    
2197    
2198        do L=1,lma-1        do L=1,lma-1
2199        do i=1,len        do i=1,lng
2200           if( pl(i).ge.p(L)   .and.           if( pl(i).ge.p(L)   .and.
2201       .       pl(i).le.p(L+1)) then       .       pl(i).le.p(L+1)) then
2202           temp = ( pl(i)-p(L) )/( p(L+1)-p(L) )           temp = ( pl(i)-p(L) )/( p(L+1)-p(L) )
# Line 2174  C Local variables Line 2205  C Local variables
2205        enddo        enddo
2206        enddo        enddo
2207    
2208        do i=1,len        do i=1,lng
2209        if( pl(i).lt.p(1)   ) acr(i) = a(1)        if( pl(i).lt.p(1)   ) acr(i) = a(1)
2210        if( pl(i).gt.p(lma) ) acr(i) = a(lma)        if( pl(i).gt.p(lma) ) acr(i) = a(lma)
2211        enddo        enddo
2212    
2213        do i=1,len        do i=1,lng
2214        acr(i) = acr(i) * (plb(i)-pl(i))        acr(i) = acr(i) * (plb(i)-pl(i))
2215        enddo        enddo
2216    
# Line 2192  C Local variables Line 2223  C Local variables
2223        implicit none        implicit none
2224  C Argument List declarations  C Argument List declarations
2225        integer nn,irun,nlay        integer nn,irun,nlay
2226        real TL(IRUN,NLAY),QL(IRUN,NLAY),RAIN(IRUN,NLAY),        _RL TL(IRUN,NLAY),QL(IRUN,NLAY),RAIN(IRUN,NLAY),
2227       . PL(IRUN,NLAY),CLFRAC(IRUN,NLAY),SP(IRUN),TEMP1(IRUN,NLAY),       . PL(IRUN,NLAY),CLFRAC(IRUN,NLAY),SP(IRUN),TEMP1(IRUN,NLAY),
2228       . TEMP2(IRUN,NLAY),PLKE(IRUN,NLAY+1),       . TEMP2(IRUN,NLAY),PLKE(IRUN,NLAY+1),
2229       . 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),
2230       . TEMP3(IRUN,NLAY)       . TEMP3(IRUN,NLAY)
2231        integer ITMP1(IRUN,NLAY),ITMP2(IRUN,NLAY)        integer ITMP1(IRUN,NLAY),ITMP2(IRUN,NLAY)
2232        real CLSBTH(IRUN,NLAY)        _RL CLSBTH(IRUN,NLAY)
2233        real tmscl,tmfrc,cp,gravity,alhl,gamfac,offset,alpha        _RL tmscl,tmfrc,cp,gravity,alhl,gamfac,offset,alpha
2234        real cldlz(irun,nlay)        _RL cldlz(irun,nlay)
2235        real rhcrit(irun,nlay)        _RL rhcrit(irun,nlay)
2236  C  C
2237  C Local Variables  C Local Variables
2238        real zm1p04,zero,two89,zp44,zp01,half,zp578,one,thousand,z3600        _RL zm1p04,zero,two89,zp44,zp01,half,zp578,one,thousand,z3600
2239        real zp1,zp001        _RL zp1,zp001
2240        PARAMETER (ZM1P04 = -1.04E-4 )        PARAMETER (ZM1P04 = -1.04E-4 )
2241        PARAMETER (ZERO = 0.)        PARAMETER (ZERO = 0.)
2242        PARAMETER (TWO89= 2.89E-5)        PARAMETER (TWO89= 2.89E-5)
# Line 2219  C Local Variables Line 2250  C Local Variables
2250        PARAMETER ( THOUSAND = 1000.)        PARAMETER ( THOUSAND = 1000.)
2251        PARAMETER ( Z3600 = 3600.)        PARAMETER ( Z3600 = 3600.)
2252  C  C
2253        real EVP9(IRUN,NLAY)        _RL EVP9(IRUN,NLAY)
2254        real water(irun),crystal(irun)        _RL water(irun),crystal(irun)
2255        real watevap(irun),iceevap(irun)        _RL watevap(irun),iceevap(irun)
2256        real fracwat,fracice, tice,rh,fact,dum        _RL fracwat,fracice, tice,rh,fact,dum
2257        real rainmax(irun)        _RL rainmax(irun)
2258        real getcon,rphf,elocp,cpog,relax        _RL getcon,rphf,elocp,cpog,relax
2259        real exparg,arearat,rpow        _RL exparg,arearat,rpow
2260    
2261        integer i,L,n,nlaym1,irnlay,irnlm1        integer i,L,n,nlaym1,irnlay,irnlm1
2262    
# Line 2433  C*************************************** Line 2464  C***************************************
2464        implicit none        implicit none
2465        integer  irun,irise        integer  irun,irise
2466    
2467        real   th(irun,irise)        _RL   th(irun,irise)
2468        real    q(irun,irise)        _RL    q(irun,irise)
2469        real  plk(irun,irise)        _RL  plk(irun,irise)
2470        real   pl(irun,irise)        _RL   pl(irun,irise)
2471        real plke(irun,irise+1)        _RL plke(irun,irise+1)
2472    
2473        real  cloud(irun,irise)        _RL  cloud(irun,irise)
2474        real cldwat(irun,irise)        _RL cldwat(irun,irise)
2475        real     qs(irun,irise)        _RL     qs(irun,irise)
2476    
2477        real cp, alhl, getcon, akap        _RL cp, alhl, getcon, akap
2478        real ratio, temp, elocp        _RL ratio, temp, elocp
2479        real rhcrit,rh,dum        _RL rhcrit,rh,dum
2480        integer i,L        integer i,L
2481    
2482        real rhc(irun,irise)        _RL rhc(irun,irise)
2483        real offset,alpha        _RL offset,alpha
2484    
2485  c Explicit Inline Directives  c Explicit Inline Directives
2486  c --------------------------  c --------------------------
# Line 2495  c -------------------------------------- Line 2526  c --------------------------------------
2526        subroutine ctei ( th,q,cldfrc,cldwat,pl,plk,plke,im,lm )        subroutine ctei ( th,q,cldfrc,cldwat,pl,plk,plke,im,lm )
2527        implicit none        implicit none
2528        integer im,lm        integer im,lm
2529        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)
2530        real plk(im,lm),pl(im,lm),cldfrc(im,lm)        _RL plk(im,lm),pl(im,lm),cldfrc(im,lm)
2531        integer i,L        integer i,L
2532        real    getcon,cp,alhl,elocp,cpoel,t,p,s,qs,dqsdt,dq        _RL    getcon,cp,alhl,elocp,cpoel,t,p,s,qs,dqsdt,dq
2533        real    k,krd,kmm,f        _RL    k,krd,kmm,f
2534    
2535        cp     = getcon('CP')        cp     = getcon('CP')
2536        alhl   = getcon('LATENT HEAT COND')        alhl   = getcon('LATENT HEAT COND')
# Line 2536  c -------------------------------------- Line 2567  c --------------------------------------
2567        subroutine back2grd(gathered,indeces,scattered,irun)        subroutine back2grd(gathered,indeces,scattered,irun)
2568        implicit none        implicit none
2569        integer i,irun,indeces(irun)        integer i,irun,indeces(irun)
2570        real gathered(irun),scattered(irun)        _RL gathered(irun),scattered(irun)
2571        real temp(irun)        _RL temp(irun)
2572        do i = 1,irun        do i = 1,irun
2573         temp(indeces(i)) = gathered(i)         temp(indeces(i)) = gathered(i)
2574        enddo        enddo
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.16
  ViewVC Help
Powered by ViewVC 1.1.22