/[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.12 by molod, Mon Jul 26 18:45:17 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 swrio (nymd,nhms,ndswr,myid,istrip,npcs,        subroutine swrio (nymd,nhms,bi,bj,ndswr,myid,istrip,npcs,
6       .        pz,tz,qz,pkht,oz,co2,       .        low_level,mid_level,
7         .        pz,plz,plze,dpres,pkht,pkz,tz,qz,oz,co2,
8       .        albvisdr,albvisdf,albnirdr,albnirdf,       .        albvisdr,albvisdf,albnirdr,albnirdf,
9       .        dtradsw,dtswclr,radswg,swgclr,albedo,       .        dtradsw,dtswclr,radswg,swgclr,
10       .        fdifpar,fdirpar,osr,osrclr,       .        fdifpar,fdirpar,osr,osrclr,
11       .        im,jm,lm,sige,sig,dsig,ptop,       .        im,jm,lm,ptop,
12       .        nswcld,cldsw,cswmo,nswlz,swlz,       .        nswcld,cldsw,cswmo,nswlz,swlz,
13       .        lpnt,imstturb,qliqave,fccave,landtype,xlats,xlons)       .        lpnt,imstturb,qliqave,fccave,landtype,xlats,xlons)
14    
15        implicit none        implicit none
16  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
17    #include "SIZE.h"
18    #include "diagnostics_SIZE.h"
19  #include "diagnostics.h"  #include "diagnostics.h"
20  #endif  #endif
21    
22  c Input Variables  c Input Variables
23  c ---------------  c ---------------
24        integer nymd,nhms,ndswr,istrip,npcs        integer nymd,nhms,bi,bj,ndswr,myid,istrip,npcs
25          integer mid_level,low_level
26        integer im,jm,lm                integer im,jm,lm        
27        real  ptop                      _RL  ptop
28        real  sige(lm+1)                _RL pz(im,jm),plz(im,jm,lm),plze(im,jm,lm+1),dpres(im,jm,lm)
29        real   sig(lm)                  _RL pkht(im,jm,lm+1),pkz(im,jm,lm)
30        real  dsig(lm)                  _RL tz(im,jm,lm),qz(im,jm,lm)
31          _RL oz(im,jm,lm)
32        real    pz(im,jm)              _RL co2
33        real    tz(im,jm,lm)            _RL albvisdr(im,jm),albvisdf(im,jm),albnirdr(im,jm)
34        real  pkht(im,jm,lm)            _RL albnirdf(im,jm)
35          _RL radswg(im,jm),swgclr(im,jm),fdifpar(im,jm),fdirpar(im,jm)
36        real    co2                    _RL 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)  
   
37        integer nswcld,nswlz            integer nswcld,nswlz    
38        real  cldsw(im,jm,lm)          _RL cldsw(im,jm,lm),cswmo(im,jm,lm),swlz(im,jm,lm)  
       real  cswmo(im,jm,lm)    
       real   swlz(im,jm,lm)    
   
39        logical lpnt                    logical lpnt            
40        integer imstturb                integer imstturb        
41        real qliqave(im,jm,lm)          _RL qliqave(im,jm,lm),fccave(im,jm,lm)  
       real  fccave(im,jm,lm)    
   
42        integer landtype(im,jm)        integer landtype(im,jm)
43          _RL xlats(im,jm),xlons(im,jm)
44    
45  c Local Variables  c Local Variables
46  c ---------------  c ---------------
47        integer   i,j,L,nn,nsecf,mid_level, low_level        integer   i,j,L,nn,nsecf
48        integer   nb2,ntmstp,nymd2,nhms2        integer   ntmstp,nymd2,nhms2
49        real      getcon,grav,cp,undef,pcheck        _RL      getcon,grav,cp,undef
50        real      ra,alf,reffw,reffi,tminv        _RL      ra,alf,reffw,reffi,tminv
51    
52        parameter ( reffw = 10.0 )          parameter ( reffw = 10.0 )  
53        parameter ( reffi = 65.0 )          parameter ( reffi = 65.0 )  
54    
55        real      alat(im,jm)        _RL tdry(im,jm,lm)
56        real      alon(im,jm)        _RL TEMP1(im,jm)
57          _RL TEMP2(im,jm)
58          _RL zenith (im,jm)
59          _RL cldtot (im,jm,lm)
60          _RL cldmxo (im,jm,lm)
61          _RL totcld (im,jm)
62          _RL cldlow (im,jm)
63          _RL cldmid (im,jm)
64          _RL cldhi  (im,jm)
65          _RL taulow (im,jm)
66          _RL taumid (im,jm)
67          _RL tauhi  (im,jm)
68          _RL tautype(im,jm,lm,3)
69          _RL tau(im,jm,lm)
70          _RL albedo(im,jm)    
71    
72          _RL PK(ISTRIP,lm)
73          _RL qzl(ISTRIP,lm),CLRO(ISTRIP,lm)
74          _RL TZL(ISTRIP,lm)
75          _RL OZL(ISTRIP,lm)
76          _RL PLE(ISTRIP,lm+1)
77          _RL COSZ(ISTRIP)
78          _RL dpstrip(ISTRIP,lm)
79    
80          _RL albuvdr(ISTRIP),albuvdf(ISTRIP)
81          _RL albirdr(ISTRIP),albirdf(ISTRIP)
82          _RL difpar (ISTRIP),dirpar (ISTRIP)
83    
84          _RL fdirir(istrip),fdifir(istrip)
85          _RL fdiruv(istrip),fdifuv(istrip)
86    
87          _RL flux(istrip,lm+1)
88          _RL fluxclr(istrip,lm+1)
89          _RL dtsw(istrip,lm)
90          _RL dtswc(istrip,lm)
91    
92          _RL taul   (istrip,lm)
93          _RL reff   (istrip,lm,2)
94          _RL tauc   (istrip,lm,2)
95          _RL taua   (istrip,lm)
96          _RL tstrip (istrip)
97    
98        real          PKZ(im,jm,lm)        logical first
99        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/  
100    
101  C **********************************************************************  C **********************************************************************
102  C ****                       INITIALIZATION                         ****  C ****                       INITIALIZATION                         ****
# Line 136  C ************************************** Line 109  C **************************************
109        NTMSTP = nsecf(NDSWR)        NTMSTP = nsecf(NDSWR)
110        TMINV  = 1./float(ntmstp)        TMINV  = 1./float(ntmstp)
111    
       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 )  
   
