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

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

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

revision 1.2 by molod, Tue Jun 15 16:06:03 2004 UTC revision 1.8 by molod, Wed Jul 14 15:49:07 2004 UTC
# Line 2  C $Header$ Line 2  C $Header$
2  C $Name$  C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
5        subroutine swrio (nymd,nhms,ndswr,myid,istrip,npcs,  #include "PACKAGES_CONFIG.h"
6       .        pz,tz,qz,pkht,oz,co2,        subroutine swrio (nymd,nhms,bi,bj,ndswr,myid,istrip,npcs,
7         .        low_level,mid_level,
8         .        pz,plz,plze,dpres,pkht,pkz,tz,qz,oz,co2,
9       .        albvisdr,albvisdf,albnirdr,albnirdf,       .        albvisdr,albvisdf,albnirdr,albnirdf,
10       .        dtradsw,dtswclr,radswg,swgclr,albedo,       .        dtradsw,dtswclr,radswg,swgclr,
11       .        fdifpar,fdirpar,osr,osrclr,       .        fdifpar,fdirpar,osr,osrclr,
12       .        im,jm,lm,sige,sig,dsig,ptop,       .        im,jm,lm,ptop,
13       .        nswcld,cldsw,cswmo,nswlz,swlz,       .        nswcld,cldsw,cswmo,nswlz,swlz,
14       .        lpnt,imstturb,qliqave,fccave,landtype,xlats,xlons)       .        lpnt,imstturb,qliqave,fccave,landtype,xlats,xlons)
15    
16        implicit none        implicit none
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 nymd,nhms,ndswr,istrip,npcs        integer nymd,nhms,bi,bj,ndswr,myid,istrip,npcs
26          integer mid_level,low_level
27        integer im,jm,lm                integer im,jm,lm        
28        real  ptop                      real  ptop
29        real  sige(lm+1)                real pz(im,jm),plz(im,jm,lm),plze(im,jm,lm+1),dpres(im,jm,lm)
30        real   sig(lm)                  real pkht(im,jm,lm+1),pkz(im,jm,lm)
31        real  dsig(lm)                  real tz(im,jm,lm),qz(im,jm,lm)
32          real oz(im,jm,lm)
33        real    pz(im,jm)              real co2
34        real    tz(im,jm,lm)            real albvisdr(im,jm),albvisdf(im,jm),albnirdr(im,jm)
35        real  pkht(im,jm,lm)            real albnirdf(im,jm)
36          real radswg(im,jm),swgclr(im,jm),fdifpar(im,jm),fdirpar(im,jm)
37        real    co2                    real osr(im,jm),osrclr(im,jm),dtradsw(im,jm,lm),dtswclr(im,jm,lm)
       real    oz(im,jm,lm)      
       real    qz(im,jm,lm)      
   
       real albvisdr(im,jm)      
       real albvisdf(im,jm)      
       real albnirdr(im,jm)      
       real albnirdf(im,jm)      
   
       real   radswg(im,jm)      
       real   swgclr(im,jm)      
       real   albedo(im,jm)      
       real  fdifpar(im,jm)      
       real  fdirpar(im,jm)      
       real      osr(im,jm)      
       real   osrclr(im,jm)      
       real  dtradsw(im,jm,lm)  
       real  dtswclr(im,jm,lm)  
   
38        integer nswcld,nswlz            integer nswcld,nswlz    
39        real  cldsw(im,jm,lm)          real cldsw(im,jm,lm),cswmo(im,jm,lm),swlz(im,jm,lm)  
       real  cswmo(im,jm,lm)    
       real   swlz(im,jm,lm)    
   
40        logical lpnt                    logical lpnt            
41        integer imstturb                integer imstturb        
42        real qliqave(im,jm,lm)          real qliqave(im,jm,lm),fccave(im,jm,lm)  
       real  fccave(im,jm,lm)    
   
