- Timestamp:
- 2017-09-27T16:29:24+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90
r8215 r8568 28 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 29 29 USE prtctl ! Print control 30 USE wrk_nemo ! Memory Allocation31 30 USE timing ! Timing 32 31 … … 45 44 # include "vectopt_loop_substitute.h90" 46 45 !!---------------------------------------------------------------------- 47 !! NEMO/OPA 3.3 , NEMO Consortium (2011)46 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 48 47 !! $Id$ 49 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 108 107 ! 109 108 INTEGER :: ji, jj, jk ! dummy loop indices 110 REAL(wp) :: zabe1, zabe2, zcof1, zcof2 ! local scalars 111 REAL(wp) :: zmskt, zmskf ! - - 112 REAL(wp) :: zcoef0, zcoef3, zcoef4, zmkt, zmkf ! - - 113 REAL(wp) :: zuav, zvav, zuwslpi, zuwslpj, zvwslpi, zvwslpj ! - - 114 ! 115 REAL(wp), POINTER, DIMENSION(:,:) :: ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v 109 REAL(wp) :: zabe1, zmskt, zmkt, zuav, zuwslpi, zuwslpj ! local scalars 110 REAL(wp) :: zabe2, zmskf, zmkf, zvav, zvwslpi, zvwslpj ! - - 111 REAL(wp) :: zcof0, zcof1, zcof2, zcof3, zcof4 ! - - 112 REAL(wp), DIMENSION(jpi,jpj) :: ziut, zivf, zdku, zdk1u ! 2D workspace 113 REAL(wp), DIMENSION(jpi,jpj) :: zjuf, zjvt, zdkv, zdk1v ! - - 116 114 !!---------------------------------------------------------------------- 117 115 ! 118 IF( nn_timing == 1 ) CALL timing_start('dyn_ldf_iso') 119 ! 120 CALL wrk_alloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v ) 116 IF( ln_timing ) CALL timing_start('dyn_ldf_iso') 121 117 ! 122 118 IF( kt == nit000 ) THEN … … 343 339 DO jk = 2, jpkm1 344 340 DO ji = 2, jpim1 345 zco ef0= 0.5* rn_aht_0 * umask(ji,jj,jk)341 zcof0 = 0.5_wp * rn_aht_0 * umask(ji,jj,jk) 346 342 ! 347 zuwslpi = zco ef0 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) )348 zuwslpj = zco ef0 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) )343 zuwslpi = zcof0 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) ) 344 zuwslpj = zcof0 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) ) 349 345 ! 350 zmkt = 1./MAX( tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1) &351 + tmask(ji,jj,jk )+tmask(ji+1,jj,jk ) , 1. )352 zmkf = 1./MAX( fmask(ji,jj-1,jk-1) + fmask(ji,jj,jk-1) &353 + fmask(ji,jj-1,jk ) + fmask(ji,jj,jk ) , 1. )354 355 zco ef3 = - e2u(ji,jj) * zmkt * zuwslpi356 zco ef4 = - e1u(ji,jj) * zmkf * zuwslpj346 zmkt = 1./MAX( tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1) & 347 + tmask(ji,jj,jk )+tmask(ji+1,jj,jk ) , 1. ) 348 zmkf = 1./MAX( fmask(ji,jj-1,jk-1) + fmask(ji,jj,jk-1) & 349 + fmask(ji,jj-1,jk ) + fmask(ji,jj,jk ) , 1. ) 350 351 zcof3 = - e2u(ji,jj) * zmkt * zuwslpi 352 zcof4 = - e1u(ji,jj) * zmkf * zuwslpj 357 353 ! vertical flux on u field 358 zfuw(ji,jk) = zco ef3 * ( zdiu (ji,jk-1) + zdiu (ji+1,jk-1)&359 +zdiu (ji,jk ) + zdiu (ji+1,jk )) &360 + zcoef4 * ( zdj1u(ji,jk-1) + zdju (ji ,jk-1)&361 +zdj1u(ji,jk ) + zdju (ji ,jk ))354 zfuw(ji,jk) = zcof3 * ( zdiu (ji,jk-1) + zdiu (ji+1,jk-1) & 355 & + zdiu (ji,jk ) + zdiu (ji+1,jk ) ) & 356 & + zcof4 * ( zdj1u(ji,jk-1) + zdju (ji ,jk-1) & 357 & + zdj1u(ji,jk ) + zdju (ji ,jk ) ) 362 358 ! vertical mixing coefficient (akzu) 363 ! Note: zco ef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0359 ! Note: zcof0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0 364 360 akzu(ji,jj,jk) = ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) / rn_aht_0 365 361 END DO … … 369 365 DO jk = 2, jpkm1 370 366 DO ji = 2, jpim1 371 zco ef0 = 0.5* rn_aht_0 * vmask(ji,jj,jk)372 373 zvwslpi = zco ef0 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) )374 zvwslpj = zco ef0 * ( wslpj(ji,jj+1,jk) + wslpj(ji,jj,jk) )375 376 zmkf = 1./MAX( fmask(ji-1,jj,jk-1)+fmask(ji,jj,jk-1) &377 + fmask(ji-1,jj,jk )+fmask(ji,jj,jk ), 1. )378 zmkt = 1./MAX( tmask(ji,jj,jk-1)+tmask(ji,jj+1,jk-1) &379 + tmask(ji,jj,jk )+tmask(ji,jj+1,jk ), 1. )380 381 zco ef3 = - e2v(ji,jj) * zmkf * zvwslpi382 zco ef4 = - e1v(ji,jj) * zmkt * zvwslpj367 zcof0 = 0.5_wp * rn_aht_0 * vmask(ji,jj,jk) 368 ! 369 zvwslpi = zcof0 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) ) 370 zvwslpj = zcof0 * ( wslpj(ji,jj+1,jk) + wslpj(ji,jj,jk) ) 371 ! 372 zmkf = 1./MAX( fmask(ji-1,jj,jk-1)+fmask(ji,jj,jk-1) & 373 & + fmask(ji-1,jj,jk )+fmask(ji,jj,jk ) , 1. ) 374 zmkt = 1./MAX( tmask(ji,jj,jk-1)+tmask(ji,jj+1,jk-1) & 375 & + tmask(ji,jj,jk )+tmask(ji,jj+1,jk ) , 1. ) 376 377 zcof3 = - e2v(ji,jj) * zmkf * zvwslpi 378 zcof4 = - e1v(ji,jj) * zmkt * zvwslpj 383 379 ! vertical flux on v field 384 zfvw(ji,jk) = zco ef3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1)&385 & +zdiv (ji,jk ) + zdiv (ji-1,jk )) &386 & + zco ef4 * ( zdjv (ji,jk-1) + zdj1v(ji ,jk-1)&387 & +zdjv (ji,jk ) + zdj1v(ji ,jk ))380 zfvw(ji,jk) = zcof3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1) & 381 & + zdiv (ji,jk ) + zdiv (ji-1,jk ) ) & 382 & + zcof4 * ( zdjv (ji,jk-1) + zdj1v(ji ,jk-1) & 383 & + zdjv (ji,jk ) + zdj1v(ji ,jk ) ) 388 384 ! vertical mixing coefficient (akzv) 389 ! Note: zco ef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0385 ! Note: zcof0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0 390 386 akzv(ji,jj,jk) = ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) / rn_aht_0 391 387 END DO … … 404 400 END DO ! End of slab 405 401 ! ! =============== 406 CALL wrk_dealloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v )407 402 ! 408 IF( nn_timing == 1 )CALL timing_stop('dyn_ldf_iso')403 IF( ln_timing ) CALL timing_stop('dyn_ldf_iso') 409 404 ! 410 405 END SUBROUTINE dyn_ldf_iso
Note: See TracChangeset
for help on using the changeset viewer.
