MODULE diahth !!====================================================================== !! *** MODULE diahth *** !! Ocean diagnostics: thermocline and 20 degree depth !!====================================================================== !! History : OPA ! 1994-09 (J.-P. Boulanger) Original code !! ! 1996-11 (E. Guilyardi) OPA8 !! ! 1997-08 (G. Madec) optimization !! ! 1999-07 (E. Guilyardi) hd28 + heat content !! 8.5 ! 2002-06 (G. Madec) F90: Free form and module !! NEMO 3.2 ! 2009-07 (S. Masson) hc300 bugfix + cleaning !!---------------------------------------------------------------------- #if defined key_diahth || defined key_esopa !!---------------------------------------------------------------------- !! 'key_diahth' : thermocline depth diag. !!---------------------------------------------------------------------- !! dia_hth : Compute diagnostics associated with the thermocline !!---------------------------------------------------------------------- !! * Modules used USE oce ! ocean dynamics and tracers USE dom_oce ! ocean space and time domain USE phycst ! physical constants USE in_out_manager ! I/O manager USE iom IMPLICIT NONE PRIVATE !! * Routine accessibility PUBLIC dia_hth ! routine called by step.F90 !! * Shared module variables LOGICAL , PUBLIC, PARAMETER :: lk_diahth = .TRUE. !: thermocline-20d depths flag REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: hth , & !: depth of the max vertical temperature gradient (m) hd20 , & !: depth of 20 C isotherm (m) hd28 , & !: depth of 28 C isotherm (m) htc3 !: heat content of first 300 m !! * Substitutions # include "domzgr_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) !! $Id$ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE dia_hth( kt ) !!--------------------------------------------------------------------- !! *** ROUTINE dia_hth *** !! !! ** Purpose : !! Computes the depth of strongest vertical temperature gradient !! Computes the depth of the 20 degree isotherm !! Computes the depth of the 28 degree isotherm !! Computes the heat content of first 300 m !! !! ** Method : !! !!------------------------------------------------------------------- INTEGER, INTENT( in ) :: kt ! ocean time-step index !! INTEGER :: ji, jj, jk ! dummy loop arguments INTEGER :: iid, iif, ilevel ! temporary integers INTEGER, DIMENSION(jpi,jpj) :: ikc ! levels REAL(wp) :: zd, zthick_0, zcoef ! temporary scalars REAL(wp), DIMENSION(jpi,jpj) :: zthick REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdzt !!---------------------------------------------------------------------- IF( kt == nit000 ) THEN IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'dia_hth : diagnostics of the thermocline depth' IF(lwp) WRITE(numout,*) '~~~~~~~ ' IF(lwp) WRITE(numout,*) ENDIF ! -------------------------- ! ! Depth of the thermocline ! ! -------------------------- ! ! The depth of the thermocline is defined as the depth of the ! strongest vertical temperature gradient zdzt(:,:,1) = 0.e0 DO jk = 2, jpk ! vertical gradient of temperature zdzt(:,:,jk) = ( tn(:,:,jk-1) - tn(:,:,jk) ) / fse3w(:,:,jk) * tmask(:,:,jk) END DO DO jj = 1, jpj DO ji = 1, jpi ilevel = MAXLOC( zdzt(ji,jj,:), dim= 1 ) ! level of maximum vertical temperature gradient hth(ji,jj) = fsdepw(ji,jj,ilevel) ! depth of the thermocline END DO END DO CALL iom_put( "thermod", hth ) ! depth of the thermocline ! ----------------------- ! ! Depth of 20C isotherm ! ! ----------------------- ! ! search last level above 20C ikc(:,:) = COUNT( tn >= 20., dim = 3 ) ! Depth of 20C isotherm, linear interpolation DO jj = 1, jpj DO ji = 1, jpi iid = MAX(1, ikc(ji,jj)) zd = fsdept(ji,jj,iid) + ( fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid) ) & & * ( 20.*tmask(ji,jj,iid+1) - tn(ji,jj,iid) ) & & / ( tn(ji,jj,iid+1) - tn(ji,jj,iid) + ( 1. - tmask(ji,jj,1) ) ) ! bound by the ocean depth, minimum value, first T-point depth iif = mbathy(ji,jj) hd20(ji,jj) = MIN( zd*tmask(ji,jj,1), fsdepw(ji,jj,iif) ) END DO END DO WHERE(ikc == 0 ) hd20 = 0.e0 CALL iom_put( "20d", hd20 ) ! depth of the 20 isotherm ! ----------------------- ! ! Depth of 28C isotherm ! ! ----------------------- ! ! search last level above 28C ikc(:,:) = COUNT( tn >= 28., dim = 3 ) ! Depth of 28C isotherm, linear interpolation DO jj = 1, jpj DO ji = 1, jpi iid = MAX(1, ikc(ji,jj)) zd = fsdept(ji,jj,iid) + ( fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid) ) & & * ( 28.*tmask(ji,jj,iid+1) - tn(ji,jj,iid) ) & & / ( tn(ji,jj,iid+1) - tn(ji,jj,iid) + ( 1. - tmask(ji,jj,1) ) ) ! bound by the ocean depth, minimum value, first T-point depth iif = mbathy(ji,jj) hd28(ji,jj) = MIN( zd*tmask(ji,jj,1), fsdepw(ji,jj,iif) ) END DO END DO WHERE(ikc == 0 ) hd28 = 0.e0 CALL iom_put( "28d", hd28 ) ! depth of the 28 isotherm ! ----------------------------- ! ! Heat content of first 300 m ! ! ----------------------------- ! ! find ilevel with (ilevel+1) the deepest W-level above 300m (we assume we can use e3t_0 to do this search...) ilevel = 0 zthick_0 = 0.e0 DO jk = 1, jpk-1 zthick_0 = zthick_0 + e3t_0(jk) IF( zthick_0 < 300. ) ilevel = jk END DO ! surface boundary condition IF( lk_vvl ) THEN ; zthick(:,:) = 0.e0 ; htc3(:,:) = 0.e0 ELSE ; zthick(:,:) = sshn(:,:) ; htc3(:,:) = tn(:,:,jk) * sshn(:,:) * tmask(:,:,jk) ENDIF ! integration down to ilevel DO jk = 1, ilevel zthick(:,:) = zthick(:,:) + fse3t(:,:,jk) htc3 (:,:) = htc3 (:,:) + fse3t(:,:,jk) * tn(:,:,jk) * tmask(:,:,jk) END DO ! deepest layer zthick(:,:) = 300. - zthick(:,:) ! remaining thickness to reach 300m htc3(:,:) = htc3(:,:) + tn(:,:,ilevel+1) * MIN( fse3t(:,:,ilevel+1), zthick(:,:) ) * tmask(:,:,ilevel+1) ! from temperature to heat contain zcoef = rau0 * rcp htc3(:,:) = zcoef * htc3(:,:) CALL iom_put( "hc300", htc3 ) ! first 300m heaat content END SUBROUTINE dia_hth #else !!---------------------------------------------------------------------- !! Default option : Empty module !!---------------------------------------------------------------------- LOGICAL , PUBLIC, PARAMETER :: lk_diahth = .FALSE. !: thermocline-20d depths flag CONTAINS SUBROUTINE dia_hth( kt ) ! Empty routine WRITE(*,*) 'dia_hth: You should not have seen this print! error?', kt END SUBROUTINE dia_hth #endif !!====================================================================== END MODULE diahth