112  C Compute Temperature from Theta  C Compute Temperature from Theta
113  C ------------------------------  C ------------------------------
114        do L=1,lm        do L=1,lm
# Line 163  C ------------------------------ Line 119  C ------------------------------
119        enddo        enddo
120        enddo        enddo
121    
 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  
   
122        if (first .and. myid.eq.0 ) then        if (first .and. myid.eq.0 ) then
123        print *        print *
124        print *,'Low-Level Clouds are Grouped between levels: ',        print *,'Low-Level Clouds are Grouped between levels: ',
# Line 187  C ************************************** Line 133  C **************************************
133  C ****             CALCULATE COSINE OF THE ZENITH ANGLE             ****  C ****             CALCULATE COSINE OF THE ZENITH ANGLE             ****
134  C **********************************************************************  C **********************************************************************
135    
136        CALL ASTRO ( NYMD,   NHMS,  ALAT,ALON, im*jm, TEMP1,RA )        CALL ASTRO ( NYMD,   NHMS,  XLATS,XLONS, im*jm, TEMP1,RA )
137                     NYMD2 = NYMD                     NYMD2 = NYMD
138                     NHMS2 = NHMS                     NHMS2 = NHMS
139        CALL TICK  ( NYMD2,  NHMS2, NTMSTP )        CALL TICK  ( NYMD2,  NHMS2, NTMSTP )
140        CALL ASTRO ( NYMD2,  NHMS2, ALAT,ALON, im*jm, TEMP2,RA )        CALL ASTRO ( NYMD2,  NHMS2, XLATS,XLONS, im*jm, TEMP2,RA )
141    
142        do j = 1,jm        do j = 1,jm
143        do i = 1,im        do i = 1,im
# Line 278  c ------------------------- Line 224  c -------------------------
224        if(icldfrc.gt.0) then        if(icldfrc.gt.0) then
225        do j=1,jm        do j=1,jm
226        do i=1,im        do i=1,im
227        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)
228        enddo        enddo
229        enddo        enddo
230        ncldfrc = ncldfrc + 1        ncldfrc = ncldfrc + 1
# Line 288  c ------------------------- Line 234  c -------------------------
234        do L=1,lm        do L=1,lm
235        do j=1,jm        do j=1,jm
236        do i=1,im        do i=1,im
237        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) +
238         .                                                     cswmo(i,j,L)
239        enddo        enddo
240        enddo        enddo
241        enddo        enddo
# Line 299  c ------------------------- Line 246  c -------------------------
246        do L=1,lm        do L=1,lm
247        do j=1,jm        do j=1,jm
248        do i=1,im        do i=1,im
249        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) +
250         .                                                     cldtot(i,j,L)
251        enddo        enddo
252        enddo        enddo
253        enddo        enddo
# Line 309  c ------------------------- Line 257  c -------------------------
257        if( icldlow.gt.0 ) then        if( icldlow.gt.0 ) then
258        do j=1,jm        do j=1,jm
259        do i=1,im        do i=1,im
260        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)
261        enddo        enddo
262        enddo        enddo
263        ncldlow = ncldlow + 1        ncldlow = ncldlow + 1
# Line 318  c ------------------------- Line 266  c -------------------------
266        if( icldmid.gt.0 ) then        if( icldmid.gt.0 ) then
267        do j=1,jm        do j=1,jm
268        do i=1,im        do i=1,im
269        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)
270        enddo        enddo
271        enddo        enddo
272        ncldmid = ncldmid + 1        ncldmid = ncldmid + 1
# Line 327  c ------------------------- Line 275  c -------------------------
275        if( icldhi.gt.0 ) then        if( icldhi.gt.0 ) then
276        do j=1,jm        do j=1,jm
277        do i=1,im        do i=1,im
278        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)
279        enddo        enddo
280        enddo        enddo
281        ncldhi = ncldhi + 1        ncldhi = ncldhi + 1
# Line 337  c ------------------------- Line 285  c -------------------------
285        do L=1,lm        do L=1,lm
286        do j=1,jm        do j=1,jm
287        do i=1,im        do i=1,im
288        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) +
289         .                                                     swlz(i,j,L)*1.0e6
290        enddo        enddo
291        enddo        enddo
292        enddo        enddo
# Line 349  c ------------------ Line 298  c ------------------
298        if( ialbvisdr.gt.0 ) then        if( ialbvisdr.gt.0 ) then
299        do j=1,jm        do j=1,jm
300        do i=1,im        do i=1,im
301        qdiag(i,j,ialbvisdr) = qdiag(i,j,ialbvisdr) + albvisdr(i,j)        qdiag(i,j,ialbvisdr,bi,bj) = qdiag(i,j,ialbvisdr,bi,bj) +
302         .                                                     albvisdr(i,j)
303        enddo        enddo
304        enddo        enddo
305        nalbvisdr = nalbvisdr + 1        nalbvisdr = nalbvisdr + 1
# Line 358  c ------------------ Line 308  c ------------------
308        if( ialbvisdf.gt.0 ) then        if( ialbvisdf.gt.0 ) then
309        do j=1,jm        do j=1,jm
310        do i=1,im        do i=1,im
311        qdiag(i,j,ialbvisdf) = qdiag(i,j,ialbvisdf) + albvisdf(i,j)        qdiag(i,j,ialbvisdf,bi,bj) = qdiag(i,j,ialbvisdf,bi,bj) +
312         .                                                     albvisdf(i,j)
313        enddo        enddo
314        enddo        enddo
315        nalbvisdf = nalbvisdf + 1        nalbvisdf = nalbvisdf + 1
# Line 367  c ------------------ Line 318  c ------------------
318        if( ialbnirdr.gt.0 ) then        if( ialbnirdr.gt.0 ) then
319        do j=1,jm        do j=1,jm
320        do i=1,im        do i=1,im
321        qdiag(i,j,ialbnirdr) = qdiag(i,j,ialbnirdr) + albnirdr(i,j)        qdiag(i,j,ialbnirdr,bi,bj) = qdiag(i,j,ialbnirdr,bi,bj) +
322         .                                                     albnirdr(i,j)
323        enddo        enddo
324        enddo        enddo
325        nalbnirdr = nalbnirdr + 1        nalbnirdr = nalbnirdr + 1
# Line 376  c ------------------ Line 328  c ------------------
328        if( ialbnirdf.gt.0 ) then        if( ialbnirdf.gt.0 ) then
329        do j=1,jm        do j=1,jm
330        do i=1,im        do i=1,im
331        qdiag(i,j,ialbnirdf) = qdiag(i,j,ialbnirdf) + albnirdf(i,j)        qdiag(i,j,ialbnirdf,bi,bj) = qdiag(i,j,ialbnirdf,bi,bj) +
332         .                                                     albnirdf(i,j)
333        enddo        enddo
334        enddo        enddo
335        nalbnirdf = nalbnirdf + 1        nalbnirdf = nalbnirdf + 1
# Line 399  C -------------------------------------- Line 352  C --------------------------------------
352        do L=1,lm        do L=1,lm
353        do j=1,jm        do j=1,jm
354        do i=1,im        do i=1,im
355        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) +
356       .                        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))
357        enddo        enddo
358        enddo        enddo
# Line 412  C -------------------------------------- Line 365  C --------------------------------------
365        do j=1,jm        do j=1,jm
366        do i=1,im        do i=1,im
367         if( cldtot(i,j,L).ne.0.0 ) then         if( cldtot(i,j,L).ne.0.0 ) then
368          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) +
369       .                        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))
370          qdiag(i,j,itaucldc+L-1) = qdiag(i,j,itaucldc+L-1) + 1.0          qdiag(i,j,itaucldc+L-1,bi,bj) =
371         .                             qdiag(i,j,itaucldc+L-1,bi,bj) + 1.0
372         endif         endif
373        enddo        enddo
374        enddo        enddo
# Line 424  C -------------------------------------- Line 378  C --------------------------------------
378  c Compute Low, Mid, and High Cloud Optical Depth Diagnostics  c Compute Low, Mid, and High Cloud Optical Depth Diagnostics
379  c ----------------------------------------------------------  c ----------------------------------------------------------
380        if( itaulow.ne.0 ) then        if( itaulow.ne.0 ) then
381            do j = 1,jm         do j = 1,jm
382            do i = 1,im         do i = 1,im
383            if( cldlow(i,j).ne.0.0 ) then          if( cldlow(i,j).ne.0.0 ) then
384                taulow(i,j) =  0.0           taulow(i,j) =  0.0
385                do L = low_level,lm           do L = low_level,lm
386                taulow(i,j) = taulow(i,j) + tau(i,j,L)            taulow(i,j) = taulow(i,j) + tau(i,j,L)
387                enddo           enddo
388                 qdiag(i,j,itaulow ) = qdiag(i,j,itaulow ) + taulow(i,j)           qdiag(i,j,itaulow,bi,bj ) = qdiag(i,j,itaulow,bi,bj ) +
389                 qdiag(i,j,itaulowc) = qdiag(i,j,itaulowc) + 1.0       .                                                    taulow(i,j)
390            endif           qdiag(i,j,itaulowc,bi,bj) = qdiag(i,j,itaulowc,bi,bj) + 1.0
391            enddo          endif
392            enddo         enddo
393           enddo
394        endif        endif
395    
396        if( itaumid.ne.0 ) then        if( itaumid.ne.0 ) then
397            do j = 1,jm         do j = 1,jm
398            do i = 1,im         do i = 1,im
399            if( cldmid(i,j).ne.0.0 ) then          if( cldmid(i,j).ne.0.0 ) then
400                taumid(i,j) =  0.0           taumid(i,j) =  0.0
401                do L = mid_level,low_level+1           do L = mid_level,low_level+1
402                taumid(i,j) = taumid(i,j) + tau(i,j,L)            taumid(i,j) = taumid(i,j) + tau(i,j,L)
403                enddo           enddo
404                 qdiag(i,j,itaumid ) = qdiag(i,j,itaumid ) + taumid(i,j)           qdiag(i,j,itaumid,bi,bj ) = qdiag(i,j,itaumid,bi,bj ) +
405                 qdiag(i,j,itaumidc) = qdiag(i,j,itaumidc) + 1.0       .                                                    taumid(i,j)
406            endif           qdiag(i,j,itaumidc,bi,bj) = qdiag(i,j,itaumidc,bi,bj) + 1.0
407            enddo          endif
408            enddo         enddo
409           enddo
410        endif        endif
411    
412        if( itauhi.ne.0 ) then        if( itauhi.ne.0 ) then
413            do j = 1,jm         do j = 1,jm
414            do i = 1,im         do i = 1,im
415            if( cldhi(i,j).ne.0.0 ) then          if( cldhi(i,j).ne.0.0 ) then
416                tauhi(i,j) =  0.0           tauhi(i,j) =  0.0
417                do L = 1,mid_level+1           do L = 1,mid_level+1
418                tauhi(i,j) = tauhi(i,j) + tau(i,j,L)            tauhi(i,j) = tauhi(i,j) + tau(i,j,L)
419                enddo           enddo
420                 qdiag(i,j,itauhi ) = qdiag(i,j,itauhi ) + tauhi(i,j)           qdiag(i,j,itauhi,bi,bj ) = qdiag(i,j,itauhi,bi,bj ) +
421                 qdiag(i,j,itauhic) = qdiag(i,j,itauhic) + 1.0       .                                                   tauhi(i,j)
422            endif           qdiag(i,j,itauhic,bi,bj) = qdiag(i,j,itauhic,bi,bj) + 1.0
423            enddo          endif
424            enddo         enddo
425           enddo
426        endif        endif
427    
428  C***********************************************************************  C***********************************************************************
# Line 480  C ************************************** Line 437  C **************************************
437    
438        CALL STRIP ( zenith,COSZ,im*jm,ISTRIP,1,NN )        CALL STRIP ( zenith,COSZ,im*jm,ISTRIP,1,NN )
439    
440        CALL STRIP ( plze, ple   ,im*jm,ISTRIP,lm+1,NN)        CALL STRIP ( plze,  ple   ,im*jm,ISTRIP,lm+1,NN)
441        CALL STRIP ( pkz , pk    ,im*jm,ISTRIP,lm  ,NN)        CALL STRIP ( pkz ,  pk    ,im*jm,ISTRIP,lm  ,NN)
442        CALL STRIP ( tdry, tzl   ,im*jm,ISTRIP,lm  ,NN)        CALL STRIP ( dpres,dpstrip,im*jm,ISTRIP,lm  ,NN)
443        CALL STRIP ( qz  , qzl   ,im*jm,ISTRIP,lm  ,NN)        CALL STRIP ( tdry,  tzl   ,im*jm,ISTRIP,lm  ,NN)
444        CALL STRIP ( oz  , ozl   ,im*jm,ISTRIP,lm  ,NN)        CALL STRIP ( qz  ,  qzl   ,im*jm,ISTRIP,lm  ,NN)
445        CALL STRIP ( tau , taul  ,im*jm,ISTRIP,lm  ,NN)        CALL STRIP ( oz  ,  ozl   ,im*jm,ISTRIP,lm  ,NN)
446          CALL STRIP ( tau ,  taul  ,im*jm,ISTRIP,lm  ,NN)
447    
448        CALL STRIP ( albvisdr,albuvdr,im*jm,ISTRIP,1,NN )        CALL STRIP ( albvisdr,albuvdr,im*jm,ISTRIP,1,NN )
449        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 490  C ****     Compute Mass-Weighted Theta T
490  C **********************************************************************  C **********************************************************************
491    
492        do l=1,lm        do l=1,lm
       alf = grav/(cp*dsig(L)*100)  
