/[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.13 by molod, Mon Jul 26 19:51:08 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)
37        real    oz(im,jm,lm)            _RL dtswclr(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)          _RL 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)          _RL qliqave(im,jm,lm),fccave(im,jm,lm)  
       real  fccave(im,jm,lm)    
   
43        integer landtype(im,jm)        integer landtype(im,jm)
44          _RL 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        _RL      getcon,grav,cp,undef
51        real      ra,alf,reffw,reffi,tminv        _RL      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)        _RL tdry(im,jm,lm)
57        real      alon(im,jm)        _RL TEMP1(im,jm)
58          _RL TEMP2(im,jm)
59          _RL zenith (im,jm)
60          _RL cldtot (im,jm,lm)
61          _RL cldmxo (im,jm,lm)
62          _RL totcld (im,jm)
63          _RL cldlow (im,jm)
64          _RL cldmid (im,jm)
65          _RL cldhi  (im,jm)
66          _RL taulow (im,jm)
67          _RL taumid (im,jm)
68          _RL tauhi  (im,jm)
69          _RL tautype(im,jm,lm,3)
70          _RL tau(im,jm,lm)
71          _RL albedo(im,jm)    
72    
73          _RL PK(ISTRIP,lm)
74          _RL qzl(ISTRIP,lm),CLRO(ISTRIP,lm)
75          _RL TZL(ISTRIP,lm)
76          _RL OZL(ISTRIP,lm)
77          _RL PLE(ISTRIP,lm+1)
78          _RL COSZ(ISTRIP)
79          _RL dpstrip(ISTRIP,lm)
80    
81          _RL albuvdr(ISTRIP),albuvdf(ISTRIP)
82          _RL albirdr(ISTRIP),albirdf(ISTRIP)
83          _RL difpar (ISTRIP),dirpar (ISTRIP)
84    
85          _RL fdirir(istrip),fdifir(istrip)
86          _RL fdiruv(istrip),fdifuv(istrip)
87    
88          _RL flux(istrip,lm+1)
89          _RL fluxclr(istrip,lm+1)
90          _RL dtsw(istrip,lm)
91          _RL dtswc(istrip,lm)
92    
93          _RL taul   (istrip,lm)
94          _RL reff   (istrip,lm,2)
95          _RL tauc   (istrip,lm,2)
96          _RL taua   (istrip,lm)
97          _RL 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 627  C                  tau(im,jm,lm,2):  Sus Line 586  C                  tau(im,jm,lm,2):  Sus
586  C                  tau(im,jm,lm,3):  Raindrops  C                  tau(im,jm,lm,3):  Raindrops
587  C  C
588  C***********************************************************************  C***********************************************************************
 C*                  GODDARD LABORATORY FOR ATMOSPHERES                 *  
 C***********************************************************************  
