/[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.5 by molod, Wed Jul 7 20:07:47 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 "CPP_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,pl,ple,dpres,pkht,pkl,tz,qz,bi,bj,ntracer,ptracer,       .   pz,plz,plze,dpres,pkht,pkl,tz,qz,bi,bj,ntracer,ptracer,
8       .   qqz,dumoist,dvmoist,dtmoist,dqmoist,       .   qqz,dumoist,dvmoist,dtmoist,dqmoist,
9       .   im,jm,lm,ptop,       .   im,jm,lm,ptop,
10       .   iras,rainlsp,rainconv,snowfall,       .   iras,rainlsp,rainconv,snowfall,
# Line 12  C $Name$ Line 12  C $Name$
12       .   nlwcld,cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,       .   nlwcld,cldtot_lw,cldras_lw,cldlsp_lw,nlwlz,lwlz,
13       .   lpnt,myid)       .   lpnt,myid)
14    
15           implicit none
16    
17  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
18    #include "SIZE.h"
19    #include "diagnostics_SIZE.h"
20  #include "diagnostics.h"  #include "diagnostics.h"
21  #endif  #endif
22    
23  c Input Variables  c Input Variables
24  c ---------------  c ---------------
25          integer im,jm,lm
26        integer ndmoist,istrip,npcs        integer ndmoist,istrip,npcs
       integer lowlevel,midlevel,nltop,nsubmin,nsubmax,Lup  
       real pz(im,jm),pl(im,jm,lm),ple(im,jm,lm+1),dpres(im,jm,lm)  
       real pkht(im,jm,lm+1),pkl(im,jm,lm)  
       real tz(im,jm,lm),qz(im,jm,lm,ntracer)        
