/[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.9 by molod, Wed Jul 14 15:52:04 2004 UTC revision 1.11 by molod, Fri Jul 16 20:08:08 2004 UTC
# Line 771  c*************************************** Line 771  c***************************************
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
# Line 796  c-----output parameters Line 796  c-----output parameters
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    
# Line 1022  c-----output parameters Line 1022  c-----output parameters
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    
# Line 1231  c*************************************** Line 1231  c***************************************
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)
# Line 1266  c-----temporary array Line 1266  c-----temporary array
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    
# Line 1641  c*************************************** Line 1640  c***************************************
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  
# Line 1676  c-----temporary array Line 1675  c-----temporary array
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)
# Line 1958  c*************************************** Line 1955  c***************************************
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
# Line 2082  c*************************************** Line 2079  c***************************************
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
# Line 2124  c*************************************** Line 2121  c***************************************
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
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22