493        do i=1,istrip        do i=1,istrip
494          alf = grav*(ple(i,L+1)-ptop)/(cp*dpstrip(i,L)*100)
495        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)
496        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)
497        enddo        enddo
# Line 572  c ---------------------- Line 530  c ----------------------
530        do j=1,jm        do j=1,jm
531        do i=1,im        do i=1,im
532        if( albedo(i,j).ne.undef ) then        if( albedo(i,j).ne.undef ) then
533        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)
534        qdiag(i,j,ialbedoc) = qdiag(i,j,ialbedoc) + 1.0        qdiag(i,j,ialbedoc,bi,bj) = qdiag(i,j,ialbedoc,bi,bj) + 1.0
535        endif        endif
536        enddo        enddo
537        enddo        enddo
# Line 627  C                  tau(im,jm,lm,2):  Sus Line 585  C                  tau(im,jm,lm,2):  Sus
585  C                  tau(im,jm,lm,3):  Raindrops  C                  tau(im,jm,lm,3):  Raindrops
586  C  C
587  C***********************************************************************  C***********************************************************************
 C*                  GODDARD LABORATORY FOR ATMOSPHERES                 *  
 C***********************************************************************  
588    
589        implicit none        implicit none
590    
591        integer  im,jm,lm,i,j,L        integer  im,jm,lm,i,j,L
592    
593        real  tl(im,jm,lm)        _RL  tl(im,jm,lm)
594        real  pl(im,jm,lm)        _RL  pl(im,jm,lm)
595        real ple(im,jm,lm+1)        _RL ple(im,jm,lm+1)
596        real  lz(im,jm,lm)        _RL  lz(im,jm,lm)
597        real  cf(im,jm,lm)        _RL  cf(im,jm,lm)
598        real cfm(im,jm,lm)        _RL cfm(im,jm,lm)
599        real tau(im,jm,lm,3)        _RL tau(im,jm,lm,3)
600        integer lwi(im,jm)        integer lwi(im,jm)
601    
602        real dp, alf, fracls, fraccu        _RL dp, alf, fracls, fraccu
603        real tauice, tauh2o, tauras        _RL tauice, tauh2o, tauras
604    
605  c Compute Cloud Optical Depths  c Compute Cloud Optical Depths
606  c ----------------------------  c ----------------------------
# Line 812  c*************************************** Line 768  c***************************************
768    
769  c-----Explicit Inline Directives  c-----Explicit Inline Directives
770    
771  #if CRAY  #ifdef CRAY
772  #if f77  #ifdef f77
773  cfpp$ expand (expmn)  cfpp$ expand (expmn)
774  #endif  #endif
775  #endif  #endif
776        real expmn        _RL expmn
777    
778  c-----input parameters  c-----input parameters
779    
780        integer m,n,ndim,np,ict,icb        integer m,n,ndim,np,ict,icb
781        real pl(m,ndim,np+1),ta(m,ndim,np),wa(m,ndim,np),oa(m,ndim,np)        _RL pl(m,ndim,np+1),ta(m,ndim,np),wa(m,ndim,np),oa(m,ndim,np)
782        real  taucld(m,ndim,np,2),reff(m,ndim,np,2)        _RL  taucld(m,ndim,np,2),reff(m,ndim,np,2)
783        real  fcld(m,ndim,np),taual(m,ndim,np)        _RL  fcld(m,ndim,np),taual(m,ndim,np)
784        real  rsirbm(m,ndim),rsirdf(m,ndim),        _RL  rsirbm(m,ndim),rsirdf(m,ndim),
785       *     rsuvbm(m,ndim),rsuvdf(m,ndim),cosz(m,ndim),co2       *     rsuvbm(m,ndim),rsuvdf(m,ndim),cosz(m,ndim),co2
786    
787  c-----output parameters  c-----output parameters
788    
789        real  flx(m,ndim,np+1),flc(m,ndim,np+1)        _RL  flx(m,ndim,np+1),flc(m,ndim,np+1)
790        real  fdirir(m,ndim),fdifir(m,ndim)        _RL  fdirir(m,ndim),fdifir(m,ndim)
791        real  fdirpar(m,ndim),fdifpar(m,ndim)        _RL  fdirpar(m,ndim),fdifpar(m,ndim)
792        real  fdiruv(m,ndim),fdifuv(m,ndim)        _RL  fdiruv(m,ndim),fdifuv(m,ndim)
793    
794  c-----temporary array  c-----temporary array
795    
796        integer i,j,k,ik        integer i,j,k
797        real  cc(m,n,3),tauclb(m,n,np),tauclf(m,n,np)        _RL  cc(m,n,3),tauclb(m,n,np),tauclf(m,n,np)
798        real  dp(m,n,np),wh(m,n,np),oh(m,n,np),scal(m,n,np)        _RL  dp(m,n,np),wh(m,n,np),oh(m,n,np),scal(m,n,np)
799        real  swh(m,n,np+1),so2(m,n,np+1),df(m,n,np+1)        _RL  swh(m,n,np+1),so2(m,n,np+1),df(m,n,np+1)
800        real  sdf(m,n),sclr(m,n),csm(m,n),taux,x        _RL  sdf(m,n),sclr(m,n),csm(m,n),x
801    
802  c-----------------------------------------------------------------  c-----------------------------------------------------------------
803    
# Line 1054  c*************************************** Line 1010  c***************************************
1010  c-----input parameters  c-----input parameters
1011    
1012        integer m,n,ndim,np,ict,icb        integer m,n,ndim,np,ict,icb
1013        real  cosz(m,ndim),fcld(m,ndim,np),taucld(m,ndim,np,2)        _RL  cosz(m,ndim),fcld(m,ndim,np),taucld(m,ndim,np,2)
1014    
1015  c-----output parameters  c-----output parameters
1016    
1017        real  cc(m,n,3),tauclb(m,n,np),tauclf(m,n,np)        _RL  cc(m,n,3),tauclb(m,n,np),tauclf(m,n,np)
1018    
1019  c-----temporary variables  c-----temporary variables
1020    
1021        integer i,j,k,im,it,ia,kk        integer i,j,k,im,it,ia,kk
1022        real   fm,ft,fa,xai,taucl,taux        _RL   fm,ft,fa,xai,taux
1023    
1024  c-----pre-computed table  c-----pre-computed table
1025    
1026        integer   nm,nt,na        integer   nm,nt,na
1027        parameter (nm=11,nt=9,na=11)        parameter (nm=11,nt=9,na=11)
1028        real   dm,dt,da,t1,caib(nm,nt,na),caif(nt,na)        _RL   dm,dt,da,t1,caib(nm,nt,na),caif(nt,na)
1029        parameter (dm=0.1,dt=0.30103,da=0.1,t1=-0.9031)        parameter (dm=0.1,dt=0.30103,da=0.1,t1=-0.9031)
1030    
1031  c-----include the pre-computed table for cai  c-----include the pre-computed table for cai
1032    
1033        include 'cai.dat'  #include "cai-dat.h"
1034        save caib,caif  c     save caib,caif
1035    
1036    
1037  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 1272  c*************************************** Line 1228  c***************************************
1228    
1229  c-----Explicit Inline Directives  c-----Explicit Inline Directives
1230    
1231  #if CRAY  #ifdef CRAY
1232  #if f77  #ifdef f77
1233  cfpp$ expand (deledd)  cfpp$ expand (deledd)
1234  cfpp$ expand (sagpol)  cfpp$ expand (sagpol)
1235  cfpp$ expand (expmn)  cfpp$ expand (expmn)
1236  #endif  #endif
1237  #endif  #endif
1238        real expmn        _RL expmn
1239    
1240  c-----input parameters  c-----input parameters
1241    
1242        integer m,n,ndim,np,ict,icb        integer m,n,ndim,np,ict,icb
1243        real  taucld(m,ndim,np,2),reff(m,ndim,np,2),fcld(m,ndim,np)        _RL  taucld(m,ndim,np,2),reff(m,ndim,np,2),fcld(m,ndim,np)
1244        real  tauclb(m,n,np),tauclf(m,n,np),cc(m,n,3)        _RL  tauclb(m,n,np),tauclf(m,n,np),cc(m,n,3)
1245        real  rsirbm(m,ndim),rsirdf(m,ndim)        _RL  rsirbm(m,ndim),rsirdf(m,ndim)
1246        real  wh(m,n,np),taual(m,ndim,np),csm(m,n)        _RL  wh(m,n,np),taual(m,ndim,np),csm(m,n)
1247    
1248  c-----output (updated) parameters  c-----output (updated) parameters
1249    
1250        real  flx(m,ndim,np+1),flc(m,ndim,np+1)        _RL  flx(m,ndim,np+1),flc(m,ndim,np+1)
1251        real  fdirir(m,ndim),fdifir(m,ndim)        _RL  fdirir(m,ndim),fdifir(m,ndim)
1252    
1253  c-----static parameters  c-----static parameters
1254    
1255        integer nk,nband        integer nk,nband
1256        parameter (nk=10,nband=3)        parameter (nk=10,nband=3)
1257        real  xk(nk),hk(nband,nk),ssaal(nband),asyal(nband)        _RL  xk(nk),hk(nband,nk),ssaal(nband),asyal(nband)
1258        real  aia(nband,3),awa(nband,3),aig(nband,3),awg(nband,3)        _RL  aia(nband,3),awa(nband,3),aig(nband,3),awg(nband,3)
1259    
1260  c-----temporary array  c-----temporary array
1261    
1262        integer ib,ik,i,j,k        integer ib,ik,i,j,k
1263        real  ssacl(m,n,np),asycl(m,n,np)        _RL  ssacl(m,n,np),asycl(m,n,np)
1264        real  rr(m,n,np+1,2),tt(m,n,np+1,2),td(m,n,np+1,2),        _RL  rr(m,n,np+1,2),tt(m,n,np+1,2),td(m,n,np+1,2),
1265       *       rs(m,n,np+1,2),ts(m,n,np+1,2)       *       rs(m,n,np+1,2),ts(m,n,np+1,2)
1266        real  rssab(m,n,np+1),rabx(m,n,np+1),rsabx(m,n,np+1)        _RL  fall(m,n,np+1),fclr(m,n,np+1)
1267        real  fall(m,n,np+1),fclr(m,n,np+1)        _RL  fsdir(m,n),fsdif(m,n)
1268        real  fsdir(m,n),fsdif(m,n)  
1269          _RL  tauwv,tausto,ssatau,asysto,tauto,ssato,asyto
1270        real  tauwv,tausto,ssatau,asysto,tauto,ssato,asyto        _RL  taux,reff1,reff2,w1,w2,g1,g2
1271        real  taux,reff1,reff2,w1,w2,g1,g2        _RL  ssaclt(m,n),asyclt(m,n)
1272        real  ssaclt(m,n),asyclt(m,n)        _RL  rr1t(m,n),tt1t(m,n),td1t(m,n),rs1t(m,n),ts1t(m,n)
1273        real  rr1t(m,n),tt1t(m,n),td1t(m,n),rs1t(m,n),ts1t(m,n)        _RL  rr2t(m,n),tt2t(m,n),td2t(m,n),rs2t(m,n),ts2t(m,n)
       real  rr2t(m,n),tt2t(m,n),td2t(m,n),rs2t(m,n),ts2t(m,n)  