27        integer bi,bj,ntracer,ptracer                integer bi,bj,ntracer,ptracer        
28        real qqz(im,jm,lm)        integer lowlevel,midlevel,nltop,nsubmin,nsubmax,Lup
29        real dumoist(im,jm,lm),dvmoist(im,jm,lm)        _RL pz(im,jm),plz(im,jm,lm),plze(im,jm,lm+1),dpres(im,jm,lm)
30        real dtmoist(im,jm,lm),dqmoist(im,jm,lm,ntracer)        _RL pkht(im,jm,lm+1),pkl(im,jm,lm)
31        integer im,jm,lm        _RL tz(im,jm,lm),qz(im,jm,lm,ntracer)      
32        real ptop        _RL qqz(im,jm,lm)
33          _RL dumoist(im,jm,lm),dvmoist(im,jm,lm)
34          _RL dtmoist(im,jm,lm),dqmoist(im,jm,lm,ntracer)
35          _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 44  c Local Variables Line 48  c Local Variables
48  c ---------------  c ---------------
49        integer    ncrnd,nsecf        integer    ncrnd,nsecf
50    
51        real       fracqq, rh,temp1,temp2,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,cldras_mem,cldras,watnow,watmin,cldmin        _RL cldnow,cldlsp_mem,cldlsp,cldras_mem,cldras
62        real cldprs(im,jm),cldtmp(im,jm)        _RL watnow,watmin,cldmin
63        real cldhi (im,jm),cldlow(im,jm)        _RL cldprs(im,jm),cldtmp(im,jm)
64        real cldmid(im,jm),totcld(im,jm)        _RL cldhi (im,jm),cldlow(im,jm)
65          _RL cldmid(im,jm),totcld(im,jm)
66        real   CLDLS(im,jm,lm)  , CPEN(im,jm,lm)  
67        real    tmpimjm(im,jm)        _RL   CLDLS(im,jm,lm)  , CPEN(im,jm,lm)
68        real    lsp_new(im,jm)        _RL    tmpimjm(im,jm)
69        real   conv_new(im,jm)        _RL    lsp_new(im,jm)
70        real   snow_new(im,jm)        _RL   conv_new(im,jm)
71          _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)        _RL    pkegather(im*jm,lm+1)
85        real    tmpgather(im*jm,lm)        _RL    plzgather(im*jm,lm)
86        real   deltgather(im*jm,lm)        _RL    plegather(im*jm,lm+1)
87        real   delqgather(im*jm,lm)        _RL     dpgather(im*jm,lm)
88        real      ugather(im*jm,lm,ntracer)        _RL    tmpgather(im*jm,lm)
89        real   delugather(im*jm,lm,ntracer)        _RL   deltgather(im*jm,lm)
90        real     deltrnev(im*jm,lm)        _RL   delqgather(im*jm,lm)
91        real     delqrnev(im*jm,lm)        _RL      ugather(im*jm,lm,ntracer)
92          _RL   delugather(im*jm,lm,ntracer)
93          _RL     deltrnev(im*jm,lm)
94          _RL     delqrnev(im*jm,lm)
95    
96        integer  nindeces(lm)        integer  nindeces(lm)
97        integer  pblindex(im*jm)        integer  pblindex(im*jm)
# Line 89  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), gam(istrip,lm)        _RL     ple(istrip,lm+1)
108        real      TL(ISTRIP,lm)  , SHL(ISTRIP,lm)        _RL      dp(istrip,lm)
109        real      PL(ISTRIP,lm)  , PLK(ISTRIP,lm)        _RL      TL(ISTRIP,lm)  , SHL(ISTRIP,lm)
110        real    PLKE(ISTRIP,lm+1)        _RL      PL(ISTRIP,lm)  , PLK(ISTRIP,lm)
111        real      TH(ISTRIP,lm)  ,CVTH(ISTRIP,lm)        _RL    PLKE(ISTRIP,lm+1)
112        real   SHSAT(ISTRIP,lm)  , CVQ(ISTRIP,lm)        _RL      TH(ISTRIP,lm)  ,CVTH(ISTRIP,lm)
113        real      UL(ISTRIP,lm,ntracer)        _RL   CVQ(ISTRIP,lm)
114        real     cvu(istrip,lm,ntracer)        _RL      UL(ISTRIP,lm,ntracer)
115        real  CLMAXO(ISTRIP,lm),CLBOTH(ISTRIP,lm)        _RL     cvu(istrip,lm,ntracer)
116        real  CLSBTH(ISTRIP,lm)        _RL  CLMAXO(ISTRIP,lm),CLBOTH(ISTRIP,lm)
117        real    TMP1(ISTRIP,lm),  TMP2(ISTRIP,lm)        _RL  CLSBTH(ISTRIP,lm)
118        real    TMP3(ISTRIP,lm),  TMP4(ISTRIP,lm+1)        _RL    TMP1(ISTRIP,lm),  TMP2(ISTRIP,lm)
119        real    TMP5(ISTRIP,lm+1)        _RL    TMP3(ISTRIP,lm),  TMP4(ISTRIP,lm+1)
120          _RL    TMP5(ISTRIP,lm+1)
121        integer   ITMP1(ISTRIP,lm), ITMP2(ISTRIP,lm)        integer   ITMP1(ISTRIP,lm), ITMP2(ISTRIP,lm)
       integer   ITMP3(ISTRIP,lm)  