43        integer landtype(im,jm)        integer landtype(im,jm)
44          real xlats(im,jm),xlons(im,jm)
45    
46  c Local Variables  c Local Variables
47  c ---------------  c ---------------
48        integer   i,j,L,nn,nsecf,mid_level, low_level        integer   i,j,L,nn,nsecf
49        integer   nb2,ntmstp,nymd2,nhms2        integer   ntmstp,nymd2,nhms2
50        real      getcon,grav,cp,undef,pcheck        real      getcon,grav,cp,undef
51        real      ra,alf,reffw,reffi,tminv        real      ra,alf,reffw,reffi,tminv
52    
53        parameter ( reffw = 10.0 )          parameter ( reffw = 10.0 )  
54        parameter ( reffi = 65.0 )          parameter ( reffi = 65.0 )  
55    
56        real      alat(im,jm)        real tdry(im,jm,lm)
57        real      alon(im,jm)        real TEMP1(im,jm)
58          real TEMP2(im,jm)
59          real zenith (im,jm)
60          real cldtot (im,jm,lm)
61          real cldmxo (im,jm,lm)
62          real totcld (im,jm)
63          real cldlow (im,jm)
64          real cldmid (im,jm)
65          real cldhi  (im,jm)
66          real taulow (im,jm)
67          real taumid (im,jm)
68          real tauhi  (im,jm)
69          real tautype(im,jm,lm,3)
70          real tau(im,jm,lm)
71          real albedo(im,jm)    
72    
73          real PK(ISTRIP,lm)
74          real qzl(ISTRIP,lm),CLRO(ISTRIP,lm)
75          real TZL(ISTRIP,lm)
76          real OZL(ISTRIP,lm)
77          real PLE(ISTRIP,lm+1)
78          real COSZ(ISTRIP)
79          real dpstrip(ISTRIP,lm)
80    
81          real albuvdr(ISTRIP),albuvdf(ISTRIP)
82          real albirdr(ISTRIP),albirdf(ISTRIP)
83          real difpar (ISTRIP),dirpar (ISTRIP)
84    
85          real fdirir(istrip),fdifir(istrip)
86          real fdiruv(istrip),fdifuv(istrip)
87    
88          real flux(istrip,lm+1)
89          real fluxclr(istrip,lm+1)
90          real dtsw(istrip,lm)
91          real dtswc(istrip,lm)
92    
93          real taul   (istrip,lm)
94          real reff   (istrip,lm,2)
95          real tauc   (istrip,lm,2)
96          real taua   (istrip,lm)
97          real tstrip (istrip)
98    
99        real          PKZ(im,jm,lm)        logical first
100        real          PLZ(im,jm,lm)        data first /.true./
       real         tdry(im,jm,lm)  
       real         PLZE(im,jm,lm+1)  
       real        TEMP1(im,jm)  
       real        TEMP2(im,jm)  
       real      zenith (im,jm)  
       real      cldtot (im,jm,lm)  
       real      cldmxo (im,jm,lm)  
       real      totcld (im,jm)  
       real      cldlow (im,jm)  
       real      cldmid (im,jm)  
       real      cldhi  (im,jm)  
       real      taulow (im,jm)  
       real      taumid (im,jm)  
       real      tauhi  (im,jm)  
       real      tautype(im,jm,lm,3)  
       real      tau    (im,jm,lm)  
   
       real          PK(ISTRIP,lm)  
       real         qzl(ISTRIP,lm),  CLRO(ISTRIP,lm)  
       real         TZL(ISTRIP,lm)  
       real         OZL(ISTRIP,lm)  
       real         PLE(ISTRIP,lm+1)  
       real        COSZ(ISTRIP)  
   
       real      albuvdr(ISTRIP),albuvdf(ISTRIP)  
       real      albirdr(ISTRIP),albirdf(ISTRIP)  
       real      difpar (ISTRIP),dirpar (ISTRIP)  
   
       real      fdirir(istrip),fdifir(istrip)  
       real      fdiruv(istrip),fdifuv(istrip)  
   
       real      flux   (istrip,lm+1)  
       real      fluxclr(istrip,lm+1)  
       real      dtsw   (istrip,lm)  
       real      dtswc  (istrip,lm)  
   
       real      taul   (istrip,lm)  
       real      reff   (istrip,lm,2)  
       real      tauc   (istrip,lm,2)  
       real      taua   (istrip,lm)  
       real      tstrip (istrip)  
   
       logical   first  
       data      first /.true./  
   
       integer   koz, kh2o  
       data      KOZ  /20/  
       data      kh2o /18/  
