- Timestamp:
- 2016-01-08T10:35:19+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
r4292 r6225 8 8 !! ! 1997-08 (G. Madec) optimization 9 9 !! ! 1999-07 (E. Guilyardi) hd28 + heat content 10 !! 8.5! 2002-06 (G. Madec) F90: Free form and module11 !! NEMO3.2 ! 2009-07 (S. Masson) hc300 bugfix + cleaning + add new diag12 !!---------------------------------------------------------------------- 13 #if defined key_diahth || defined key_esopa10 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 11 !! 3.2 ! 2009-07 (S. Masson) hc300 bugfix + cleaning + add new diag 12 !!---------------------------------------------------------------------- 13 #if defined key_diahth 14 14 !!---------------------------------------------------------------------- 15 15 !! 'key_diahth' : thermocline depth diag. … … 20 20 USE dom_oce ! ocean space and time domain 21 21 USE phycst ! physical constants 22 ! 22 23 USE in_out_manager ! I/O manager 23 24 USE lib_mpp ! MPP library … … 31 32 PUBLIC dia_hth_alloc ! routine called by nemogcm.F90 32 33 33 LOGICAL , PUBLIC, PARAMETER :: lk_diahth = .TRUE. !: thermocline-20d depths flag 34 LOGICAL , PUBLIC, PARAMETER :: lk_diahth = .TRUE. !: thermocline-20d depths flag 35 34 36 ! note: following variables should move to local variables once iom_put is always used 35 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hth !: depth of the max vertical temperature gradient [m] … … 38 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: htc3 !: heat content of first 300 m [W] 39 41 40 !! * Substitutions41 # include "domzgr_substitute.h90"42 42 !!---------------------------------------------------------------------- 43 43 !! NEMO/OPA 4.0 , NEMO Consortium (2011) … … 52 52 !!--------------------------------------------------------------------- 53 53 ! 54 ALLOCATE( hth(jpi,jpj), hd20(jpi,jpj), hd28(jpi,jpj), htc3(jpi,jpj), STAT=dia_hth_alloc)54 ALLOCATE( hth(jpi,jpj), hd20(jpi,jpj), hd28(jpi,jpj), htc3(jpi,jpj), STAT=dia_hth_alloc ) 55 55 ! 56 56 IF( lk_mpp ) CALL mpp_sum ( dia_hth_alloc ) … … 108 108 IF( kt == nit000 ) THEN 109 109 ! ! allocate dia_hth array 110 IF( dia_hth_alloc() /= 0 ) CALL ctl_stop( 'STOP', ' lim_sbc_init: unable to allocate standard arrays' )111 112 IF(. not. ALLOCATED(ik20))THEN110 IF( dia_hth_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_hth : unable to allocate standard arrays' ) 111 112 IF(.NOT. ALLOCATED(ik20) ) THEN 113 113 ALLOCATE(ik20(jpi,jpj), ik28(jpi,jpj), & 114 114 & zabs2(jpi,jpj), & … … 187 187 DO ji = 1, jpi 188 188 ! 189 zzdep = fsdepw(ji,jj,jk)189 zzdep = gdepw_n(ji,jj,jk) 190 190 zztmp = ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) / zzdep * tmask(ji,jj,jk) ! vertical gradient of temperature (dT/dz) 191 191 zzdep = zzdep * tmask(ji,jj,1) … … 223 223 DO ji = 1, jpi 224 224 ! 225 zzdep = fsdepw(ji,jj,jk) * tmask(ji,jj,1)225 zzdep = gdepw_n(ji,jj,jk) * tmask(ji,jj,1) 226 226 ! 227 227 zztmp = tsn(ji,jj,nla10,jp_tem) - tsn(ji,jj,jk,jp_tem) ! - delta T(10m) … … 245 245 CALL iom_put( "mldr10_3", zrho10_3 ) ! MLD delta rho(10m) = 0.03 246 246 CALL iom_put( "pycndep" , zpycn ) ! MLD delta rho equi. delta T(10m) = 0.2 247 CALL iom_put( "BLT" , ztm2 - zpycn ) ! Barrier Layer Thickness248 247 CALL iom_put( "tinv" , ztinv ) ! max. temp. inv. (t10 ref) 249 248 CALL iom_put( "depti" , zdepinv ) ! depth of max. temp. inv. (t10 ref) … … 271 270 DO ji = 1, jpi 272 271 ! 273 zzdep = fsdepw(ji,jj,mbkt(ji,jj)+1) ! depth of the oean bottom272 zzdep = gdepw_n(ji,jj,mbkt(ji,jj)+1) ! depth of the oean bottom 274 273 ! 275 274 iid = ik20(ji,jj) 276 275 IF( iid /= 1 ) THEN 277 zztmp = fsdept(ji,jj,iid ) & ! linear interpolation278 & + ( fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid) ) &276 zztmp = gdept_n(ji,jj,iid ) & ! linear interpolation 277 & + ( gdept_n(ji,jj,iid+1) - gdept_n(ji,jj,iid) ) & 279 278 & * ( 20.*tmask(ji,jj,iid+1) - tsn(ji,jj,iid,jp_tem) ) & 280 279 & / ( tsn(ji,jj,iid+1,jp_tem) - tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) ) … … 286 285 iid = ik28(ji,jj) 287 286 IF( iid /= 1 ) THEN 288 zztmp = fsdept(ji,jj,iid ) & ! linear interpolation289 & + ( fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid) ) &287 zztmp = gdept_n(ji,jj,iid ) & ! linear interpolation 288 & + ( gdept_n(ji,jj,iid+1) - gdept_n(ji,jj,iid) ) & 290 289 & * ( 28.*tmask(ji,jj,iid+1) - tsn(ji,jj,iid,jp_tem) ) & 291 290 & / ( tsn(ji,jj,iid+1,jp_tem) - tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) ) … … 312 311 END DO 313 312 ! surface boundary condition 314 IF( l k_vvl ) THEN ; zthick(:,:) = 0._wp ; htc3(:,:) = 0._wp315 ELSE ; zthick(:,:) = sshn(:,:) ; htc3(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) * tmask(:,:,1)313 IF( ln_linssh ) THEN ; zthick(:,:) = sshn(:,:) ; htc3(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) * tmask(:,:,1) 314 ELSE ; zthick(:,:) = 0._wp ; htc3(:,:) = 0._wp 316 315 ENDIF 317 316 ! integration down to ilevel 318 317 DO jk = 1, ilevel 319 zthick(:,:) = zthick(:,:) + fse3t(:,:,jk)320 htc3 (:,:) = htc3 (:,:) + fse3t(:,:,jk) * tsn(:,:,jk,jp_tem) * tmask(:,:,jk)318 zthick(:,:) = zthick(:,:) + e3t_n(:,:,jk) 319 htc3 (:,:) = htc3 (:,:) + e3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) * tmask(:,:,jk) 321 320 END DO 322 321 ! deepest layer … … 324 323 DO jj = 1, jpj 325 324 DO ji = 1, jpi 326 htc3(ji,jj) = htc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem) * MIN( fse3t(ji,jj,ilevel+1), zthick(ji,jj) )&327 325 htc3(ji,jj) = htc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem) & 326 & * MIN( e3t_n(ji,jj,ilevel+1), zthick(ji,jj) ) * tmask(ji,jj,ilevel+1) 328 327 END DO 329 328 END DO
Note: See TracChangeset
for help on using the changeset viewer.