1274    
1275  c-----water vapor absorption coefficient for 10 k-intervals.  c-----water vapor absorption coefficient for 10 k-intervals.
1276  c     unit: cm^2/gm  c     unit: cm^2/gm
# Line 1682  c*************************************** Line 1637  c***************************************
1637    
1638  c-----Explicit Inline Directives    c-----Explicit Inline Directives  
1639        
1640  #if CRAY  #ifdef CRAY
1641  #if f77    #ifdef f77  
1642  cfpp$ expand (deledd)  cfpp$ expand (deledd)
1643  cfpp$ expand (sagpol)  cfpp$ expand (sagpol)
1644  #endif    #endif  
# Line 1692  cfpp$ expand (sagpol) Line 1647  cfpp$ expand (sagpol)
1647  c-----input parameters  c-----input parameters
1648    
1649        integer m,n,ndim,np,ict,icb        integer m,n,ndim,np,ict,icb
1650        real  taucld(m,ndim,np,2),reff(m,ndim,np,2),fcld(m,ndim,np)        _RL  taucld(m,ndim,np,2),reff(m,ndim,np,2),fcld(m,ndim,np)
1651        real  tauclb(m,n,np),tauclf(m,n,np),cc(m,n,3)        _RL  tauclb(m,n,np),tauclf(m,n,np),cc(m,n,3)
1652        real  oh(m,n,np),dp(m,n,np),taual(m,ndim,np)        _RL  oh(m,n,np),dp(m,n,np),taual(m,ndim,np)
1653        real  rsuvbm(m,ndim),rsuvdf(m,ndim),csm(m,n)        _RL  rsuvbm(m,ndim),rsuvdf(m,ndim),csm(m,n)
1654    
1655  c-----output (updated) parameter  c-----output (updated) parameter
1656    
1657        real  flx(m,ndim,np+1),flc(m,ndim,np+1)        _RL  flx(m,ndim,np+1),flc(m,ndim,np+1)
1658        real  fdirpar(m,ndim),fdifpar(m,ndim)        _RL  fdirpar(m,ndim),fdifpar(m,ndim)
1659        real  fdiruv(m,ndim),fdifuv(m,ndim)        _RL  fdiruv(m,ndim),fdifuv(m,ndim)
1660    
1661  c-----static parameters  c-----static parameters
1662    
1663        integer nband        integer nband
1664        parameter (nband=8)        parameter (nband=8)
1665        real  hk(nband),xk(nband),ry(nband)        _RL  hk(nband),xk(nband),ry(nband)
1666        real  asyal(nband),ssaal(nband),aig(3),awg(3)        _RL  asyal(nband),ssaal(nband),aig(3),awg(3)
1667    
1668  c-----temporary array  c-----temporary array
1669    
1670        integer i,j,k,ib        integer i,j,k,ib
1671        real  taurs,tauoz,tausto,ssatau,asysto,tauto,ssato,asyto        _RL  taurs,tauoz,tausto,ssatau,asysto,tauto,ssato,asyto
1672        real  taux,reff1,reff2,g1,g2,asycl(m,n,np)        _RL  taux,reff1,reff2,g1,g2,asycl(m,n,np)
1673        real  td(m,n,np+1,2),rr(m,n,np+1,2),tt(m,n,np+1,2),        _RL  td(m,n,np+1,2),rr(m,n,np+1,2),tt(m,n,np+1,2),
1674       *       rs(m,n,np+1,2),ts(m,n,np+1,2)       *       rs(m,n,np+1,2),ts(m,n,np+1,2)
1675        real  upflux(m,n,np+1),dwflux(m,n,np+1),        _RL  fall(m,n,np+1),fclr(m,n,np+1),fsdir(m,n),fsdif(m,n)
1676       *     rssab(m,n,np+1),rabx(m,n,np+1),rsabx(m,n,np+1)        _RL  asyclt(m,n)
1677        real  fall(m,n,np+1),fclr(m,n,np+1),fsdir(m,n),fsdif(m,n)        _RL  rr1t(m,n),tt1t(m,n),td1t(m,n),rs1t(m,n),ts1t(m,n)
1678        real  asyclt(m,n)        _RL  rr2t(m,n),tt2t(m,n),td2t(m,n),rs2t(m,n),ts2t(m,n)
       real  rr1t(m,n),tt1t(m,n),td1t(m,n),rs1t(m,n),ts1t(m,n)  
       real  rr2t(m,n),tt2t(m,n),td2t(m,n),rs2t(m,n),ts2t(m,n)  