101    
102  C **********************************************************************  C **********************************************************************
103  C ****                       INITIALIZATION                         ****  C ****                       INITIALIZATION                         ****
# Line 136  C ************************************** Line 110  C **************************************
110        NTMSTP = nsecf(NDSWR)        NTMSTP = nsecf(NDSWR)
111        TMINV  = 1./float(ntmstp)        TMINV  = 1./float(ntmstp)
112    
       do j = 1,jm  
       do i = 1,im  
       PLZE(I,j,1) = SIGE(1)*PZ(I,j) + PTOP  
       enddo  
       enddo  
         
       DO L = 1,lm  
       do j = 1,jm  
       DO I = 1,im  
       PLZ (I,j,L  ) = SIG (L)  *PZ(I,j) + PTOP  
       PLZE(I,j,L+1) = SIGE(L+1)*PZ(I,j) + PTOP  
       ENDDO  
       ENDDO  
       ENDDO  
   
       call pkappa ( pz,pkht,pkz,ptop,sige,dsig,im,jm,lm )  
   
113  C Compute Temperature from Theta  C Compute Temperature from Theta
114  C ------------------------------  C ------------------------------
115        do L=1,lm        do L=1,lm
# Line 163  C ------------------------------ Line 120  C ------------------------------
120        enddo        enddo
121        enddo        enddo
122    
 c Determine Level Indices for Low-Mid-High Cloud Regions  
 c ------------------------------------------------------  
       low_level = lm  
       mid_level = lm  
       do L = lm-1,1,-1  
       pcheck = (1000.-ptop)*sig(l) + ptop  
       if (pcheck.gt.700.0) low_level = L  
       if (pcheck.gt.400.0) mid_level = L  
       enddo  
   
