Skip to content
Snippets Groups Projects
Commit 522ad4c1 authored by “Katherine's avatar “Katherine
Browse files

going back to original trunk

parent a2c59863
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Showing
with 35 additions and 51 deletions
src/OCE/DIA/diahth.F90
+ 35
− 51
View file @ 522ad4c1
...@@ -86,22 +86,22 @@ CONTAINS ...@@ -86,22 +86,22 @@ CONTAINS
INTEGER, INTENT( in ) :: kt ! ocean time-step index INTEGER, INTENT( in ) :: kt ! ocean time-step index
INTEGER, INTENT( in ) :: Kmm ! ocean time level index INTEGER, INTENT( in ) :: Kmm ! ocean time level index
!! !!
INTEGER :: ji, jj, jk ! dummy loop arguments INTEGER :: ji, jj, jk ! dummy loop arguments
REAL(wp) :: zrho3 = 0.03_wp ! density criterion for mixed layer depth REAL(wp) :: zrho3 = 0.03_wp ! density criterion for mixed layer depth
REAL(wp) :: zrho1 = 0.01_wp ! density criterion for mixed layer depth REAL(wp) :: zrho1 = 0.01_wp ! density criterion for mixed layer depth
REAL(wp) :: ztem2 = 0.2_wp ! temperature criterion for mixed layer depth REAL(wp) :: ztem2 = 0.2_wp ! temperature criterion for mixed layer depth
REAL(wp) :: zztmp, zzdep ! temporary scalars inside do loop REAL(wp) :: zztmp, zzdep ! temporary scalars inside do loop
REAL(wp) :: zu, zv, zw, zut, zvt ! temporary workspace REAL(wp) :: zu, zv, zw, zut, zvt ! temporary workspace
REAL(wp), DIMENSION(A2D(0)) :: zabs2 ! MLD: abs( tn - tn(10m) ) = ztem2 REAL(wp), DIMENSION(jpi,jpj) :: zabs2 ! MLD: abs( tn - tn(10m) ) = ztem2
REAL(wp), DIMENSION(A2D(0)) :: ztm2 ! Top of thermocline: tn = tn(10m) - ztem2 REAL(wp), DIMENSION(jpi,jpj) :: ztm2 ! Top of thermocline: tn = tn(10m) - ztem2
REAL(wp), DIMENSION(A2D(0)) :: zrho10_3 ! MLD: rho = rho10m + zrho3 REAL(wp), DIMENSION(jpi,jpj) :: zrho10_3 ! MLD: rho = rho10m + zrho3
REAL(wp), DIMENSION(A2D(0)) :: zpycn ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC) REAL(wp), DIMENSION(jpi,jpj) :: zpycn ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC)
REAL(wp), DIMENSION(A2D(0)) :: ztinv ! max of temperature inversion REAL(wp), DIMENSION(jpi,jpj) :: ztinv ! max of temperature inversion
REAL(wp), DIMENSION(A2D(0)) :: zdepinv ! depth of temperature inversion REAL(wp), DIMENSION(jpi,jpj) :: zdepinv ! depth of temperature inversion
REAL(wp), DIMENSION(A2D(0)) :: zrho0_3 ! MLD rho = rho(surf) = 0.03 REAL(wp), DIMENSION(jpi,jpj) :: zrho0_3 ! MLD rho = rho(surf) = 0.03
REAL(wp), DIMENSION(A2D(0)) :: zrho0_1 ! MLD rho = rho(surf) = 0.01 REAL(wp), DIMENSION(jpi,jpj) :: zrho0_1 ! MLD rho = rho(surf) = 0.01
REAL(wp), DIMENSION(A2D(0)) :: zmaxdzT ! max of dT/dz REAL(wp), DIMENSION(jpi,jpj) :: zmaxdzT ! max of dT/dz
REAL(wp), DIMENSION(A2D(0)) :: zdelr ! delta rho equivalent to deltaT = 0.2 REAL(wp), DIMENSION(jpi,jpj) :: zdelr ! delta rho equivalent to deltaT = 0.2
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
IF( ln_timing ) CALL timing_start('dia_hth') IF( ln_timing ) CALL timing_start('dia_hth')
...@@ -126,12 +126,10 @@ CONTAINS ...@@ -126,12 +126,10 @@ CONTAINS
! !
IF( iom_use( 'mlddzt' ) .OR. iom_use( 'mldr0_3' ) .OR. iom_use( 'mldr0_1' ) ) THEN IF( iom_use( 'mlddzt' ) .OR. iom_use( 'mldr0_3' ) .OR. iom_use( 'mldr0_1' ) ) THEN
! initialization ! initialization
DO_2D( 0, 0, 0, 0) ! loop from bottom to 2 ztinv (:,:) = 0._wp
ztinv (ji,jj) = 0._wp zdepinv(:,:) = 0._wp
zdepinv(ji,jj) = 0._wp zmaxdzT(:,:) = 0._wp
zmaxdzT(ji,jj) = 0._wp DO_2D( 1, 1, 1, 1 )
END_2D
DO_2D( 0, 0, 0, 0 )
zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)
hth (ji,jj) = zztmp hth (ji,jj) = zztmp
zabs2 (ji,jj) = zztmp zabs2 (ji,jj) = zztmp
...@@ -140,7 +138,7 @@ CONTAINS ...@@ -140,7 +138,7 @@ CONTAINS
zpycn (ji,jj) = zztmp zpycn (ji,jj) = zztmp
END_2D END_2D
IF( nla10 > 1 ) THEN IF( nla10 > 1 ) THEN
DO_2D( 0, 0, 0, 0 ) DO_2D( 1, 1, 1, 1 )
zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)
zrho0_3(ji,jj) = zztmp zrho0_3(ji,jj) = zztmp
zrho0_1(ji,jj) = zztmp zrho0_1(ji,jj) = zztmp
...@@ -149,7 +147,7 @@ CONTAINS ...@@ -149,7 +147,7 @@ CONTAINS
! Preliminary computation ! Preliminary computation
! computation of zdelr = (dr/dT)(T,S,10m)*(-0.2 degC) ! computation of zdelr = (dr/dT)(T,S,10m)*(-0.2 degC)
DO_2D( 0, 0, 0, 0 ) DO_2D( 1, 1, 1, 1 )
IF( tmask(ji,jj,nla10) == 1. ) THEN IF( tmask(ji,jj,nla10) == 1. ) THEN
zu = 1779.50 + 11.250 * ts(ji,jj,nla10,jp_tem,Kmm) - 3.80 * ts(ji,jj,nla10,jp_sal,Kmm) & zu = 1779.50 + 11.250 * ts(ji,jj,nla10,jp_tem,Kmm) - 3.80 * ts(ji,jj,nla10,jp_sal,Kmm) &
& - 0.0745 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_tem,Kmm) & & - 0.0745 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_tem,Kmm) &
...@@ -171,7 +169,7 @@ CONTAINS ...@@ -171,7 +169,7 @@ CONTAINS
! MLD: rho = rho(1) + zrho3 ! ! MLD: rho = rho(1) + zrho3 !
! MLD: rho = rho(1) + zrho1 ! ! MLD: rho = rho(1) + zrho1 !
! ------------------------------------------------------------- ! ! ------------------------------------------------------------- !
DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! loop from bottom to 2 DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) ! loop from bottom to 2
! !
zzdep = gdepw(ji,jj,jk,Kmm) zzdep = gdepw(ji,jj,jk,Kmm)
zztmp = ( ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ) & zztmp = ( ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ) &
...@@ -208,7 +206,7 @@ CONTAINS ...@@ -208,7 +206,7 @@ CONTAINS
! temperature inversion: max( 0, max of tn - tn(10m) ) ! ! temperature inversion: max( 0, max of tn - tn(10m) ) !
! depth of temperature inversion ! ! depth of temperature inversion !
! ------------------------------------------------------------- ! ! ------------------------------------------------------------- !
DO_3DS( 0, 0, 0, 0, jpkm1, nlb10, -1 ) ! loop from bottom to nlb10 DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) ! loop from bottom to nlb10
! !
zzdep = gdepw(ji,jj,jk,Kmm) * tmask(ji,jj,1) zzdep = gdepw(ji,jj,jk,Kmm) * tmask(ji,jj,1)
! !
...@@ -300,16 +298,13 @@ CONTAINS ...@@ -300,16 +298,13 @@ CONTAINS
! !
INTEGER :: ji, jj, jk, iid INTEGER :: ji, jj, jk, iid
REAL(wp) :: zztmp, zzdep REAL(wp) :: zztmp, zzdep
INTEGER, DIMENSION(A2D(0)) :: iktem INTEGER, DIMENSION(jpi,jpj) :: iktem
! --------------------------------------- ! ! --------------------------------------- !
! search deepest level above ptem ! ! search deepest level above ptem !
! --------------------------------------- ! ! --------------------------------------- !
DO_2D( 0, 0, 0, 0 ) iktem(:,:) = 1
iktem(ji,jj) = 1 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! beware temperature is not always decreasing with depth => loop from top to bottom
END_2D
DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! beware temperature is not always decreasing with depth => loop from top to bottom
zztmp = ts(ji,jj,jk,jp_tem,Kmm) zztmp = ts(ji,jj,jk,jp_tem,Kmm)
IF( zztmp >= ptem ) iktem(ji,jj) = jk IF( zztmp >= ptem ) iktem(ji,jj) = jk
END_3D END_3D
...@@ -317,7 +312,7 @@ CONTAINS ...@@ -317,7 +312,7 @@ CONTAINS
! ------------------------------- ! ! ------------------------------- !
! Depth of ptem isotherm ! ! Depth of ptem isotherm !
! ------------------------------- ! ! ------------------------------- !
DO_2D( 0, 0, 0, 0 ) DO_2D( 1, 1, 1, 1 )
! !
zzdep = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) ! depth of the ocean bottom zzdep = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) ! depth of the ocean bottom
! !
...@@ -344,29 +339,18 @@ CONTAINS ...@@ -344,29 +339,18 @@ CONTAINS
REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: phtc REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: phtc
! !
INTEGER :: ji, jj, jk, ik INTEGER :: ji, jj, jk, ik
REAL(wp), DIMENSION(A2D(0)) :: zthick REAL(wp), DIMENSION(jpi,jpj) :: zthick
INTEGER , DIMENSION(A2D(0)) :: ilevel INTEGER , DIMENSION(jpi,jpj) :: ilevel
! surface boundary condition ! surface boundary condition
IF( .NOT. ln_linssh ) THEN IF( .NOT. ln_linssh ) THEN ; zthick(:,:) = 0._wp ; phtc(:,:) = 0._wp
DO_2D( 0, 0, 0, 0 ) ELSE ; zthick(:,:) = ssh(:,:,Kmm) ; phtc(:,:) = pt(:,:,1) * ssh(:,:,Kmm) * tmask(:,:,1)
zthick(ji,jj) = 0._wp
phtc (ji,jj) = 0._wp
END_2D
ELSE
DO_2D( 0, 0, 0, 0 )
zthick(ji,jj) = ssh(ji,jj,Kmm)
phtc (ji,jj) = pt(ji,jj,1) * ssh(ji,jj,Kmm) * tmask(ji,jj,1)
END_2D
ENDIF ENDIF
! !
DO_2D( 0, 0, 0, 0 ) ilevel(:,:) = 1
ilevel(ji,jj) = 1 DO_3D( 1, 1, 1, 1, 1, jpkm1 )
END_2D
!
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
IF( ( gdepw(ji,jj,jk+1,Kmm) < pdep ) .AND. ( tmask(ji,jj,jk) == 1 ) ) THEN IF( ( gdepw(ji,jj,jk+1,Kmm) < pdep ) .AND. ( tmask(ji,jj,jk) == 1 ) ) THEN
ilevel(ji,jj) = jk+1 ilevel(ji,jj) = jk+1
zthick(ji,jj) = zthick(ji,jj) + e3t(ji,jj,jk,Kmm) zthick(ji,jj) = zthick(ji,jj) + e3t(ji,jj,jk,Kmm)
...@@ -374,7 +358,7 @@ CONTAINS ...@@ -374,7 +358,7 @@ CONTAINS
ENDIF ENDIF
END_3D END_3D
! !
DO_2D( 0, 0, 0, 0 ) DO_2D( 1, 1, 1, 1 )
ik = ilevel(ji,jj) ik = ilevel(ji,jj)
IF( tmask(ji,jj,ik) == 1 ) THEN IF( tmask(ji,jj,ik) == 1 ) THEN
zthick(ji,jj) = MIN ( gdepw(ji,jj,ik+1,Kmm), pdep ) - zthick(ji,jj) ! remaining thickness to reach dephw pdep zthick(ji,jj) = MIN ( gdepw(ji,jj,ik+1,Kmm), pdep ) - zthick(ji,jj) ! remaining thickness to reach dephw pdep
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment