/[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.19 by molod, Thu Aug 12 15:21:22 2004 UTC revision 1.20 by molod, Thu Aug 26 14:41:56 2004 UTC
# Line 2002  c-----output parameters Line 2002  c-----output parameters
2002  c-----temporary parameters  c-----temporary parameters
2003    
2004        _RL  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,
2005       *     all,bll,st7,st8,cll,dll,fll,ell,st1,st2,st3,st4       *     all1,bll,st7,st8,cll,dll,fll,ell,st1,st2,st3,st4
2006  c  c
2007                  zth = one / csm                  zth = one / csm
2008    
# Line 2039  c   alf1 and alf2 are alpha1 and alpha2 Line 2039  c   alf1 and alf2 are alpha1 and alpha2
2039                  alf1 = gm1 - gm3 * xx                  alf1 = gm1 - gm3 * xx
2040                  alf2 = gm2 + gm3 * xx                  alf2 = gm2 + gm3 * xx
2041    
2042  c  all is last term in eq(21) of K & H  c  all1 is last term in eq(21) of K & H
2043  c  bll is last term in eq(22) of K & H  c  bll is last term in eq(22) of K & H
2044    
2045                  xx  = akk * two                  xx  = akk * two
2046                  all = (gm3 - alf2 * zth    )*xx*td                  all1 = (gm3 - alf2 * zth    )*xx*td
2047                  bll = (one - gm3 + alf1*zth)*xx                  bll = (one - gm3 + alf1*zth)*xx
2048    
2049                  xx  = akk * zth                  xx  = akk * zth
# Line 2069  c  bll is last term in eq(22) of K & H Line 2069  c  bll is last term in eq(22) of K & H
2069  c   rr is r-hat of eq(21) of K & H  c   rr is r-hat of eq(21) of K & H
2070  c   tt is diffuse part of t-hat of eq(22) of K & H  c   tt is diffuse part of t-hat of eq(22) of K & H
2071    
2072                  rr =   ( cll-dll*st4    -all*st2)*st1                  rr =   ( cll-dll*st4    -all1*st2)*st1
2073                  tt = - ((fll-ell*st4)*td-bll*st2)*st1                  tt = - ((fll-ell*st4)*td-bll*st2)*st1
2074    
2075                  rr = max(rr,zero)                  rr = max(rr,zero)
# Line 2528  c-----output (undated) parameter Line 2528  c-----output (undated) parameter
2528  c-----temporary array  c-----temporary array
2529    
2530        integer i,j,k,ic,iw        integer i,j,k,ic,iw
2531        _RL  xx,clog,wlog,dc,dw,x1,x2,y2        _RL  xx,clog1,wlog,dc,dw,x1,x2,y2
2532    
2533  c********************************************************************  c********************************************************************
2534  c-----include co2 look-up table  c-----include co2 look-up table
# Line 2545  c     extraterrestrial solar flux in the Line 2545  c     extraterrestrial solar flux in the
2545         do j= 1, n         do j= 1, n
2546          do i= 1, m          do i= 1, m
2547            xx=1./.3            xx=1./.3
2548            clog=log10(swc(i,j,k)*csm(i,j))            clog1=log10(swc(i,j,k)*csm(i,j))
2549            wlog=log10(swh(i,j,k)*csm(i,j))            wlog=log10(swh(i,j,k)*csm(i,j))
2550            ic=int( (clog+3.15)*xx+1.)            ic=int( (clog1+3.15)*xx+1.)
2551            iw=int( (wlog+4.15)*xx+1.)            iw=int( (wlog+4.15)*xx+1.)
2552            if(ic.lt.2)ic=2            if(ic.lt.2)ic=2
2553            if(iw.lt.2)iw=2            if(iw.lt.2)iw=2
2554            if(ic.gt.22)ic=22            if(ic.gt.22)ic=22
2555            if(iw.gt.19)iw=19                if(iw.gt.19)iw=19    
2556            dc=clog-float(ic-2)*.3+3.            dc=clog1-float(ic-2)*.3+3.
2557            dw=wlog-float(iw-2)*.3+4.              dw=wlog-float(iw-2)*.3+4.  
2558            x1=cah(1,iw-1)+(cah(1,iw)-cah(1,iw-1))*xx*dw            x1=cah(1,iw-1)+(cah(1,iw)-cah(1,iw-1))*xx*dw
2559            x2=cah(ic-1,iw-1)+(cah(ic-1,iw)-cah(ic-1,iw-1))*xx*dw            x2=cah(ic-1,iw-1)+(cah(ic-1,iw)-cah(ic-1,iw-1))*xx*dw

Legend:
Removed from v.1.19  
changed lines
  Added in v.1.20

  ViewVC Help
Powered by ViewVC 1.1.22