/[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.16 by molod, Tue Aug 10 15:13:47 2004 UTC revision 1.24 by molod, Sat Dec 11 00:34:24 2004 UTC
# Line 4  C $Name$ Line 4  C $Name$
4  #include "FIZHI_OPTIONS.h"  #include "FIZHI_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,uz,vz,tz,qz,bi,bj,ntracerin,ptracer,
8       .   qqz,dumoist,dvmoist,dtmoist,dqmoist,       .   qqz,dumoist,dvmoist,dtmoist,dqmoist,cumfric,
9       .   im,jm,lm,ptop,       .   im,jm,lm,ptop,
10       .   iras,rainlsp,rainconv,snowfall,       .   iras,rainlsp,rainconv,snowfall,
11       .   nswcld,cldtot_sw,cldras_sw,cldlsp_sw,nswlz,swlz,       .   nswcld,cldtot_sw,cldras_sw,cldlsp_sw,nswlz,swlz,
# Line 24  c Input Variables Line 24  c Input Variables
24  c ---------------  c ---------------
25        integer im,jm,lm        integer im,jm,lm
26        integer ndmoist,istrip,npcs        integer ndmoist,istrip,npcs
27        integer bi,bj,ntracer,ptracer                integer bi,bj,ntracerin,ptracer        
28        integer lowlevel,midlevel,nltop,nsubmin,nsubmax,Lup        integer lowlevel,midlevel,nltop,nsubmin,nsubmax,Lup
29        _RL 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        _RL pkht(im,jm,lm+1),pkl(im,jm,lm)        _RL pkht(im,jm,lm+1),pkl(im,jm,lm)
31        _RL tz(im,jm,lm),qz(im,jm,lm,ntracer)              _RL tz(im,jm,lm),qz(im,jm,lm,ntracerin)      
32          _RL uz(im,jm,lm),vz(im,jm,lm)      
33        _RL qqz(im,jm,lm)        _RL qqz(im,jm,lm)
34        _RL dumoist(im,jm,lm),dvmoist(im,jm,lm)        _RL dumoist(im,jm,lm),dvmoist(im,jm,lm)
35        _RL dtmoist(im,jm,lm),dqmoist(im,jm,lm,ntracer)        _RL dtmoist(im,jm,lm),dqmoist(im,jm,lm,ntracerin)
36          logical cumfric
37        _RL ptop        _RL ptop
38        integer iras        integer iras
39        _RL rainlsp(im,jm),rainconv(im,jm),snowfall(im,jm)        _RL rainlsp(im,jm),rainconv(im,jm),snowfall(im,jm)
# Line 88  c -------------------------------------- Line 90  c --------------------------------------
90        _RL    tmpgather(im*jm,lm)        _RL    tmpgather(im*jm,lm)
91        _RL   deltgather(im*jm,lm)        _RL   deltgather(im*jm,lm)
92        _RL   delqgather(im*jm,lm)        _RL   delqgather(im*jm,lm)
93        _RL      ugather(im*jm,lm,ntracer)        _RL      ugather(im*jm,lm,ntracerin+2-ptracer)
94        _RL   delugather(im*jm,lm,ntracer)        _RL   delugather(im*jm,lm,ntracerin+2-ptracer)
95        _RL     deltrnev(im*jm,lm)        _RL     deltrnev(im*jm,lm)
96        _RL     delqrnev(im*jm,lm)        _RL     delqrnev(im*jm,lm)
97    
# Line 101  c Stripped Arrays Line 103  c Stripped Arrays
103  c ---------------  c ---------------
104        _RL saveth (istrip,lm)        _RL saveth (istrip,lm)
105        _RL saveq  (istrip,lm)        _RL saveq  (istrip,lm)
106        _RL saveu  (istrip,lm,ntracer)        _RL saveu  (istrip,lm,ntracerin+2-ptracer)
107        _RL usubcl (istrip,   ntracer)        _RL usubcl (istrip,   ntracerin+2-ptracer)
108    
109        _RL     ple(istrip,lm+1)        _RL     ple(istrip,lm+1)
110        _RL      dp(istrip,lm)        _RL      dp(istrip,lm)
# Line 111  c --------------- Line 113  c ---------------
113        _RL    PLKE(ISTRIP,lm+1)        _RL    PLKE(ISTRIP,lm+1)
114        _RL      TH(ISTRIP,lm)  ,CVTH(ISTRIP,lm)        _RL      TH(ISTRIP,lm)  ,CVTH(ISTRIP,lm)
115        _RL   CVQ(ISTRIP,lm)        _RL   CVQ(ISTRIP,lm)
116        _RL      UL(ISTRIP,lm,ntracer)        _RL      UL(ISTRIP,lm,ntracerin+2-ptracer)
117        _RL     cvu(istrip,lm,ntracer)        _RL     cvu(istrip,lm,ntracerin+2-ptracer)
118        _RL  CLMAXO(ISTRIP,lm),CLBOTH(ISTRIP,lm)        _RL  CLMAXO(ISTRIP,lm),CLBOTH(ISTRIP,lm)
119        _RL  CLSBTH(ISTRIP,lm)        _RL  CLSBTH(ISTRIP,lm)
120        _RL    TMP1(ISTRIP,lm),  TMP2(ISTRIP,lm)        _RL    TMP1(ISTRIP,lm),  TMP2(ISTRIP,lm)
# Line 144  c --------------- Line 146  c ---------------
146        _RL tmstp,tminv,sday,grav,alhl,cp,elocp,gamfac        _RL tmstp,tminv,sday,grav,alhl,cp,elocp,gamfac
147        _RL rkappa,p0kappa,p0kinv,ptopkap,pcheck        _RL rkappa,p0kappa,p0kinv,ptopkap,pcheck
148        _RL tice,getcon,pi        _RL tice,getcon,pi
149          integer ntracer,ntracedim, ntracex
150    
151  C **********************************************************************  C **********************************************************************
152  C ****                     INITIALIZATION                           ****  C ****                     INITIALIZATION                           ****
153  C **********************************************************************  C **********************************************************************
154    
155    C Add U and V components to tracer array for cumulus friction
156    
157          if(cumfric) then
158           ntracer = ntracerin + 2
159          else
160           ntracer = ntracerin
161          endif
162          ntracedim= max(ntracer-ptracer,1)
163          ntracex= ntracer-ptracer
164        IMSTP  = nsecf(NDMOIST)        IMSTP  = nsecf(NDMOIST)
165        TMSTP  = FLOAT(IMSTP)        TMSTP  = FLOAT(IMSTP)
166        TMINV  = 1. /  TMSTP        TMINV  = 1. /  TMSTP
# Line 186  c Determine Total number of Random Cloud Line 198  c Determine Total number of Random Cloud
198  c ---------------------------------------------  c ---------------------------------------------
199        ncrnd = (lm-nltop+1)/2        ncrnd = (lm-nltop+1)/2
200    
201        if(first .and. myid.eq.1) then        if(first .and. myid.eq.1 .and. bi.eq.1 ) then
202         print *         print *
203         print *,'Top Level Allowed for Convection : ',nltop         print *,'Top Level Allowed for Convection : ',nltop
204         print *,'          Highest Sub-Cloud Level: ',nsubmax         print *,'          Highest Sub-Cloud Level: ',nsubmax
# Line 260  c -------------------------------------- Line 272  c --------------------------------------
272           dpgather(indx,L) = dpres(pblindex(indx),1,L)           dpgather(indx,L) = dpres(pblindex(indx),1,L)
273         enddo         enddo
274        enddo        enddo
275        do nt = 1,ntracer-ptracer  C General Tracers
276    C----------------
277          do nt = 1,ntracerin-ptracer
278        do L = 1,lm        do L = 1,lm
279         do indx = 1,im*jm         do indx = 1,im*jm
280          ugather(indx,L,nt) = qz(pblindex(indx),1,L,nt+ptracer)          ugather(indx,L,nt) = qz(pblindex(indx),1,L,nt+ptracer)
# Line 268  c -------------------------------------- Line 282  c --------------------------------------
282        enddo        enddo
283        enddo        enddo
284    
285          if(cumfric) then
286    C Cumulus Friction - load u and v wind components into tracer array
287    C------------------------------------------------------------------
288          do L = 1,lm
289           do indx = 1,im*jm
290            ugather(indx,L,ntracerin-ptracer+1) = uz(pblindex(indx),1,L)
291            ugather(indx,L,ntracerin-ptracer+2) = vz(pblindex(indx),1,L)
292           enddo
293          enddo
294    
295          endif
296    
297  c bump the counter for number of calls to convection  c bump the counter for number of calls to convection
298  c --------------------------------------------------  c --------------------------------------------------
299                          iras = iras + 1                          iras = iras + 1
# Line 280  c -------------------------------------- Line 306  c --------------------------------------
306        do l=1,lm        do l=1,lm
307        do j=1,jm        do j=1,jm
308        do i=1,im        do i=1,im
309          dumoist(i,j,l) = 0.
310          dvmoist(i,j,l) = 0.
311        dtmoist(i,j,l) = 0.        dtmoist(i,j,l) = 0.
312          do nt = 1,ntracer          do nt = 1,ntracerin
313          dqmoist(i,j,l,nt) = 0.          dqmoist(i,j,l,nt) = 0.
314          enddo          enddo
315        enddo        enddo
# Line 309  C ************************************** Line 337  C **************************************
337         CALL STRINT( levgather, pbl     ,im*jm,ISTRIP,1 ,NN )         CALL STRINT( levgather, pbl     ,im*jm,ISTRIP,1 ,NN )
338    
339         do nt = 1,ntracer-ptracer         do nt = 1,ntracer-ptracer
340         call strip ( ugather(1,1,nt), ul(1,1,nt),im*jm,istrip,lm,nn )          call strip ( ugather(1,1,nt), ul(1,1,nt),im*jm,istrip,lm,nn )
341         enddo         enddo
342    
343  C **********************************************************************  C **********************************************************************
# Line 342  C ************************************** Line 370  C **************************************
370         endif         endif
371        enddo        enddo
372    
   
373  C Initiate a do-loop around RAS for the number of different  C Initiate a do-loop around RAS for the number of different
374  C    sub-cloud layer depths in this strip  C    sub-cloud layer depths in this strip
375  C --If all subcloud depths are the same, execute loop once  C --If all subcloud depths are the same, execute loop once
# Line 478  c -------------------------------------- Line 505  c --------------------------------------
505        enddo        enddo
506    
507        CALL RAS ( NN,istrip,nindeces(nsubcl),NLRAS,NLTOP,lm,TMSTP        CALL RAS ( NN,istrip,nindeces(nsubcl),NLRAS,NLTOP,lm,TMSTP
508       1, UL(num,1,1),ntracer-ptracer,TH(num,NLTOP),SHL(num,NLTOP)       1, UL(num,1,1),ntracedim,ntracex,TH(num,NLTOP),SHL(num,NLTOP)
509       2, TMP4(num,NLTOP), TMP5(num,NLTOP),rnd, ncrnd, PCPEN(num,NLTOP)       2, TMP4(num,NLTOP), TMP5(num,NLTOP),rnd, ncrnd, PCPEN(num,NLTOP)
510       3, CLBOTH(num,NLTOP), CLFRAC(num,NLTOP)       3, CLBOTH(num,NLTOP), CLFRAC(num,NLTOP)
511       4, cldmas(num,nltop), detrain(num,nltop)       4, cldmas(num,nltop), detrain(num,nltop)
# Line 762  c ------------ Line 789  c ------------
789       .                                              cldsr(1,1,L),im*jm)       .                                              cldsr(1,1,L),im*jm)
790        enddo        enddo
791    
792  c Tracers  c General Tracers
793  c -------  c ---------------
794        do nt = 1,ntracer-ptracer        do nt = 1,ntracerin-ptracer
795         do L = 1,lm         do L = 1,lm
796         call back2grd (delugather(1,L,nt),pblindex,         call back2grd (delugather(1,L,nt),pblindex,
797       .                                 dqmoist(1,1,L,ptracer+nt),im*jm)       .                                 dqmoist(1,1,L,ptracer+nt),im*jm)
798         enddo         enddo
799        enddo        enddo
800    
801          if(cumfric) then
802    
803    c U and V for cumulus friction
804    c ----------------------------
805          do L = 1,lm
806           call back2grd (delugather(1,L,ntracerin-ptracer+1),pblindex,
807         .                                 dumoist(1,1,L),im*jm)
808           call back2grd (delugather(1,L,ntracerin-ptracer+2),pblindex,
809         .                                 dvmoist(1,1,L),im*jm)
810          enddo
811    
812    C Remove pi-weighting for u and v tendencies
813          do j = 1,jm
814          do i = 1,im
815           tmpimjm(i,j) = 1./pz(i,j)
816          enddo
817          enddo
818          do L = 1,lm
819          do j = 1,jm
820          do i = 1,im
821           dumoist(i,j,L) = dumoist(i,j,L) * tmpimjm(i,j)
822           dvmoist(i,j,L) = dvmoist(i,j,L) * tmpimjm(i,j)
823          enddo
824          enddo
825          enddo
826    
827    
828          endif
829    
830  C **********************************************************************  C **********************************************************************
831  C                          BUMP DIAGNOSTICS  C                          BUMP DIAGNOSTICS
# Line 831  c ------------------------------- Line 886  c -------------------------------
886        enddo        enddo
887        endif        endif
888    
889    c Moist Processes Change in U-Momentum (Cumulus Friction)
890    c ------------------------------------------------------
891          if(iudiag1.gt.0) then
892          do L = 1,lm
893          do j = 1,jm
894          do i = 1,im
895           indgath = (j-1)*im + i
896          qdiag(i,j,iudiag1+L-1,bi,bj) = qdiag(i,j,iudiag1+L-1,bi,bj) +
897         .    dumoist(i,j,L)*sday
898          enddo
899          enddo
900          enddo
901          endif
902    
903    c Moist Processes Change in V-Momentum (Cumulus Friction)
904    c ------------------------------------------------------
905          if(iudiag2.gt.0) then
906          do L = 1,lm
907          do j = 1,jm
908          do i = 1,im
909           indgath = (j-1)*im + i
910          qdiag(i,j,iudiag2+L-1,bi,bj) = qdiag(i,j,iudiag2+L-1,bi,bj) +
911         .    dvmoist(i,j,L)*sday
912          enddo
913          enddo
914          enddo
915          endif
916    
917  c Cloud Mass Flux  c Cloud Mass Flux
918  c ---------------  c ---------------
919        if(icldmas.gt.0) then        if(icldmas.gt.0) then
# Line 1011  c -------------------------------------- Line 1094  c --------------------------------------
1094        enddo        enddo
1095        enddo        enddo
1096    
1097  c Compute Instantanious Total 2-D Cloud Fraction  c Compute Instantaneous Total 2-D Cloud Fraction
1098  c ----------------------------------------------  c ----------------------------------------------
1099        do j = 1,jm        do j = 1,jm
1100        do i = 1,im        do i = 1,im
# Line 1074  C ************************************** Line 1157  C **************************************
1157    
1158         ndtls  = ndtls  + 1         ndtls  = ndtls  + 1
1159         ndqls  = ndqls  + 1         ndqls  = ndqls  + 1
1160    
1161           nudiag1  = nudiag1  + 1
1162           nudiag2  = nudiag2  + 1
1163    
1164         endif         endif
1165  #endif  #endif
1166    
1167        RETURN        RETURN
1168        END        END
1169        SUBROUTINE RAS( NN, LNG, LENC, K, NLTOP, nlayr, DT        SUBROUTINE RAS( NN, LNG, LENC, K, NLTOP, nlayr, DT
1170       *,               UOI, ntracer, POI, QOI, PRS, PRJ, rnd, ncrnd       *,      UOI, ntracedim, ntracer, POI, QOI, PRS, PRJ, rnd, ncrnd
1171       *,               RAINS, CLN, CLF, cldmas, detrain       *,      RAINS, CLN, CLF, cldmas, detrain
1172       *,               cp,grav,rkappa,alhl,rhfrac,rasmax )       *,      cp,grav,rkappa,alhl,rhfrac,rasmax )
1173  C  C
1174  C*********************************************************************  C*********************************************************************
1175  C********************* SUBROUTINE  RAS   *****************************  C********************* SUBROUTINE  RAS   *****************************
# Line 1093  C Line 1180  C
1180    
1181  C Argument List  C Argument List
1182        integer nn,lng,lenc,k,nltop,nlayr        integer nn,lng,lenc,k,nltop,nlayr
1183        integer ntracer        integer ntracedim, ntracer
1184        integer ncrnd        integer ncrnd
1185        _RL dt        _RL dt
1186        _RL UOI(lng,nlayr,ntracer),   POI(lng,K)        _RL UOI(lng,nlayr,ntracedim),   POI(lng,K)
1187        _RL QOI(lng,K), PRS(lng,K+1), PRJ(lng,K+1)        _RL QOI(lng,K), PRS(lng,K+1), PRJ(lng,K+1)
1188        _RL rnd(ncrnd)        _RL rnd(ncrnd)
1189        _RL RAINS(lng,K), CLN(lng,K), CLF(lng,K)        _RL RAINS(lng,K), CLN(lng,K), CLF(lng,K)
# Line 1105  C Argument List Line 1192  C Argument List
1192    
1193  C Local Variables  C Local Variables
1194        _RL TCU(lng,K), QCU(lng,K)        _RL TCU(lng,K), QCU(lng,K)
1195        _RL ucu(lng,K,ntracer)        _RL ucu(lng,K,ntracedim)
1196        _RL ALF(lng,K), BET(lng,K), GAM(lng,K)        _RL ALF(lng,K), BET(lng,K), GAM(lng,K)
1197       *,         ETA(lng,K), HOI(lng,K)       *,         ETA(lng,K), HOI(lng,K)
1198       *,         PRH(lng,K), PRI(lng,K)       *,         PRH(lng,K), PRI(lng,K)
# Line 1113  C Local Variables Line 1200  C Local Variables
1200    
1201        _RL TX1(lng), TX2(lng), TX3(lng), TX4(lng), TX5(lng)        _RL TX1(lng), TX2(lng), TX3(lng), TX4(lng), TX5(lng)
1202       *,         TX6(lng), TX7(lng), TX8(lng), TX9(lng)       *,         TX6(lng), TX7(lng), TX8(lng), TX9(lng)
1203       *,         TX11(lng), TX12(lng), TX13(lng), TX14(lng,ntracer)       *,         TX11(lng), TX12(lng), TX13(lng), TX14(lng,ntracedim)
1204       *,         TX15(lng)       *,         TX15(lng)
1205       *,         WFN(lng)       *,         WFN(lng)
1206        integer IA1(lng), IA2(lng), IA3(lng)        integer IA1(lng), IA2(lng), IA3(lng)
# Line 1129  C Local Variables Line 1216  C Local Variables
1216        integer IC(ICM),   IRND(icm)        integer IC(ICM),   IRND(icm)
1217        _RL cmass(lng,K)        _RL cmass(lng,K)
1218        LOGICAL SETRAS        LOGICAL SETRAS
1219          integer ifound
1220          _RL temp
1221          _RL thbef(lng,K)
1222    
1223        integer i,L,nc,ib,nt        integer i,L,nc,ib,nt
1224        integer km1,kp1,kprv,kcr,kfx,ncmx        integer km1,kp1,kprv,kcr,kfx,ncmx
# Line 1147  C The numerator here is the fraction of Line 1237  C The numerator here is the fraction of
1237  C      allowed to entrain into the cloud  C      allowed to entrain into the cloud
1238    
1239  CCC   FRAC = 1./dt  CCC   FRAC = 1./dt
1240    CCC   FRAC = 0.5/dt
1241        FRAC = 0.5/dt        FRAC = 0.5/dt
1242    
1243        KM1    = K  - 1        KM1    = K  - 1
# Line 1186  C Line 1277  C
1277         ENDIF         ENDIF
1278         IB = IC(NC)         IB = IC(NC)
1279    
        print *,' Calling cloud for cloud ',nc,' det at ',ic(nc)  
   
1280  c Initialize Cloud Fraction Array  c Initialize Cloud Fraction Array
1281  c -------------------------------  c -------------------------------
1282        do i = 1,lenc        do i = 1,lenc
# Line 1196  c ------------------------------- Line 1285  c -------------------------------
1285    
1286         CALL CLOUD(nn,lng, LENC, K, NLTOP, nlayr, IB, RASBLF,SETRAS,FRAC         CALL CLOUD(nn,lng, LENC, K, NLTOP, nlayr, IB, RASBLF,SETRAS,FRAC
1287       *,           CP,  ALHL, RKAPPA, GRAV, P00, CRTMSF       *,           CP,  ALHL, RKAPPA, GRAV, P00, CRTMSF
1288       *,           POI, QOI, UOI, Ntracer, PRS, PRJ       *,           POI, QOI, UOI, ntracedim, Ntracer, PRS, PRJ
1289       *,           PCU, CLOUDN, TCU, QCU, UCU, CMASS       *,           PCU, CLOUDN, TCU, QCU, UCU, CMASS
1290       *,           ALF, BET, GAM, PRH, PRI, HOI, ETA       *,           ALF, BET, GAM, PRH, PRI, HOI, ETA
1291       *,           HST, QOL, GMH       *,           HST, QOL, GMH
# Line 1239  c ***************************** Line 1328  c *****************************
1328    
1329        DO L=IB,K        DO L=IB,K
1330         DO I=1,LENC         DO I=1,LENC
1331            thbef(I,L) = POI(I,L)
1332          POI(I,L) = POI(I,L) + TCU(I,L) * DT * rhfrac(i)          POI(I,L) = POI(I,L) + TCU(I,L) * DT * rhfrac(i)
1333          QOI(I,L) = QOI(I,L) + QCU(I,L) * DT * rhfrac(i)          QOI(I,L) = QOI(I,L) + QCU(I,L) * DT * rhfrac(i)
1334         ENDDO         ENDDO
# Line 1254  c ***************************** Line 1344  c *****************************
1344         rains(I,ib) = rains(I,ib) + PCU(I)*dt * rhfrac(i)         rains(I,ib) = rains(I,ib) + PCU(I)*dt * rhfrac(i)
1345        ENDDO        ENDDO
1346    
1347          do i = 1,lenc
1348           ifound = 0
1349           do L = 1,k
1350            if(tcu(i,L).ne.0.)ifound = ifound + 1
1351           enddo
1352           if(ifound.ne.0) then
1353    c       print *,i,' made a cloud detraining at ',ib
1354            do L = 1,k
1355             temp = TCU(I,L) * DT * rhfrac(i)
1356    c        write(6,122)L,thbef(i,L),poi(i,L),temp
1357            enddo
1358           endif
1359          enddo
1360    
1361    100 CONTINUE    100 CONTINUE
1362    
1363     122  format(' ',i3,' TH B ',e10.3,' TH A ',e10.3,' DTH ',e10.3)
1364    
1365  c Fill Convective Cloud Fractions based on 3-D Rain Amounts  c Fill Convective Cloud Fractions based on 3-D Rain Amounts
1366  c ---------------------------------------------------------  c ---------------------------------------------------------
# Line 1295  c -------------------------------------- Line 1401  c --------------------------------------
1401  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
1402  c ----------------------------------------------------------------------------  c ----------------------------------------------------------------------------
1403        if( first.and.(iras.gt.1) .or. iras.ne.iras0+1 )then        if( first.and.(iras.gt.1) .or. iras.ne.iras0+1 )then
1404           print *,' first ',first,' iras ',iras,' iras0 ',iras0
1405         if( myid.eq.1 ) print *, 'Recreating Rand Numb Array in RNDCLOUD'         if( myid.eq.1 ) print *, 'Recreating Rand Numb Array in RNDCLOUD'
1406         if( myid.eq.1 ) print *, 'IRAS: ',iras,'  IRAS0: ',iras0         if( myid.eq.1 ) print *, 'IRAS: ',iras,'  IRAS0: ',iras0
1407         numrand = mod(iras,irm/nrnd) * nrnd         numrand = mod(iras,irm/nrnd) * nrnd
# Line 1367  c -------------------------------------- Line 1474  c --------------------------------------
1474        SUBROUTINE CLOUD(nn,lng, LENC, K, NLTOP, nlayr, IC, RASALF        SUBROUTINE CLOUD(nn,lng, LENC, K, NLTOP, nlayr, IC, RASALF
1475       *,                 SETRAS, FRAC       *,                 SETRAS, FRAC
1476       *,                 CP,  ALHL, RKAP, GRAV, P00, CRTMSF       *,                 CP,  ALHL, RKAP, GRAV, P00, CRTMSF
1477       *,                 POI, QOI, UOI, Ntracer, PRS,  PRJ       *,                 POI, QOI, UOI, ntracedim, Ntracer, PRS,  PRJ
1478       *,                 PCU, CLN, TCU, QCU, UCU, CMASS       *,                 PCU, CLN, TCU, QCU, UCU, CMASS
1479       *,                 ALF, BET, GAM, PRH, PRI, HOL, ETA       *,                 ALF, BET, GAM, PRH, PRI, HOL, ETA
1480       *,                 HST, QOL, GMH       *,                 HST, QOL, GMH
# Line 1500  C Line 1607  C
1607  C************************************************************************  C************************************************************************
1608        implicit none        implicit none
1609  C Argument List declarations  C Argument List declarations
1610        integer nn,lng,LENC,K,NLTOP,nlayr,ic,ntracer        integer nn,lng,LENC,K,NLTOP,nlayr,ic,ntracedim, ntracer
1611        _RL rasalf        _RL rasalf
1612        LOGICAL SETRAS        LOGICAL SETRAS
1613        _RL frac, cp,  alhl, rkap, grav, p00, crtmsf        _RL frac, cp,  alhl, rkap, grav, p00, crtmsf
1614        _RL POI(lng,K),QOI(lng,K),PRS(lng,K+1),PRJ(lng,K+1)        _RL POI(lng,K),QOI(lng,K),PRS(lng,K+1),PRJ(lng,K+1)
1615        _RL uoi(lng,nlayr,ntracer)        _RL uoi(lng,nlayr,ntracedim)
1616        _RL PCU(LENC), CLN(lng)        _RL PCU(LENC), CLN(lng)
1617        _RL TCU(lng,K),  QCU(lng,K),  ucu(lng,k,ntracer), CMASS(lng,K)        _RL TCU(lng,K),QCU(lng,K),ucu(lng,k,ntracedim),CMASS(lng,K)
1618        _RL ALF(lng,K), BET(lng,K),  GAM(lng,K), PRH(lng,K), PRI(lng,K)        _RL ALF(lng,K), BET(lng,K),  GAM(lng,K), PRH(lng,K), PRI(lng,K)
1619        _RL 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)
1620        _RL GMH(LENC,K)        _RL GMH(LENC,K)
# Line 1515  C Argument List declarations Line 1622  C Argument List declarations
1622        _RL TX5(LENC), TX6(LENC), TX7(LENC), TX8(LENC)        _RL TX5(LENC), TX6(LENC), TX7(LENC), TX8(LENC)
1623        _RL ALM(LENC), WFN(LENC), AKM(LENC), QS1(LENC)        _RL ALM(LENC), WFN(LENC), AKM(LENC), QS1(LENC)
1624        _RL WLQ(LENC), CLF(LENC)        _RL WLQ(LENC), CLF(LENC)
1625        _RL uht(lng,ntracer)        _RL uht(lng,ntracedim)
1626        integer IA(LENC), I1(LENC),I2(LENC)        integer IA(LENC), I1(LENC),I2(LENC)
1627        _RL      rhfrac(lng)        _RL      rhfrac(lng)
1628    
# Line 1544  cfpp$ expand (qsat) Line 1651  cfpp$ expand (qsat)
1651        ONEBG  = 1.0  / GRAV        ONEBG  = 1.0  / GRAV
1652        CPBG   = CP   * ONEBG        CPBG   = CP   * ONEBG
1653        TWOBAL = 2.0 / ALHL        TWOBAL = 2.0 / ALHL
1654    
1655  C  C
1656        KM1 = K  - 1        KM1 = K  - 1
1657        IC1 = IC + 1        IC1 = IC + 1
# Line 1845  C Line 1953  C
1953        DO I=1,LENB        DO I=1,LENB
1954        II = I1(I)        II = I1(I)
1955        TEM    = ETA(I,L) - ETA(I,L+1)        TEM    = ETA(I,L) - ETA(I,L+1)
1956        UHT(I,NT) = UHT(I,NT) + TEM * UOI(II,L+nltop-1,NT)        UHT(I,NT) = UHT(I,NT) + TEM *  UOI(II,L+nltop-1,NT)
1957        ENDDO        ENDDO
1958        ENDDO        ENDDO
1959        ENDDO        ENDDO
# Line 2065  C Line 2173  C
2173  c Compute Tracer Tendencies  c Compute Tracer Tendencies
2174  c -------------------------  c -------------------------
2175        do nt = 1,ntracer        do nt = 1,ntracer
2176    c
2177  c Tracer Tendency at the Bottom Layer  c Tracer Tendency at the Bottom Layer
2178  c -----------------------------------  c -----------------------------------
2179        DO 995 I=1,LENB        DO 995 I=1,LENB
2180        II = I1(I)        II = I1(I)
2181        TEM    = half*TX5(I) * PRI(II,K)        TEM    = half*TX5(I) * PRI(II,K)
2182        TX1(I) = (UOI(II,KM1+nltop-1,nt) - UOI(II,K+nltop-1,nt))        TX1(I) = ( UOI(II,KM1+nltop-1,nt) - UOI(II,K+nltop-1,nt))
2183        ucu(II,K,nt) = TEM * TX1(I)        ucu(II,K,nt) = TEM * TX1(I)
2184    995 CONTINUE    995 CONTINUE
2185    c
2186  c Tracer Tendency at all other Levels  c Tracer Tendency at all other Levels
2187  c -----------------------------------  c -----------------------------------
2188        DO 1020 L=KM1,IC1,-1        DO 1020 L=KM1,IC1,-1
# Line 2103  c ----------------------------------- Line 2211  c -----------------------------------
2211        II = I1(I)        II = I1(I)
2212        ucu(II,IC,nt) = TX1(I)        ucu(II,IC,nt) = TX1(I)
2213   1040 CONTINUE   1040 CONTINUE
2214    
2215        enddo        enddo
2216  C  C
2217  C     PENETRATIVE CONVECTION CALCULATION OVER  C     PENETRATIVE CONVECTION CALCULATION OVER
Legend:
Removed from v.1.16  
changed lines
  Added in v.1.24
  ViewVC Help
Powered by ViewVC 1.1.22