/[MITgcm]/MITgcm/pkg/exf/exf_bulkformulae.F
ViewVC logotype

Diff of /MITgcm/pkg/exf/exf_bulkformulae.F

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

revision 1.29 by jmc, Sat Dec 8 15:24:13 2012 UTC revision 1.30 by jmc, Fri May 2 22:14:52 2014 UTC
# Line 187  C     these need to be 2D-arrays for vec Line 187  C     these need to be 2D-arrays for vec
187        _RL rd    (1:sNx,1:sNy)   ! = sqrt(Cd)          [-]        _RL rd    (1:sNx,1:sNy)   ! = sqrt(Cd)          [-]
188        _RL delq  (1:sNx,1:sNy)   ! specific humidity difference [kg/kg]        _RL delq  (1:sNx,1:sNy)   ! specific humidity difference [kg/kg]
189        _RL deltap(1:sNx,1:sNy)        _RL deltap(1:sNx,1:sNy)
190  C  #ifdef EXF_CALC_ATMRHO
191          _RL atmrho_loc(1:sNx,1:sNy) ! local atmospheric density [kg/m^3]
192    #endif
193    
194  #ifdef ALLOW_BULK_LARGEYEAGER04  #ifdef ALLOW_BULK_LARGEYEAGER04
195        _RL dzTmp        _RL dzTmp
196  #endif  #endif
# Line 239  C-- Set surface parameters : Line 242  C-- Set surface parameters :
242  C--   abbreviation  C--   abbreviation
243        recip_rhoConstFresh = 1. _d 0/rhoConstFresh        recip_rhoConstFresh = 1. _d 0/rhoConstFresh
244    
245  c     Loop over tiles.  C     Loop over tiles.
246  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
247  C--   HPF directive to help TAMC  C--   HPF directive to help TAMC
248  CHPF$ INDEPENDENT  CHPF$ INDEPENDENT
# Line 289  C-   Surface Temp. Line 292  C-   Surface Temp.
292       &              *  maskC(i,j,ksrfp1,bi,bj)       &              *  maskC(i,j,ksrfp1,bi,bj)
293              Tsf = Tsf + MAX( SSTtmp, 0. _d 0 )              Tsf = Tsf + MAX( SSTtmp, 0. _d 0 )
294             ENDIF             ENDIF
295  c  
296             tmpbulk = cvapor_fac*exp(-cvapor_exp/Tsf)             tmpbulk = cvapor_fac*exp(-cvapor_exp/Tsf)
297    #ifdef EXF_CALC_ATMRHO
298               atmrho_loc(i,j) = apressure(i,j,bi,bj) /
299         &                  (287.04 _d 0*atemp(i,j,bi,bj)
300         &                  *(1. _d 0 + humid_fac*aqh(i,j,bi,bj)))
301               ssq = saltsat*tmpbulk/atmrho_loc(i,j)
302    #else
303             ssq = saltsat*tmpbulk/atmrho             ssq = saltsat*tmpbulk/atmrho
304    #endif
305             deltap(i,j) = atemp(i,j,bi,bj) + gamma_blk*ht - Tsf             deltap(i,j) = atemp(i,j,bi,bj) + gamma_blk*ht - Tsf
306             delq(i,j)   = aqh(i,j,bi,bj) - ssq             delq(i,j)   = aqh(i,j,bi,bj) - ssq
307  C--  no negative evaporation over ocean:  C--  no negative evaporation over ocean:
# Line 314  C--   Wind speed Line 324  C--   Wind speed
324             ELSE             ELSE
325              rdn(i,j)   = 0. _d 0              rdn(i,j)   = 0. _d 0
326              windStress = wStress(i,j,bi,bj)              windStress = wStress(i,j,bi,bj)
327    #ifdef EXF_CALC_ATMRHO
328                ustar(i,j) = sqrt(windStress/atmrho_loc(i,j))
329                tau(i,j)   = sqrt(windStress*atmrho_loc(i,j))
330    #else
331              ustar(i,j) = sqrt(windStress/atmrho)              ustar(i,j) = sqrt(windStress/atmrho)
332  c           tau(i,j)   = windStress/ustar(i,j)  c           tau(i,j)   = windStress/ustar(i,j)
333              tau(i,j)   = sqrt(windStress*atmrho)              tau(i,j)   = sqrt(windStress*atmrho)
334    #endif
335             ENDIF             ENDIF
336    
337  C--  initial guess for exchange other coefficients:  C--  initial guess for exchange other coefficients:
# Line 374  C--   Large&Pond1981: Line 389  C--   Large&Pond1981:
389              hqol   = huol*hq/hu              hqol   = huol*hq/hu
390              stable = exf_half + sign(exf_half, huol)              stable = exf_half + sign(exf_half, huol)
391    
392  c                 Evaluate all stability functions assuming hq = ht.  C     Evaluate all stability functions assuming hq = ht.
393              IF ( solve4Stress ) THEN              IF ( solve4Stress ) THEN
394  #ifdef ALLOW_BULK_LARGEYEAGER04  #ifdef ALLOW_BULK_LARGEYEAGER04
395  C--   Large&Yeager04:  C--   Large&Yeager04:
# Line 413  C--   Large&Yeager04: Line 428  C--   Large&Yeager04:
428  C--   Large&Pond1981:  C--   Large&Pond1981:
429  c           rd(i,j)= rdn(i,j)/(exf_one - rdn(i,j)/karman*psimh )  c           rd(i,j)= rdn(i,j)/(exf_one - rdn(i,j)/karman*psimh )
430  c           usn    = sh(i,j,bi,bj)*rd(i,j)/rdn(i,j)  c           usn    = sh(i,j,bi,bj)*rd(i,j)/rdn(i,j)
431  c     ML: the original formulation above is replaced below to be  C     ML: the original formulation above is replaced below to be
432  c     similar to largeyeager04, but does not give the same results, strange  C     similar to largeyeager04, but does not give the same results, strange
433               usn   = sh(i,j,bi,bj)/(exf_one - rdn(i,j)/karman*psimh)               usn   = sh(i,j,bi,bj)/(exf_one - rdn(i,j)/karman*psimh)
434  #endif /* ALLOW_BULK_LARGEYEAGER04 */  #endif /* ALLOW_BULK_LARGEYEAGER04 */
435               usm   = MAX(usn, umin)               usm   = MAX(usn, umin)
# Line 430  C-   Update the 10m, neutral stability t Line 445  C-   Update the 10m, neutral stability t
445  #endif /* ALLOW_BULK_LARGEYEAGER04 */  #endif /* ALLOW_BULK_LARGEYEAGER04 */
446               ustar(i,j) = rd(i,j)*sh(i,j,bi,bj)               ustar(i,j) = rd(i,j)*sh(i,j,bi,bj)
447  C-   Coeff:  C-   Coeff:
448    #ifdef EXF_CALC_ATMRHO
449                 tau(i,j)   = atmrho_loc(i,j)*rd(i,j)*wspeed(i,j,bi,bj)
450    #else
451               tau(i,j)   = atmrho*rd(i,j)*wspeed(i,j,bi,bj)               tau(i,j)   = atmrho*rd(i,j)*wspeed(i,j,bi,bj)
452    #endif
453              ENDIF              ENDIF
454    
455  C-   Update the 10m, neutral stability transfer coefficients (sens&evap)  C-   Update the 10m, neutral stability transfer coefficients (sens&evap)
# Line 448  C--  Update ustar, tstar, qstar using up Line 467  C--  Update ustar, tstar, qstar using up
467             ENDIF             ENDIF
468            ENDDO            ENDDO
469           ENDDO           ENDDO
470  c end of iteration loop  C end of iteration loop
471          ENDDO          ENDDO
472          DO j = 1,sNy          DO j = 1,sNy
473           DO i = 1,sNx           DO i = 1,sNx
Legend:
Removed from v.1.29  
changed lines
  Added in v.1.30
  ViewVC Help
Powered by ViewVC 1.1.22