589    
590        implicit none        implicit none
591    
592        integer  im,jm,lm,i,j,L        integer  im,jm,lm,i,j,L
593    
594        real  tl(im,jm,lm)        _RL  tl(im,jm,lm)
595        real  pl(im,jm,lm)        _RL  pl(im,jm,lm)
596        real ple(im,jm,lm+1)        _RL ple(im,jm,lm+1)
597        real  lz(im,jm,lm)        _RL  lz(im,jm,lm)
598        real  cf(im,jm,lm)        _RL  cf(im,jm,lm)
599        real cfm(im,jm,lm)        _RL cfm(im,jm,lm)
600        real tau(im,jm,lm,3)        _RL tau(im,jm,lm,3)
601        integer lwi(im,jm)        integer lwi(im,jm)
602    
603        real dp, alf, fracls, fraccu        _RL dp, alf, fracls, fraccu
604        real tauice, tauh2o, tauras        _RL tauice, tauh2o, tauras
605    
606  c Compute Cloud Optical Depths  c Compute Cloud Optical Depths
607  c ----------------------------  c ----------------------------
# Line 812  c*************************************** Line 769  c***************************************
769    
770  c-----Explicit Inline Directives  c-----Explicit Inline Directives
771    
772  #if CRAY  #ifdef CRAY
773  #if f77  #ifdef f77
774  cfpp$ expand (expmn)  cfpp$ expand (expmn)
775  #endif  #endif
776  #endif  #endif
777        real expmn        _RL expmn
778    
779  c-----input parameters  c-----input parameters
780    
781        integer m,n,ndim,np,ict,icb        integer m,n,ndim,np,ict,icb
782        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)
783        real  taucld(m,ndim,np,2),reff(m,ndim,np,2)        _RL  taucld(m,ndim,np,2),reff(m,ndim,np,2)
784        real  fcld(m,ndim,np),taual(m,ndim,np)        _RL  fcld(m,ndim,np),taual(m,ndim,np)
785        real  rsirbm(m,ndim),rsirdf(m,ndim),        _RL  rsirbm(m,ndim),rsirdf(m,ndim),
786       *     rsuvbm(m,ndim),rsuvdf(m,ndim),cosz(m,ndim),co2       *     rsuvbm(m,ndim),rsuvdf(m,ndim),cosz(m,ndim),co2
787    
788  c-----output parameters  c-----output parameters
789    
790        real  flx(m,ndim,np+1),flc(m,ndim,np+1)        _RL  flx(m,ndim,np+1),flc(m,ndim,np+1)
791        real  fdirir(m,ndim),fdifir(m,ndim)        _RL  fdirir(m,ndim),fdifir(m,ndim)
792        real  fdirpar(m,ndim),fdifpar(m,ndim)        _RL  fdirpar(m,ndim),fdifpar(m,ndim)
793        real  fdiruv(m,ndim),fdifuv(m,ndim)        _RL  fdiruv(m,ndim),fdifuv(m,ndim)
794    
795  c-----temporary array  c-----temporary array
796    
797        integer i,j,k,ik        integer i,j,k
798        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)
799        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)
800        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)
801        real  sdf(m,n),sclr(m,n),csm(m,n),taux,x        _RL  sdf(m,n),sclr(m,n),csm(m,n),x
802    
803  c-----------------------------------------------------------------  c-----------------------------------------------------------------
804    
# Line 1054  c*************************************** Line 1011  c***************************************
1011  c-----input parameters  c-----input parameters
1012    
1013        integer m,n,ndim,np,ict,icb        integer m,n,ndim,np,ict,icb
1014        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)
1015    
1016  c-----output parameters  c-----output parameters
1017    
1018        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)
1019    
1020  c-----temporary variables  c-----temporary variables
1021    
1022        integer i,j,k,im,it,ia,kk        integer i,j,k,im,it,ia,kk
1023        real   fm,ft,fa,xai,taucl,taux        _RL   fm,ft,fa,xai,taux
1024    
1025  c-----pre-computed table  c-----pre-computed table
1026    
1027        integer   nm,nt,na        integer   nm,nt,na
1028        parameter (nm=11,nt=9,na=11)        parameter (nm=11,nt=9,na=11)
1029        real   dm,dt,da,t1,caib(nm,nt,na),caif(nt,na)        _RL   dm,dt,da,t1,caib(nm,nt,na),caif(nt,na)
1030        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)
1031    
1032  c-----include the pre-computed table for cai  c-----include the pre-computed table for cai
1033    
1034        include 'cai.dat'  #include "cai-dat.h"
1035        save caib,caif  c     save caib,caif
1036    
1037    
1038  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 1229  c***************************************
1229    
1230  c-----Explicit Inline Directives  c-----Explicit Inline Directives
1231    
1232  #if CRAY  #ifdef CRAY
1233  #if f77  #ifdef f77
1234  cfpp$ expand (deledd)  cfpp$ expand (deledd)
1235  cfpp$ expand (sagpol)  cfpp$ expand (sagpol)
1236  cfpp$ expand (expmn)  cfpp$ expand (expmn)
1237  #endif  #endif
1238  #endif  #endif
1239        real expmn        _RL expmn
1240    
1241  c-----input parameters  c-----input parameters
1242    
1243        integer m,n,ndim,np,ict,icb        integer m,n,ndim,np,ict,icb
1244        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)
1245        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)
1246        real  rsirbm(m,ndim),rsirdf(m,ndim)        _RL  rsirbm(m,ndim),rsirdf(m,ndim)
1247        real  wh(m,n,np),taual(m,ndim,np),csm(m,n)        _RL  wh(m,n,np),taual(m,ndim,np),csm(m,n)
1248    
1249  c-----output (updated) parameters  c-----output (updated) parameters
1250    
1251        real  flx(m,ndim,np+1),flc(m,ndim,np+1)        _RL  flx(m,ndim,np+1),flc(m,ndim,np+1)
1252        real  fdirir(m,ndim),fdifir(m,ndim)        _RL  fdirir(m,ndim),fdifir(m,ndim)
1253    
1254  c-----static parameters  c-----static parameters
1255    
1256        integer nk,nband        integer nk,nband
1257        parameter (nk=10,nband=3)        parameter (nk=10,nband=3)
1258        real  xk(nk),hk(nband,nk),ssaal(nband),asyal(nband)        _RL  xk(nk),hk(nband,nk),ssaal(nband),asyal(nband)
1259        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)
1260    
1261  c-----temporary array  c-----temporary array
1262    
1263        integer ib,ik,i,j,k        integer ib,ik,i,j,k
1264        real  ssacl(m,n,np),asycl(m,n,np)        _RL  ssacl(m,n,np),asycl(m,n,np)
1265        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),
1266       *       rs(m,n,np+1,2),ts(m,n,np+1,2)       *       rs(m,n,np+1,2),ts(m,n,np+1,2)
1267        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)
1268        real  fall(m,n,np+1),fclr(m,n,np+1)        _RL  fsdir(m,n),fsdif(m,n)
1269        real  fsdir(m,n),fsdif(m,n)  
1270          _RL  tauwv,tausto,ssatau,asysto,tauto,ssato,asyto
1271        real  tauwv,tausto,ssatau,asysto,tauto,ssato,asyto        _RL  taux,reff1,reff2,w1,w2,g1,g2
1272        real  taux,reff1,reff2,w1,w2,g1,g2        _RL  ssaclt(m,n),asyclt(m,n)
1273        real  ssaclt(m,n),asyclt(m,n)        _RL  rr1t(m,n),tt1t(m,n),td1t(m,n),rs1t(m,n),ts1t(m,n)
1274        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)  
1275    
1276  c-----water vapor absorption coefficient for 10 k-intervals.  c-----water vapor absorption coefficient for 10 k-intervals.
1277  c     unit: cm^2/gm  c     unit: cm^2/gm
# Line 1682  c*************************************** Line 1638  c***************************************
1638    
1639  c-----Explicit Inline Directives    c-----Explicit Inline Directives  
1640        
1641  #if CRAY  #ifdef CRAY
1642  #if f77    #ifdef f77  
1643  cfpp$ expand (deledd)  cfpp$ expand (deledd)
1644  cfpp$ expand (sagpol)  cfpp$ expand (sagpol)
1645  #endif    #endif  
# Line 1692  cfpp$ expand (sagpol) Line 1648  cfpp$ expand (sagpol)
1648  c-----input parameters  c-----input parameters
1649    
1650        integer m,n,ndim,np,ict,icb        integer m,n,ndim,np,ict,icb
1651        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)
1652        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)
1653        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)
1654        real  rsuvbm(m,ndim),rsuvdf(m,ndim),csm(m,n)        _RL  rsuvbm(m,ndim),rsuvdf(m,ndim),csm(m,n)
1655    
1656  c-----output (updated) parameter  c-----output (updated) parameter
1657    
1658        real  flx(m,ndim,np+1),flc(m,ndim,np+1)        _RL  flx(m,ndim,np+1),flc(m,ndim,np+1)
1659        real  fdirpar(m,ndim),fdifpar(m,ndim)        _RL  fdirpar(m,ndim),fdifpar(m,ndim)
1660        real  fdiruv(m,ndim),fdifuv(m,ndim)        _RL  fdiruv(m,ndim),fdifuv(m,ndim)
1661    
1662  c-----static parameters  c-----static parameters
1663    
1664        integer nband        integer nband
1665        parameter (nband=8)        parameter (nband=8)
1666        real  hk(nband),xk(nband),ry(nband)        _RL  hk(nband),xk(nband),ry(nband)
1667        real  asyal(nband),ssaal(nband),aig(3),awg(3)        _RL  asyal(nband),ssaal(nband),aig(3),awg(3)
1668    
1669  c-----temporary array  c-----temporary array
1670    
1671        integer i,j,k,ib        integer i,j,k,ib
1672        real  taurs,tauoz,tausto,ssatau,asysto,tauto,ssato,asyto        _RL  taurs,tauoz,tausto,ssatau,asysto,tauto,ssato,asyto
1673        real  taux,reff1,reff2,g1,g2,asycl(m,n,np)        _RL  taux,reff1,reff2,g1,g2,asycl(m,n,np)
1674        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),
1675       *       rs(m,n,np+1,2),ts(m,n,np+1,2)       *       rs(m,n,np+1,2),ts(m,n,np+1,2)
1676        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)
1677       *     rssab(m,n,np+1),rabx(m,n,np+1),rsabx(m,n,np+1)        _RL  asyclt(m,n)
1678        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)
1679        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)  
1680    
1681  c-----hk is the fractional extra-terrestrial solar flux.  c-----hk is the fractional extra-terrestrial solar flux.
1682  c     the sum of hk is 0.47074.  c     the sum of hk is 0.47074.
# Line 1999  c*************************************** Line 1953  c***************************************
1953    
1954  c-----Explicit Inline Directives    c-----Explicit Inline Directives  
1955        
1956  #if CRAY  #ifdef CRAY
1957  #if f77    #ifdef f77  
1958  cfpp$ expand (expmn)  cfpp$ expand (expmn)
1959  #endif    #endif  
1960  #endif  #endif
1961        real expmn        _RL expmn
1962    
1963        real  zero,one,two,three,four,fourth,seven,tumin        _RL  zero,one,two,three,four,fourth,seven,tumin
1964        parameter (one=1., three=3.)        parameter (one=1., three=3.)
1965        parameter (seven=7., two=2.)        parameter (seven=7., two=2.)
1966        parameter (four=4., fourth=.25)        parameter (four=4., fourth=.25)
1967        parameter (zero=0., tumin=1.e-20)        parameter (zero=0., tumin=1.e-20)
1968    
1969  c-----input parameters  c-----input parameters
1970        real  tau,ssc,g0,csm        _RL  tau,ssc,g0,csm
1971    
1972  c-----output parameters  c-----output parameters
1973        real  rr,tt,td        _RL  rr,tt,td
1974    
1975  c-----temporary parameters  c-----temporary parameters
1976    
1977        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,
1978       *     all,bll,st7,st8,cll,dll,fll,ell,st1,st2,st3,st4       *     all,bll,st7,st8,cll,dll,fll,ell,st1,st2,st3,st4
1979  c  c
1980                  zth = one / csm                  zth = one / csm
# Line 2123  c*************************************** Line 2077  c***************************************
2077    
2078  c-----Explicit Inline Directives    c-----Explicit Inline Directives  
2079        
2080  #if CRAY  #ifdef CRAY
2081  #if f77    #ifdef f77  
2082  cfpp$ expand (expmn)  cfpp$ expand (expmn)
2083  #endif    #endif  
2084  #endif  #endif
2085        real expmn        _RL expmn
2086    
2087        real  one,three,four        _RL  one,three,four
2088        parameter (one=1., three=3., four=4.)        parameter (one=1., three=3., four=4.)
2089    
2090  c-----output parameters:  c-----output parameters:
2091    
2092        real  tau,ssc,g0        _RL  tau,ssc,g0
2093    
2094  c-----output parameters:  c-----output parameters:
2095    
2096        real  rll,tll        _RL  rll,tll
2097    
2098  c-----temporary arrays  c-----temporary arrays
2099    
2100        real  xx,uuu,ttt,emt,up1,um1,st1        _RL  xx,uuu,ttt,emt,up1,um1,st1
2101    
2102               xx  = one-ssc*g0               xx  = one-ssc*g0
2103               uuu = sqrt( xx/(one-ssc))               uuu = sqrt( xx/(one-ssc))
# Line 2165  c*************************************** Line 2119  c***************************************
2119    
2120  c*******************************************************************  c*******************************************************************
2121  c compute exponential for arguments in the range 0> fin > -10.  c compute exponential for arguments in the range 0> fin > -10.
2122    c*******************************************************************
2123          implicit none
2124          _RL  fin,expmn
2125    
2126          _RL one,expmin,e1,e2,e3,e4
2127        parameter (one=1.0, expmin=-10.0)        parameter (one=1.0, expmin=-10.0)
2128        parameter (e1=1.0,        e2=-2.507213e-1)        parameter (e1=1.0,        e2=-2.507213e-1)
2129        parameter (e3=2.92732e-2, e4=-3.827800e-3)        parameter (e3=2.92732e-2, e4=-3.827800e-3)
       real  fin,expmn  