122    
123        real   PRECIP(ISTRIP), PCMID(ISTRIP), PCNET(ISTRIP)        _RL   PRECIP(ISTRIP), PCNET(ISTRIP)
124        real   PCLOW (ISTRIP),    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 176  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 235  c -------------------------------------- Line 245  c --------------------------------------
245        do index = 1,im*jm        do index = 1,im*jm
246         levgather(index) = levpbl(pblindex(index),1)         levgather(index) = levpbl(pblindex(index),1)
247          pigather(index) =     pz(pblindex(index),1)          pigather(index) =     pz(pblindex(index),1)
248            pkegather(index,lm+1) = pkht(pblindex(index),1,lm+1)
249            plegather(index,lm+1) = plze(pblindex(index),1,lm+1)
250        enddo        enddo
251    
252        do L = 1,lm        do L = 1,lm
253         do index = 1,im*jm         do index = 1,im*jm
254           thgather(index,L) =   tz(pblindex(index),1,L)           thgather(index,L) = tz(pblindex(index),1,L)
255           shgather(index,L) =   qz(pblindex(index),1,L,1)           shgather(index,L) = qz(pblindex(index),1,L,1)
256          pkegather(index,L) = pkht(pblindex(index),1,L)          pkegather(index,L) = pkht(pblindex(index),1,L)
257          pkzgather(index,L) = pkl (pblindex(index),1,L)          pkzgather(index,L) = pkl(pblindex(index),1,L)
258            plegather(index,L) = plze(pblindex(index),1,L)
259            plzgather(index,L) = plz(pblindex(index),1,L)
260             dpgather(index,L) = dpres(pblindex(index),1,L)
261         enddo         enddo
262        enddo        enddo
263        do nt = 1,ntracer-ptracer        do nt = 1,ntracer-ptracer
# Line 285  C ************************************** Line 300  C **************************************
300    
301         CALL STRIP (  pigather, SP      ,im*jm,ISTRIP,1 ,NN )         CALL STRIP (  pigather, SP      ,im*jm,ISTRIP,1 ,NN )
302         CALL STRIP ( pkzgather, PLK     ,im*jm,ISTRIP,lm,NN )         CALL STRIP ( pkzgather, PLK     ,im*jm,ISTRIP,lm,NN )
303         CALL STRIP ( pkegather, PLKE    ,im*jm,ISTRIP,lm,NN )         CALL STRIP ( pkegather, PLKE    ,im*jm,ISTRIP,lm+1,NN )
304           CALL STRIP ( plzgather, PL      ,im*jm,ISTRIP,lm,NN )
305           CALL STRIP ( plegather, PLE     ,im*jm,ISTRIP,lm+1,NN )
306           CALL STRIP (  dpgather, dp      ,im*jm,ISTRIP,lm,NN )
307         CALL STRIP (  thgather, TH      ,im*jm,ISTRIP,lm,NN )         CALL STRIP (  thgather, TH      ,im*jm,ISTRIP,lm,NN )
308         CALL STRIP (  shgather, SHL     ,im*jm,ISTRIP,lm,NN )         CALL STRIP (  shgather, SHL     ,im*jm,ISTRIP,lm,NN )
309         CALL STRINT( levgather, pbl     ,im*jm,ISTRIP,1 ,NN )         CALL STRINT( levgather, pbl     ,im*jm,ISTRIP,1 ,NN )
# Line 294  C ************************************** Line 312  C **************************************
312         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 )
313         enddo         enddo
314    
       do l = 1,lm  
       do i = 1,istrip  
        PL(I,L) =  SIG(L)*SP(I) + PTOP  
       PLE(I,L) = SIGE(L)*SP(I) + PTOP  
       enddo  
       enddo  
   
       do i = 1,istrip  
       PLE(I,lm+1) = SP(I) + PTOP  
       enddo  
   
