Changeset 6140 for trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
- Timestamp:
- 2015-12-21T12:35:23+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
r5836 r6140 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) … … 270 270 DO ji = 1, jpi 271 271 ! 272 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 273 273 ! 274 274 iid = ik20(ji,jj) 275 275 IF( iid /= 1 ) THEN 276 zztmp = fsdept(ji,jj,iid ) & ! linear interpolation277 & + ( 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) ) & 278 278 & * ( 20.*tmask(ji,jj,iid+1) - tsn(ji,jj,iid,jp_tem) ) & 279 279 & / ( tsn(ji,jj,iid+1,jp_tem) - tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) ) … … 285 285 iid = ik28(ji,jj) 286 286 IF( iid /= 1 ) THEN 287 zztmp = fsdept(ji,jj,iid ) & ! linear interpolation288 & + ( 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) ) & 289 289 & * ( 28.*tmask(ji,jj,iid+1) - tsn(ji,jj,iid,jp_tem) ) & 290 290 & / ( tsn(ji,jj,iid+1,jp_tem) - tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) ) … … 311 311 END DO 312 312 ! surface boundary condition 313 IF( l k_vvl ) THEN ; zthick(:,:) = 0._wp ; htc3(:,:) = 0._wp314 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 315 315 ENDIF 316 316 ! integration down to ilevel 317 317 DO jk = 1, ilevel 318 zthick(:,:) = zthick(:,:) + fse3t(:,:,jk)319 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) 320 320 END DO 321 321 ! deepest layer … … 323 323 DO jj = 1, jpj 324 324 DO ji = 1, jpi 325 htc3(ji,jj) = htc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem) * MIN( fse3t(ji,jj,ilevel+1), zthick(ji,jj) )&326 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) 327 327 END DO 328 328 END DO
Note: See TracChangeset
for help on using the changeset viewer.