/[MITgcm]/MITgcm/pkg/kpp/kpp_calc.F
ViewVC logotype

Diff of /MITgcm/pkg/kpp/kpp_calc.F

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

revision 1.9 by adcroft, Thu Sep 27 18:08:57 2001 UTC revision 1.12 by mlosch, Wed Sep 25 19:36:50 2002 UTC
# Line 162  c     vRef   (nx,ny)       - Reference m Line 162  c     vRef   (nx,ny)       - Reference m
162        _RL     worka ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy                )        _RL     worka ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy                )
163        integer work1 ( ibot:itop    , jbot:jtop                    )        integer work1 ( ibot:itop    , jbot:jtop                    )
164        _KPP_RL work2 ( ibot:itop    , jbot:jtop                    )        _KPP_RL work2 ( ibot:itop    , jbot:jtop                    )
165          _KPP_RL work3 ( ibot:itop    , jbot:jtop                    )
166        _KPP_RL ustar ( ibot:itop    , jbot:jtop                    )        _KPP_RL ustar ( ibot:itop    , jbot:jtop                    )
167        _KPP_RL bo    ( ibot:itop    , jbot:jtop                    )        _KPP_RL bo    ( ibot:itop    , jbot:jtop                    )
168        _KPP_RL bosol ( ibot:itop    , jbot:jtop                    )        _KPP_RL bosol ( ibot:itop    , jbot:jtop                    )
# Line 299  c     so that the subroutine "bldepth" w Line 300  c     so that the subroutine "bldepth" w
300           END DO           END DO
301        END DO        END DO
302    
303    cph(
304    cph  this avoids a single or double recomp./call of statekpp
305    CADJ store work2              = comlev1_kpp, key = ikey
306    #ifdef ALLOW_AUTODIFF_KPP_EXTENSIVE_STORE
307    CADJ store dbloc, Ritop, ghat = comlev1_kpp, key = ikey
308    CADJ store vddiff             = comlev1_kpp, key = ikey
309    #endif
310    cph)
311    
312  c------------------------------------------------------------------------  c------------------------------------------------------------------------
313  c     friction velocity, turbulent and radiative surface buoyancy forcing  c     friction velocity, turbulent and radiative surface buoyancy forcing
314  c     -------------------------------------------------------------------  c     -------------------------------------------------------------------
315  c     taux / rho = SurfaceTendencyU * delZ(1)                     (N/m^2)  c     taux / rho = SurfaceTendencyU * drF(1)                     (N/m^2)
316  c     tauy / rho = SurfaceTendencyV * delZ(1)                     (N/m^2)  c     tauy / rho = SurfaceTendencyV * drF(1)                     (N/m^2)
317  c     ustar = sqrt( sqrt( taux^2 + tauy^2 ) / rho )                 (m/s)  c     ustar = sqrt( sqrt( taux^2 + tauy^2 ) / rho )                (m/s)
318  c     bo    = - g * ( alpha*SurfaceTendencyT +  c     bo    = - g * ( alpha*SurfaceTendencyT +
319  c                     beta *SurfaceTendencyS ) * delZ(1) / rho  (m^2/s^3)  c                     beta *SurfaceTendencyS ) * drF(1) / rho  (m^2/s^3)
320  c     bosol = - g * alpha * Qsw * delZ(1) / rho                 (m^2/s^3)  c     bosol = - g * alpha * Qsw * drF(1) / rho                 (m^2/s^3)
321  c------------------------------------------------------------------------  c------------------------------------------------------------------------
322    
323  c initialize arrays to zero  c initialize arrays to zero
# Line 323  c initialize arrays to zero Line 333  c initialize arrays to zero
333         jp1 = j + 1         jp1 = j + 1
334         DO i = imin, imax         DO i = imin, imax
335          ip1 = i+1          ip1 = i+1
336          tempVar1 =          work3(i,j) =
337       &   (SurfaceTendencyU(i,j,bi,bj) + SurfaceTendencyU(ip1,j,bi,bj)) *       &   (SurfaceTendencyU(i,j,bi,bj) + SurfaceTendencyU(ip1,j,bi,bj)) *
338       &   (SurfaceTendencyU(i,j,bi,bj) + SurfaceTendencyU(ip1,j,bi,bj)) +       &   (SurfaceTendencyU(i,j,bi,bj) + SurfaceTendencyU(ip1,j,bi,bj)) +
339       &   (SurfaceTendencyV(i,j,bi,bj) + SurfaceTendencyV(i,jp1,bi,bj)) *       &   (SurfaceTendencyV(i,j,bi,bj) + SurfaceTendencyV(i,jp1,bi,bj)) *
340       &   (SurfaceTendencyV(i,j,bi,bj) + SurfaceTendencyV(i,jp1,bi,bj))       &   (SurfaceTendencyV(i,j,bi,bj) + SurfaceTendencyV(i,jp1,bi,bj))
341          if ( tempVar1 .lt. (phepsi*phepsi) ) then         END DO
342             ustar(i,j) = SQRT( phepsi * p5 * delZ(1) )        END DO
343    cph(
344    CADJ store work3 = comlev1_kpp, key = ikey
345    cph)
346          DO j = jmin, jmax
347           jp1 = j + 1
348           DO i = imin, imax
349            ip1 = i+1
350            if ( work3(i,j) .lt. (phepsi*phepsi) ) then
351               ustar(i,j) = SQRT( phepsi * p5 * drF(1) )
352          else          else
353             tempVar2 =  SQRT( tempVar1 ) * p5 * delZ(1)             tempVar2 =  SQRT( work3(i,j) ) * p5 * drF(1)
354             ustar(i,j) = SQRT( tempVar2 )             ustar(i,j) = SQRT( tempVar2 )
355          endif          endif
356          bo(I,J) = - gravity *          bo(I,J) = - gravity *
357       &       ( vddiff(I,J,1,1) * SurfaceTendencyT(i,j,bi,bj) +       &       ( vddiff(I,J,1,1) * SurfaceTendencyT(i,j,bi,bj) +
358       &         vddiff(I,J,1,2) * SurfaceTendencyS(i,j,bi,bj)       &         vddiff(I,J,1,2) * SurfaceTendencyS(i,j,bi,bj)
359       &       ) *       &       ) *
360       &       delZ(1) / work2(I,J)       &       drF(1) / work2(I,J)
361          bosol(I,J) = gravity * vddiff(I,J,1,1) * Qsw(i,j,bi,bj) *          bosol(I,J) = gravity * vddiff(I,J,1,1) * Qsw(i,j,bi,bj) *
362       &       recip_Cp*recip_rhoNil*recip_dRf(1) *       &       recip_Cp*recip_rhoConst*recip_dRf(1) *
363       &       delZ(1) / work2(I,J)       &       drF(1) / work2(I,J)
364         END DO         END DO
365        END DO        END DO
366    
367    cph(
368    CADJ store ustar = comlev1_kpp, key = ikey
369    cph)
370    
371  c------------------------------------------------------------------------  c------------------------------------------------------------------------
372  c     velocity shear  c     velocity shear
373  c     --------------  c     --------------
# Line 580  c     shsq computation Line 603  c     shsq computation
603           END DO           END DO
604        END DO        END DO
605    
606    cph(
607    #ifdef ALLOW_AUTODIFF_KPP_EXTENSIVE_STORE
608    CADJ store dvsq, shsq = comlev1_kpp, key = ikey
609    #endif
610    cph)
611    
612  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
613  c     solve for viscosity, diffusivity, ghat, and hbl on "t-grid"  c     solve for viscosity, diffusivity, ghat, and hbl on "t-grid"
614  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
# Line 602  c--------------------------------------- Line 631  c---------------------------------------
631    
632        CALL TIMER_STOP ('KPPMIX [KPP_CALC]', myThid)        CALL TIMER_STOP ('KPPMIX [KPP_CALC]', myThid)
633    
 #ifdef ALLOW_AUTODIFF_TAMC  
 cph( storing not necessary  
 cphCADJ STORE vddiff, ghat  = comlev1_kpp, key = ikey  
 cph)  
 #endif /* ALLOW_AUTODIFF_TAMC */  
   
634  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
635  c     zero out land values and transfer to global variables  c     zero out land values and transfer to global variables
636  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
# Line 655  c     horizontal smoothing of vertical d Line 678  c     horizontal smoothing of vertical d
678        _EXCH_XYZ_R8(KPPdiffKzT , myThid )        _EXCH_XYZ_R8(KPPdiffKzT , myThid )
679  #endif /* KPP_SMOOTH_DIFF */  #endif /* KPP_SMOOTH_DIFF */
680    
681    cph(
682    cph  crucial: this avoids full recomp./call of kppmix
683    CADJ store KPPhbl = comlev1_kpp, key = ikey
684    cph)
685    
686  C     Compute fraction of solar short-wave flux penetrating to  C     Compute fraction of solar short-wave flux penetrating to
687  C     the bottom of the mixing layer.  C     the bottom of the mixing layer.
688        DO j=1-OLy,sNy+OLy        DO j=1-OLy,sNy+OLy
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22