123        if (first .and. myid.eq.0 ) then        if (first .and. myid.eq.0 ) then
124        print *        print *
125        print *,'Low-Level Clouds are Grouped between levels: ',        print *,'Low-Level Clouds are Grouped between levels: ',
# Line 187  C ************************************** Line 134  C **************************************
134  C ****             CALCULATE COSINE OF THE ZENITH ANGLE             ****  C ****             CALCULATE COSINE OF THE ZENITH ANGLE             ****
135  C **********************************************************************  C **********************************************************************
136    
137        CALL ASTRO ( NYMD,   NHMS,  ALAT,ALON, im*jm, TEMP1,RA )        CALL ASTRO ( NYMD,   NHMS,  XLATS,XLONS, im*jm, TEMP1,RA )
138                     NYMD2 = NYMD                     NYMD2 = NYMD
139                     NHMS2 = NHMS                     NHMS2 = NHMS
140        CALL TICK  ( NYMD2,  NHMS2, NTMSTP )        CALL TICK  ( NYMD2,  NHMS2, NTMSTP )
141        CALL ASTRO ( NYMD2,  NHMS2, ALAT,ALON, im*jm, TEMP2,RA )        CALL ASTRO ( NYMD2,  NHMS2, XLATS,XLONS, im*jm, TEMP2,RA )
142    
143        do j = 1,jm        do j = 1,jm
144        do i = 1,im        do i = 1,im
# Line 278  c ------------------------- Line 225  c -------------------------
225        if(icldfrc.gt.0) then        if(icldfrc.gt.0) then
226        do j=1,jm        do j=1,jm
227        do i=1,im        do i=1,im
228        qdiag(i,j,icldfrc) =  qdiag(i,j,icldfrc) + totcld(i,j)        qdiag(i,j,icldfrc,bi,bj) =  qdiag(i,j,icldfrc,bi,bj) + totcld(i,j)
229        enddo        enddo
230        enddo        enddo
231        ncldfrc = ncldfrc + 1        ncldfrc = ncldfrc + 1
# Line 288  c ------------------------- Line 235  c -------------------------
235        do L=1,lm        do L=1,lm
236        do j=1,jm        do j=1,jm
237        do i=1,im        do i=1,im
238        qdiag(i,j,icldras+L-1) = qdiag(i,j,icldras+L-1) + cswmo(i,j,L)        qdiag(i,j,icldras+L-1,bi,bj) = qdiag(i,j,icldras+L-1,bi,bj) +
239         .                                                     cswmo(i,j,L)
240        enddo        enddo
241        enddo        enddo
242        enddo        enddo
# Line 299  c ------------------------- Line 247  c -------------------------
247        do L=1,lm        do L=1,lm
248        do j=1,jm        do j=1,jm
249        do i=1,im        do i=1,im
250        qdiag(i,j,icldtot+L-1) = qdiag(i,j,icldtot+L-1) + cldtot(i,j,L)        qdiag(i,j,icldtot+L-1,bi,bj) = qdiag(i,j,icldtot+L-1,bi,bj) +
251         .                                                     cldtot(i,j,L)
252        enddo        enddo
253        enddo        enddo
254        enddo        enddo
# Line 309  c ------------------------- Line 258  c -------------------------
258        if( icldlow.gt.0 ) then        if( icldlow.gt.0 ) then
259        do j=1,jm        do j=1,jm
260        do i=1,im        do i=1,im
261        qdiag(i,j,icldlow) = qdiag(i,j,icldlow) + cldlow(i,j)        qdiag(i,j,icldlow,bi,bj) = qdiag(i,j,icldlow,bi,bj) + cldlow(i,j)
262        enddo        enddo
263        enddo        enddo
264        ncldlow = ncldlow + 1        ncldlow = ncldlow + 1
# Line 318  c ------------------------- Line 267  c -------------------------
267        if( icldmid.gt.0 ) then        if( icldmid.gt.0 ) then
268        do j=1,jm        do j=1,jm
269        do i=1,im        do i=1,im
270        qdiag(i,j,icldmid) = qdiag(i,j,icldmid) + cldmid(i,j)        qdiag(i,j,icldmid,bi,bj) = qdiag(i,j,icldmid,bi,bj) + cldmid(i,j)
271        enddo        enddo
272        enddo        enddo
273        ncldmid = ncldmid + 1        ncldmid = ncldmid + 1
# Line 327  c ------------------------- Line 276  c -------------------------
276        if( icldhi.gt.0 ) then        if( icldhi.gt.0 ) then
277        do j=1,jm        do j=1,jm
278        do i=1,im        do i=1,im
279        qdiag(i,j,icldhi) = qdiag(i,j,icldhi) + cldhi(i,j)        qdiag(i,j,icldhi,bi,bj) = qdiag(i,j,icldhi,bi,bj) + cldhi(i,j)
280        enddo        enddo
281        enddo        enddo
282        ncldhi = ncldhi + 1        ncldhi = ncldhi + 1
# Line 337  c ------------------------- Line 286  c -------------------------
286        do L=1,lm        do L=1,lm
287        do j=1,jm        do j=1,jm
288        do i=1,im        do i=1,im
289        qdiag(i,j,ilzrad+L-1) = qdiag(i,j,ilzrad+L-1) + swlz(i,j,L)*1.0e6        qdiag(i,j,ilzrad+L-1,bi,bj) = qdiag(i,j,ilzrad+L-1,bi,bj) +
290         .                                                     swlz(i,j,L)*1.0e6
291        enddo        enddo
292        enddo        enddo
293        enddo        enddo
# Line 349  c ------------------ Line 299  c ------------------
299        if( ialbvisdr.gt.0 ) then        if( ialbvisdr.gt.0 ) then
300        do j=1,jm        do j=1,jm
301        do i=1,im        do i=1,im
302        qdiag(i,j,ialbvisdr) = qdiag(i,j,ialbvisdr) + albvisdr(i,j)        qdiag(i,j,ialbvisdr,bi,bj) = qdiag(i,j,ialbvisdr,bi,bj) +
303         .                                                     albvisdr(i,j)
304        enddo        enddo
305        enddo        enddo
306        nalbvisdr = nalbvisdr + 1        nalbvisdr = nalbvisdr + 1
# Line 358  c ------------------ Line 309  c ------------------
309        if( ialbvisdf.gt.0 ) then        if( ialbvisdf.gt.0 ) then
310        do j=1,jm        do j=1,jm
311        do i=1,im        do i=1,im
312        qdiag(i,j,ialbvisdf) = qdiag(i,j,ialbvisdf) + albvisdf(i,j)        qdiag(i,j,ialbvisdf,bi,bj) = qdiag(i,j,ialbvisdf,bi,bj) +
313         .                                                     albvisdf(i,j)
314        enddo        enddo
315        enddo        enddo
316        nalbvisdf = nalbvisdf + 1        nalbvisdf = nalbvisdf + 1
# Line 367  c ------------------ Line 319  c ------------------
319        if( ialbnirdr.gt.0 ) then        if( ialbnirdr.gt.0 ) then
320        do j=1,jm        do j=1,jm
321        do i=1,im        do i=1,im
322        qdiag(i,j,ialbnirdr) = qdiag(i,j,ialbnirdr) + albnirdr(i,j)        qdiag(i,j,ialbnirdr,bi,bj) = qdiag(i,j,ialbnirdr,bi,bj) +
323         .                                                     albnirdr(i,j)
324        enddo        enddo
325        enddo        enddo
326        nalbnirdr = nalbnirdr + 1        nalbnirdr = nalbnirdr + 1
# Line 376  c ------------------ Line 329  c ------------------
329        if( ialbnirdf.gt.0 ) then        if( ialbnirdf.gt.0 ) then
330        do j=1,jm        do j=1,jm
331        do i=1,im        do i=1,im
332        qdiag(i,j,ialbnirdf) = qdiag(i,j,ialbnirdf) + albnirdf(i,j)        qdiag(i,j,ialbnirdf,bi,bj) = qdiag(i,j,ialbnirdf,bi,bj) +
333         .                                                     albnirdf(i,j)
334        enddo        enddo
335        enddo        enddo
336        nalbnirdf = nalbnirdf + 1        nalbnirdf = nalbnirdf + 1
# Line 399  C -------------------------------------- Line 353  C --------------------------------------
353        do L=1,lm        do L=1,lm
354        do j=1,jm        do j=1,jm
355        do i=1,im        do i=1,im
356        qdiag(i,j,itauave+L-1) = qdiag(i,j,itauave+L-1) +        qdiag(i,j,itauave+L-1,bi,bj) = qdiag(i,j,itauave+L-1,bi,bj) +
357       .                        tau(i,j,L)*100/(plze(i,j,L+1)-plze(i,j,L))       .                        tau(i,j,L)*100/(plze(i,j,L+1)-plze(i,j,L))
358        enddo        enddo
359        enddo        enddo
# Line 412  C -------------------------------------- Line 366  C --------------------------------------
366        do j=1,jm        do j=1,jm
367        do i=1,im        do i=1,im
368         if( cldtot(i,j,L).ne.0.0 ) then         if( cldtot(i,j,L).ne.0.0 ) then
369          qdiag(i,j,itaucld +L-1) = qdiag(i,j,itaucld +L-1) +          qdiag(i,j,itaucld +L-1,bi,bj) = qdiag(i,j,itaucld +L-1,bi,bj) +
370       .                        tau(i,j,L)*100/(plze(i,j,L+1)-plze(i,j,L))       .                        tau(i,j,L)*100/(plze(i,j,L+1)-plze(i,j,L))
371          qdiag(i,j,itaucldc+L-1) = qdiag(i,j,itaucldc+L-1) + 1.0          qdiag(i,j,itaucldc+L-1,bi,bj) =
372         .                             qdiag(i,j,itaucldc+L-1,bi,bj) + 1.0
373         endif         endif
374        enddo        enddo
375        enddo        enddo
# Line 424  C -------------------------------------- Line 379  C --------------------------------------
379  c Compute Low, Mid, and High Cloud Optical Depth Diagnostics  c Compute Low, Mid, and High Cloud Optical Depth Diagnostics
380  c ----------------------------------------------------------  c ----------------------------------------------------------
381        if( itaulow.ne.0 ) then        if( itaulow.ne.0 ) then
382            do j = 1,jm         do j = 1,jm
383            do i = 1,im         do i = 1,im
384            if( cldlow(i,j).ne.0.0 ) then          if( cldlow(i,j).ne.0.0 ) then
385                taulow(i,j) =  0.0           taulow(i,j) =  0.0
386                do L = low_level,lm           do L = low_level,lm
387                taulow(i,j) = taulow(i,j) + tau(i,j,L)            taulow(i,j) = taulow(i,j) + tau(i,j,L)
388                enddo           enddo
389                 qdiag(i,j,itaulow ) = qdiag(i,j,itaulow ) + taulow(i,j)           qdiag(i,j,itaulow,bi,bj ) = qdiag(i,j,itaulow,bi,bj ) +
390                 qdiag(i,j,itaulowc) = qdiag(i,j,itaulowc) + 1.0       .                                                    taulow(i,j)
391            endif           qdiag(i,j,itaulowc,bi,bj) = qdiag(i,j,itaulowc,bi,bj) + 1.0
392            enddo          endif
393            enddo         enddo
394           enddo
395        endif        endif
396    
397        if( itaumid.ne.0 ) then        if( itaumid.ne.0 ) then
398            do j = 1,jm         do j = 1,jm
399            do i = 1,im         do i = 1,im
400            if( cldmid(i,j).ne.0.0 ) then          if( cldmid(i,j).ne.0.0 ) then
401                taumid(i,j) =  0.0           taumid(i,j) =  0.0
402                do L = mid_level,low_level+1           do L = mid_level,low_level+1
403                taumid(i,j) = taumid(i,j) + tau(i,j,L)            taumid(i,j) = taumid(i,j) + tau(i,j,L)
404                enddo           enddo
405                 qdiag(i,j,itaumid ) = qdiag(i,j,itaumid ) + taumid(i,j)           qdiag(i,j,itaumid,bi,bj ) = qdiag(i,j,itaumid,bi,bj ) +
406                 qdiag(i,j,itaumidc) = qdiag(i,j,itaumidc) + 1.0       .                                                    taumid(i,j)
407            endif           qdiag(i,j,itaumidc,bi,bj) = qdiag(i,j,itaumidc,bi,bj) + 1.0
408            enddo          endif
409            enddo         enddo
410           enddo
411        endif        endif
412    
413        if( itauhi.ne.0 ) then        if( itauhi.ne.0 ) then
414            do j = 1,jm         do j = 1,jm
415            do i = 1,im         do i = 1,im
416            if( cldhi(i,j).ne.0.0 ) then          if( cldhi(i,j).ne.0.0 ) then
417                tauhi(i,j) =  0.0           tauhi(i,j) =  0.0
418                do L = 1,mid_level+1           do L = 1,mid_level+1
419                tauhi(i,j) = tauhi(i,j) + tau(i,j,L)            tauhi(i,j) = tauhi(i,j) + tau(i,j,L)
420                enddo           enddo
421                 qdiag(i,j,itauhi ) = qdiag(i,j,itauhi ) + tauhi(i,j)           qdiag(i,j,itauhi,bi,bj ) = qdiag(i,j,itauhi,bi,bj ) +
422                 qdiag(i,j,itauhic) = qdiag(i,j,itauhic) + 1.0       .                                                   tauhi(i,j)
423            endif           qdiag(i,j,itauhic,bi,bj) = qdiag(i,j,itauhic,bi,bj) + 1.0
424            enddo          endif
425            enddo         enddo
426           enddo
427        endif        endif
428    
429  C***********************************************************************  C***********************************************************************
# Line 480  C ************************************** Line 438  C **************************************
438    
439        CALL STRIP ( zenith,COSZ,im*jm,ISTRIP,1,NN )        CALL STRIP ( zenith,COSZ,im*jm,ISTRIP,1,NN )
440    
441        CALL STRIP ( plze, ple   ,im*jm,ISTRIP,lm+1,NN)        CALL STRIP ( plze,  ple   ,im*jm,ISTRIP,lm+1,NN)
442        CALL STRIP ( pkz , pk    ,im*jm,ISTRIP,lm  ,NN)        CALL STRIP ( pkz ,  pk    ,im*jm,ISTRIP,lm  ,NN)
443        CALL STRIP ( tdry, tzl   ,im*jm,ISTRIP,lm  ,NN)        CALL STRIP ( dpres,dpstrip,im*jm,ISTRIP,lm  ,NN)
444        CALL STRIP ( qz  , qzl   ,im*jm,ISTRIP,lm  ,NN)        CALL STRIP ( tdry,  tzl   ,im*jm,ISTRIP,lm  ,NN)
445        CALL STRIP ( oz  , ozl   ,im*jm,ISTRIP,lm  ,NN)        CALL STRIP ( qz  ,  qzl   ,im*jm,ISTRIP,lm  ,NN)
446        CALL STRIP ( tau , taul  ,im*jm,ISTRIP,lm  ,NN)        CALL STRIP ( oz  ,  ozl   ,im*jm,ISTRIP,lm  ,NN)
447          CALL STRIP ( tau ,  taul  ,im*jm,ISTRIP,lm  ,NN)
448    
449        CALL STRIP ( albvisdr,albuvdr,im*jm,ISTRIP,1,NN )        CALL STRIP ( albvisdr,albuvdr,im*jm,ISTRIP,1,NN )
450        CALL STRIP ( albvisdf,albuvdf,im*jm,ISTRIP,1,NN )        CALL STRIP ( albvisdf,albuvdf,im*jm,ISTRIP,1,NN )
# Line 532  C ****     Compute Mass-Weighted Theta T Line 491  C ****     Compute Mass-Weighted Theta T
491  C **********************************************************************  C **********************************************************************
492    
493        do l=1,lm        do l=1,lm
       alf = grav/(cp*dsig(L)*100)  