1679    
1680  c-----hk is the fractional extra-terrestrial solar flux.  c-----hk is the fractional extra-terrestrial solar flux.
1681  c     the sum of hk is 0.47074.  c     the sum of hk is 0.47074.
# Line 1999  c*************************************** Line 1952  c***************************************
1952    
1953  c-----Explicit Inline Directives    c-----Explicit Inline Directives  
1954        
1955  #if CRAY  #ifdef CRAY
1956  #if f77    #ifdef f77  
1957  cfpp$ expand (expmn)  cfpp$ expand (expmn)
1958  #endif    #endif  
1959  #endif  #endif
1960        real expmn        _RL expmn
1961    
1962        real  zero,one,two,three,four,fourth,seven,tumin        _RL  zero,one,two,three,four,fourth,seven,tumin
1963        parameter (one=1., three=3.)        parameter (one=1., three=3.)
1964        parameter (seven=7., two=2.)        parameter (seven=7., two=2.)
1965        parameter (four=4., fourth=.25)        parameter (four=4., fourth=.25)
1966        parameter (zero=0., tumin=1.e-20)        parameter (zero=0., tumin=1.e-20)
1967    
1968  c-----input parameters  c-----input parameters
1969        real  tau,ssc,g0,csm        _RL  tau,ssc,g0,csm
1970    
1971  c-----output parameters  c-----output parameters
1972        real  rr,tt,td        _RL  rr,tt,td
1973    
1974  c-----temporary parameters  c-----temporary parameters
1975    
1976        real  zth,ff,xx,taup,sscp,gp,gm1,gm2,gm3,akk,alf1,alf2,        _RL  zth,ff,xx,taup,sscp,gp,gm1,gm2,gm3,akk,alf1,alf2,
1977       *     all,bll,st7,st8,cll,dll,fll,ell,st1,st2,st3,st4       *     all,bll,st7,st8,cll,dll,fll,ell,st1,st2,st3,st4
1978  c  c
1979                  zth = one / csm                  zth = one / csm
# Line 2123  c*************************************** Line 2076  c***************************************
2076    
2077  c-----Explicit Inline Directives    c-----Explicit Inline Directives  
2078        
2079  #if CRAY  #ifdef CRAY
2080  #if f77    #ifdef f77  
2081  cfpp$ expand (expmn)  cfpp$ expand (expmn)
2082  #endif    #endif  
2083  #endif  #endif
2084        real expmn        _RL expmn
2085    
2086        real  one,three,four        _RL  one,three,four
2087        parameter (one=1., three=3., four=4.)        parameter (one=1., three=3., four=4.)
2088    
2089  c-----output parameters:  c-----output parameters:
2090    
2091        real  tau,ssc,g0        _RL  tau,ssc,g0
2092    
2093  c-----output parameters:  c-----output parameters:
2094    
2095        real  rll,tll        _RL  rll,tll
2096    
2097  c-----temporary arrays  c-----temporary arrays
2098    
2099        real  xx,uuu,ttt,emt,up1,um1,st1        _RL  xx,uuu,ttt,emt,up1,um1,st1
2100    
2101               xx  = one-ssc*g0               xx  = one-ssc*g0
2102               uuu = sqrt( xx/(one-ssc))               uuu = sqrt( xx/(one-ssc))
# Line 2165  c*************************************** Line 2118  c***************************************
2118    
2119  c*******************************************************************  c*******************************************************************
2120  c compute exponential for arguments in the range 0> fin > -10.  c compute exponential for arguments in the range 0> fin > -10.
2121    c*******************************************************************
2122          implicit none
2123          _RL  fin,expmn
2124    
2125          _RL one,expmin,e1,e2,e3,e4
2126        parameter (one=1.0, expmin=-10.0)        parameter (one=1.0, expmin=-10.0)
2127        parameter (e1=1.0,        e2=-2.507213e-1)        parameter (e1=1.0,        e2=-2.507213e-1)
2128        parameter (e3=2.92732e-2, e4=-3.827800e-3)        parameter (e3=2.92732e-2, e4=-3.827800e-3)
       real  fin,expmn  
