46 |
c Local Variables |
c Local Variables |
47 |
c --------------- |
c --------------- |
48 |
integer i,j,L,nn,nsecf |
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 ) |
75 |
real TZL(ISTRIP,lm) |
real TZL(ISTRIP,lm) |
76 |
real OZL(ISTRIP,lm) |
real OZL(ISTRIP,lm) |
77 |
real PLE(ISTRIP,lm+1) |
real PLE(ISTRIP,lm+1) |
78 |
real OSZ(ISTRIP) |
real COSZ(ISTRIP) |
79 |
real dpstrip(ISTRIP,lm) |
real dpstrip(ISTRIP,lm) |
80 |
|
|
81 |
real albuvdr(ISTRIP),albuvdf(ISTRIP) |
real albuvdr(ISTRIP),albuvdf(ISTRIP) |
771 |
|
|
772 |
c-----Explicit Inline Directives |
c-----Explicit Inline Directives |
773 |
|
|
774 |
#if CRAY |
#ifdef CRAY |
775 |
#if f77 |
#ifdef f77 |
776 |
cfpp$ expand (expmn) |
cfpp$ expand (expmn) |
777 |
#endif |
#endif |
778 |
#endif |
#endif |
796 |
|
|
797 |
c-----temporary array |
c-----temporary array |
798 |
|
|
799 |
integer i,j,k,ik |
integer i,j,k |
800 |
real cc(m,n,3),tauclb(m,n,np),tauclf(m,n,np) |
real cc(m,n,3),tauclb(m,n,np),tauclf(m,n,np) |
801 |
real dp(m,n,np),wh(m,n,np),oh(m,n,np),scal(m,n,np) |
real dp(m,n,np),wh(m,n,np),oh(m,n,np),scal(m,n,np) |
802 |
real swh(m,n,np+1),so2(m,n,np+1),df(m,n,np+1) |
real swh(m,n,np+1),so2(m,n,np+1),df(m,n,np+1) |
803 |
real sdf(m,n),sclr(m,n),csm(m,n),taux,x |
real sdf(m,n),sclr(m,n),csm(m,n),x |
804 |
|
|
805 |
c----------------------------------------------------------------- |
c----------------------------------------------------------------- |
806 |
|
|
1022 |
c-----temporary variables |
c-----temporary variables |
1023 |
|
|
1024 |
integer i,j,k,im,it,ia,kk |
integer i,j,k,im,it,ia,kk |
1025 |
real fm,ft,fa,xai,taucl,taux |
real fm,ft,fa,xai,taux |
1026 |
|
|
1027 |
c-----pre-computed table |
c-----pre-computed table |
1028 |
|
|
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 |
c 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 |
1231 |
|
|
1232 |
c-----Explicit Inline Directives |
c-----Explicit Inline Directives |
1233 |
|
|
1234 |
#if CRAY |
#ifdef CRAY |
1235 |
#if f77 |
#ifdef f77 |
1236 |
cfpp$ expand (deledd) |
cfpp$ expand (deledd) |
1237 |
cfpp$ expand (sagpol) |
cfpp$ expand (sagpol) |
1238 |
cfpp$ expand (expmn) |
cfpp$ expand (expmn) |
1266 |
real ssacl(m,n,np),asycl(m,n,np) |
real ssacl(m,n,np),asycl(m,n,np) |
1267 |
real rr(m,n,np+1,2),tt(m,n,np+1,2),td(m,n,np+1,2), |
real rr(m,n,np+1,2),tt(m,n,np+1,2),td(m,n,np+1,2), |
1268 |
* rs(m,n,np+1,2),ts(m,n,np+1,2) |
* rs(m,n,np+1,2),ts(m,n,np+1,2) |
|
real rssab(m,n,np+1),rabx(m,n,np+1),rsabx(m,n,np+1) |
|
1269 |
real fall(m,n,np+1),fclr(m,n,np+1) |
real fall(m,n,np+1),fclr(m,n,np+1) |
1270 |
real fsdir(m,n),fsdif(m,n) |
real fsdir(m,n),fsdif(m,n) |
1271 |
|
|
1640 |
|
|
1641 |
c-----Explicit Inline Directives |
c-----Explicit Inline Directives |
1642 |
|
|
1643 |
#if CRAY |
#ifdef CRAY |
1644 |
#if f77 |
#ifdef f77 |
1645 |
cfpp$ expand (deledd) |
cfpp$ expand (deledd) |
1646 |
cfpp$ expand (sagpol) |
cfpp$ expand (sagpol) |
1647 |
#endif |
#endif |
1675 |
real taux,reff1,reff2,g1,g2,asycl(m,n,np) |
real taux,reff1,reff2,g1,g2,asycl(m,n,np) |
1676 |
real td(m,n,np+1,2),rr(m,n,np+1,2),tt(m,n,np+1,2), |
real td(m,n,np+1,2),rr(m,n,np+1,2),tt(m,n,np+1,2), |
1677 |
* rs(m,n,np+1,2),ts(m,n,np+1,2) |
* rs(m,n,np+1,2),ts(m,n,np+1,2) |
|
real upflux(m,n,np+1),dwflux(m,n,np+1), |
|
|
* rssab(m,n,np+1),rabx(m,n,np+1),rsabx(m,n,np+1) |
|
1678 |
real fall(m,n,np+1),fclr(m,n,np+1),fsdir(m,n),fsdif(m,n) |
real fall(m,n,np+1),fclr(m,n,np+1),fsdir(m,n),fsdif(m,n) |
1679 |
real asyclt(m,n) |
real asyclt(m,n) |
1680 |
real rr1t(m,n),tt1t(m,n),td1t(m,n),rs1t(m,n),ts1t(m,n) |
real rr1t(m,n),tt1t(m,n),td1t(m,n),rs1t(m,n),ts1t(m,n) |
1955 |
|
|
1956 |
c-----Explicit Inline Directives |
c-----Explicit Inline Directives |
1957 |
|
|
1958 |
#if CRAY |
#ifdef CRAY |
1959 |
#if f77 |
#ifdef f77 |
1960 |
cfpp$ expand (expmn) |
cfpp$ expand (expmn) |
1961 |
#endif |
#endif |
1962 |
#endif |
#endif |
2079 |
|
|
2080 |
c-----Explicit Inline Directives |
c-----Explicit Inline Directives |
2081 |
|
|
2082 |
#if CRAY |
#ifdef CRAY |
2083 |
#if f77 |
#ifdef f77 |
2084 |
cfpp$ expand (expmn) |
cfpp$ expand (expmn) |
2085 |
#endif |
#endif |
2086 |
#endif |
#endif |
2121 |
|
|
2122 |
c******************************************************************* |
c******************************************************************* |
2123 |
c compute exponential for arguments in the range 0> fin > -10. |
c compute exponential for arguments in the range 0> fin > -10. |
2124 |
|
c******************************************************************* |
2125 |
|
implicit none |
2126 |
|
real fin,expmn |
2127 |
|
|
2128 |
|
real one,expmin,e1,e2,e3,e4 |
2129 |
parameter (one=1.0, expmin=-10.0) |
parameter (one=1.0, expmin=-10.0) |
2130 |
parameter (e1=1.0, e2=-2.507213e-1) |
parameter (e1=1.0, e2=-2.507213e-1) |
2131 |
parameter (e3=2.92732e-2, e4=-3.827800e-3) |
parameter (e3=2.92732e-2, e4=-3.827800e-3) |
|
real fin,expmn |
|
2132 |
|
|
2133 |
if (fin .lt. expmin) fin = expmin |
if (fin .lt. expmin) fin = expmin |
2134 |
expmn = ((e4*fin + e3)*fin+e2)*fin+e1 |
expmn = ((e4*fin + e3)*fin+e2)*fin+e1 |
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 |
c 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 |