Changeset 10965 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DIA/diahth.F90
- Timestamp:
- 2019-05-10T18:02:51+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DIA/diahth.F90
r10425 r10965 60 60 61 61 62 SUBROUTINE dia_hth( kt )62 SUBROUTINE dia_hth( kt, Kmm ) 63 63 !!--------------------------------------------------------------------- 64 64 !! *** ROUTINE dia_hth *** … … 81 81 !!------------------------------------------------------------------- 82 82 INTEGER, INTENT( in ) :: kt ! ocean time-step index 83 INTEGER, INTENT( in ) :: Kmm ! ocean time level index 83 84 !! 84 85 INTEGER :: ji, jj, jk ! dummy loop arguments … … 139 140 DO jj = 1, jpj 140 141 DO ji = 1, jpi 141 zztmp = gdepw _n(ji,jj,mbkt(ji,jj)+1)142 zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 142 143 hth (ji,jj) = zztmp 143 144 zabs2 (ji,jj) = zztmp … … 150 151 DO jj = 1, jpj 151 152 DO ji = 1, jpi 152 zztmp = gdepw _n(ji,jj,mbkt(ji,jj)+1)153 zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 153 154 zrho0_3(ji,jj) = zztmp 154 155 zrho0_1(ji,jj) = zztmp … … 162 163 DO ji = 1, jpi 163 164 IF( tmask(ji,jj,nla10) == 1. ) THEN 164 zu = 1779.50 + 11.250 * ts n(ji,jj,nla10,jp_tem) - 3.80 * tsn(ji,jj,nla10,jp_sal) &165 & - 0.0745 * ts n(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_tem) &166 & - 0.0100 * ts n(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_sal)167 zv = 5891.00 + 38.000 * ts n(ji,jj,nla10,jp_tem) + 3.00 * tsn(ji,jj,nla10,jp_sal) &168 & - 0.3750 * ts n(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_tem)169 zut = 11.25 - 0.149 * ts n(ji,jj,nla10,jp_tem) - 0.01 * tsn(ji,jj,nla10,jp_sal)170 zvt = 38.00 - 0.750 * ts n(ji,jj,nla10,jp_tem)165 zu = 1779.50 + 11.250 * ts(ji,jj,nla10,jp_tem,Kmm) - 3.80 * ts(ji,jj,nla10,jp_sal,Kmm) & 166 & - 0.0745 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_tem,Kmm) & 167 & - 0.0100 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_sal,Kmm) 168 zv = 5891.00 + 38.000 * ts(ji,jj,nla10,jp_tem,Kmm) + 3.00 * ts(ji,jj,nla10,jp_sal,Kmm) & 169 & - 0.3750 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_tem,Kmm) 170 zut = 11.25 - 0.149 * ts(ji,jj,nla10,jp_tem,Kmm) - 0.01 * ts(ji,jj,nla10,jp_sal,Kmm) 171 zvt = 38.00 - 0.750 * ts(ji,jj,nla10,jp_tem,Kmm) 171 172 zw = (zu + 0.698*zv) * (zu + 0.698*zv) 172 173 zdelr(ji,jj) = ztem2 * (1000.*(zut*zv - zvt*zu)/zw) … … 187 188 DO ji = 1, jpi 188 189 ! 189 zzdep = gdepw _n(ji,jj,jk)190 zztmp = ( ts n(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) / zzdep * tmask(ji,jj,jk) ! vertical gradient of temperature (dT/dz)190 zzdep = gdepw(ji,jj,jk,Kmm) 191 zztmp = ( ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ) / zzdep * tmask(ji,jj,jk) ! vertical gradient of temperature (dT/dz) 191 192 zzdep = zzdep * tmask(ji,jj,1) 192 193 … … 223 224 DO ji = 1, jpi 224 225 ! 225 zzdep = gdepw _n(ji,jj,jk) * tmask(ji,jj,1)226 zzdep = gdepw(ji,jj,jk,Kmm) * tmask(ji,jj,1) 226 227 ! 227 zztmp = ts n(ji,jj,nla10,jp_tem) - tsn(ji,jj,jk,jp_tem) ! - delta T(10m)228 zztmp = ts(ji,jj,nla10,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ! - delta T(10m) 228 229 IF( ABS(zztmp) > ztem2 ) zabs2 (ji,jj) = zzdep ! abs > 0.2 229 230 IF( zztmp > ztem2 ) ztm2 (ji,jj) = zzdep ! > 0.2 … … 257 258 DO jj = 1, jpj 258 259 DO ji = 1, jpi 259 zztmp = ts n(ji,jj,jk,jp_tem)260 zztmp = ts(ji,jj,jk,jp_tem,Kmm) 260 261 IF( zztmp >= 20. ) ik20(ji,jj) = jk 261 262 IF( zztmp >= 28. ) ik28(ji,jj) = jk … … 270 271 DO ji = 1, jpi 271 272 ! 272 zzdep = gdepw _n(ji,jj,mbkt(ji,jj)+1) ! depth of the oean bottom273 zzdep = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) ! depth of the oean bottom 273 274 ! 274 275 iid = ik20(ji,jj) 275 276 IF( iid /= 1 ) THEN 276 zztmp = gdept _n(ji,jj,iid) & ! linear interpolation277 & + ( gdept _n(ji,jj,iid+1) - gdept_n(ji,jj,iid) ) &278 & * ( 20.*tmask(ji,jj,iid+1) - ts n(ji,jj,iid,jp_tem) ) &279 & / ( ts n(ji,jj,iid+1,jp_tem) - tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) )277 zztmp = gdept(ji,jj,iid ,Kmm) & ! linear interpolation 278 & + ( gdept(ji,jj,iid+1,Kmm) - gdept(ji,jj,iid,Kmm) ) & 279 & * ( 20.*tmask(ji,jj,iid+1) - ts(ji,jj,iid,jp_tem,Kmm) ) & 280 & / ( ts(ji,jj,iid+1,jp_tem,Kmm) - ts(ji,jj,iid,jp_tem,Kmm) + (1.-tmask(ji,jj,1)) ) 280 281 hd20(ji,jj) = MIN( zztmp , zzdep) * tmask(ji,jj,1) ! bound by the ocean depth 281 282 ELSE … … 285 286 iid = ik28(ji,jj) 286 287 IF( iid /= 1 ) THEN 287 zztmp = gdept _n(ji,jj,iid) & ! linear interpolation288 & + ( gdept _n(ji,jj,iid+1) - gdept_n(ji,jj,iid) ) &289 & * ( 28.*tmask(ji,jj,iid+1) - ts n(ji,jj,iid,jp_tem) ) &290 & / ( ts n(ji,jj,iid+1,jp_tem) - tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) )288 zztmp = gdept(ji,jj,iid ,Kmm) & ! linear interpolation 289 & + ( gdept(ji,jj,iid+1,Kmm) - gdept(ji,jj,iid,Kmm) ) & 290 & * ( 28.*tmask(ji,jj,iid+1) - ts(ji,jj,iid,jp_tem,Kmm) ) & 291 & / ( ts(ji,jj,iid+1,jp_tem,Kmm) - ts(ji,jj,iid,jp_tem,Kmm) + (1.-tmask(ji,jj,1)) ) 291 292 hd28(ji,jj) = MIN( zztmp , zzdep ) * tmask(ji,jj,1) ! bound by the ocean depth 292 293 ELSE … … 311 312 END DO 312 313 ! surface boundary condition 313 IF( ln_linssh ) THEN ; zthick(:,:) = ssh n(:,:) ; htc3(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) * tmask(:,:,1)314 IF( ln_linssh ) THEN ; zthick(:,:) = ssh(:,:,Kmm) ; htc3(:,:) = ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm) * tmask(:,:,1) 314 315 ELSE ; zthick(:,:) = 0._wp ; htc3(:,:) = 0._wp 315 316 ENDIF 316 317 ! integration down to ilevel 317 318 DO jk = 1, ilevel 318 zthick(:,:) = zthick(:,:) + e3t _n(:,:,jk)319 htc3 (:,:) = htc3 (:,:) + e3t _n(:,:,jk) * tsn(:,:,jk,jp_tem) * tmask(:,:,jk)319 zthick(:,:) = zthick(:,:) + e3t(:,:,jk,Kmm) 320 htc3 (:,:) = htc3 (:,:) + e3t(:,:,jk,Kmm) * ts(:,:,jk,jp_tem,Kmm) * tmask(:,:,jk) 320 321 END DO 321 322 ! deepest layer … … 323 324 DO jj = 1, jpj 324 325 DO ji = 1, jpi 325 htc3(ji,jj) = htc3(ji,jj) + ts n(ji,jj,ilevel+1,jp_tem) &326 & * MIN( e3t _n(ji,jj,ilevel+1), zthick(ji,jj) ) * tmask(ji,jj,ilevel+1)326 htc3(ji,jj) = htc3(ji,jj) + ts(ji,jj,ilevel+1,jp_tem,Kmm) & 327 & * MIN( e3t(ji,jj,ilevel+1,Kmm), zthick(ji,jj) ) * tmask(ji,jj,ilevel+1) 327 328 END DO 328 329 END DO … … 342 343 LOGICAL , PUBLIC, PARAMETER :: lk_diahth = .FALSE. !: thermocline-20d depths flag 343 344 CONTAINS 344 SUBROUTINE dia_hth( kt ) ! Empty routine345 SUBROUTINE dia_hth( kt, Kmm ) ! Empty routine 345 346 IMPLICIT NONE 346 347 INTEGER, INTENT( in ) :: kt 348 INTEGER, INTENT( in ) :: Kmm 347 349 WRITE(*,*) 'dia_hth: You should not have seen this print! error?', kt 348 350 END SUBROUTINE dia_hth
Note: See TracChangeset
for help on using the changeset viewer.