315  C **********************************************************************  C **********************************************************************
316  C ****        SETUP FOR RAS CUMULUS PARAMETERIZATION                ****  C ****        SETUP FOR RAS CUMULUS PARAMETERIZATION                ****
317  C **********************************************************************  C **********************************************************************
# Line 400  c ------------------------------- Line 407  c -------------------------------
407         ENDDO         ENDDO
408         DO L=2,lm         DO L=2,lm
409         DO I=num,num+nindeces(nsubcl)-1         DO I=num,num+nindeces(nsubcl)-1
410          TMP5(I,L) = PLKE(I,L-1)*P0KINV          TMP5(I,L) = PLKE(I,L)*P0KINV
411         ENDDO         ENDDO
412         ENDDO         ENDDO
413         DO  I=num,num+nindeces(nsubcl)-1         DO  I=num,num+nindeces(nsubcl)-1
414          TMP4(I,lm+1) = PLE (I,lm+1)          TMP4(I,lm+1) = PLE (I,lm+1)
415          TMP5(I,lm+1) = PLKE(I,lm)*P0KINV          TMP5(I,lm+1) = PLKE(I,lm+1)*P0KINV
416         ENDDO         ENDDO
417         DO 113 I=num,num+nindeces(nsubcl)-1         DO 113 I=num,num+nindeces(nsubcl)-1
418          TMP4(I,NSUBCL+1) = PLE (I,lm+1)          TMP4(I,NSUBCL+1) = PLE (I,lm+1)
419          TMP5(I,NSUBCL+1) = PLKE(I,lm)*P0KINV          TMP5(I,NSUBCL+1) = PLKE(I,lm+1)*P0KINV
420   113   CONTINUE   113   CONTINUE
421    
422        do i=num,num+nindeces(nsubcl)-1        do i=num,num+nindeces(nsubcl)-1
# Line 446  C Top level of atan func above this rh_t Line 453  C Top level of atan func above this rh_t
453           rhcrit(i,L) = 1.           rhcrit(i,L) = 1.
454         enddo         enddo
455         do L = 1, nsubcl-1         do L = 1, nsubcl-1
456          pcheck = (1000.-ptop)*sig(L) + ptop          pcheck = pl(i,L)
457          if (pcheck .le. pup) then          if (pcheck .le. pup) then
458           rhcrit(i,L) = rhmin           rhcrit(i,L) = rhmin
459          else          else
460           ppbl = (1000.-ptop)*sig(nsubcl) + ptop           ppbl = pl(i,nsubcl)
461           rhcrit(i,L) = rhmin + (1.-rhmin)/(19.) *           rhcrit(i,L) = rhmin + (1.-rhmin)/(19.) *
462       .      ((atan( (2.*(pcheck-pup)/(ppbl-pup)-1.) *       .      ((atan( (2.*(pcheck-pup)/(ppbl-pup)-1.) *
463       .       tan(20.*pi/21.-0.5*pi) )       .       tan(20.*pi/21.-0.5*pi) )
# Line 480  c -------------------------------------- Line 487  c --------------------------------------
487  c Compute Diagnostic CLDMAS in RAS Subcloud Layers  c Compute Diagnostic CLDMAS in RAS Subcloud Layers
488  c ------------------------------------------------  c ------------------------------------------------
489         do L=nsubcl,lm         do L=nsubcl,lm
         dum = dsig(L)/(1.0-sige(nsubcl))  
490         do I=num,num+nindeces(nsubcl)-1         do I=num,num+nindeces(nsubcl)-1
491            dum = dp(i,L)/(ple(i,lm+1)-ple(i,nsubcl))
492          cldmas(i,L) = cldmas(i,L-1) - dum*cldmas(i,nsubcl-1)          cldmas(i,L) = cldmas(i,L-1) - dum*cldmas(i,nsubcl-1)
493         enddo         enddo
494         enddo         enddo
# Line 595  C ************************************** Line 602  C **************************************
602        ENDDO        ENDDO
603        ENDDO        ENDDO
604    
605         CALL RNEVP (NN,ISTRIP,lm,TL,SHL,PCPEN,PL,CLFRAC,SP,DSIG,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 769  C ************************************** Line 776  C **************************************
776  C                          BUMP DIAGNOSTICS  C                          BUMP DIAGNOSTICS
777  C **********************************************************************  C **********************************************************************
778    
 c Clear-Sky (Above 400mb) Temperature  
 c -----------------------------------  
       if( itmpuclr.ne.0 .or. isphuclr.ne.0 ) then  
       do j = 1,jm  
       do i = 1,im  
       totcld(i,j) = 0.0  
       enddo  
       enddo  
       do L = 1,midlevel  
       do j = 1,jm  
       do i = 1,im  
        if(cldls(i,j,L).ne.0.0.or.cpen(i,j,L).ne.0.0)totcld(i,j) = 1.0  
       enddo  
       enddo  
       enddo  
       do L = 1,lm  
        if( itmpuclr.ne.0 ) then  
         do i = 1,im*jm  
         if( totcld(i,1).eq.0.0 ) then  
          qdiag(i,1,itmpuclr +L-1,bi,bj) =  
      .         qdiag(i,1,itmpuclr +L-1,bi,bj) + tz(i,1,L)*pkzgather(i,L)  
          qdiag(i,1,itmpuclrc+L-1,bi,bj) =  
      .                            qdiag(i,1,itmpuclrc+L-1,bi,bj)+1.0  
         endif  
         enddo  
        endif  
   
        if( isphuclr.ne.0 ) then  
         do i = 1,im*jm  
         if( totcld(i,1).eq.0.0 ) then  
          qdiag(i,1,isphuclr +L-1,bi,bj) =  
      .              qdiag(i,1,isphuclr +L-1,bi,bj) + qz(i,1,L,1)*1000.0  
          qdiag(i,1,isphuclrc+L-1,bi,bj) =  
      .                      qdiag(i,1,isphuclrc+L-1,bi,bj) + 1.0  
         endif  
         enddo  
        endif  
       enddo  
       endif  
   
779  c Sub-Cloud Layer  c Sub-Cloud Layer
780  c -------------------------  c -------------------------
781        if( ipsubcld.ne.0 ) then        if( ipsubcld.ne.0 ) then
# Line 963  c ------------------------------------ Line 930  c ------------------------------------
930    
931        do L = 1,lm        do L = 1,lm
932        do i = 1,im*jm        do i = 1,im*jm
933         plev = sig(L)*pz(i,1)+ptop         plev = pl(i,L)
934    
935  c Compute Time-averaged Cloud and Water Amounts for Longwave Radiation  c Compute Time-averaged Cloud and Water Amounts for Longwave Radiation
936  c --------------------------------------------------------------------  c --------------------------------------------------------------------
# Line 1095  C ************************************** Line 1062  C **************************************
1062       *,               cp,grav,rkappa,alhl,rhfrac,rasmax )       *,               cp,grav,rkappa,alhl,rhfrac,rasmax )
1063  C  C
1064  C*********************************************************************  C*********************************************************************
 C*********************** ARIES   MODEL *******************************  
1065  C********************* SUBROUTINE  RAS   *****************************  C********************* SUBROUTINE  RAS   *****************************
1066  C********************** 16 MARCH   1988 ******************************  C********************** 16 MARCH   1988 ******************************
1067  C*********************************************************************  C*********************************************************************
1068  C  C
1069        PARAMETER (KRMIN=01)        implicit none
1070        PARAMETER (ICM=1000)  
1071        PARAMETER (CMB2PA=100.0)  C Argument List
1072        PARAMETER (rknob = 10.)        integer nn,len,lenc,k,nltop,nlayr
 C  
1073        integer ntracer        integer ntracer
1074        integer nltop,nlayr        integer ncrnd
1075        DIMENSION UOI(len,nlayr,ntracer),   POI(len,K)        _RL dt
1076        DIMENSION QOI(len,K), PRS(len,K+1), PRJ(len,K+1)        _RL UOI(len,nlayr,ntracer),   POI(len,K)
1077        dimension rnd(ncrnd)        _RL QOI(len,K), PRS(len,K+1), PRJ(len,K+1)
1078  C        _RL rnd(ncrnd)
1079        DIMENSION RAINS(len,K), CLN(len,K), CLF(len,K)        _RL RAINS(len,K), CLN(len,K), CLF(len,K)
1080        DIMENSION cldmas(len,K), detrain(len,K)        _RL cldmas(len,K), detrain(len,K)
1081        DIMENSION TCU(len,K), QCU(len,K)        _RL cp,grav,rkappa,alhl,rhfrac(len),rasmax
1082        real ucu(len,K,ntracer)  
1083        DIMENSION ALF(len,K), BET(len,K), GAM(len,K)  C Local Variables
1084          _RL TCU(len,K), QCU(len,K)
1085          _RL ucu(len,K,ntracer)
1086          _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        DIMENSION HST(len,K), QOL(len,K), GMH(len,K)        _RL HST(len,K), QOL(len,K), GMH(len,K)
1090    
1091        DIMENSION 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), TX16(len)       *,         TX15(len)
1095       *,         WFN(len), IA1(len), IA2(len), IA3(len)       *,         WFN(len)
1096        DIMENSION cloudn(len), pcu(len)        integer IA1(len), IA2(len), IA3(len)
1097          _RL cloudn(len), pcu(len)
1098    
1099        real rhfrac(len),rasmax        integer krmin,icm
1100          _RL rknob, cmb2pa
1101        DIMENSION IC(ICM),   IRND(icm)        PARAMETER (KRMIN=01)
1102        dimension cmass(len,K)        PARAMETER (ICM=1000)
1103          PARAMETER (CMB2PA=100.0)
1104          PARAMETER (rknob = 10.)
1105    
1106          integer IC(ICM),   IRND(icm)
1107          _RL cmass(len,K)
1108        LOGICAL SETRAS        LOGICAL SETRAS
1109    
1110           do L = 1,k        integer i,L,nc,ib,nt
1111           do I = 1,LENC        integer km1,kp1,kprv,kcr,kfx,ncmx
1112           rains(i,l) = 0.        _RL p00, crtmsf, frac, rasblf
1113           enddo  
1114           enddo        do L = 1,k
1115          do I = 1,LENC
1116           rains(i,l) = 0.
1117          enddo
1118          enddo
1119    
1120        p00 = 1000.        p00 = 1000.
1121        crtmsf = 0.        crtmsf = 0.
# Line 1264  c -------------------------------------- Line 1242  c --------------------------------------
1242    
1243        RETURN        RETURN
1244        END        END
   
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 1284  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 1293  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 1309  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 1331  c -------------------------------------- Line 1308  c --------------------------------------
1308        iras0 = iras        iras0 = iras
1309        return        return
1310        end        end
1311          function random_numbx(iseed)
       real function random_numbx()  
1312        implicit none        implicit none
1313  #if CRAY        integer iseed
1314        real ranf        real *8 seed,port_rand
1315          _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)
1339  #endif  #endif
1340        return        return
1341        end        end
1342          SUBROUTINE CLOUD(nn,LEN, LENC, K, NLTOP, nlayr, IC, RASALF
       SUBROUTINE CLOUD(nn,LEN, LENC, K, NLTOP, nlayr, IC, RASALF,  
1343       *,                 SETRAS, FRAC       *,                 SETRAS, FRAC
1344       *,                 CP,  ALHL, RKAP, GRAV, P00, CRTMSF       *,                 CP,  ALHL, RKAP, GRAV, P00, CRTMSF
1345       *,                 POI, QOI, UOI, Ntracer, PRS,  PRJ       *,                 POI, QOI, UOI, Ntracer, PRS,  PRJ
# Line 1492  C    IA, I1, and I2 are temporary intege Line 1473  C    IA, I1, and I2 are temporary intege
1473  C  C
1474  C  C
1475  C************************************************************************  C************************************************************************
1476  C        implicit none
1477  C  C Argument List declarations
1478          integer nn,LEN,LENC,K,NLTOP,nlayr,ic,ntracer
1479          _RL rasalf
1480          LOGICAL SETRAS
1481          _RL frac, cp,  alhl, rkap, grav, p00, crtmsf
1482          _RL POI(LEN,K),QOI(LEN,K),PRS(LEN,K+1),PRJ(LEN,K+1)
1483          _RL uoi(len,nlayr,ntracer)
1484          _RL PCU(LENC), CLN(LEN)
1485          _RL TCU(LEN,K),  QCU(LEN,K),  ucu(len,k,ntracer), CMASS(LEN,K)
1486          _RL ALF(LEN,K), BET(LEN,K),  GAM(LEN,K), PRH(LEN,K), PRI(LEN,K)
1487          _RL HOL(LENC,K), ETA(LENC,K), HST(LENC,K), QOL(LENC,K)
1488          _RL GMH(LENC,K)
1489          _RL TX1(LENC), TX2(LENC), TX3(LENC), TX4(LENC)
1490          _RL TX5(LENC), TX6(LENC), TX7(LENC), TX8(LENC)
1491          _RL ALM(LENC), WFN(LENC), AKM(LENC), QS1(LENC)
1492          _RL WLQ(LENC), CLF(LENC)
1493          _RL uht(len,ntracer)
1494          integer IA(LENC), I1(LENC),I2(LENC)
1495          _RL      rhfrac(len)
1496    
1497    C Local Variables
1498          _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          _RL rkapp1,onebcp,albcp,onebg,cpbg,twobal
1503  C  C
1504        integer nltop,ntracer,nlayr        integer nt,km1,ic1,i,L,len1,len2,isav,len11,ii
1505        DIMENSION POI(LEN,K),  QOI(LEN,K),  PRS(LEN,K+1)        integer lena,lena1,lenb,tem,tem1
      *,         PRJ(LEN,K+1)  
      *,         TCU(LEN,K),  QCU(LEN,K),  CMASS(LEN,K), CLN(LEN)  
       real uoi(len,nlayr,ntracer)  
       DIMENSION ALF(LEN,K), BET(LEN,K),  GAM(LEN,K)  
      *,         PRH(LEN,K), PRI(LEN,K)  
       DIMENSION AKM(LENC),   WFN(LENC)  
       DIMENSION HOL(LENC,K), QOL(LENC,K),  ETA(LENC,K), HST(LENC,K)  
      *,         GMH(LENC,K), ALM(LENC),    WLQ(LENC),   QS1(LENC)  
      *,         TX1(LENC),   TX2(LENC), TX3(LENC),   TX4(LENC)  
      *,         TX5(LENC),   TX6(LENC), TX7(LENC),   TX8(LENC)  
      *,         CLF(LENC),   PCU(LENC)  
       DIMENSION IA(LENC),    I1(LENC),  I2(LENC)  
       real      rhfrac(len)  
       real ucu(len,k,ntracer),uht(len,ntracer)  
       LOGICAL SETRAS  
   
       integer nt  
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 1537  C Line 1522  C
1522        KM1 = K  - 1        KM1 = K  - 1
1523        IC1 = IC + 1        IC1 = IC + 1
1524  C  C
1525  C      SETTIING ALF, BET, GAM, PRH, AND PRI : DONE ONLY WHEN SETRAS=.T.  C      SETTING ALF, BET, GAM, PRH, AND PRI : DONE ONLY WHEN SETRAS=.T.
1526  C  C
1527    
1528        IF (SETRAS) THEN        IF (SETRAS) THEN
# Line 2102  C Line 2087  C
2087        END        END
2088        SUBROUTINE RNCL(LEN, PL, RNO, CLF)        SUBROUTINE RNCL(LEN, PL, RNO, CLF)
2089  C  C
 C  
2090  C*********************************************************************  C*********************************************************************
2091  C********************** Relaxed Arakawa-Schubert *********************  C********************** Relaxed Arakawa-Schubert *********************
2092  C************************   SUBROUTINE  RNCL  ************************  C************************   SUBROUTINE  RNCL  ************************
2093  C**************************** 23 July 1992 ***************************  C**************************** 23 July 1992 ***************************
2094  C*********************************************************************  C*********************************************************************
2095          implicit none
2096    C Argument List declarations
2097          integer len
2098          _RL PL(LEN),  RNO(LEN), CLF(LEN)
2099    
2100    C Local Variables
2101          _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))
 C  
2104        PARAMETER (P4=400.0,    P6=401.0)        PARAMETER (P4=400.0,    P6=401.0)
2105        PARAMETER (P7=700.0,    P9=900.0)        PARAMETER (P7=700.0,    P9=900.0)
2106        PARAMETER (CUCLD=0.5,CFAC=CUCLD/(P6-P4))        PARAMETER (CUCLD=0.5,CFAC=CUCLD/(P6-P4))
2107    
2108          integer i
2109  C  C
       DIMENSION PL(LEN),  RNO(LEN), CLF(LEN)  
   
2110        DO 10 I=1,LEN        DO 10 I=1,LEN
2111                             rno(i) = 1.0                             rno(i) = 1.0
2112  ccc   if( pl(i).le.400.0 ) rno(i) = max( 0.75, 1.0-0.0025*(400.0-pl(i)) )  ccc   if( pl(i).le.400.0 ) rno(i) = max( 0.75, 1.0-0.0025*(400.0-pl(i)) )
# Line 2156  C****  Note:  Data obtained from January Line 2145  C****  Note:  Data obtained from January
2145  C****         from 4x5 46-layer GEOS Assimilation                *****  C****         from 4x5 46-layer GEOS Assimilation                *****
2146  C****                                                            *****  C****                                                            *****
2147  C*********************************************************************  C*********************************************************************
2148          implicit none
2149        real PL(LEN), PLB(LEN), ACR(LEN)  C Argument List declarations
2150          integer len
2151          _RL PL(LEN), PLB(LEN), ACR(LEN)
2152    
2153    C Local variables
2154          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
2159          _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 2195  C*************************************** Line 2190  C***************************************
2190    
2191        RETURN        RETURN
2192        END        END
2193         SUBROUTINE RNEVP(NN,IRUN,NLAY,TL,QL,RAIN,PL,CLFRAC,SP,DSIG,PLKE,         SUBROUTINE RNEVP(NN,IRUN,NLAY,TL,QL,RAIN,PL,CLFRAC,SP,DP,PLKE,
2194       1   PLK,TH,TEMP1,TEMP2,TEMP3,ITMP1,ITMP2,RCON,RLAR,CLSBTH,tmscl,       1   PLK,TH,TEMP1,TEMP2,TEMP3,ITMP1,ITMP2,RCON,RLAR,CLSBTH,tmscl,
2195       2   tmfrc,cp,gravity,alhl,gamfac,cldlz,RHCRIT,offset,alpha)       2   tmfrc,cp,gravity,alhl,gamfac,cldlz,RHCRIT,offset,alpha)
2196    
2197          implicit none
2198    C Argument List declarations
2199          integer nn,irun,nlay
2200          _RL TL(IRUN,NLAY),QL(IRUN,NLAY),RAIN(IRUN,NLAY),
2201         . PL(IRUN,NLAY),CLFRAC(IRUN,NLAY),SP(IRUN),TEMP1(IRUN,NLAY),
2202         . TEMP2(IRUN,NLAY),PLKE(IRUN,NLAY+1),
2203         . RCON(IRUN),RLAR(IRUN),DP(IRUN,NLAY),PLK(IRUN,NLAY),TH(IRUN,NLAY),
2204         . TEMP3(IRUN,NLAY)
2205          integer ITMP1(IRUN,NLAY),ITMP2(IRUN,NLAY)
2206          _RL CLSBTH(IRUN,NLAY)
2207          _RL tmscl,tmfrc,cp,gravity,alhl,gamfac,offset,alpha
2208          _RL cldlz(irun,nlay)
2209          _RL rhcrit(irun,nlay)
2210    C
2211    C Local Variables
2212          _RL zm1p04,zero,two89,zp44,zp01,half,zp578,one,thousand,z3600
2213          _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 2212  C*************************************** Line 2224  C***************************************
2224        PARAMETER ( THOUSAND = 1000.)        PARAMETER ( THOUSAND = 1000.)
2225        PARAMETER ( Z3600 = 3600.)        PARAMETER ( Z3600 = 3600.)
2226  C  C
2227         DIMENSION TL(IRUN,NLAY),QL(IRUN,NLAY),RAIN(IRUN,NLAY),        _RL EVP9(IRUN,NLAY)
2228       $ PL(IRUN,NLAY),CLFRAC(IRUN,NLAY),SP(IRUN),TEMP1(IRUN,NLAY),        _RL water(irun),crystal(irun)
2229       $ TEMP2(IRUN,NLAY),PLKE(IRUN,NLAY),        _RL watevap(irun),iceevap(irun)
2230       $ RCON(IRUN),RLAR(IRUN),DSIG(NLAY),PLK(IRUN,NLAY),TH(IRUN,NLAY),        _RL fracwat,fracice, tice,rh,fact,dum
2231       $ TEMP3(IRUN,NLAY),ITMP1(IRUN,NLAY),        _RL rainmax(irun)
2232       $ ITMP2(IRUN,NLAY),CLSBTH(IRUN,NLAY)        _RL getcon,rphf,elocp,cpog,relax
2233  C        _RL exparg,arearat,rpow
2234         DIMENSION EVP9(IRUN,NLAY)  
2235         real water(irun),crystal(irun)        integer i,L,n,nlaym1,irnlay,irnlm1
        real watevap(irun),iceevap(irun)  
        real fracwat,fracice, tice,rh,fact,dum  
   
        real cldlz(irun,nlay)  
        real rhcrit(irun,nlay), rainmax(irun)  
        real offset, alpha  
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 2280  C INVERSE OF MASS IN EACH LAYER Line 2286  C INVERSE OF MASS IN EACH LAYER
2286  c -----------------------------  c -----------------------------
2287        DO L = 1,NLAY        DO L = 1,NLAY
2288        DO I = 1,IRUN        DO I = 1,IRUN
2289        TEMP3(I,L) = SP(I) * DSIG(L)        TEMP3(I,L) = GRAVITY*ZP01 / DP(I,L)
       TEMP3(I,L) = GRAVITY*ZP01 / TEMP3(I,L)  
2290        ENDDO        ENDDO
2291        ENDDO        ENDDO
2292    
# Line 2429  C  ======= Line 2434  C  =======
2434  C    cloud ...... Cloud Fraction        (irun,irise)  C    cloud ...... Cloud Fraction        (irun,irise)
2435  C  C
2436  C***********************************************************************  C***********************************************************************
 C*                  GODDARD LABORATORY FOR ATMOSPHERES                 *  
 C***********************************************************************  
2437    
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 tempth(irun)        _RL  cloud(irun,irise)
2448        real tempqs(irun)        _RL cldwat(irun,irise)
2449        real dhstar(irun)        _RL     qs(irun,irise)
2450        real  cloud(irun,irise)  
2451        real cldwat(irun,irise)        _RL cp, alhl, getcon, akap
2452        real     qs(irun,irise)        _RL ratio, temp, elocp
2453          _RL rhcrit,rh,dum
2454        real cp, alhl, getcon, akap, pcheck        integer i,L
2455        real ratio, temp, pke, elocp  
2456        real rhcrit,rh,dum,pbar,tbar        _RL rhc(irun,irise)
2457        integer i,L,ntradesu,ntradesl        _RL offset,alpha
   
       real factor  
       real rhc(irun,irise)  
       real 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 2501  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 2542  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.5  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22