2129    
2130        if (fin .lt. expmin) fin = expmin        if (fin .lt. expmin) fin = expmin
2131        expmn = ((e4*fin + e3)*fin+e2)*fin+e1        expmn = ((e4*fin + e3)*fin+e2)*fin+e1
# Line 2219  c-----input parameters Line 2175  c-----input parameters
2175    
2176        integer m,n,np,ict,icb        integer m,n,np,ict,icb
2177    
2178        real  rr(m,n,np+1,2),tt(m,n,np+1,2),td(m,n,np+1,2)        _RL  rr(m,n,np+1,2),tt(m,n,np+1,2),td(m,n,np+1,2)
2179        real  rs(m,n,np+1,2),ts(m,n,np+1,2)        _RL  rs(m,n,np+1,2),ts(m,n,np+1,2)
2180        real  cc(m,n,3)        _RL  cc(m,n,3)
2181    
2182  c-----temporary array  c-----temporary array
2183    
2184        integer i,j,k,ih,im,is        integer i,j,k,ih,im,is
2185        real  rra(m,n,np+1,2,2),tta(m,n,np+1,2,2),tda(m,n,np+1,2,2)        _RL  rra(m,n,np+1,2,2),tta(m,n,np+1,2,2),tda(m,n,np+1,2,2)
2186        real  rsa(m,n,np+1,2,2),rxa(m,n,np+1,2,2)        _RL  rsa(m,n,np+1,2,2),rxa(m,n,np+1,2,2)
2187        real  ch(m,n),cm(m,n),ct(m,n),flxdn(m,n,np+1)        _RL  ch(m,n),cm(m,n),ct(m,n),flxdn(m,n,np+1)
2188        real  fdndir(m,n),fdndif(m,n),fupdif        _RL  fdndir(m,n),fdndif(m,n),fupdif
2189        real  denm,xx        _RL  denm,xx
2190    
2191  c-----output parameters  c-----output parameters
2192    
2193        real  fclr(m,n,np+1),fall(m,n,np+1)        _RL  fclr(m,n,np+1),fall(m,n,np+1)
2194        real  fsdir(m,n),fsdif(m,n)        _RL  fsdir(m,n),fsdif(m,n)
2195    
2196  c-----initialize all-sky flux (fall) and surface downward fluxes  c-----initialize all-sky flux (fall) and surface downward fluxes
2197    
# Line 2535  c     due to co2 absorption. Line 2491  c     due to co2 absorption.
2491  c-----input parameters  c-----input parameters
2492    
2493        integer m,n,np        integer m,n,np
2494        real  csm(m,n),swc(m,n,np+1),swh(m,n,np+1),cah(22,19)        _RL  csm(m,n),swc(m,n,np+1),swh(m,n,np+1),cah(22,19)
2495    
2496  c-----output (undated) parameter  c-----output (undated) parameter
2497    
2498        real  df(m,n,np+1)        _RL  df(m,n,np+1)
2499    
2500  c-----temporary array  c-----temporary array
2501    
2502        integer i,j,k,ic,iw        integer i,j,k,ic,iw
2503        real  xx,clog,wlog,dc,dw,x1,x2,y2        _RL  xx,clog,wlog,dc,dw,x1,x2,y2
2504    
2505  c********************************************************************  c********************************************************************
2506  c-----include co2 look-up table  c-----include co2 look-up table
2507    
2508        include 'cah.dat'  #include "cah-dat.h"
2509        save cah  c     save cah
2510    
2511  c********************************************************************  c********************************************************************
2512  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.12
  ViewVC Help
Powered by ViewVC 1.1.22