494        do i=1,istrip        do i=1,istrip
495          alf = grav*(ple(i,L+1)-ptop)/(cp*dpstrip(i,L)*100)
496        dtsw (i,L) = alf*( flux   (i,L)-flux   (i,L+1) )/pk(i,L)        dtsw (i,L) = alf*( flux   (i,L)-flux   (i,L+1) )/pk(i,L)
497        dtswc(i,L) = alf*( fluxclr(i,L)-fluxclr(i,L+1) )/pk(i,L)        dtswc(i,L) = alf*( fluxclr(i,L)-fluxclr(i,L+1) )/pk(i,L)
498        enddo        enddo
# Line 572  c ---------------------- Line 531  c ----------------------
531        do j=1,jm        do j=1,jm
532        do i=1,im        do i=1,im
533        if( albedo(i,j).ne.undef ) then        if( albedo(i,j).ne.undef ) then
534        qdiag(i,j,ialbedo ) = qdiag(i,j,ialbedo ) + albedo(i,j)        qdiag(i,j,ialbedo,bi,bj ) = qdiag(i,j,ialbedo,bi,bj )+albedo(i,j)
535        qdiag(i,j,ialbedoc) = qdiag(i,j,ialbedoc) + 1.0        qdiag(i,j,ialbedoc,bi,bj) = qdiag(i,j,ialbedoc,bi,bj) + 1.0
536        endif        endif
537        enddo        enddo
538        enddo        enddo
# Line 1074  c-----pre-computed table Line 1033  c-----pre-computed table
1033    
1034  c-----include the pre-computed table for cai  c-----include the pre-computed table for cai
1035    
1036        include 'cai.dat'  #include "cai-dat.h"
1037        save caib,caif  #     save caib,caif
1038    
1039    
1040  c-----clouds within each of the high, middle, and low clouds are  c-----clouds within each of the high, middle, and low clouds are
# Line 2549  c-----temporary array Line 2508  c-----temporary array
2508  c********************************************************************  c********************************************************************
2509  c-----include co2 look-up table  c-----include co2 look-up table
2510    
2511        include 'cah.dat'  #include "cah-dat.h"
2512        save cah  #     save cah
2513    
2514  c********************************************************************  c********************************************************************
2515  c-----table look-up for the reduction of clear-sky solar  c-----table look-up for the reduction of clear-sky solar
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22