/[MITgcm]/MITgcm/pkg/cheapaml/cheapaml_coare3_flux.F
ViewVC logotype

Diff of /MITgcm/pkg/cheapaml/cheapaml_coare3_flux.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.2 by wienders, Thu Feb 24 16:11:41 2011 UTC revision 1.3 by jmc, Fri Jun 24 01:25:15 2011 UTC
# Line 29  c Line 29  c
29        _RL Du,Wg,Dt,Dq,u10,zo10,Cd10,Ch10        _RL Du,Wg,Dt,Dq,u10,zo10,Cd10,Ch10
30        _RL xBeta,visa,Ribcu,QaR        _RL xBeta,visa,Ribcu,QaR
31        _RL Ct,zetu,L10,Tas,ta,charn        _RL Ct,zetu,L10,Tas,ta,charn
 c        
32  c  c
33  c Constants and coefficients (Stull 1988 p640).  c
34    c Constants and coefficients (Stull 1988 p640).
35        xBeta=1.2     !Given as 1.25 in Fairall et al.(1996)        xBeta=1.2     !Given as 1.25 in Fairall et al.(1996)
36        twopi=2. _d 0*pi        twopi=2. _d 0*pi
37        visa=1.326 _d -5        visa=1.326 _d -5
# Line 45  c sea surface temperature without skin c Line 45  c sea surface temperature without skin c
45    
46    
47  c net upward long wave  c net upward long wave
48        Rnl= 0.97*(stefan*(tsw+Celsius2K)**4) !Net longwave (up = +).        Rnl= 0.97*(stefan*(tsw+Celsius2K)**4) !Net longwave (up = +).
49  c  c
50  c Teten''s returns air svp es in mb  c Teten''s returns air svp es in mb
51        es = (1.0007+3.46e-6*p0)*6.1121*dexp(17.502*tsw/(240.97+tsw)) !mb        es = (1.0007+3.46e-6*p0)*6.1121*dexp(17.502*tsw/(240.97+tsw)) !mb
# Line 79  c Air-sea differences - includes warm la Line 79  c Air-sea differences - includes warm la
79          u=dsqrt(u)          u=dsqrt(u)
80        Du=(u**2.+Wg**2.)**.5       !include gustiness in wind spd. difference        Du=(u**2.+Wg**2.)**.5       !include gustiness in wind spd. difference
81        Dt=tsw-Tas-gamma_blk*zt         !potential temperature difference.        Dt=tsw-Tas-gamma_blk*zt         !potential temperature difference.
82        Dq=qs-q                            Dq=qs-q
83  c  c
84  c **************** neutral coefficients ******************  c **************** neutral coefficients ******************
85  c  c
# Line 95  c Line 95  c
95  c standard coare3 boundary layer height  c standard coare3 boundary layer height
96        zi=600. _d 0        zi=600. _d 0
97    
98  c        c
99  c ************* Grachev and Fairall (JAM, 1997) **********  c ************* Grachev and Fairall (JAM, 1997) **********
100  c  c
101        ta=Tas+Celsius2K        ta=Tas+Celsius2K
102        Ct=xkar/dlog(zt/zot10)         ! Temperature transfer coefficient        Ct=xkar/dlog(zt/zot10)         ! Temperature transfer coefficient
103        CC=xkar*Ct/Cd                  ! z/L vs Rib linear coefficient        CC=xkar*Ct/Cd                  ! z/L vs Rib linear coefficient
104        Ribcu=-zu/(zi*0.004 _d 0*xBeta**3)  ! Saturation or plateau Rib        Ribcu=-zu/(zi*0.004 _d 0*xBeta**3)  ! Saturation or plateau Rib
105        Ribu=-gravity*zu*(Dt+0.61 _d 0*ta*Dq)/(ta*Du**2)        Ribu=-gravity*zu*(Dt+0.61 _d 0*ta*Dq)/(ta*Du**2)
106        if (Ribu.lt.0. _d 0) then        if (Ribu.lt.0. _d 0) then
107            zetu=CC*Ribu/(1. _d 0+Ribu/Ribcu)   ! Unstable G and F            zetu=CC*Ribu/(1. _d 0+Ribu/Ribcu)   ! Unstable G and F
# Line 120  c Line 120  c
120        usr= Du*xkar/(dlog(zu/zo10)-psiu(zu/L10))        usr= Du*xkar/(dlog(zu/zo10)-psiu(zu/L10))
121        tsr=-(Dt)*xkar/(dlog(zt/zot10)-psit(zt/L10))        tsr=-(Dt)*xkar/(dlog(zt/zot10)-psit(zt/L10))
122        qsr=-(Dq)*xkar/(dlog(zq/zot10)-psit(zq/L10))        qsr=-(Dq)*xkar/(dlog(zq/zot10)-psit(zq/L10))
123  c        c
124        charn=0.011 _d 0     !then modify Charnock for high wind speeds Chris' data        charn=0.011 _d 0     !then modify Charnock for high wind speeds Chris s data
125        if(Du.gt.10. _d 0) charn=0.011 _d 0+(0.018-0.011)*(Du-10.)/(18.0-10.0)        if(Du.gt.10. _d 0) charn=0.011 _d 0
126         &                        +(0.018-0.011)*(Du-10.)/(18.0-10.0)
127        if(Du.gt.18. _d 0) charn=0.018 _d 0        if(Du.gt.18. _d 0) charn=0.018 _d 0
128  c        c
129  c **** Iterate across u*(t*,q*),zo(zot,zoq) and z/L including cool skin ****  c **** Iterate across u*(t*,q*),zo(zot,zoq) and z/L including cool skin ****
130  c  c
131        do iter=1,nits        do iter=1,nits
# Line 134  c Line 135  c
135          zo=(50./twopi)*lwave*(usr/cwave)**4.5 _d 0+0.11*visa/usr !Oost et al.          zo=(50./twopi)*lwave*(usr/cwave)**4.5 _d 0+0.11*visa/usr !Oost et al.
136         else if(WAVEMODEL.eq.'TayYel') then         else if(WAVEMODEL.eq.'TayYel') then
137          zo=1200. _d 0*wavesh(i,j,bi,bj)*(wavesh(i,j,bi,bj)/lwave)**4.5          zo=1200. _d 0*wavesh(i,j,bi,bj)*(wavesh(i,j,bi,bj)/lwave)**4.5
138       & +0.11 _d 0*visa/usr !Taylor and Yelland       & +0.11 _d 0*visa/usr !Taylor and Yelland
139         endif         endif
140        rr=zo*usr/visa        rr=zo*usr/visa
141  c  c
142  c *** zoq and zot fitted to results from several ETL cruises ************  c *** zoq and zot fitted to results from several ETL cruises ************
# Line 159  c Line 160  c
160         endif         endif
161           Du=sqrt(u**2.+Wg**2.)        !include gustiness in wind spd.           Du=sqrt(u**2.+Wg**2.)        !include gustiness in wind spd.
162         enddo         enddo
163    
164  c compute surface fluxes and other parameters  c compute surface fluxes and other parameters
165         tau=rhoa*usr*usr*u/Du          !stress N/m2         tau=rhoa*usr*usr*u/Du          !stress N/m2
166         hf=-cpair*rhoa*usr*tsr           !sensible W/m2         hf=-cpair*rhoa*usr*tsr           !sensible W/m2
# Line 171  c compute surface fluxes and other param Line 172  c compute surface fluxes and other param
172         endif         endif
173         q100=qs+qsr*(dlog(100. _d 0/zoq)-psit(100. _d 0/L))         q100=qs+qsr*(dlog(100. _d 0/zoq)-psit(100. _d 0/L))
174  c  c
175        return        return
176        end        end
177  c  c
178  c------------------------------------------------------------------  c------------------------------------------------------------------
# Line 199  c Line 200  c
200        endif        endif
201        return        return
202        end        end
203  c--------------------------------------------------------------    c--------------------------------------------------------------
204        function psit(zL)        function psit(zL)
205          
206        implicit none        implicit none
207        _RL zL,x,y,psik,psic,f,psit,c        _RL zL,x,y,psik,psic,f,psit,c
208        if(zL.lt.0.0) then        if(zL.lt.0.0) then
# Line 218  c--------------------------------------- Line 219  c---------------------------------------
219        endif        endif
220        return        return
221        end        end
222              
223  c-------------------------------------------------------------  c-------------------------------------------------------------
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22