2130    
2131        if (fin .lt. expmin) fin = expmin        if (fin .lt. expmin) fin = expmin
2132        expmn = ((e4*fin + e3)*fin+e2)*fin+e1        expmn = ((e4*fin + e3)*fin+e2)*fin+e1
# Line 2219  c-----input parameters Line 2176  c-----input parameters
2176    
2177        integer m,n,np,ict,icb        integer m,n,np,ict,icb
2178    
2179        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)
2180        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)
2181        real  cc(m,n,3)        _RL  cc(m,n,3)
2182    
2183  c-----temporary array  c-----temporary array
2184    
2185        integer i,j,k,ih,im,is        integer i,j,k,ih,im,is
2186        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)
2187        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)
2188        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)
2189        real  fdndir(m,n),fdndif(m,n),fupdif        _RL  fdndir(m,n),fdndif(m,n),fupdif
2190        real  denm,xx        _RL  denm,xx
2191    
2192  c-----output parameters  c-----output parameters
2193    
2194        real  fclr(m,n,np+1),fall(m,n,np+1)        _RL  fclr(m,n,np+1),fall(m,n,np+1)
2195        real  fsdir(m,n),fsdif(m,n)        _RL  fsdir(m,n),fsdif(m,n)
2196    
2197  c-----initialize all-sky flux (fall) and surface downward fluxes  c-----initialize all-sky flux (fall) and surface downward fluxes
2198    
# Line 2535  c     due to co2 absorption. Line 2492  c     due to co2 absorption.
2492  c-----input parameters  c-----input parameters
2493    
2494        integer m,n,np        integer m,n,np
2495        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)
2496    
2497  c-----output (undated) parameter  c-----output (undated) parameter
2498    
2499        real  df(m,n,np+1)        _RL  df(m,n,np+1)
2500    
2501  c-----temporary array  c-----temporary array
2502    
2503        integer i,j,k,ic,iw        integer i,j,k,ic,iw
2504        real  xx,clog,wlog,dc,dw,x1,x2,y2        _RL  xx,clog,wlog,dc,dw,x1,x2,y2
2505    
2506  c********************************************************************  c********************************************************************
2507  c-----include co2 look-up table  c-----include co2 look-up table
2508    
2509        include 'cah.dat'  #include "cah-dat.h"
2510        save cah  c     save cah
2511    
2512  c********************************************************************  c********************************************************************
2513  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.13
  ViewVC Help
Powered by ViewVC 1.1.22