- Timestamp:
- 2015-10-31T08:40:45+01:00 (8 years ago)
- Location:
- branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM
- Files:
-
- 2 deleted
- 171 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/SHARED/namelist_ref
r5836 r5845 1268 1268 cn_dir_cdg = './' ! root directory for the location of drag coefficient files 1269 1269 / 1270 !-----------------------------------------------------------------------1271 &namdyn_nept ! Neptune effect (simplified: lateral and vertical diffusions removed)1272 !-----------------------------------------------------------------------1273 ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model1274 ln_neptsimp = .false. ! yes/no use simplified neptune1275 1276 ln_smooth_neptvel = .false. ! yes/no smooth zunep, zvnep1277 rn_tslse = 1.2e4 ! value of lengthscale L at the equator1278 rn_tslsp = 3.0e3 ! value of lengthscale L at the pole1279 ! Specify whether to ramp down the Neptune velocity in shallow1280 ! water, and if so the depth range controlling such ramping down1281 ln_neptramp = .true. ! ramp down Neptune velocity in shallow water1282 rn_htrmin = 100.0 ! min. depth of transition range1283 rn_htrmax = 200.0 ! max. depth of transition range1284 / -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r5836 r5845 58 58 !! * Substitutions 59 59 # include "vectopt_loop_substitute.h90" 60 # include "domzgr_substitute.h90"61 60 !!---------------------------------------------------------------------- 62 61 !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011) … … 471 470 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 472 471 do jk = 1,jpkm1 ! adjust initial vertical scale factors 473 fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )474 fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )472 e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 473 e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 475 474 end do 476 fse3t_a(:,:,:) = fse3t_b(:,:,:)475 e3t_a(:,:,:) = e3t_b(:,:,:) 477 476 ! Reconstruction of all vertical scale factors at now and before time steps 478 477 ! ============================================================================= 479 478 ! Horizontal scale factor interpolations 480 479 ! -------------------------------------- 481 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' )482 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' )483 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' )484 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' )485 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' )480 CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 481 CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 482 CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 483 CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 484 CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' ) 486 485 ! Vertical scale factor interpolations 487 486 ! ------------------------------------ 488 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W' )489 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' )490 CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' )491 CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' )492 CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' )487 CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W' ) 488 CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 489 CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 490 CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 491 CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 493 492 ! t- and w- points depth 494 493 ! ---------------------- 495 fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1)496 fsdepw_n(:,:,1) = 0.0_wp497 fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:)494 gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 495 gdepw_n(:,:,1) = 0.0_wp 496 gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 498 497 DO jk = 2, jpk 499 fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk)500 fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1)501 fsde3w_n(:,:,jk) = fsdept_n(:,:,jk ) - sshn (:,:)498 gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk) 499 gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1) 500 gde3w_n(:,:,jk) = gdept_n(:,:,jk ) - sshn (:,:) 502 501 END DO 503 502 ENDIF -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
r5836 r5845 47 47 48 48 !! * Substitutions 49 # include "domzgr_substitute.h90"50 49 # include "vectopt_loop_substitute.h90" 51 50 !!-------- ------------------------------------------------------------- … … 233 232 234 233 ! energy needed to bring ocean surface layer until its freezing 235 qcmif (ji,jj) = rau0 * rcp * fse3t_m(ji,jj) * ( tfu(ji,jj) - sst_m(ji,jj) - rt0 ) * ( 1 - zinda )234 qcmif (ji,jj) = rau0 * rcp * e3t_m(ji,jj) * ( tfu(ji,jj) - sst_m(ji,jj) - rt0 ) * ( 1 - zinda ) 236 235 237 236 ! calculate oceanic heat flux. -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r5407 r5845 57 57 !! * Substitutions 58 58 # include "vectopt_loop_substitute.h90" 59 # include "domzgr_substitute.h90"60 59 !!---------------------------------------------------------------------- 61 60 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) … … 335 334 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 336 335 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 336 337 337 #if defined key_vvl 338 ! key_vvl necessary? clem: yes for compilation purpose 338 !!gm key_vvl necessary? clem: yes for compilation purpose 339 !!gm I really don't like this staff here... Find a way to put that elsewhere or differently 339 340 DO jk = 1,jpkm1 ! adjust initial vertical scale factors 340 fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )341 fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )342 END DO343 fse3t_a(:,:,:) = fse3t_b(:,:,:)341 e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 342 e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 343 END DO 344 e3t_a(:,:,:) = e3t_b(:,:,:) 344 345 ! Reconstruction of all vertical scale factors at now and before time 345 346 ! steps … … 347 348 ! Horizontal scale factor interpolations 348 349 ! -------------------------------------- 349 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' )350 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' )351 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' )352 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' )353 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' )350 CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 351 CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 352 CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 353 CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 354 CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' ) 354 355 ! Vertical scale factor interpolations 355 356 ! ------------------------------------ 356 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W' )357 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' )358 CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' )359 CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' )360 CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' )357 CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W' ) 358 CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 359 CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 360 CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 361 CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 361 362 ! t- and w- points depth 362 363 ! ---------------------- 363 fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 364 fsdepw_n(:,:,1) = 0.0_wp 365 fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 364 !!gm not sure of that.... 365 gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 366 gdepw_n(:,:,1) = 0.0_wp 367 gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 366 368 DO jk = 2, jpk 367 fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk)368 fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1)369 fsde3w_n(:,:,jk) = fsdept_n(:,:,jk ) - sshn (:,:)369 gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk) 370 gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1) 371 gde3w_n(:,:,jk) = gdept_n(:,:,jk ) - sshn (:,:) 370 372 END DO 371 373 #endif -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r5836 r5845 52 52 53 53 !! * Substitutions 54 # include "domzgr_substitute.h90"55 54 # include "vectopt_loop_substitute.h90" 56 55 !!---------------------------------------------------------------------- … … 147 146 148 147 ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 149 zqfr = tmask(ji,jj,1) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) )148 zqfr = tmask(ji,jj,1) * rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 150 149 151 150 ! --- Energy from the turbulent oceanic heat flux (W/m2) --- ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r5656 r5845 46 46 # endif 47 47 48 # include "domzgr_substitute.h90"49 48 # include "vectopt_loop_substitute.h90" 50 49 !!---------------------------------------------------------------------- … … 76 75 !! *** ROUTINE Agrif_DYN *** 77 76 !!---------------------------------------------------------------------- 78 !!79 77 INTEGER, INTENT(in) :: kt 80 ! !78 ! 81 79 INTEGER :: ji,jj,jk, j1,j2, i1,i2 82 80 REAL(wp) :: timeref … … 137 135 DO jk=1,jpkm1 138 136 DO jj=1,jpj 139 spgu(2,jj)=spgu(2,jj)+ fse3u(2,jj,jk)*ua(2,jj,jk)137 spgu(2,jj)=spgu(2,jj)+e3u_n(2,jj,jk)*ua(2,jj,jk) 140 138 END DO 141 139 END DO … … 143 141 DO jj=1,jpj 144 142 IF (umask(2,jj,1).NE.0.) THEN 145 spgu(2,jj)=spgu(2,jj) /hu(2,jj)143 spgu(2,jj)=spgu(2,jj)*r1_hu_n(2,jj) 146 144 ENDIF 147 145 END DO … … 161 159 DO jk=1,jpkm1 162 160 DO jj=1,jpj 163 spgu1(2,jj)=spgu1(2,jj)+ fse3u(2,jj,jk)*ua(2,jj,jk)161 spgu1(2,jj)=spgu1(2,jj)+e3u_n(2,jj,jk)*ua(2,jj,jk) 164 162 END DO 165 163 END DO … … 167 165 DO jj=1,jpj 168 166 IF (umask(2,jj,1).NE.0.) THEN 169 spgu1(2,jj)=spgu1(2,jj) /hu(2,jj)167 spgu1(2,jj)=spgu1(2,jj)*r1_hu_n(2,jj) 170 168 ENDIF 171 169 END DO … … 182 180 DO jk=1,jpkm1 183 181 DO jj=1,jpj 184 spgv1(2,jj)=spgv1(2,jj)+ fse3v_a(2,jj,jk)*va(2,jj,jk)182 spgv1(2,jj)=spgv1(2,jj)+e3v_a(2,jj,jk)*va(2,jj,jk) 185 183 END DO 186 184 END DO 187 185 DO jj=1,jpj 188 spgv1(2,jj)=spgv1(2,jj)* hvr_a(2,jj)186 spgv1(2,jj)=spgv1(2,jj)*r1_hv_a(2,jj) 189 187 END DO 190 188 DO jk=1,jpkm1 … … 207 205 DO jk=1,jpkm1 208 206 DO jj=1,jpj 209 spgu(nlci-2,jj)=spgu(nlci-2,jj)+ fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)207 spgu(nlci-2,jj)=spgu(nlci-2,jj)+e3u_n(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 210 208 ENDDO 211 209 ENDDO 212 210 DO jj=1,jpj 213 211 IF (umask(nlci-2,jj,1).NE.0.) THEN 214 spgu(nlci-2,jj)=spgu(nlci-2,jj) /hu(nlci-2,jj)212 spgu(nlci-2,jj)=spgu(nlci-2,jj)*r1_hu_n(nlci-2,jj) 215 213 ENDIF 216 214 END DO … … 229 227 DO jk=1,jpkm1 230 228 DO jj=1,jpj 231 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+ fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk)229 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+e3u_n(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk) 232 230 END DO 233 231 END DO 234 232 DO jj=1,jpj 235 233 IF (umask(nlci-2,jj,1).NE.0.) THEN 236 spgu1(nlci-2,jj)=spgu1(nlci-2,jj) /hu(nlci-2,jj)234 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)*r1_hu_n(nlci-2,jj) 237 235 ENDIF 238 236 END DO … … 248 246 DO jk=1,jpkm1 249 247 DO jj=1,jpj 250 spgv1(nlci-1,jj)=spgv1(nlci-1,jj)+ fse3v_a(nlci-1,jj,jk)*va(nlci-1,jj,jk)*vmask(nlci-1,jj,jk)248 spgv1(nlci-1,jj)=spgv1(nlci-1,jj)+e3v_a(nlci-1,jj,jk)*va(nlci-1,jj,jk)*vmask(nlci-1,jj,jk) 251 249 END DO 252 250 END DO 253 251 254 252 DO jj=1,jpj 255 spgv1(nlci-1,jj)=spgv1(nlci-1,jj)* hvr_a(nlci-1,jj)253 spgv1(nlci-1,jj)=spgv1(nlci-1,jj)*r1_hv_a(nlci-1,jj) 256 254 END DO 257 255 … … 278 276 DO jk=1,jpkm1 279 277 DO ji=1,jpi 280 spgv(ji,2)=spgv(ji,2)+ fse3v(ji,2,jk)*va(ji,2,jk)278 spgv(ji,2)=spgv(ji,2)+e3v_n(ji,2,jk)*va(ji,2,jk) 281 279 END DO 282 280 END DO … … 284 282 DO ji=1,jpi 285 283 IF (vmask(ji,2,1).NE.0.) THEN 286 spgv(ji,2)=spgv(ji,2) /hv(ji,2)284 spgv(ji,2)=spgv(ji,2)* r1_hv_n(ji,2) 287 285 ENDIF 288 286 END DO … … 302 300 DO jk=1,jpkm1 303 301 DO ji=1,jpi 304 spgv1(ji,2)=spgv1(ji,2)+ fse3v(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk)302 spgv1(ji,2)=spgv1(ji,2)+e3v_n(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk) 305 303 END DO 306 304 END DO … … 308 306 DO ji=1,jpi 309 307 IF (vmask(ji,2,1).NE.0.) THEN 310 spgv1(ji,2)=spgv1(ji,2) /hv(ji,2)308 spgv1(ji,2)=spgv1(ji,2)*r1_hv_n(ji,2) 311 309 ENDIF 312 310 END DO … … 323 321 DO jk=1,jpkm1 324 322 DO ji=1,jpi 325 spgu1(ji,2)=spgu1(ji,2)+ fse3u_a(ji,2,jk)*ua(ji,2,jk)*umask(ji,2,jk)323 spgu1(ji,2)=spgu1(ji,2)+e3u_a(ji,2,jk)*ua(ji,2,jk)*umask(ji,2,jk) 326 324 END DO 327 325 END DO 328 326 329 327 DO ji=1,jpi 330 spgu1(ji,2)=spgu1(ji,2)* hur_a(ji,2)328 spgu1(ji,2)=spgu1(ji,2)*r1_hu_a(ji,2) 331 329 END DO 332 330 … … 353 351 DO jk=1,jpkm1 354 352 DO ji=1,jpi 355 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+ fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)353 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+e3v_n(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 356 354 END DO 357 355 END DO … … 359 357 DO ji=1,jpi 360 358 IF (vmask(ji,nlcj-2,1).NE.0.) THEN 361 spgv(ji,nlcj-2)=spgv(ji,nlcj-2) /hv(ji,nlcj-2)359 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)*r1_hv_n(ji,nlcj-2) 362 360 ENDIF 363 361 END DO … … 378 376 DO jk=1,jpkm1 379 377 DO ji=1,jpi 380 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+ fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)378 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+e3v_n(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 381 379 END DO 382 380 END DO … … 384 382 DO ji=1,jpi 385 383 IF (vmask(ji,nlcj-2,1).NE.0.) THEN 386 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2) /hv(ji,nlcj-2)384 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)*r1_hv_n(ji,nlcj-2) 387 385 ENDIF 388 386 END DO … … 399 397 DO jk=1,jpkm1 400 398 DO ji=1,jpi 401 spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)+ fse3u_a(ji,nlcj-1,jk)*ua(ji,nlcj-1,jk)399 spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)+e3u_a(ji,nlcj-1,jk)*ua(ji,nlcj-1,jk) 402 400 END DO 403 401 END DO 404 402 405 403 DO ji=1,jpi 406 spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)* hur_a(ji,nlcj-1)404 spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)*r1_hu_a(ji,nlcj-1) 407 405 END DO 408 406 … … 812 810 DO ji=i1,i2 813 811 ptab(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 814 ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3u(ji,jj,jk)812 ptab(ji,jj,jk) = ptab(ji,jj,jk) * e3u_n(ji,jj,jk) 815 813 END DO 816 814 END DO … … 821 819 DO jj=j1,j2 822 820 ua(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhoy*e2u(i1:i2,jj))) 823 ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / fse3u(i1:i2,jj,jk)821 ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / e3u_n(i1:i2,jj,jk) 824 822 END DO 825 823 END DO … … 880 878 DO ji=i1,i2 881 879 ptab(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 882 ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3v(ji,jj,jk)880 ptab(ji,jj,jk) = ptab(ji,jj,jk) * e3v_n(ji,jj,jk) 883 881 END DO 884 882 END DO … … 889 887 DO jj=j1,j2 890 888 va(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhox*e1v(i1:i2,jj))) 891 va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / fse3v(i1:i2,jj,jk)889 va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / e3v_n(i1:i2,jj,jk) 892 890 END DO 893 891 END DO … … 944 942 DO jj=j1,j2 945 943 DO ji=i1,i2 946 ptab(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu (ji,jj)944 ptab(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu_n(ji,jj) 947 945 END DO 948 946 END DO … … 1021 1019 DO jj=j1,j2 1022 1020 DO ji=i1,i2 1023 ptab(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv (ji,jj)1021 ptab(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv_n(ji,jj) 1024 1022 END DO 1025 1023 END DO … … 1209 1207 WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk 1210 1208 ENDIF 1211 WRITE(numout,*) ' ptab(ji,jj,jk), fse3t(ji,jj,jk) ', ptab(ji,jj,jk), e3t_0(ji,jj,jk)1209 WRITE(numout,*) ' ptab(ji,jj,jk), e3t(ji,jj,jk) ', ptab(ji,jj,jk), e3t_0(ji,jj,jk) 1212 1210 kindic_agr = kindic_agr + 1 1213 1211 ENDIF … … 1219 1217 ! 1220 1218 END SUBROUTINE interpe3t 1219 1221 1220 1222 1221 SUBROUTINE interpumsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
r5836 r5845 17 17 PUBLIC interptsn_sponge, interpun_sponge, interpvn_sponge 18 18 19 !! * Substitutions20 # include "domzgr_substitute.h90"21 19 !!---------------------------------------------------------------------- 22 20 !! NEMO/NST 3.3 , NEMO Consortium (2010) … … 210 208 DO jj = j1,j2-1 211 209 DO ji = i1,i2-1 212 zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk)213 zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk)210 zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) 211 zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) 214 212 ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 215 213 ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) … … 239 237 240 238 IF (.NOT. tabspongedone_tsn(ji,jj)) THEN 241 zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk)239 zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 242 240 ! horizontal diffusive trends 243 241 ztsa = zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji ,jj-1,jk) ) … … 290 288 DO jj = j1,j2 291 289 DO ji = i1+1,i2 ! vector opt. 292 zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj)293 hdivdiff(ji,jj,jk) = ( e2u(ji ,jj)* fse3u_n(ji ,jj,jk) * ubdiff(ji ,jj,jk) &294 & -e2u(ji-1,jj)* fse3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr290 zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 291 hdivdiff(ji,jj,jk) = ( e2u(ji ,jj)*e3u_n(ji ,jj,jk) * ubdiff(ji ,jj,jk) & 292 & -e2u(ji-1,jj)*e3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr 295 293 END DO 296 294 END DO … … 298 296 DO jj = j1,j2-1 299 297 DO ji = i1,i2 ! vector opt. 300 zbtr = r1_e1e2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj)298 zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 301 299 rotdiff(ji,jj,jk) = (-e1u(ji,jj+1) * ubdiff(ji,jj+1,jk) & 302 300 +e1u(ji,jj ) * ubdiff(ji,jj ,jk) & … … 318 316 ze1v = hdivdiff(ji,jj,jk) 319 317 ! horizontal diffusive trends 320 zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) ) &318 zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) & 321 319 + ( hdivdiff(ji+1,jj,jk) - ze1v ) / e1u(ji,jj) 322 320 … … 344 342 345 343 ! horizontal diffusive trends 346 zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) ) &344 zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) & 347 345 + ( hdivdiff(ji,jj+1,jk) - ze1v ) / e2v(ji,jj) 348 346 … … 396 394 DO jj = j1+1,j2 397 395 DO ji = i1,i2 ! vector opt. 398 zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj)399 hdivdiff(ji,jj,jk) = ( e1v(ji,jj ) * fse3v(ji,jj ,jk) * vbdiff(ji,jj ,jk) &400 & -e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vbdiff(ji,jj-1,jk) ) * zbtr396 zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 397 hdivdiff(ji,jj,jk) = ( e1v(ji,jj ) * e3v_n(ji,jj ,jk) * vbdiff(ji,jj ,jk) & 398 & -e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vbdiff(ji,jj-1,jk) ) * zbtr 401 399 END DO 402 400 END DO 403 401 DO jj = j1,j2 404 402 DO ji = i1,i2-1 ! vector opt. 405 zbtr = r1_e1e2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj)403 zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 406 404 rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) & 407 405 & -e2v(ji ,jj) * vbdiff(ji ,jj,jk) & … … 424 422 ze1v = hdivdiff(ji,jj,jk) 425 423 ! horizontal diffusive trends 426 zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) ) + ( hdivdiff(ji+1,jj,jk) - ze1v) &424 zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) + ( hdivdiff(ji+1,jj,jk) - ze1v) & 427 425 / e1u(ji,jj) 428 426 … … 446 444 ! horizontal diffusive trends 447 445 448 zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) ) + ( hdivdiff(ji,jj+1,jk) - ze1v) &446 zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) + ( hdivdiff(ji,jj+1,jk) - ze1v) & 449 447 / e2v(ji,jj) 450 448 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r5656 r5845 26 26 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 27 27 !!---------------------------------------------------------------------- 28 29 28 CONTAINS 30 29 … … 67 66 ! 68 67 END SUBROUTINE Agrif_Update_Tra 68 69 69 70 70 RECURSIVE SUBROUTINE Agrif_Update_Dyn( ) … … 153 153 154 154 # if defined key_zdftke 155 155 156 SUBROUTINE Agrif_Update_Tke( kt ) 156 157 !!--------------------------------------------- … … 175 176 176 177 END SUBROUTINE Agrif_Update_Tke 178 177 179 # endif /* key_zdftke */ 178 180 … … 181 183 !! *** ROUTINE updateT *** 182 184 !!--------------------------------------------- 183 # include "domzgr_substitute.h90"184 185 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 185 186 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres … … 231 232 END SUBROUTINE updateTS 232 233 234 233 235 SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, before ) 234 236 !!--------------------------------------------- 235 237 !! *** ROUTINE updateu *** 236 238 !!--------------------------------------------- 237 # include "domzgr_substitute.h90"238 !!239 239 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 240 240 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres … … 250 250 DO jj=j1,j2 251 251 DO ji=i1,i2 252 tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 253 tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u_n(ji,jj,jk) 252 tabres(ji,jj,jk) = e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) 254 253 END DO 255 254 END DO … … 260 259 DO jj=j1,j2 261 260 DO ji=i1,i2 262 tabres(ji,jj,jk) = tabres(ji,jj,jk) / e2u(ji,jj) / fse3u_n(ji,jj,jk)261 tabres(ji,jj,jk) = tabres(ji,jj,jk) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) 263 262 ! 264 263 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part … … 275 274 END SUBROUTINE updateu 276 275 276 277 277 SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, before ) 278 278 !!--------------------------------------------- 279 279 !! *** ROUTINE updatev *** 280 280 !!--------------------------------------------- 281 # include "domzgr_substitute.h90"282 !!283 281 INTEGER :: i1,i2,j1,j2,k1,k2 284 282 INTEGER :: ji,jj,jk … … 294 292 DO jj=j1,j2 295 293 DO ji=i1,i2 296 tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 297 tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v_n(ji,jj,jk) 294 tabres(ji,jj,jk) = e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 298 295 END DO 299 296 END DO … … 304 301 DO jj=j1,j2 305 302 DO ji=i1,i2 306 tabres(ji,jj,jk) = tabres(ji,jj,jk) / e1v(ji,jj) / fse3v_n(ji,jj,jk)303 tabres(ji,jj,jk) = tabres(ji,jj,jk) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) 307 304 ! 308 305 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part … … 319 316 END SUBROUTINE updatev 320 317 318 321 319 SUBROUTINE updateu2d( tabres, i1, i2, j1, j2, before ) 322 320 !!--------------------------------------------- 323 321 !! *** ROUTINE updateu2d *** 324 322 !!--------------------------------------------- 325 # include "domzgr_substitute.h90"326 !!327 323 INTEGER, INTENT(in) :: i1, i2, j1, j2 328 324 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres … … 338 334 DO jj=j1,j2 339 335 DO ji=i1,i2 340 tabres(ji,jj) = un_b(ji,jj) * hu (ji,jj) * e2u(ji,jj)336 tabres(ji,jj) = un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj) 341 337 END DO 342 338 END DO … … 345 341 DO jj=j1,j2 346 342 DO ji=i1,i2 347 tabres(ji,jj) = tabres(ji,jj) * hur(ji,jj) /e2u(ji,jj)343 tabres(ji,jj) = tabres(ji,jj) * r1_hu_n(ji,jj) * r1_e2u(ji,jj) 348 344 ! 349 345 ! Update "now" 3d velocities: 350 346 spgu(ji,jj) = 0.e0 351 347 DO jk=1,jpkm1 352 spgu(ji,jj) = spgu(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk)353 END DO 354 spgu(ji,jj) = spgu(ji,jj) * hur(ji,jj)348 spgu(ji,jj) = spgu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) 349 END DO 350 spgu(ji,jj) = spgu(ji,jj) * r1_hu_n(ji,jj) 355 351 ! 356 352 zcorr = tabres(ji,jj) - spgu(ji,jj) … … 371 367 spgu(ji,jj) = 0.e0 372 368 DO jk=1,jpkm1 373 spgu(ji,jj) = spgu(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk)374 END DO 375 spgu(ji,jj) = spgu(ji,jj) * hur_b(ji,jj)369 spgu(ji,jj) = spgu(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) 370 END DO 371 spgu(ji,jj) = spgu(ji,jj) * r1_hu_b(ji,jj) 376 372 ! 377 373 zcorr = ub_b(ji,jj) - spgu(ji,jj) … … 385 381 ! 386 382 END SUBROUTINE updateu2d 383 387 384 388 385 SUBROUTINE updatev2d( tabres, i1, i2, j1, j2, before ) … … 403 400 DO jj=j1,j2 404 401 DO ji=i1,i2 405 tabres(ji,jj) = vn_b(ji,jj) * hv (ji,jj) * e1v(ji,jj)402 tabres(ji,jj) = vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj) 406 403 END DO 407 404 END DO … … 410 407 DO jj=j1,j2 411 408 DO ji=i1,i2 412 tabres(ji,jj) = tabres(ji,jj) * hvr(ji,jj) /e1v(ji,jj)409 tabres(ji,jj) = tabres(ji,jj) * r1_hv_n(ji,jj) * r1_e1v(ji,jj) 413 410 ! 414 411 ! Update "now" 3d velocities: 415 412 spgv(ji,jj) = 0.e0 416 413 DO jk=1,jpkm1 417 spgv(ji,jj) = spgv(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk)418 END DO 419 spgv(ji,jj) = spgv(ji,jj) * hvr(ji,jj)414 spgv(ji,jj) = spgv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) 415 END DO 416 spgv(ji,jj) = spgv(ji,jj) * r1_hv_n(ji,jj) 420 417 ! 421 418 zcorr = tabres(ji,jj) - spgv(ji,jj) … … 436 433 spgv(ji,jj) = 0.e0 437 434 DO jk=1,jpkm1 438 spgv(ji,jj) = spgv(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk)439 END DO 440 spgv(ji,jj) = spgv(ji,jj) * hvr_b(ji,jj)435 spgv(ji,jj) = spgv(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) 436 END DO 437 spgv(ji,jj) = spgv(ji,jj) * r1_hv_b(ji,jj) 441 438 ! 442 439 zcorr = vb_b(ji,jj) - spgv(ji,jj) … … 489 486 END SUBROUTINE updateSSH 490 487 488 491 489 SUBROUTINE updateub2b( tabres, i1, i2, j1, j2, before ) 492 490 !!--------------------------------------------- … … 519 517 END SUBROUTINE updateub2b 520 518 519 521 520 SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before ) 522 521 !!--------------------------------------------- … … 555 554 !! *** ROUTINE updateT *** 556 555 !!--------------------------------------------- 557 # include "domzgr_substitute.h90"558 559 556 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 560 557 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 561 558 LOGICAL, iNTENT(in) :: before 562 559 ! 563 560 INTEGER :: ji,jj,jk 564 561 REAL(wp) :: ztemp 562 !!--------------------------------------------- 565 563 566 564 IF (before) THEN … … 600 598 601 599 # if defined key_zdftke 600 602 601 SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before ) 603 602 !!--------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
r5656 r5845 17 17 PUBLIC Agrif_trc, interptrn 18 18 19 # include "domzgr_substitute.h90"20 19 # include "vectopt_loop_substitute.h90" 21 20 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
r5836 r5845 19 19 PUBLIC Agrif_Sponge_trc, interptrn_sponge 20 20 21 !! * Substitutions22 # include "domzgr_substitute.h90"23 21 !!---------------------------------------------------------------------- 24 22 !! NEMO/NST 3.6 , NEMO Consortium (2010) … … 74 72 DO jj = j1,j2-1 75 73 DO ji = i1,i2-1 76 zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk)77 zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk)74 zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) 75 zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) 78 76 ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 79 77 ztv(ji,jj) = zabe2 * ( trbdiff(ji ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) … … 85 83 86 84 IF (.NOT. tabspongedone_trn(ji,jj)) THEN 87 zbtr = r1_e1e2t(ji,jj) / fse3t(ji,jj,jk)85 zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk) 88 86 ! horizontal diffusive trends 89 87 ztra = zbtr * ( ztu(ji,jj) - ztu(ji-1,jj ) + ztv(ji,jj) - ztv(ji ,jj-1) ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
r5656 r5845 64 64 !! *** ROUTINE updateT *** 65 65 !!--------------------------------------------- 66 # include "domzgr_substitute.h90"67 66 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 68 67 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OFF_SRC/domrea.F90
r5836 r5845 34 34 35 35 !! * Substitutions 36 # include "domzgr_substitute.h90"37 36 # include "vectopt_loop_substitute.h90" 38 37 !!---------------------------------------------------------------------- … … 76 75 r1_e1f(:,:) = 1._wp / e1f(:,:) ; r1_e2f (:,:) = 1._wp / e2f(:,:) 77 76 ! 77 !!gm BUG if scale factor reduction !!!! 78 78 e1e2t (:,:) = e1t(:,:) * e2t(:,:) ; r1_e1e2t(:,:) = 1._wp / e1e2t(:,:) 79 79 e1e2u (:,:) = e1u(:,:) * e2u(:,:) ; r1_e1e2u(:,:) = 1._wp / e1e2u(:,:) … … 84 84 e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 85 85 ! 86 hu (:,:) = 0._wp! Ocean depth at U- and V-points87 hv (:,:) = 0._wp88 DO jk = 1, jpk89 hu (:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)90 hv (:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)86 hu_n(:,:) = e3u_n(:,:,1) * umask(:,:,1) ! Ocean depth at U- and V-points 87 hv_n(:,:) = e3v_n(:,:,1) * vmask(:,:,1) 88 DO jk = 2, jpk 89 hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk) 90 hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk) 91 91 END DO 92 92 ! ! Inverse of the local depth 93 hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1)94 hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1)93 r1_hu_n(:,:) = 1._wp / ( hu_n(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1) 94 r1_hv_n(:,:) = 1._wp / ( hv_n(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1) 95 95 ! 96 96 CALL dom_stp ! Time step … … 554 554 CALL iom_get( inum4, jpdom_unknown, 'esigw', esigw ) 555 555 556 CALL iom_get( inum4, jpdom_data, 'e3t_0', fse3t_n(:,:,:) ) ! scale factors557 CALL iom_get( inum4, jpdom_data, 'e3u_0', fse3u_n(:,:,:) )558 CALL iom_get( inum4, jpdom_data, 'e3v_0', fse3v_n(:,:,:) )559 CALL iom_get( inum4, jpdom_data, 'e3w_0', fse3w_n(:,:,:) )556 CALL iom_get( inum4, jpdom_data, 'e3t_0', e3t_n(:,:,:) ) ! scale factors 557 CALL iom_get( inum4, jpdom_data, 'e3u_0', e3u_n(:,:,:) ) 558 CALL iom_get( inum4, jpdom_data, 'e3v_0', e3v_n(:,:,:) ) 559 CALL iom_get( inum4, jpdom_data, 'e3w_0', e3w_n(:,:,:) ) 560 560 561 561 CALL iom_get( inum4, jpdom_unknown, 'gdept_1d', gdept_1d ) ! depth … … 571 571 ! 572 572 IF( nmsh <= 6 ) THEN ! 3D vertical scale factors 573 CALL iom_get( inum4, jpdom_data, 'e3t_0', fse3t_n(:,:,:) )574 CALL iom_get( inum4, jpdom_data, 'e3u_0', fse3u_n(:,:,:) )575 CALL iom_get( inum4, jpdom_data, 'e3v_0', fse3v_n(:,:,:) )576 CALL iom_get( inum4, jpdom_data, 'e3w_0', fse3w_n(:,:,:) )573 CALL iom_get( inum4, jpdom_data, 'e3t_0', e3t_n(:,:,:) ) 574 CALL iom_get( inum4, jpdom_data, 'e3u_0', e3u_n(:,:,:) ) 575 CALL iom_get( inum4, jpdom_data, 'e3v_0', e3v_n(:,:,:) ) 576 CALL iom_get( inum4, jpdom_data, 'e3w_0', e3w_n(:,:,:) ) 577 577 ELSE ! 2D bottom scale factors 578 578 CALL iom_get( inum4, jpdom_data, 'e3t_ps', e3tp ) … … 580 580 ! ! deduces the 3D scale factors 581 581 DO jk = 1, jpk 582 fse3t_n(:,:,jk) = e3t_1d(jk) ! set to the ref. factors583 fse3u_n(:,:,jk) = e3t_1d(jk)584 fse3v_n(:,:,jk) = e3t_1d(jk)585 fse3w_n(:,:,jk) = e3w_1d(jk)582 e3t_n(:,:,jk) = e3t_1d(jk) ! set to the ref. factors 583 e3u_n(:,:,jk) = e3t_1d(jk) 584 e3v_n(:,:,jk) = e3t_1d(jk) 585 e3w_n(:,:,jk) = e3w_1d(jk) 586 586 END DO 587 587 DO jj = 1,jpj ! adjust the deepest values 588 588 DO ji = 1,jpi 589 589 ik = mbkt(ji,jj) 590 fse3t_n(ji,jj,ik) = e3tp(ji,jj) * tmask(ji,jj,1) + e3t_1d(1) * ( 1._wp - tmask(ji,jj,1) )591 fse3w_n(ji,jj,ik) = e3wp(ji,jj) * tmask(ji,jj,1) + e3w_1d(1) * ( 1._wp - tmask(ji,jj,1) )590 e3t_n(ji,jj,ik) = e3tp(ji,jj) * tmask(ji,jj,1) + e3t_1d(1) * ( 1._wp - tmask(ji,jj,1) ) 591 e3w_n(ji,jj,ik) = e3wp(ji,jj) * tmask(ji,jj,1) + e3w_1d(1) * ( 1._wp - tmask(ji,jj,1) ) 592 592 END DO 593 593 END DO … … 595 595 DO jj = 1, jpjm1 596 596 DO ji = 1, jpim1 597 fse3u_n(ji,jj,jk) = MIN( fse3t_n(ji,jj,jk), fse3t_n(ji+1,jj,jk) )598 fse3v_n(ji,jj,jk) = MIN( fse3t_n(ji,jj,jk), fse3t_n(ji,jj+1,jk) )597 e3u_n(ji,jj,jk) = MIN( e3t_n(ji,jj,jk), e3t_n(ji+1,jj,jk) ) 598 e3v_n(ji,jj,jk) = MIN( e3t_n(ji,jj,jk), e3t_n(ji,jj+1,jk) ) 599 599 END DO 600 600 END DO 601 601 END DO 602 CALL lbc_lnk( fse3u_n(:,:,:) , 'U', 1._wp ) ; CALL lbc_lnk( fse3uw_n(:,:,:), 'U', 1._wp ) ! lateral boundary conditions603 CALL lbc_lnk( fse3v_n(:,:,:) , 'V', 1._wp ) ; CALL lbc_lnk( fse3vw_n(:,:,:), 'V', 1._wp )602 CALL lbc_lnk( e3u_n(:,:,:) , 'U', 1._wp ) ; CALL lbc_lnk( e3uw_n(:,:,:), 'U', 1._wp ) ! lateral boundary conditions 603 CALL lbc_lnk( e3v_n(:,:,:) , 'V', 1._wp ) ; CALL lbc_lnk( e3vw_n(:,:,:), 'V', 1._wp ) 604 604 ! 605 605 DO jk = 1, jpk ! set to z-scale factor if zero (i.e. along closed boundaries) 606 WHERE( fse3u_n(:,:,jk) == 0._wp ) fse3u_n(:,:,jk) = e3t_1d(jk)607 WHERE( fse3v_n(:,:,jk) == 0._wp ) fse3v_n(:,:,jk) = e3t_1d(jk)606 WHERE( e3u_n(:,:,jk) == 0._wp ) e3u_n(:,:,jk) = e3t_1d(jk) 607 WHERE( e3v_n(:,:,jk) == 0._wp ) e3v_n(:,:,jk) = e3t_1d(jk) 608 608 END DO 609 609 END IF 610 610 611 611 IF( iom_varid( inum4, 'gdept_0', ldstop = .FALSE. ) > 0 ) THEN ! 3D depth of t- and w-level 612 CALL iom_get( inum4, jpdom_data, 'gdept_0', fsdept_n(:,:,:) )613 CALL iom_get( inum4, jpdom_data, 'gdepw_0', fsdepw_n(:,:,:) )612 CALL iom_get( inum4, jpdom_data, 'gdept_0', gdept_n(:,:,:) ) 613 CALL iom_get( inum4, jpdom_data, 'gdepw_0', gdepw_n(:,:,:) ) 614 614 ELSE ! 2D bottom depth 615 615 CALL iom_get( inum4, jpdom_data, 'hdept', zprt ) … … 617 617 ! 618 618 DO jk = 1, jpk ! deduces the 3D depth 619 fsdept_n(:,:,jk) = gdept_1d(jk)620 fsdepw_n(:,:,jk) = gdepw_1d(jk)619 gdept_n(:,:,jk) = gdept_1d(jk) 620 gdepw_n(:,:,jk) = gdepw_1d(jk) 621 621 END DO 622 622 DO jj = 1, jpj … … 624 624 ik = mbkt(ji,jj) 625 625 IF( ik > 0 ) THEN 626 fsdepw_n(ji,jj,ik+1) = zprw(ji,jj)627 fsdept_n(ji,jj,ik ) = zprt(ji,jj)628 fsdept_n(ji,jj,ik+1) = fsdept_n(ji,jj,ik) + fse3t_n(ji,jj,ik)626 gdepw_n(ji,jj,ik+1) = zprw(ji,jj) 627 gdept_n(ji,jj,ik ) = zprt(ji,jj) 628 gdept_n(ji,jj,ik+1) = gdept_n(ji,jj,ik) + e3t_n(ji,jj,ik) 629 629 ENDIF 630 630 END DO … … 640 640 CALL iom_get( inum4, jpdom_unknown, 'e3w_1d' , e3w_1d ) 641 641 DO jk = 1, jpk 642 fse3t_n(:,:,jk) = e3t_1d(jk) ! set to the ref. factors643 fse3u_n(:,:,jk) = e3t_1d(jk)644 fse3v_n(:,:,jk) = e3t_1d(jk)645 fse3w_n(:,:,jk) = e3w_1d(jk)646 fsdept_n(:,:,jk) = gdept_1d(jk)647 fsdepw_n(:,:,jk) = gdepw_1d(jk)642 e3t_n(:,:,jk) = e3t_1d(jk) ! set to the ref. factors 643 e3u_n(:,:,jk) = e3t_1d(jk) 644 e3v_n(:,:,jk) = e3t_1d(jk) 645 e3w_n(:,:,jk) = e3w_1d(jk) 646 gdept_n(:,:,jk) = gdept_1d(jk) 647 gdepw_n(:,:,jk) = gdepw_1d(jk) 648 648 END DO 649 649 ENDIF -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r5836 r5845 85 85 86 86 !! * Substitutions 87 # include "domzgr_substitute.h90"88 87 # include "vectopt_loop_substitute.h90" 89 88 !!---------------------------------------------------------------------- … … 421 420 END SUBROUTINE dta_dyn_init 422 421 422 423 423 SUBROUTINE dta_dyn_wzv( pu, pv, pw ) 424 424 !!---------------------------------------------------------------------- … … 449 449 DO jj = 2, jpjm1 450 450 DO ji = fs_2, fs_jpim1 ! vector opt. 451 zu = pu(ji ,jj ,jk) * umask(ji ,jj ,jk) * e2u(ji ,jj ) * fse3u(ji ,jj ,jk) 452 zu1 = pu(ji-1,jj ,jk) * umask(ji-1,jj ,jk) * e2u(ji-1,jj ) * fse3u(ji-1,jj ,jk) 453 zv = pv(ji ,jj ,jk) * vmask(ji ,jj ,jk) * e1v(ji ,jj ) * fse3v(ji ,jj ,jk) 454 zv1 = pv(ji ,jj-1,jk) * vmask(ji ,jj-1,jk) * e1v(ji ,jj-1) * fse3v(ji ,jj-1,jk) 455 zet = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 456 zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet 451 zu = pu(ji ,jj ,jk) * umask(ji ,jj ,jk) * e2u(ji ,jj ) * e3u_n(ji ,jj ,jk) 452 zu1 = pu(ji-1,jj ,jk) * umask(ji-1,jj ,jk) * e2u(ji-1,jj ) * e3u_n(ji-1,jj ,jk) 453 zv = pv(ji ,jj ,jk) * vmask(ji ,jj ,jk) * e1v(ji ,jj ) * e3v_n(ji ,jj ,jk) 454 zv1 = pv(ji ,jj-1,jk) * vmask(ji ,jj-1,jk) * e1v(ji ,jj-1) * e3v_n(ji ,jj-1,jk) 455 zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 457 456 END DO 458 457 END DO 459 458 END DO 460 459 ! ! update the horizontal divergence with the runoff inflow 461 IF( ln_dynrnf ) zhdiv(:,:,1) = zhdiv(:,:,1) - rnf(:,:) * r1_rau0 / fse3t(:,:,1)460 IF( ln_dynrnf ) zhdiv(:,:,1) = zhdiv(:,:,1) - rnf(:,:) * r1_rau0 / e3t_n(:,:,1) 462 461 ! 463 462 CALL lbc_lnk( zhdiv, 'T', 1. ) ! Lateral boundary conditions on zhdiv … … 465 464 pw(:,:,jpk) = 0._wp 466 465 DO jk = jpkm1, 1, -1 467 pw(:,:,jk) = pw(:,:,jk+1) - fse3t(:,:,jk) * zhdiv(:,:,jk)466 pw(:,:,jk) = pw(:,:,jk+1) - e3t_n(:,:,jk) * zhdiv(:,:,jk) 468 467 END DO 469 468 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r5836 r5845 87 87 88 88 !! * Substitutions 89 # include "domzgr_substitute.h90"90 89 # include "vectopt_loop_substitute.h90" 91 90 !!---------------------------------------------------------------------- 92 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)91 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 93 92 !! $Id$ 94 93 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 430 429 DO jt = 1, nn_divdmp 431 430 ! 432 DO jk = 1, jpkm1 431 DO jk = 1, jpkm1 ! hdiv = e1e1 * div 433 432 hdiv(:,:) = 0._wp 434 433 DO jj = 2, jpjm1 435 434 DO ji = fs_2, fs_jpim1 ! vector opt. 436 hdiv(ji,jj) = & 437 ( e2u(ji ,jj ) * fse3u(ji ,jj ,jk) * u_bkginc(ji ,jj ,jk) & 438 - e2u(ji-1,jj ) * fse3u(ji-1,jj ,jk) * u_bkginc(ji-1,jj ,jk) & 439 + e1v(ji ,jj ) * fse3v(ji ,jj ,jk) * v_bkginc(ji ,jj ,jk) & 440 - e1v(ji ,jj-1) * fse3v(ji ,jj-1,jk) * v_bkginc(ji ,jj-1,jk) ) & 441 / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 435 hdiv(ji,jj) = ( e2u(ji ,jj) * e3u_n(ji ,jj,jk) * u_bkginc(ji ,jj,jk) & 436 & - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * u_bkginc(ji-1,jj,jk) & 437 & + e1v(ji,jj ) * e3v_n(ji,jj ,jk) * v_bkginc(ji,jj ,jk) & 438 & - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * v_bkginc(ji,jj-1,jk) ) / e3t_n(ji,jj,jk) 442 439 END DO 443 440 END DO … … 446 443 DO jj = 2, jpjm1 447 444 DO ji = fs_2, fs_jpim1 ! vector opt. 448 u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji+1,jj) * hdiv(ji+1,jj) & 449 & - e1e2t(ji ,jj) * hdiv(ji ,jj) ) & 450 & * r1_e1u(ji,jj) * umask(ji,jj,jk) 451 v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji,jj+1) * hdiv(ji,jj+1) & 452 & - e1e2t(ji,jj ) * hdiv(ji,jj ) ) & 453 & * r1_e2v(ji,jj) * vmask(ji,jj,jk) 445 u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) & 446 & + 0.2_wp * ( hdiv(ji+1,jj) - hdiv(ji ,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 447 v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) & 448 & + 0.2_wp * ( hdiv(ji,jj+1) - hdiv(ji,jj ) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 454 449 END DO 455 450 END DO … … 645 640 ! used to prevent the applied increments taking the temperature below the local freezing point 646 641 DO jk = 1, jpkm1 647 CALL eos_fzp( tsn(:,:,jk,jp_sal), fzptnz(:,:,jk), fsdept(:,:,jk) )642 CALL eos_fzp( tsn(:,:,jk,jp_sal), fzptnz(:,:,jk), gdept_n(:,:,jk) ) 648 643 END DO 649 644 ! … … 877 872 IF( lk_vvl ) THEN 878 873 DO jk = 1, jpk 879 fse3t_b(:,:,jk) = fse3t_n(:,:,jk)874 e3t_b(:,:,jk) = e3t_n(:,:,jk) 880 875 END DO 881 876 ENDIF -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
r5132 r5845 59 59 #endif 60 60 61 # include "domzgr_substitute.h90"62 61 !!---------------------------------------------------------------------- 63 62 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 289 288 DO ik = 1, jpkm1 290 289 dta%u2d(ib) = dta%u2d(ib) & 291 & + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik)290 & + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 292 291 END DO 293 dta%u2d(ib) = dta%u2d(ib) * hur(ii,ij)292 dta%u2d(ib) = dta%u2d(ib) * r1_hu_n(ii,ij) 294 293 END DO 295 294 igrd = 3 ! meridional velocity … … 300 299 DO ik = 1, jpkm1 301 300 dta%v2d(ib) = dta%v2d(ib) & 302 & + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik)301 & + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 303 302 END DO 304 dta%v2d(ib) = dta%v2d(ib) * hvr(ii,ij)303 dta%v2d(ib) = dta%v2d(ib) * r1_hv_n(ii,ij) 305 304 END DO 306 305 ENDIF … … 353 352 DO ik = 1, jpkm1 354 353 dta%u2d(ib) = dta%u2d(ib) & 355 & + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik)354 & + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 356 355 END DO 357 dta%u2d(ib) = dta%u2d(ib) * hur(ii,ij)356 dta%u2d(ib) = dta%u2d(ib) * r1_hu_n(ii,ij) 358 357 DO ik = 1, jpkm1 359 358 dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib) … … 367 366 DO ik = 1, jpkm1 368 367 dta%v2d(ib) = dta%v2d(ib) & 369 & + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik)368 & + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 370 369 END DO 371 dta%v2d(ib) = dta%v2d(ib) * hvr(ii,ij)370 dta%v2d(ib) = dta%v2d(ib) * r1_hv_n(ii,ij) 372 371 DO ik = 1, jpkm1 373 372 dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib) … … 882 881 ENDIF 883 882 #endif 884 885 END DO ! ib_bdy886 883 ! 884 END DO ! ib_bdy 885 ! 887 886 IF( nn_timing == 1 ) CALL timing_stop('bdy_dta_init') 888 889 887 ! 888 END SUBROUTINE bdy_dta_init 890 889 891 890 #else -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90
r4689 r5845 38 38 ! dyn_nxt (if lk_dynspg_ts or lk_dynspg_exp) 39 39 40 # include "domzgr_substitute.h90"41 40 !!---------------------------------------------------------------------- 42 41 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 53 52 !! 54 53 !!---------------------------------------------------------------------- 55 !!56 54 INTEGER, INTENT( in ) :: kt ! Main time step counter 57 55 LOGICAL, INTENT( in ), OPTIONAL :: dyn3d_only ! T => only update baroclinic velocities 58 !! 59 INTEGER :: jk,ii,ij,ib_bdy,ib,igrd ! Loop counter 60 LOGICAL :: ll_dyn2d, ll_dyn3d, ll_orlanski 61 !! 56 ! 57 INTEGER :: jk,ii,ij,ib_bdy,ib,igrd ! Loop counter 58 LOGICAL :: ll_dyn2d, ll_dyn3d, ll_orlanski 62 59 REAL(wp), POINTER, DIMENSION(:,:) :: pua2d, pva2d ! after barotropic velocities 63 64 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn') 65 60 !!---------------------------------------------------------------------- 61 ! 62 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn') 63 ! 66 64 ll_dyn2d = .true. 67 65 ll_dyn3d = .true. 68 66 ! 69 67 IF( PRESENT(dyn3d_only) ) THEN 70 IF( dyn3d_only ) ll_dyn2d = .false.68 IF( dyn3d_only ) ll_dyn2d = .false. 71 69 ENDIF 72 70 … … 74 72 DO ib_bdy = 1, nb_bdy 75 73 IF ( cn_dyn2d(ib_bdy) == 'orlanski' .or. cn_dyn2d(ib_bdy) == 'orlanski_npo' & 76 & .or. cn_dyn3d(ib_bdy) == 'orlanski' .or. cn_dyn3d(ib_bdy) == 'orlanski_npo') ll_orlanski = .true.77 END DO74 & .or. cn_dyn3d(ib_bdy) == 'orlanski' .or. cn_dyn3d(ib_bdy) == 'orlanski_npo') ll_orlanski = .true. 75 END DO 78 76 79 77 !------------------------------------------------------- … … 81 79 !------------------------------------------------------- 82 80 83 CALL wrk_alloc( jpi,jpj,pua2d,pva2d)81 CALL wrk_alloc( jpi,jpj, pua2d, pva2d ) 84 82 85 83 !------------------------------------------------------- … … 87 85 !------------------------------------------------------- 88 86 89 ! "After" velocities: 87 ! ! "After" velocities: 88 pua2d(:,:) = 0._wp 89 pva2d(:,:) = 0._wp 90 DO jk = 1, jpkm1 91 pua2d(:,:) = pua2d(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 92 pva2d(:,:) = pva2d(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 93 END DO 94 pua2d(:,:) = pua2d(:,:) * r1_hu_a(:,:) 95 pva2d(:,:) = pva2d(:,:) * r1_hv_a(:,:) 90 96 91 pua2d(:,:) = 0.e0 92 pva2d(:,:) = 0.e0 93 DO jk = 1, jpkm1 94 pua2d(:,:) = pua2d(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 95 pva2d(:,:) = pva2d(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 97 DO jk = 1 , jpkm1 98 ua(:,:,jk) = ( ua(:,:,jk) - pua2d(:,:) ) * umask(:,:,jk) 99 va(:,:,jk) = ( va(:,:,jk) - pva2d(:,:) ) * vmask(:,:,jk) 96 100 END DO 97 101 98 pua2d(:,:) = pua2d(:,:) * hur_a(:,:)99 pva2d(:,:) = pva2d(:,:) * hvr_a(:,:)100 102 101 DO jk = 1 , jpkm1 102 ua(:,:,jk) = (ua(:,:,jk) - pua2d(:,:)) * umask(:,:,jk) 103 va(:,:,jk) = (va(:,:,jk) - pva2d(:,:)) * vmask(:,:,jk) 104 END DO 105 106 ! "Before" velocities (required for Orlanski condition): 107 108 IF ( ll_orlanski ) THEN 103 IF( ll_orlanski ) THEN ! "Before" velocities (Orlanski condition only) 109 104 DO jk = 1 , jpkm1 110 ub(:,:,jk) = ( ub(:,:,jk) - ub_b(:,:)) * umask(:,:,jk)111 vb(:,:,jk) = ( vb(:,:,jk) - vb_b(:,:)) * vmask(:,:,jk)105 ub(:,:,jk) = ( ub(:,:,jk) - ub_b(:,:) ) * umask(:,:,jk) 106 vb(:,:,jk) = ( vb(:,:,jk) - vb_b(:,:) ) * vmask(:,:,jk) 112 107 END DO 113 END 108 ENDIF 114 109 115 110 !------------------------------------------------------- … … 118 113 !------------------------------------------------------- 119 114 120 IF( ll_dyn2d ) CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, hur_a(:,:), hvr_a(:,:), ssha )115 IF( ll_dyn2d ) CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, r1_hu_a(:,:), r1_hv_a(:,:), ssha ) 121 116 122 IF( ll_dyn3d ) CALL bdy_dyn3d( kt )117 IF( ll_dyn3d ) CALL bdy_dyn3d( kt ) 123 118 124 119 !------------------------------------------------------- 125 120 ! Recombine velocities 126 121 !------------------------------------------------------- 127 122 ! 128 123 DO jk = 1 , jpkm1 129 124 ua(:,:,jk) = ( ua(:,:,jk) + pua2d(:,:) ) * umask(:,:,jk) 130 125 va(:,:,jk) = ( va(:,:,jk) + pva2d(:,:) ) * vmask(:,:,jk) 131 126 END DO 132 127 ! 133 128 IF ( ll_orlanski ) THEN 134 129 DO jk = 1 , jpkm1 … … 137 132 END DO 138 133 END IF 139 140 CALL wrk_dealloc( jpi,jpj,pua2d,pva2d)141 134 ! 135 CALL wrk_dealloc( jpi,jpj, pua2d, pva2d ) 136 ! 142 137 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn') 143 138 ! 144 139 END SUBROUTINE bdy_dyn 145 140 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90
r5215 r5845 29 29 PUBLIC bdy_dyn3d_dmp ! routine called by step 30 30 31 !! * Substitutions32 # include "domzgr_substitute.h90"33 31 !!---------------------------------------------------------------------- 34 32 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 46 44 !!---------------------------------------------------------------------- 47 45 INTEGER, INTENT( in ) :: kt ! Main time step counter 48 ! !46 ! 49 47 INTEGER :: ib_bdy ! loop index 50 !! 51 48 !!---------------------------------------------------------------------- 49 ! 52 50 DO ib_bdy=1, nb_bdy 53 51 ! 54 52 SELECT CASE( cn_dyn3d(ib_bdy) ) 55 CASE('none') 56 CYCLE 57 CASE('frs') 58 CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 59 CASE('specified') 60 CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 61 CASE('zero') 62 CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 63 CASE('orlanski') 64 CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 65 CASE('orlanski_npo') 66 CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 67 CASE DEFAULT 68 CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 53 CASE('none') ; CYCLE 54 CASE('frs' ) ; CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 55 CASE('specified') ; CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 56 CASE('zero') ; CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 57 CASE('orlanski' ) ; CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 58 CASE('orlanski_npo'); CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 59 CASE DEFAULT ; CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 69 60 END SELECT 70 END DO71 61 END DO 62 ! 72 63 END SUBROUTINE bdy_dyn3d 64 73 65 74 66 SUBROUTINE bdy_dyn3d_spe( idx, dta, kt , ib_bdy ) … … 80 72 !! 81 73 !!---------------------------------------------------------------------- 82 INTEGER 83 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices84 TYPE(OBC_DATA) , INTENT(in) :: dta! OBC external data85 INTEGER ,INTENT(in) :: ib_bdy ! BDY set index86 ! !74 INTEGER , INTENT(in) :: kt 75 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 76 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 77 INTEGER , INTENT(in) :: ib_bdy ! BDY set index 78 ! 87 79 INTEGER :: jb, jk ! dummy loop indices 88 80 INTEGER :: ii, ij, igrd ! local integers … … 112 104 CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy ) 113 105 ! 114 IF( kt .eq. nit000 )CLOSE( unit = 102 )115 106 IF( kt == nit000 ) CLOSE( unit = 102 ) 107 ! 116 108 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_spe') 117 109 ! 118 110 END SUBROUTINE bdy_dyn3d_spe 119 111 112 120 113 SUBROUTINE bdy_dyn3d_zro( idx, dta, kt, ib_bdy ) 121 114 !!---------------------------------------------------------------------- … … 125 118 !! 126 119 !!---------------------------------------------------------------------- 127 INTEGER 120 INTEGER , INTENT(in) :: kt 128 121 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 129 TYPE(OBC_DATA) ,INTENT(in) :: dta ! OBC external data122 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 130 123 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 131 124 !! … … 157 150 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ; CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy ) ! Boundary points should be updated 158 151 ! 159 IF( kt .eq.nit000 ) CLOSE( unit = 102 )160 161 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_zro')162 152 IF( kt == nit000 ) CLOSE( unit = 102 ) 153 ! 154 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_zro') 155 ! 163 156 END SUBROUTINE bdy_dyn3d_zro 157 164 158 165 159 SUBROUTINE bdy_dyn3d_frs( idx, dta, kt, ib_bdy ) … … 174 168 !! topography. Tellus, 365-382. 175 169 !!---------------------------------------------------------------------- 176 INTEGER 170 INTEGER , INTENT(in) :: kt 177 171 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 178 TYPE(OBC_DATA) ,INTENT(in) :: dta ! OBC external data172 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 179 173 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 180 ! !174 ! 181 175 INTEGER :: jb, jk ! dummy loop indices 182 176 INTEGER :: ii, ij, igrd ! local integers … … 208 202 CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy ) 209 203 ! 210 IF( kt .eq. nit000 )CLOSE( unit = 102 )211 204 IF( kt == nit000 ) CLOSE( unit = 102 ) 205 ! 212 206 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_frs') 213 207 ! 214 208 END SUBROUTINE bdy_dyn3d_frs 209 215 210 216 211 SUBROUTINE bdy_dyn3d_orlanski( idx, dta, ib_bdy, ll_npo ) … … 259 254 !! 260 255 !!---------------------------------------------------------------------- 261 INTEGER 262 ! !256 INTEGER, INTENT(in) :: kt 257 ! 263 258 INTEGER :: jb, jk ! dummy loop indices 264 259 INTEGER :: ii, ij, igrd ! local integers 265 260 REAL(wp) :: zwgt ! boundary weight 266 INTEGER :: ib_bdy! loop index261 INTEGER :: ib_bdy ! loop index 267 262 !!---------------------------------------------------------------------- 268 263 ! 269 264 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_dmp') 270 265 ! 271 !-------------------------------------------------------272 273 266 DO ib_bdy=1, nb_bdy 274 267 IF ( ln_dyn3d_dmp(ib_bdy) .and. cn_dyn3d(ib_bdy) /= 'none' ) THEN … … 300 293 ! 301 294 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_dmp') 302 295 ! 303 296 END SUBROUTINE bdy_dyn3d_dmp 304 297 … … 311 304 WRITE(*,*) 'bdy_dyn3d: You should not have seen this print! error?', kt 312 305 END SUBROUTINE bdy_dyn3d 313 314 306 SUBROUTINE bdy_dyn3d_dmp( kt ) ! Empty routine 315 307 WRITE(*,*) 'bdy_dyn3d_dmp: You should not have seen this print! error?', kt 316 308 END SUBROUTINE bdy_dyn3d_dmp 317 318 309 #endif 319 310 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r5836 r5845 1319 1319 nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 1320 1320 flagu => idx_bdy(ib_bdy)%flagu(ib,igrd) 1321 bdysurftot = bdysurftot + hu 1321 bdysurftot = bdysurftot + hu_n (nbi , nbj) & 1322 1322 & * e2u (nbi , nbj) * ABS( flagu ) & 1323 1323 & * tmask_i(nbi , nbj) & … … 1332 1332 nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 1333 1333 flagv => idx_bdy(ib_bdy)%flagv(ib,igrd) 1334 bdysurftot = bdysurftot + hv 1334 bdysurftot = bdysurftot + hv_n (nbi, nbj ) & 1335 1335 & * e1v (nbi, nbj ) * ABS( flagv ) & 1336 1336 & * tmask_i(nbi, nbj ) & -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
r5132 r5845 288 288 END SUBROUTINE bdytide_init 289 289 290 290 291 SUBROUTINE bdytide_update ( kt, idx, dta, td, jit, time_offset ) 291 292 !!---------------------------------------------------------------------- … … 295 296 !! 296 297 !!---------------------------------------------------------------------- 297 INTEGER, INTENT( in ) :: kt ! Main timestep counter 298 TYPE(OBC_INDEX), INTENT( in ) :: idx ! OBC indices 299 TYPE(OBC_DATA), INTENT(inout) :: dta ! OBC external data 300 TYPE(TIDES_DATA),INTENT( inout ) :: td ! tidal harmonics data 301 INTEGER,INTENT(in),OPTIONAL :: jit ! Barotropic timestep counter (for timesplitting option) 302 INTEGER,INTENT( in ), OPTIONAL :: time_offset ! time offset in units of timesteps. NB. if jit 303 ! is present then units = subcycle timesteps. 304 ! time_offset = 0 => get data at "now" time level 305 ! time_offset = -1 => get data at "before" time level 306 ! time_offset = +1 => get data at "after" time level 307 ! etc. 308 !! 309 INTEGER, DIMENSION(3) :: ilen0 !: length of boundary data (from OBC arrays) 298 INTEGER , INTENT(in ) :: kt ! Main timestep counter 299 TYPE(OBC_INDEX) , INTENT(in ) :: idx ! OBC indices 300 TYPE(OBC_DATA) , INTENT(inout) :: dta ! OBC external data 301 TYPE(TIDES_DATA) , INTENT(inout) :: td ! tidal harmonics data 302 INTEGER, OPTIONAL, INTENT(in ) :: jit ! Barotropic timestep counter (for timesplitting option) 303 INTEGER, OPTIONAL, INTENT(in ) :: time_offset ! time offset in units of timesteps. NB. if jit 304 ! ! is present then units = subcycle timesteps. 305 ! ! time_offset = 0 => get data at "now" time level 306 ! ! time_offset = -1 => get data at "before" time level 307 ! ! time_offset = +1 => get data at "after" time level 308 ! ! etc. 309 ! 310 310 INTEGER :: itide, igrd, ib ! dummy loop indices 311 311 INTEGER :: time_add ! time offset in units of timesteps 312 INTEGER, DIMENSION(3) :: ilen0 !: length of boundary data (from OBC arrays) 312 313 REAL(wp) :: z_arg, z_sarg, zflag, zramp 313 314 REAL(wp), DIMENSION(jpmax_harmo) :: z_sist, z_cost … … 380 381 END SUBROUTINE bdytide_update 381 382 383 382 384 SUBROUTINE bdy_dta_tides( kt, kit, time_offset ) 383 385 !!---------------------------------------------------------------------- … … 387 389 !! 388 390 !!---------------------------------------------------------------------- 389 INTEGER, INTENT( in ) :: kt ! Main timestep counter 390 INTEGER, INTENT( in ),OPTIONAL :: kit ! Barotropic timestep counter (for timesplitting option) 391 INTEGER, INTENT( in ),OPTIONAL :: time_offset ! time offset in units of timesteps. NB. if kit 392 ! is present then units = subcycle timesteps. 393 ! time_offset = 0 => get data at "now" time level 394 ! time_offset = -1 => get data at "before" time level 395 ! time_offset = +1 => get data at "after" time level 396 ! etc. 397 !! 398 LOGICAL :: lk_first_btstp ! =.TRUE. if time splitting and first barotropic step 399 INTEGER, DIMENSION(jpbgrd) :: ilen0 391 INTEGER, INTENT(in) :: kt ! Main timestep counter 392 INTEGER, OPTIONAL, INTENT(in) :: kit ! Barotropic timestep counter (for timesplitting option) 393 INTEGER, OPTIONAL, INTENT(in) :: time_offset ! time offset in units of timesteps. NB. if kit 394 ! ! is present then units = subcycle timesteps. 395 ! ! time_offset = 0 => get data at "now" time level 396 ! ! time_offset = -1 => get data at "before" time level 397 ! ! time_offset = +1 => get data at "after" time level 398 ! ! etc. 399 ! 400 LOGICAL :: lk_first_btstp ! =.TRUE. if time splitting and first barotropic step 401 INTEGER :: itide, ib_bdy, ib, igrd ! loop indices 402 INTEGER :: time_add ! time offset in units of timesteps 403 INTEGER, DIMENSION(jpbgrd) :: ilen0 400 404 INTEGER, DIMENSION(1:jpbgrd) :: nblen, nblenrim ! short cuts 401 INTEGER :: itide, ib_bdy, ib, igrd ! loop indices402 INTEGER :: time_add ! time offset in units of timesteps403 405 REAL(wp) :: z_arg, z_sarg, zramp, zoff, z_cost, z_sist 404 406 !!---------------------------------------------------------------------- … … 511 513 END SUBROUTINE bdy_dta_tides 512 514 515 513 516 SUBROUTINE tide_init_elevation( idx, td ) 514 517 !!---------------------------------------------------------------------- 515 518 !! *** ROUTINE tide_init_elevation *** 516 519 !!---------------------------------------------------------------------- 517 TYPE(OBC_INDEX), INTENT( in ) :: idx ! OBC indices 518 TYPE(TIDES_DATA),INTENT( inout ) :: td ! tidal harmonics data 519 !! * Local declarations 520 INTEGER, DIMENSION(1) :: ilen0 !: length of boundary data (from OBC arrays) 520 TYPE(OBC_INDEX) , INTENT(in ) :: idx ! OBC indices 521 TYPE(TIDES_DATA), INTENT(inout) :: td ! tidal harmonics data 522 ! 523 INTEGER :: itide, igrd, ib ! dummy loop indices 524 INTEGER, DIMENSION(1) :: ilen0 ! length of boundary data (from OBC arrays) 521 525 REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide 522 INTEGER :: itide, igrd, ib ! dummy loop indices526 !!---------------------------------------------------------------------- 523 527 524 528 igrd=1 … … 544 548 END DO 545 549 546 DEALLOCATE( mod_tide,phi_tide)547 550 DEALLOCATE( mod_tide, phi_tide ) 551 ! 548 552 END SUBROUTINE tide_init_elevation 549 553 554 550 555 SUBROUTINE tide_init_velocities( idx, td ) 551 556 !!---------------------------------------------------------------------- 552 557 !! *** ROUTINE tide_init_elevation *** 553 558 !!---------------------------------------------------------------------- 554 TYPE(OBC_INDEX), INTENT( in ) :: idx ! OBC indices 555 TYPE(TIDES_DATA),INTENT( inout ) :: td ! tidal harmonics data 556 !! * Local declarations 557 INTEGER, DIMENSION(3) :: ilen0 !: length of boundary data (from OBC arrays) 559 TYPE(OBC_INDEX) , INTENT(in ) :: idx ! OBC indices 560 TYPE(TIDES_DATA), INTENT(inout) :: td ! tidal harmonics data 561 ! 562 INTEGER :: itide, igrd, ib ! dummy loop indices 563 INTEGER, DIMENSION(3) :: ilen0 ! length of boundary data (from OBC arrays) 558 564 REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide 559 INTEGER :: itide, igrd, ib ! dummy loop indices565 !!---------------------------------------------------------------------- 560 566 561 567 ilen0(2) = SIZE(td%u0(:,1,1)) … … 564 570 igrd=2 ! U grid. 565 571 566 ALLOCATE( mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))572 ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 567 573 568 574 DO itide = 1, nb_harmo … … 581 587 END DO 582 588 583 DEALLOCATE( mod_tide,phi_tide)589 DEALLOCATE( mod_tide , phi_tide ) 584 590 585 591 igrd=3 ! V grid. 586 592 587 ALLOCATE( mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))593 ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 588 594 589 595 DO itide = 1, nb_harmo … … 601 607 ENDDO 602 608 END DO 603 609 ! 604 610 DEALLOCATE(mod_tide,phi_tide) 605 611 ! 606 612 END SUBROUTINE tide_init_velocities 613 607 614 #else 608 615 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
r5836 r5845 32 32 PUBLIC bdy_vol ! routine called by dynspg_flt.h90 33 33 34 !! * Substitutions35 # include "domzgr_substitute.h90"36 34 !!---------------------------------------------------------------------- 37 35 !! NEMO/OPA 3.6 , NEMO Consortium (2014) … … 111 109 ii = idx%nbi(jb,jgrd) 112 110 ij = idx%nbj(jb,jgrd) 113 zubtpecor = zubtpecor + idx%flagu(jb,jgrd) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(ii,ij,jk)111 zubtpecor = zubtpecor + idx%flagu(jb,jgrd) * ua(ii,ij, jk) * e2u(ii,ij) * e3u_n(ii,ij,jk) 114 112 END DO 115 113 END DO … … 119 117 ii = idx%nbi(jb,jgrd) 120 118 ij = idx%nbj(jb,jgrd) 121 zubtpecor = zubtpecor + idx%flagv(jb,jgrd) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(ii,ij,jk)119 zubtpecor = zubtpecor + idx%flagv(jb,jgrd) * va(ii,ij, jk) * e1v(ii,ij) * e3v_n(ii,ij,jk) 122 120 END DO 123 121 END DO … … 144 142 ij = idx%nbj(jb,jgrd) 145 143 ua(ii,ij,jk) = ua(ii,ij,jk) - idx%flagu(jb,jgrd) * zubtpecor * umask(ii,ij,jk) 146 ztranst = ztranst + idx%flagu(jb,jgrd) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(ii,ij,jk)144 ztranst = ztranst + idx%flagu(jb,jgrd) * ua(ii,ij,jk) * e2u(ii,ij) * e3u_n(ii,ij,jk) 147 145 END DO 148 146 END DO … … 153 151 ij = idx%nbj(jb,jgrd) 154 152 va(ii,ij,jk) = va(ii,ij,jk) -idx%flagv(jb,jgrd) * zubtpecor * vmask(ii,ij,jk) 155 ztranst = ztranst + idx%flagv(jb,jgrd) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(ii,ij,jk)153 ztranst = ztranst + idx%flagv(jb,jgrd) * va(ii,ij,jk) * e1v(ii,ij) * e3v_n(ii,ij,jk) 156 154 END DO 157 155 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90
r5215 r5845 31 31 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_uvd ! structure for input U & V current (file information and data) 32 32 33 !! * Substitutions34 # include "domzgr_substitute.h90"35 33 !!---------------------------------------------------------------------- 36 34 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 174 172 DO ji = 1, jpi ! determines the interpolated U & V current profiles at each (i,j) point 175 173 DO jk = 1, jpk 176 zl = fsdept(ji,jj,jk)174 zl = gdept_n(ji,jj,jk) 177 175 IF ( zl < gdept_1d(1 ) ) THEN ! extrapolate above the first level of data 178 176 zup(jk) = puvd(ji,jj,1 ,1) … … 222 220 ENDIF 223 221 ! 224 IF( lwp .AND. kt == nit000 ) THEN ! control print225 WRITE(numout,*) ' U current '226 WRITE(numout,*)227 WRITE(numout,*)' level = 1'228 CALL prihre( puvd(:,:,1 ,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )229 WRITE(numout,*)' level = ', jpk/2230 CALL prihre( puvd(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )231 WRITE(numout,*)' level = ', jpkm1232 CALL prihre( puvd(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )233 WRITE(numout,*)234 WRITE(numout,*) ' V current '235 WRITE(numout,*)236 WRITE(numout,*)' level = 1'237 CALL prihre( puvd(:,:,1 ,2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )238 WRITE(numout,*)' level = ', jpk/2239 CALL prihre( puvd(:,:,jpk/2,2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )240 WRITE(numout,*)' level = ', jpkm1241 CALL prihre( puvd(:,:,jpkm1,2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )242 WRITE(numout,*)243 ENDIF244 !245 222 IF( .NOT. ln_uvd_dyndmp ) THEN !== deallocate U & V current structure ==! 246 223 ! !== (data used only for initialization) ==! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90
r5215 r5845 43 43 44 44 !! * Substitutions 45 # include "domzgr_substitute.h90"46 45 # include "vectopt_loop_substitute.h90" 47 46 !!---------------------------------------------------------------------- … … 204 203 DO jj = 2, jpjm1 205 204 DO ji = fs_2, fs_jpim1 ! vector opt. 206 IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN205 IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN 207 206 zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - ub(ji,jj,jk) ) 208 207 zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - vb(ji,jj,jk) ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90
r5836 r5845 28 28 29 29 !! * Substitutions 30 # include "domzgr_substitute.h90"31 30 # include "zdfddm_substitute.h90" 32 31 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
r5215 r5845 11 11 USE in_out_manager 12 12 13 14 13 IMPLICIT NONE 15 14 PUBLIC 16 15 17 18 16 PUBLIC crs_dom_alloc ! Called from crsini.F90 19 17 PUBLIC crs_dom_alloc2 ! Called from crsini.F90 … … 161 159 INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: nmln_crs, hmld_crs, hmlp_crs, hmlpt_crs 162 160 163 ! Direction of lateral diffusion 164 165 161 !!---------------------------------------------------------------------- 162 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 166 163 !! $Id$ 164 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 165 !!---------------------------------------------------------------------- 167 166 CONTAINS 168 167 … … 258 257 259 258 END FUNCTION crs_dom_alloc 260 259 260 261 261 INTEGER FUNCTION crs_dom_alloc2() 262 262 !!------------------------------------------------------------------- … … 272 272 crs_dom_alloc2 = MAXVAL(ierr) 273 273 274 END FUNCTION crs_dom_alloc2 274 END FUNCTION crs_dom_alloc2 275 275 276 276 277 SUBROUTINE dom_grid_glo … … 312 313 END SUBROUTINE dom_grid_glo 313 314 315 314 316 SUBROUTINE dom_grid_crs 315 317 !!-------------------------------------------------------------------- … … 318 320 !! ** Purpose : Save the parent grid information & Switch to coarse grid domain 319 321 !!--------------------------------------------------------------------- 320 321 322 ! 322 323 ! Switch to coarse grid domain … … 349 350 nlejt(:) = nlejt_crs(:) 350 351 njmppt(:) = njmppt_crs(:) 351 352 353 352 ! 354 353 END SUBROUTINE dom_grid_crs 355 354 356 357 355 !!====================================================================== 358 356 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90
r5302 r5845 30 30 !! Original. May 2012. (J. Simeon, C. Calone, G. Madec, C. Ethe) 31 31 !!=================================================================== 32 33 32 USE dom_oce ! ocean space and time domain and to get jperio 34 USE wrk_nemo ! work arrays35 33 USE crs ! domain for coarse grid 34 ! 36 35 USE in_out_manager 37 36 USE par_kind 38 37 USE crslbclnk 38 USE wrk_nemo ! work arrays 39 39 USE lib_mpp 40 41 40 42 41 IMPLICIT NONE … … 54 53 REAL(wp) :: r_inf = 1e+36 55 54 56 !! Substitutions 57 # include "domzgr_substitute.h90" 58 55 !!---------------------------------------------------------------------- 56 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 59 57 !! $Id$ 58 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 59 !!---------------------------------------------------------------------- 60 60 CONTAINS 61 62 61 63 62 SUBROUTINE crs_dom_msk … … 133 132 END SUBROUTINE crs_dom_msk 134 133 134 135 135 SUBROUTINE crs_dom_coordinates( p_gphi, p_glam, cd_type, p_gphi_crs, p_glam_crs ) 136 136 !!---------------------------------------------------------------- … … 334 334 !! cd_type = grid type (T,U,V,F) for scale factors; for velocities (U or V) 335 335 !! cd_op = applied operation (SUM, VOL, WGT) 336 !! p_ fse3 = (Optional) parent grid vertical level thickness (fse3u or fse3v)336 !! p_e3 = (Optional) parent grid vertical level thickness (e3u or e3v) 337 337 !! ** Outputs : p_cfield2d_1 = (Optional) 2D field on coarse grid 338 338 !! p_cfield2d_2 = (Optional) 2D field on coarse grid … … 348 348 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: p_e1 ! Parent grid U,V scale factors (e1) 349 349 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: p_e2 ! Parent grid U,V scale factors (e2) 350 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in) :: p_e3 ! Parent grid vertical level thickness ( fse3u, fse3v)350 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in) :: p_e3 ! Parent grid vertical level thickness (e3u, e3v) 351 351 352 352 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld1_crs ! Coarse grid box 3D quantity … … 469 469 !! p_pmask = parent grid mask (T,U,V,F) for scale factors; 470 470 !! for velocities (U or V) 471 !! p_ fse3 = parent grid vertical level thickness (fse3u or fse3v)471 !! p_e3 = parent grid vertical level thickness (e3u or e3v) 472 472 !! p_pfield = U or V on the parent grid 473 473 !! p_surf_crs = (Optional) Coarse grid weight for averaging … … 478 478 !! 5 Jun. Streamline for area-weighted average only ; separate scale factor and weights. 479 479 !!---------------------------------------------------------------- 480 !!481 !! Arguments482 480 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_fld ! T, U, V or W on parent grid 483 481 CHARACTER(len=3), INTENT(in) :: cd_op ! Operation SUM, MAX or MIN … … 485 483 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_mask ! Parent grid T,U,V mask 486 484 REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: p_e12 ! Parent grid T,U,V scale factors (e1 or e2) 487 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: p_e3 ! Parent grid vertical level thickness ( fse3u, fse3v)485 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: p_e3 ! Parent grid vertical level thickness (e3u, e3v) 488 486 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator 489 487 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs ! Coarse grid T,U,V maska 490 488 REAL(wp), INTENT(in) :: psgn ! sign 491 492 493 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld_crs ! Coarse grid box 3D quantity 494 495 !! Local variables 489 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT( out) :: p_fld_crs ! Coarse grid box 3D quantity 490 ! 496 491 INTEGER :: ji, jj, jk 497 492 INTEGER :: ii, ij, ijie, ijje, je_2 … … 499 494 REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk, zmask 500 495 !!---------------------------------------------------------------- 501 502 p_fld_crs(:,:,:) = 0. 0503 496 ! 497 p_fld_crs(:,:,:) = 0._wp 498 ! 504 499 SELECT CASE ( cd_op ) 505 500 … … 1136 1131 !! p_pmask = parent grid mask (T,U,V,F) for scale factors; 1137 1132 !! for velocities (U or V) 1138 !! p_ fse3 = parent grid vertical level thickness (fse3u or fse3v)1133 !! p_e3 = parent grid vertical level thickness (e3u or e3v) 1139 1134 !! p_pfield = U or V on the parent grid 1140 1135 !! p_surf_crs = (Optional) Coarse grid weight for averaging … … 1152 1147 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_mask ! Parent grid T,U,V mask 1153 1148 REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: p_e12 ! Parent grid T,U,V scale factors (e1 or e2) 1154 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: p_e3 ! Parent grid vertical level thickness ( fse3u, fse3v)1149 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: p_e3 ! Parent grid vertical level thickness (e3u, e3v) 1155 1150 REAL(wp), DIMENSION(jpi_crs,jpj_crs) , INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator 1156 1151 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs ! Coarse grid T,U,V mask -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90
r5215 r5845 33 33 PUBLIC crs_dom_wri ! routine called by crsini.F90 34 34 35 !!---------------------------------------------------------------------- 36 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 35 37 !! $Id$ 38 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 39 !!---------------------------------------------------------------------- 36 40 CONTAINS 37 41 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
r5836 r5845 33 33 34 34 !! * Substitutions 35 # include "zdfddm_substitute.h90"36 # include "domzgr_substitute.h90"37 35 # include "vectopt_loop_substitute.h90" 38 36 !!---------------------------------------------------------------------- … … 61 59 REAL(wp) :: z2dcrsu, z2dcrsv ! local scalars 62 60 ! 63 REAL(wp), POINTER, DIMENSION(:,:,:) :: z fse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e361 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3t, ze3u, ze3v, ze3w ! 3D workspace for e3 64 62 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zt_crs 65 63 REAL(wp), POINTER, DIMENSION(:,:,:) :: zs, zs_crs … … 69 67 70 68 ! Initialize arrays 71 CALL wrk_alloc( jpi,jpj,jpk, z fse3t, zfse3w )72 CALL wrk_alloc( jpi,jpj,jpk, z fse3u, zfse3v )73 CALL wrk_alloc( jpi,jpj,jpk, zt , zs)74 ! 75 CALL wrk_alloc( jpi_crs, jpj_crs, jpk,zt_crs, zs_crs )69 CALL wrk_alloc( jpi,jpj,jpk, ze3t, ze3w ) 70 CALL wrk_alloc( jpi,jpj,jpk, ze3u, ze3v ) 71 CALL wrk_alloc( jpi,jpj,jpk, zt , zs ) 72 ! 73 CALL wrk_alloc( jpi_crs,jpj_crs,jpk, zt_crs, zs_crs ) 76 74 77 75 ! Depth work arrrays 78 z fse3t(:,:,:) = fse3t(:,:,:)79 z fse3u(:,:,:) = fse3u(:,:,:)80 z fse3v(:,:,:) = fse3v(:,:,:)81 z fse3w(:,:,:) = fse3w(:,:,:)76 ze3t(:,:,:) = e3t_n(:,:,:) 77 ze3u(:,:,:) = e3u_n(:,:,:) 78 ze3v(:,:,:) = e3v_n(:,:,:) 79 ze3w(:,:,:) = e3w_n(:,:,:) 82 80 83 81 IF( kt == nit000 ) THEN … … 107 105 ! Temperature 108 106 zt(:,:,:) = tsn(:,:,:,jp_tem) ; zt_crs(:,:,:) = 0._wp 109 CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=z fse3t, psgn=1.0 )107 CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 110 108 tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:) 111 109 … … 116 114 ! Salinity 117 115 zs(:,:,:) = tsn(:,:,:,jp_sal) ; zs_crs(:,:,:) = 0._wp 118 CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=z fse3t, psgn=1.0 )116 CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 119 117 tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:) 120 118 … … 123 121 124 122 ! U-velocity 125 CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=z fse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )123 CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 126 124 ! 127 125 zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp … … 134 132 END DO 135 133 END DO 136 CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=z fse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )137 CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=z fse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )134 CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 135 CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 138 136 139 137 CALL iom_put( "uoce" , un_crs ) ! i-current … … 142 140 143 141 ! V-velocity 144 CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=z fse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )142 CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 145 143 ! 146 144 zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp … … 153 151 END DO 154 152 END DO 155 CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=z fse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )156 CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=z fse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )153 CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 154 CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 157 155 158 156 CALL iom_put( "voce" , vn_crs ) ! i-current … … 162 160 163 161 ! Kinetic energy 164 CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=z fse3t, psgn=1.0 )162 CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 165 163 CALL iom_put( "eken", rke_crs ) 166 164 … … 188 186 IF( ln_crs_wn ) THEN 189 187 CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 ) 190 ! CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=z fse3w )188 ! CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=ze3w ) 191 189 ELSE 192 190 wn_crs(:,:,jpk) = 0._wp … … 199 197 200 198 ! avt, avs 199 !!gm BUG TOP always uses avs !!! 201 200 SELECT CASE ( nn_crs_kz ) 202 201 CASE ( 0 ) 203 CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=z fse3w, psgn=1.0 )202 CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 204 203 CASE ( 1 ) 205 CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=z fse3w, psgn=1.0 )204 CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 206 205 CASE ( 2 ) 207 CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=z fse3w, psgn=1.0 )206 CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 208 207 END SELECT 209 208 ! … … 211 210 212 211 ! sbc fields 213 CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=z fse3t, psgn=1.0 )212 CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t , psgn=1.0 ) 214 213 CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u , p_surf_crs=e2u_crs , psgn=1.0 ) 215 214 CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v , p_surf_crs=e1v_crs , psgn=1.0 ) … … 233 232 234 233 ! free memory 235 CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w )236 CALL wrk_dealloc( jpi, jpj, jpk, zfse3u, zfse3v )237 CALL wrk_dealloc( jpi, jpj, jpk, zt, zs)238 CALL wrk_dealloc( jpi_crs, jpj_crs, jpk,zt_crs, zs_crs )234 CALL wrk_dealloc( jpi,jpj,jpk, ze3t, ze3w ) 235 CALL wrk_dealloc( jpi,jpj,jpk, ze3u, ze3v ) 236 CALL wrk_dealloc( jpi,jpj,jpk, zt , zs ) 237 CALL wrk_dealloc( jpi_crs,jpj_crs,jpk, zt_crs, zs_crs ) 239 238 ! 240 239 CALL iom_swap( "nemo" ) ! return back on high-resolution grid -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90
r5836 r5845 30 30 PUBLIC crs_init ! called by nemogcm.F90 module 31 31 32 !! * Substitutions 33 # include "domzgr_substitute.h90" 34 !!---------------------------------------------------------------------- 32 !!---------------------------------------------------------------------- 33 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 35 34 !! $Id$ 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 36 !!---------------------------------------------------------------------- 37 37 CONTAINS … … 64 64 !! output C*dA or C*dV as summation not mran, then do mean (division) at moment of output. 65 65 !! As is, crsfun takes into account vvl. 66 !! Talked about pre-setting the surface array to avoid IF/ENDIF Sand division.66 !! Talked about pre-setting the surface array to avoid IF/ENDIF and division. 67 67 !! But have then to make that preset array here and elsewhere. 68 68 !! that is called every timestep... … … 73 73 INTEGER :: ierr ! allocation error status 74 74 INTEGER :: ios ! Local integer output status for namelist read 75 REAL(wp), DIMENSION(:,:,:), POINTER :: z fse3t, zfse3u, zfse3v, zfse3w75 REAL(wp), DIMENSION(:,:,:), POINTER :: ze3t, ze3u, ze3v, ze3w 76 76 77 77 NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, nn_msh_crs, nn_crs_kz, ln_crs_wn … … 187 187 188 188 ! 189 CALL wrk_alloc( jpi,jpj,jpk, z fse3t, zfse3u, zfse3v, zfse3w )190 ! 191 z fse3t(:,:,:) = fse3t(:,:,:)192 z fse3u(:,:,:) = fse3u(:,:,:)193 z fse3v(:,:,:) = fse3v(:,:,:)194 z fse3w(:,:,:) = fse3w(:,:,:)189 CALL wrk_alloc( jpi,jpj,jpk, ze3t, ze3u, ze3v, ze3w ) 190 ! 191 ze3t(:,:,:) = e3t_n(:,:,:) 192 ze3u(:,:,:) = e3u_n(:,:,:) 193 ze3v(:,:,:) = e3v_n(:,:,:) 194 ze3w(:,:,:) = e3w_n(:,:,:) 195 195 196 196 ! 3.d.2 Surfaces 197 CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t 198 CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=z fse3u )199 CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=z fse3v )197 CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t ) 198 CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=ze3u ) 199 CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=ze3v ) 200 200 201 201 facsurfu(:,:,:) = umask_crs(:,:,:) * e2e3u_msk(:,:,:) / e2e3u_crs(:,:,:) … … 204 204 ! 3.d.3 Vertical scale factors 205 205 ! 206 CALL crs_dom_e3( e1t, e2t, z fse3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs)207 CALL crs_dom_e3( e1u, e2u, z fse3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs)208 CALL crs_dom_e3( e1v, e2v, z fse3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs)209 CALL crs_dom_e3( e1t, e2t, z fse3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs)206 CALL crs_dom_e3( e1t, e2t, ze3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs) 207 CALL crs_dom_e3( e1u, e2u, ze3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs) 208 CALL crs_dom_e3( e1v, e2v, ze3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs) 209 CALL crs_dom_e3( e1t, e2t, ze3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs) 210 210 211 211 ! Replace 0 by e3t_0 or e3w_0 … … 222 222 223 223 ! 3.d.3 Vertical depth (meters) 224 CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_crs, p_e3=z fse3t, psgn=1.0 )225 CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=z fse3w, psgn=1.0 )224 CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_crs, p_e3=ze3t, psgn=1.0 ) 225 CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=ze3w, psgn=1.0 ) 226 226 227 227 … … 230 230 !--------------------------------------------------------- 231 231 ! 4.a. Ocean volume or area unmasked and masked 232 CALL crs_dom_facvol( tmask, 'T', e1t, e2t, z fse3t, ocean_volume_crs_t, facvol_t )232 CALL crs_dom_facvol( tmask, 'T', e1t, e2t, ze3t, ocean_volume_crs_t, facvol_t ) 233 233 ! 234 234 bt_crs(:,:,:) = ocean_volume_crs_t(:,:,:) * facvol_t(:,:,:) … … 237 237 WHERE( bt_crs /= 0._wp ) r1_bt_crs(:,:,:) = 1._wp / bt_crs(:,:,:) 238 238 239 CALL crs_dom_facvol( tmask, 'W', e1t, e2t, z fse3w, ocean_volume_crs_w, facvol_w )239 CALL crs_dom_facvol( tmask, 'W', e1t, e2t, ze3w, ocean_volume_crs_w, facvol_w ) 240 240 ! 241 241 !--------------------------------------------------------- … … 252 252 ! 7. Finish and clean-up 253 253 !--------------------------------------------------------- 254 CALL wrk_dealloc( jpi,jpj,jpk, z fse3t, zfse3u, zfse3v, zfse3w )254 CALL wrk_dealloc( jpi,jpj,jpk, ze3t, ze3u, ze3v, ze3w ) 255 255 ! 256 256 END SUBROUTINE crs_init -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90
r5215 r5845 7 7 !!===================================================================== 8 8 !! History : ! 2012-06 (J. Simeon, G. Madec, C. Ethe, C. Calone) Original code 9 9 !!---------------------------------------------------------------------- 10 10 USE dom_oce 11 11 USE crs … … 13 13 USE par_kind, ONLY: wp 14 14 USE in_out_manager 15 16 17 15 18 16 INTERFACE crs_lbc_lnk … … 22 20 PUBLIC crs_lbc_lnk 23 21 22 !!---------------------------------------------------------------------- 23 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 24 24 !! $Id$ 25 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 26 !!---------------------------------------------------------------------- 25 27 CONTAINS 26 28 … … 35 37 !! Upon exiting, switch back to full domain indices. 36 38 !!---------------------------------------------------------------------- 37 !! Arguments38 39 CHARACTER(len=1) , INTENT(in ) :: cd_type1 ! grid type 39 40 REAL(wp) , INTENT(in ) :: psgn ! control of the sign … … 42 43 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! valeur sur les halo 43 44 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing) 44 45 !! local vairables 45 ! 46 46 LOGICAL :: ll_grid_crs 47 47 REAL(wp) :: zval ! valeur sur les halo 48 49 48 !!---------------------------------------------------------------------- 50 49 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r5836 r5845 40 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sn0 ! initial salinity 41 41 42 !! * Substitutions43 # include "domzgr_substitute.h90"44 42 !!---------------------------------------------------------------------- 45 43 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 99 97 ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) ! thermosteric ssh 100 98 ztsn(:,:,:,jp_sal) = sn0(:,:,:) 101 CALL eos( ztsn, zrhd, fsdept_n(:,:,:) ) ! now in situ density using initial salinity99 CALL eos( ztsn, zrhd, gdept_n(:,:,:) ) ! now in situ density using initial salinity 102 100 ! 103 101 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 104 102 DO jk = 1, jpkm1 105 zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk)103 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 106 104 END DO 107 105 IF( .NOT.lk_vvl ) THEN … … 123 121 124 122 ! ! steric sea surface height 125 CALL eos( tsn, zrhd, zrhop, fsdept_n(:,:,:) ) ! now in situ and potential density123 CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) ) ! now in situ and potential density 126 124 zrhop(:,:,jpk) = 0._wp 127 125 CALL iom_put( 'rhop', zrhop ) … … 129 127 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 130 128 DO jk = 1, jpkm1 131 zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk)129 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 132 130 END DO 133 131 IF( .NOT.lk_vvl ) THEN … … 159 157 DO jj = 1, jpj 160 158 DO ji = 1, jpi 161 zztmp = area(ji,jj) * fse3t(ji,jj,jk)159 zztmp = area(ji,jj) * e3t_n(ji,jj,jk) 162 160 ztemp = ztemp + zztmp * tsn(ji,jj,jk,jp_tem) 163 161 zsal = zsal + zztmp * tsn(ji,jj,jk,jp_sal) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r5505 r5845 30 30 !! 31 31 !!---------------------------------------------------------------------- 32 !! * Modules used33 32 USE oce ! ocean dynamics and tracers 34 33 USE dom_oce ! ocean space and time domain … … 51 50 PRIVATE 52 51 53 !! * Routine accessibility54 52 PUBLIC dia_dct ! routine called by step.F90 55 53 PUBLIC dia_dct_init ! routine called by opa.F90 … … 60 58 PRIVATE dia_dct_wri 61 59 62 #include "domzgr_substitute.h90"63 64 !! * Shared module variables65 60 LOGICAL, PUBLIC, PARAMETER :: lk_diadct = .TRUE. !: model-data diagnostics flag 66 61 67 !! * Module variables68 62 INTEGER :: nn_dct ! Frequency of computation 69 63 INTEGER :: nn_dctwri ! Frequency of output … … 112 106 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: transports_2d 113 107 108 !!---------------------------------------------------------------------- 109 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 114 110 !! $Id$ 111 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 112 !!---------------------------------------------------------------------- 115 113 CONTAINS 116 117 114 118 115 INTEGER FUNCTION diadct_alloc() … … 130 127 131 128 END FUNCTION diadct_alloc 129 132 130 133 131 SUBROUTINE dia_dct_init … … 208 206 !! Reinitialise all relevant arrays to zero 209 207 !!--------------------------------------------------------------------- 210 !! * Arguments 211 INTEGER,INTENT(IN) ::kt 212 213 !! * Local variables 208 INTEGER,INTENT(in) ::kt 209 ! 214 210 INTEGER :: jsec, &! loop on sections 215 211 itotal ! nb_sec_max*nb_type_class*nb_class_max … … 220 216 REAL(wp), POINTER, DIMENSION(:) :: zwork ! " 221 217 REAL(wp), POINTER, DIMENSION(:,:,:):: zsum ! " 222 223 218 !!--------------------------------------------------------------------- 219 ! 224 220 IF( nn_timing == 1 ) CALL timing_start('dia_dct') 225 221 … … 619 615 zumid_ice, zvmid_ice, &!U/V ice velocity 620 616 zTnorm !transport of velocity through one cell's sides 621 REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, z fsdep !temperature/salinity/potential density/ssh/depth at u/v point617 REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zdep !temperature/salinity/potential density/ssh/depth at u/v point 622 618 623 619 TYPE(POINT_SECTION) :: k … … 723 719 END SELECT 724 720 725 z fsdep= fsdept(k%I,k%J,jk)721 zdep= gdept_n(k%I,k%J,jk) 726 722 727 723 !compute velocity with the correct direction … … 737 733 !zTnorm=transport through one cell; 738 734 !velocity* cell's length * cell's thickness 739 zTnorm=zumid*e2u(k%I,k%J)* fse3u(k%I,k%J,jk)+ &740 zvmid*e1v(k%I,k%J)* fse3v(k%I,k%J,jk)735 zTnorm=zumid*e2u(k%I,k%J)* e3u_n(k%I,k%J,jk)+ & 736 zvmid*e1v(k%I,k%J)* e3v_n(k%I,k%J,jk) 741 737 742 738 #if ! defined key_vvl … … 828 824 !! 829 825 !!------------------------------------------------------------- 830 !! * arguments831 826 TYPE(SECTION),INTENT(INOUT) :: sec 832 827 INTEGER ,INTENT(IN) :: jsec ! numeric identifier of section … … 834 829 TYPE(POINT_SECTION) :: k 835 830 INTEGER :: jk,jseg,jclass ! dummy variables for looping on level/segment/classes 836 REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, z fsdep ! temperature/salinity/ssh/potential density /depth at u/v point831 REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zdep ! temperature/salinity/ssh/potential density /depth at u/v point 837 832 !!------------------------------------------------------------- 838 833 … … 903 898 END SELECT 904 899 905 z fsdep= fsdept(k%I,k%J,jk)900 zdep= gdept_n(k%I,k%J,jk) 906 901 907 902 !------------------------------- … … 932 927 ( sec%ztem(jclass) .EQ.99.)) .AND. & 933 928 934 ((( z fsdep .GE. sec%zlay(jclass)) .AND. &935 ( z fsdep .LE. sec%zlay(jclass+1))) .OR. &929 ((( zdep .GE. sec%zlay(jclass)) .AND. & 930 ( zdep .LE. sec%zlay(jclass+1))) .OR. & 936 931 ( sec%zlay(jclass) .EQ. 99. )) & 937 932 )) THEN … … 1144 1139 1145 1140 CALL wrk_dealloc(nb_type_class , zsumclasses ) 1141 ! 1146 1142 END SUBROUTINE dia_dct_wri 1143 1147 1144 1148 1145 FUNCTION interp(ki, kj, kk, cd_point, ptab) … … 1214 1211 !*local declations 1215 1212 INTEGER :: ii1, ij1, ii2, ij2 ! local integer 1216 REAL(wp):: ze3t, z fse3, zwgt1, zwgt2, zbis, zdepu ! local real1213 REAL(wp):: ze3t, ze3, zwgt1, zwgt2, zbis, zdepu ! local real 1217 1214 REAL(wp):: zet1, zet2 ! weight for interpolation 1218 1215 REAL(wp):: zdep1,zdep2 ! differences of depth … … 1241 1238 IF( ln_sco )THEN ! s-coordinate case 1242 1239 1243 zdepu = ( fsdept(ii1,ij1,kk) + fsdept(ii2,ij2,kk) ) /21244 zdep1 = fsdept(ii1,ij1,kk) - zdepu1245 zdep2 = fsdept(ii2,ij2,kk) - zdepu1240 zdepu = ( gdept_n(ii1,ij1,kk) + gdept_n(ii2,ij2,kk) ) * 0.5_wp 1241 zdep1 = gdept_n(ii1,ij1,kk) - zdepu 1242 zdep2 = gdept_n(ii2,ij2,kk) - zdepu 1246 1243 1247 1244 ! weights … … 1255 1252 ELSE ! full step or partial step case 1256 1253 1257 #if defined key_vvl 1258 1259 ze3t = fse3t_n(ii2,ij2,kk) - fse3t_n(ii1,ij1,kk) 1260 zwgt1 = ( fse3w_n(ii2,ij2,kk) - fse3w_n(ii1,ij1,kk) ) / fse3w_n(ii2,ij2,kk) 1261 zwgt2 = ( fse3w_n(ii1,ij1,kk) - fse3w_n(ii2,ij2,kk) ) / fse3w_n(ii1,ij1,kk) 1262 1263 #else 1264 1265 ze3t = fse3t(ii2,ij2,kk) - fse3t(ii1,ij1,kk) 1266 zwgt1 = ( fse3w(ii2,ij2,kk) - fse3w(ii1,ij1,kk) ) / fse3w(ii2,ij2,kk) 1267 zwgt2 = ( fse3w(ii1,ij1,kk) - fse3w(ii2,ij2,kk) ) / fse3w(ii1,ij1,kk) 1268 1269 #endif 1254 ze3t = e3t_n(ii2,ij2,kk) - e3t_n(ii1,ij1,kk) 1255 zwgt1 = ( e3w_n(ii2,ij2,kk) - e3w_n(ii1,ij1,kk) ) / e3w_n(ii2,ij2,kk) 1256 zwgt2 = ( e3w_n(ii1,ij1,kk) - e3w_n(ii2,ij2,kk) ) / e3w_n(ii1,ij1,kk) 1270 1257 1271 1258 IF(kk .NE. 1)THEN … … 1288 1275 1289 1276 ENDIF 1290 1291 1292 END FUNCTION interp 1277 ! 1278 END FUNCTION interp 1293 1279 1294 1280 #else -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90
r4292 r5845 24 24 REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:) :: z4dep ! vertical level (sp) 25 25 26 !! * Substitutions27 # include "domzgr_substitute.h90"28 26 !!---------------------------------------------------------------------- 29 27 !! NEMO/OPA 3.3 , NEMO Consortium (2010) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90
r5836 r5845 33 33 34 34 !! * Substitutions 35 # include "domzgr_substitute.h90"36 35 # include "vectopt_loop_substitute.h90" 37 36 !!---------------------------------------------------------------------- … … 40 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 41 40 !!---------------------------------------------------------------------- 42 43 41 CONTAINS 44 42 … … 80 78 DO jj = 2, jpjm1 81 79 DO ji = fs_2, fs_jpim1 ! vector opt. 82 zwei = e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)80 zwei = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 83 81 a_salb = a_salb + ( tsb(ji,jj,jk,jp_sal) - zsm0 ) * zwei 84 82 END DO … … 106 104 DO jj = 2, jpjm1 107 105 DO ji = fs_2, fs_jpim1 ! vector opt. 108 zwei = e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)106 zwei = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 109 107 a_saln = a_saln + ( tsn(ji,jj,jk,jp_sal) - zsm0 ) * zwei 110 108 zvol = zvol + zwei … … 186 184 zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 187 185 zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 188 zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)186 zu = un(ji,jj,jk) * e3t_n(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj) 189 187 190 188 IF( un(ji,jj,jk) > 0.e0 ) THEN … … 238 236 zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 239 237 zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 240 zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)238 zu = un(ji,jj,jk) * e3t_n(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj) 241 239 242 240 IF( un(ji,jj,jk) > 0.e0 ) THEN … … 290 288 zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 291 289 zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 292 zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)290 zu = un(ji,jj,jk) * e3t_n(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj) 293 291 294 292 IF( un(ji,jj,jk) > 0.e0 ) THEN … … 342 340 zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 343 341 zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 344 zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)342 zu = un(ji,jj,jk) * e3t_n(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj) 345 343 346 344 IF( un(ji,jj,jk) > 0.e0 ) THEN -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r5643 r5845 51 51 52 52 !! * Substitutions 53 # include "domzgr_substitute.h90"54 53 # include "vectopt_loop_substitute.h90" 55 54 !!---------------------------------------------------------------------- … … 165 164 ! volume variation (calculated with scale factors) 166 165 zdiff_v2 = zdiff_v2 + glob_sum( surf(:,:) * tmask(:,:,jk) & 167 & * ( fse3t_n(:,:,jk) - e3t_ini(:,:,jk) ) )166 & * ( e3t_n(:,:,jk) - e3t_ini(:,:,jk) ) ) 168 167 ! heat content variation 169 168 zdiff_hc = zdiff_hc + glob_sum( surf(:,:) * tmask(:,:,jk) & 170 & * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) - hc_loc_ini(:,:,jk) ) )169 & * ( e3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) - hc_loc_ini(:,:,jk) ) ) 171 170 ! salt content variation 172 171 zdiff_sc = zdiff_sc + glob_sum( surf(:,:) * tmask(:,:,jk) & 173 & * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) - sc_loc_ini(:,:,jk) ) )172 & * ( e3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) - sc_loc_ini(:,:,jk) ) ) 174 173 ENDDO 175 174 … … 191 190 zvol_tot = 0._wp ! total ocean volume (calculated with scale factors) 192 191 DO jk = 1, jpkm1 193 zvol_tot = zvol_tot + glob_sum( surf(:,:) * tmask(:,:,jk) * fse3t_n(:,:,jk) )192 zvol_tot = zvol_tot + glob_sum( surf(:,:) * tmask(:,:,jk) * e3t_n(:,:,jk) ) 194 193 END DO 195 194 … … 275 274 ssh_ini(:,:) = sshn(:,:) ! initial ssh 276 275 DO jk = 1, jpk 277 e3t_ini (:,:,jk) = fse3t_n(:,:,jk) ! initial vertical scale factors278 hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * fse3t_n(:,:,jk) ! initial heat content279 sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * fse3t_n(:,:,jk) ! initial salt content276 e3t_ini (:,:,jk) = e3t_n(:,:,jk) ! initial vertical scale factors 277 hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) ! initial heat content 278 sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) ! initial salt content 280 279 END DO 281 280 frc_v = 0._wp ! volume trend due to forcing -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
r5836 r5845 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) … … 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)) ) … … 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) ) &325 htc3(ji,jj) = htc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem) * MIN( e3t_n(ji,jj,ilevel+1), zthick(ji,jj) ) & 326 326 * tmask(ji,jj,ilevel+1) 327 327 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r5147 r5845 59 59 REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:) :: p_fval2d 60 60 61 62 61 !! * Substitutions 63 # include "domzgr_substitute.h90"64 62 # include "vectopt_loop_substitute.h90" 65 63 !!---------------------------------------------------------------------- … … 118 116 DO jj = 1, jpj 119 117 DO ji = 1, jpi 120 zsfc = e1t(ji,jj) * fse3t(ji,jj,jk)118 zsfc = e1t(ji,jj) * e3t_n(ji,jj,jk) 121 119 zmask(ji,jj,jk) = tmask(ji,jj,jk) * zsfc 122 120 zts(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * zsfc -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r5836 r5845 30 30 USE zdf_oce ! ocean vertical physics 31 31 USE ldftra ! lateral physics: eddy diffusivity coef. 32 USE ldfdyn ! lateral physics: eddy viscosity coef. 32 33 USE sol_oce ! solver variables 33 34 USE sbc_oce ! Surface boundary condition: ocean fields … … 41 42 USE zdfddm ! vertical physics: double diffusion 42 43 USE diahth ! thermocline diagnostics 44 ! 43 45 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 44 46 USE in_out_manager ! I/O manager … … 76 78 !! * Substitutions 77 79 # include "zdfddm_substitute.h90" 78 # include "domzgr_substitute.h90"79 80 # include "vectopt_loop_substitute.h90" 80 81 !!---------------------------------------------------------------------- … … 146 147 147 148 IF( .NOT.lk_vvl ) THEN 148 CALL iom_put( "e3t" , fse3t_n(:,:,:) )149 CALL iom_put( "e3u" , fse3u_n(:,:,:) )150 CALL iom_put( "e3v" , fse3v_n(:,:,:) )151 CALL iom_put( "e3w" , fse3w_n(:,:,:) )149 CALL iom_put( "e3t" , e3t_n(:,:,:) ) 150 CALL iom_put( "e3u" , e3u_n(:,:,:) ) 151 CALL iom_put( "e3v" , e3v_n(:,:,:) ) 152 CALL iom_put( "e3w" , e3w_n(:,:,:) ) 152 153 ENDIF 153 154 … … 266 267 DO jj = 1, jpj 267 268 DO ji = 1, jpi 268 z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)269 z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 269 270 END DO 270 271 END DO … … 278 279 DO jj = 1, jpj 279 280 DO ji = 1, jpi 280 z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)281 z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 281 282 END DO 282 283 END DO … … 290 291 DO jj = 2, jpjm1 291 292 DO ji = fs_2, fs_jpim1 ! vector opt. 292 zztmp = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )293 zztmpx = 0.5 * ( un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) &294 & + un(ji ,jj,jk) * un(ji ,jj,jk) * e2u(ji ,jj) * fse3u(ji ,jj,jk) ) &293 zztmp = 1._wp / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 294 zztmpx = 0.5 * ( un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) & 295 & + un(ji ,jj,jk) * un(ji ,jj,jk) * e2u(ji ,jj) * e3u_n(ji ,jj,jk) ) & 295 296 & * zztmp 296 297 ! 297 zztmpy = 0.5 * ( vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) &298 & + vn(ji,jj ,jk) * vn(ji,jj ,jk) * e1v(ji,jj ) * fse3v(ji,jj ,jk) ) &298 zztmpy = 0.5 * ( vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) & 299 & + vn(ji,jj ,jk) * vn(ji,jj ,jk) * e1v(ji,jj ) * e3v_n(ji,jj ,jk) ) & 299 300 & * zztmp 300 301 ! … … 311 312 z3d(:,:,jpk) = 0.e0 312 313 DO jk = 1, jpkm1 313 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk)314 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk) 314 315 END DO 315 316 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction … … 346 347 z3d(:,:,jpk) = 0.e0 347 348 DO jk = 1, jpkm1 348 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk)349 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk) 349 350 END DO 350 351 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction … … 730 731 731 732 IF( lk_vvl ) THEN 732 CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) * fse3t_n(:,:,:) , ndim_T , ndex_T ) ! heat content733 CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) * fse3t_n(:,:,:) , ndim_T , ndex_T ) ! salt content734 CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) * fse3t_n(:,:,1) , ndim_hT, ndex_hT ) ! sea surface heat content735 CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) * fse3t_n(:,:,1) , ndim_hT, ndex_hT ) ! sea surface salinity content733 CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) * e3t_n(:,:,:) , ndim_T , ndex_T ) ! heat content 734 CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) * e3t_n(:,:,:) , ndim_T , ndex_T ) ! salt content 735 CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) * e3t_n(:,:,1) , ndim_hT, ndex_hT ) ! sea surface heat content 736 CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) * e3t_n(:,:,1) , ndim_hT, ndex_hT ) ! sea surface salinity content 736 737 ELSE 737 738 CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) , ndim_T , ndex_T ) ! temperature … … 741 742 ENDIF 742 743 IF( lk_vvl ) THEN 743 zw3d(:,:,:) = ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2744 CALL histwrite( nid_T, "vovvle3t", it, fse3t_n (:,:,:) , ndim_T , ndex_T ) ! level thickness745 CALL histwrite( nid_T, "vovvldep", it, fsdept_n(:,:,:) , ndim_T , ndex_T ) ! t-point depth744 zw3d(:,:,:) = ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 745 CALL histwrite( nid_T, "vovvle3t", it, e3t_n (:,:,:) , ndim_T , ndex_T ) ! level thickness 746 CALL histwrite( nid_T, "vovvldep", it, gdept_n(:,:,:) , ndim_T , ndex_T ) ! t-point depth 746 747 CALL histwrite( nid_T, "vovvldef", it, zw3d , ndim_T , ndex_T ) ! level thickness deformation 747 748 ENDIF … … 913 914 CALL histdef( id_i, "vovecrtz", "Vertical Velocity" , "m/s" , & ! vertical current 914 915 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 916 ! 917 CALL histdef( id_i, "ahtu" , "u-eddy diffusivity" , "m2/s" , & ! zonal current 918 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 919 CALL histdef( id_i, "ahtv" , "v-eddy diffusivity" , "m2/s" , & ! meridonal current 920 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 921 CALL histdef( id_i, "ahmt" , "t-eddy viscosity" , "m2/s" , & ! zonal current 922 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 923 CALL histdef( id_i, "ahmf" , "f-eddy viscosity" , "m2/s" , & ! meridonal current 924 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 925 ! 915 926 CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S", & ! net freshwater 916 927 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) … … 952 963 CALL histwrite( id_i, "vomecrty", kt, vn , jpi*jpj*jpk, idex ) ! now j-velocity 953 964 CALL histwrite( id_i, "vovecrtz", kt, wn , jpi*jpj*jpk, idex ) ! now k-velocity 965 ! 966 CALL histwrite( id_i, "ahtu" , kt, ahtu , jpi*jpj*jpk, idex ) ! aht at u-point 967 CALL histwrite( id_i, "ahtv" , kt, ahtv , jpi*jpj*jpk, idex ) ! - at v-point 968 CALL histwrite( id_i, "ahmt" , kt, ahmt , jpi*jpj*jpk, idex ) ! ahm at t-point 969 CALL histwrite( id_i, "ahmf" , kt, ahmf , jpi*jpj*jpk, idex ) ! - at f-point 970 ! 954 971 CALL histwrite( id_i, "sowaflup", kt, emp-rnf , jpi*jpj , idex ) ! freshwater budget 955 972 CALL histwrite( id_i, "sohefldo", kt, qsr + qns , jpi*jpj , idex ) ! total heat flux … … 972 989 ! 973 990 END SUBROUTINE dia_wri_state 991 974 992 !!====================================================================== 975 993 END MODULE diawri -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r5836 r5845 11 11 !! to the optimization of BDY communications 12 12 !! 3.7 ! 2015-11 (G. Madec) introduce surface and scale factor ratio 13 !! - ! 2015-11 (G. Madec, A. Coward) time varying zgr by default 13 14 !!---------------------------------------------------------------------- 14 15 … … 178 179 LOGICAL, PUBLIC :: ln_isfcav !: presence of ISF 179 180 180 !! All coordinates 181 !! --------------- 182 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdep3w_0 !: depth of t-points (sum of e3w) (m) 183 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_0, gdepw_0 !: analytical (time invariant) depth at t-w points (m) 184 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3v_0 , e3f_0 !: analytical (time invariant) vertical scale factors at v-f 185 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_0 , e3u_0 !: t-u points (m) 186 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw_0 !: analytical (time invariant) vertical scale factors at vw 187 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3w_0 , e3uw_0 !: w-uw points (m) 181 !!gm 188 182 #if defined key_vvl 189 183 LOGICAL, PUBLIC, PARAMETER :: lk_vvl = .TRUE. !: variable grid flag 190 191 !! All coordinates192 !! ---------------193 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdep3w_n !: now depth of T-points (sum of e3w) (m)194 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_n, gdepw_n !: now depth at T-W points (m)195 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_b, gdepw_b !: before depth at T-W points (m)196 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_n !: now vertical scale factors at t point (m)197 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3u_n , e3v_n !: - - - - u --v points (m)198 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3w_n , e3f_n !: - - - - w --f points (m)199 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3uw_n , e3vw_n !: - - - - uw--vw points (m)200 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_b !: before - - - - t points (m)201 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3w_b !: before - - - - t points (m)202 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3u_b , e3v_b !: - - - - - u --v points (m)203 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3uw_b , e3vw_b !: - - - - - uw--vw points (m)204 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_a !: after - - - - t point (m)205 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3u_a , e3v_a !: - - - - - u --v points (m)206 184 #else 207 LOGICAL, PUBLIC, PARAMETER :: lk_vvl = .FALSE. !: fixedgrid flag185 LOGICAL, PUBLIC, PARAMETER :: lk_vvl = .FALSE. !: variable grid flag 208 186 #endif 209 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hur , hvr !: Now inverse of u and v-points ocean depth (1/m) 210 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu , hv !: depth at u- and v-points (meters) 211 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht !: depth at t-points (meters) 212 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ehur_a, ehvr_a !: After inverse of u and v-points ocean depth (1/m) 213 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ehu_a , ehv_a !: depth at u- and v-points (meters) 214 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ehur_b, ehvr_b !: Before inverse of u and v-points ocean depth (1/m) 215 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ehu_b , ehv_b !: depth at u- and v-points (meters) 216 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_0 !: reference depth at t- points (meters) 217 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0 , hv_0 !: reference depth at u- and v-points (meters) 187 !!gm 188 189 ! ! ref. ! before ! now ! after ! 190 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_0 , e3t_b , e3t_n , e3t_a !: t- vert. scale factor [m] 191 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3u_0 , e3u_b , e3u_n , e3u_a !: u- vert. scale factor [m] 192 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3v_0 , e3v_b , e3v_n , e3v_a !: v- vert. scale factor [m] 193 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3f_0 , e3f_n !: f- vert. scale factor [m] 194 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3w_0 , e3w_b , e3w_n !: w- vert. scale factor [m] 195 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3uw_0 , e3uw_b , e3uw_n !: uw-vert. scale factor [m] 196 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw_0 , e3vw_b , e3vw_n !: vw-vert. scale factor [m] 197 198 ! ! ref. ! before ! now ! 199 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_0 , gdept_b , gdept_n !: t- depth [m] 200 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdepw_0 , gdepw_b , gdepw_n !: w- depth [m] 201 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w_0 , gde3w_n !: w- depth (sum of e3w) [m] 202 203 ! ! ref. ! before ! now ! after ! 204 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_0 , ht_n , ht_a !: t-depth [m] 205 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0 , hu_b , hu_n , hu_a !: u-depth [m] 206 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hv_0 , hv_b , hv_n , hv_a !: u-depth [m] 207 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r1_hu_b , r1_hu_n , r1_hu_a !: inverse of u-depth [1/m] 208 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r1_hv_b , r1_hv_n , r1_hv_a !: inverse of v-depth [1/m] 209 218 210 219 211 INTEGER, PUBLIC :: nla10 !: deepest W level Above ~10m (nlb10 - 1) 220 212 INTEGER, PUBLIC :: nlb10 !: shallowest W level Bellow ~10m (nla10 + 1) 221 213 222 !! z-coordinate with full steps (also used in the other cases as reference z-coordinate)214 !! 1D reference vertical coordinate 223 215 !! =-----------------====------ 224 216 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: gdept_1d, gdepw_1d !: reference depth of t- and w-points (m) … … 347 339 & ff (jpi,jpj) , STAT=ierr(3) ) 348 340 ! 349 ALLOCATE( gdep3w_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0 (jpi,jpj,jpk) , & 350 & gdept_0 (jpi,jpj,jpk) , e3t_0(jpi,jpj,jpk) , e3u_0 (jpi,jpj,jpk) , & 351 & gdepw_0 (jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , e3uw_0(jpi,jpj,jpk) , STAT=ierr(4) ) 352 ! 353 #if defined key_vvl 354 ALLOCATE( gdep3w_n(jpi,jpj,jpk) , e3t_n (jpi,jpj,jpk) , e3u_n (jpi,jpj,jpk) , & 355 & gdept_n (jpi,jpj,jpk) , e3v_n (jpi,jpj,jpk) , e3w_n (jpi,jpj,jpk) , & 356 & gdepw_n (jpi,jpj,jpk) , e3f_n (jpi,jpj,jpk) , e3vw_n(jpi,jpj,jpk) , e3uw_n(jpi,jpj,jpk) , & 357 & e3t_b (jpi,jpj,jpk) , e3u_b (jpi,jpj,jpk) , e3v_b (jpi,jpj,jpk) , & 358 & e3uw_b (jpi,jpj,jpk) , e3vw_b(jpi,jpj,jpk) , & 359 & gdept_b (jpi,jpj,jpk) ,gdepw_b(jpi,jpj,jpk) , e3w_b (jpi,jpj,jpk) , & 360 & e3t_a (jpi,jpj,jpk) , e3u_a (jpi,jpj,jpk) , e3v_a (jpi,jpj,jpk) , & 361 & ehu_a (jpi,jpj) , ehv_a (jpi,jpj), & 362 & ehur_a (jpi,jpj) , ehvr_a(jpi,jpj), & 363 & ehu_b (jpi,jpj) , ehv_b (jpi,jpj), & 364 & ehur_b (jpi,jpj) , ehvr_b(jpi,jpj), STAT=ierr(5) ) 365 #endif 366 ! 367 ALLOCATE( hu(jpi,jpj) , hur(jpi,jpj) , hu_0(jpi,jpj) , ht_0(jpi,jpj) , & 368 & hv(jpi,jpj) , hvr(jpi,jpj) , hv_0(jpi,jpj) , ht (jpi,jpj) , STAT=ierr(6) ) 341 ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , gde3w_0(jpi,jpj,jpk) , & 342 & gdept_b(jpi,jpj,jpk) , gdepw_b(jpi,jpj,jpk) , & 343 & gdept_n(jpi,jpj,jpk) , gdepw_n(jpi,jpj,jpk) , gde3w_n(jpi,jpj,jpk) , STAT=ierr(4) ) 344 ! 345 ALLOCATE( e3t_0(jpi,jpj,jpk) , e3u_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0(jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) , & 346 & e3t_b(jpi,jpj,jpk) , e3u_b(jpi,jpj,jpk) , e3v_b(jpi,jpj,jpk) , e3w_b(jpi,jpj,jpk) , & & 347 & e3t_n(jpi,jpj,jpk) , e3u_n(jpi,jpj,jpk) , e3v_n(jpi,jpj,jpk) , e3f_n(jpi,jpj,jpk) , e3w_n(jpi,jpj,jpk) , & & 348 & e3t_a(jpi,jpj,jpk) , e3u_a(jpi,jpj,jpk) , e3v_a(jpi,jpj,jpk) , & 349 ! ! 350 & e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , & 351 & e3uw_b(jpi,jpj,jpk) , e3vw_b(jpi,jpj,jpk) , & 352 & e3uw_n(jpi,jpj,jpk) , e3vw_n(jpi,jpj,jpk) , STAT=ierr(5) ) 353 ! 354 ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj) , hv_0(jpi,jpj) , & 355 & hu_b(jpi,jpj) , hv_b(jpi,jpj) , r1_hu_b(jpi,jpj) , r1_hv_b(jpi,jpj) , & 356 & ht_n(jpi,jpj) , hu_n(jpi,jpj) , hv_n(jpi,jpj) , r1_hu_n(jpi,jpj) , r1_hv_n(jpi,jpj) , & 357 & ht_a(jpi,jpj) , hu_a(jpi,jpj) , hv_a(jpi,jpj) , r1_hu_a(jpi,jpj) , r1_hv_a(jpi,jpj) , STAT=ierr(6) ) 358 ! 369 359 ! 370 360 ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) , & … … 400 390 !!====================================================================== 401 391 END MODULE dom_oce 402 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r5836 r5845 13 13 !! 3.3 ! 2010-11 (G. Madec) initialisation in C1D configuration 14 14 !! 3.6 ! 2013 ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs 15 !! - ! 2015-11 (G. Madec, A. Coward) time varying zgr by default 15 16 !!---------------------------------------------------------------------- 16 17 … … 36 37 ! 37 38 USE in_out_manager ! I/O manager 39 USE wrk_nemo ! Memory Allocation 38 40 USE lib_mpp ! distributed memory computing library 39 41 USE lbclnk ! ocean lateral boundary condition (or mpp link) … … 45 47 PUBLIC dom_init ! called by opa.F90 46 48 47 !! * Substitutions48 # include "domzgr_substitute.h90"49 49 !!------------------------------------------------------------------------- 50 50 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 72 72 INTEGER :: jk ! dummy loop argument 73 73 INTEGER :: iconf = 0 ! local integers 74 REAL(wp), POINTER, DIMENSION(:,:) :: z1_hu_0, z1_hv_0 74 75 !!---------------------------------------------------------------------- 75 76 ! … … 82 83 ENDIF 83 84 ! 84 CALL dom_nam ! read namelist ( namrun, namdom ) 85 CALL dom_clo ! Closed seas and lake 86 CALL dom_hgr ! Horizontal mesh 87 CALL dom_zgr ! Vertical mesh and bathymetry 88 CALL dom_msk ! Masks 89 IF( ln_sco ) CALL dom_stiff ! Maximum stiffness ratio/hydrostatic consistency 90 ! 91 ht_0(:,:) = 0._wp ! Reference ocean depth at T-points 92 hu_0(:,:) = 0._wp ! Reference ocean depth at U-points 93 hv_0(:,:) = 0._wp ! Reference ocean depth at V-points 94 DO jk = 1, jpk 85 ! !== Reference coordinate system ==! 86 ! 87 CALL dom_nam ! read namelist ( namrun, namdom ) 88 CALL dom_clo ! Closed seas and lake 89 CALL dom_hgr ! Horizontal mesh 90 CALL dom_zgr ! Vertical mesh and bathymetry 91 CALL dom_msk ! Masks 92 IF( ln_sco ) CALL dom_stiff ! Maximum stiffness ratio/hydrostatic consistency 93 ! 94 ht_0(:,:) = e3t_0(:,:,1) * tmask(:,:,1) ! Reference ocean thickness 95 hu_0(:,:) = e3u_0(:,:,1) * tmask(:,:,1) 96 hv_0(:,:) = e3v_0(:,:,1) * vmask(:,:,1) 97 DO jk = 2, jpk 95 98 ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) 96 99 hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk) … … 98 101 END DO 99 102 ! 100 IF( lk_vvl ) CALL dom_vvl_init ! Vertical variable mesh 101 ! 102 IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point 103 ! 104 ! 105 hu(:,:) = 0._wp ! Ocean depth at U-points 106 hv(:,:) = 0._wp ! Ocean depth at V-points 107 ht(:,:) = 0._wp ! Ocean depth at T-points 108 DO jk = 1, jpkm1 109 hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 110 hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 111 ht(:,:) = ht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 112 END DO 113 ! ! Inverse of the local depth 114 hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:) 115 hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 116 117 CALL dom_stp ! time step 118 IF( nmsh /= 0 ) CALL dom_wri ! Create a domain file 119 IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control 103 ! !== time varying part of coordinate system ==! 104 ! 105 IF( lk_vvl ) THEN ! time varying : initialize before/now/after variables 106 CALL dom_vvl_init 107 ! 108 ELSE ! Fix in time : set to the reference one for all 109 ! before ! now ! after ! 110 gdept_b = gdept_0 ; gdept_n = gdept_0 ! --- ! depth of grid-points 111 gdepw_b = gdepw_0 ; gdepw_n = gdepw_0 ! --- ! 112 gde3w_n = gde3w_0 ! --- ! 113 ! 114 e3t_b = e3t_0 ; e3t_n = e3t_0 ; e3t_a = e3t_0 ! scale factors 115 e3u_b = e3u_0 ; e3u_n = e3u_0 ; e3u_a = e3u_0 ! 116 e3v_b = e3v_0 ; e3v_n = e3u_0 ; e3v_a = e3v_0 ! 117 ; e3f_n = e3f_0 ! --- ! 118 e3w_b = e3w_0 ; e3w_n = e3w_0 ! --- ! 119 e3uw_b = e3uw_0 ; e3uw_n = e3uw_0 ! --- ! 120 e3vw_b = e3vw_0 ; e3vw_n = e3vw_0 ! --- ! 121 ! 122 ! ! 123 CALL wrk_alloc( jpi,jpj, z1_hu_0, z1_hv_0 ) 124 ! 125 z1_hu_0(:,:) = 1._wp / ( hu_0(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:) ! _i mask due to ISF 126 z1_hv_0(:,:) = 1._wp / ( hv_0(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 127 ! 128 ! before ! now ! after ! 129 ; ; ht_n = hu_0 ; ht_a = hu_0 ! water column thickness 130 ; hu_b = hu_0 ; hu_n = hu_0 ; hu_a = hu_0 ! 131 ; hv_b = hv_0 ; hv_n = hv_0 ; hv_a = hv_0 ! 132 ; r1_hu_b = z1_hu_0 ; r1_hu_n = z1_hu_0 ; r1_hu_a = z1_hu_0 ! inverse of water column thickness 133 ; r1_hv_b = z1_hv_0 ; r1_hv_n = z1_hv_0 ; r1_hv_a = z1_hv_0 ! 134 ! 135 CALL wrk_dealloc( jpi,jpj, z1_hu_0, z1_hv_0 ) 136 ENDIF 137 ! 138 IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point 139 ! 140 CALL dom_stp ! time step 141 IF( nmsh /= 0 ) CALL dom_wri ! Create a domain file 142 IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control 120 143 ! 121 144 IF( nn_timing == 1 ) CALL timing_stop('dom_init') … … 412 435 DO jj = 2, jpjm1 413 436 DO jk = 1, jpkm1 414 zr1(1) = umask(ji-1,jj ,jk) *abs( (gdepw_0(ji ,jj ,jk )-gdepw_0(ji-1,jj ,jk )&415 & +gdepw_0(ji ,jj ,jk+1)-gdepw_0(ji-1,jj ,jk+1))&416 & /(gdepw_0(ji ,jj ,jk )+gdepw_0(ji-1,jj ,jk )&417 & -gdepw_0(ji ,jj ,jk+1)-gdepw_0(ji-1,jj ,jk+1) + rsmall))418 zr1(2) = umask(ji ,jj ,jk) *abs( (gdepw_0(ji+1,jj ,jk )-gdepw_0(ji ,jj ,jk )&419 & +gdepw_0(ji+1,jj ,jk+1)-gdepw_0(ji ,jj ,jk+1))&420 & /(gdepw_0(ji+1,jj ,jk )+gdepw_0(ji ,jj ,jk )&421 & -gdepw_0(ji+1,jj ,jk+1)-gdepw_0(ji ,jj ,jk+1) + rsmall))422 zr1(3) = vmask(ji ,jj ,jk) *abs( (gdepw_0(ji ,jj+1,jk )-gdepw_0(ji ,jj ,jk )&423 & +gdepw_0(ji ,jj+1,jk+1)-gdepw_0(ji ,jj ,jk+1))&424 & /(gdepw_0(ji ,jj+1,jk )+gdepw_0(ji ,jj ,jk )&425 & -gdepw_0(ji ,jj+1,jk+1)-gdepw_0(ji ,jj ,jk+1) + rsmall))426 zr1(4) = vmask(ji ,jj-1,jk) *abs( (gdepw_0(ji ,jj ,jk )-gdepw_0(ji ,jj-1,jk )&427 & +gdepw_0(ji ,jj ,jk+1)-gdepw_0(ji ,jj-1,jk+1))&428 & /(gdepw_0(ji ,jj ,jk )+gdepw_0(ji ,jj-1,jk )&429 & -gdepw_0(ji, jj ,jk+1)-gdepw_0(ji ,jj-1,jk+1) + rsmall))430 zrxmax = MAXVAL( zr1(1:4))431 rx1(ji,jj) = MAX( rx1(ji,jj), zrxmax)437 zr1(1) = ABS( ( gdepw_0(ji ,jj,jk )-gdepw_0(ji-1,jj,jk ) & 438 & +gdepw_0(ji ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) ) & 439 & / ( gdepw_0(ji ,jj,jk )+gdepw_0(ji-1,jj,jk ) & 440 & -gdepw_0(ji ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) + rsmall ) ) * umask(ji-1,jj,jk) 441 zr1(2) = ABS( ( gdepw_0(ji+1,jj,jk )-gdepw_0(ji ,jj,jk ) & 442 & +gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji ,jj,jk+1) ) & 443 & / ( gdepw_0(ji+1,jj,jk )+gdepw_0(ji ,jj,jk ) & 444 & -gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji ,jj,jk+1) + rsmall ) ) * umask(ji ,jj,jk) 445 zr1(3) =ABS( ( gdepw_0(ji,jj+1,jk )-gdepw_0(ji,jj ,jk ) & 446 & +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj ,jk+1) ) & 447 & / ( gdepw_0(ji,jj+1,jk )+gdepw_0(ji,jj ,jk ) & 448 & -gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj ,jk+1) + rsmall ) ) * vmask(ji,jj ,jk) 449 zr1(4) = ABS( ( gdepw_0(ji,jj ,jk )-gdepw_0(ji,jj-1,jk ) & 450 & +gdepw_0(ji,jj ,jk+1)-gdepw_0(ji,jj-1,jk+1) ) & 451 & / ( gdepw_0(ji,jj ,jk )+gdepw_0(ji,jj-1,jk ) & 452 & -gdepw_0(ji,jj ,jk+1)-gdepw_0(ji,jj-1,jk+1) + rsmall ) ) * vmask(ji,jj-1,jk) 453 zrxmax = MAXVAL( zr1(1:4) ) 454 rx1(ji,jj) = MAX( rx1(ji,jj) , zrxmax ) 432 455 END DO 433 456 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90
r4667 r5845 118 118 WRITE(numout,*) ' south-west indices jpizoom = ', jpizoom, & 119 119 & ' jpjzoom = ', jpjzoom 120 WRITE(numout,*) 121 WRITE(numout,*) ' conversion local ==> data i-index domain' 122 WRITE(numout,25) (mig(ji),ji = 1,jpi) 123 WRITE(numout,*) 124 WRITE(numout,*) ' conversion data ==> local i-index domain' 125 WRITE(numout,*) ' starting index' 126 WRITE(numout,25) (mi0(ji),ji = 1,jpidta) 127 WRITE(numout,*) ' ending index' 128 WRITE(numout,25) (mi1(ji),ji = 1,jpidta) 129 WRITE(numout,*) 130 WRITE(numout,*) ' conversion local ==> data j-index domain' 131 WRITE(numout,25) (mjg(jj),jj = 1,jpj) 132 WRITE(numout,*) 133 WRITE(numout,*) ' conversion data ==> local j-index domain' 134 WRITE(numout,*) ' starting index' 135 WRITE(numout,25) (mj0(jj),jj = 1,jpjdta) 136 WRITE(numout,*) ' ending index' 137 WRITE(numout,25) (mj1(jj),jj = 1,jpjdta) 120 IF( nn_print >= 1 ) THEN 121 WRITE(numout,*) 122 WRITE(numout,*) ' conversion local ==> data i-index domain' 123 WRITE(numout,25) (mig(ji),ji = 1,jpi) 124 WRITE(numout,*) 125 WRITE(numout,*) ' conversion data ==> local i-index domain' 126 WRITE(numout,*) ' starting index' 127 WRITE(numout,25) (mi0(ji),ji = 1,jpidta) 128 WRITE(numout,*) ' ending index' 129 WRITE(numout,25) (mi1(ji),ji = 1,jpidta) 130 WRITE(numout,*) 131 WRITE(numout,*) ' conversion local ==> data j-index domain' 132 WRITE(numout,25) (mjg(jj),jj = 1,jpj) 133 WRITE(numout,*) 134 WRITE(numout,*) ' conversion data ==> local j-index domain' 135 WRITE(numout,*) ' starting index' 136 WRITE(numout,25) (mj0(jj),jj = 1,jpjdta) 137 WRITE(numout,*) ' ending index' 138 WRITE(numout,25) (mj1(jj),jj = 1,jpjdta) 139 ENDIF 138 140 ENDIF 139 141 25 FORMAT( 100(10x,19i4,/) ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r5836 r5845 348 348 e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 349 349 350 IF( lwp .AND. .NOT.ln_rstart ) THEN ! Control print : Grid informations (if not restart)350 IF( lwp .AND. nn_print >=1 .AND. .NOT.ln_rstart ) THEN ! Control print : Grid informations (if not restart) 351 351 WRITE(numout,*) 352 352 WRITE(numout,*) ' longitude and e1 scale factors' … … 393 393 IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN ! for EEL6 configuration only 394 394 IF( .NOT. Agrif_Root() ) THEN 395 zphi0 = ppgphi0 - REAL( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 395 zphi0 = ppgphi0 - REAL( Agrif_Parent(jpjglo)/2 )*Agrif_Parent(ppe2_m) & 396 & / (ra * rad) ! CAUTIOn : split in 2 lignes for AGRIF 396 397 ENDIF 397 398 ENDIF -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r5836 r5845 400 400 ! 401 401 CALL lbc_lnk( fmask, 'F', 1._wp ) ! Lateral boundary conditions on fmask 402 402 ! 403 403 ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) 404 405 IF( nprint == 1 .AND. lwp ) THEN ! Control print406 imsk(:,:) = INT( tmask_i(:,:) )407 WRITE(numout,*) ' tmask_i : '408 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, &409 & 1, jpj, 1, 1, numout)410 WRITE (numout,*)411 WRITE (numout,*) ' dommsk: tmask for each level'412 WRITE (numout,*) ' ----------------------------'413 DO jk = 1, jpk414 imsk(:,:) = INT( tmask(:,:,jk) )415 416 WRITE(numout,*)417 WRITE(numout,*) ' level = ',jk418 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, &419 & 1, jpj, 1, 1, numout)420 END DO421 WRITE(numout,*)422 WRITE(numout,*) ' dom_msk: vmask for each level'423 WRITE(numout,*) ' -----------------------------'424 DO jk = 1, jpk425 imsk(:,:) = INT( vmask(:,:,jk) )426 WRITE(numout,*)427 WRITE(numout,*) ' level = ',jk428 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, &429 & 1, jpj, 1, 1, numout)430 END DO431 WRITE(numout,*)432 WRITE(numout,*) ' dom_msk: fmask for each level'433 WRITE(numout,*) ' -----------------------------'434 DO jk = 1, jpk435 imsk(:,:) = INT( fmask(:,:,jk) )436 WRITE(numout,*)437 WRITE(numout,*) ' level = ',jk438 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, &439 & 1, jpj, 1, 1, numout )440 END DO441 WRITE(numout,*)442 WRITE(numout,*) ' dom_msk: bmask '443 WRITE(numout,*) ' ---------------'444 WRITE(numout,*)445 imsk(:,:) = INT( bmask(:,:) )446 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, &447 & 1, jpj, 1, 1, numout )448 ENDIF449 404 ! 450 405 CALL wrk_dealloc( jpi, jpj, imsk ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90
r4292 r5845 22 22 PUBLIC dom_stp ! routine called by inidom.F90 23 23 24 !! * Substitutions25 # include "domzgr_substitute.h90"26 24 !!---------------------------------------------------------------------- 27 25 !! NEMO/OPA 3.3 , NEMO Consortium (2010) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r5836 r5845 20 20 !!---------------------------------------------------------------------- 21 21 USE oce ! ocean dynamics and tracers 22 USE phycst ! physical constant 22 23 USE dom_oce ! ocean space and time domain 23 24 USE sbc_oce ! ocean surface boundary condition 25 USE restart ! ocean restart 26 ! 24 27 USE in_out_manager ! I/O manager 25 28 USE iom ! I/O manager library 26 USE restart ! ocean restart27 29 USE lib_mpp ! distributed memory computing library 28 30 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 60 62 61 63 !! * Substitutions 62 # include "domzgr_substitute.h90"63 64 # include "vectopt_loop_substitute.h90" 64 65 !!---------------------------------------------------------------------- … … 67 68 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 68 69 !!---------------------------------------------------------------------- 69 70 70 CONTAINS 71 71 … … 81 81 IF( lk_mpp ) CALL mpp_sum ( dom_vvl_alloc ) 82 82 IF( dom_vvl_alloc /= 0 ) CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays') 83 un_td = 0. 0_wp84 vn_td = 0. 0_wp83 un_td = 0._wp 84 vn_td = 0._wp 85 85 ENDIF 86 86 IF( ln_vvl_ztilde ) THEN … … 89 89 IF( dom_vvl_alloc /= 0 ) CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays') 90 90 ENDIF 91 91 ! 92 92 END FUNCTION dom_vvl_alloc 93 93 … … 103 103 !! - interpolate scale factors 104 104 !! 105 !! ** Action : - fse3t_(n/b) and tilde_e3t_(n/b)106 !! - Regrid: fse3(u/v)_n107 !! fse3(u/v)_b108 !! fse3w_n109 !! fse3(u/v)w_b110 !! fse3(u/v)w_n111 !! fsdept_n, fsdepw_n and fsde3w_n105 !! ** Action : - e3t_(n/b) and tilde_e3t_(n/b) 106 !! - Regrid: e3(u/v)_n 107 !! e3(u/v)_b 108 !! e3w_n 109 !! e3(u/v)w_b 110 !! e3(u/v)w_n 111 !! gdept_n, gdepw_n and gde3w_n 112 112 !! - h(t/u/v)_0 113 113 !! - frq_rst_e3t and frq_rst_hdv … … 115 115 !! Reference : Leclair, M., and G. Madec, 2011, Ocean Modelling. 116 116 !!---------------------------------------------------------------------- 117 USE phycst, ONLY : rpi, rsmall, rad 118 !! * Local declarations 119 INTEGER :: ji,jj,jk 117 INTEGER :: ji, jj, jk 120 118 INTEGER :: ii0, ii1, ij0, ij1 121 119 REAL(wp):: zcoef 122 120 !!---------------------------------------------------------------------- 121 ! 123 122 IF( nn_timing == 1 ) CALL timing_start('dom_vvl_init') 124 123 ! 125 124 IF(lwp) WRITE(numout,*) 126 125 IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated' 127 126 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 128 129 ! choose vertical coordinate (z_star, z_tilde or layer) 130 ! ========================== 131 CALL dom_vvl_ctl 132 133 ! Allocate module arrays 134 ! ====================== 127 ! 128 CALL dom_vvl_ctl ! choose vertical coordinate (z_star, z_tilde or layer) 129 ! 130 ! ! Allocate module arrays 135 131 IF( dom_vvl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' ) 136 137 ! Read or initialize fse3t_(b/n), tilde_e3t_(b/n) and hdiv_lf (and e3t_a(jpk)) 138 ! ============================================================================ 132 ! 133 ! ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf 139 134 CALL dom_vvl_rst( nit000, 'READ' ) 140 fse3t_a(:,:,jpk) = e3t_0(:,:,jpk) 141 142 ! Reconstruction of all vertical scale factors at now and before time steps 143 ! ============================================================================= 144 ! Horizontal scale factor interpolations 145 ! -------------------------------------- 146 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' ) 147 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' ) 148 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' ) 149 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' ) 150 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' ) 151 ! Vertical scale factor interpolations 152 ! ------------------------------------ 153 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W' ) 154 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' ) 155 CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' ) 156 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3w_b (:,:,:), 'W' ) 157 CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' ) 158 CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' ) 159 ! t- and w- points depth 160 ! ---------------------- 161 ! set the isf depth as it is in the initial step 162 fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 163 fsdepw_n(:,:,1) = 0.0_wp 164 fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 165 fsdept_b(:,:,1) = 0.5_wp * fse3w_b(:,:,1) 166 fsdepw_b(:,:,1) = 0.0_wp 167 168 DO jk = 2, jpk 135 e3t_a(:,:,jpk) = e3t_0(:,:,jpk) ! last level always inside the sea floor set one for all 136 ! 137 ! !== Set of all other vertical scale factors ==! (now and before) 138 ! ! Horizontal interpolation of e3t 139 CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) ! from T to U 140 CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 141 CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) ! from T to V 142 CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 143 CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' ) ! from U to F 144 ! ! Vertical interpolation of e3t,u,v 145 CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W' ) ! from T to W 146 CALL dom_vvl_interpol( e3t_b(:,:,:), e3w_b (:,:,:), 'W' ) 147 CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) ! from U to UW 148 CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 149 CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) ! from V to UW 150 CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 151 ! 152 ! !== depth of t and w-point ==! (set the isf depth as it is in the initial timestep) 153 gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) ! reference to the ocean surface (used for MLD and light penetration) 154 gdepw_n(:,:,1) = 0.0_wp 155 gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) ! reference to a common level z=0 for hpg 156 gdept_b(:,:,1) = 0.5_wp * e3w_b(:,:,1) 157 gdepw_b(:,:,1) = 0.0_wp 158 DO jk = 2, jpk ! vertical sum 169 159 DO jj = 1,jpj 170 160 DO ji = 1,jpi 171 ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 172 ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 173 ! 0.5 where jk = mikt 174 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 175 fsdepw_n(ji,jj,jk) = fsdepw_n(ji,jj,jk-1) + fse3t_n(ji,jj,jk-1) 176 fsdept_n(ji,jj,jk) = zcoef * ( fsdepw_n(ji,jj,jk ) + 0.5 * fse3w_n(ji,jj,jk)) & 177 & + (1-zcoef) * ( fsdept_n(ji,jj,jk-1) + fse3w_n(ji,jj,jk)) 178 fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk) - sshn(ji,jj) 179 fsdepw_b(ji,jj,jk) = fsdepw_b(ji,jj,jk-1) + fse3t_b(ji,jj,jk-1) 180 fsdept_b(ji,jj,jk) = zcoef * ( fsdepw_b(ji,jj,jk ) + 0.5 * fse3w_b(ji,jj,jk)) & 181 & + (1-zcoef) * ( fsdept_b(ji,jj,jk-1) + fse3w_b(ji,jj,jk)) 161 ! zcoef = tmask - wmask ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 162 ! ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 163 ! ! 0.5 where jk = mikt 164 !!gm ??????? BUG ? gdept_n as well as gde3w_n does not include the thickness of ISF ?? 165 zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 166 gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 167 gdept_n(ji,jj,jk) = zcoef * ( gdepw_n(ji,jj,jk ) + 0.5 * e3w_n(ji,jj,jk)) & 168 & + (1-zcoef) * ( gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk)) 169 gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - sshn(ji,jj) 170 gdepw_b(ji,jj,jk) = gdepw_b(ji,jj,jk-1) + e3t_b(ji,jj,jk-1) 171 gdept_b(ji,jj,jk) = zcoef * ( gdepw_b(ji,jj,jk ) + 0.5 * e3w_b(ji,jj,jk)) & 172 & + (1-zcoef) * ( gdept_b(ji,jj,jk-1) + e3w_b(ji,jj,jk)) 182 173 END DO 183 174 END DO 184 175 END DO 185 186 ! Before depth and Inverse of the local depth of the water column at u- and v- points 187 ! ----------------------------------------------------------------------------------- 188 hu_b(:,:) = 0. 189 hv_b(:,:) = 0. 190 DO jk = 1, jpkm1 191 hu_b(:,:) = hu_b(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) 192 hv_b(:,:) = hv_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) 176 ! 177 ! !== thickness of the water column !! (ocean portion only) 178 ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1) !!gm BUG : this should be 1/2 * e3w(k=1) .... 179 hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1) 180 hv_b(:,:) = e3u_b(:,:,1) * vmask(:,:,1) 181 hu_n(:,:) = e3u_n(:,:,1) * umask(:,:,1) 182 hv_n(:,:) = e3v_n(:,:,1) * vmask(:,:,1) 183 DO jk = 2, jpkm1 184 ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 185 hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk) 186 hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk) 187 hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk) 188 hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk) 193 189 END DO 194 hur_b(:,:) = umask_i(:,:) / ( hu_b(:,:) + 1. - umask_i(:,:) ) 195 hvr_b(:,:) = vmask_i(:,:) / ( hv_b(:,:) + 1. - vmask_i(:,:) ) 196 197 ! Restoring frequencies for z_tilde coordinate 198 ! ============================================ 190 ! 191 ! !== inverse of water column thickness ==! (u- and v- points) 192 r1_hu_b(:,:) = umask_i(:,:) / ( hu_b(:,:) + 1._wp - umask_i(:,:) ) ! _i mask due to ISF 193 r1_hu_n(:,:) = umask_i(:,:) / ( hu_n(:,:) + 1._wp - umask_i(:,:) ) 194 r1_hv_b(:,:) = vmask_i(:,:) / ( hv_b(:,:) + 1._wp - vmask_i(:,:) ) 195 r1_hv_n(:,:) = vmask_i(:,:) / ( hv_n(:,:) + 1._wp - vmask_i(:,:) ) 196 197 ! !== z_tilde coordinate case ==! (Restoring frequencies) 199 198 IF( ln_vvl_ztilde ) THEN 200 ! Values in days provided via the namelist; use rsmall to avoid possible division by zero errors with faulty settings 201 frq_rst_e3t(:,:) = 2.0_wp * rpi / ( MAX( rn_rst_e3t , rsmall ) * 86400.0_wp ) 202 frq_rst_hdv(:,:) = 2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.0_wp ) 203 IF( ln_vvl_ztilde_as_zstar ) THEN 204 ! Ignore namelist settings and use these next two to emulate z-star using z-tilde 205 frq_rst_e3t(:,:) = 0.0_wp 206 frq_rst_hdv(:,:) = 1.0_wp / rdt 207 ENDIF 208 IF ( ln_vvl_zstar_at_eqtor ) THEN 199 !!gm : idea: add here a READ in a file of custumized restoring frequency 200 ! ! Values in days provided via the namelist 201 ! ! use rsmall to avoid possible division by zero errors with faulty settings 202 frq_rst_e3t(:,:) = 2._wp * rpi / ( MAX( rn_rst_e3t , rsmall ) * 86400.0_wp ) 203 frq_rst_hdv(:,:) = 2._wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.0_wp ) 204 ! 205 IF( ln_vvl_ztilde_as_zstar ) THEN ! z-star emulation using z-tile 206 frq_rst_e3t(:,:) = 0._wp !Ignore namelist settings 207 frq_rst_hdv(:,:) = 1._wp / rdt 208 ENDIF 209 IF ( ln_vvl_zstar_at_eqtor ) THEN ! use z-star in vicinity of the Equator 209 210 DO jj = 1, jpj 210 211 DO ji = 1, jpi 212 !!gm case |gphi| >= 6 degrees is useless initialized just above by default 211 213 IF( ABS(gphit(ji,jj)) >= 6.) THEN 212 214 ! values outside the equatorial band and transition zone (ztilde) 213 215 frq_rst_e3t(ji,jj) = 2.0_wp * rpi / ( MAX( rn_rst_e3t , rsmall ) * 86400.e0_wp ) 214 216 frq_rst_hdv(ji,jj) = 2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp ) 215 ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN 217 ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN ! Equator strip ==> z-star 216 218 ! values inside the equatorial band (ztilde as zstar) 217 219 frq_rst_e3t(ji,jj) = 0.0_wp 218 220 frq_rst_hdv(ji,jj) = 1.0_wp / rdt 219 ELSE 220 ! values in the transition band (linearly vary from ztilde to ztilde as zstar values)221 ELSE ! transition band (2.5 to 6 degrees N/S) 222 ! ! (linearly transition from z-tilde to z-star) 221 223 frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp & 222 224 & * ( 1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & … … 229 231 END DO 230 232 END DO 231 IF( cp_cfg == "orca" .AND. jp_cfg == 3 ) THEN 232 ii0 = 103 ; ii1 = 111 ! Suppress ztilde in the Foxe Basin for ORCA2233 IF( cp_cfg == "orca" .AND. jp_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 234 ii0 = 103 ; ii1 = 111 233 235 ij0 = 128 ; ij1 = 135 ; 234 236 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.0_wp … … 237 239 ENDIF 238 240 ENDIF 239 241 ! 240 242 IF( nn_timing == 1 ) CALL timing_stop('dom_vvl_init') 241 243 ! 242 244 END SUBROUTINE dom_vvl_init 243 245 … … 261 263 !! - tilde_e3t_a: after increment of vertical scale factor 262 264 !! in z_tilde case 263 !! - fse3(t/u/v)_a265 !! - e3(t/u/v)_a 264 266 !! 265 267 !! Reference : Leclair, M., and Madec, G. 2011, Ocean Modelling. … … 277 279 LOGICAL :: ll_do_bclinic ! temporary logical 278 280 !!---------------------------------------------------------------------- 281 ! 279 282 IF( nn_timing == 1 ) CALL timing_start('dom_vvl_sf_nxt') 280 CALL wrk_alloc( jpi, jpj, zht, z_scale, zwu, zwv, zhdiv ) 281 CALL wrk_alloc( jpi, jpj, jpk, ze3t ) 283 ! 284 CALL wrk_alloc( jpi,jpj,zht, z_scale, zwu, zwv, zhdiv ) 285 CALL wrk_alloc( jpi,jpj,jpk, ze3t ) 282 286 283 287 IF(kt == nit000) THEN … … 289 293 ll_do_bclinic = .TRUE. 290 294 IF( PRESENT(kcall) ) THEN 291 IF ( kcall == 2 .AND. ln_vvl_ztilde )ll_do_bclinic = .FALSE.295 IF( kcall == 2 .AND. ln_vvl_ztilde ) ll_do_bclinic = .FALSE. 292 296 ENDIF 293 297 … … 295 299 ! After acale factors at t-points ! 296 300 ! ******************************* ! 297 298 301 ! ! --------------------------------------------- ! 299 302 ! ! z_star coordinate and barotropic z-tilde part ! 300 303 ! ! --------------------------------------------- ! 301 304 ! 302 305 z_scale(:,:) = ( ssha(:,:) - sshb(:,:) ) * ssmask(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 303 306 DO jk = 1, jpkm1 304 ! formally this is the same as fse3t_a = e3t_0*(1+ssha/ht_0)305 fse3t_a(:,:,jk) = fse3t_b(:,:,jk) + fse3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk)307 ! formally this is the same as e3t_a = e3t_0*(1+ssha/ht_0) 308 e3t_a(:,:,jk) = e3t_b(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) 306 309 END DO 307 310 ! 308 311 IF( ln_vvl_ztilde .OR. ln_vvl_layer .AND. ll_do_bclinic ) THEN ! z_tilde or layer coordinate ! 309 312 ! ! ------baroclinic part------ ! … … 314 317 ! 1 - barotropic divergence 315 318 ! ------------------------- 316 zhdiv(:,:) = 0. 317 zht(:,:) = 0. 319 zhdiv(:,:) = 0._wp 320 zht(:,:) = 0._wp 318 321 DO jk = 1, jpkm1 319 zhdiv(:,:) = zhdiv(:,:) + fse3t_n(:,:,jk) * hdivn(:,:,jk)320 zht (:,:) = zht (:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk)322 zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk) 323 zht (:,:) = zht (:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 321 324 END DO 322 325 zhdiv(:,:) = zhdiv(:,:) / ( zht(:,:) + 1. - tmask_i(:,:) ) … … 325 328 ! -------------------------------------------------- 326 329 IF( ln_vvl_ztilde ) THEN 327 IF( kt .GT.nit000 ) THEN330 IF( kt > nit000 ) THEN 328 331 DO jk = 1, jpkm1 329 332 hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rdt * frq_rst_hdv(:,:) & 330 & * ( hdiv_lf(:,:,jk) - fse3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) )333 & * ( hdiv_lf(:,:,jk) - e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) ) 331 334 END DO 332 335 ENDIF 333 END 336 ENDIF 334 337 335 338 ! II - after z_tilde increments of vertical scale factors 336 339 ! ======================================================= 337 tilde_e3t_a(:,:,:) = 0. 0_wp ! tilde_e3t_a used to store tendency terms340 tilde_e3t_a(:,:,:) = 0._wp ! tilde_e3t_a used to store tendency terms 338 341 339 342 ! 1 - High frequency divergence term … … 341 344 IF( ln_vvl_ztilde ) THEN ! z_tilde case 342 345 DO jk = 1, jpkm1 343 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( fse3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) )346 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) ) 344 347 END DO 345 348 ELSE ! layer case 346 349 DO jk = 1, jpkm1 347 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - fse3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk)348 END DO 349 END 350 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk) 351 END DO 352 ENDIF 350 353 351 354 ! 2 - Restoring term (z-tilde case only) … … 355 358 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - frq_rst_e3t(:,:) * tilde_e3t_b(:,:,jk) 356 359 END DO 357 END 360 ENDIF 358 361 359 362 ! 3 - Thickness diffusion term 360 363 ! ---------------------------- 361 zwu(:,:) = 0.0_wp 362 zwv(:,:) = 0.0_wp 363 ! a - first derivative: diffusive fluxes 364 DO jk = 1, jpkm1 364 zwu(:,:) = 0._wp 365 zwv(:,:) = 0._wp 366 DO jk = 1, jpkm1 ! a - first derivative: diffusive fluxes 365 367 DO jj = 1, jpjm1 366 368 DO ji = 1, fs_jpim1 ! vector opt. … … 374 376 END DO 375 377 END DO 376 ! b - correction for last oceanic u-v points 377 DO jj = 1, jpj 378 DO jj = 1, jpj ! b - correction for last oceanic u-v points 378 379 DO ji = 1, jpi 379 380 un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) … … 381 382 END DO 382 383 END DO 383 ! c - second derivative: divergence of diffusive fluxes 384 DO jk = 1, jpkm1 384 DO jk = 1, jpkm1 ! c - second derivative: divergence of diffusive fluxes 385 385 DO jj = 2, jpjm1 386 386 DO ji = fs_2, fs_jpim1 ! vector opt. … … 391 391 END DO 392 392 END DO 393 ! d - thickness diffusion transport: boundary conditions394 ! (stored for tracer advction and continuity equation)393 ! ! d - thickness diffusion transport: boundary conditions 394 ! (stored for tracer advction and continuity equation) 395 395 CALL lbc_lnk( un_td , 'U' , -1._wp) 396 396 CALL lbc_lnk( vn_td , 'V' , -1._wp) … … 410 410 ! Maximum deformation control 411 411 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 412 ze3t(:,:,jpk) = 0. 0_wp412 ze3t(:,:,jpk) = 0._wp 413 413 DO jk = 1, jpkm1 414 414 ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) … … 462 462 z_scale(:,:) = - zht(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 463 463 DO jk = 1, jpkm1 464 dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + fse3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk)464 dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) 465 465 END DO 466 466 … … 470 470 ! ! ---baroclinic part--------- ! 471 471 DO jk = 1, jpkm1 472 fse3t_a(:,:,jk) = fse3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk)472 e3t_a(:,:,jk) = e3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk) 473 473 END DO 474 474 ENDIF … … 485 485 zht(:,:) = 0.0_wp 486 486 DO jk = 1, jpkm1 487 zht(:,:) = zht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk)487 zht(:,:) = zht(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 488 488 END DO 489 489 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshn(:,:) - zht(:,:) ) ) 490 490 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain 491 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM( fse3t_n))) =', z_tmax491 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t_n))) =', z_tmax 492 492 ! 493 493 zht(:,:) = 0.0_wp 494 494 DO jk = 1, jpkm1 495 zht(:,:) = zht(:,:) + fse3t_a(:,:,jk) * tmask(:,:,jk)495 zht(:,:) = zht(:,:) + e3t_a(:,:,jk) * tmask(:,:,jk) 496 496 END DO 497 497 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssha(:,:) - zht(:,:) ) ) 498 498 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain 499 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM( fse3t_a))) =', z_tmax499 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t_a))) =', z_tmax 500 500 ! 501 501 zht(:,:) = 0.0_wp 502 502 DO jk = 1, jpkm1 503 zht(:,:) = zht(:,:) + fse3t_b(:,:,jk) * tmask(:,:,jk)503 zht(:,:) = zht(:,:) + e3t_b(:,:,jk) * tmask(:,:,jk) 504 504 END DO 505 505 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshb(:,:) - zht(:,:) ) ) 506 506 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain 507 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM( fse3t_b))) =', z_tmax507 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM(e3t_b))) =', z_tmax 508 508 ! 509 509 z_tmax = MAXVAL( tmask(:,:,1) * ABS( sshb(:,:) ) ) … … 524 524 ! *********************************** ! 525 525 526 CALL dom_vvl_interpol( fse3t_a(:,:,:), fse3u_a(:,:,:), 'U' )527 CALL dom_vvl_interpol( fse3t_a(:,:,:), fse3v_a(:,:,:), 'V' )526 CALL dom_vvl_interpol( e3t_a(:,:,:), e3u_a(:,:,:), 'U' ) 527 CALL dom_vvl_interpol( e3t_a(:,:,:), e3v_a(:,:,:), 'V' ) 528 528 529 529 ! *********************************** ! … … 531 531 ! *********************************** ! 532 532 533 hu_a(:,:) = 0._wp ! Ocean depth at U-points534 hv_a(:,:) = 0._wp ! Ocean depth at V-points535 DO jk = 1, jpkm1536 hu_a(:,:) = hu_a(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk)537 hv_a(:,:) = hv_a(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk)533 hu_a(:,:) = e3u_a(:,:,1) * umask(:,:,1) 534 hv_a(:,:) = e3v_a(:,:,1) * vmask(:,:,1) 535 DO jk = 2, jpkm1 536 hu_a(:,:) = hu_a(:,:) + e3u_a(:,:,jk) * umask(:,:,jk) 537 hv_a(:,:) = hv_a(:,:) + e3v_a(:,:,jk) * vmask(:,:,jk) 538 538 END DO 539 539 ! ! Inverse of the local depth 540 hur_a(:,:) = 1._wp / ( hu_a(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:) 541 hvr_a(:,:) = 1._wp / ( hv_a(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 542 543 CALL wrk_dealloc( jpi, jpj, zht, z_scale, zwu, zwv, zhdiv ) 544 CALL wrk_dealloc( jpi, jpj, jpk, ze3t ) 545 540 !!gm BUG ? don't understand the use of umask_i here ..... 541 r1_hu_a(:,:) = 1._wp / ( hu_a(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:) 542 r1_hv_a(:,:) = 1._wp / ( hv_a(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 543 ! 544 CALL wrk_dealloc( jpi,jpj, zht, z_scale, zwu, zwv, zhdiv ) 545 CALL wrk_dealloc( jpi,jpj,jpk, ze3t ) 546 ! 546 547 IF( nn_timing == 1 ) CALL timing_stop('dom_vvl_sf_nxt') 547 548 ! 548 549 END SUBROUTINE dom_vvl_sf_nxt 549 550 … … 561 562 !! - recompute depths and water height fields 562 563 !! 563 !! ** Action : - fse3t_(b/n), tilde_e3t_(b/n) and fse3(u/v)_n ready for next time step564 !! ** Action : - e3t_(b/n), tilde_e3t_(b/n) and e3(u/v)_n ready for next time step 564 565 !! - Recompute: 565 !! fse3(u/v)_b566 !! fse3w_n567 !! fse3(u/v)w_b568 !! fse3(u/v)w_n569 !! fsdept_n, fsdepw_n and fsde3w_n566 !! e3(u/v)_b 567 !! e3w_n 568 !! e3(u/v)w_b 569 !! e3(u/v)w_n 570 !! gdept_n, gdepw_n and gde3w_n 570 571 !! h(u/v) and h(u/v)r 571 572 !! … … 573 574 !! Leclair, M., and G. Madec, 2011, Ocean Modelling. 574 575 !!---------------------------------------------------------------------- 575 !! * Arguments 576 INTEGER, INTENT( in ) :: kt ! time step 577 !! * Local declarations 578 INTEGER :: ji,jj,jk ! dummy loop indices 579 REAL(wp) :: zcoef 576 INTEGER, INTENT( in ) :: kt ! time step 577 ! 578 INTEGER :: ji, jj, jk ! dummy loop indices 579 REAL(wp) :: zcoef ! local scalar 580 580 !!---------------------------------------------------------------------- 581 581 … … 590 590 ! Time filter and swap of scale factors 591 591 ! ===================================== 592 ! - ML - fse3(t/u/v)_b are allready computed in dynnxt.592 ! - ML - e3(t/u/v)_b are allready computed in dynnxt. 593 593 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 594 594 IF( neuler == 0 .AND. kt == nit000 ) THEN … … 600 600 tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:) 601 601 ENDIF 602 fsdept_b(:,:,:) = fsdept_n(:,:,:)603 fsdepw_b(:,:,:) = fsdepw_n(:,:,:)604 605 fse3t_n(:,:,:) = fse3t_a(:,:,:)606 fse3u_n(:,:,:) = fse3u_a(:,:,:)607 fse3v_n(:,:,:) = fse3v_a(:,:,:)602 gdept_b(:,:,:) = gdept_n(:,:,:) 603 gdepw_b(:,:,:) = gdepw_n(:,:,:) 604 605 e3t_n(:,:,:) = e3t_a(:,:,:) 606 e3u_n(:,:,:) = e3u_a(:,:,:) 607 e3v_n(:,:,:) = e3v_a(:,:,:) 608 608 609 609 ! Compute all missing vertical scale factor and depths … … 611 611 ! Horizontal scale factor interpolations 612 612 ! -------------------------------------- 613 ! - ML - fse3u_b and fse3v_b are allready computed in dynnxt613 ! - ML - e3u_b and e3v_b are allready computed in dynnxt 614 614 ! - JC - hu_b, hv_b, hur_b, hvr_b also 615 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n (:,:,:), 'F' ) 615 616 CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' ) 617 616 618 ! Vertical scale factor interpolations 617 619 ! ------------------------------------ 618 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W' )619 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' )620 CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' )621 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3w_b (:,:,:), 'W' )622 CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' )623 CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' )620 CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W' ) 621 CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 622 CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 623 CALL dom_vvl_interpol( e3t_b(:,:,:), e3w_b (:,:,:), 'W' ) 624 CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 625 CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 624 626 ! t- and w- points depth 625 627 ! ---------------------- 626 628 ! set the isf depth as it is in the initial step 627 fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1)628 fsdepw_n(:,:,1) = 0.0_wp629 fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:)629 gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 630 gdepw_n(:,:,1) = 0.0_wp 631 gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 630 632 631 633 DO jk = 2, jpk … … 635 637 ! 1 for jk = mikt 636 638 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 637 fsdepw_n(ji,jj,jk) = fsdepw_n(ji,jj,jk-1) + fse3t_n(ji,jj,jk-1)638 fsdept_n(ji,jj,jk) = zcoef * ( fsdepw_n(ji,jj,jk ) + 0.5 * fse3w_n(ji,jj,jk)) &639 & + (1-zcoef) * ( fsdept_n(ji,jj,jk-1) + fse3w_n(ji,jj,jk))640 fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk) - sshn(ji,jj)639 gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 640 gdept_n(ji,jj,jk) = zcoef * ( gdepw_n(ji,jj,jk ) + 0.5 * e3w_n(ji,jj,jk)) & 641 & + (1-zcoef) * ( gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk)) 642 gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - sshn(ji,jj) 641 643 END DO 642 644 END DO 643 645 END DO 644 646 645 ! Local depth and Inverse of the local depth of the water column at u- and v- points646 647 ! ---------------------------------------------------------------------------------- 647 hu (:,:) = hu_a (:,:) 648 hv (:,:) = hv_a (:,:) 649 650 ! Inverse of the local depth 651 hur(:,:) = hur_a(:,:) 652 hvr(:,:) = hvr_a(:,:) 653 654 ! Local depth of the water column at t- points 655 ! -------------------------------------------- 656 ht(:,:) = 0. 657 DO jk = 1, jpkm1 658 ht(:,:) = ht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 648 hu_n(:,:) = hu_a(:,:) ; r1_hu_n(:,:) = r1_hu_a(:,:) 649 hv_n(:,:) = hv_a(:,:) ; r1_hv_n(:,:) = r1_hv_a(:,:) 650 ! 651 ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1) 652 DO jk = 2, jpkm1 653 ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 659 654 END DO 660 655 661 656 ! Write outputs 662 657 ! ============= 663 CALL iom_put( "e3t" , fse3t_n (:,:,:) )664 CALL iom_put( "e3u" , fse3u_n (:,:,:) )665 CALL iom_put( "e3v" , fse3v_n (:,:,:) )666 CALL iom_put( "e3w" , fse3w_n (:,:,:) )667 CALL iom_put( "tpt_dep" , fsde3w_n(:,:,:) )658 CALL iom_put( "e3t" , e3t_n (:,:,:) ) 659 CALL iom_put( "e3u" , e3u_n (:,:,:) ) 660 CALL iom_put( "e3v" , e3v_n (:,:,:) ) 661 CALL iom_put( "e3w" , e3w_n (:,:,:) ) 662 CALL iom_put( "tpt_dep" , gde3w_n(:,:,:) ) 668 663 IF( iom_use("e3tdef") ) & 669 CALL iom_put( "e3tdef" , ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 )664 CALL iom_put( "e3tdef" , ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 670 665 671 666 ! write restart file … … 674 669 ! 675 670 IF( nn_timing == 1 ) CALL timing_stop('dom_vvl_sf_swp') 676 671 ! 677 672 END SUBROUTINE dom_vvl_sf_swp 678 673 … … 801 796 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn ) 802 797 ! 803 id1 = iom_varid( numror, ' fse3t_b', ldstop = .FALSE. )804 id2 = iom_varid( numror, ' fse3t_n', ldstop = .FALSE. )798 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 799 id2 = iom_varid( numror, 'e3t_n', ldstop = .FALSE. ) 805 800 id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 806 801 id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) … … 810 805 ! ! --------- ! 811 806 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 812 CALL iom_get( numror, jpdom_autoglo, ' fse3t_b', fse3t_b(:,:,:) )813 CALL iom_get( numror, jpdom_autoglo, ' fse3t_n', fse3t_n(:,:,:) )807 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) ) 808 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) ) 814 809 ! needed to restart if land processor not computed 815 IF(lwp) write(numout,*) 'dom_vvl_rst : fse3t_b and fse3t_n found in restart files'810 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t_b and e3t_n found in restart files' 816 811 WHERE ( tmask(:,:,:) == 0.0_wp ) 817 fse3t_n(:,:,:) = e3t_0(:,:,:)818 fse3t_b(:,:,:) = e3t_0(:,:,:)812 e3t_n(:,:,:) = e3t_0(:,:,:) 813 e3t_b(:,:,:) = e3t_0(:,:,:) 819 814 END WHERE 820 815 IF( neuler == 0 ) THEN 821 fse3t_b(:,:,:) = fse3t_n(:,:,:)816 e3t_b(:,:,:) = e3t_n(:,:,:) 822 817 ENDIF 823 818 ELSE IF( id1 > 0 ) THEN 824 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : fse3t_n not found in restart files'825 IF(lwp) write(numout,*) ' fse3t_n set equal to fse3t_b.'819 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_n not found in restart files' 820 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 826 821 IF(lwp) write(numout,*) 'neuler is forced to 0' 827 CALL iom_get( numror, jpdom_autoglo, ' fse3t_b', fse3t_b(:,:,:) )828 fse3t_n(:,:,:) = fse3t_b(:,:,:)822 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) ) 823 e3t_n(:,:,:) = e3t_b(:,:,:) 829 824 neuler = 0 830 825 ELSE IF( id2 > 0 ) THEN 831 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : fse3t_b not found in restart files'832 IF(lwp) write(numout,*) ' fse3t_b set equal to fse3t_n.'826 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_b not found in restart files' 827 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 833 828 IF(lwp) write(numout,*) 'neuler is forced to 0' 834 CALL iom_get( numror, jpdom_autoglo, ' fse3t_n', fse3t_n(:,:,:) )835 fse3t_b(:,:,:) = fse3t_n(:,:,:)829 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) ) 830 e3t_b(:,:,:) = e3t_n(:,:,:) 836 831 neuler = 0 837 832 ELSE 838 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : fse3t_n not found in restart file'833 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_n not found in restart file' 839 834 IF(lwp) write(numout,*) 'Compute scale factor from sshn' 840 835 IF(lwp) write(numout,*) 'neuler is forced to 0' 841 DO jk =1,jpk842 fse3t_n(:,:,jk) = e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) &843 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)&844 & + e3t_0(:,:,jk)* (1._wp -tmask(:,:,jk))836 DO jk = 1, jpk 837 e3t_n(:,:,jk) = e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) & 838 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 839 & + e3t_0(:,:,jk) * (1._wp -tmask(:,:,jk)) 845 840 END DO 846 fse3t_b(:,:,:) = fse3t_n(:,:,:)841 e3t_b(:,:,:) = e3t_n(:,:,:) 847 842 neuler = 0 848 843 ENDIF … … 875 870 ! 876 871 ELSE !* Initialize at "rest" 877 fse3t_b(:,:,:) = e3t_0(:,:,:)878 fse3t_n(:,:,:) = e3t_0(:,:,:)872 e3t_b(:,:,:) = e3t_0(:,:,:) 873 e3t_n(:,:,:) = e3t_0(:,:,:) 879 874 sshn(:,:) = 0.0_wp 880 875 IF( ln_vvl_ztilde .OR. ln_vvl_layer) THEN … … 891 886 ! ! all cases ! 892 887 ! ! --------- ! 893 CALL iom_rstput( kt, nitrst, numrow, ' fse3t_b', fse3t_b(:,:,:) )894 CALL iom_rstput( kt, nitrst, numrow, ' fse3t_n', fse3t_n(:,:,:) )888 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t_b(:,:,:) ) 889 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:) ) 895 890 ! ! ----------------------- ! 896 891 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r5836 r5845 2 2 !!============================================================================== 3 3 !! *** MODULE domzgr *** 4 !! Ocean initialization : domain initialization4 !! Ocean domain : definition of the vertical coordinate system 5 5 !!============================================================================== 6 6 !! History : OPA ! 1995-12 (G. Madec) Original code : s vertical coordinate … … 38 38 USE closea ! closed seas 39 39 USE c1d ! 1D vertical configuration 40 ! 40 41 USE in_out_manager ! I/O manager 41 42 USE iom ! I/O library … … 73 74 74 75 !! * Substitutions 75 # include "domzgr_substitute.h90"76 76 # include "vectopt_loop_substitute.h90" 77 77 !!---------------------------------------------------------------------- … … 157 157 WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) 158 158 WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ), & 159 & ' w ', MINVAL( gdepw_0(:,:,:) ), '3w ', MINVAL( gde p3w_0(:,:,:) )159 & ' w ', MINVAL( gdepw_0(:,:,:) ), '3w ', MINVAL( gde3w_0(:,:,:) ) 160 160 WRITE(numout,*) ' MIN val e3 t ', MINVAL( e3t_0(:,:,:) ), ' f ', MINVAL( e3f_0(:,:,:) ), & 161 161 & ' u ', MINVAL( e3u_0(:,:,:) ), ' u ', MINVAL( e3v_0(:,:,:) ), & … … 164 164 165 165 WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ), & 166 & ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w ', MAXVAL( gde p3w_0(:,:,:) )166 & ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w ', MAXVAL( gde3w_0(:,:,:) ) 167 167 WRITE(numout,*) ' MAX val e3 t ', MAXVAL( e3t_0(:,:,:) ), ' f ', MAXVAL( e3f_0(:,:,:) ), & 168 168 & ' u ', MAXVAL( e3u_0(:,:,:) ), ' u ', MAXVAL( e3v_0(:,:,:) ), & … … 674 674 !! - update bathy : meter bathymetry (in meters) 675 675 !!---------------------------------------------------------------------- 676 !!677 676 INTEGER :: ji, jj, jl ! dummy loop indices 678 677 INTEGER :: icompt, ibtest, ikmax ! temporary integers 679 678 REAL(wp), POINTER, DIMENSION(:,:) :: zbathy 680 681 679 !!---------------------------------------------------------------------- 682 680 ! … … 775 773 IF(lwp) WRITE(numout,*) ' you can decrease jpk to ', ikmax+1 776 774 ENDIF 777 778 IF( lwp .AND. nprint == 1 ) THEN ! control print779 WRITE(numout,*)780 WRITE(numout,*) ' bathymetric field : number of non-zero T-levels '781 WRITE(numout,*) ' ------------------'782 CALL prihin( mbathy, jpi, jpj, 1, jpi, 1, 1, jpj, 1, 3, numout )783 WRITE(numout,*)784 ENDIF785 775 ! 786 776 CALL wrk_dealloc( jpi, jpj, zbathy ) … … 803 793 !! (min value = 1 over land) 804 794 !!---------------------------------------------------------------------- 805 !!806 795 INTEGER :: ji, jj ! dummy loop indices 807 796 REAL(wp), POINTER, DIMENSION(:,:) :: zmbk … … 835 824 END SUBROUTINE zgr_bot_level 836 825 837 SUBROUTINE zgr_top_level 826 827 SUBROUTINE zgr_top_level 838 828 !!---------------------------------------------------------------------- 839 829 !! *** ROUTINE zgr_bot_level *** … … 847 837 !! (min value = 1) 848 838 !!---------------------------------------------------------------------- 849 !!850 839 INTEGER :: ji, jj ! dummy loop indices 851 840 REAL(wp), POINTER, DIMENSION(:,:) :: zmik … … 881 870 END SUBROUTINE zgr_top_level 882 871 872 883 873 SUBROUTINE zgr_zco 884 874 !!---------------------------------------------------------------------- … … 895 885 ! 896 886 DO jk = 1, jpk 897 gdept_0 898 gdepw_0 899 gde p3w_0(:,:,jk) = gdepw_1d(jk)900 e3t_0 901 e3u_0 902 e3v_0 903 e3f_0 904 e3w_0 905 e3uw_0 906 e3vw_0 887 gdept_0(:,:,jk) = gdept_1d(jk) 888 gdepw_0(:,:,jk) = gdepw_1d(jk) 889 gde3w_0(:,:,jk) = gdepw_1d(jk) 890 e3t_0 (:,:,jk) = e3t_1d (jk) 891 e3u_0 (:,:,jk) = e3t_1d (jk) 892 e3v_0 (:,:,jk) = e3t_1d (jk) 893 e3f_0 (:,:,jk) = e3t_1d (jk) 894 e3w_0 (:,:,jk) = e3w_1d (jk) 895 e3uw_0 (:,:,jk) = e3w_1d (jk) 896 e3vw_0 (:,:,jk) = e3w_1d (jk) 907 897 END DO 908 898 ! … … 957 947 !! Reference : Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270. 958 948 !!---------------------------------------------------------------------- 959 !!960 949 INTEGER :: ji, jj, jk ! dummy loop indices 961 950 INTEGER :: ik, it, ikb, ikt ! temporary integers 962 LOGICAL :: ll_print ! Allow control print for debugging963 951 REAL(wp) :: ze3tp , ze3wp ! Last ocean level thickness at T- and W-points 964 952 REAL(wp) :: zdepwp, zdepth ! Ajusted ocean depth to avoid too small e3t … … 977 965 IF(lwp) WRITE(numout,*) ' ~~~~~~~ ' 978 966 IF(lwp) WRITE(numout,*) ' mbathy is recomputed : bathy_level file is NOT used' 979 980 ll_print = .FALSE. ! Local variable for debugging981 982 IF(lwp .AND. ll_print) THEN ! control print of the ocean depth983 WRITE(numout,*)984 WRITE(numout,*) 'dom_zgr_zps: bathy (in hundred of meters)'985 CALL prihre( bathy, jpi, jpj, 1,jpi, 1, 1, jpj, 1, 1.e-2, numout )986 ENDIF987 988 967 989 968 ! bathymetry in level (from bathy_meter) … … 1196 1175 IF( MINVAL( gdepw_0(:,:,:) ) < 0._wp ) CALL ctl_stop( ' zgr_zps : e r r o r gdepw_0 < 0' ) 1197 1176 1198 ! Compute gde p3w_0 (vertical sum of e3w)1177 ! Compute gde3w_0 (vertical sum of e3w) 1199 1178 IF ( ln_isfcav ) THEN ! if cavity 1200 1179 WHERE (misfdep == 0) misfdep = 1 1201 1180 DO jj = 1,jpj 1202 1181 DO ji = 1,jpi 1203 gde p3w_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1)1182 gde3w_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1) 1204 1183 DO jk = 2, misfdep(ji,jj) 1205 gde p3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)1184 gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 1206 1185 END DO 1207 IF (misfdep(ji,jj) .GE. 2) gde p3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj))1186 IF (misfdep(ji,jj) .GE. 2) gde3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj)) 1208 1187 DO jk = misfdep(ji,jj) + 1, jpk 1209 gde p3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)1188 gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 1210 1189 END DO 1211 1190 END DO 1212 1191 END DO 1213 1192 ELSE ! no cavity 1214 gde p3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1)1193 gde3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1) 1215 1194 DO jk = 2, jpk 1216 gde p3w_0(:,:,jk) = gdep3w_0(:,:,jk-1) + e3w_0(:,:,jk)1195 gde3w_0(:,:,jk) = gde3w_0(:,:,jk-1) + e3w_0(:,:,jk) 1217 1196 END DO 1218 1197 END IF 1219 ! ! ================= !1220 IF(lwp .AND. ll_print) THEN ! Control print !1221 ! ! ================= !1222 DO jj = 1,jpj1223 DO ji = 1, jpi1224 ik = MAX( mbathy(ji,jj), 1 )1225 zprt(ji,jj,1) = e3t_0 (ji,jj,ik)1226 zprt(ji,jj,2) = e3w_0 (ji,jj,ik)1227 zprt(ji,jj,3) = e3u_0 (ji,jj,ik)1228 zprt(ji,jj,4) = e3v_0 (ji,jj,ik)1229 zprt(ji,jj,5) = e3f_0 (ji,jj,ik)1230 zprt(ji,jj,6) = gdep3w_0(ji,jj,ik)1231 END DO1232 END DO1233 WRITE(numout,*)1234 WRITE(numout,*) 'domzgr e3t(mbathy)' ; CALL prihre(zprt(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)1235 WRITE(numout,*)1236 WRITE(numout,*) 'domzgr e3w(mbathy)' ; CALL prihre(zprt(:,:,2),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)1237 WRITE(numout,*)1238 WRITE(numout,*) 'domzgr e3u(mbathy)' ; CALL prihre(zprt(:,:,3),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)1239 WRITE(numout,*)1240 WRITE(numout,*) 'domzgr e3v(mbathy)' ; CALL prihre(zprt(:,:,4),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)1241 WRITE(numout,*)1242 WRITE(numout,*) 'domzgr e3f(mbathy)' ; CALL prihre(zprt(:,:,5),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)1243 WRITE(numout,*)1244 WRITE(numout,*) 'domzgr gdep3w(mbathy)' ; CALL prihre(zprt(:,:,6),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)1245 ENDIF1246 1198 ! 1247 1199 CALL wrk_dealloc( jpi, jpj, jpk, zprt ) … … 1250 1202 ! 1251 1203 END SUBROUTINE zgr_zps 1204 1252 1205 1253 1206 SUBROUTINE zgr_isf … … 1265 1218 !! - bathy and isfdraft are modified 1266 1219 !!---------------------------------------------------------------------- 1267 !!1268 1220 INTEGER :: ji, jj, jk, jl ! dummy loop indices 1269 1221 INTEGER :: ik, it ! temporary integers 1270 1222 INTEGER :: id, jd, nprocd 1271 1223 INTEGER :: icompt, ibtest, ibtestim1, ibtestip1, ibtestjm1, ibtestjp1 ! (ISF) 1272 LOGICAL :: ll_print ! Allow control print for debugging1273 1224 REAL(wp) :: ze3tp , ze3wp ! Last ocean level thickness at T- and W-points 1274 1225 REAL(wp) :: zdepwp, zdepth ! Ajusted ocean depth to avoid too small e3t … … 1752 1703 CALL wrk_dealloc( jpi, jpj, zmask, zbathy, zrisfdep ) 1753 1704 CALL wrk_dealloc( jpi, jpj, zmisfdep, zmbathy ) 1754 1705 ! 1755 1706 IF( nn_timing == 1 ) CALL timing_stop('zgr_isf') 1756 1707 ! 1757 1708 END SUBROUTINE 1709 1758 1710 1759 1711 SUBROUTINE zgr_sco … … 1801 1753 !! 1802 1754 !!---------------------------------------------------------------------- 1803 !1804 1755 INTEGER :: ji, jj, jk, jl ! dummy loop argument 1805 1756 INTEGER :: iip1, ijp1, iim1, ijm1 ! temporary integers … … 1810 1761 REAL(wp), POINTER, DIMENSION(:,: ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2 1811 1762 REAL(wp), POINTER, DIMENSION(:,: ) :: zenv, ztmp, zmsk, zri, zrj, zhbat 1812 1763 !! 1813 1764 NAMELIST/namzgr_sco/ln_s_sh94, ln_s_sf12, ln_sigcrit, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, & 1814 1765 & rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b 1815 1766 !!---------------------------------------------------------------------- 1816 1767 ! … … 1876 1827 DO jj = 1, jpj 1877 1828 DO ji = 1, jpi 1878 IF( bathy(ji,jj) == 0._wp ) THEN 1879 iip1 = MIN( ji+1, jpi ) 1880 ijp1 = MIN( jj+1, jpj ) 1881 iim1 = MAX( ji-1, 1 ) 1882 ijm1 = MAX( jj-1, 1 ) 1883 IF( (bathy(iip1,jj) + bathy(iim1,jj) + bathy(ji,ijp1) + bathy(ji,ijm1) + & 1884 & bathy(iip1,ijp1) + bathy(iim1,ijm1) + bathy(iip1,ijp1) + bathy(iim1,ijm1)) > 0._wp ) THEN 1885 zenv(ji,jj) = rn_sbot_min 1886 ENDIF 1829 IF( bathy(ji,jj) == 0._wp ) THEN 1830 iip1 = MIN( ji+1, jpi ) 1831 ijp1 = MIN( jj+1, jpj ) 1832 iim1 = MAX( ji-1, 1 ) 1833 ijm1 = MAX( jj-1, 1 ) 1834 !!gm BUG fix see ticket #1617 1835 IF( ( + bathy(iim1,ijm1) + bathy(ji,ijp1) + bathy(iip1,ijp1) & 1836 & + bathy(iim1,jj ) + bathy(iip1,jj ) & 1837 & + bathy(iim1,ijm1) + bathy(ji,ijm1) + bathy(iip1,ijp1) ) > 0._wp ) zenv(ji,jj) = rn_sbot_min 1838 !!gm 1839 !!gm IF( ( bathy(iip1,jj ) + bathy(iim1,jj ) + bathy(ji,ijp1 ) + bathy(ji,ijm1) + & 1840 !!gm & bathy(iip1,ijp1) + bathy(iim1,ijm1) + bathy(iip1,ijp1) + bathy(iim1,ijm1)) > 0._wp ) THEN 1841 !!gm zenv(ji,jj) = rn_sbot_min 1842 !!gm ENDIF 1843 !!gm end 1887 1844 ENDIF 1888 1845 END DO … … 1975 1932 ENDIF 1976 1933 ! 1977 IF(lwp) THEN ! Control print1978 WRITE(numout,*)1979 WRITE(numout,*) ' domzgr: hbatt field; ocean depth in meters'1980 WRITE(numout,*)1981 CALL prihre( hbatt(1,1), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 0._wp, numout )1982 IF( nprint == 1 ) THEN1983 WRITE(numout,*) ' bathy MAX ', MAXVAL( bathy(:,:) ), ' MIN ', MINVAL( bathy(:,:) )1984 WRITE(numout,*) ' hbatt MAX ', MAXVAL( hbatt(:,:) ), ' MIN ', MINVAL( hbatt(:,:) )1985 ENDIF1986 ENDIF1987 1988 1934 ! ! ============================== 1989 1935 ! ! hbatu, hbatv, hbatf fields … … 2081 2027 CALL lbc_lnk( e3vw_0, 'V', 1._wp ) 2082 2028 2083 fsdepw(:,:,:) = gdepw_0 (:,:,:) 2084 fsde3w(:,:,:) = gdep3w_0(:,:,:) 2085 ! 2086 where (e3t_0 (:,:,:).eq.0.0) e3t_0(:,:,:) = 1.0 2087 where (e3u_0 (:,:,:).eq.0.0) e3u_0(:,:,:) = 1.0 2088 where (e3v_0 (:,:,:).eq.0.0) e3v_0(:,:,:) = 1.0 2089 where (e3f_0 (:,:,:).eq.0.0) e3f_0(:,:,:) = 1.0 2090 where (e3w_0 (:,:,:).eq.0.0) e3w_0(:,:,:) = 1.0 2091 where (e3uw_0 (:,:,:).eq.0.0) e3uw_0(:,:,:) = 1.0 2092 where (e3vw_0 (:,:,:).eq.0.0) e3vw_0(:,:,:) = 1.0 2029 gdepw_n(:,:,:) = gdepw_0(:,:,:) 2030 ! 2031 WHERE( e3t_0 (:,:,:) == 0._wp ) e3t_0 (:,:,:) = 1._wp 2032 WHERE( e3u_0 (:,:,:) == 0._wp ) e3u_0 (:,:,:) = 1._wp 2033 WHERE( e3v_0 (:,:,:) == 0._wp ) e3v_0 (:,:,:) = 1._wp 2034 WHERE( e3f_0 (:,:,:) == 0._wp ) e3f_0 (:,:,:) = 1._wp 2035 WHERE( e3w_0 (:,:,:) == 0._wp ) e3w_0 (:,:,:) = 1._wp 2036 WHERE( e3uw_0(:,:,:) == 0._wp ) e3uw_0(:,:,:) = 1._wp 2037 WHERE( e3vw_0(:,:,:) == 0._wp ) e3vw_0(:,:,:) = 1._wp 2093 2038 2094 2039 #if defined key_agrif 2095 ! Ensure meaningful vertical scale factors in ghost lines/columns 2096 IF( .NOT. Agrif_Root() ) THEN 2097 ! 2098 IF((nbondi == -1).OR.(nbondi == 2)) THEN 2099 e3u_0(1,:,:) = e3u_0(2,:,:) 2100 ENDIF 2101 ! 2102 IF((nbondi == 1).OR.(nbondi == 2)) THEN 2103 e3u_0(nlci-1,:,:) = e3u_0(nlci-2,:,:) 2104 ENDIF 2105 ! 2106 IF((nbondj == -1).OR.(nbondj == 2)) THEN 2107 e3v_0(:,1,:) = e3v_0(:,2,:) 2108 ENDIF 2109 ! 2110 IF((nbondj == 1).OR.(nbondj == 2)) THEN 2111 e3v_0(:,nlcj-1,:) = e3v_0(:,nlcj-2,:) 2112 ENDIF 2113 ! 2114 ENDIF 2040 IF( .NOT. Agrif_Root() ) THEN ! Ensure meaningful vertical scale factors in ghost lines/columns 2041 IF( nbondi == -1 .OR. nbondi == 2 ) e3u_0( 1 , : ,:) = e3u_0( 2 , : ,:) 2042 IF( nbondi == 1 .OR. nbondi == 2 ) e3u_0(nlci-1, : ,:) = e3u_0(nlci-2, : ,:) 2043 IF( nbondj == -1 .OR. nbondj == 2 ) e3v_0( : , 1 ,:) = e3v_0( : , 2 ,:) 2044 IF( nbondj == 1 .OR. nbondj == 2 ) e3v_0( : ,nlcj-1,:) = e3v_0( : ,nlcj-2,:) 2045 ENDIF 2115 2046 #endif 2116 2047 2117 fsdept(:,:,:) = gdept_0(:,:,:)2118 fsdepw(:,:,:) = gdepw_0(:,:,:)2119 fsde3w(:,:,:) = gdep3w_0(:,:,:)2120 fse3t (:,:,:) = e3t_0(:,:,:)2121 fse3u (:,:,:) = e3u_0(:,:,:)2122 fse3v (:,:,:) = e3v_0(:,:,:)2123 fse3f (:,:,:) = e3f_0(:,:,:)2124 fse3w (:,:,:) = e3w_0(:,:,:)2125 fse3uw(:,:,:) = e3uw_0(:,:,:)2126 fse3vw(:,:,:) = e3vw_0(:,:,:)2048 gdept_n(:,:,:) = gdept_0(:,:,:) 2049 gdepw_n(:,:,:) = gdepw_0(:,:,:) 2050 gde3w_n(:,:,:) = gde3w_0(:,:,:) 2051 e3t_n (:,:,:) = e3t_0 (:,:,:) 2052 e3u_n (:,:,:) = e3u_0 (:,:,:) 2053 e3v_n (:,:,:) = e3v_0 (:,:,:) 2054 e3f_n (:,:,:) = e3f_0 (:,:,:) 2055 e3w_n (:,:,:) = e3w_0 (:,:,:) 2056 e3uw_n (:,:,:) = e3uw_0 (:,:,:) 2057 e3vw_n (:,:,:) = e3vw_0 (:,:,:) 2127 2058 !! 2128 2059 ! HYBRID : … … 2130 2061 DO ji = 1, jpi 2131 2062 DO jk = 1, jpkm1 2132 IF( scobot(ji,jj) >= fsdept(ji,jj,jk) ) mbathy(ji,jj) = MAX( 2, jk )2063 IF( scobot(ji,jj) >= gdept_n(ji,jj,jk) ) mbathy(ji,jj) = MAX( 2, jk ) 2133 2064 END DO 2134 2065 IF( scobot(ji,jj) == 0._wp ) mbathy(ji,jj) = 0 … … 2141 2072 WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) 2142 2073 WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ), & 2143 & ' w ', MINVAL( gdepw_0(:,:,:) ), '3w ' , MINVAL( gde p3w_0(:,:,:) )2144 WRITE(numout,*) ' MIN val e3 t ', MINVAL( e3t_0 (:,:,:) ), ' f ' , MINVAL( e3f_0 2145 & ' u ', MINVAL( e3u_0 (:,:,:) ), ' u ' , MINVAL( e3v_0 2146 & ' uw', MINVAL( e3uw_0 (:,:,:) ), ' vw' , MINVAL( e3vw_0 2074 & ' w ', MINVAL( gdepw_0(:,:,:) ), '3w ' , MINVAL( gde3w_0(:,:,:) ) 2075 WRITE(numout,*) ' MIN val e3 t ', MINVAL( e3t_0 (:,:,:) ), ' f ' , MINVAL( e3f_0 (:,:,:) ), & 2076 & ' u ', MINVAL( e3u_0 (:,:,:) ), ' u ' , MINVAL( e3v_0 (:,:,:) ), & 2077 & ' uw', MINVAL( e3uw_0 (:,:,:) ), ' vw' , MINVAL( e3vw_0 (:,:,:) ), & 2147 2078 & ' w ', MINVAL( e3w_0 (:,:,:) ) 2148 2079 2149 2080 WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ), & 2150 & ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w ' , MAXVAL( gde p3w_0(:,:,:) )2151 WRITE(numout,*) ' MAX val e3 t ', MAXVAL( e3t_0 (:,:,:) ), ' f ' , MAXVAL( e3f_0 2152 & ' u ', MAXVAL( e3u_0 (:,:,:) ), ' u ' , MAXVAL( e3v_0 2153 & ' uw', MAXVAL( e3uw_0 (:,:,:) ), ' vw' , MAXVAL( e3vw_0 2081 & ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w ' , MAXVAL( gde3w_0(:,:,:) ) 2082 WRITE(numout,*) ' MAX val e3 t ', MAXVAL( e3t_0 (:,:,:) ), ' f ' , MAXVAL( e3f_0 (:,:,:) ), & 2083 & ' u ', MAXVAL( e3u_0 (:,:,:) ), ' u ' , MAXVAL( e3v_0 (:,:,:) ), & 2084 & ' uw', MAXVAL( e3uw_0 (:,:,:) ), ' vw' , MAXVAL( e3vw_0 (:,:,:) ), & 2154 2085 & ' w ', MAXVAL( e3w_0 (:,:,:) ) 2155 2086 ENDIF … … 2193 2124 DO jk = 1, mbathy(ji,jj) 2194 2125 ! check coordinate is monotonically increasing 2195 IF ( fse3w(ji,jj,jk) <= 0._wp .OR. fse3t(ji,jj,jk) <= 0._wp ) THEN2126 IF (e3w_n(ji,jj,jk) <= 0._wp .OR. e3t_n(ji,jj,jk) <= 0._wp ) THEN 2196 2127 WRITE(ctmp1,*) 'ERROR zgr_sco : e3w or e3t =< 0 at point (i,j,k)= ', ji, jj, jk 2197 2128 WRITE(numout,*) 'ERROR zgr_sco : e3w or e3t =< 0 at point (i,j,k)= ', ji, jj, jk 2198 WRITE(numout,*) 'e3w', fse3w(ji,jj,:)2199 WRITE(numout,*) 'e3t', fse3t(ji,jj,:)2129 WRITE(numout,*) 'e3w',e3w_n(ji,jj,:) 2130 WRITE(numout,*) 'e3t',e3t_n(ji,jj,:) 2200 2131 CALL ctl_stop( ctmp1 ) 2201 2132 ENDIF 2202 2133 ! and check it has never gone negative 2203 IF( fsdepw(ji,jj,jk) < 0._wp .OR. fsdept(ji,jj,jk) < 0._wp ) THEN2134 IF( gdepw_n(ji,jj,jk) < 0._wp .OR. gdept_n(ji,jj,jk) < 0._wp ) THEN 2204 2135 WRITE(ctmp1,*) 'ERROR zgr_sco : gdepw or gdept =< 0 at point (i,j,k)= ', ji, jj, jk 2205 2136 WRITE(numout,*) 'ERROR zgr_sco : gdepw or gdept =< 0 at point (i,j,k)= ', ji, jj, jk 2206 WRITE(numout,*) 'gdepw', fsdepw(ji,jj,:)2207 WRITE(numout,*) 'gdept', fsdept(ji,jj,:)2137 WRITE(numout,*) 'gdepw',gdepw_n(ji,jj,:) 2138 WRITE(numout,*) 'gdept',gdept_n(ji,jj,:) 2208 2139 CALL ctl_stop( ctmp1 ) 2209 2140 ENDIF 2210 2141 ! and check it never exceeds the total depth 2211 IF( fsdepw(ji,jj,jk) > hbatt(ji,jj) ) THEN2142 IF( gdepw_n(ji,jj,jk) > hbatt(ji,jj) ) THEN 2212 2143 WRITE(ctmp1,*) 'ERROR zgr_sco : gdepw > hbatt at point (i,j,k)= ', ji, jj, jk 2213 2144 WRITE(numout,*) 'ERROR zgr_sco : gdepw > hbatt at point (i,j,k)= ', ji, jj, jk 2214 WRITE(numout,*) 'gdepw', fsdepw(ji,jj,:)2145 WRITE(numout,*) 'gdepw',gdepw_n(ji,jj,:) 2215 2146 CALL ctl_stop( ctmp1 ) 2216 2147 ENDIF … … 2219 2150 DO jk = 1, mbathy(ji,jj)-1 2220 2151 ! and check it never exceeds the total depth 2221 IF( fsdept(ji,jj,jk) > hbatt(ji,jj) ) THEN2152 IF( gdept_n(ji,jj,jk) > hbatt(ji,jj) ) THEN 2222 2153 WRITE(ctmp1,*) 'ERROR zgr_sco : gdept > hbatt at point (i,j,k)= ', ji, jj, jk 2223 2154 WRITE(numout,*) 'ERROR zgr_sco : gdept > hbatt at point (i,j,k)= ', ji, jj, jk 2224 WRITE(numout,*) 'gdept', fsdept(ji,jj,:)2155 WRITE(numout,*) 'gdept',gdept_n(ji,jj,:) 2225 2156 CALL ctl_stop( ctmp1 ) 2226 2157 ENDIF … … 2297 2228 zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp) 2298 2229 zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp) 2299 gdept_0 2300 gdepw_0 2301 gde p3w_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsi3w3(ji,jj,jk)+rn_hc*zcoeft )2230 gdept_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigt3(ji,jj,jk)+rn_hc*zcoeft ) 2231 gdepw_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigw3(ji,jj,jk)+rn_hc*zcoefw ) 2232 gde3w_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsi3w3(ji,jj,jk)+rn_hc*zcoeft ) 2302 2233 END DO 2303 2234 ! … … 2425 2356 2426 2357 DO jk = 1, jpk 2427 gdept_0 2428 gdepw_0 2429 gde p3w_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsi3w3(ji,jj,jk)2358 gdept_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigt3(ji,jj,jk) 2359 gdepw_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigw3(ji,jj,jk) 2360 gde3w_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsi3w3(ji,jj,jk) 2430 2361 END DO 2431 2362 … … 2485 2416 !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408. 2486 2417 !!---------------------------------------------------------------------- 2487 2488 INTEGER :: ji, jj, jk ! dummy loop argument 2418 INTEGER :: ji, jj, jk ! dummy loop argument 2489 2419 REAL(wp) :: zcoeft, zcoefw ! temporary scalars 2490 2491 2420 REAL(wp), POINTER, DIMENSION(:) :: z_gsigw, z_gsigt, z_gsi3w 2492 2421 REAL(wp), POINTER, DIMENSION(:) :: z_esigt, z_esigw 2493 2494 CALL wrk_alloc( jpk, z_gsigw, z_gsigt, z_gsi3w ) 2495 CALL wrk_alloc( jpk, z_esigt, z_esigw ) 2422 !!---------------------------------------------------------------------- 2423 2424 CALL wrk_alloc( jpk, z_gsigw, z_gsigt, z_gsi3w ) 2425 CALL wrk_alloc( jpk, z_esigt, z_esigw ) 2496 2426 2497 2427 z_gsigw = 0._wp ; z_gsigt = 0._wp ; z_gsi3w = 0._wp … … 2523 2453 zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp) 2524 2454 zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp) 2525 gdept_0 2526 gdepw_0 2527 gde p3w_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsi3w(jk) + hift(:,:)*zcoeft )2455 gdept_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigt(jk) + hift(:,:)*zcoeft ) 2456 gdepw_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigw(jk) + hift(:,:)*zcoefw ) 2457 gde3w_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsi3w(jk) + hift(:,:)*zcoeft ) 2528 2458 END DO 2529 2459 !!gm: e3uw, e3vw can be suppressed (modif in dynzdf, dynzdf_iso, zdfbfr) (save 2 3D arrays) … … 2542 2472 END DO 2543 2473 END DO 2544 2545 CALL wrk_dealloc( jpk, z_gsigw, z_gsigt, z_gsi3w)2546 CALL wrk_dealloc( jpk, z_esigt, z_esigw)2547 2474 ! 2475 CALL wrk_dealloc( jpk, z_gsigw, z_gsigt, z_gsi3w ) 2476 CALL wrk_dealloc( jpk, z_esigt, z_esigw ) 2477 ! 2548 2478 END SUBROUTINE s_tanh 2479 2549 2480 2550 2481 FUNCTION fssig( pk ) RESULT( pf ) … … 2618 2549 REAL(wp), INTENT(in ) :: pk1(jpk) ! continuous "k" coordinate 2619 2550 REAL(wp) :: p_gamma(jpk) ! stretched coordinate 2620 REAL(wp), INTENT(in ) :: pzb ! Bottom box depth2621 REAL(wp), INTENT(in ) :: pzs ! surface box depth2622 REAL(wp), INTENT(in ) :: psmth ! Smoothing parameter2623 REAL(wp) :: za1,za2,za3 ! local variables2624 REAL(wp) :: zn1,zn2 ! local variables2625 REAL(wp) :: za,zb,zx ! local variables2626 integer :: jk2627 !!----------------------------------------------------------------------2628 ! 2629 2630 zn1 = 1. /(jpk-1.)2551 REAL(wp), INTENT(in ) :: pzb ! Bottom box depth 2552 REAL(wp), INTENT(in ) :: pzs ! surface box depth 2553 REAL(wp), INTENT(in ) :: psmth ! Smoothing parameter 2554 ! 2555 INTEGER :: jk ! dummy loop index 2556 REAL(wp) :: za1,za2,za3 ! local scalar 2557 REAL(wp) :: zn1,zn2 ! - - 2558 REAL(wp) :: za,zb,zx ! - - 2559 !!---------------------------------------------------------------------- 2560 ! 2561 zn1 = 1._wp / REAL( jpkm1, wp ) 2631 2562 zn2 = 1. - zn1 2632 2563 ! 2633 2564 za1 = (rn_alpha+2.0_wp)*zn1**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn1**(rn_alpha+2.0_wp) 2634 2565 za2 = (rn_alpha+2.0_wp)*zn2**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn2**(rn_alpha+2.0_wp) 2635 2566 za3 = (zn2**3.0_wp - za2)/( zn1**3.0_wp - za1) 2636 2567 ! 2637 2568 za = pzb - za3*(pzs-za1)-za2 2638 2569 za = za/( zn2-0.5_wp*(za2+zn2**2.0_wp) - za3*(zn1-0.5_wp*(za1+zn1**2.0_wp) ) ) 2639 2570 zb = (pzs - za1 - za*( zn1-0.5_wp*(za1+zn1**2.0_wp ) ) ) / (zn1**3.0_wp - za1) 2640 2571 zx = 1.0_wp-za/2.0_wp-zb 2641 2572 ! 2642 2573 DO jk = 1, jpk 2643 p_gamma(jk) = za*(pk1(jk)*(1.0_wp-pk1(jk)/2.0_wp))+zb*pk1(jk)**3.0_wp + &2644 &zx*( (rn_alpha+2.0_wp)*pk1(jk)**(rn_alpha+1.0_wp)- &2645 &(rn_alpha+1.0_wp)*pk1(jk)**(rn_alpha+2.0_wp) )2574 p_gamma(jk) = za*(pk1(jk)*(1.0_wp-pk1(jk)/2.0_wp))+zb*pk1(jk)**3.0_wp + & 2575 & zx*( (rn_alpha+2.0_wp)*pk1(jk)**(rn_alpha+1.0_wp)- & 2576 & (rn_alpha+1.0_wp)*pk1(jk)**(rn_alpha+2.0_wp) ) 2646 2577 p_gamma(jk) = p_gamma(jk)*psmth+pk1(jk)*(1.0_wp-psmth) 2647 ENDDO 2648 2578 END DO 2649 2579 ! 2650 2580 END FUNCTION fgamma -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90
r5836 r5845 35 35 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tsd ! structure of input SST (file informations, fields read) 36 36 37 !! * Substitutions38 # include "domzgr_substitute.h90"39 37 !!---------------------------------------------------------------------- 40 38 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 250 248 ENDIF 251 249 ! 252 IF( lwp .AND. kt == nit000 ) THEN253 WRITE(numout,*) ' temperature Levitus '254 WRITE(numout,*)255 WRITE(numout,*)' level = 1'256 CALL prihre( ptsd(:,:,1 ,jp_tem), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )257 WRITE(numout,*)' level = ', jpk/2258 CALL prihre( ptsd(:,:,jpk/2,jp_tem), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )259 WRITE(numout,*)' level = ', jpkm1260 CALL prihre( ptsd(:,:,jpkm1,jp_tem), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )261 WRITE(numout,*)262 WRITE(numout,*) ' salinity Levitus '263 WRITE(numout,*)264 WRITE(numout,*)' level = 1'265 CALL prihre( ptsd(:,:,1 ,jp_sal), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )266 WRITE(numout,*)' level = ', jpk/2267 CALL prihre( ptsd(:,:,jpk/2,jp_sal), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )268 WRITE(numout,*)' level = ', jpkm1269 CALL prihre( ptsd(:,:,jpkm1,jp_sal), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )270 WRITE(numout,*)271 ENDIF272 !273 250 IF( .NOT.ln_tsd_tradmp ) THEN !== deallocate T & S structure ==! 274 251 ! (data used only for initialisation) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r5836 r5845 52 52 53 53 !! * Substitutions 54 # include "domzgr_substitute.h90"55 54 # include "vectopt_loop_substitute.h90" 56 55 !!---------------------------------------------------------------------- … … 124 123 ENDIF 125 124 ! 126 ! - ML - sshn could be modified by istate_eel, so that initialization of fse3t_b is done here125 ! - ML - sshn could be modified by istate_eel, so that initialization of e3t_b is done here 127 126 IF( lk_vvl ) THEN 128 127 DO jk = 1, jpk 129 fse3t_b(:,:,jk) = fse3t_n(:,:,jk)128 e3t_b(:,:,jk) = e3t_n(:,:,jk) 130 129 END DO 131 130 ENDIF … … 155 154 DO jj = 1, jpj 156 155 DO ji = 1, jpi 157 un_b(ji,jj) = un_b(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)158 vn_b(ji,jj) = vn_b(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)156 un_b(ji,jj) = un_b(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 157 vn_b(ji,jj) = vn_b(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 159 158 ! 160 ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk)161 vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk)159 ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 160 vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 162 161 END DO 163 162 END DO 164 163 END DO 165 164 ! 166 un_b(:,:) = un_b(:,:) * hur(:,:)167 vn_b(:,:) = vn_b(:,:) * hvr(:,:)168 ! 169 ub_b(:,:) = ub_b(:,:) * hur_b(:,:)170 vb_b(:,:) = vb_b(:,:) * hvr_b(:,:)165 un_b(:,:) = un_b(:,:) * r1_hu_n (:,:) 166 vn_b(:,:) = vn_b(:,:) * r1_hv_n (:,:) 167 ! 168 ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 169 vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 171 170 ! 172 171 ! … … 197 196 ! 198 197 DO jk = 1, jpk 199 tsn(:,:,jk,jp_tem) = ( ( ( 7.5 - 0. * ABS( gphit(:,:) )/30. ) * ( 1.-TANH(( fsdept(:,:,jk)-80.)/30.) ) &200 & + 10. * ( 5000. - fsdept(:,:,jk) ) /5000.) ) * tmask(:,:,jk)198 tsn(:,:,jk,jp_tem) = ( ( ( 7.5 - 0. * ABS( gphit(:,:) )/30. ) * ( 1.-TANH((gdept_n(:,:,jk)-80.)/30.) ) & 199 & + 10. * ( 5000. - gdept_n(:,:,jk) ) /5000.) ) * tmask(:,:,jk) 201 200 tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem) 202 201 END DO … … 251 250 ! 252 251 DO jk = 1, jpk 253 tsn(:,:,jk,jp_tem) = ( zt2 + zt1 * exp( - fsdept(:,:,jk) / 1000 ) ) * tmask(:,:,jk)252 tsn(:,:,jk,jp_tem) = ( zt2 + zt1 * exp( - gdept_n(:,:,jk) / 1000 ) ) * tmask(:,:,jk) 254 253 tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem) 255 254 END DO 256 !257 IF(lwp) CALL prizre( tsn(:,:,:,jp_tem), jpi , jpj , jpk , jpj/2 , &258 & 1 , jpi , 5 , 1 , jpk , &259 & 1 , 1. , numout )260 255 ! 261 256 ! set salinity field to a constant value … … 327 322 tsn(:,:,:,jp_tem) = tsb(:,:,:,jp_tem) ! set nox temperature to tb 328 323 ! 329 IF(lwp) CALL prizre( tsn(:,:,:,jp_tem), jpi , jpj , jpk , jpj/2 , &330 & 1 , jpi , 5 , 1 , jpk , &331 & 1 , 1. , numout )332 !333 324 ! set salinity field to a constant value 334 325 ! -------------------------------------- … … 376 367 DO jj = 1, jpj 377 368 DO ji = 1, jpi 378 tsn(ji,jj,jk,jp_tem) = ( 16. - 12. * TANH( ( fsdept(ji,jj,jk) - 400) / 700 ) ) &379 & * (-TANH( (500- fsdept(ji,jj,jk)) / 150 ) + 1) / 2 &380 & + ( 15. * ( 1. - TANH( ( fsdept(ji,jj,jk)-50.) / 1500.) ) &381 & - 1.4 * TANH(( fsdept(ji,jj,jk)-100.) / 100.) &382 & + 7. * (1500. - fsdept(ji,jj,jk)) / 1500. ) &383 & * (-TANH( ( fsdept(ji,jj,jk) - 500) / 150) + 1) / 2369 tsn(ji,jj,jk,jp_tem) = ( 16. - 12. * TANH( (gdept_n(ji,jj,jk) - 400) / 700 ) ) & 370 & * (-TANH( (500-gdept_n(ji,jj,jk)) / 150 ) + 1) / 2 & 371 & + ( 15. * ( 1. - TANH( (gdept_n(ji,jj,jk)-50.) / 1500.) ) & 372 & - 1.4 * TANH((gdept_n(ji,jj,jk)-100.) / 100.) & 373 & + 7. * (1500. - gdept_n(ji,jj,jk)) / 1500. ) & 374 & * (-TANH( (gdept_n(ji,jj,jk) - 500) / 150) + 1) / 2 384 375 tsn(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 385 376 tsb(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) 386 377 387 tsn(ji,jj,jk,jp_sal) = ( 36.25 - 1.13 * TANH( ( fsdept(ji,jj,jk) - 305) / 460 ) ) &388 & * (-TANH((500 - fsdept(ji,jj,jk)) / 150) + 1) / 2 &389 & + ( 35.55 + 1.25 * (5000. - fsdept(ji,jj,jk)) / 5000. &390 & - 1.62 * TANH( ( fsdept(ji,jj,jk) - 60. ) / 650. ) &391 & + 0.2 * TANH( ( fsdept(ji,jj,jk) - 35. ) / 100. ) &392 & + 0.2 * TANH( ( fsdept(ji,jj,jk) - 1000.) / 5000.) ) &393 & * (-TANH(( fsdept(ji,jj,jk) - 500) / 150) + 1) / 2378 tsn(ji,jj,jk,jp_sal) = ( 36.25 - 1.13 * TANH( (gdept_n(ji,jj,jk) - 305) / 460 ) ) & 379 & * (-TANH((500 - gdept_n(ji,jj,jk)) / 150) + 1) / 2 & 380 & + ( 35.55 + 1.25 * (5000. - gdept_n(ji,jj,jk)) / 5000. & 381 & - 1.62 * TANH( (gdept_n(ji,jj,jk) - 60. ) / 650. ) & 382 & + 0.2 * TANH( (gdept_n(ji,jj,jk) - 35. ) / 100. ) & 383 & + 0.2 * TANH( (gdept_n(ji,jj,jk) - 1000.) / 5000.) ) & 384 & * (-TANH((gdept_n(ji,jj,jk) - 500) / 150) + 1) / 2 394 385 tsn(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 395 386 tsb(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) … … 466 457 zalfg = 0.5 * grav * rau0 467 458 468 zprn(:,:,1) = zalfg * fse3w(:,:,1) * ( 1 + rhd(:,:,1) ) ! Surface value459 zprn(:,:,1) = zalfg * e3w_n(:,:,1) * ( 1 + rhd(:,:,1) ) ! Surface value 469 460 470 461 DO jk = 2, jpkm1 ! Vertical integration from the surface 471 462 zprn(:,:,jk) = zprn(:,:,jk-1) & 472 & + zalfg * fse3w(:,:,jk) * ( 2. + rhd(:,:,jk) + rhd(:,:,jk-1) )463 & + zalfg * e3w_n(:,:,jk) * ( 2. + rhd(:,:,jk) + rhd(:,:,jk-1) ) 473 464 END DO 474 465 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90
r5836 r5845 36 36 37 37 !! * Substitutions 38 # include "domzgr_substitute.h90"39 38 # include "vectopt_loop_substitute.h90" 40 39 !!---------------------------------------------------------------------- … … 74 73 DO jj = 2, jpjm1 75 74 DO ji = fs_2, fs_jpim1 ! vector opt. 76 hdivn(ji,jj,jk) = ( e2u(ji ,jj) * fse3u_n(ji ,jj,jk) * un(ji ,jj,jk) &77 & - e2u(ji-1,jj) * fse3u_n(ji-1,jj,jk) * un(ji-1,jj,jk) &78 & + e1v(ji,jj ) * fse3v_n(ji,jj ,jk) * vn(ji,jj ,jk) &79 & - e1v(ji,jj-1) * fse3v_n(ji,jj-1,jk) * vn(ji,jj-1,jk) ) &80 & / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) )75 hdivn(ji,jj,jk) = ( e2u(ji ,jj) * e3u_n(ji ,jj,jk) * un(ji ,jj,jk) & 76 & - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * un(ji-1,jj,jk) & 77 & + e1v(ji,jj ) * e3v_n(ji,jj ,jk) * vn(ji,jj ,jk) & 78 & - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vn(ji,jj-1,jk) ) & 79 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 81 80 END DO 82 81 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90
r5836 r5845 39 39 40 40 !! * Substitutions 41 # include "domzgr_substitute.h90"42 41 # include "vectopt_loop_substitute.h90" 43 42 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
r5836 r5845 30 30 31 31 !! * Substitutions 32 # include "domzgr_substitute.h90"33 32 # include "vectopt_loop_substitute.h90" 34 33 !!---------------------------------------------------------------------- … … 77 76 DO jk = 1, jpkm1 ! ====================== ! 78 77 ! ! horizontal volume fluxes 79 zfu(:,:,jk) = 0.25 * e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)80 zfv(:,:,jk) = 0.25 * e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)78 zfu(:,:,jk) = 0.25 * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 79 zfv(:,:,jk) = 0.25 * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 81 80 ! 82 81 DO jj = 1, jpjm1 ! horizontal momentum fluxes at T- and F-point … … 90 89 DO jj = 2, jpjm1 ! divergence of horizontal momentum fluxes 91 90 DO ji = fs_2, fs_jpim1 ! vector opt. 92 zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk)93 zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk)91 zbu = e1e2u(ji,jj) * e3u_n(ji,jj,jk) 92 zbv = e1e2v(ji,jj) * e3v_n(ji,jj,jk) 94 93 ! 95 94 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_t(ji+1,jj ,jk) - zfu_t(ji ,jj ,jk) & … … 144 143 DO ji = fs_2, fs_jpim1 ! vector opt. 145 144 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) & 146 & / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) )145 & / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk) ) 147 146 va(ji,jj,jk) = va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) & 148 & / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) )147 & / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk) ) 149 148 END DO 150 149 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
r5836 r5845 35 35 36 36 !! * Substitutions 37 # include "domzgr_substitute.h90"38 37 # include "vectopt_loop_substitute.h90" 39 38 !!---------------------------------------------------------------------- … … 111 110 ! ! =========================== ! 112 111 ! ! horizontal volume fluxes 113 zfu(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)114 zfv(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)112 zfu(:,:,jk) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 113 zfv(:,:,jk) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 115 114 ! 116 115 DO jj = 2, jpjm1 ! laplacian … … 142 141 DO jk = 1, jpkm1 ! ====================== ! 143 142 ! ! horizontal volume fluxes 144 zfu(:,:,jk) = 0.25 * e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)145 zfv(:,:,jk) = 0.25 * e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)143 zfu(:,:,jk) = 0.25 * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 144 zfv(:,:,jk) = 0.25 * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 146 145 ! 147 146 DO jj = 1, jpjm1 ! horizontal momentum fluxes at T- and F-point … … 181 180 DO jj = 2, jpjm1 ! divergence of horizontal momentum fluxes 182 181 DO ji = fs_2, fs_jpim1 ! vector opt. 183 zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk)184 zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk)182 zbu = e1e2u(ji,jj) * e3u_n(ji,jj,jk) 183 zbv = e1e2v(ji,jj) * e3v_n(ji,jj,jk) 185 184 ! 186 185 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_t(ji+1,jj ,jk) - zfu_t(ji ,jj ,jk) & … … 233 232 DO ji = fs_2, fs_jpim1 ! vector opt. 234 233 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) & 235 & / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) )234 & / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk) ) 236 235 va(ji,jj,jk) = va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) & 237 & / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) )236 & / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk) ) 238 237 END DO 239 238 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
r5120 r5845 29 29 30 30 !! * Substitutions 31 # include "domzgr_substitute.h90"32 # include "zdfddm_substitute.h90"33 31 # include "vectopt_loop_substitute.h90" 34 32 !!---------------------------------------------------------------------- … … 78 76 ! 79 77 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 80 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( bfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt ) * ub(ji,jj,ikbu)81 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( bfrva(ji,jj) / fse3v(ji,jj,ikbv) , zm1_2dt ) * vb(ji,jj,ikbv)78 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( bfrua(ji,jj) / e3u_n(ji,jj,ikbu) , zm1_2dt ) * ub(ji,jj,ikbu) 79 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( bfrva(ji,jj) / e3v_n(ji,jj,ikbv) , zm1_2dt ) * vb(ji,jj,ikbv) 82 80 END DO 83 81 END DO … … 91 89 ! 92 90 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 93 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( tfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt ) * ub(ji,jj,ikbu) &91 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( tfrua(ji,jj) / e3u_n(ji,jj,ikbu) , zm1_2dt ) * ub(ji,jj,ikbu) & 94 92 & * (1.-umask(ji,jj,1)) 95 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( tfrva(ji,jj) / fse3v(ji,jj,ikbv) , zm1_2dt ) * vb(ji,jj,ikbv) &93 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( tfrva(ji,jj) / e3v_n(ji,jj,ikbv) , zm1_2dt ) * vb(ji,jj,ikbv) & 96 94 & * (1.-vmask(ji,jj,1)) 97 95 ! (ISF) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r5836 r5845 63 63 64 64 !! * Substitutions 65 # include "domzgr_substitute.h90"66 65 # include "vectopt_loop_substitute.h90" 67 66 !!---------------------------------------------------------------------- … … 214 213 !!---------------------------------------------------------------------- 215 214 INTEGER, INTENT(in) :: kt ! ocean time-step index 216 ! !215 ! 217 216 INTEGER :: ji, jj, jk ! dummy loop indices 218 217 REAL(wp) :: zcoef0, zcoef1 ! temporary scalars … … 233 232 DO jj = 2, jpjm1 234 233 DO ji = fs_2, fs_jpim1 ! vector opt. 235 zcoef1 = zcoef0 * fse3w(ji,jj,1)234 zcoef1 = zcoef0 * e3w_n(ji,jj,1) 236 235 ! hydrostatic pressure gradient 237 236 zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) / e1u(ji,jj) 238 237 zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) / e2v(ji,jj) 238 !!gm zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj) 239 !!gm zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj) 239 240 ! add to the general momentum trend 240 241 ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) … … 248 249 DO jj = 2, jpjm1 249 250 DO ji = fs_2, fs_jpim1 ! vector opt. 250 zcoef1 = zcoef0 * fse3w(ji,jj,jk)251 zcoef1 = zcoef0 * e3w_n(ji,jj,jk) 251 252 ! hydrostatic pressure gradient 252 253 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) & 253 254 & + zcoef1 * ( ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) ) & 254 255 & - ( rhd(ji ,jj,jk)+rhd(ji ,jj,jk-1) ) ) / e1u(ji,jj) 256 !!gm & - ( rhd(ji ,jj,jk)+rhd(ji ,jj,jk-1) ) ) * r1_e1u(ji,jj) 255 257 256 258 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) & 257 259 & + zcoef1 * ( ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) ) & 258 260 & - ( rhd(ji,jj, jk)+rhd(ji,jj ,jk-1) ) ) / e2v(ji,jj) 261 !!gm & - ( rhd(ji,jj, jk)+rhd(ji,jj ,jk-1) ) ) * r1_e2v(ji,jj) 259 262 ! add to the general momentum trend 260 263 ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) … … 300 303 DO jj = 2, jpjm1 301 304 DO ji = fs_2, fs_jpim1 ! vector opt. 302 zcoef1 = zcoef0 * fse3w(ji,jj,1)305 zcoef1 = zcoef0 * e3w_n(ji,jj,1) 303 306 ! hydrostatic pressure gradient 304 307 zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj ,1) - rhd(ji,jj,1) ) / e1u(ji,jj) 305 308 zhpj(ji,jj,1) = zcoef1 * ( rhd(ji ,jj+1,1) - rhd(ji,jj,1) ) / e2v(ji,jj) 309 !!gm zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj ,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj) 310 !!gm zhpj(ji,jj,1) = zcoef1 * ( rhd(ji ,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj) 306 311 ! add to the general momentum trend 307 312 ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) … … 315 320 DO jj = 2, jpjm1 316 321 DO ji = fs_2, fs_jpim1 ! vector opt. 317 zcoef1 = zcoef0 * fse3w(ji,jj,jk)322 zcoef1 = zcoef0 * e3w_n(ji,jj,jk) 318 323 ! hydrostatic pressure gradient 319 324 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) & 320 325 & + zcoef1 * ( ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) ) & 321 326 & - ( rhd(ji ,jj,jk) + rhd(ji ,jj,jk-1) ) ) / e1u(ji,jj) 327 !!gm & - ( rhd(ji ,jj,jk) + rhd(ji ,jj,jk-1) ) ) * r1_e1u(ji,jj) 322 328 323 329 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) & 324 330 & + zcoef1 * ( ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) ) & 325 331 & - ( rhd(ji,jj, jk) + rhd(ji,jj ,jk-1) ) ) / e2v(ji,jj) 332 !!gm & - ( rhd(ji,jj, jk) + rhd(ji,jj ,jk-1) ) ) * r1_e2v(ji,jj) 326 333 ! add to the general momentum trend 327 334 ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) … … 337 344 iku = mbku(ji,jj) 338 345 ikv = mbkv(ji,jj) 339 zcoef2 = zcoef0 * MIN( fse3w(ji,jj,iku), fse3w(ji+1,jj ,iku) )340 zcoef3 = zcoef0 * MIN( fse3w(ji,jj,ikv), fse3w(ji ,jj+1,ikv) )346 zcoef2 = zcoef0 * MIN( e3w_n(ji,jj,iku), e3w_n(ji+1,jj ,iku) ) 347 zcoef3 = zcoef0 * MIN( e3w_n(ji,jj,ikv), e3w_n(ji ,jj+1,ikv) ) 341 348 IF( iku > 1 ) THEN ! on i-direction (level 2 or more) 342 349 ua (ji,jj,iku) = ua(ji,jj,iku) - zhpi(ji,jj,iku) ! subtract old value 343 350 zhpi(ji,jj,iku) = zhpi(ji,jj,iku-1) & ! compute the new one 344 351 & + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + gru(ji,jj) ) / e1u(ji,jj) 352 !!gm & + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + gru(ji,jj) ) * r1_e1u(ji,jj) 345 353 ua (ji,jj,iku) = ua(ji,jj,iku) + zhpi(ji,jj,iku) ! add the new one to the general momentum trend 346 354 ENDIF … … 349 357 zhpj(ji,jj,ikv) = zhpj(ji,jj,ikv-1) & ! compute the new one 350 358 & + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + grv(ji,jj) ) / e2v(ji,jj) 359 !!gm & + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + grv(ji,jj) ) * r1_e2v(ji,jj) 351 360 va (ji,jj,ikv) = va(ji,jj,ikv) + zhpj(ji,jj,ikv) ! add the new one to the general momentum trend 352 361 ENDIF … … 402 411 DO ji = fs_2, fs_jpim1 ! vector opt. 403 412 ! hydrostatic pressure gradient along s-surfaces 404 zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( fse3w(ji+1,jj ,1) * ( znad + rhd(ji+1,jj ,1) ) & 405 & - fse3w(ji ,jj ,1) * ( znad + rhd(ji ,jj ,1) ) ) 406 zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( fse3w(ji ,jj+1,1) * ( znad + rhd(ji ,jj+1,1) ) & 407 & - fse3w(ji ,jj ,1) * ( znad + rhd(ji ,jj ,1) ) ) 413 !!gm zhpi(ji,jj,1) = zcoef0 * r1_e1u(ji,jj) * ( e3w_n(ji+1,jj ,1) * ( znad + rhd(ji+1,jj ,1) ) & 414 zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( e3w_n(ji+1,jj ,1) * ( znad + rhd(ji+1,jj ,1) ) & 415 & - e3w_n(ji ,jj ,1) * ( znad + rhd(ji ,jj ,1) ) ) 416 !!gm zhpj(ji,jj,1) = zcoef0 * r1_e2v(ji,jj) * ( e3w_n(ji ,jj+1,1) * ( znad + rhd(ji ,jj+1,1) ) & 417 zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( e3w_n(ji ,jj+1,1) * ( znad + rhd(ji ,jj+1,1) ) & 418 & - e3w_n(ji ,jj ,1) * ( znad + rhd(ji ,jj ,1) ) ) 408 419 ! s-coordinate pressure gradient correction 409 zuap = -zcoef0 * ( rhd (ji+1,jj,1) + rhd (ji,jj,1) + 2._wp * znad ) & 410 & * ( fsde3w(ji+1,jj,1) - fsde3w(ji,jj,1) ) / e1u(ji,jj) 411 zvap = -zcoef0 * ( rhd (ji,jj+1,1) + rhd (ji,jj,1) + 2._wp * znad ) & 412 & * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj) 420 zuap = -zcoef0 * ( rhd (ji+1,jj,1) + rhd (ji,jj,1) + 2._wp * znad ) & 421 & * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) / e1u(ji,jj) 422 !!gm & * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) * r1_e1u(ji,jj) 423 zvap = -zcoef0 * ( rhd (ji,jj+1,1) + rhd (ji,jj,1) + 2._wp * znad ) & 424 & * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) / e2v(ji,jj) 425 !!gm & * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) * r1_e2v(ji,jj) 413 426 ! add to the general momentum trend 414 427 ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap … … 422 435 DO ji = fs_2, fs_jpim1 ! vector opt. 423 436 ! hydrostatic pressure gradient along s-surfaces 437 !!gm zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj) & 424 438 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj) & 425 & * ( fse3w(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) & 426 & - fse3w(ji ,jj,jk) * ( rhd(ji ,jj,jk) + rhd(ji ,jj,jk-1) + 2*znad ) ) 427 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj) & 428 & * ( fse3w(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) & 429 & - fse3w(ji,jj ,jk) * ( rhd(ji,jj, jk) + rhd(ji,jj ,jk-1) + 2*znad ) ) 439 & * ( e3w_n(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) & 440 & - e3w_n(ji ,jj,jk) * ( rhd(ji ,jj,jk) + rhd(ji ,jj,jk-1) + 2*znad ) ) 441 !!gm zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj) & 442 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 * r1_e2v(ji,jj) & 443 & * ( e3w_n(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) & 444 & - e3w_n(ji,jj ,jk) * ( rhd(ji,jj, jk) + rhd(ji,jj ,jk-1) + 2*znad ) ) 430 445 ! s-coordinate pressure gradient correction 431 zuap = -zcoef0 * ( rhd (ji+1,jj ,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & 432 & * ( fsde3w(ji+1,jj ,jk) - fsde3w(ji,jj,jk) ) / e1u(ji,jj) 433 zvap = -zcoef0 * ( rhd (ji ,jj+1,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & 434 & * ( fsde3w(ji ,jj+1,jk) - fsde3w(ji,jj,jk) ) / e2v(ji,jj) 446 zuap = -zcoef0 * ( rhd (ji+1,jj ,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & 447 & * ( gde3w_n(ji+1,jj ,jk) - gde3w_n(ji,jj,jk) ) / e1u(ji,jj) 448 !!gm & * ( gde3w_n(ji+1,jj ,jk) - gde3w_n(ji,jj,jk) ) * r1_e1u(ji,jj) 449 zvap = -zcoef0 * ( rhd (ji ,jj+1,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & 450 & * ( gde3w_n(ji ,jj+1,jk) - gde3w_n(ji,jj,jk) ) / e2v(ji,jj) 451 !!gm & * ( gde3w_n(ji ,jj+1,jk) - gde3w_n(ji,jj,jk) ) * r1_e2v(ji,jj) 435 452 ! add to the general momentum trend 436 453 ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap … … 528 545 DO ji = 1, jpi ! vector opt. 529 546 ikt=mikt(ji,jj) 530 ziceload(ji,jj) = ziceload(ji,jj) + (znad + rhd(ji,jj,1) ) * fse3w(ji,jj,1) * (1._wp - tmask(ji,jj,1))547 ziceload(ji,jj) = ziceload(ji,jj) + (znad + rhd(ji,jj,1) ) * e3w_n(ji,jj,1) * (1._wp - tmask(ji,jj,1)) 531 548 DO jk=2,ikt-1 532 ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + rhd(ji,jj,jk-1) + rhd(ji,jj,jk)) * fse3w(ji,jj,jk) &549 ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + rhd(ji,jj,jk-1) + rhd(ji,jj,jk)) * e3w_n(ji,jj,jk) & 533 550 & * (1._wp - tmask(ji,jj,jk)) 534 551 END DO … … 544 561 ! hydrostatic pressure gradient along s-surfaces and ice shelf pressure 545 562 ! we assume ISF is in isostatic equilibrium 546 zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( 0.5_wp * fse3w(ji+1,jj ,iktp1i) & 563 !!gm zhpi(ji,jj,1) = zcoef0 * r1_e1u(ji,jj) * ( 0.5_wp * e3w_n(ji+1,jj ,iktp1i) & 564 zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( 0.5_wp * e3w_n(ji+1,jj ,iktp1i) & 547 565 & * ( 2._wp * znad + rhd(ji+1,jj ,iktp1i) + zrhdtop_oce(ji+1,jj ) ) & 548 & - 0.5_wp * fse3w(ji ,jj ,ikt ) &566 & - 0.5_wp * e3w_n(ji ,jj ,ikt ) & 549 567 & * ( 2._wp * znad + rhd(ji ,jj ,ikt ) + zrhdtop_oce(ji ,jj ) ) & 550 568 & + ( ziceload(ji+1,jj) - ziceload(ji,jj)) ) 551 zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( 0.5_wp * fse3w(ji ,jj+1,iktp1j) & 569 !!gm zhpj(ji,jj,1) = zcoef0 * r1_e2v(ji,jj) * ( 0.5_wp * e3w_n(ji ,jj+1,iktp1j) & 570 zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( 0.5_wp * e3w_n(ji ,jj+1,iktp1j) & 552 571 & * ( 2._wp * znad + rhd(ji ,jj+1,iktp1j) + zrhdtop_oce(ji ,jj+1) ) & 553 & - 0.5_wp * fse3w(ji ,jj ,ikt ) &572 & - 0.5_wp * e3w_n(ji ,jj ,ikt ) & 554 573 & * ( 2._wp * znad + rhd(ji ,jj ,ikt ) + zrhdtop_oce(ji ,jj ) ) & 555 574 & + ( ziceload(ji,jj+1) - ziceload(ji,jj) ) ) 556 575 ! s-coordinate pressure gradient correction (=0 if z coordinate) 557 zuap = -zcoef0 * ( rhd (ji+1,jj,1) + rhd (ji,jj,1) + 2._wp * znad ) & 558 & * ( fsde3w(ji+1,jj,1) - fsde3w(ji,jj,1) ) / e1u(ji,jj) 559 zvap = -zcoef0 * ( rhd (ji,jj+1,1) + rhd (ji,jj,1) + 2._wp * znad ) & 560 & * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj) 576 zuap = -zcoef0 * ( rhd (ji+1,jj,1) + rhd (ji,jj,1) + 2._wp * znad ) & 577 & * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) / e1u(ji,jj) 578 !!gm & * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) * r1_e1u(ji,jj) 579 zvap = -zcoef0 * ( rhd (ji,jj+1,1) + rhd (ji,jj,1) + 2._wp * znad ) & 580 & * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) / e2v(ji,jj) 581 !!gm & * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) * r1_e2v(ji,jj) 561 582 ! add to the general momentum trend 562 583 ua(ji,jj,1) = ua(ji,jj,1) + (zhpi(ji,jj,1) + zuap) * umask(ji,jj,1) … … 569 590 DO jj = 2, jpjm1 570 591 DO ji = fs_2, fs_jpim1 ! vector opt. 571 iku = miku(ji,jj) ;572 zpshpi(ji,jj) =0.0_wp ; zpshpj(ji,jj)=0.0_wp592 iku = miku(ji,jj) 593 zpshpi(ji,jj) = 0._wp ; zpshpj(ji,jj) = 0._wp 573 594 ze3wu = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku)) 574 595 ! u direction 575 596 IF ( iku .GT. 1 ) THEN 576 597 ! case iku 598 !!gm zhpi(ji,jj,iku) = zcoef0 * r1_e1u(ji,jj) * ze3wu & 577 599 zhpi(ji,jj,iku) = zcoef0 / e1u(ji,jj) * ze3wu & 578 600 & * ( rhd (ji+1,jj,iku) + rhd (ji,jj,iku) & 579 601 & + SIGN(1._wp,ze3wu) * grui(ji,jj) + 2._wp * znad ) 580 602 ! corrective term ( = 0 if z coordinate ) 603 !!gm zuap = -zcoef0 * ( arui(ji,jj) + 2._wp * znad ) * gzui(ji,jj) * r1_e1u(ji,jj) 581 604 zuap = -zcoef0 * ( arui(ji,jj) + 2._wp * znad ) * gzui(ji,jj) / e1u(ji,jj) 582 605 ! zhpi will be added in interior loop … … 586 609 587 610 ! case iku + 1 (remove the zphi term added in the interior loop and compute the one corrected for zps) 611 !!gm zhpiint = zcoef0 * r1_e1u(ji,jj) & 588 612 zhpiint = zcoef0 / e1u(ji,jj) & 589 & * ( fse3w(ji+1,jj ,iku+1) * ( (rhd(ji+1,jj,iku+1) + znad) &613 & * ( e3w_n(ji+1,jj ,iku+1) * ( (rhd(ji+1,jj,iku+1) + znad) & 590 614 & + (rhd(ji+1,jj,iku ) + znad) ) * tmask(ji+1,jj,iku) & 591 & - fse3w(ji ,jj ,iku+1) * ( (rhd(ji ,jj,iku+1) + znad) &615 & - e3w_n(ji ,jj ,iku+1) * ( (rhd(ji ,jj,iku+1) + znad) & 592 616 & + (rhd(ji ,jj,iku ) + znad) ) * tmask(ji ,jj,iku) ) 617 !!gm zhpi(ji,jj,iku+1) = zcoef0 * r1_e1u(ji,jj) * ge3rui(ji,jj) - zhpiint 593 618 zhpi(ji,jj,iku+1) = zcoef0 / e1u(ji,jj) * ge3rui(ji,jj) - zhpiint 594 619 END IF … … 599 624 IF ( ikv .GT. 1 ) THEN 600 625 ! case ikv 626 !!gm zhpj(ji,jj,ikv) = zcoef0 * r1_e2v(ji,jj) * ze3wv & 601 627 zhpj(ji,jj,ikv) = zcoef0 / e2v(ji,jj) * ze3wv & 602 628 & * ( rhd(ji,jj+1,ikv) + rhd (ji,jj,ikv) & 603 629 & + SIGN(1._wp,ze3wv) * grvi(ji,jj) + 2._wp * znad ) 604 630 ! corrective term ( = 0 if z coordinate ) 631 !!gm zvap = -zcoef0 * ( arvi(ji,jj) + 2._wp * znad ) * gzvi(ji,jj) * r1_e2v(ji,jj) 605 632 zvap = -zcoef0 * ( arvi(ji,jj) + 2._wp * znad ) * gzvi(ji,jj) / e2v(ji,jj) 606 633 ! zhpi will be added in interior loop … … 610 637 611 638 ! case ikv + 1 (remove the zphj term added in the interior loop and compute the one corrected for zps) 639 !!gm zhpjint = zcoef0 * r1_e2v(ji,jj) & 612 640 zhpjint = zcoef0 / e2v(ji,jj) & 613 & * ( fse3w(ji ,jj+1,ikv+1) * ( (rhd(ji,jj+1,ikv+1) + znad) &641 & * ( e3w_n(ji ,jj+1,ikv+1) * ( (rhd(ji,jj+1,ikv+1) + znad) & 614 642 & + (rhd(ji,jj+1,ikv ) + znad) ) * tmask(ji,jj+1,ikv) & 615 & - fse3w(ji ,jj ,ikv+1) * ( (rhd(ji,jj ,ikv+1) + znad) &643 & - e3w_n(ji ,jj ,ikv+1) * ( (rhd(ji,jj ,ikv+1) + znad) & 616 644 & + (rhd(ji,jj ,ikv ) + znad) ) * tmask(ji,jj ,ikv) ) 645 !!gm zhpj(ji,jj,ikv+1) = zcoef0 * r1_e2v(ji,jj) * ge3rvi(ji,jj) - zhpjint 617 646 zhpj(ji,jj,ikv+1) = zcoef0 / e2v(ji,jj) * ge3rvi(ji,jj) - zhpjint 618 647 END IF … … 626 655 DO jj = 2, jpjm1 627 656 DO ji = fs_2, fs_jpim1 ! vector opt. 657 !!gm useles ! 628 658 iku=miku(ji,jj); ikv=mikv(ji,jj) 659 !!gm 629 660 DO jk = 2, jpkm1 630 661 ! hydrostatic pressure gradient along s-surfaces 631 662 ! zhpi is masked for the first wet cell (contribution already done in the upper bloc) 632 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) + zhpi(ji,jj,jk-1) & 633 & + zcoef0 / e1u(ji,jj) & 634 & * ( fse3w(ji+1,jj ,jk) * ( (rhd(ji+1,jj,jk ) + znad) & 635 & + (rhd(ji+1,jj,jk-1) + znad) ) * tmask(ji+1,jj,jk-1) & 636 & - fse3w(ji ,jj ,jk) * ( (rhd(ji ,jj,jk ) + znad) & 637 & + (rhd(ji ,jj,jk-1) + znad) ) * tmask(ji ,jj,jk-1) ) 663 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) + zhpi(ji,jj,jk-1) & 664 !!gm & + zcoef0 * r1_e1u(ji,jj) & 665 & + zcoef0 / e1u(ji,jj) & 666 & * ( e3w_n(ji+1,jj,jk) * ( (rhd(ji+1,jj,jk ) + znad) & 667 & + (rhd(ji+1,jj,jk-1) + znad) ) * tmask(ji+1,jj,jk-1) & 668 & - e3w_n(ji ,jj,jk) * ( (rhd(ji ,jj,jk ) + znad) & 669 & + (rhd(ji ,jj,jk-1) + znad) ) * tmask(ji ,jj,jk-1) ) 638 670 ! s-coordinate pressure gradient correction 639 671 ! corrective term, we mask this term for the first wet level beneath the ice shelf (contribution done in the upper bloc) 640 zuap = - zcoef0 * ( rhd (ji+1,jj ,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & 641 & * ( fsde3w(ji+1,jj ,jk) - fsde3w(ji,jj,jk) ) / e1u(ji,jj) * umask(ji,jj,jk-1) 672 zuap = - zcoef0 * ( rhd (ji+1,jj ,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & 673 & * ( gde3w_n(ji+1,jj ,jk) - gde3w_n(ji,jj,jk) ) / e1u(ji,jj) * umask(ji,jj,jk-1) 674 !!gm & * ( gde3w_n(ji+1,jj ,jk) - gde3w_n(ji,jj,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk-1) 642 675 ua(ji,jj,jk) = ua(ji,jj,jk) + ( zhpi(ji,jj,jk) + zuap) * umask(ji,jj,jk) 643 676 644 677 ! hydrostatic pressure gradient along s-surfaces 645 678 ! zhpi is masked for the first wet cell (contribution already done in the upper bloc) 646 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) + zhpj(ji,jj,jk-1) & 647 & + zcoef0 / e2v(ji,jj) & 648 & * ( fse3w(ji ,jj+1,jk) * ( (rhd(ji,jj+1,jk ) + znad) & 649 & + (rhd(ji,jj+1,jk-1) + znad) ) * tmask(ji,jj+1,jk-1) & 650 & - fse3w(ji ,jj ,jk) * ( (rhd(ji,jj ,jk ) + znad) & 651 & + (rhd(ji,jj ,jk-1) + znad) ) * tmask(ji,jj ,jk-1) ) 679 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) + zhpj(ji,jj,jk-1) & 680 !!gm & + zcoef0 * r1_e2v(ji,jj) & 681 & + zcoef0 / e2v(ji,jj) & 682 & * ( e3w_n(ji ,jj+1,jk) * ( (rhd(ji,jj+1,jk ) + znad) & 683 & + (rhd(ji,jj+1,jk-1) + znad) ) * tmask(ji,jj+1,jk-1) & 684 & - e3w_n(ji ,jj ,jk) * ( (rhd(ji,jj ,jk ) + znad) & 685 & + (rhd(ji,jj ,jk-1) + znad) ) * tmask(ji,jj ,jk-1) ) 652 686 ! s-coordinate pressure gradient correction 653 687 ! corrective term, we mask this term for the first wet level beneath the ice shelf (contribution done in the upper bloc) 654 zvap = - zcoef0 * ( rhd (ji ,jj+1,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & 655 & * ( fsde3w(ji ,jj+1,jk) - fsde3w(ji,jj,jk) ) / e2v(ji,jj) * vmask(ji,jj,jk-1) 688 zvap = - zcoef0 * ( rhd (ji ,jj+1,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & 689 & * ( gde3w_n(ji ,jj+1,jk) - gde3w_n(ji,jj,jk) ) / e2v(ji,jj) * vmask(ji,jj,jk-1) 690 !!gm & * ( gde3w_n(ji ,jj+1,jk) - gde3w_n(ji,jj,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk-1) 656 691 ! add to the general momentum trend 657 692 va(ji,jj,jk) = va(ji,jj,jk) + ( zhpj(ji,jj,jk) + zvap ) * vmask(ji,jj,jk) … … 671 706 IF (iku .GT. 1) THEN 672 707 ! remove old value (interior case) 673 zuap = -zcoef0 * ( rhd (ji+1,jj ,iku) + rhd (ji,jj,iku) + 2._wp * znad ) & 674 & * ( fsde3w(ji+1,jj ,iku) - fsde3w(ji,jj,iku) ) / e1u(ji,jj) 708 zuap = -zcoef0 * ( rhd (ji+1,jj ,iku) + rhd (ji,jj,iku) + 2._wp * znad ) & 709 & * ( gde3w_n(ji+1,jj ,iku) - gde3w_n(ji,jj,iku) ) / e1u(ji,jj) 710 !!gm & * ( gde3w_n(ji+1,jj ,iku) - gde3w_n(ji,jj,iku) ) * r1_e1u(ji,jj) 675 711 ua(ji,jj,iku) = ua(ji,jj,iku) - zhpi(ji,jj,iku) - zuap 676 712 ! put new value 677 713 ! -zpshpi to avoid double contribution of the partial step in the top layer 714 !!gm zuap = -zcoef0 * ( aru(ji,jj) + 2._wp * znad ) * gzu(ji,jj) * r1_e1u(ji,jj) 678 715 zuap = -zcoef0 * ( aru(ji,jj) + 2._wp * znad ) * gzu(ji,jj) / e1u(ji,jj) 679 716 zhpi(ji,jj,iku) = zhpi(ji,jj,iku-1) + zcoef0 / e1u(ji,jj) * ge3ru(ji,jj) - zpshpi(ji,jj) 717 !!gm zhpi(ji,jj,iku) = zhpi(ji,jj,iku-1) + zcoef0 * r1_e1u(ji,jj) * ge3ru(ji,jj) - zpshpi(ji,jj) 680 718 ua(ji,jj,iku) = ua(ji,jj,iku) + zhpi(ji,jj,iku) + zuap 681 719 END IF … … 683 721 IF (ikv .GT. 1) THEN 684 722 ! remove old value (interior case) 685 zvap = -zcoef0 * ( rhd (ji ,jj+1,ikv) + rhd (ji,jj,ikv) + 2._wp * znad ) & 686 & * ( fsde3w(ji ,jj+1,ikv) - fsde3w(ji,jj,ikv) ) / e2v(ji,jj) 723 zvap = -zcoef0 * ( rhd (ji ,jj+1,ikv) + rhd (ji,jj,ikv) + 2._wp * znad ) & 724 & * ( gde3w_n(ji ,jj+1,ikv) - gde3w_n(ji,jj,ikv) ) / e2v(ji,jj) 725 !!gm & * ( gde3w_n(ji ,jj+1,ikv) - gde3w_n(ji,jj,ikv) ) * r1_e2v(ji,jj) 687 726 va(ji,jj,ikv) = va(ji,jj,ikv) - zhpj(ji,jj,ikv) - zvap 688 727 ! put new value 689 728 ! -zpshpj to avoid double contribution of the partial step in the top layer 729 !!gm zvap = -zcoef0 * ( arv(ji,jj) + 2._wp * znad ) * gzv(ji,jj) * r1_e2v(ji,jj) 690 730 zvap = -zcoef0 * ( arv(ji,jj) + 2._wp * znad ) * gzv(ji,jj) / e2v(ji,jj) 691 731 zhpj(ji,jj,ikv) = zhpj(ji,jj,ikv-1) + zcoef0 / e2v(ji,jj) * ge3rv(ji,jj) - zpshpj(ji,jj) 732 !!gm zhpj(ji,jj,ikv) = zhpj(ji,jj,ikv-1) + zcoef0 * r1_e2v(ji,jj) * ge3rv(ji,jj) - zpshpj(ji,jj) 692 733 va(ji,jj,ikv) = va(ji,jj,ikv) + zhpj(ji,jj,ikv) + zvap 693 734 END IF … … 750 791 DO jj = 2, jpjm1 751 792 DO ji = fs_2, fs_jpim1 ! vector opt. 752 drhoz(ji,jj,jk) = rhd (ji ,jj ,jk) - rhd(ji,jj,jk-1)753 dzz (ji,jj,jk) = fsde3w(ji ,jj ,jk) - fsde3w(ji,jj,jk-1)754 drhox(ji,jj,jk) = rhd (ji+1,jj ,jk) - rhd(ji,jj,jk )755 dzx (ji,jj,jk) = fsde3w(ji+1,jj ,jk) - fsde3w(ji,jj,jk )756 drhoy(ji,jj,jk) = rhd (ji ,jj+1,jk) - rhd(ji,jj,jk )757 dzy (ji,jj,jk) = fsde3w(ji ,jj+1,jk) - fsde3w(ji,jj,jk )793 drhoz(ji,jj,jk) = rhd (ji ,jj ,jk) - rhd (ji,jj,jk-1) 794 dzz (ji,jj,jk) = gde3w_n(ji ,jj ,jk) - gde3w_n(ji,jj,jk-1) 795 drhox(ji,jj,jk) = rhd (ji+1,jj ,jk) - rhd (ji,jj,jk ) 796 dzx (ji,jj,jk) = gde3w_n(ji+1,jj ,jk) - gde3w_n(ji,jj,jk ) 797 drhoy(ji,jj,jk) = rhd (ji ,jj+1,jk) - rhd (ji,jj,jk ) 798 dzy (ji,jj,jk) = gde3w_n(ji ,jj+1,jk) - gde3w_n(ji,jj,jk ) 758 799 END DO 759 800 END DO … … 837 878 !------------------------------------------------------------- 838 879 839 !!bug gm : e3w- de3w = 0.5*e3w .... and de3w(2)-de3w(1)=e3w(2) .... to be verified840 ! true if de3w is really defined as the sum of the e3w scale factors as, it seems to me, it should be880 !!bug gm : e3w-gde3w = 0.5*e3w .... and gde3w(2)-gde3w(1)=e3w(2) .... to be verified 881 ! true if gde3w is really defined as the sum of the e3w scale factors as, it seems to me, it should be 841 882 842 883 DO jj = 2, jpjm1 843 884 DO ji = fs_2, fs_jpim1 ! vector opt. 844 rho_k(ji,jj,1) = -grav * ( fse3w(ji,jj,1) - fsde3w(ji,jj,1) ) &845 & * ( rhd(ji,jj,1) &846 & + 0.5_wp * ( rhd (ji,jj,2) - rhd(ji,jj,1) )&847 & * ( fse3w (ji,jj,1) - fsde3w(ji,jj,1) )&848 & / ( fsde3w(ji,jj,2) - fsde3w(ji,jj,1) ) )885 rho_k(ji,jj,1) = -grav * ( e3w_n(ji,jj,1) - gde3w_n(ji,jj,1) ) & 886 & * ( rhd(ji,jj,1) & 887 & + 0.5_wp * ( rhd (ji,jj,2) - rhd (ji,jj,1) ) & 888 & * ( e3w_n (ji,jj,1) - gde3w_n(ji,jj,1) ) & 889 & / ( gde3w_n(ji,jj,2) - gde3w_n(ji,jj,1) ) ) 849 890 END DO 850 891 END DO … … 857 898 DO ji = fs_2, fs_jpim1 ! vector opt. 858 899 859 rho_k(ji,jj,jk) = zcoef0 * ( rhd (ji,jj,jk) + rhd(ji,jj,jk-1) ) &860 & * ( fsde3w(ji,jj,jk) - fsde3w(ji,jj,jk-1) ) &861 & - grav * z1_10 * ( 862 & ( drhow (ji,jj,jk) - drhow(ji,jj,jk-1) ) &863 & * ( fsde3w(ji,jj,jk) - fsde3w(ji,jj,jk-1) - z1_12 * ( dzw (ji,jj,jk) + dzw (ji,jj,jk-1) ) ) &864 & - ( dzw (ji,jj,jk) - dzw(ji,jj,jk-1) ) &865 & * ( rhd (ji,jj,jk) - rhd(ji,jj,jk-1) - z1_12 * ( drhow(ji,jj,jk) + drhow(ji,jj,jk-1) ) ) &900 rho_k(ji,jj,jk) = zcoef0 * ( rhd (ji,jj,jk) + rhd (ji,jj,jk-1) ) & 901 & * ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) ) & 902 & - grav * z1_10 * ( & 903 & ( drhow (ji,jj,jk) - drhow (ji,jj,jk-1) ) & 904 & * ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) - z1_12 * ( dzw (ji,jj,jk) + dzw (ji,jj,jk-1) ) ) & 905 & - ( dzw (ji,jj,jk) - dzw (ji,jj,jk-1) ) & 906 & * ( rhd (ji,jj,jk) - rhd (ji,jj,jk-1) - z1_12 * ( drhow(ji,jj,jk) + drhow(ji,jj,jk-1) ) ) & 866 907 & ) 867 908 868 rho_i(ji,jj,jk) = zcoef0 * ( rhd (ji+1,jj,jk) + rhd(ji,jj,jk) ) &869 & * ( fsde3w(ji+1,jj,jk) - fsde3w(ji,jj,jk) ) &870 & - grav* z1_10 * ( 871 & ( drhou (ji+1,jj,jk) - drhou(ji,jj,jk) ) &872 & * ( fsde3w(ji+1,jj,jk) - fsde3w(ji,jj,jk) - z1_12 * ( dzu (ji+1,jj,jk) + dzu (ji,jj,jk) ) ) &873 & - ( dzu (ji+1,jj,jk) - dzu(ji,jj,jk) ) &874 & * ( rhd (ji+1,jj,jk) - rhd(ji,jj,jk) - z1_12 * ( drhou(ji+1,jj,jk) + drhou(ji,jj,jk) ) ) &909 rho_i(ji,jj,jk) = zcoef0 * ( rhd (ji+1,jj,jk) + rhd (ji,jj,jk) ) & 910 & * ( gde3w_n(ji+1,jj,jk) - gde3w_n(ji,jj,jk) ) & 911 & - grav* z1_10 * ( & 912 & ( drhou (ji+1,jj,jk) - drhou (ji,jj,jk) ) & 913 & * ( gde3w_n(ji+1,jj,jk) - gde3w_n(ji,jj,jk) - z1_12 * ( dzu (ji+1,jj,jk) + dzu (ji,jj,jk) ) ) & 914 & - ( dzu (ji+1,jj,jk) - dzu (ji,jj,jk) ) & 915 & * ( rhd (ji+1,jj,jk) - rhd (ji,jj,jk) - z1_12 * ( drhou(ji+1,jj,jk) + drhou(ji,jj,jk) ) ) & 875 916 & ) 876 917 877 rho_j(ji,jj,jk) = zcoef0 * ( rhd (ji,jj+1,jk) + rhd (ji,jj,jk) )&878 & * ( fsde3w(ji,jj+1,jk) - fsde3w(ji,jj,jk) ) &879 & - grav* z1_10 * ( 880 & ( drhov (ji,jj+1,jk) - drhov(ji,jj,jk) ) &881 & * ( fsde3w(ji,jj+1,jk) - fsde3w(ji,jj,jk) - z1_12 * ( dzv (ji,jj+1,jk) + dzv (ji,jj,jk) ) ) &882 & - ( dzv (ji,jj+1,jk) - dzv(ji,jj,jk) ) &883 & * ( rhd (ji,jj+1,jk) - rhd(ji,jj,jk) - z1_12 * ( drhov(ji,jj+1,jk) + drhov(ji,jj,jk) ) ) &918 rho_j(ji,jj,jk) = zcoef0 * ( rhd (ji,jj+1,jk) + rhd (ji,jj,jk) ) & 919 & * ( gde3w_n(ji,jj+1,jk) - gde3w_n(ji,jj,jk) ) & 920 & - grav* z1_10 * ( & 921 & ( drhov (ji,jj+1,jk) - drhov (ji,jj,jk) ) & 922 & * ( gde3w_n(ji,jj+1,jk) - gde3w_n(ji,jj,jk) - z1_12 * ( dzv (ji,jj+1,jk) + dzv (ji,jj,jk) ) ) & 923 & - ( dzv (ji,jj+1,jk) - dzv (ji,jj,jk) ) & 924 & * ( rhd (ji,jj+1,jk) - rhd (ji,jj,jk) - z1_12 * ( drhov(ji,jj+1,jk) + drhov(ji,jj,jk) ) ) & 884 925 & ) 885 926 … … 897 938 DO jj = 2, jpjm1 898 939 DO ji = fs_2, fs_jpim1 ! vector opt. 940 !!gm zhpi(ji,jj,1) = ( rho_k(ji+1,jj ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj) 899 941 zhpi(ji,jj,1) = ( rho_k(ji+1,jj ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) / e1u(ji,jj) 900 942 zhpj(ji,jj,1) = ( rho_k(ji ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) / e2v(ji,jj) 943 !!gm zhpj(ji,jj,1) = ( rho_k(ji ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) * r1_e2v(ji,jj) 901 944 ! add to the general momentum trend 902 945 ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) … … 915 958 & + ( ( rho_k(ji+1,jj,jk) - rho_k(ji,jj,jk ) ) & 916 959 & - ( rho_i(ji ,jj,jk) - rho_i(ji,jj,jk-1) ) ) / e1u(ji,jj) 960 !!gm & - ( rho_i(ji ,jj,jk) - rho_i(ji,jj,jk-1) ) ) * r1_e1u(ji,jj) 917 961 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) & 918 962 & + ( ( rho_k(ji,jj+1,jk) - rho_k(ji,jj,jk ) ) & 919 963 & -( rho_j(ji,jj ,jk) - rho_j(ji,jj,jk-1) ) ) / e2v(ji,jj) 964 !!gm & -( rho_j(ji,jj ,jk) - rho_j(ji,jj,jk-1) ) ) * r1_e2v(ji,jj) 920 965 ! add to the general momentum trend 921 966 ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) … … 983 1028 DO ji = 1, jpi 984 1029 jk = mbathy(ji,jj) 985 IF( jk <= 0 ) THEN; zrhh(ji,jj,:) = 0._wp986 ELSE IF(jk == 1) THEN; zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk)987 ELSE IF(jk < jpkm1) THEN1030 IF( jk <= 0 ) THEN ; zrhh(ji,jj, : ) = 0._wp 1031 ELSEIF( jk == 1 ) THEN ; zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk) 1032 ELSEIF( jk < jpkm1 ) THEN 988 1033 DO jkk = jk+1, jpk 989 zrhh(ji,jj,jkk) = interp1( fsde3w(ji,jj,jkk), fsde3w(ji,jj,jkk-1),&990 fsde3w(ji,jj,jkk-2), rhd(ji,jj,jkk-1), rhd(ji,jj,jkk-2))1034 zrhh(ji,jj,jkk) = interp1(gde3w_n(ji,jj,jkk ), gde3w_n(ji,jj,jkk-1), & 1035 & gde3w_n(ji,jj,jkk-2), rhd (ji,jj,jkk-1), rhd(ji,jj,jkk-2)) 991 1036 END DO 992 1037 ENDIF … … 997 1042 DO jj = 1, jpj 998 1043 DO ji = 1, jpi 999 zdept(ji,jj,1) = 0.5_wp * fse3w(ji,jj,1) - sshn(ji,jj) * znad1044 zdept(ji,jj,1) = 0.5_wp * e3w_n(ji,jj,1) - sshn(ji,jj) * znad 1000 1045 END DO 1001 1046 END DO … … 1004 1049 DO jj = 1, jpj 1005 1050 DO ji = 1, jpi 1006 zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + fse3w(ji,jj,jk)1051 zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + e3w_n(ji,jj,jk) 1007 1052 END DO 1008 1053 END DO … … 1022 1067 zrhdt1 = zrhh(ji,jj,1) - interp3(zdept(ji,jj,1),asp(ji,jj,1), & 1023 1068 bsp(ji,jj,1), csp(ji,jj,1), & 1024 dsp(ji,jj,1) ) * 0.25_wp * fse3w(ji,jj,1)1069 dsp(ji,jj,1) ) * 0.25_wp * e3w_n(ji,jj,1) 1025 1070 1026 1071 ! assuming linear profile across the top half surface layer 1027 zhpi(ji,jj,1) = 0.5_wp * fse3w(ji,jj,1) * zrhdt11072 zhpi(ji,jj,1) = 0.5_wp * e3w_n(ji,jj,1) * zrhdt1 1028 1073 END DO 1029 1074 END DO … … 1055 1100 DO jj = 2, jpjm1 1056 1101 DO ji = 2, jpim1 1057 zu(ji,jj,1) = - ( fse3u(ji,jj,1) - zsshu_n(ji,jj) * znad)1058 zv(ji,jj,1) = - ( fse3v(ji,jj,1) - zsshv_n(ji,jj) * znad)1102 zu(ji,jj,1) = - ( e3u_n(ji,jj,1) - zsshu_n(ji,jj) * znad) 1103 zv(ji,jj,1) = - ( e3v_n(ji,jj,1) - zsshv_n(ji,jj) * znad) 1059 1104 END DO 1060 1105 END DO … … 1063 1108 DO jj = 2, jpjm1 1064 1109 DO ji = 2, jpim1 1065 zu(ji,jj,jk) = zu(ji,jj,jk-1)- fse3u(ji,jj,jk)1066 zv(ji,jj,jk) = zv(ji,jj,jk-1)- fse3v(ji,jj,jk)1110 zu(ji,jj,jk) = zu(ji,jj,jk-1)- e3u_n(ji,jj,jk) 1111 zv(ji,jj,jk) = zv(ji,jj,jk-1)- e3v_n(ji,jj,jk) 1067 1112 END DO 1068 1113 END DO … … 1072 1117 DO jj = 2, jpjm1 1073 1118 DO ji = 2, jpim1 1074 zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * fse3u(ji,jj,jk)1075 zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * fse3v(ji,jj,jk)1119 zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u_n(ji,jj,jk) 1120 zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v_n(ji,jj,jk) 1076 1121 END DO 1077 1122 END DO … … 1142 1187 ! update the momentum trends in u direction 1143 1188 1189 !!gm zdpdx1 = zcoef0 * r1_e1u(ji,jj) * (zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk)) 1144 1190 zdpdx1 = zcoef0 / e1u(ji,jj) * (zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk)) 1145 1191 IF( lk_vvl ) THEN 1192 !!gm zdpdx2 = zcoef0 * r1_e1u(ji,jj) * & 1146 1193 zdpdx2 = zcoef0 / e1u(ji,jj) * & 1147 1194 ( REAL(jis-jid, wp) * (zpwes + zpwed) + (sshn(ji+1,jj)-sshn(ji,jj)) ) 1148 1195 ELSE 1196 !!gm zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed) 1149 1197 zdpdx2 = zcoef0 / e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed) 1150 1198 ENDIF … … 1199 1247 ! update the momentum trends in v direction 1200 1248 1249 !!gm zdpdy1 = zcoef0 * r1_e2v(ji,jj) * (zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk)) 1201 1250 zdpdy1 = zcoef0 / e2v(ji,jj) * (zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk)) 1202 1251 IF( lk_vvl ) THEN 1252 !!gm zdpdy2 = zcoef0 * r1_e2v(ji,jj) * & 1203 1253 zdpdy2 = zcoef0 / e2v(ji,jj) * & 1204 1254 ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (sshn(ji,jj+1)-sshn(ji,jj)) ) 1205 1255 ELSE 1256 !!gm zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd ) 1206 1257 zdpdy2 = zcoef0 / e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd ) 1207 1258 ENDIF -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
r5836 r5845 46 46 47 47 !! * Substitutions 48 # include "domzgr_substitute.h90"49 48 # include "vectopt_loop_substitute.h90" 50 49 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90
r5836 r5845 41 41 42 42 !! * Substitutions 43 # include "domzgr_substitute.h90"44 43 # include "vectopt_loop_substitute.h90" 45 44 !!---------------------------------------------------------------------- … … 135 134 DO jj = 2, jpjm1 136 135 DO ji = 2, jpim1 137 uslp (ji,jj,jk) = - ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)138 vslp (ji,jj,jk) = - ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)139 wslpi(ji,jj,jk) = - ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * r1_e1t(ji,jj) * tmask(ji,jj,jk) * 0.5140 wslpj(ji,jj,jk) = - ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * r1_e2t(ji,jj) * tmask(ji,jj,jk) * 0.5136 uslp (ji,jj,jk) = - ( gdept_b(ji+1,jj,jk) - gdept_b(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 137 vslp (ji,jj,jk) = - ( gdept_b(ji,jj+1,jk) - gdept_b(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 138 wslpi(ji,jj,jk) = - ( gdepw_b(ji+1,jj,jk) - gdepw_b(ji-1,jj,jk) ) * r1_e1t(ji,jj) * tmask(ji,jj,jk) * 0.5 139 wslpj(ji,jj,jk) = - ( gdepw_b(ji,jj+1,jk) - gdepw_b(ji,jj-1,jk) ) * r1_e2t(ji,jj) * tmask(ji,jj,jk) * 0.5 141 140 END DO 142 141 END DO … … 183 182 DO jj = 2, jpjm1 184 183 DO ji = fs_2, jpi ! vector opt. 185 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( fse3u(ji,jj,jk), fse3u(ji-1,jj,jk) ) * r1_e1t(ji,jj)184 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( e3u_n(ji,jj,jk), e3u_n(ji-1,jj,jk) ) * r1_e1t(ji,jj) 186 185 187 186 zmskt = 1._wp / MAX( umask(ji-1,jj,jk )+umask(ji,jj,jk+1) & … … 198 197 DO jj = 2, jpjm1 199 198 DO ji = fs_2, jpi ! vector opt. 200 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * fse3t(ji,jj,jk) * r1_e1t(ji,jj)199 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * e3t_n(ji,jj,jk) * r1_e1t(ji,jj) 201 200 202 201 zmskt = 1._wp / MAX( umask(ji-1,jj,jk ) + umask(ji,jj,jk+1) & … … 215 214 DO jj = 1, jpjm1 216 215 DO ji = 1, fs_jpim1 ! vector opt. 217 zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * fse3f(ji,jj,jk) * r1_e2f(ji,jj)216 zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * e3f_n(ji,jj,jk) * r1_e2f(ji,jj) 218 217 219 218 zmskf = 1._wp / MAX( umask(ji,jj+1,jk )+umask(ji,jj,jk+1) & … … 236 235 DO jj = 2, jpjm1 237 236 DO ji = 1, fs_jpim1 ! vector opt. 238 zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * fse3f(ji,jj,jk) * r1_e1f(ji,jj)237 zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * e3f_n(ji,jj,jk) * r1_e1f(ji,jj) 239 238 240 239 zmskf = 1._wp / MAX( vmask(ji+1,jj,jk )+vmask(ji,jj,jk+1) & … … 253 252 DO jj = 2, jpj 254 253 DO ji = 1, fs_jpim1 ! vector opt. 255 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( fse3v(ji,jj,jk), fse3v(ji,jj-1,jk) ) * r1_e2t(ji,jj)254 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( e3v_n(ji,jj,jk), e3v_n(ji,jj-1,jk) ) * r1_e2t(ji,jj) 256 255 257 256 zmskt = 1._wp / MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & … … 268 267 DO jj = 2, jpj 269 268 DO ji = 1, fs_jpim1 ! vector opt. 270 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * fse3t(ji,jj,jk) * r1_e2t(ji,jj)269 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * e3t_n(ji,jj,jk) * r1_e2t(ji,jj) 271 270 272 271 zmskt = 1./MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & … … 288 287 DO ji = 2, jpim1 !!gm Question vectop possible??? !!bug 289 288 ua(ji,jj,jk) = ua(ji,jj,jk) + ( ziut(ji+1,jj) - ziut(ji,jj ) & 290 & + zjuf(ji ,jj) - zjuf(ji,jj-1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) )289 & + zjuf(ji ,jj) - zjuf(ji,jj-1) ) / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk) ) 291 290 va(ji,jj,jk) = va(ji,jj,jk) + ( zivf(ji,jj ) - zivf(ji-1,jj) & 292 & + zjvt(ji,jj+1) - zjvt(ji,jj ) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) )291 & + zjvt(ji,jj+1) - zjvt(ji,jj ) ) / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk) ) 293 292 END DO 294 293 END DO … … 403 402 DO jk = 1, jpkm1 404 403 DO ji = 2, jpim1 405 ua(ji,jj,jk) = ua(ji,jj,jk) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) )406 va(ji,jj,jk) = va(ji,jj,jk) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) )404 ua(ji,jj,jk) = ua(ji,jj,jk) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk) ) 405 va(ji,jj,jk) = va(ji,jj,jk) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk) ) 407 406 END DO 408 407 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90
r5836 r5845 35 35 36 36 !! * Substitutions 37 # include "domzgr_substitute.h90"38 37 # include "vectopt_loop_substitute.h90" 39 38 !!---------------------------------------------------------------------- … … 87 86 DO ji = fs_2, jpi ! vector opt. 88 87 ! ! ahm * e3 * curl (computed from 1 to jpim1/jpjm1) 89 zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * fse3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1) &88 zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f_n(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1) & 90 89 & * ( e2v(ji ,jj-1) * pvb(ji ,jj-1,jk) - e2v(ji-1,jj-1) * pvb(ji-1,jj-1,jk) & 91 90 & - e1u(ji-1,jj ) * pub(ji-1,jj ,jk) + e1u(ji-1,jj-1) * pub(ji-1,jj-1,jk) ) * fmask(ji-1,jj-1,jk) 92 91 ! ! ahm * div (computed from 2 to jpi/jpj) 93 zdiv(ji,jj) = ahmt(ji,jj,jk) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) * tmask(ji,jj,jk) &94 & * ( e2u(ji,jj)* fse3u(ji,jj,jk) * pub(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * pub(ji-1,jj,jk) &95 & + e1v(ji,jj)* fse3v(ji,jj,jk) * pvb(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * pvb(ji,jj-1,jk) )92 zdiv(ji,jj) = ahmt(ji,jj,jk) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) * tmask(ji,jj,jk) & 93 & * ( e2u(ji,jj)*e3u_n(ji,jj,jk) * pub(ji,jj,jk) - e2u(ji-1,jj)*e3u_n(ji-1,jj,jk) * pub(ji-1,jj,jk) & 94 & + e1v(ji,jj)*e3v_n(ji,jj,jk) * pvb(ji,jj,jk) - e1v(ji,jj-1)*e3v_n(ji,jj-1,jk) * pvb(ji,jj-1,jk) ) 96 95 END DO 97 96 END DO … … 100 99 DO ji = fs_2, fs_jpim1 ! vector opt. 101 100 pua(ji,jj,jk) = pua(ji,jj,jk) + zsign * ( & 102 & - ( zcur(ji ,jj) - zcur(ji,jj-1) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) &101 & - ( zcur(ji ,jj) - zcur(ji,jj-1) ) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) & 103 102 & + ( zdiv(ji+1,jj) - zdiv(ji,jj ) ) * r1_e1u(ji,jj) ) 104 103 ! 105 104 pva(ji,jj,jk) = pva(ji,jj,jk) + zsign * ( & 106 & ( zcur(ji,jj ) - zcur(ji-1,jj) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) &105 & ( zcur(ji,jj ) - zcur(ji-1,jj) ) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) & 107 106 & + ( zdiv(ji,jj+1) - zdiv(ji ,jj) ) * r1_e2v(ji,jj) ) 108 107 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r5643 r5845 55 55 PUBLIC dyn_nxt ! routine called by step.F90 56 56 57 !! * Substitutions58 # include "domzgr_substitute.h90"59 57 !!---------------------------------------------------------------------- 60 58 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 146 144 ELSE ! applied on thickness weighted velocity 147 145 DO jk = 1, jpkm1 148 ua(:,:,jk) = ( ub(:,:,jk) * fse3u_b(:,:,jk) & 149 & + z2dt * ua(:,:,jk) * fse3u_n(:,:,jk) ) & 150 & / fse3u_a(:,:,jk) * umask(:,:,jk) 151 va(:,:,jk) = ( vb(:,:,jk) * fse3v_b(:,:,jk) & 152 & + z2dt * va(:,:,jk) * fse3v_n(:,:,jk) ) & 153 & / fse3v_a(:,:,jk) * vmask(:,:,jk) 146 ua(:,:,jk) = ( ub(:,:,jk) * e3u_b(:,:,jk) & 147 & + z2dt * ua(:,:,jk) * e3u_n(:,:,jk) ) / e3u_a(:,:,jk) * umask(:,:,jk) 148 va(:,:,jk) = ( vb(:,:,jk) * e3v_b(:,:,jk) & 149 & + z2dt * va(:,:,jk) * e3v_n(:,:,jk) ) / e3v_a(:,:,jk) * vmask(:,:,jk) 154 150 END DO 155 151 ENDIF … … 160 156 ! Ensure below that barotropic velocities match time splitting estimate 161 157 ! Compute actual transport and replace it with ts estimate at "after" time step 162 zue(:,:) = fse3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1)163 zve(:,:) = fse3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1)158 zue(:,:) = e3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 159 zve(:,:) = e3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 164 160 DO jk = 2, jpkm1 165 zue(:,:) = zue(:,:) + fse3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk)166 zve(:,:) = zve(:,:) + fse3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)161 zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 162 zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 167 163 END DO 168 164 DO jk = 1, jpkm1 169 ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * hur_a(:,:) + ua_b(:,:) ) * umask(:,:,jk)170 va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * hvr_a(:,:) + va_b(:,:) ) * vmask(:,:,jk)165 ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * r1_hu_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 166 va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * r1_hv_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 171 167 END DO 172 168 … … 231 227 IF (lk_vvl) THEN 232 228 DO jk = 1, jpkm1 233 fse3t_b(:,:,jk) = fse3t_n(:,:,jk)234 fse3u_b(:,:,jk) = fse3u_n(:,:,jk)235 fse3v_b(:,:,jk) = fse3v_n(:,:,jk)229 e3t_b(:,:,jk) = e3t_n(:,:,jk) 230 e3u_b(:,:,jk) = e3u_n(:,:,jk) 231 e3v_b(:,:,jk) = e3v_n(:,:,jk) 236 232 ENDDO 237 233 ENDIF … … 261 257 IF (lk_dynspg_ts.AND.ln_bt_fw) THEN 262 258 ! No asselin filtering on thicknesses if forward time splitting 263 fse3t_b(:,:,:) = fse3t_n(:,:,:)259 e3t_b(:,:,:) = e3t_n(:,:,:) 264 260 ELSE 265 fse3t_b(:,:,:) = fse3t_n(:,:,:) + atfp * ( fse3t_b(:,:,:) - 2._wp * fse3t_n(:,:,:) + fse3t_a(:,:,:) )261 e3t_b(:,:,:) = e3t_n(:,:,:) + atfp * ( e3t_b(:,:,:) - 2._wp * e3t_n(:,:,:) + e3t_a(:,:,:) ) 266 262 ! Add volume filter correction: compatibility with tracer advection scheme 267 263 ! => time filter + conservation correction (only at the first level) 268 264 IF ( nn_isf == 0) THEN ! if no ice shelf melting 269 fse3t_b(:,:,1) = fse3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) &265 e3t_b(:,:,1) = e3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) & 270 266 & -rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 271 267 ELSE ! if ice shelf melting … … 273 269 DO ji = 1,jpi 274 270 jk = mikt(ji,jj) 275 fse3t_b(ji,jj,jk) = fse3t_b(ji,jj,jk) - atfp * rdt * r1_rau0 &276 & 277 & 278 & 271 e3t_b(ji,jj,jk) = e3t_b(ji,jj,jk) - atfp * rdt * r1_rau0 & 272 & * ( (emp_b(ji,jj) - emp(ji,jj) ) & 273 & - (rnf_b(ji,jj) - rnf(ji,jj) ) & 274 & + (fwfisf_b(ji,jj) - fwfisf(ji,jj)) ) * tmask(ji,jj,jk) 279 275 END DO 280 276 END DO … … 285 281 ! Before scale factor at (u/v)-points 286 282 ! ----------------------------------- 287 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' )288 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' )283 CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 284 CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 289 285 ! Leap-Frog - Asselin filter and swap: applied on velocity 290 286 ! ----------------------------------- … … 306 302 ! Temporary filtered scale factor at (u/v)-points (will become before scale factor) 307 303 !------------------------------------------------ 308 CALL dom_vvl_interpol( fse3t_b(:,:,:), ze3u_f, 'U' )309 CALL dom_vvl_interpol( fse3t_b(:,:,:), ze3v_f, 'V' )304 CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' ) 305 CALL dom_vvl_interpol( e3t_b(:,:,:), ze3v_f, 'V' ) 310 306 ! Leap-Frog - Asselin filter and swap: applied on thickness weighted velocity 311 307 ! ----------------------------------- =========================== … … 313 309 DO jj = 1, jpj 314 310 DO ji = 1, jpi 315 zue3a = ua(ji,jj,jk) * fse3u_a(ji,jj,jk)316 zve3a = va(ji,jj,jk) * fse3v_a(ji,jj,jk)317 zue3n = un(ji,jj,jk) * fse3u_n(ji,jj,jk)318 zve3n = vn(ji,jj,jk) * fse3v_n(ji,jj,jk)319 zue3b = ub(ji,jj,jk) * fse3u_b(ji,jj,jk)320 zve3b = vb(ji,jj,jk) * fse3v_b(ji,jj,jk)311 zue3a = ua(ji,jj,jk) * e3u_a(ji,jj,jk) 312 zve3a = va(ji,jj,jk) * e3v_a(ji,jj,jk) 313 zue3n = un(ji,jj,jk) * e3u_n(ji,jj,jk) 314 zve3n = vn(ji,jj,jk) * e3v_n(ji,jj,jk) 315 zue3b = ub(ji,jj,jk) * e3u_b(ji,jj,jk) 316 zve3b = vb(ji,jj,jk) * e3v_b(ji,jj,jk) 321 317 ! 322 318 zuf = ( zue3n + atfp * ( zue3b - 2._wp * zue3n + zue3a ) ) / ze3u_f(ji,jj,jk) … … 330 326 END DO 331 327 END DO 332 fse3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1) ! e3u_b <-- filtered scale factor333 fse3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1)328 e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1) ! e3u_b <-- filtered scale factor 329 e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 334 330 ENDIF 335 331 ! … … 339 335 ! Revert "before" velocities to time split estimate 340 336 ! Doing it here also means that asselin filter contribution is removed 341 zue(:,:) = fse3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1)342 zve(:,:) = fse3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)337 zue(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 338 zve(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1) 343 339 DO jk = 2, jpkm1 344 zue(:,:) = zue(:,:) + fse3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk)345 zve(:,:) = zve(:,:) + fse3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)340 zue(:,:) = zue(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 341 zve(:,:) = zve(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 346 342 END DO 347 343 DO jk = 1, jpkm1 348 ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * hur(:,:) - un_b(:,:)) * umask(:,:,jk)349 vb(:,:,jk) = vb(:,:,jk) - (zve(:,:) * hvr(:,:) - vn_b(:,:)) * vmask(:,:,jk)344 ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * r1_hu_n(:,:) - un_b(:,:)) * umask(:,:,jk) 345 vb(:,:,jk) = vb(:,:,jk) - (zve(:,:) * r1_hv_n(:,:) - vn_b(:,:)) * vmask(:,:,jk) 350 346 END DO 351 347 ENDIF … … 359 355 ! 360 356 IF (lk_vvl) THEN 361 hu_b(:,:) = 0.362 hv_b(:,:) = 0.363 DO jk = 1, jpkm1364 hu_b(:,:) = hu_b(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk)365 hv_b(:,:) = hv_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk)357 hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1) 358 hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1) 359 DO jk = 2, jpkm1 360 hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk) 361 hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk) 366 362 END DO 367 hur_b(:,:) = umask_i(:,:) / ( hu_b(:,:) + 1._wp - umask_i(:,:) ) 368 hvr_b(:,:) = vmask_i(:,:) / ( hv_b(:,:) + 1._wp - vmask_i(:,:) )369 ENDIF370 !371 un_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp372 u b_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp373 !363 !!gm don't understand the use of umask_i .... 364 r1_hu_b(:,:) = umask_i(:,:) / ( hu_b(:,:) + 1._wp - umask_i(:,:) ) 365 r1_hv_b(:,:) = vmask_i(:,:) / ( hv_b(:,:) + 1._wp - vmask_i(:,:) ) 366 ENDIF 367 ! 368 un_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp 369 ub_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp 374 370 DO jk = 1, jpkm1 375 371 DO jj = 1, jpj 376 372 DO ji = 1, jpi 377 un_b(ji,jj) = un_b(ji,jj) + fse3u_a(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)378 vn_b(ji,jj) = vn_b(ji,jj) + fse3v_a(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)373 un_b(ji,jj) = un_b(ji,jj) + e3u_a(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 374 vn_b(ji,jj) = vn_b(ji,jj) + e3v_a(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 379 375 ! 380 ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk)381 vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk)376 ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 377 vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 382 378 END DO 383 379 END DO 384 380 END DO 385 ! 386 ! 387 un_b(:,:) = un_b(:,:) * hur_a(:,:) 388 vn_b(:,:) = vn_b(:,:) * hvr_a(:,:) 389 ub_b(:,:) = ub_b(:,:) * hur_b(:,:) 390 vb_b(:,:) = vb_b(:,:) * hvr_b(:,:) 391 ! 392 ! 393 381 un_b(:,:) = un_b(:,:) * r1_hu_a(:,:) 382 vn_b(:,:) = vn_b(:,:) * r1_hv_a(:,:) 383 ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 384 vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 385 ! 394 386 IF( l_trddyn ) THEN ! 3D output: asselin filter trends on momentum 395 387 zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r5836 r5845 46 46 47 47 !! * Substitutions 48 # include "domzgr_substitute.h90"49 48 # include "vectopt_loop_substitute.h90" 50 49 !!---------------------------------------------------------------------- … … 78 77 !! period is used to prevent the divergence of odd and even time step. 79 78 !!---------------------------------------------------------------------- 80 !81 79 INTEGER, INTENT(in ) :: kt ! ocean time-step index 82 80 INTEGER, INTENT( out) :: kindic ! solver flag … … 97 95 98 96 IF( l_trddyn ) THEN ! temporary save of ta and sa trends 99 CALL wrk_alloc( jpi, jpj, jpk,ztrdu, ztrdv )97 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 100 98 ztrdu(:,:,:) = ua(:,:,:) 101 99 ztrdv(:,:,:) = va(:,:,:) … … 139 137 ! 140 138 IF( nn_ice_embd == 2 ) THEN !== embedded sea ice: Pressure gradient due to snow-ice mass ==! 141 CALL wrk_alloc( jpi, jpj,zpice )139 CALL wrk_alloc( jpi,jpj, zpice ) 142 140 ! 143 141 zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) … … 151 149 END DO 152 150 ! 153 CALL wrk_dealloc( jpi, jpj,zpice )151 CALL wrk_dealloc( jpi,jpj, zpice ) 154 152 ENDIF 155 153 ! … … 188 186 CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 189 187 ! 190 CALL wrk_dealloc( jpi, jpj, jpk,ztrdu, ztrdv )188 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 191 189 ENDIF 192 190 ! ! print mean trends (used for debugging) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90
r5836 r5845 34 34 35 35 !! * Substitutions 36 # include "domzgr_substitute.h90"37 36 # include "vectopt_loop_substitute.h90" 38 37 !!---------------------------------------------------------------------- … … 81 80 DO jj = 2, jpjm1 ! now surface pressure gradient 82 81 DO ji = fs_2, fs_jpim1 ! vector opt. 83 spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) /e1u(ji,jj)84 spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) /e2v(ji,jj)82 spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj) 83 spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj) 85 84 END DO 86 85 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r5836 r5845 59 59 60 60 !! * Substitutions 61 # include "domzgr_substitute.h90"62 61 # include "vectopt_loop_substitute.h90" 63 62 !!---------------------------------------------------------------------- … … 155 154 DO jj = 2, jpjm1 156 155 DO ji = fs_2, fs_jpim1 ! vector opt. 157 ua(ji,jj,jk) = ( ub(ji,jj,jk) * fse3u_b(ji,jj,jk) & 158 & + z2dt * ua(ji,jj,jk) * fse3u_n(ji,jj,jk) ) & 159 & / fse3u_a(ji,jj,jk) * umask(ji,jj,jk) 160 va(ji,jj,jk) = ( vb(ji,jj,jk) * fse3v_b(ji,jj,jk) & 161 & + z2dt * va(ji,jj,jk) * fse3v_n(ji,jj,jk) ) & 162 & / fse3v_a(ji,jj,jk) * vmask(ji,jj,jk) 156 ua(ji,jj,jk) = ( ub(ji,jj,jk) * e3u_b(ji,jj,jk) & 157 & + z2dt * ua(ji,jj,jk) * e3u_n(ji,jj,jk) ) / e3u_a(ji,jj,jk) * umask(ji,jj,jk) 158 va(ji,jj,jk) = ( vb(ji,jj,jk) * e3v_b(ji,jj,jk) & 159 & + z2dt * va(ji,jj,jk) * e3v_n(ji,jj,jk) ) / e3v_a(ji,jj,jk) * vmask(ji,jj,jk) 163 160 END DO 164 161 END DO … … 171 168 DO jj = 2, jpjm1 ! Surface pressure gradient (now) 172 169 DO ji = fs_2, fs_jpim1 ! vector opt. 173 spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) /e1u(ji,jj)174 spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) /e2v(ji,jj)170 spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj) 171 spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj) 175 172 END DO 176 173 END DO … … 211 208 DO jj = 2, jpjm1 212 209 DO ji = fs_2, fs_jpim1 ! vector opt. 213 spgu(ji,jj) = fse3u_a(ji,jj,1) * ua(ji,jj,1)214 spgv(ji,jj) = fse3v_a(ji,jj,1) * va(ji,jj,1)210 spgu(ji,jj) = e3u_a(ji,jj,1) * ua(ji,jj,1) 211 spgv(ji,jj) = e3v_a(ji,jj,1) * va(ji,jj,1) 215 212 END DO 216 213 END DO … … 218 215 DO jj = 2, jpjm1 219 216 DO ji = fs_2, fs_jpim1 ! vector opt. 220 spgu(ji,jj) = spgu(ji,jj) + fse3u_a(ji,jj,jk) * ua(ji,jj,jk)221 spgv(ji,jj) = spgv(ji,jj) + fse3v_a(ji,jj,jk) * va(ji,jj,jk)217 spgu(ji,jj) = spgu(ji,jj) + e3u_a(ji,jj,jk) * ua(ji,jj,jk) 218 spgv(ji,jj) = spgv(ji,jj) + e3v_a(ji,jj,jk) * va(ji,jj,jk) 222 219 END DO 223 220 END DO … … 256 253 ! add contribution of gradient of after barotropic transport divergence 257 254 IF( nbondi == -1 .OR. nbondi == 2 ) gcb(3 ,:) = & 258 & gcb(3 ,:) - z2dtg * z2dt * laplacu(2 ,:) * gcdprc(3 ,:) * hu (2 ,:) * e2u(2 ,:)255 & gcb(3 ,:) - z2dtg * z2dt * laplacu(2 ,:) * gcdprc(3 ,:) * hu_n(2 ,:) * e2u(2 ,:) 259 256 IF( nbondi == 1 .OR. nbondi == 2 ) gcb(nlci-2,:) = & 260 & gcb(nlci-2,:) + z2dtg * z2dt * laplacu(nlci-2,:) * gcdprc(nlci-2,:) * hu (nlci-2,:) * e2u(nlci-2,:)257 & gcb(nlci-2,:) + z2dtg * z2dt * laplacu(nlci-2,:) * gcdprc(nlci-2,:) * hu_n(nlci-2,:) * e2u(nlci-2,:) 261 258 IF( nbondj == -1 .OR. nbondj == 2 ) gcb(: ,3) = & 262 & gcb(:,3 ) - z2dtg * z2dt * laplacv(:,2 ) * gcdprc(:,3 ) * hv (:,2 ) * e1v(:,2 )259 & gcb(:,3 ) - z2dtg * z2dt * laplacv(:,2 ) * gcdprc(:,3 ) * hv_n(:,2 ) * e1v(:,2 ) 263 260 IF( nbondj == 1 .OR. nbondj == 2 ) gcb(:,nlcj-2) = & 264 & gcb(:,nlcj-2) + z2dtg * z2dt * laplacv(:,nlcj-2) * gcdprc(:,nlcj-2) * hv (:,nlcj-2) * e1v(:,nlcj-2)261 & gcb(:,nlcj-2) + z2dtg * z2dt * laplacv(:,nlcj-2) * gcdprc(:,nlcj-2) * hv_n(:,nlcj-2) * e1v(:,nlcj-2) 265 262 ENDIF 266 263 #endif -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r5836 r5845 75 75 76 76 !! * Substitutions 77 # include "domzgr_substitute.h90"78 77 # include "vectopt_loop_substitute.h90" 79 78 !!---------------------------------------------------------------------- … … 91 90 !!---------------------------------------------------------------------- 92 91 ierr(:) = 0 93 92 ! 94 93 ALLOCATE( sshb_e(jpi,jpj), sshbb_e(jpi,jpj), & 95 94 & ub_e(jpi,jpj) , vb_e(jpi,jpj) , & 96 95 & ubb_e(jpi,jpj) , vbb_e(jpi,jpj) , STAT= ierr(1) ) 97 96 ! 98 97 ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT= ierr(2) ) 99 98 ! 100 99 IF( ln_dynvor_een ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & 101 100 & ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) ) 102 103 dyn_spg_ts_alloc = MAXVAL(ierr(:)) 104 101 ! 102 dyn_spg_ts_alloc = MAXVAL( ierr(:) ) 105 103 IF( lk_mpp ) CALL mpp_sum( dyn_spg_ts_alloc ) 106 104 IF( dyn_spg_ts_alloc /= 0 ) CALL ctl_warn('dynspg_oce_alloc: failed to allocate arrays') … … 138 136 !! Ocean Modelling, 9, 347-404. 139 137 !!--------------------------------------------------------------------- 140 !141 138 INTEGER, INTENT(in) :: kt ! ocean time-step index 142 139 ! 143 LOGICAL :: ll_fw_start 144 LOGICAL :: ll_init 145 INTEGER :: ji, jj, jk, jn 146 INTEGER :: ikbu, ikbv, noffset ! local integers147 REAL(wp) :: zraur, z1_2dt_b, z2dt_bf 140 LOGICAL :: ll_fw_start ! if true, forward integration 141 LOGICAL :: ll_init ! if true, special startup of 2d equations 142 INTEGER :: ji, jj, jk, jn ! dummy loop indices 143 INTEGER :: ikbu, ikbv, noffset ! local integers 144 REAL(wp) :: zraur, z1_2dt_b, z2dt_bf ! local scalars 148 145 REAL(wp) :: zx1, zy1, zx2, zy2 ! - - 149 146 REAL(wp) :: z1_12, z1_8, z1_4, z1_2 ! - - 150 147 REAL(wp) :: zu_spg, zv_spg ! - - 151 148 REAL(wp) :: zhura, zhvra ! - - 152 REAL(wp) :: za0, za1, za2, za3 153 ! 154 REAL(wp), POINTER, DIMENSION(:,:) :: zun_e, zvn_e, zsshp2_e155 REAL(wp), POINTER, DIMENSION(:,:) :: zu_trd, zv_trd, zu_frc, zv_frc, zssh_frc156 REAL(wp), POINTER, DIMENSION(:,:) :: zu_sum, zv_sum, zwx, zwy, zhdiv157 REAL(wp), POINTER, DIMENSION(:,:) :: zhup2_e, zhvp2_e, zhust_e, zhvst_e158 REAL(wp), POINTER, DIMENSION(:,:) :: zsshu_a, zsshv_a159 REAL(wp), POINTER, DIMENSION(:,:) :: zhf149 REAL(wp) :: za0, za1, za2, za3 ! - - 150 ! 151 REAL(wp), POINTER, DIMENSION(:,:) :: zun_e, zvn_e, zsshp2_e 152 REAL(wp), POINTER, DIMENSION(:,:) :: zu_trd, zv_trd, zu_frc, zv_frc, zssh_frc 153 REAL(wp), POINTER, DIMENSION(:,:) :: zu_sum, zv_sum, zwx, zwy, zhdiv 154 REAL(wp), POINTER, DIMENSION(:,:) :: zhup2_e, zhvp2_e, zhust_e, zhvst_e 155 REAL(wp), POINTER, DIMENSION(:,:) :: zsshu_a, zsshv_a 156 REAL(wp), POINTER, DIMENSION(:,:) :: zhf 160 157 !!---------------------------------------------------------------------- 161 158 ! 162 159 IF( nn_timing == 1 ) CALL timing_start('dyn_spg_ts') 163 160 ! 164 ! !* Allocate temporary arrays 165 CALL wrk_alloc( jpi, jpj, zsshp2_e, zhdiv ) 166 CALL wrk_alloc( jpi, jpj, zu_trd, zv_trd, zun_e, zvn_e ) 167 CALL wrk_alloc( jpi, jpj, zwx, zwy, zu_sum, zv_sum, zssh_frc, zu_frc, zv_frc) 168 CALL wrk_alloc( jpi, jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e) 169 CALL wrk_alloc( jpi, jpj, zsshu_a, zsshv_a ) 170 CALL wrk_alloc( jpi, jpj, zhf ) 171 ! 172 ! !* Local constant initialization 173 z1_12 = 1._wp / 12._wp 161 CALL wrk_alloc( jpi,jpj, zsshp2_e, zhdiv ) 162 CALL wrk_alloc( jpi,jpj, zu_trd, zv_trd, zun_e, zvn_e ) 163 CALL wrk_alloc( jpi,jpj, zwx, zwy, zu_sum, zv_sum, zssh_frc, zu_frc, zv_frc) 164 CALL wrk_alloc( jpi,jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e) 165 CALL wrk_alloc( jpi,jpj, zsshu_a, zsshv_a ) 166 CALL wrk_alloc( jpi,jpj, zhf ) 167 ! 168 z1_12 = 1._wp / 12._wp !* Local constant initialization 174 169 z1_8 = 0.125_wp 175 170 z1_4 = 0.25_wp 176 171 z1_2 = 0.5_wp 177 172 zraur = 1._wp / rau0 178 ! 179 IF( kt == nit000 .AND. neuler == 0 ) THEN ! reciprocal of baroclinic time step 180 z2dt_bf = rdt 181 ELSE 182 z2dt_bf = 2.0_wp * rdt 173 ! ! reciprocal of baroclinic time step 174 IF( kt == nit000 .AND. neuler == 0 ) THEN ; z2dt_bf = rdt 175 ELSE ; z2dt_bf = 2.0_wp * rdt 183 176 ENDIF 184 177 z1_2dt_b = 1.0_wp / z2dt_bf 185 178 ! 186 ll_init = ln_bt_av! if no time averaging, then no specific restart179 ll_init = ln_bt_av ! if no time averaging, then no specific restart 187 180 ll_fw_start = .FALSE. 188 ! 189 ! time offset in steps for bdy data update 190 IF (.NOT.ln_bt_fw) THEN ; noffset=-2*nn_baro ; ELSE ; noffset = 0 ; ENDIF 181 ! ! time offset in steps for bdy data update 182 IF( .NOT.ln_bt_fw ) THEN ; noffset =-2*nn_baro 183 ELSE ; noffset = 0 184 ENDIF 191 185 ! 192 186 IF( kt == nit000 ) THEN !* initialisation … … 197 191 IF(lwp) WRITE(numout,*) 198 192 ! 199 IF (neuler==0)ll_init=.TRUE.200 ! 201 IF (ln_bt_fw.OR.(neuler==0)) THEN202 ll_fw_start=.TRUE.203 noffset = 0193 IF( neuler == 0 ) ll_init=.TRUE. 194 ! 195 IF( ln_bt_fw .OR. neuler == 0 ) THEN 196 ll_fw_start=.TRUE. 197 noffset = 0 204 198 ELSE 205 ll_fw_start=.FALSE.199 ll_fw_start=.FALSE. 206 200 ENDIF 207 201 ! 208 202 ! Set averaging weights and cycle length: 209 CALL ts_wgt(ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2) 210 ! 203 CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 ) 211 204 ! 212 205 ENDIF … … 225 218 DO jj = 1, jpjm1 226 219 DO ji = 1, jpim1 227 zwz(ji,jj) = ( ht (ji ,jj+1) + ht(ji+1,jj+1) + &228 & ht (ji ,jj ) + ht(ji+1,jj ) ) / 4._wp220 zwz(ji,jj) = ( ht_n(ji ,jj+1) + ht_n(ji+1,jj+1) + & 221 & ht_n(ji ,jj ) + ht_n(ji+1,jj ) ) / 4._wp 229 222 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = ff(ji,jj) / zwz(ji,jj) 230 223 END DO … … 233 226 DO jj = 1, jpjm1 234 227 DO ji = 1, jpim1 235 zwz(ji,jj) = ( ht (ji ,jj+1) + ht(ji+1,jj+1) + &236 & ht (ji ,jj ) + ht(ji+1,jj ) ) &228 zwz(ji,jj) = ( ht_n(ji ,jj+1) + ht_n(ji+1,jj+1) + & 229 & ht_n(ji ,jj ) + ht_n(ji+1,jj ) ) & 237 230 & / ( MAX( 1._wp, tmask(ji ,jj+1, 1) + tmask(ji+1,jj+1, 1) + & 238 231 & tmask(ji ,jj , 1) + tmask(ji+1,jj , 1) ) ) … … 276 269 DO jk = 1, jpkm1 277 270 DO jj = 1, jpjm1 278 zhf(:,jj) = zhf(:,jj) + fse3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk)271 zhf(:,jj) = zhf(:,jj) + e3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 279 272 END DO 280 273 END DO … … 308 301 ! 309 302 DO jk = 1, jpkm1 310 zu_frc(:,:) = zu_frc(:,:) + fse3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk)311 zv_frc(:,:) = zv_frc(:,:) + fse3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)303 zu_frc(:,:) = zu_frc(:,:) + e3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 304 zv_frc(:,:) = zv_frc(:,:) + e3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 312 305 END DO 313 306 ! 314 zu_frc(:,:) = zu_frc(:,:) * hur(:,:)315 zv_frc(:,:) = zv_frc(:,:) * hvr(:,:)307 zu_frc(:,:) = zu_frc(:,:) * r1_hu_n(:,:) 308 zv_frc(:,:) = zv_frc(:,:) * r1_hv_n(:,:) 316 309 ! 317 310 ! … … 327 320 ! !* barotropic Coriolis trends (vorticity scheme dependent) 328 321 ! ! -------------------------------------------------------- 329 zwx(:,:) = un_b(:,:) * hu (:,:) * e2u(:,:) ! now fluxes330 zwy(:,:) = vn_b(:,:) * hv (:,:) * e1v(:,:)322 zwx(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:) ! now fluxes 323 zwy(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:) 331 324 ! 332 325 IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN ! energy conserving or mixed scheme … … 411 404 ! 412 405 ! Note that the "unclipped" bottom friction parameter is used even with explicit drag 413 zu_frc(:,:) = zu_frc(:,:) + hur(:,:) * bfrua(:,:) * zwx(:,:)414 zv_frc(:,:) = zv_frc(:,:) + hvr(:,:) * bfrva(:,:) * zwy(:,:)406 zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * bfrua(:,:) * zwx(:,:) 407 zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * bfrva(:,:) * zwy(:,:) 415 408 ! 416 409 IF (ln_bt_fw) THEN ! Add wind forcing 417 zu_frc(:,:) = zu_frc(:,:) + zraur * utau(:,:) * hur(:,:)418 zv_frc(:,:) = zv_frc(:,:) + zraur * vtau(:,:) * hvr(:,:)410 zu_frc(:,:) = zu_frc(:,:) + zraur * utau(:,:) * r1_hu_n(:,:) 411 zv_frc(:,:) = zv_frc(:,:) + zraur * vtau(:,:) * r1_hv_n(:,:) 419 412 ELSE 420 zu_frc(:,:) = zu_frc(:,:) + zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * hur(:,:)421 zv_frc(:,:) = zv_frc(:,:) + zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * hvr(:,:)413 zu_frc(:,:) = zu_frc(:,:) + zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * r1_hu_n(:,:) 414 zv_frc(:,:) = zv_frc(:,:) + zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * r1_hv_n(:,:) 422 415 ENDIF 423 416 ! … … 484 477 ! 485 478 IF (ln_bt_fw) THEN ! FORWARD integration: start from NOW fields 486 sshn_e(:,:) = sshn 487 zun_e (:,:) = un_b 488 zvn_e (:,:) = vn_b 489 ! 490 hu_e (:,:) = hu(:,:)491 hv_e (:,:) = hv(:,:)492 hur_e (:,:) = hur(:,:)493 hvr_e (:,:) = hvr(:,:)479 sshn_e(:,:) = sshn(:,:) 480 zun_e (:,:) = un_b(:,:) 481 zvn_e (:,:) = vn_b(:,:) 482 ! 483 hu_e (:,:) = hu_n(:,:) 484 hv_e (:,:) = hv_n(:,:) 485 hur_e (:,:) = r1_hu_n(:,:) 486 hvr_e (:,:) = r1_hv_n(:,:) 494 487 ELSE ! CENTRED integration: start from BEFORE fields 495 sshn_e(:,:) = sshb 496 zun_e (:,:) = ub_b 497 zvn_e (:,:) = vb_b 498 ! 499 hu_e (:,:) = hu_b(:,:)500 hv_e (:,:) = hv_b(:,:)501 hur_e (:,:) = hur_b(:,:)502 hvr_e (:,:) = hvr_b(:,:)488 sshn_e(:,:) = sshb(:,:) 489 zun_e (:,:) = ub_b(:,:) 490 zvn_e (:,:) = vb_b(:,:) 491 ! 492 hu_e (:,:) = hu_b(:,:) 493 hv_e (:,:) = hv_b(:,:) 494 hur_e (:,:) = r1_hu_b(:,:) 495 hvr_e (:,:) = r1_hv_b(:,:) 503 496 ENDIF 504 497 ! … … 519 512 #if defined key_tide 520 513 IF ( lk_bdy .AND. lk_tide ) CALL bdy_dta_tides( kt, kit=jn, time_offset=(noffset+1) ) 521 IF ( ln_tide_pot .AND. lk_tide ) CALL upd_tide ( kt, kit=jn, koffset=noffset )514 IF ( ln_tide_pot .AND. lk_tide ) CALL upd_tide ( kt, kit=jn, koffset=noffset ) 522 515 #endif 523 516 ! … … 557 550 zhvp2_e (:,:) = hv_0(:,:) + zwy(:,:) 558 551 ELSE 559 zhup2_e (:,:) = hu (:,:)560 zhvp2_e (:,:) = hv (:,:)552 zhup2_e (:,:) = hu_n(:,:) 553 zhvp2_e (:,:) = hv_n(:,:) 561 554 ENDIF 562 555 ! !* after ssh … … 775 768 & + rdtbt * ( zhust_e(ji,jj) * zwx(ji,jj) & 776 769 & + zhup2_e(ji,jj) * zu_trd(ji,jj) & 777 & + hu(ji,jj) * zu_frc(ji,jj) ) &770 & + hu_n(ji,jj) * zu_frc(ji,jj) ) & 778 771 & ) * zhura 779 772 … … 781 774 & + rdtbt * ( zhvst_e(ji,jj) * zwy(ji,jj) & 782 775 & + zhvp2_e(ji,jj) * zv_trd(ji,jj) & 783 & + hv(ji,jj) * zv_frc(ji,jj) ) &776 & + hv_n(ji,jj) * zv_frc(ji,jj) ) & 784 777 & ) * zhvra 785 778 END DO … … 857 850 ! 858 851 ! Set advection velocity correction: 859 IF (((kt==nit000).AND.(neuler==0)).OR.(.NOT.ln_bt_fw)) THEN860 un_adv(:,:) = zu_sum(:,:) *hur(:,:)861 vn_adv(:,:) = zv_sum(:,:) *hvr(:,:)852 IF( ( kt == nit000 .AND. neuler==0 ) .OR. .NOT.ln_bt_fw ) THEN 853 un_adv(:,:) = zu_sum(:,:) * r1_hu_n(:,:) 854 vn_adv(:,:) = zv_sum(:,:) * r1_hv_n(:,:) 862 855 ELSE 863 un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zu_sum(:,:) ) * hur(:,:)864 vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zv_sum(:,:) ) * hvr(:,:)856 un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zu_sum(:,:) ) * r1_hu_n(:,:) 857 vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zv_sum(:,:) ) * r1_hv_n(:,:) 865 858 END IF 866 859 867 IF (ln_bt_fw) THEN ! Save integrated transport for next computation860 IF( ln_bt_fw ) THEN ! Save integrated transport for next computation 868 861 ub2_b(:,:) = zu_sum(:,:) 869 862 vb2_b(:,:) = zv_sum(:,:) … … 871 864 ! 872 865 ! Update barotropic trend: 873 IF (( ln_dynadv_vec ).OR. (.NOT. lk_vvl)) THEN866 IF( ln_dynadv_vec .OR. .NOT.lk_vvl ) THEN 874 867 DO jk=1,jpkm1 875 868 ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * z1_2dt_b … … 878 871 ELSE 879 872 DO jk=1,jpkm1 880 ua(:,:,jk) = ua(:,:,jk) + hur(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b881 va(:,:,jk) = va(:,:,jk) + hvr(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * z1_2dt_b873 ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b 874 va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * z1_2dt_b 882 875 END DO 883 876 ! Save barotropic velocities not transport: 884 ua_b 885 va_b 877 ua_b(:,:) = ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - umask(:,:,1) ) 878 va_b(:,:) = va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - vmask(:,:,1) ) 886 879 ENDIF 887 880 ! 888 881 DO jk = 1, jpkm1 889 882 ! Correct velocities: 890 un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:) - un_b(:,:) ) *umask(:,:,jk)891 vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:) - vn_b(:,:) ) *vmask(:,:,jk)883 un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:) - un_b(:,:) ) * umask(:,:,jk) 884 vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:) - vn_b(:,:) ) * vmask(:,:,jk) 892 885 ! 893 886 END DO … … 897 890 ! (used to update coarse grid transports at next time step) 898 891 ! 899 IF ( (.NOT.Agrif_Root()).AND.(ln_bt_fw)) THEN900 IF ( Agrif_NbStepint().EQ.0 ) THEN901 ub2_i_b(:,:) = 0. e0902 vb2_i_b(:,:) = 0. e0892 IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN 893 IF( Agrif_NbStepint() == 0 ) THEN 894 ub2_i_b(:,:) = 0._wp 895 vb2_i_b(:,:) = 0._wp 903 896 END IF 904 897 ! … … 912 905 ! 913 906 ! !* write time-spliting arrays in the restart 914 IF( lrst_oce .AND.ln_bt_fw) CALL ts_rst( kt, 'WRITE' )915 ! 916 CALL wrk_dealloc( jpi, jpj,zsshp2_e, zhdiv )917 CALL wrk_dealloc( jpi, jpj,zu_trd, zv_trd, zun_e, zvn_e )918 CALL wrk_dealloc( jpi, jpj,zwx, zwy, zu_sum, zv_sum, zssh_frc, zu_frc, zv_frc )919 CALL wrk_dealloc( jpi, jpj,zhup2_e, zhvp2_e, zhust_e, zhvst_e )920 CALL wrk_dealloc( jpi, jpj, zsshu_a, zsshv_a)921 CALL wrk_dealloc( jpi, jpj,zhf )907 IF( lrst_oce .AND.ln_bt_fw ) CALL ts_rst( kt, 'WRITE' ) 908 ! 909 CALL wrk_dealloc( jpi,jpj, zsshp2_e, zhdiv ) 910 CALL wrk_dealloc( jpi,jpj, zu_trd, zv_trd, zun_e, zvn_e ) 911 CALL wrk_dealloc( jpi,jpj, zwx, zwy, zu_sum, zv_sum, zssh_frc, zu_frc, zv_frc ) 912 CALL wrk_dealloc( jpi,jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e ) 913 CALL wrk_dealloc( jpi,jpj, zsshu_a, zsshv_a ) 914 CALL wrk_dealloc( jpi,jpj, zhf ) 922 915 ! 923 916 IF( nn_timing == 1 ) CALL timing_stop('dyn_spg_ts') 924 917 ! 925 918 END SUBROUTINE dyn_spg_ts 919 926 920 927 921 SUBROUTINE ts_wgt( ll_av, ll_fw, jpit, zwgt1, zwgt2) … … 1094 1088 END DO 1095 1089 ELSE 1090 !!gm BUG ?? restartability issue if ssh changes are large.... 1091 !!gm We should just test this with ht_0 only, no? 1096 1092 DO jj = 1, jpj 1097 1093 DO ji =1, jpi 1098 1094 zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 1099 1095 zyr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 1100 zcu(ji,jj) = SQRT( grav * ht (ji,jj) * (zxr2 + zyr2) )1096 zcu(ji,jj) = SQRT( grav * ht_n(ji,jj) * (zxr2 + zyr2) ) 1101 1097 END DO 1102 1098 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r5836 r5845 75 75 76 76 !! * Substitutions 77 # include "domzgr_substitute.h90"78 77 # include "vectopt_loop_substitute.h90" 79 78 !!---------------------------------------------------------------------- … … 284 283 285 284 IF( ln_sco ) THEN 286 zwz(:,:) = zwz(:,:) / fse3f(:,:,jk)287 zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)288 zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)285 zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk) 286 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 287 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 289 288 ELSE 290 289 zwx(:,:) = e2u(:,:) * un(:,:,jk) … … 404 403 ! 405 404 IF( ln_sco ) THEN !== horizontal fluxes ==! 406 zwz(:,:) = zwz(:,:) / fse3f(:,:,jk)407 zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)408 zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)405 zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk) 406 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 407 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 409 408 ELSE 410 409 zwx(:,:) = e2u(:,:) * un(:,:,jk) … … 415 414 DO ji = fs_2, fs_jpim1 ! vector opt. 416 415 zuav = r1_8 * r1_e1u(ji,jj) * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 417 & + zwy(ji ,jj ) + zwy(ji+1,jj ) )416 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) 418 417 zvau =-r1_8 * r1_e2v(ji,jj) * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 419 & + zwx(ji ,jj ) + zwx(ji ,jj+1) )418 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) 420 419 pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji ,jj-1) + zwz(ji,jj) ) 421 420 pva(ji,jj,jk) = pva(ji,jj,jk) + zvau * ( zwz(ji-1,jj ) + zwz(ji,jj) ) … … 482 481 DO jj = 1, jpjm1 483 482 DO ji = 1, fs_jpim1 ! vector opt. 484 ze3 = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) &485 & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) )483 ze3 = ( e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 484 & + e3t_n(ji,jj ,jk)*tmask(ji,jj ,jk) + e3t_n(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) 486 485 IF( ze3 /= 0._wp ) THEN ; z1_e3f(ji,jj) = 4.0_wp / ze3 487 486 ELSE ; z1_e3f(ji,jj) = 0.0_wp … … 492 491 DO jj = 1, jpjm1 493 492 DO ji = 1, fs_jpim1 ! vector opt. 494 ze3 = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) &495 & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) )493 ze3 = ( e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 494 & + e3t_n(ji,jj ,jk)*tmask(ji,jj ,jk) + e3t_n(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) 496 495 zmsk = ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) & 497 496 & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk) ) … … 558 557 ! 559 558 ! !== horizontal fluxes ==! 560 zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)561 zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)559 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 560 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 562 561 563 562 ! !== compute and add the vorticity term trend =! … … 633 632 WRITE(numout,*) ' enstrophy and energy conserving scheme ln_dynvor_een = ', ln_dynvor_een 634 633 WRITE(numout,*) ' e3f = averaging /4 (=0) or /sum(tmask) (=1) nn_een_e3f = ', nn_een_e3f 635 WRITE(numout,*) ' masked (= 1) or unmasked(=0) vorticity ln_dynvor_msk = ', ln_dynvor_msk634 WRITE(numout,*) ' masked (=T) or unmasked(=F) vorticity ln_dynvor_msk = ', ln_dynvor_msk 636 635 ENDIF 637 636 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
r5836 r5845 32 32 33 33 !! * Substitutions 34 # include "domzgr_substitute.h90"35 34 # include "vectopt_loop_substitute.h90" 36 35 !!---------------------------------------------------------------------- … … 121 120 DO ji = fs_2, fs_jpim1 ! vector opt. 122 121 ! ! vertical momentum advective trends 123 zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) )124 zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) )122 zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk) ) 123 zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk) ) 125 124 ! ! add the trends to the general momentum trends 126 125 ua(ji,jj,jk) = ua(ji,jj,jk) + zua … … 252 251 DO ji = fs_2, fs_jpim1 ! vector opt. 253 252 ! ! vertical momentum advective trends 254 zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) )255 zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) )253 zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk) ) 254 zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk) ) 256 255 zus(ji,jj,jk,jta) = zus(ji,jj,jk,jtb) + zua * zts 257 256 zvs(ji,jj,jk,jta) = zvs(ji,jj,jk,jtb) + zva * zts -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
r5836 r5845 37 37 38 38 !! * Substitutions 39 # include "domzgr_substitute.h90"40 # include "zdfddm_substitute.h90"41 39 # include "vectopt_loop_substitute.h90" 42 40 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90
r3625 r5845 32 32 33 33 !! * Substitutions 34 # include "domzgr_substitute.h90"35 34 # include "vectopt_loop_substitute.h90" 36 35 !!---------------------------------------------------------------------- … … 98 97 DO jj = 2, jpjm1 99 98 DO ji = 2, jpim1 100 zwy(ji,jj,jk) = avmu(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) / fse3uw(ji,jj,jk)101 zww(ji,jj,jk) = avmv(ji,jj,jk) * ( zwz(ji,jj,jk-1) - zwz(ji,jj,jk) ) / fse3vw(ji,jj,jk)99 zwy(ji,jj,jk) = avmu(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) / e3uw_n(ji,jj,jk) 100 zww(ji,jj,jk) = avmv(ji,jj,jk) * ( zwz(ji,jj,jk-1) - zwz(ji,jj,jk) ) / e3vw_n(ji,jj,jk) 102 101 END DO 103 102 END DO … … 106 105 DO jj = 2, jpjm1 107 106 DO ji = 2, jpim1 108 zua = zlavmr * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) / fse3u(ji,jj,jk)109 zva = zlavmr * ( zww(ji,jj,jk) - zww(ji,jj,jk+1) ) / fse3v(ji,jj,jk)107 zua = zlavmr * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) / e3u_n(ji,jj,jk) 108 zva = zlavmr * ( zww(ji,jj,jk) - zww(ji,jj,jk+1) ) / e3v_n(ji,jj,jk) 110 109 ua(ji,jj,jk) = ua(ji,jj,jk) + zua 111 110 va(ji,jj,jk) = va(ji,jj,jk) + zva -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r5836 r5845 36 36 37 37 !! * Substitutions 38 # include "domzgr_substitute.h90"39 38 # include "vectopt_loop_substitute.h90" 40 39 !!---------------------------------------------------------------------- … … 103 102 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 104 103 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 105 avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * fse3uw(ji,jj,ikbu+1)106 avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * fse3vw(ji,jj,ikbv+1)104 avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * e3uw_n(ji,jj,ikbu+1) 105 avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * e3vw_n(ji,jj,ikbv+1) 107 106 END DO 108 107 END DO … … 112 111 ikbu = miku(ji,jj) ! ocean top level at u- and v-points 113 112 ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points) 114 IF (ikbu .GE. 2) avmu(ji,jj,ikbu) = -tfrua(ji,jj) * fse3uw(ji,jj,ikbu)115 IF (ikbv .GE. 2) avmv(ji,jj,ikbv) = -tfrva(ji,jj) * fse3vw(ji,jj,ikbv)113 IF (ikbu .GE. 2) avmu(ji,jj,ikbu) = -tfrua(ji,jj) * e3uw_n(ji,jj,ikbu) 114 IF (ikbv .GE. 2) avmv(ji,jj,ikbv) = -tfrva(ji,jj) * e3vw_n(ji,jj,ikbv) 116 115 END DO 117 116 END DO … … 127 126 ELSE ! applied on thickness weighted velocity 128 127 DO jk = 1, jpkm1 129 ua(:,:,jk) = ( ub(:,:,jk) * fse3u_b(:,:,jk) &130 & + p2dt * ua(:,:,jk) * fse3u_n(:,:,jk) ) &131 & / fse3u_a(:,:,jk) * umask(:,:,jk)132 va(:,:,jk) = ( vb(:,:,jk) * fse3v_b(:,:,jk) &133 & + p2dt * va(:,:,jk) * fse3v_n(:,:,jk) ) &134 & / fse3v_a(:,:,jk) * vmask(:,:,jk)128 ua(:,:,jk) = ( ub(:,:,jk) * e3u_b(:,:,jk) & 129 & + p2dt * ua(:,:,jk) * e3u_n(:,:,jk) ) & 130 & / e3u_a(:,:,jk) * umask(:,:,jk) 131 va(:,:,jk) = ( vb(:,:,jk) * e3v_b(:,:,jk) & 132 & + p2dt * va(:,:,jk) * e3v_n(:,:,jk) ) & 133 & / e3v_a(:,:,jk) * vmask(:,:,jk) 135 134 END DO 136 135 ENDIF … … 147 146 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 148 147 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 149 ze3ua = ( 1._wp - r_vvl ) * fse3u_n(ji,jj,ikbu) + r_vvl * fse3u_a(ji,jj,ikbu)150 ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,ikbv) + r_vvl * fse3v_a(ji,jj,ikbv)148 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,ikbu) + r_vvl * e3u_a(ji,jj,ikbu) 149 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikbv) + r_vvl * e3v_a(ji,jj,ikbv) 151 150 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * bfrua(ji,jj) * ua_b(ji,jj) / ze3ua 152 151 va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * bfrva(ji,jj) * va_b(ji,jj) / ze3va … … 158 157 ikbu = miku(ji,jj) ! top ocean level at u- and v-points 159 158 ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points) 160 ze3ua = ( 1._wp - r_vvl ) * fse3u_n(ji,jj,ikbu) + r_vvl * fse3u_a(ji,jj,ikbu)161 ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,ikbv) + r_vvl * fse3v_a(ji,jj,ikbv)159 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,ikbu) + r_vvl * e3u_a(ji,jj,ikbu) 160 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikbv) + r_vvl * e3v_a(ji,jj,ikbv) 162 161 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * tfrua(ji,jj) * ua_b(ji,jj) / ze3ua 163 162 va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * tfrva(ji,jj) * va_b(ji,jj) / ze3va … … 177 176 DO jj = 2, jpjm1 178 177 DO ji = fs_2, fs_jpim1 ! vector opt. 179 ze3ua = ( 1._wp - r_vvl ) * fse3u_n(ji,jj,jk) + r_vvl * fse3u_a(ji,jj,jk) ! after scale factor at T-point178 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk) ! after scale factor at T-point 180 179 zcoef = - p2dt / ze3ua 181 zzwi = zcoef * avmu (ji,jj,jk ) / fse3uw(ji,jj,jk )180 zzwi = zcoef * avmu (ji,jj,jk ) / e3uw_n(ji,jj,jk ) 182 181 zwi(ji,jj,jk) = zzwi * wumask(ji,jj,jk ) 183 zzws = zcoef * avmu (ji,jj,jk+1) / fse3uw(ji,jj,jk+1)182 zzws = zcoef * avmu (ji,jj,jk+1) / e3uw_n(ji,jj,jk+1) 184 183 zws(ji,jj,jk) = zzws * wumask(ji,jj,jk+1) 185 184 zwd(ji,jj,jk) = 1._wp - zzwi - zzws … … 220 219 DO ji = fs_2, fs_jpim1 ! vector opt. 221 220 #if defined key_dynspg_ts 222 ze3ua = ( 1._wp - r_vvl ) * fse3u_n(ji,jj,1) + r_vvl * fse3u_a(ji,jj,1)221 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1) 223 222 ua(ji,jj,1) = ua(ji,jj,1) + p2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) & 224 223 & / ( ze3ua * rau0 ) * umask(ji,jj,1) … … 226 225 ua(ji,jj,1) = ub(ji,jj,1) & 227 226 & + p2dt *(ua(ji,jj,1) + 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) & 228 & / ( fse3u(ji,jj,1) * rau0 ) * umask(ji,jj,1) )227 & / ( e3u_n(ji,jj,1) * rau0 ) * umask(ji,jj,1) ) 229 228 #endif 230 229 END DO … … 276 275 DO jj = 2, jpjm1 277 276 DO ji = fs_2, fs_jpim1 ! vector opt. 278 ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,jk) + r_vvl * fse3v_a(ji,jj,jk) ! after scale factor at T-point277 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk) ! after scale factor at T-point 279 278 zcoef = - p2dt / ze3va 280 zzwi = zcoef * avmv (ji,jj,jk ) / fse3vw(ji,jj,jk )279 zzwi = zcoef * avmv (ji,jj,jk ) / e3vw_n(ji,jj,jk ) 281 280 zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk) 282 zzws = zcoef * avmv (ji,jj,jk+1) / fse3vw(ji,jj,jk+1)281 zzws = zcoef * avmv (ji,jj,jk+1) / e3vw_n(ji,jj,jk+1) 283 282 zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1) 284 283 zwd(ji,jj,jk) = 1._wp - zzwi - zzws … … 319 318 DO ji = fs_2, fs_jpim1 ! vector opt. 320 319 #if defined key_dynspg_ts 321 ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,1) + r_vvl * fse3v_a(ji,jj,1)320 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1) 322 321 va(ji,jj,1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 323 322 & / ( ze3va * rau0 ) … … 325 324 va(ji,jj,1) = vb(ji,jj,1) & 326 325 & + p2dt *(va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 327 & / ( fse3v(ji,jj,1) * rau0 ) )326 & / ( e3v_n(ji,jj,1) * rau0 ) ) 328 327 #endif 329 328 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r5836 r5845 47 47 48 48 !! * Substitutions 49 # include "domzgr_substitute.h90"50 49 # include "vectopt_loop_substitute.h90" 51 50 !!---------------------------------------------------------------------- … … 97 96 zhdiv(:,:) = 0._wp 98 97 DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports 99 zhdiv(:,:) = zhdiv(:,:) + fse3t_n(:,:,jk) * hdivn(:,:,jk)98 zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk) 100 99 END DO 101 100 ! ! Sea surface elevation time stepping … … 194 193 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 195 194 ! computation of w 196 wn(:,:,jk) = wn(:,:,jk+1) - ( fse3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk) &197 & + z1_2dt * ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) ) ) * tmask(:,:,jk)195 wn(:,:,jk) = wn(:,:,jk+1) - ( e3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk) & 196 & + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) ) * tmask(:,:,jk) 198 197 END DO 199 198 ! IF( ln_vvl_layer ) wn(:,:,:) = 0.e0 … … 202 201 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 203 202 ! computation of w 204 wn(:,:,jk) = wn(:,:,jk+1) - ( fse3t_n(:,:,jk) * hdivn(:,:,jk) &205 & + z1_2dt * ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) ) ) * tmask(:,:,jk)203 wn(:,:,jk) = wn(:,:,jk+1) - ( e3t_n(:,:,jk) * hdivn(:,:,jk) & 204 & + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) ) * tmask(:,:,jk) 206 205 END DO 207 206 ENDIF -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90
r5836 r5845 29 29 REAL(wp), DIMENSION (3) :: scoef1 = (/ 0.5 , 0.5 , 1.0 /) ! 30 30 31 !! * Substitutions32 # include "domzgr_substitute.h90"33 31 !!---------------------------------------------------------------------- 34 32 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 436 434 & ( tcoef1(ki) * wb(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3))+ & 437 435 & tcoef2(ki) * wn(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3)) ) & 438 & / fse3w(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3))436 & / e3w_n(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3)) 439 437 END DO 440 438 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90
r5836 r5845 23 23 PUBLIC flo_blk ! routine called by floats.F90 24 24 25 !! * Substitutions26 # include "domzgr_substitute.h90"27 25 !!---------------------------------------------------------------------- 28 26 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 118 116 119 117 ! compute the transport across the mesh where the float is. 120 !!bug (gm) change e3t into fse3. but never checked121 zsurfx(1) = e2u(iiloc(jfl)-1,ijloc(jfl) ) * fse3u(iiloc(jfl)-1,ijloc(jfl) ,-ikl(jfl))122 zsurfx(2) = e2u(iiloc(jfl) ,ijloc(jfl) ) * fse3u(iiloc(jfl) ,ijloc(jfl) ,-ikl(jfl))123 zsurfy(1) = e1v(iiloc(jfl) ,ijloc(jfl)-1) * fse3v(iiloc(jfl) ,ijloc(jfl)-1,-ikl(jfl))124 zsurfy(2) = e1v(iiloc(jfl) ,ijloc(jfl) ) * fse3v(iiloc(jfl) ,ijloc(jfl) ,-ikl(jfl))118 !!bug (gm) change e3t into e3. but never checked 119 zsurfx(1) = e2u(iiloc(jfl)-1,ijloc(jfl) ) * e3u_n(iiloc(jfl)-1,ijloc(jfl) ,-ikl(jfl)) 120 zsurfx(2) = e2u(iiloc(jfl) ,ijloc(jfl) ) * e3u_n(iiloc(jfl) ,ijloc(jfl) ,-ikl(jfl)) 121 zsurfy(1) = e1v(iiloc(jfl) ,ijloc(jfl)-1) * e3v_n(iiloc(jfl) ,ijloc(jfl)-1,-ikl(jfl)) 122 zsurfy(2) = e1v(iiloc(jfl) ,ijloc(jfl) ) * e3v_n(iiloc(jfl) ,ijloc(jfl) ,-ikl(jfl)) 125 123 126 124 ! for a isobar float zsurfz is put to zero. The vertical velocity will be zero too. 127 125 zsurfz = e1e2t(iiloc(jfl),ijloc(jfl)) 128 zvol = zsurfz * fse3t(iiloc(jfl),ijloc(jfl),-ikl(jfl))126 zvol = zsurfz * e3t_n(iiloc(jfl),ijloc(jfl),-ikl(jfl)) 129 127 130 128 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90
r5836 r5845 37 37 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zgifl, zgjfl, zgkfl ! distances in indexes 38 38 39 !! * Substitutions40 # include "domzgr_substitute.h90"41 39 !!---------------------------------------------------------------------- 42 40 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 176 174 ihtest(jfl) = ihtest(jfl)+1 177 175 DO jk = 1, jpk-1 178 IF( ( fsdepw(ji,jj,jk) <= flzz(jfl)) .AND. (fsdepw(ji,jj,jk+1) > flzz(jfl)) ) THEN176 IF( (gdepw_n(ji,jj,jk) <= flzz(jfl)) .AND. (gdepw_n(ji,jj,jk+1) > flzz(jfl)) ) THEN 179 177 ikmfl(jfl) = jk 180 178 ivtest(jfl) = ivtest(jfl) + 1 … … 238 236 zgifl(jfl)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-jpizoom) 239 237 zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom) 240 zgkfl(jfl) = (( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl)) &241 & / ( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) &242 & - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ) ) &243 & + (( flzz(jfl)- fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) *(ikmfl(jfl)+1)) &244 & / ( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) &245 & - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) )238 zgkfl(jfl) = (( gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl)) & 239 & / ( gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) & 240 & - gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ) ) & 241 & + (( flzz(jfl)-gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) *(ikmfl(jfl)+1)) & 242 & / ( gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) & 243 & - gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) 246 244 ELSE 247 245 zgifl(jfl) = 0.e0 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90
r5836 r5845 26 26 INTEGER, ALLOCATABLE, DIMENSION(:) :: iperproc ! 1D workspace 27 27 28 !! * Substitutions29 # include "domzgr_substitute.h90"30 28 !!---------------------------------------------------------------------- 31 29 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) … … 52 50 !! ** Purpose : 53 51 !! 54 !!55 52 !! 56 53 !! ** Method : The frequency of ??? is nwritefl 57 54 !! 58 55 !!---------------------------------------------------------------------- 59 !! * Arguments60 56 INTEGER :: kt ! time step 61 62 !! * Local declarations 57 ! 63 58 CHARACTER (len=80) :: clname ! restart filename 64 59 INTEGER :: ic , jc , jpn ,jfl ! temporary integer … … 125 120 ENDIF 126 121 ENDIF 127 122 ! 128 123 ENDIF 129 124 ! 130 125 END SUBROUTINE flo_rst 131 132 126 133 127 # else -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90
r5836 r5845 40 40 REAL(wp), ALLOCATABLE, DIMENSION(:) :: ztem , zsal, zrho ! 2D workspace 41 41 42 !! * Substitutions43 # include "domzgr_substitute.h90"44 42 !!---------------------------------------------------------------------- 45 43 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) … … 125 123 zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) & 126 124 + zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc) 127 zdep(jfl) = (1.-zcfl)* fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl)125 zdep(jfl) = (1.-zcfl)*gdepw_n(iafloc,ibfloc,icfl ) + zcfl * gdepw_n(iafloc,ibfloc,ic1fl) 128 126 129 127 !save temperature, salinity and density at this position … … 146 144 zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) & 147 145 + zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc) 148 zdep(jfl) = (1.-zcfl)* fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl)146 zdep(jfl) = (1.-zcfl)*gdepw_n(iafloc,ibfloc,icfl ) + zcfl * gdepw_n(iafloc,ibfloc,ic1fl) 149 147 150 148 ztem(jfl) = tsn(iafloc,ibfloc,icfl,jp_tem) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r5836 r5845 37 37 38 38 !! * Substitutions 39 # include "domzgr_substitute.h90"40 39 # include "vectopt_loop_substitute.h90" 41 40 !!---------------------------------------------------------------------- … … 237 236 CALL iom_get( numror, jpdom_autoglo, 'rhop' , rhop ) ! now potential density 238 237 ELSE 239 CALL eos ( tsn, rhd, rhop, fsdept_n(:,:,:) )238 CALL eos ( tsn, rhd, rhop, gdept_n(:,:,:) ) 240 239 ENDIF 241 240 ! … … 248 247 IF( lk_vvl ) THEN 249 248 DO jk = 1, jpk 250 fse3t_b(:,:,jk) = fse3t_n(:,:,jk)249 e3t_b(:,:,jk) = e3t_n(:,:,jk) 251 250 END DO 252 251 ENDIF -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
r4679 r5845 11 11 !! mpp_init_ioispl: IOIPSL initialization in mpp 12 12 !!---------------------------------------------------------------------- 13 !! * Modules used14 13 USE dom_oce ! ocean space and time domain 15 14 USE in_out_manager ! I/O Manager … … 23 22 PUBLIC mpp_init2 ! called by opa.F90 24 23 25 !! * Substitutions26 # include "domzgr_substitute.h90"27 24 !!---------------------------------------------------------------------- 28 25 !! NEMO/OPA 3.3 , NEMO Consortium (2010) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/LDF/ldfc1d_c2d.F90
r5836 r5845 28 28 29 29 !! * Substitutions 30 # include "domzgr_substitute.h90"31 30 # include "vectopt_loop_substitute.h90" 32 31 !!---------------------------------------------------------------------- … … 72 71 CASE( 'DYN' ) ! T- and F-points 73 72 DO jk = 1, jpk ! pah1 at T-point 74 pah1(:,:,jk) = pahs1(:,:) * ( prat + zc * ( 1._wp + TANH( - ( fsdept(:,:,jk) - zh ) * zw) ) ) * tmask(:,:,jk)73 pah1(:,:,jk) = pahs1(:,:) * ( prat + zc * ( 1._wp + TANH( - ( gdept_n(:,:,jk) - zh ) * zw) ) ) * tmask(:,:,jk) 75 74 END DO 76 75 DO jk = 1, jpk ! pah2 at F-point (zdep2 is an approximation in zps-coord.) 77 76 DO jj = 1, jpjm1 78 77 DO ji = 1, fs_jpim1 79 zdep2 = ( fsdept(ji,jj+1,jk) + fsdept(ji+1,jj+1,jk) &80 & + fsdept(ji,jj ,jk) + fsdept(ji+1,jj ,jk) ) * 0.25_wp78 zdep2 = ( gdept_n(ji,jj+1,jk) + gdept_n(ji+1,jj+1,jk) & 79 & + gdept_n(ji,jj ,jk) + gdept_n(ji+1,jj ,jk) ) * 0.25_wp 81 80 pah2(ji,jj,jk) = pahs2(ji,jj) * ( prat + zc * ( 1._wp + TANH( - ( zdep2 - zh ) * zw) ) ) * fmask(ji,jj,jk) 82 81 END DO … … 89 88 DO jj = 1, jpjm1 90 89 DO ji = 1, fs_jpim1 91 zdep1 = ( fsdept(ji,jj,jk) + fsdept(ji+1,jj,jk) ) * 0.5_wp92 zdep2 = ( fsdept(ji,jj,jk) + fsdept(ji,jj+1,jk) ) * 0.5_wp90 zdep1 = ( gdept_n(ji,jj,jk) + gdept_n(ji+1,jj,jk) ) * 0.5_wp 91 zdep2 = ( gdept_n(ji,jj,jk) + gdept_n(ji,jj+1,jk) ) * 0.5_wp 93 92 pah1(ji,jj,jk) = pahs1(ji,jj) * ( prat + zc * ( 1._wp + TANH( - ( zdep1 - zh ) * zw) ) ) * umask(ji,jj,jk) 94 93 pah2(ji,jj,jk) = pahs2(ji,jj) * ( prat + zc * ( 1._wp + TANH( - ( zdep2 - zh ) * zw) ) ) * vmask(ji,jj,jk) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90
r5836 r5845 52 52 53 53 !! * Substitutions 54 # include "domzgr_substitute.h90"55 54 # include "vectopt_loop_substitute.h90" 56 55 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r5836 r5845 73 73 74 74 !! * Substitutions 75 # include "domzgr_substitute.h90"76 75 # include "vectopt_loop_substitute.h90" 77 76 !!---------------------------------------------------------------------- … … 181 180 ! ! bound the slopes: abs(zw.)<= 1/100 and zb..<0 182 181 ! ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 183 zbu = MIN( zbu, - z1_slpmax * ABS( zau ) , -7.e+3_wp/ fse3u(ji,jj,jk)* ABS( zau ) )184 zbv = MIN( zbv, - z1_slpmax * ABS( zav ) , -7.e+3_wp/ fse3v(ji,jj,jk)* ABS( zav ) )182 zbu = MIN( zbu, - z1_slpmax * ABS( zau ) , -7.e+3_wp/e3u_n(ji,jj,jk)* ABS( zau ) ) 183 zbv = MIN( zbv, - z1_slpmax * ABS( zav ) , -7.e+3_wp/e3v_n(ji,jj,jk)* ABS( zav ) ) 185 184 ! ! uslp and vslp output in zwz and zww, resp. 186 185 zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) … … 188 187 zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps ) & 189 188 & + zfi * uslpml(ji,jj) & 190 & * 0.5_wp * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) ) &189 & * 0.5_wp * ( gdept_n(ji+1,jj,jk)+gdept_n(ji,jj,jk)-e3u_n(ji,jj,1) ) & 191 190 & / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk) 192 191 zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps ) & 193 192 & + zfj * vslpml(ji,jj) & 194 & * 0.5_wp * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) ) &193 & * 0.5_wp * ( gdept_n(ji,jj+1,jk)+gdept_n(ji,jj,jk)-e3v_n(ji,jj,1) ) & 195 194 & / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) 196 195 !!gm modif to suppress omlmask.... (as in Griffies case) … … 198 197 ! zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp ) 199 198 ! zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp ) 200 ! zci = 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) )201 ! zcj = 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) )199 ! zci = 0.5 * ( gdept_n(ji+1,jj,jk)+gdept_n(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) ) 200 ! zcj = 0.5 * ( gdept_n(ji,jj+1,jk)+gdept_n(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) ) 202 201 ! zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk) 203 202 ! zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk) … … 270 269 ! ! bound the slopes: abs(zw.)<= 1/100 and zb..<0. 271 270 ! ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 272 zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/ fse3w(ji,jj,jk)* ABS( zai ) )273 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/ fse3w(ji,jj,jk)* ABS( zaj ) )271 zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/e3w_n(ji,jj,jk)* ABS( zai ) ) 272 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_n(ji,jj,jk)* ABS( zaj ) ) 274 273 ! ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.) 275 274 zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) ! zfk=1 in the ML otherwise zfk=0 276 zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10._wp )275 zck = gdepw_n(ji,jj,jk) / MAX( hmlp(ji,jj), 10._wp ) 277 276 zwz(ji,jj,jk) = ( zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk ) * tmask(ji,jj,jk) 278 277 zww(ji,jj,jk) = ( zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk ) * tmask(ji,jj,jk) … … 281 280 ! ! ! jk must be >= ML level for zfk=1. otherwise zfk=0. 282 281 ! zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp ) 283 ! zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10. )282 ! zck = gdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10. ) 284 283 ! zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk) 285 284 ! zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk) … … 441 440 zdks = 0._wp 442 441 ENDIF 443 zdzrho_raw = ( - zalbet(ji,jj,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp)442 zdzrho_raw = ( - zalbet(ji,jj,jk) * zdkt + zbeta0*zdks ) / e3w_n(ji,jj,jk+kp) 444 443 zdzrho(ji,jj,jk,kp) = - MIN( - repsln , zdzrho_raw ) ! force zdzrho >= repsln 445 444 END DO … … 451 450 DO ji = 1, jpi 452 451 jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1 ! MIN in case ML depth is the ocean depth 453 z1_mlbw(ji,jj) = 1._wp / fsdepw(ji,jj,jk)452 z1_mlbw(ji,jj) = 1._wp / gdepw_n(ji,jj,jk) 454 453 END DO 455 454 END DO … … 480 479 ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 481 480 zti_g_raw = ( zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp) & 482 & - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) * r1_e1u(ji,jj) ) * umask(ji,jj,jk)483 ze3_e1 = fse3w(ji+ip,jj,jk-kp) * r1_e1u(ji,jj)481 & - ( gdept_n(ji+1,jj,jk-kp) - gdept_n(ji,jj,jk-kp) ) * r1_e1u(ji,jj) ) * umask(ji,jj,jk) 482 ze3_e1 = e3w_n(ji+ip,jj,jk-kp) * r1_e1u(ji,jj) 484 483 zti_mlb(ji+ip,jj ,1-ip,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1 , ABS( zti_g_raw ) ), zti_g_raw ) 485 484 ENDIF … … 490 489 ELSE 491 490 ztj_g_raw = ( zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp) & 492 & - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj) ) * vmask(ji,jj,jk)493 ze3_e2 = fse3w(ji,jj+jp,jk-kp) / e2v(ji,jj)491 & - ( gdept_n(ji,jj+1,jk-kp) - gdept_n(ji,jj,jk-kp) ) / e2v(ji,jj) ) * vmask(ji,jj,jk) 492 ze3_e2 = e3w_n(ji,jj+jp,jk-kp) / e2v(ji,jj) 494 493 ztj_mlb(ji ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2 , ABS( ztj_g_raw ) ), ztj_g_raw ) 495 494 ENDIF … … 523 522 ! 524 523 ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface 525 zti_coord = znot_thru_surface * ( fsdept(ji+1,jj ,jk) - fsdept(ji,jj,jk) ) * r1_e1u(ji,jj)526 ztj_coord = znot_thru_surface * ( fsdept(ji ,jj+1,jk) - fsdept(ji,jj,jk) ) * r1_e2v(ji,jj) ! unmasked524 zti_coord = znot_thru_surface * ( gdept_n(ji+1,jj ,jk) - gdept_n(ji,jj,jk) ) * r1_e1u(ji,jj) 525 ztj_coord = znot_thru_surface * ( gdept_n(ji ,jj+1,jk) - gdept_n(ji,jj,jk) ) * r1_e2v(ji,jj) ! unmasked 527 526 zti_g_raw = zti_raw - zti_coord ! ref to geopot surfaces 528 527 ztj_g_raw = ztj_raw - ztj_coord 529 528 ! additional limit required in bilaplacian case 530 ze3_e1 = fse3w(ji+ip,jj ,jk+kp) * r1_e1u(ji,jj)531 ze3_e2 = fse3w(ji ,jj+jp,jk+kp) * r1_e2v(ji,jj)529 ze3_e1 = e3w_n(ji+ip,jj ,jk+kp) * r1_e1u(ji,jj) 530 ze3_e2 = e3w_n(ji ,jj+jp,jk+kp) * r1_e2v(ji,jj) 532 531 ! NB: hard coded factor 5 (can be a namelist parameter...) 533 532 zti_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1, ABS( zti_g_raw ) ), zti_g_raw ) … … 542 541 zti_g_lim = ( zfacti * zti_g_lim & 543 542 & + ( 1._wp - zfacti ) * zti_mlb(ji+ip,jj,1-ip,kp) & 544 & * fsdepw(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj) ) * umask(ji,jj,jk+kp)543 & * gdepw_n(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj) ) * umask(ji,jj,jk+kp) 545 544 ztj_g_lim = ( zfactj * ztj_g_lim & 546 545 & + ( 1._wp - zfactj ) * ztj_mlb(ji,jj+jp,1-jp,kp) & 547 & * fsdepw(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp) ) * vmask(ji,jj,jk+kp)546 & * gdepw_n(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp) ) * vmask(ji,jj,jk+kp) 548 547 ! 549 548 triadi_g(ji+ip,jj ,jk,1-ip,kp) = zti_g_lim … … 577 576 triadj(ji ,jj+jp,jk,1-jp,kp) = ztj_lim * zjsw 578 577 ! 579 zbu = e1e2u(ji ,jj ) * fse3u(ji ,jj ,jk )580 zbv = e1e2v(ji ,jj ) * fse3v(ji ,jj ,jk )581 zbti = e1e2t(ji+ip,jj ) * fse3w(ji+ip,jj ,jk+kp)582 zbtj = e1e2t(ji ,jj+jp) * fse3w(ji ,jj+jp,jk+kp)578 zbu = e1e2u(ji ,jj ) * e3u_n(ji ,jj ,jk ) 579 zbv = e1e2v(ji ,jj ) * e3v_n(ji ,jj ,jk ) 580 zbti = e1e2t(ji+ip,jj ) * e3w_n(ji+ip,jj ,jk+kp) 581 zbtj = e1e2t(ji ,jj+jp) * e3w_n(ji ,jj+jp,jk+kp) 583 582 ! 584 583 wslp2(ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim*zti_g_lim ! masked … … 682 681 ! !- bound the slopes: abs(zw.)<= 1/100 and zb..<0 683 682 ! kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 684 zbu = MIN( zbu , - z1_slpmax * ABS( zau ) , -7.e+3_wp/ fse3u(ji,jj,iku)* ABS( zau ) )685 zbv = MIN( zbv , - z1_slpmax * ABS( zav ) , -7.e+3_wp/ fse3v(ji,jj,ikv)* ABS( zav ) )683 zbu = MIN( zbu , - z1_slpmax * ABS( zau ) , -7.e+3_wp/e3u_n(ji,jj,iku)* ABS( zau ) ) 684 zbv = MIN( zbv , - z1_slpmax * ABS( zav ) , -7.e+3_wp/e3v_n(ji,jj,ikv)* ABS( zav ) ) 686 685 ! !- Slope at u- & v-points (uslpml, vslpml) 687 686 uslpml(ji,jj) = zau / ( zbu - zeps ) * umask(ji,jj,iku) … … 705 704 ! !- bound the slopes: abs(zw.)<= 1/100 and zb..<0. 706 705 ! kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 707 zbi = MIN( zbw , -100._wp* ABS( zai ) , -7.e+3_wp/ fse3w(ji,jj,ik)* ABS( zai ) )708 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/ fse3w(ji,jj,ik)* ABS( zaj ) )706 zbi = MIN( zbw , -100._wp* ABS( zai ) , -7.e+3_wp/e3w_n(ji,jj,ik)* ABS( zai ) ) 707 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_n(ji,jj,ik)* ABS( zaj ) ) 709 708 ! !- i- & j-slope at w-points (wslpiml, wslpjml) 710 709 wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask (ji,jj,ik) … … 775 774 ! 776 775 ! ! set the slope of diffusion to the slope of s-surfaces 777 ! ! ( c a u t i o n : minus sign as fsdep has positive value )776 ! ! ( c a u t i o n : minus sign as dep has positive value ) 778 777 ! DO jk = 1, jpk 779 778 ! DO jj = 2, jpjm1 780 779 ! DO ji = fs_2, fs_jpim1 ! vector opt. 781 ! uslp (ji,jj,jk) = - ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)782 ! vslp (ji,jj,jk) = - ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)783 ! wslpi(ji,jj,jk) = - ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * r1_e1t(ji,jj) * wmask(ji,jj,jk) * 0.5784 ! wslpj(ji,jj,jk) = - ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * r1_e2t(ji,jj) * wmask(ji,jj,jk) * 0.5780 ! uslp (ji,jj,jk) = - ( gdept_n(ji+1,jj,jk) - gdept_n(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 781 ! vslp (ji,jj,jk) = - ( gdept_n(ji,jj+1,jk) - gdept_n(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 782 ! wslpi(ji,jj,jk) = - ( gdepw_n(ji+1,jj,jk) - gdepw_n(ji-1,jj,jk) ) * r1_e1t(ji,jj) * wmask(ji,jj,jk) * 0.5 783 ! wslpj(ji,jj,jk) = - ( gdepw_n(ji,jj+1,jk) - gdepw_n(ji,jj-1,jk) ) * r1_e2t(ji,jj) * wmask(ji,jj,jk) * 0.5 785 784 ! END DO 786 785 ! END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
r5836 r5845 81 81 82 82 !! * Substitutions 83 # include "domzgr_substitute.h90"84 83 # include "vectopt_loop_substitute.h90" 85 84 !!---------------------------------------------------------------------- … … 515 514 ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 516 515 zn2 = MAX( rn2b(ji,jj,jk), 0._wp ) 517 zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk)516 zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w_n(ji,jj,jk) 518 517 ! Compute elements required for the inverse time scale of baroclinic 519 518 ! eddies using the isopycnal slopes calculated in ldfslp.F : 520 519 ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 521 ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk)520 ze3w = e3w_n(ji,jj,jk) * tmask(ji,jj,jk) 522 521 zah(ji,jj) = zah(ji,jj) + zn2 * wslp2(ji,jj,jk) * ze3w 523 522 zhw(ji,jj) = zhw(ji,jj) + ze3w … … 533 532 ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 534 533 zn2 = MAX( rn2b(ji,jj,jk), 0._wp ) 535 zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk)534 zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w_n(ji,jj,jk) 536 535 ! Compute elements required for the inverse time scale of baroclinic 537 536 ! eddies using the isopycnal slopes calculated in ldfslp.F : 538 537 ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 539 ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk)538 ze3w = e3w_n(ji,jj,jk) * tmask(ji,jj,jk) 540 539 zah(ji,jj) = zah(ji,jj) + zn2 * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk) & 541 540 & + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) * ze3w … … 711 710 ! 712 711 DO jk = 1, jpkm1 ! e2u e3u u_eiv = -dk[psi_uw] 713 zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * fse3u(:,:,jk) )712 zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * e3u_n(:,:,jk) ) 714 713 END DO 715 714 CALL iom_put( "uoce_eiv", zw3d ) 716 715 ! 717 716 DO jk = 1, jpkm1 ! e1v e3v v_eiv = -dk[psi_vw] 718 zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * fse3v(:,:,jk) )717 zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * e3v_n(:,:,jk) ) 719 718 END DO 720 719 CALL iom_put( "voce_eiv", zw3d ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r5836 r5845 172 172 & ssv_m (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) 173 173 ! 174 #if defined key_vvl175 174 ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) ) 176 #endif177 175 ! 178 176 sbc_oce_alloc = MAXVAL( ierr ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90
r5836 r5845 37 37 38 38 !! * Substitutions 39 # include "domzgr_substitute.h90"40 39 # include "vectopt_loop_substitute.h90" 41 40 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
r5836 r5845 39 39 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_apr ! structure of input fields (file informations, fields read) 40 40 41 !! * Substitutions42 # include "domzgr_substitute.h90"43 41 !!---------------------------------------------------------------------- 44 42 !! NEMO/OPA 4.0 , NEMO Consortium (2011) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r5583 r5845 93 93 94 94 !! * Substitutions 95 # include "domzgr_substitute.h90"96 95 # include "vectopt_loop_substitute.h90" 97 96 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90
r5836 r5845 42 42 43 43 !! * Substitutions 44 # include "domzgr_substitute.h90"45 44 # include "vectopt_loop_substitute.h90" 46 45 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5836 r5845 165 165 166 166 !! Substitution 167 # include "domzgr_substitute.h90"168 167 # include "vectopt_loop_substitute.h90" 169 168 !!---------------------------------------------------------------------- … … 2002 2001 ! ! first T level thickness 2003 2002 IF( ssnd(jps_e3t1st )%laction ) THEN 2004 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1) , (/jpi,jpj,1/) ), info )2003 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t_n(:,:,1) , (/jpi,jpj,1/) ), info ) 2005 2004 ENDIF 2006 2005 ! ! Qsr fraction -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
r5836 r5845 17 17 USE sbcdcy ! surface boundary condition: diurnal cycle on qsr 18 18 USE phycst ! physical constants 19 ! 19 20 USE fldread ! read input fields 20 21 USE iom ! IOM library … … 37 38 38 39 !! * Substitutions 39 # include "domzgr_substitute.h90"40 40 # include "vectopt_loop_substitute.h90" 41 41 !!---------------------------------------------------------------------- … … 165 165 WRITE(numout,*) 166 166 WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact 167 CALL prihre( sf(jf)%fnow, jpi, jpj, 1, jpi, 20, 1, jpj, 10, zfact, numout )168 167 END DO 169 CALL FLUSH(numout)170 168 ENDIF 171 169 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
r5643 r5845 40 40 41 41 !! * Substitutions 42 # include "domzgr_substitute.h90"43 42 # include "vectopt_loop_substitute.h90" 44 43 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r5836 r5845 9 9 !!---------------------------------------------------------------------- 10 10 !! sbc_ice_cice : sea-ice model time-stepping and update ocean sbc over ice-covered area 11 !!12 !!13 11 !!---------------------------------------------------------------------- 14 12 USE oce ! ocean dynamics and tracers … … 92 90 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), PRIVATE :: png ! local array used in sbc_cice_ice 93 91 94 !! * Substitutions95 # include "domzgr_substitute.h90"96 92 !!---------------------------------------------------------------------- 97 93 !! NEMO/OPA 3.7 , NEMO-consortium (2015) … … 249 245 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 250 246 #if defined key_vvl 251 ! key_vvl necessary? clem: yes for compilation purpose 247 !!gm key_vvl necessary? clem: yes for compilation purpose 248 !!gm same remark as in limsbc 252 249 DO jk = 1,jpkm1 ! adjust initial vertical scale factors 253 fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )254 fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )250 e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 251 e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 255 252 ENDDO 256 fse3t_a(:,:,:) = fse3t_b(:,:,:)253 e3t_a(:,:,:) = e3t_b(:,:,:) 257 254 ! Reconstruction of all vertical scale factors at now and before time 258 255 ! steps … … 260 257 ! Horizontal scale factor interpolations 261 258 ! -------------------------------------- 262 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' )263 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' )264 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' )265 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' )266 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' )259 CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 260 CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 261 CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 262 CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 263 CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' ) 267 264 ! Vertical scale factor interpolations 268 265 ! ------------------------------------ 269 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W' )270 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' )271 CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' )272 CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' )273 CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' )266 CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W' ) 267 CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 268 CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 269 CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 270 CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 274 271 ! t- and w- points depth 275 272 ! ---------------------- 276 fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1)277 fsdepw_n(:,:,1) = 0.0_wp278 fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:)273 gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 274 gdepw_n(:,:,1) = 0.0_wp 275 gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 279 276 DO jk = 2, jpk 280 fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk)281 fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1)282 fsde3w_n(:,:,jk) = fsdept_n(:,:,jk ) - sshn (:,:)277 gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk) 278 gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1) 279 gde3w_n(:,:,jk) = gdept_n(:,:,jk ) - sshn (:,:) 283 280 END DO 284 281 #endif … … 448 445 ! Freezing/melting potential 449 446 ! Calculated over NEMO leapfrog timestep (hence 2*dt) 450 nfrzmlt(:,:) =rau0*rcp*fse3t_m(:,:)*(Tocnfrz-sst_m(:,:))/(2.0*dt)447 nfrzmlt(:,:) = rau0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt ) 451 448 452 449 ztmp(:,:) = nfrzmlt(:,:) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
r5541 r5845 34 34 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ice ! structure of input ice-cover (file informations, fields read) 35 35 36 !! * Substitutions37 # include "domzgr_substitute.h90"38 36 !!---------------------------------------------------------------------- 39 37 !! NEMO/OPA 3.3 , NEMO Consortium (2010) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r5541 r5845 74 74 75 75 !! * Substitutions 76 # include "domzgr_substitute.h90"77 76 # include "vectopt_loop_substitute.h90" 78 77 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r5541 r5845 64 64 65 65 !! * Substitutions 66 # include "domzgr_substitute.h90"67 66 # include "vectopt_loop_substitute.h90" 68 67 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r5836 r5845 68 68 TYPE(FLD_N) , PUBLIC :: sn_depmax_isf, sn_depmin_isf, sn_Leff_isf !: information about the runoff file to be read 69 69 70 !! * Substitutions71 # include "domzgr_substitute.h90"72 70 !!---------------------------------------------------------------------- 73 71 !! NEMO/OPA 3.7 , LOCEAN-IPSL (2015) … … 170 168 DO jj = 1, jpj 171 169 jk = 2 172 DO WHILE ( jk .LE. mbkt(ji,jj) .AND. fsdepw(ji,jj,jk) < rzisf_tbl(ji,jj) ) ; jk = jk + 1 ; END DO170 DO WHILE ( jk .LE. mbkt(ji,jj) .AND. gdepw_n(ji,jj,jk) < rzisf_tbl(ji,jj) ) ; jk = jk + 1 ; END DO 173 171 misfkt(ji,jj) = jk-1 174 172 END DO … … 195 193 ikb = misfkt(ji,jj) 196 194 ! thickness of boundary layer at least the top level thickness 197 rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), fse3t_n(ji,jj,ikt))195 rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3t_n(ji,jj,ikt)) 198 196 199 197 ! determine the deepest level influenced by the boundary layer 200 198 ! test on tmask useless ????? 201 199 DO jk = ikt, mbkt(ji,jj) 202 IF ( (SUM( fse3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk200 IF ( (SUM(e3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 203 201 END DO 204 rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM( fse3t_n(ji,jj,ikt:ikb))) ! limit the tbl to water thickness.202 rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t_n(ji,jj,ikt:ikb))) ! limit the tbl to water thickness. 205 203 misfkb(ji,jj) = ikb ! last wet level of the tbl 206 204 r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj) 207 205 208 zhk = SUM( fse3t(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj) ! proportion of tbl cover by cell from ikt to ikb - 1209 ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / fse3t(ji,jj,ikb) ! proportion of bottom cell influenced by boundary layer206 zhk = SUM( e3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj) ! proportion of tbl cover by cell from ikt to ikb - 1 207 ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / e3t_n(ji,jj,ikb) ! proportion of bottom cell influenced by boundary layer 210 208 END DO 211 209 END DO … … 369 367 ! after verif with UNESCO, wrong sign in BG eq. 2 370 368 ! Calculate freezing temperature 371 zpress = grav*rau0* fsdept(ji,jj,ik)*1.e-04369 zpress = grav*rau0*gdept_n(ji,jj,ik)*1.e-04 372 370 CALL eos_fzp(tsb(ji,jj,ik,jp_sal), zt_frz, zpress) 373 zt_sum = zt_sum + (tsn(ji,jj,ik,jp_tem)-zt_frz) * fse3t(ji,jj,ik) * tmask(ji,jj,ik) ! sum temp371 zt_sum = zt_sum + (tsn(ji,jj,ik,jp_tem)-zt_frz) * e3t_n(ji,jj,ik) * tmask(ji,jj,ik) ! sum temp 374 372 ENDDO 375 373 zt_ave = zt_sum/rhisf_tbl(ji,jj) ! calcul mean value … … 445 443 ! Crude approximation for pressure (but commonly used) 446 444 ! 1e-04 to convert from Pa to dBar 447 zpress(ji,jj)=grav*rau0* fsdepw(ji,jj,mikt(ji,jj))*1.e-04445 zpress(ji,jj)=grav*rau0*gdepw_n(ji,jj,mikt(ji,jj))*1.e-04 448 446 ! 449 447 END DO … … 643 641 ELSE 644 642 !! compute Rc number (as done in zdfric.F90) 645 zcoef = 0.5 / fse3w(ji,jj,ikt)643 zcoef = 0.5 / e3w_n(ji,jj,ikt) 646 644 ! ! shear of horizontal velocity 647 645 zdku = zcoef * ( un(ji-1,jj ,ikt ) + un(ji,jj,ikt ) & … … 663 661 zts(jp_tem) = ttbl(ji,jj) 664 662 zts(jp_sal) = stbl(ji,jj) 665 zdep = fsdepw(ji,jj,ikt)663 zdep = gdepw_n(ji,jj,ikt) 666 664 ! 667 665 CALL eos_rab( zts, zdep, zab ) … … 672 670 !! compute Monin Obukov Length 673 671 ! Maximum boundary layer depth 674 zhmax = fsdept(ji,jj,mbkt(ji,jj)) - fsdepw(ji,jj,mikt(ji,jj)) -0.001672 zhmax = gdept_n(ji,jj,mbkt(ji,jj)) - gdepw_n(ji,jj,mikt(ji,jj)) -0.001 675 673 ! Compute Monin obukhov length scale at the surface and Ekman depth: 676 674 zmob = zustar ** 3 / (vkarmn * (zbuofdep + epsln)) … … 730 728 ! level fully include in the ice shelf boundary layer 731 729 DO jk = ikt, ikb - 1 732 ze3 = fse3t_n(ji,jj,jk)730 ze3 = e3t_n(ji,jj,jk) 733 731 IF (cptin == 'T' ) varout(ji,jj) = varout(ji,jj) + varin(ji,jj,jk) * r1_hisf_tbl(ji,jj) * ze3 734 732 IF (cptin == 'U' ) varout(ji,jj) = varout(ji,jj) + 0.5_wp * (varin(ji,jj,jk) + varin(ji-1,jj,jk)) & … … 739 737 740 738 ! level partially include in ice shelf boundary layer 741 zhk = SUM( fse3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)739 zhk = SUM( e3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj) 742 740 IF (cptin == 'T') & 743 741 & varout(ji,jj) = varout(ji,jj) + varin(ji,jj,ikb) * (1._wp - zhk) … … 788 786 ikb = misfkt(ji,jj) 789 787 ! thickness of boundary layer at least the top level thickness 790 rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), fse3t(ji,jj,ikt))788 rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3t_n(ji,jj,ikt)) 791 789 792 790 ! determine the deepest level influenced by the boundary layer 793 791 ! test on tmask useless ????? 794 792 DO jk = ikt, mbkt(ji,jj) 795 IF ( (SUM( fse3t(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk793 IF ( (SUM(e3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 796 794 END DO 797 rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM( fse3t(ji,jj,ikt:ikb))) ! limit the tbl to water thickness.795 rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t_n(ji,jj,ikt:ikb))) ! limit the tbl to water thickness. 798 796 misfkb(ji,jj) = ikb ! last wet level of the tbl 799 797 r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj) 800 798 801 zhk = SUM( fse3t(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj) ! proportion of tbl cover by cell from ikt to ikb - 1802 ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / fse3t(ji,jj,ikb) ! proportion of bottom cell influenced by boundary layer799 zhk = SUM( e3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj) ! proportion of tbl cover by cell from ikt to ikb - 1 800 ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / e3t_n(ji,jj,ikb) ! proportion of bottom cell influenced by boundary layer 803 801 END DO 804 802 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r5836 r5845 62 62 INTEGER :: nsbc ! type of surface boundary condition (deduced from namsbc informations) 63 63 64 !! * Substitutions65 # include "domzgr_substitute.h90"66 64 !!---------------------------------------------------------------------- 67 65 !! NEMO/OPA 4.0 , NEMO-consortium (2011) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r5836 r5845 68 68 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_t_rnf ! structure: river runoff temperature (file information, fields read) 69 69 70 !! * Substitutions71 # include "domzgr_substitute.h90"72 70 !!---------------------------------------------------------------------- 73 71 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 216 214 h_rnf(ji,jj) = 0._wp 217 215 DO jk = 1, nk_rnf(ji,jj) ! recalculates h_rnf to be the depth in metres 218 h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) ! to the bottom of the relevant grid box216 h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk) ! to the bottom of the relevant grid box 219 217 END DO 220 218 ! ! apply the runoff input flow … … 235 233 ELSE !== runoff put only at the surface ==! 236 234 IF( lk_vvl ) THEN ! variable volume case 237 h_rnf(:,:) = fse3t(:,:,1) ! recalculate h_rnf to be depth of top box238 ENDIF 239 phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / fse3t(:,:,1)235 h_rnf(:,:) = e3t_n(:,:,1) ! recalculate h_rnf to be depth of top box 236 ENDIF 237 phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / e3t_n(:,:,1) 240 238 ENDIF 241 239 ! … … 377 375 h_rnf(ji,jj) = 0._wp 378 376 DO jk = 1, nk_rnf(ji,jj) 379 h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)377 h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk) 380 378 END DO 381 379 END DO … … 435 433 h_rnf(ji,jj) = 0._wp 436 434 DO jk = 1, nk_rnf(ji,jj) 437 h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)435 h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk) 438 436 END DO 439 437 END DO … … 448 446 ELSE ! runoffs applied at the surface 449 447 nk_rnf(:,:) = 1 450 h_rnf (:,:) = fse3t(:,:,1)448 h_rnf (:,:) = e3t_n(:,:,1) 451 449 ENDIF 452 450 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r5407 r5845 28 28 PUBLIC sbc_ssm_init ! routine called by sbcmod.F90 29 29 30 LOGICAL, SAVE :: l_ssm_mean = .FALSE. ! keep track of whether means have been read 31 ! from restart file 30 LOGICAL, SAVE :: l_ssm_mean = .FALSE. ! keep track of whether means have been read from restart file 32 31 33 !! * Substitutions34 # include "domzgr_substitute.h90"35 32 !!---------------------------------------------------------------------- 36 33 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 81 78 ENDIF 82 79 ! 83 IF( lk_vvl ) e3t_m(:,:) = fse3t_n(:,:,1)80 IF( lk_vvl ) e3t_m(:,:) = e3t_n(:,:,1) 84 81 ! 85 82 frq_m(:,:) = fraqsr_1lev(:,:) … … 103 100 ENDIF 104 101 ! 105 IF( lk_vvl ) e3t_m(:,:) = zcoef * fse3t_n(:,:,1)102 IF( lk_vvl ) e3t_m(:,:) = zcoef * e3t_n(:,:,1) 106 103 ! 107 104 frq_m(:,:) = zcoef * fraqsr_1lev(:,:) … … 131 128 ENDIF 132 129 ! 133 IF( lk_vvl ) e3t_m(:,:) = fse3t_m(:,:) + fse3t_n(:,:,1)130 IF( lk_vvl ) e3t_m(:,:) = e3t_m(:,:) + e3t_n(:,:,1) 134 131 ! 135 132 frq_m(:,:) = frq_m(:,:) + fraqsr_1lev(:,:) … … 144 141 ssv_m(:,:) = ssv_m(:,:) * zcoef ! 145 142 ssh_m(:,:) = ssh_m(:,:) * zcoef ! mean SSH [m] 146 IF( lk_vvl ) e3t_m(:,:) = fse3t_m(:,:) * zcoef ! mean vertical scale factor [m]143 IF( lk_vvl ) e3t_m(:,:) = e3t_m(:,:) * zcoef ! mean vertical scale factor [m] 147 144 frq_m(:,:) = frq_m(:,:) * zcoef ! mean fraction of solar net radiation absorbed in the 1st T level [-] 148 145 ! … … 229 226 sss_m(:,:) = zcoef * sss_m(:,:) 230 227 ssh_m(:,:) = zcoef * ssh_m(:,:) 231 IF( lk_vvl ) e3t_m(:,:) = zcoef * fse3t_m(:,:)228 IF( lk_vvl ) e3t_m(:,:) = zcoef * e3t_m(:,:) 232 229 frq_m(:,:) = zcoef * frq_m(:,:) 233 230 ELSE … … 247 244 sss_m(:,:) = tsn(:,:,1,jp_sal) 248 245 ssh_m(:,:) = sshn(:,:) 249 IF( lk_vvl ) e3t_m(:,:) = fse3t_n(:,:,1)246 IF( lk_vvl ) e3t_m(:,:) = e3t_n(:,:,1) 250 247 frq_m(:,:) = 1._wp 251 248 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
r5836 r5845 47 47 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sss ! structure of input SSS (file informations, fields read) 48 48 49 !! * Substitutions50 # include "domzgr_substitute.h90"51 49 !!---------------------------------------------------------------------- 52 50 !! NEMO/OPA 4.0 , NEMO Consortium (2011) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
r5836 r5845 40 40 41 41 !! * Substitutions 42 # include "domzgr_substitute.h90"43 42 # include "vectopt_loop_substitute.h90" 44 43 !!---------------------------------------------------------------------- … … 128 127 ! !* distribute it on the vertical 129 128 DO jk = 1, jpkm1 130 zusd_t(:,:,jk) = sf_sd(jp_usd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * fsdept_n(:,:,jk) )131 zvsd_t(:,:,jk) = sf_sd(jp_vsd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * fsdept_n(:,:,jk) )129 zusd_t(:,:,jk) = sf_sd(jp_usd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * gdept_n(:,:,jk) ) 130 zvsd_t(:,:,jk) = sf_sd(jp_vsd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * gdept_n(:,:,jk) ) 132 131 END DO 133 132 ! !* interpolate the stokes drift from t-point to u- and v-points … … 136 135 DO ji = 1, jpim1 137 136 usd3d(ji,jj,jk) = 0.5_wp * ( zusd_t(ji ,jj,jk) + zusd_t(ji+1,jj,jk) ) * umask(ji,jj,jk) 138 vsd3d(ji,jj,jk) = 0.5_wp * ( zvsd_t(ji ,jj,jk) + zvsd_t(ji +1,jj,jk) ) * vmask(ji,jj,jk)137 vsd3d(ji,jj,jk) = 0.5_wp * ( zvsd_t(ji ,jj,jk) + zvsd_t(ji,jj+1,jk) ) * vmask(ji,jj,jk) 139 138 END DO 140 139 END DO … … 146 145 DO jj = 2, jpjm1 147 146 DO ji = fs_2, fs_jpim1 ! vector opt. 148 ze3hdiv(ji,jj,jk) = ( e2u(ji ,jj) * fse3u_n(ji ,jj,jk) * usd3d(ji ,jj,jk) &149 & - e2u(ji-1,jj) * fse3u_n(ji-1,jj,jk) * usd3d(ji-1,jj,jk) &150 & + e1v(ji,jj ) * fse3v_n(ji,jj ,jk) * vsd3d(ji,jj ,jk) &151 & - e1v(ji,jj-1) * fse3v_n(ji,jj-1,jk) * vsd3d(ji,jj-1,jk) ) * r1_e1e2t(ji,jj)147 ze3hdiv(ji,jj,jk) = ( e2u(ji ,jj) * e3u_n(ji ,jj,jk) * usd3d(ji ,jj,jk) & 148 & - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * usd3d(ji-1,jj,jk) & 149 & + e1v(ji,jj ) * e3v_n(ji,jj ,jk) * vsd3d(ji,jj ,jk) & 150 & - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vsd3d(ji,jj-1,jk) ) * r1_e1e2t(ji,jj) 152 151 END DO 153 152 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90
r5836 r5845 89 89 DO ji = 2, jpim1 90 90 zcoef = z2dt * z2dt * grav * bmask(ji,jj) 91 zcoefs = -zcoef * hv (ji ,jj-1) * e1_e2v(ji ,jj-1) ! south coefficient92 zcoefw = -zcoef * hu (ji-1,jj ) * e2_e1u(ji-1,jj ) ! west coefficient93 zcoefe = -zcoef * hu (ji ,jj ) * e2_e1u(ji ,jj ) ! east coefficient94 zcoefn = -zcoef * hv (ji ,jj ) * e1_e2v(ji ,jj ) ! north coefficient91 zcoefs = -zcoef * hv_n(ji ,jj-1) * e1_e2v(ji ,jj-1) ! south coefficient 92 zcoefw = -zcoef * hu_n(ji-1,jj ) * e2_e1u(ji-1,jj ) ! west coefficient 93 zcoefe = -zcoef * hu_n(ji ,jj ) * e2_e1u(ji ,jj ) ! east coefficient 94 zcoefn = -zcoef * hv_n(ji ,jj ) * e1_e2v(ji ,jj ) ! north coefficient 95 95 gcp(ji,jj,1) = zcoefs 96 96 gcp(ji,jj,2) = zcoefw … … 110 110 111 111 ! south coefficient 112 zcoefs = -zcoef * hv (ji,jj-1) * e1_e2v(ji,jj-1)112 zcoefs = -zcoef * hv_n(ji,jj-1) * e1_e2v(ji,jj-1) 113 113 zcoefs = zcoefs * bdyvmask(ji,jj-1) 114 114 gcp(ji,jj,1) = zcoefs 115 115 116 116 ! west coefficient 117 zcoefw = -zcoef * hu (ji-1,jj) * e2_e1u(ji-1,jj)117 zcoefw = -zcoef * hu_n(ji-1,jj) * e2_e1u(ji-1,jj) 118 118 zcoefw = zcoefw * bdyumask(ji-1,jj) 119 119 gcp(ji,jj,2) = zcoefw 120 120 121 121 ! east coefficient 122 zcoefe = -zcoef * hu (ji,jj) * e2_e1u(ji,jj)122 zcoefe = -zcoef * hu_n(ji,jj) * e2_e1u(ji,jj) 123 123 zcoefe = zcoefe * bdyumask(ji,jj) 124 124 gcp(ji,jj,3) = zcoefe 125 125 126 126 ! north coefficient 127 zcoefn = -zcoef * hv (ji,jj) * e1_e2v(ji,jj)127 zcoefn = -zcoef * hv_n(ji,jj) * e1_e2v(ji,jj) 128 128 zcoefn = zcoefn * bdyvmask(ji,jj) 129 129 gcp(ji,jj,4) = zcoefn … … 148 148 ! south coefficient 149 149 IF( ( nbondj == -1 .OR. nbondj == 2 ) .AND. ( jj == 3 ) ) THEN 150 zcoefs = -zcoef * hv (ji,jj-1) * e1_e2v(ji,jj-1)*(1.-vmask(ji,jj-1,1))150 zcoefs = -zcoef * hv_n(ji,jj-1) * e1_e2v(ji,jj-1)*(1.-vmask(ji,jj-1,1)) 151 151 ELSE 152 zcoefs = -zcoef * hv (ji,jj-1) * e1_e2v(ji,jj-1)152 zcoefs = -zcoef * hv_n(ji,jj-1) * e1_e2v(ji,jj-1) 153 153 END IF 154 154 gcp(ji,jj,1) = zcoefs … … 156 156 ! west coefficient 157 157 IF( ( nbondi == -1 .OR. nbondi == 2 ) .AND. ( ji == 3 ) ) THEN 158 zcoefw = -zcoef * hu (ji-1,jj) * e2_e1u(ji-1,jj)*(1.-umask(ji-1,jj,1))158 zcoefw = -zcoef * hu_n(ji-1,jj) * e2_e1u(ji-1,jj)*(1.-umask(ji-1,jj,1)) 159 159 ELSE 160 zcoefw = -zcoef * hu (ji-1,jj) * e2_e1u(ji-1,jj)160 zcoefw = -zcoef * hu_n(ji-1,jj) * e2_e1u(ji-1,jj) 161 161 END IF 162 162 gcp(ji,jj,2) = zcoefw … … 164 164 ! east coefficient 165 165 IF( ( nbondi == 1 .OR. nbondi == 2 ) .AND. ( ji == nlci-2 ) ) THEN 166 zcoefe = -zcoef * hu (ji,jj) * e2_e1u(ji,jj)*(1.-umask(ji,jj,1))166 zcoefe = -zcoef * hu_n(ji,jj) * e2_e1u(ji,jj)*(1.-umask(ji,jj,1)) 167 167 ELSE 168 zcoefe = -zcoef * hu (ji,jj) * e2_e1u(ji,jj)168 zcoefe = -zcoef * hu_n(ji,jj) * e2_e1u(ji,jj) 169 169 END IF 170 170 gcp(ji,jj,3) = zcoefe … … 172 172 ! north coefficient 173 173 IF( ( nbondj == 1 .OR. nbondj == 2 ) .AND. ( jj == nlcj-2 ) ) THEN 174 zcoefn = -zcoef * hv (ji,jj) * e1_e2v(ji,jj)*(1.-vmask(ji,jj,1))174 zcoefn = -zcoef * hv_n(ji,jj) * e1_e2v(ji,jj)*(1.-vmask(ji,jj,1)) 175 175 ELSE 176 zcoefn = -zcoef * hv (ji,jj) * e1_e2v(ji,jj)176 zcoefn = -zcoef * hv_n(ji,jj) * e1_e2v(ji,jj) 177 177 END IF 178 178 gcp(ji,jj,4) = zcoefn -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r5541 r5845 172 172 173 173 !! * Substitutions 174 # include "domzgr_substitute.h90"175 174 # include "vectopt_loop_substitute.h90" 176 175 !!---------------------------------------------------------------------- … … 587 586 DO ji = 1, jpi 588 587 ! 589 zh = fsdept(ji,jj,jk) * r1_Z0 ! depth588 zh = gdept_n(ji,jj,jk) * r1_Z0 ! depth 590 589 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 591 590 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity … … 645 644 zt = pts (ji,jj,jk,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 646 645 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 647 zh = fsdept(ji,jj,jk)! depth in meters at t-point646 zh = gdept_n(ji,jj,jk) ! depth in meters at t-point 648 647 ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask 649 648 ! … … 913 912 DO jj = 1, jpj ! surface and bottom value set to zero one for all in istate.F90 914 913 DO ji = 1, jpi 915 zrw = ( fsdepw(ji,jj,jk ) - fsdept(ji,jj,jk) ) &916 & / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) )914 zrw = ( gdepw_n(ji,jj,jk ) - gdept_n(ji,jj,jk) ) & 915 & / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 917 916 ! 918 917 zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw … … 921 920 pn2(ji,jj,jk) = grav * ( zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) & 922 921 & - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) & 923 & / fse3w(ji,jj,jk) * tmask(ji,jj,jk)922 & / e3w_n(ji,jj,jk) * tmask(ji,jj,jk) 924 923 END DO 925 924 END DO … … 1129 1128 DO ji = 1, jpi 1130 1129 ! 1131 zh = fsdept(ji,jj,jk) * r1_Z0 ! depth1130 zh = gdept_n(ji,jj,jk) * r1_Z0 ! depth 1132 1131 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 1133 1132 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity … … 1193 1192 zt = pts(ji,jj,jk,jp_tem) - 10._wp ! temperature anomaly (t-T0) 1194 1193 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 1195 zh = fsdept(ji,jj,jk)! depth in meters at t-point1194 zh = gdept_n(ji,jj,jk) ! depth in meters at t-point 1196 1195 ztm = tmask(ji,jj,jk) ! tmask 1197 1196 zn = 0.5_wp * zh * r1_rau0 * ztm -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r5836 r5845 66 66 67 67 !! * Substitutions 68 # include "domzgr_substitute.h90"69 68 # include "vectopt_loop_substitute.h90" 70 69 !!---------------------------------------------------------------------- … … 102 101 ! !== effective transport ==! 103 102 DO jk = 1, jpkm1 104 zun(:,:,jk) = e2u (:,:) * fse3u(:,:,jk) * un(:,:,jk) ! eulerian transport only105 zvn(:,:,jk) = e1v (:,:) * fse3v(:,:,jk) * vn(:,:,jk)103 zun(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * un(:,:,jk) ! eulerian transport only 104 zvn(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 106 105 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 107 106 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90
r5836 r5845 34 34 35 35 !! * Substitutions 36 # include "domzgr_substitute.h90"37 36 # include "vectopt_loop_substitute.h90" 38 37 !!---------------------------------------------------------------------- … … 183 182 & - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 184 183 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 185 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) )184 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 186 185 END DO 187 186 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
r5836 r5845 40 40 41 41 !! * Substitutions 42 # include "domzgr_substitute.h90"43 42 # include "vectopt_loop_substitute.h90" 44 43 !!---------------------------------------------------------------------- … … 156 155 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 157 156 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 158 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) )157 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 159 158 ! update and guess with monotonic sheme 160 159 !!gm why tmask added in the two following lines ??? the mask is done in tranxt ! … … 296 295 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 297 296 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) & 298 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )297 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 299 298 END DO 300 299 END DO … … 450 449 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 451 450 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 452 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) )451 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 453 452 ! update and guess with monotonic sheme 454 453 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra … … 548 547 ztrs(ji,jj,jk,jta) = ztrs(ji,jj,jk,jtb) & 549 548 & - zts(jk) * ( zhdiv(ji,jj,jk) + zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) & 550 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )549 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 551 550 END DO 552 551 END DO … … 577 576 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ( zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 578 577 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) & 579 & / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) )578 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 580 579 END DO 581 580 END DO … … 680 679 681 680 ! up & down beta terms 682 zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt681 zbt = e1t(ji,jj) * e2t(ji,jj) * e3t_n(ji,jj,jk) / z2dtt 683 682 zbetup(ji,jj,jk) = ( zup - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt 684 683 zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo ) / ( zneg + zrtrn ) * zbt -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90
r5836 r5845 49 49 50 50 !! * Substitutions 51 # include "domzgr_substitute.h90"52 51 # include "vectopt_loop_substitute.h90" 53 52 !!---------------------------------------------------------------------- … … 125 124 DO jj = 1, jpj 126 125 DO ji = 1, jpi 127 zc = fse3t(ji,jj,jk) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1 ) ) ! zc being 0 outside the ML t-points126 zc = e3t_n(ji,jj,jk) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1 ) ) ! zc being 0 outside the ML t-points 128 127 zmld(ji,jj) = zmld(ji,jj) + zc 129 128 zbm (ji,jj) = zbm (ji,jj) + zc * (rau0 - rhop(ji,jj,jk) ) * r1_rau0 … … 157 156 END SELECT 158 157 ! ! convert density into buoyancy 159 zbm(:,:) = + grav * zbm(:,:) / MAX( fse3t(:,:,1), zmld(:,:) )158 zbm(:,:) = + grav * zbm(:,:) / MAX( e3t_n(:,:,1), zmld(:,:) ) 160 159 ! 161 160 ! … … 215 214 DO jj = 1, jpjm1 216 215 DO ji = 1, fs_jpim1 ! vector opt. 217 zcuw = 1._wp - ( fsdepw(ji+1,jj,jk) + fsdepw(ji,jj,jk) ) * zhu(ji,jj)218 zcvw = 1._wp - ( fsdepw(ji,jj+1,jk) + fsdepw(ji,jj,jk) ) * zhv(ji,jj)216 zcuw = 1._wp - ( gdepw_n(ji+1,jj,jk) + gdepw_n(ji,jj,jk) ) * zhu(ji,jj) 217 zcvw = 1._wp - ( gdepw_n(ji,jj+1,jk) + gdepw_n(ji,jj,jk) ) * zhv(ji,jj) 219 218 zcuw = zcuw * zcuw 220 219 zcvw = zcvw * zcvw -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90
r5836 r5845 42 42 43 43 !! * Substitutions 44 # include "domzgr_substitute.h90"45 44 # include "vectopt_loop_substitute.h90" 46 45 !!---------------------------------------------------------------------- … … 170 169 z0u = SIGN( 0.5, pun(ji,jj,jk) ) 171 170 zalpha = 0.5 - z0u 172 zu = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) )171 zu = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk) ) 173 172 zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk) 174 173 zzwy = ptb(ji ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji ,jj,jk) … … 177 176 z0v = SIGN( 0.5, pvn(ji,jj,jk) ) 178 177 zalpha = 0.5 - z0v 179 zv = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) )178 zv = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk) ) 180 179 zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk) 181 180 zzwy = ptb(ji,jj ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj ,jk) … … 191 190 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 192 191 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) ) & 193 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )192 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 194 193 END DO 195 194 END DO … … 243 242 z0w = SIGN( 0.5, pwn(ji,jj,jk+1) ) 244 243 zalpha = 0.5 + z0w 245 zw = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt / ( e1e2t(ji,jj) * fse3w(ji,jj,jk+1) )244 zw = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt / ( e1e2t(ji,jj) * e3w_n(ji,jj,jk+1) ) 246 245 zzwx = ptb(ji,jj,jk+1,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk+1) 247 246 zzwy = ptb(ji,jj,jk ,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk ) … … 268 267 DO jj = 2, jpjm1 269 268 DO ji = fs_2, fs_jpim1 ! vector opt. 270 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )269 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 271 270 END DO 272 271 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r5836 r5845 39 39 40 40 !! * Substitutions 41 # include "domzgr_substitute.h90"42 41 # include "vectopt_loop_substitute.h90" 43 42 !!---------------------------------------------------------------------- … … 171 170 DO ji = fs_2, fs_jpim1 ! vector opt. 172 171 zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) ) ! if pun > 0 : zdir = 1 otherwise zdir = 0 173 zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * fse3u(ji,jj,jk)172 zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u_n(ji,jj,jk) 174 173 zwx(ji,jj,jk) = ABS( pun(ji,jj,jk) ) * zdt / zdx ! (0<zc_cfl<1 : Courant number on x-direction) 175 174 zfc(ji,jj,jk) = zdir * ptb(ji ,jj,jk,jn) + ( 1. - zdir ) * ptb(ji+1,jj,jk,jn) ! FC in the x-direction for T … … 217 216 DO jj = 2, jpjm1 218 217 DO ji = fs_2, fs_jpim1 ! vector opt. 219 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )218 zbtr = 1. / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 220 219 ! horizontal advective trends 221 220 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) … … 294 293 DO ji = fs_2, fs_jpim1 ! vector opt. 295 294 zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) ) ! if pun > 0 : zdir = 1 otherwise zdir = 0 296 zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * fse3v(ji,jj,jk)295 zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v_n(ji,jj,jk) 297 296 zwy(ji,jj,jk) = ABS( pvn(ji,jj,jk) ) * zdt / zdx ! (0<zc_cfl<1 : Courant number on x-direction) 298 297 zfc(ji,jj,jk) = zdir * ptb(ji,jj ,jk,jn) + ( 1. - zdir ) * ptb(ji,jj+1,jk,jn) ! FC in the x-direction for T … … 341 340 DO jj = 2, jpjm1 342 341 DO ji = fs_2, fs_jpim1 ! vector opt. 343 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )342 zbtr = 1. / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 344 343 ! horizontal advective trends 345 344 ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) … … 413 412 DO ji = fs_2, fs_jpim1 ! vector opt. 414 413 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) & 415 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )414 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 416 415 END DO 417 416 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r5836 r5845 36 36 37 37 !! * Substitutions 38 # include "domzgr_substitute.h90"39 38 # include "vectopt_loop_substitute.h90" 40 39 !!---------------------------------------------------------------------- … … 122 121 DO jj = 1, jpjm1 ! First derivative (masked gradient) 123 122 DO ji = 1, fs_jpim1 ! vector opt. 124 zeeu = e2_e1u(ji,jj) * fse3u(ji,jj,jk) * umask(ji,jj,jk)125 zeev = e1_e2v(ji,jj) * fse3v(ji,jj,jk) * vmask(ji,jj,jk)123 zeeu = e2_e1u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) 124 zeev = e1_e2v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) 126 125 ztu(ji,jj,jk) = zeeu * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) 127 126 ztv(ji,jj,jk) = zeev * ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) … … 130 129 DO jj = 2, jpjm1 ! Second derivative (divergence) 131 130 DO ji = fs_2, fs_jpim1 ! vector opt. 132 zcoef = 1._wp / ( 6._wp * fse3t(ji,jj,jk) )131 zcoef = 1._wp / ( 6._wp * e3t_n(ji,jj,jk) ) 133 132 zltu(ji,jj,jk) = ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zcoef 134 133 zltv(ji,jj,jk) = ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) * zcoef … … 163 162 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) & 164 163 & - ( ztu(ji,jj,jk) - ztu(ji-1,jj ,jk) & 165 & + ztv(ji,jj,jk) - ztv(ji ,jj-1,jk) ) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )164 & + ztv(ji,jj,jk) - ztv(ji ,jj-1,jk) ) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 166 165 END DO 167 166 END DO … … 216 215 DO jj = 2, jpjm1 217 216 DO ji = fs_2, fs_jpim1 ! vector opt. 218 ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) )217 ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 219 218 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztak 220 219 zti(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + z2dtt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) … … 254 253 DO jj = 2, jpjm1 255 254 DO ji = fs_2, fs_jpim1 ! vector opt. 256 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) )255 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 257 256 END DO 258 257 END DO … … 265 264 zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk) & 266 265 & + ptn(ji,jj,jk,jn) * ( pwn(ji,jj,jk) - pwn(ji,jj,jk+1) ) & 267 & / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) )266 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 268 267 END DO 269 268 END DO … … 357 356 zneg = MAX( 0., pcc(ji ,jj ,jk ) ) - MIN( 0., pcc(ji ,jj ,jk+1) ) 358 357 ! up & down beta terms 359 zbt = e1e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt358 zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) / z2dtt 360 359 zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+zrtrn) * zbt 361 360 zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+zrtrn) * zbt -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
r5397 r5845 40 40 REAL(wp) :: rn_geoflx_cst ! Constant value of geothermal heat flux 41 41 42 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: qgh_trd0 ! geothermal heating trend 42 REAL(wp), PUBLIC , ALLOCATABLE, DIMENSION(:,:) :: qgh_trd0 ! geothermal heating trend 43 43 44 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_qgh ! structure of input qgh (file informations, fields read) 44 45 45 !! * Substitutions46 # include "domzgr_substitute.h90"47 46 !!---------------------------------------------------------------------- 48 47 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 92 91 DO ji = 2, jpim1 93 92 ik = mbkt(ji,jj) 94 zqgh_trd = qgh_trd0(ji,jj) / fse3t(ji,jj,ik)93 zqgh_trd = qgh_trd0(ji,jj) / e3t_n(ji,jj,ik) 95 94 tsa(ji,jj,ik,jp_tem) = tsa(ji,jj,ik,jp_tem) + zqgh_trd 96 95 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r5836 r5845 70 70 71 71 !! * Substitutions 72 # include "domzgr_substitute.h90"73 72 # include "vectopt_loop_substitute.h90" 74 73 !!---------------------------------------------------------------------- … … 211 210 & + ahv_bbl(ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) ) & 212 211 & - ahv_bbl(ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) & 213 & / ( e1e2t(ji,jj) * fse3t(ji,jj,ik) )212 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,ik) ) 214 213 END DO 215 214 END DO … … 263 262 ! 264 263 ! ! up -slope T-point (shelf bottom point) 265 zbtr = r1_e1e2t(iis,jj) / fse3t(iis,jj,ikus)264 zbtr = r1_e1e2t(iis,jj) / e3t_n(iis,jj,ikus) 266 265 ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 267 266 pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 268 267 ! 269 268 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 270 zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,jk)269 zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,jk) 271 270 ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 272 271 pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 273 272 END DO 274 273 ! 275 zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,ikud)274 zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,ikud) 276 275 ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 277 276 pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra … … 285 284 ! 286 285 ! up -slope T-point (shelf bottom point) 287 zbtr = r1_e1e2t(ji,ijs) / fse3t(ji,ijs,ikvs)286 zbtr = r1_e1e2t(ji,ijs) / e3t_n(ji,ijs,ikvs) 288 287 ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 289 288 pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 290 289 ! 291 290 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 292 zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,jk)291 zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,jk) 293 292 ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 294 293 pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn) + ztra 295 294 END DO 296 295 ! ! down-slope T-point (deep bottom point) 297 zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,ikvd)296 zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,ikvd) 298 297 ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 299 298 pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra … … 365 364 zts (ji,jj,jp_sal) = tsb(ji,jj,ik,jp_sal) 366 365 ! 367 zdep(ji,jj) = fsdept(ji,jj,ik)! bottom T-level reference depth366 zdep(ji,jj) = gdept_n(ji,jj,ik) ! bottom T-level reference depth 368 367 zub (ji,jj) = un(ji,jj,mbku(ji,jj)) ! bottom velocity 369 368 zvb (ji,jj) = vn(ji,jj,mbkv(ji,jj)) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
r5836 r5845 52 52 53 53 !! * Substitutions 54 # include "domzgr_substitute.h90"55 54 # include "vectopt_loop_substitute.h90" 56 55 !!---------------------------------------------------------------------- … … 139 138 DO jj = 2, jpjm1 140 139 DO ji = fs_2, fs_jpim1 ! vector opt. 141 IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN140 IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN 142 141 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) & 143 142 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r5836 r5845 43 43 44 44 !! * Substitutions 45 # include "domzgr_substitute.h90"46 45 # include "vectopt_loop_substitute.h90" 47 46 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_blp.F90
r5836 r5845 46 46 47 47 !! * Substitutions 48 # include "domzgr_substitute.h90"49 48 # include "vectopt_loop_substitute.h90" 50 49 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r5836 r5845 38 38 39 39 !! * Substitutions 40 # include "domzgr_substitute.h90"41 40 # include "vectopt_loop_substitute.h90" 42 41 !!---------------------------------------------------------------------- … … 183 182 DO ji = 1, fs_jpim1 184 183 akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk) & 185 & * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( fse3w(ji,jj,jk) * fse3w(ji,jj,jk) ) )184 & * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) ) ) 186 185 END DO 187 186 END DO … … 191 190 DO jj = 1, jpjm1 192 191 DO ji = 1, fs_jpim1 193 ze3w_2 = fse3w(ji,jj,jk) * fse3w(ji,jj,jk)192 ze3w_2 = e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) 194 193 zcoef0 = z2dt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 ) 195 194 akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt … … 269 268 DO jj = 1 , jpjm1 !== Horizontal fluxes 270 269 DO ji = 1, fs_jpim1 ! vector opt. 271 zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk)272 zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk)270 zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) 271 zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) 273 272 ! 274 273 zmsku = 1. / MAX( tmask(ji+1,jj,jk ) + tmask(ji,jj,jk+1) & … … 294 293 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) & 295 294 & + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) & 296 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )295 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 297 296 END DO 298 297 END DO … … 343 342 DO jj = 1, jpjm1 344 343 DO ji = fs_2, fs_jpim1 345 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk) &344 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk) & 346 345 & * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) ) & 347 346 & * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) … … 358 357 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) & 359 358 & + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj) & 360 & * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) / fse3w(ji,jj,jk)359 & * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) / e3w_n(ji,jj,jk) 361 360 END DO 362 361 END DO … … 366 365 DO jj = 1, jpjm1 367 366 DO ji = fs_2, fs_jpim1 368 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk) &367 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk) & 369 368 & * ( ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) ) & 370 369 & + akz (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) ) ) … … 379 378 DO ji = fs_2, fs_jpim1 ! vector opt. 380 379 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1) ) & 381 & / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) )380 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 382 381 END DO 383 382 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r5836 r5845 38 38 39 39 !! * Substitutions 40 # include "domzgr_substitute.h90"41 40 # include "vectopt_loop_substitute.h90" 42 41 !!---------------------------------------------------------------------- … … 100 99 DO jj = 1, jpjm1 101 100 DO ji = 1, fs_jpim1 ! vector opt. 102 zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) !!gm * umask(ji,jj,jk) pah masked!103 zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) !!gm * vmask(ji,jj,jk)101 zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) !!gm * umask(ji,jj,jk) pah masked! 102 zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) !!gm * vmask(ji,jj,jk) 104 103 END DO 105 104 END DO … … 140 139 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 141 140 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) & 142 & / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) )141 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 143 142 END DO 144 143 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90
r5836 r5845 37 37 38 38 !! * Substitutions 39 # include "domzgr_substitute.h90"40 39 # include "vectopt_loop_substitute.h90" 41 40 !!---------------------------------------------------------------------- … … 142 141 DO jj = 1, jpjm1 143 142 DO ji = 1, fs_jpim1 144 ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)145 zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk)143 ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp) 144 zbu = e1e2u(ji,jj) * e3u_n(ji,jj,jk) 146 145 zah = 0.25_wp * pahu(ji,jj,jk) 147 146 zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 148 147 ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth) 149 zslope2 = zslope_skew + ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp)148 zslope2 = zslope_skew + ( gdept_n(ji+1,jj,jk) - gdept_n(ji,jj,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp) 150 149 zslope2 = zslope2 *zslope2 151 150 ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji+ip,jj) * zslope2 … … 166 165 DO jj = 1, jpjm1 167 166 DO ji = 1, fs_jpim1 168 ze3wr = 1.0_wp / fse3w(ji,jj+jp,jk+kp)169 zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk)167 ze3wr = 1.0_wp / e3w_n(ji,jj+jp,jk+kp) 168 zbv = e1e2v(ji,jj) * e3v_n(ji,jj,jk) 170 169 zah = 0.25_wp * pahv(ji,jj,jk) 171 170 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 172 171 ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 173 172 ! (do this by *adding* gradient of depth) 174 zslope2 = zslope_skew + ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp)173 zslope2 = zslope_skew + ( gdept_n(ji,jj+1,jk) - gdept_n(ji,jj,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp) 175 174 zslope2 = zslope2 * zslope2 176 175 ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj+jp) * zslope2 … … 193 192 DO ji = 1, fs_jpim1 194 193 akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk) & 195 & * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( fse3w(ji,jj,jk) * fse3w(ji,jj,jk) ) )194 & * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) ) ) 196 195 END DO 197 196 END DO … … 201 200 DO jj = 1, jpjm1 202 201 DO ji = 1, fs_jpim1 203 ze3w_2 = fse3w(ji,jj,jk) * fse3w(ji,jj,jk)202 ze3w_2 = e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) 204 203 zcoef0 = z2dt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 ) 205 204 akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt … … 274 273 ze1ur = r1_e1u(ji,jj) 275 274 zdxt = zdit(ji,jj,jk) * ze1ur 276 ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)275 ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp) 277 276 zdzt = zdkt3d(ji+ip,jj,kp) * ze3wr 278 277 zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 279 278 zslope_iso = triadi (ji+ip,jj,jk,1-ip,kp) 280 279 281 zbu = 0.25_wp * e1e2u(ji,jj) * fse3u(ji,jj,jk)280 zbu = 0.25_wp * e1e2u(ji,jj) * e3u_n(ji,jj,jk) 282 281 ! ln_botmix_triad is .T. don't mask zah for bottom half cells !!gm ????? ahu is masked.... 283 282 zah = pahu(ji,jj,jk) … … 297 296 ze2vr = r1_e2v(ji,jj) 298 297 zdyt = zdjt(ji,jj,jk) * ze2vr 299 ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp)298 ze3wr = 1._wp / e3w_n(ji,jj+jp,jk+kp) 300 299 zdzt = zdkt3d(ji,jj+jp,kp) * ze3wr 301 300 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 302 301 zslope_iso = triadj(ji,jj+jp,jk,1-jp,kp) 303 zbv = 0.25_wp * e1e2v(ji,jj) * fse3v(ji,jj,jk)302 zbv = 0.25_wp * e1e2v(ji,jj) * e3v_n(ji,jj,jk) 304 303 ! ln_botmix_triad is .T. don't mask zah for bottom half cells !!gm ????? ahv is masked... 305 304 zah = pahv(ji,jj,jk) … … 321 320 ze1ur = r1_e1u(ji,jj) 322 321 zdxt = zdit(ji,jj,jk) * ze1ur 323 ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)322 ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp) 324 323 zdzt = zdkt3d(ji+ip,jj,kp) * ze3wr 325 324 zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 326 325 zslope_iso = triadi(ji+ip,jj,jk,1-ip,kp) 327 326 328 zbu = 0.25_wp * e1e2u(ji,jj) * fse3u(ji,jj,jk)327 zbu = 0.25_wp * e1e2u(ji,jj) * e3u_n(ji,jj,jk) 329 328 ! ln_botmix_triad is .F. mask zah for bottom half cells 330 329 zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp) ! pahu(ji+ip,jj,jk) ===>> ???? 331 330 zah_slp = zah * zslope_iso 332 IF( ln_ldfeiv ) zaei_slp = aeiu(ji,jj,jk) * zslope_skew ! fsaeit(ji+ip,jj,jk)*zslope_skew331 IF( ln_ldfeiv ) zaei_slp = aeiu(ji,jj,jk) * zslope_skew ! aeit(ji+ip,jj,jk)*zslope_skew 333 332 zftu(ji ,jj,jk ) = zftu(ji ,jj,jk ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 334 333 ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr … … 344 343 ze2vr = r1_e2v(ji,jj) 345 344 zdyt = zdjt(ji,jj,jk) * ze2vr 346 ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp)345 ze3wr = 1._wp / e3w_n(ji,jj+jp,jk+kp) 347 346 zdzt = zdkt3d(ji,jj+jp,kp) * ze3wr 348 347 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 349 348 zslope_iso = triadj(ji,jj+jp,jk,1-jp,kp) 350 zbv = 0.25_wp * e1e2v(ji,jj) * fse3v(ji,jj,jk)349 zbv = 0.25_wp * e1e2v(ji,jj) * e3v_n(ji,jj,jk) 351 350 ! ln_botmix_triad is .F. mask zah for bottom half cells 352 351 zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp) ! pahv(ji,jj+jp,jk) ???? 353 352 zah_slp = zah * zslope_iso 354 IF( ln_ldfeiv ) zaei_slp = aeiv(ji,jj,jk) * zslope_skew ! fsaeit(ji,jj+jp,jk)*zslope_skew353 IF( ln_ldfeiv ) zaei_slp = aeiv(ji,jj,jk) * zslope_skew ! aeit(ji,jj+jp,jk)*zslope_skew 355 354 zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 356 355 ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr … … 365 364 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( zftu(ji-1,jj,jk) - zftu(ji,jj,jk) & 366 365 & + zftv(ji,jj-1,jk) - zftv(ji,jj,jk) ) & 367 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )366 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 368 367 END DO 369 368 END DO … … 376 375 DO jj = 1, jpjm1 377 376 DO ji = fs_2, fs_jpim1 378 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk) &377 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk) & 379 378 & * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) ) & 380 379 & * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) … … 388 387 DO jj = 1, jpjm1 389 388 DO ji = fs_2, fs_jpim1 390 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk) &389 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk) & 391 390 & * ah_wslp2(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 392 391 END DO … … 397 396 DO jj = 1, jpjm1 398 397 DO ji = fs_2, fs_jpim1 399 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk) &398 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk) & 400 399 & * ( ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) ) & 401 400 & + akz (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) ) ) … … 410 409 DO ji = fs_2, fs_jpim1 ! vector opt. 411 410 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk) ) & 412 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )411 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 413 412 END DO 414 413 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90
r5386 r5845 35 35 36 36 !! * Substitutions 37 # include "domzgr_substitute.h90"38 37 # include "vectopt_loop_substitute.h90" 39 38 !!---------------------------------------------------------------------- … … 195 194 DO jk = ikup, ikbot ! Inside the instable (and overlying neutral) portion of the column 196 195 ! 197 zdz = fse3t(ji,jj,jk)196 zdz = e3t_n(ji,jj,jk) 198 197 zsum_temp = zsum_temp + zvts(jk,jp_tem)*zdz 199 198 zsum_sali = zsum_sali + zvts(jk,jp_sal)*zdz … … 244 243 245 244 !! Interpolating alfa and beta at W point: 246 zrw = ( fsdepw(ji,jj,jk ) - fsdept(ji,jj,jk)) &247 & / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk))245 zrw = (gdepw_n(ji,jj,jk ) - gdept_n(ji,jj,jk)) & 246 & / (gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk)) 248 247 zaw = zvab(jk,jp_tem) * (1._wp - zrw) + zvab(jk-1,jp_tem) * zrw 249 248 zbw = zvab(jk,jp_sal) * (1._wp - zrw) + zvab(jk-1,jp_sal) * zrw … … 252 251 zvn2(jk) = grav*( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) ) & 253 252 & - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) ) ) & 254 & / fse3w(ji,jj,jk) * tmask(ji,jj,jk)253 & / e3w_n(ji,jj,jk) * tmask(ji,jj,jk) 255 254 256 255 !! OR, faster => just considering the vertical gradient of density -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r5836 r5845 60 60 REAL(wp) :: rbcp ! Brown & Campana parameters for semi-implicit hpg 61 61 62 !! * Substitutions63 # include "domzgr_substitute.h90"64 62 !!---------------------------------------------------------------------- 65 63 !! NEMO/OPA 3.3 , NEMO-Consortium (2010) … … 310 308 DO jj = 1, jpj 311 309 DO ji = 1, jpi 312 ze3t_b = fse3t_b(ji,jj,jk)313 ze3t_n = fse3t_n(ji,jj,jk)314 ze3t_a = fse3t_a(ji,jj,jk)310 ze3t_b = e3t_b(ji,jj,jk) 311 ze3t_n = e3t_n(ji,jj,jk) 312 ze3t_a = e3t_a(ji,jj,jk) 315 313 ! ! tracer content at Before, now and after 316 314 ztc_b = ptb(ji,jj,jk,jn) * ze3t_b … … 338 336 IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) ) & 339 337 & ztc_f = ztc_f - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 340 & * fse3t_n(ji,jj,jk) / h_rnf(ji,jj)338 & * e3t_n(ji,jj,jk) / h_rnf(ji,jj) 341 339 342 340 ! ice shelf … … 345 343 IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) ) & 346 344 ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) & 347 & * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)345 & * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) 348 346 ! level partially include in Losch_2008 ice shelf boundary layer 349 347 IF ( jk == misfkb(ji,jj) ) & 350 348 ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) & 351 & * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)349 & * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj) 352 350 END IF 353 351 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r5836 r5845 58 58 59 59 !! * Substitutions 60 # include "domzgr_substitute.h90"61 60 # include "vectopt_loop_substitute.h90" 62 61 !!---------------------------------------------------------------------- … … 157 156 DO jj = 2, jpjm1 158 157 DO ji = fs_2, fs_jpim1 ! vector opt. 159 z1_e3t = zfact / fse3t(ji,jj,jk)158 z1_e3t = zfact / e3t_n(ji,jj,jk) 160 159 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) * z1_e3t 161 160 END DO … … 216 215 DO jj = 1, jpj 217 216 DO ji = 1, jpi 218 zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r )219 zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekb(ji,jj) )220 zc2 = ze2(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekg(ji,jj) )221 zc3 = ze3(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekr(ji,jj) )217 zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * xsi0r ) 218 zc1 = ze1(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekb(ji,jj) ) 219 zc2 = ze2(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekg(ji,jj) ) 220 zc3 = ze3(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekr(ji,jj) ) 222 221 ze0(ji,jj,jk) = zc0 223 222 ze1(ji,jj,jk) = zc1 … … 232 231 DO jj = 1, jpj 233 232 DO ji = 1, jpi 234 zzc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r )235 zzc1 = zcoef * EXP( - fse3t(ji,jj,1) * zekb(ji,jj) )236 zzc2 = zcoef * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) )237 zzc3 = zcoef * EXP( - fse3t(ji,jj,1) * zekr(ji,jj) )233 zzc0 = rn_abs * EXP( - e3t_n(ji,jj,1) * xsi0r ) 234 zzc1 = zcoef * EXP( - e3t_n(ji,jj,1) * zekb(ji,jj) ) 235 zzc2 = zcoef * EXP( - e3t_n(ji,jj,1) * zekg(ji,jj) ) 236 zzc3 = zcoef * EXP( - e3t_n(ji,jj,1) * zekr(ji,jj) ) 238 237 fraqsr_1lev(ji,jj) = 1.0 - ( zzc0 + zzc1 + zzc2 + zzc3 ) * tmask(ji,jj,2) 239 238 END DO … … 268 267 DO jj = 1, jpj 269 268 DO ji = 1, jpi 270 zc0 = zz0 * EXP( - fsdepw(ji,jj,jk )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk )*xsi1r )271 zc1 = zz0 * EXP( - fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r )269 zc0 = zz0 * EXP( -gdepw_n(ji,jj,jk )*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk )*xsi1r ) 270 zc1 = zz0 * EXP( -gdepw_n(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk+1)*xsi1r ) 272 271 qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0*tmask(ji,jj,jk) - zc1*tmask(ji,jj,jk+1) ) 273 272 END DO … … 278 277 DO jj = 1, jpj 279 278 DO ji = 1, jpi 280 zc0 = zz0 * EXP( - fsdepw(ji,jj,1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,1)*xsi1r )281 zc1 = zz0 * EXP( - fsdepw(ji,jj,2)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,2)*xsi1r )279 zc0 = zz0 * EXP( -gdepw_n(ji,jj,1)*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,1)*xsi1r ) 280 zc1 = zz0 * EXP( -gdepw_n(ji,jj,2)*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,2)*xsi1r ) 282 281 fraqsr_1lev(ji,jj) = ( zc0*tmask(ji,jj,1) - zc1*tmask(ji,jj,2) ) / r1_rau0_rcp 283 282 END DO … … 306 305 DO jj = 2, jpjm1 307 306 DO ji = fs_2, fs_jpim1 ! vector opt. 308 z1_e3t = zfact / fse3t(ji,jj,jk)307 z1_e3t = zfact / e3t_n(ji,jj,jk) 309 308 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) * z1_e3t 310 309 END DO … … 533 532 DO jj = 1, jpj ! top 400 meters 534 533 DO ji = 1, jpi 535 zc0 = zz0 * EXP( - fsdepw(ji,jj,jk )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk )*xsi1r )536 zc1 = zz0 * EXP( - fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r )534 zc0 = zz0 * EXP( -gdepw_n(ji,jj,jk )*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk )*xsi1r ) 535 zc1 = zz0 * EXP( -gdepw_n(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk+1)*xsi1r ) 537 536 etot3(ji,jj,jk) = ( zc0 * tmask(ji,jj,jk) - zc1 * tmask(ji,jj,jk+1) ) * tmask(ji,jj,1) 538 537 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r5643 r5845 40 40 41 41 !! * Substitutions 42 # include "domzgr_substitute.h90"43 42 # include "vectopt_loop_substitute.h90" 44 43 !!---------------------------------------------------------------------- … … 196 195 DO jj = 2, jpj 197 196 DO ji = fs_2, fs_jpim1 ! vector opt. 198 z1_e3t = zfact / fse3t(ji,jj,1)197 z1_e3t = zfact / e3t_n(ji,jj,1) 199 198 tsa(ji,jj,1,jn) = tsa(ji,jj,1,jn) + ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) * z1_e3t 200 199 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
r5836 r5845 44 44 45 45 !! * Substitutions 46 # include "domzgr_substitute.h90"47 46 # include "zdfddm_substitute.h90" 48 47 # include "vectopt_loop_substitute.h90" -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90
r3294 r5845 40 40 41 41 !! * Substitutions 42 # include "domzgr_substitute.h90"43 42 # include "zdfddm_substitute.h90" 44 43 # include "vectopt_loop_substitute.h90" … … 122 121 DO jj = 2, jpjm1 123 122 DO ji = fs_2, fs_jpim1 ! vector opt. 124 zave3r = 1.e0 / fse3w_n(ji,jj,jk)123 zave3r = 1.e0 / e3w_n(ji,jj,jk) 125 124 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN ! temperature : use of avt 126 125 zwy(ji,jj,jk) = avt(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) * zave3r … … 135 134 DO jj = 2, jpjm1 136 135 DO ji = fs_2, fs_jpim1 ! vector opt. 137 ze3tr = zlavmr / fse3t_n(ji,jj,jk)136 ze3tr = zlavmr / e3t_n(ji,jj,jk) 138 137 zwx(ji,jj,jk) = zwx(ji,jj,jk) + p2dt(jk) * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) * ze3tr 139 138 END DO … … 149 148 DO jj = 2, jpjm1 150 149 DO ji = fs_2, fs_jpim1 ! vector opt. 151 ze3tb = fse3t_b(ji,jj,jk) / fse3t(ji,jj,jk) ! before e3t150 ze3tb = e3t_b(ji,jj,jk) / e3t_n(ji,jj,jk) ! before e3t 152 151 ztra = zwx(ji,jj,jk) - ptb(ji,jj,jk,jn) + p2dt(jk) * pta(ji,jj,jk,jn) ! total trends * 2*rdt 153 152 pta(ji,jj,jk,jn) = ( ze3tb * ptb(ji,jj,jk,jn) + ztra ) * tmask(ji,jj,jk) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r5836 r5845 45 45 46 46 !! * Substitutions 47 # include "domzgr_substitute.h90"48 47 # include "zdfddm_substitute.h90" 49 48 # include "vectopt_loop_substitute.h90" … … 142 141 DO jj = 2, jpjm1 143 142 DO ji = fs_2, fs_jpim1 ! vector opt. 144 ze3ta = ( 1. - r_vvl ) + r_vvl * fse3t_a(ji,jj,jk) ! after scale factor at T-point145 ze3tn = r_vvl + ( 1. - r_vvl ) * fse3t_n(ji,jj,jk) ! now scale factor at T-point146 zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk ) / ( ze3tn * fse3w(ji,jj,jk ) )147 zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) )143 ze3ta = ( 1. - r_vvl ) + r_vvl * e3t_a(ji,jj,jk) ! after scale factor at T-point 144 ze3tn = r_vvl + ( 1. - r_vvl ) * e3t_n(ji,jj,jk) ! now scale factor at T-point 145 zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk ) / ( ze3tn * e3w_n(ji,jj,jk ) ) 146 zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * e3w_n(ji,jj,jk+1) ) 148 147 zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk) 149 148 END DO … … 190 189 DO jj = 2, jpjm1 191 190 DO ji = fs_2, fs_jpim1 192 ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,1)193 ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t(ji,jj,1)191 ze3tb = ( 1. - r_vvl ) + r_vvl * e3t_b(ji,jj,1) 192 ze3tn = ( 1. - r_vvl ) + r_vvl * e3t_n(ji,jj,1) 194 193 pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn) + p2dt(1) * ze3tn * pta(ji,jj,1,jn) 195 194 END DO … … 198 197 DO jj = 2, jpjm1 199 198 DO ji = fs_2, fs_jpim1 200 ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,jk)201 ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t(ji,jj,jk)199 ze3tb = ( 1. - r_vvl ) + r_vvl * e3t_b(ji,jj,jk) 200 ze3tn = ( 1. - r_vvl ) + r_vvl * e3t_n(ji,jj,jk) 202 201 zrhs = ze3tb * ptb(ji,jj,jk,jn) + p2dt(jk) * ze3tn * pta(ji,jj,jk,jn) ! zrhs=right hand side 203 202 pta(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pta(ji,jj,jk-1,jn) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
r5836 r5845 32 32 33 33 !! * Substitutions 34 # include "domzgr_substitute.h90"35 34 # include "vectopt_loop_substitute.h90" 36 35 !!---------------------------------------------------------------------- … … 111 110 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 112 111 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 113 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku)114 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv)112 ze3wu = e3w_n(ji+1,jj ,iku) - e3w_n(ji,jj,iku) 113 ze3wv = e3w_n(ji ,jj+1,ikv) - e3w_n(ji,jj,ikv) 115 114 ! 116 115 ! i- direction 117 116 IF( ze3wu >= 0._wp ) THEN ! case 1 118 zmaxu = ze3wu / fse3w(ji+1,jj,iku)117 zmaxu = ze3wu / e3w_n(ji+1,jj,iku) 119 118 ! interpolated values of tracers 120 119 zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) … … 122 121 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 123 122 ELSE ! case 2 124 zmaxu = -ze3wu / fse3w(ji,jj,iku)123 zmaxu = -ze3wu / e3w_n(ji,jj,iku) 125 124 ! interpolated values of tracers 126 125 zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) … … 131 130 ! j- direction 132 131 IF( ze3wv >= 0._wp ) THEN ! case 1 133 zmaxv = ze3wv / fse3w(ji,jj+1,ikv)132 zmaxv = ze3wv / e3w_n(ji,jj+1,ikv) 134 133 ! interpolated values of tracers 135 134 ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) … … 137 136 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 138 137 ELSE ! case 2 139 zmaxv = -ze3wv / fse3w(ji,jj,ikv)138 zmaxv = -ze3wv / e3w_n(ji,jj,ikv) 140 139 ! interpolated values of tracers 141 140 ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) … … 156 155 iku = mbku(ji,jj) 157 156 ikv = mbkv(ji,jj) 158 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku)159 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv)160 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = fsdept(ji ,jj,iku) ! i-direction: case 1161 ELSE ; zhi(ji,jj) = fsdept(ji+1,jj,iku) ! - - case 2162 ENDIF 163 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = fsdept(ji,jj ,ikv) ! j-direction: case 1164 ELSE ; zhj(ji,jj) = fsdept(ji,jj+1,ikv) ! - - case 2157 ze3wu = e3w_n(ji+1,jj ,iku) - e3w_n(ji,jj,iku) 158 ze3wv = e3w_n(ji ,jj+1,ikv) - e3w_n(ji,jj,ikv) 159 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept_n(ji ,jj,iku) ! i-direction: case 1 160 ELSE ; zhi(ji,jj) = gdept_n(ji+1,jj,iku) ! - - case 2 161 ENDIF 162 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept_n(ji,jj ,ikv) ! j-direction: case 1 163 ELSE ; zhj(ji,jj) = gdept_n(ji,jj+1,ikv) ! - - case 2 165 164 ENDIF 166 165 END DO … … 174 173 iku = mbku(ji,jj) 175 174 ikv = mbkv(ji,jj) 176 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku)177 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv)175 ze3wu = e3w_n(ji+1,jj ,iku) - e3w_n(ji,jj,iku) 176 ze3wv = e3w_n(ji ,jj+1,ikv) - e3w_n(ji,jj,ikv) 178 177 IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 179 178 ELSE ; pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj ) ) ! i: 2 … … 288 287 ! i- direction 289 288 IF( ze3wu >= 0._wp ) THEN ! case 1 290 zmaxu = ze3wu / fse3w(ji+1,jj,iku)289 zmaxu = ze3wu / e3w_n(ji+1,jj,iku) 291 290 ! interpolated values of tracers 292 291 zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) … … 294 293 pgtu(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 295 294 ELSE ! case 2 296 zmaxu = -ze3wu / fse3w(ji,jj,iku)295 zmaxu = -ze3wu / e3w_n(ji,jj,iku) 297 296 ! interpolated values of tracers 298 297 zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) … … 303 302 ! j- direction 304 303 IF( ze3wv >= 0._wp ) THEN ! case 1 305 zmaxv = ze3wv / fse3w(ji,jj+1,ikv)304 zmaxv = ze3wv / e3w_n(ji,jj+1,ikv) 306 305 ! interpolated values of tracers 307 306 ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) … … 309 308 pgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 310 309 ELSE ! case 2 311 zmaxv = -ze3wv / fse3w(ji,jj,ikv)310 zmaxv = -ze3wv / e3w_n(ji,jj,ikv) 312 311 ! interpolated values of tracers 313 312 ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) … … 335 334 ze3wv = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv)) 336 335 ! 337 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = fsdept(ji+1,jj,iku) - ze3wu ! i-direction: case 1338 ELSE ; zhi(ji,jj) = fsdept(ji ,jj,iku) + ze3wu ! - - case 2339 ENDIF 340 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = fsdept(ji,jj+1,ikv) - ze3wv ! j-direction: case 1341 ELSE ; zhj(ji,jj) = fsdept(ji,jj ,ikv) + ze3wv ! - - case 2336 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept_n(ji+1,jj,iku) - ze3wu ! i-direction: case 1 337 ELSE ; zhi(ji,jj) = gdept_n(ji ,jj,iku) + ze3wu ! - - case 2 338 ENDIF 339 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept_n(ji,jj+1,ikv) - ze3wv ! j-direction: case 1 340 ELSE ; zhj(ji,jj) = gdept_n(ji,jj ,ikv) + ze3wv ! - - case 2 342 341 ENDIF 343 342 END DO … … 354 353 ze3wv = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv)) 355 354 IF( ze3wu >= 0._wp ) THEN 356 pgzu(ji,jj) = ( fsde3w(ji+1,jj,iku) - ze3wu) - fsde3w(ji,jj,iku)355 pgzu(ji,jj) = (gde3w_n(ji+1,jj,iku) - ze3wu) - gde3w_n(ji,jj,iku) 357 356 pgru(ji,jj) = umask(ji,jj,iku) * ( zri(ji ,jj) - prd(ji,jj,iku) ) ! i: 1 358 357 pmru(ji,jj) = umask(ji,jj,iku) * ( zri(ji ,jj) + prd(ji,jj,iku) ) ! i: 1 359 358 pge3ru(ji,jj) = umask(ji,jj,iku) & 360 * ( ( fse3w(ji+1,jj,iku) - ze3wu )* ( zri(ji ,jj ) + prd(ji+1,jj,ikum1) + 2._wp) &361 - fse3w(ji ,jj,iku) * ( prd(ji ,jj,iku) + prd(ji ,jj,ikum1) + 2._wp) ) ! j: 2359 * ( (e3w_n(ji+1,jj,iku) - ze3wu )* ( zri(ji ,jj ) + prd(ji+1,jj,ikum1) + 2._wp) & 360 - e3w_n(ji ,jj,iku) * ( prd(ji ,jj,iku) + prd(ji ,jj,ikum1) + 2._wp) ) ! j: 2 362 361 ELSE 363 pgzu(ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) + ze3wu)362 pgzu(ji,jj) = gde3w_n(ji+1,jj,iku) - (gde3w_n(ji,jj,iku) + ze3wu) 364 363 pgru(ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) ! i: 2 365 364 pmru(ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) + zri(ji,jj) ) ! i: 2 366 365 pge3ru(ji,jj) = umask(ji,jj,iku) & 367 * ( fse3w(ji+1,jj,iku) * ( prd(ji+1,jj,iku) + prd(ji+1,jj,ikum1) + 2._wp) &368 -( fse3w(ji ,jj,iku) + ze3wu) * ( zri(ji ,jj ) + prd(ji ,jj,ikum1) + 2._wp) ) ! j: 2366 * ( e3w_n(ji+1,jj,iku) * ( prd(ji+1,jj,iku) + prd(ji+1,jj,ikum1) + 2._wp) & 367 -(e3w_n(ji ,jj,iku) + ze3wu) * ( zri(ji ,jj ) + prd(ji ,jj,ikum1) + 2._wp) ) ! j: 2 369 368 ENDIF 370 369 IF( ze3wv >= 0._wp ) THEN 371 pgzv(ji,jj) = ( fsde3w(ji,jj+1,ikv) - ze3wv) - fsde3w(ji,jj,ikv)370 pgzv(ji,jj) = (gde3w_n(ji,jj+1,ikv) - ze3wv) - gde3w_n(ji,jj,ikv) 372 371 pgrv(ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 373 372 pmrv(ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) + prd(ji,jj,ikv) ) ! j: 1 374 373 pge3rv(ji,jj) = vmask(ji,jj,ikv) & 375 * ( ( fse3w(ji,jj+1,ikv) - ze3wv )* ( zrj(ji,jj ) + prd(ji,jj+1,ikvm1) + 2._wp) &376 - fse3w(ji,jj ,ikv) * ( prd(ji,jj ,ikv) + prd(ji,jj ,ikvm1) + 2._wp) ) ! j: 2374 * ( (e3w_n(ji,jj+1,ikv) - ze3wv )* ( zrj(ji,jj ) + prd(ji,jj+1,ikvm1) + 2._wp) & 375 - e3w_n(ji,jj ,ikv) * ( prd(ji,jj ,ikv) + prd(ji,jj ,ikvm1) + 2._wp) ) ! j: 2 377 376 ELSE 378 pgzv(ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) + ze3wv)377 pgzv(ji,jj) = gde3w_n(ji,jj+1,ikv) - (gde3w_n(ji,jj,ikv) + ze3wv) 379 378 pgrv(ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) ! j: 2 380 379 pmrv(ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) + zrj(ji,jj) ) ! j: 2 381 380 pge3rv(ji,jj) = vmask(ji,jj,ikv) & 382 * ( fse3w(ji,jj+1,ikv) * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikvm1) + 2._wp) &383 -( fse3w(ji,jj ,ikv) + ze3wv) * ( zrj(ji,jj ) + prd(ji,jj ,ikvm1) + 2._wp) ) ! j: 2381 * ( e3w_n(ji,jj+1,ikv) * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikvm1) + 2._wp) & 382 -(e3w_n(ji,jj ,ikv) + ze3wv) * ( zrj(ji,jj ) + prd(ji,jj ,ikvm1) + 2._wp) ) ! j: 2 384 383 ENDIF 385 384 END DO … … 408 407 ! i- direction 409 408 IF( ze3wu >= 0._wp ) THEN ! case 1 410 zmaxu = ze3wu / fse3w(ji+1,jj,iku+1)409 zmaxu = ze3wu / e3w_n(ji+1,jj,iku+1) 411 410 ! interpolated values of tracers 412 411 zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,iku+1,jn) - pta(ji+1,jj,iku,jn) ) … … 414 413 pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 415 414 ELSE ! case 2 416 zmaxu = - ze3wu / fse3w(ji,jj,iku+1)415 zmaxu = - ze3wu / e3w_n(ji,jj,iku+1) 417 416 ! interpolated values of tracers 418 417 zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,iku+1,jn) - pta(ji,jj,iku,jn) ) … … 423 422 ! j- direction 424 423 IF( ze3wv >= 0._wp ) THEN ! case 1 425 zmaxv = ze3wv / fse3w(ji,jj+1,ikv+1)424 zmaxv = ze3wv / e3w_n(ji,jj+1,ikv+1) 426 425 ! interpolated values of tracers 427 426 ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikv+1,jn) - pta(ji,jj+1,ikv,jn) ) … … 429 428 pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 430 429 ELSE ! case 2 431 zmaxv = - ze3wv / fse3w(ji,jj,ikv+1)430 zmaxv = - ze3wv / e3w_n(ji,jj,ikv+1) 432 431 ! interpolated values of tracers 433 432 ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikv+1,jn) - pta(ji,jj,ikv,jn) ) … … 452 451 iku = miku(ji,jj) 453 452 ikv = mikv(ji,jj) 454 ze3wu 455 ze3wv 456 ! 457 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = fsdept(ji+1,jj,iku) + ze3wu ! i-direction: case 1458 ELSE ; zhi(ji,jj) = fsdept(ji ,jj,iku) - ze3wu ! - - case 2459 ENDIF 460 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = fsdept(ji,jj+1,ikv) + ze3wv ! j-direction: case 1461 ELSE ; zhj(ji,jj) = fsdept(ji,jj ,ikv) - ze3wv ! - - case 2453 ze3wu = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku)) 454 ze3wv = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv)) 455 ! 456 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept_n(ji+1,jj,iku) + ze3wu ! i-direction: case 1 457 ELSE ; zhi(ji,jj) = gdept_n(ji ,jj,iku) - ze3wu ! - - case 2 458 ENDIF 459 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept_n(ji,jj+1,ikv) + ze3wv ! j-direction: case 1 460 ELSE ; zhj(ji,jj) = gdept_n(ji,jj ,ikv) - ze3wv ! - - case 2 462 461 ENDIF 463 462 END DO … … 474 473 ze3wv = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv)) 475 474 IF( ze3wu >= 0._wp ) THEN 476 pgzui (ji,jj) = ( fsde3w(ji+1,jj,iku) + ze3wu) - fsde3w(ji,jj,iku)475 pgzui (ji,jj) = (gde3w_n(ji+1,jj,iku) + ze3wu) - gde3w_n(ji,jj,iku) 477 476 pgrui (ji,jj) = umask(ji,jj,iku) * ( zri(ji,jj) - prd(ji,jj,iku) ) ! i: 1 478 477 pmrui (ji,jj) = umask(ji,jj,iku) * ( zri(ji,jj) + prd(ji,jj,iku) ) ! i: 1 479 478 pge3rui(ji,jj) = umask(ji,jj,iku+1) & 480 & * ( ( fse3w(ji+1,jj,iku+1) - ze3wu) * (zri(ji,jj ) + prd(ji+1,jj,iku+1) + 2._wp) &481 & - fse3w(ji ,jj,iku+1) * (prd(ji,jj,iku) + prd(ji ,jj,iku+1) + 2._wp) ) ! i: 1479 & * ( (e3w_n(ji+1,jj,iku+1) - ze3wu) * (zri(ji,jj ) + prd(ji+1,jj,iku+1) + 2._wp) & 480 & - e3w_n(ji ,jj,iku+1) * (prd(ji,jj,iku) + prd(ji ,jj,iku+1) + 2._wp) ) ! i: 1 482 481 ELSE 483 pgzui (ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) - ze3wu)482 pgzui (ji,jj) = gde3w_n(ji+1,jj,iku) - (gde3w_n(ji,jj,iku) - ze3wu) 484 483 pgrui (ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) ! i: 2 485 484 pmrui (ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) + zri(ji,jj) ) ! i: 2 486 485 pge3rui(ji,jj) = umask(ji,jj,iku+1) & 487 & * ( fse3w(ji+1,jj,iku+1) * (prd(ji+1,jj,iku) + prd(ji+1,jj,iku+1) + 2._wp) &488 & -( fse3w(ji ,jj,iku+1) + ze3wu) * (zri(ji,jj ) + prd(ji ,jj,iku+1) + 2._wp) ) ! i: 2486 & * ( e3w_n(ji+1,jj,iku+1) * (prd(ji+1,jj,iku) + prd(ji+1,jj,iku+1) + 2._wp) & 487 & -(e3w_n(ji ,jj,iku+1) + ze3wu) * (zri(ji,jj ) + prd(ji ,jj,iku+1) + 2._wp) ) ! i: 2 489 488 ENDIF 490 489 IF( ze3wv >= 0._wp ) THEN 491 pgzvi (ji,jj) = ( fsde3w(ji,jj+1,ikv) + ze3wv) - fsde3w(ji,jj,ikv)490 pgzvi (ji,jj) = (gde3w_n(ji,jj+1,ikv) + ze3wv) - gde3w_n(ji,jj,ikv) 492 491 pgrvi (ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 493 492 pmrvi (ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) + prd(ji,jj,ikv) ) ! j: 1 494 493 pge3rvi(ji,jj) = vmask(ji,jj,ikv+1) & 495 & * ( ( fse3w(ji,jj+1,ikv+1) - ze3wv) * ( zrj(ji,jj ) + prd(ji,jj+1,ikv+1) + 2._wp) &496 & - fse3w(ji,jj ,ikv+1) * ( prd(ji,jj,ikv) + prd(ji,jj ,ikv+1) + 2._wp) ) ! j: 1494 & * ( (e3w_n(ji,jj+1,ikv+1) - ze3wv) * ( zrj(ji,jj ) + prd(ji,jj+1,ikv+1) + 2._wp) & 495 & - e3w_n(ji,jj ,ikv+1) * ( prd(ji,jj,ikv) + prd(ji,jj ,ikv+1) + 2._wp) ) ! j: 1 497 496 ! + 2 due to the formulation in density and not in anomalie in hpg sco 498 497 ELSE 499 pgzvi (ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) - ze3wv)498 pgzvi (ji,jj) = gde3w_n(ji,jj+1,ikv) - (gde3w_n(ji,jj,ikv) - ze3wv) 500 499 pgrvi (ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) ! j: 2 501 500 pmrvi (ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) + zrj(ji,jj) ) ! j: 2 502 501 pge3rvi(ji,jj) = vmask(ji,jj,ikv+1) & 503 & * ( fse3w(ji,jj+1,ikv+1) * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikv+1) + 2._wp) &504 & -( fse3w(ji,jj ,ikv+1) + ze3wv) * ( zrj(ji,jj ) + prd(ji,jj ,ikv+1) + 2._wp) ) ! j: 2502 & * ( e3w_n(ji,jj+1,ikv+1) * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikv+1) + 2._wp) & 503 & -(e3w_n(ji,jj ,ikv+1) + ze3wv) * ( zrj(ji,jj ) + prd(ji,jj ,ikv+1) + 2._wp) ) ! j: 2 505 504 ENDIF 506 505 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90
r5215 r5845 36 36 37 37 !! * Substitutions 38 # include "domzgr_substitute.h90"39 38 # include "vectopt_loop_substitute.h90" 40 39 !!---------------------------------------------------------------------- … … 147 146 ! ! wind stress trends 148 147 CALL wrk_alloc( jpi, jpj, z2dx, z2dy ) 149 z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( fse3u(:,:,1) * rau0 )150 z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( fse3v(:,:,1) * rau0 )148 z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u_n(:,:,1) * rau0 ) 149 z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v_n(:,:,1) * rau0 ) 151 150 CALL iom_put( "utrd_tau", z2dx ) 152 151 CALL iom_put( "vtrd_tau", z2dy ) … … 165 164 ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 166 165 ikbv = mbkv(ji,jj) 167 z3dx(ji,jj,jk) = bfrua(ji,jj) * un(ji,jj,ikbu) / fse3u(ji,jj,ikbu)168 z3dy(ji,jj,jk) = bfrva(ji,jj) * vn(ji,jj,ikbv) / fse3v(ji,jj,ikbv)166 z3dx(ji,jj,jk) = bfrua(ji,jj) * un(ji,jj,ikbu) / e3u_n(ji,jj,ikbu) 167 z3dy(ji,jj,jk) = bfrva(ji,jj) * vn(ji,jj,ikbv) / e3v_n(ji,jj,ikbv) 169 168 END DO 170 169 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90
r5836 r5845 52 52 53 53 !! * Substitutions 54 # include "domzgr_substitute.h90"55 54 # include "vectopt_loop_substitute.h90" 56 55 # include "zdfddm_substitute.h90" … … 92 91 DO jj = 1, jpj 93 92 DO ji = 1, jpi 94 zvm = e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)93 zvm = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 95 94 zvt = ptrdx(ji,jj,jk) * zvm 96 95 zvs = ptrdy(ji,jj,jk) * zvm … … 126 125 DO ji = 1, jpim1 127 126 zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk) & 128 & * e1u (ji ,jj ) * e2u (ji,jj) * fse3u(ji,jj,jk)127 & * e1u (ji ,jj ) * e2u (ji,jj) * e3u_n(ji,jj,jk) 129 128 zvs = ptrdy(ji,jj,jk) * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) & 130 & * e1v (ji ,jj ) * e2v (ji,jj) * fse3u(ji,jj,jk)129 & * e1v (ji ,jj ) * e2v (ji,jj) * e3u_n(ji,jj,jk) 131 130 umo(ktrd) = umo(ktrd) + zvt 132 131 vmo(ktrd) = vmo(ktrd) + zvs … … 143 142 & * z1_2rau0 * e1u (ji ,jj ) * e2u (ji,jj) 144 143 zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) & 145 & * z1_2rau0 * e1v (ji ,jj ) * e2v (ji,jj) * fse3u(ji,jj,jk)144 & * z1_2rau0 * e1v (ji ,jj ) * e2v (ji,jj) * e3u_n(ji,jj,jk) 146 145 umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 147 146 vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs … … 225 224 DO jj = 1, jpjm1 226 225 DO ji = 1, jpim1 227 zkx(ji,jj,jk) = zcof * e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) )228 zky(ji,jj,jk) = zcof * e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) )226 zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 227 zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 229 228 END DO 230 229 END DO … … 237 236 & + zkx(ji,jj,jk) - zkx(ji-1,jj ,jk ) & 238 237 & + zky(ji,jj,jk) - zky(ji ,jj-1,jk ) ) & 239 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) * tmask(ji,jj,jk) * tmask_i(ji,jj)238 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) * tmask(ji,jj,jk) * tmask_i(ji,jj) 240 239 END DO 241 240 END DO … … 246 245 peke = 0._wp 247 246 DO jk = 1, jpkm1 248 peke = peke + SUM( zkepe(:,:,jk) * fsdept(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) )247 peke = peke + SUM( zkepe(:,:,jk) * gdept_n(:,:,jk) * e1e2t(:,:) * e3t_n(:,:,jk) ) 249 248 END DO 250 249 peke = grav * peke … … 530 529 tvolt = 0._wp 531 530 DO jk = 1, jpkm1 532 tvolt = tvolt + SUM( e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) )531 tvolt = tvolt + SUM( e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) ) 533 532 END DO 534 533 IF( lk_mpp ) CALL mpp_sum( tvolt ) ! sum over the global domain … … 547 546 DO jj = 2, jpjm1 548 547 DO ji = fs_2, fs_jpim1 ! vector opt. 549 tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk)550 tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)548 tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u_n(ji,jj,jk) * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk) 549 tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v_n(ji,jj,jk) * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 551 550 END DO 552 551 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90
r5215 r5845 26 26 27 27 !! * Substitutions 28 # include "domzgr_substitute.h90"29 28 # include "vectopt_loop_substitute.h90" 30 29 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
r5836 r5845 41 41 42 42 !! * Substitutions 43 # include "domzgr_substitute.h90"44 43 # include "vectopt_loop_substitute.h90" 45 44 !!---------------------------------------------------------------------- … … 97 96 nkstp = kt 98 97 DO jk = 1, jpkm1 99 bu (:,:,jk) = e1e2u(:,:) * fse3u_n(:,:,jk)100 bv (:,:,jk) = e1e2v(:,:) * fse3v_n(:,:,jk)101 r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * fse3t_n(:,:,jk) ) * tmask(:,:,jk)98 bu (:,:,jk) = e1e2u(:,:) * e3u_n(:,:,jk) 99 bv (:,:,jk) = e1e2v(:,:) * e3v_n(:,:,jk) 100 r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * e3t_n(:,:,jk) ) * tmask(:,:,jk) 102 101 END DO 103 102 ENDIF … … 172 171 ! ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 173 172 ! ikbv = mbkv(ji,jj) 174 ! z2dx(ji,jj) = un(ji,jj,ikbu) * bfrua(ji,jj) * un(ji,jj,ikbu) / fse3u(ji,jj,ikbu)175 ! z2dy(ji,jj) = un(ji,jj,ikbu) * bfrva(ji,jj) * vn(ji,jj,ikbv) / fse3v(ji,jj,ikbv)173 ! z2dx(ji,jj) = un(ji,jj,ikbu) * bfrua(ji,jj) * un(ji,jj,ikbu) / e3u_n(ji,jj,ikbu) 174 ! z2dy(ji,jj) = un(ji,jj,ikbu) * bfrva(ji,jj) * vn(ji,jj,ikbv) / e3v_n(ji,jj,ikbv) 176 175 ! END DO 177 176 ! END DO … … 227 226 228 227 ! Surface value (also valid in partial step case) 229 zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * wn(:,:,1) * fse3w(:,:,1)228 zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * wn(:,:,1) * e3w_n(:,:,1) 230 229 231 230 ! interior value (2=<jk=<jpkm1) 232 231 DO jk = 2, jpk 233 zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * wn(:,:,jk) * fse3w(:,:,jk)232 zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * wn(:,:,jk) * e3w_n(:,:,jk) 234 233 END DO 235 234 … … 238 237 DO jj = 1, jpj 239 238 DO ji = 1, jpi 240 zcoef = 0.5_wp / fse3t(ji,jj,jk)239 zcoef = 0.5_wp / e3t_n(ji,jj,jk) 241 240 pconv(ji,jj,jk) = zcoef * ( zconv(ji,jj,jk) + zconv(ji,jj,jk+1) ) * tmask(ji,jj,jk) 242 241 END DO … … 271 270 IF( .NOT.lk_vvl ) THEN ! constant volume: bu, bv, 1/bt computed one for all 272 271 DO jk = 1, jpkm1 273 bu (:,:,jk) = e1e2u(:,:) * fse3u_n(:,:,jk)274 bv (:,:,jk) = e1e2v(:,:) * fse3v_n(:,:,jk)275 r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * fse3t_n(:,:,jk) )272 bu (:,:,jk) = e1e2u(:,:) * e3u_n(:,:,jk) 273 bv (:,:,jk) = e1e2v(:,:) * e3v_n(:,:,jk) 274 r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * e3t_n(:,:,jk) ) 276 275 END DO 277 276 ENDIF -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90
r5836 r5845 50 50 INTEGER :: nkstp ! current time step 51 51 52 53 54 52 !!gm to be moved from trdmxl_oce 55 53 ! REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: hml ! ML depth (sum of e3t over nmln-1 levels) [m] … … 73 71 74 72 !! * Substitutions 75 # include "domzgr_substitute.h90"76 73 # include "zdfddm_substitute.h90" 77 74 !!---------------------------------------------------------------------- … … 126 123 DO jj = 1,jpj 127 124 DO ji = 1,jpi 128 IF( jk - kmxln(ji,jj) < 0 ) wkx(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk)125 IF( jk - kmxln(ji,jj) < 0 ) wkx(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 129 126 END DO 130 127 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90
r5836 r5845 37 37 38 38 !! * Substitutions 39 # include "domzgr_substitute.h90"40 39 # include "zdfddm_substitute.h90" 41 40 # include "vectopt_loop_substitute.h90" … … 102 101 & - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem) & 103 102 & + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal) & 104 & ) / fse3t(:,:,1)103 & ) / e3t_n(:,:,1) 105 104 CALL iom_put( "petrd_sad" , z2d ) 106 105 CALL wrk_dealloc( jpi, jpj, z2d ) … … 120 119 ! z2d(:,:) = ( ssha(:,:) - sshb(:,:) ) & 121 120 ! & * ( dPE_dt(:,:,1) * tsn(:,:,1,jp_tem) & 122 ! & + dPE_ds(:,:,1) * tsn(:,:,1,jp_sal) ) / ( fse3t(:,:,1) * pdt )121 ! & + dPE_ds(:,:,1) * tsn(:,:,1,jp_sal) ) / ( e3t_n(:,:,1) * pdt ) 123 122 ! CALL iom_put( "petrd_sad" , z2d ) 124 123 ! CALL wrk_dealloc( jpi, jpj, z2d ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r5836 r5845 43 43 44 44 !! * Substitutions 45 # include "domzgr_substitute.h90"46 45 # include "zdfddm_substitute.h90" 47 46 # include "vectopt_loop_substitute.h90" … … 130 129 zwt(:,:,jpk) = 0._wp ; zws(:,:,jpk) = 0._wp 131 130 DO jk = 2, jpk 132 zwt(:,:,jk) = avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk)133 zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk)131 zwt(:,:,jk) = avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 132 zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 134 133 END DO 135 134 ! 136 135 ztrdt(:,:,jpk) = 0._wp ; ztrds(:,:,jpk) = 0._wp 137 136 DO jk = 1, jpkm1 138 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / fse3t(:,:,jk)139 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / fse3t(:,:,jk)137 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t_n(:,:,jk) 138 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t_n(:,:,jk) 140 139 END DO 141 140 CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt ) … … 207 206 ptrd(ji,jj,jk) = - ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik) & 208 207 & - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk) ) & 209 & / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) * tmask(ji,jj,jk)208 & / ( e1t(ji,jj) * e2t(ji,jj) * e3t_n(ji,jj,jk) ) * tmask(ji,jj,jk) 210 209 END DO 211 210 END DO … … 308 307 IF( .NOT. lk_vvl ) THEN ! cst volume : adv flux through z=0 surface 309 308 CALL wrk_alloc( jpi, jpj, z2dx, z2dy ) 310 z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / fse3t(:,:,1)311 z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / fse3t(:,:,1)309 z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / e3t_n(:,:,1) 310 z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / e3t_n(:,:,1) 312 311 CALL iom_put( "ttrd_sad", z2dx ) 313 312 CALL iom_put( "strd_sad", z2dy ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90
r5836 r5845 57 57 58 58 !! * Substitutions 59 # include "domzgr_substitute.h90"60 59 # include "vectopt_loop_substitute.h90" 61 60 !!---------------------------------------------------------------------- … … 109 108 DO jj = 2, jpjm1 ! wind stress trends 110 109 DO ji = fs_2, fs_jpim1 ! vector opt. 111 ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( fse3u(ji,jj,1) * rau0 )112 ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( fse3v(ji,jj,1) * rau0 )110 ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u_n(ji,jj,1) * rau0 ) 111 ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v_n(ji,jj,1) * rau0 ) 113 112 END DO 114 113 END DO … … 183 182 ikbu = mbkv(ji,jj) 184 183 ikbv = mbkv(ji,jj) 185 zudpvor(ji,jj) = putrdvor(ji,jj) * fse3u(ji,jj,ikbu) * e1u(ji,jj) * umask(ji,jj,ikbu)186 zvdpvor(ji,jj) = pvtrdvor(ji,jj) * fse3v(ji,jj,ikbv) * e2v(ji,jj) * vmask(ji,jj,ikbv)184 zudpvor(ji,jj) = putrdvor(ji,jj) * e3u_n(ji,jj,ikbu) * e1u(ji,jj) * umask(ji,jj,ikbu) 185 zvdpvor(ji,jj) = pvtrdvor(ji,jj) * e3v_n(ji,jj,ikbv) * e2v(ji,jj) * vmask(ji,jj,ikbv) 187 186 END DO 188 187 END DO 189 188 ! 190 189 CASE( jpvor_swf ) ! wind stress 191 zudpvor(:,:) = putrdvor(:,:) * fse3u(:,:,1) * e1u(:,:) * umask(:,:,1)192 zvdpvor(:,:) = pvtrdvor(:,:) * fse3v(:,:,1) * e2v(:,:) * vmask(:,:,1)190 zudpvor(:,:) = putrdvor(:,:) * e3u_n(:,:,1) * e1u(:,:) * umask(:,:,1) 191 zvdpvor(:,:) = pvtrdvor(:,:) * e3v_n(:,:,1) * e2v(:,:) * vmask(:,:,1) 193 192 ! 194 193 END SELECT 195 194 196 195 ! Average except for Beta.V 197 zudpvor(:,:) = zudpvor(:,:) * hur(:,:)198 zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:)196 zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:) 197 zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:) 199 198 200 199 ! Curl … … 270 269 ! putrdvor and pvtrdvor terms 271 270 DO jk = 1,jpk 272 zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * fse3u(:,:,jk) * e1u(:,:) * umask(:,:,jk)273 zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * fse3v(:,:,jk) * e2v(:,:) * vmask(:,:,jk)271 zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * e3u_n(:,:,jk) * e1u(:,:) * umask(:,:,jk) 272 zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * e3v_n(:,:,jk) * e2v(:,:) * vmask(:,:,jk) 274 273 END DO 275 274 … … 286 285 END DO 287 286 ! Average of the Curl and Surface mask 288 vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * hur(:,:) * fmask(:,:,1)287 vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu_n(:,:) * fmask(:,:,1) 289 288 ENDIF 290 289 ! 291 290 ! Average 292 zudpvor(:,:) = zudpvor(:,:) * hur(:,:)293 zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:)291 zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:) 292 zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:) 294 293 ! 295 294 ! Curl … … 351 350 ! Vertically averaged velocity 352 351 DO jk = 1, jpk - 1 353 zun(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * fse3u(:,:,jk)354 zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * fse3v(:,:,jk)352 zun(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * e3u_n(:,:,jk) 353 zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * e3v_n(:,:,jk) 355 354 END DO 356 355 357 zun(:,:) = zun(:,:) * hur(:,:)358 zvn(:,:) = zvn(:,:) * hvr(:,:)356 zun(:,:) = zun(:,:) * r1_hu_n(:,:) 357 zvn(:,:) = zvn(:,:) * r1_hv_n(:,:) 359 358 360 359 ! Curl -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
r5332 r5845 56 56 !! * Substitutions 57 57 # include "vectopt_loop_substitute.h90" 58 # include "domzgr_substitute.h90"59 58 !!---------------------------------------------------------------------- 60 59 !! NEMO/OPA 4.0 , NEMO Consortium (2011) … … 117 116 ikbt = mbkt(ji,jj) 118 117 !! JC: possible WAD implementation should modify line below if layers vanish 119 ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp118 ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 120 119 zbfrt(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp) 121 120 zbfrt(ji,jj) = MIN(zbfrt(ji,jj), rn_bfri2_max) … … 128 127 ikbt = mikt(ji,jj) 129 128 ! JC: possible WAD implementation should modify line below if layers vanish 130 ztmp = (1-tmask(ji,jj,1)) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp129 ztmp = (1-tmask(ji,jj,1)) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 131 130 ztfrt(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp) 132 131 ztfrt(ji,jj) = MIN(ztfrt(ji,jj), rn_tfri2_max) … … 375 374 DO ji = 1, jpi 376 375 ikbt = mbkt(ji,jj) 377 ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp376 ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 378 377 bfrcoef2d(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp) 379 378 bfrcoef2d(ji,jj) = MIN(bfrcoef2d(ji,jj), rn_bfri2_max) … … 384 383 DO ji = 1, jpi 385 384 ikbt = mikt(ji,jj) 386 ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_tfrz0 ))**2._wp385 ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_tfrz0 ))**2._wp 387 386 tfrcoef2d(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp) 388 387 tfrcoef2d(ji,jj) = MIN(tfrcoef2d(ji,jj), rn_tfri2_max) … … 424 423 ikbu = mbku(ji,jj) ! deepest ocean level at u- and v-points 425 424 ikbv = mbkv(ji,jj) 426 zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt427 zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt425 zfru = 0.5 * e3u_n(ji,jj,ikbu) / rdt 426 zfrv = 0.5 * e3v_n(ji,jj,ikbv) / rdt 428 427 IF( ABS( bfrcoef2d(ji,jj) ) > zfru ) THEN 429 428 IF( ln_ctl ) THEN … … 446 445 ikbu = miku(ji,jj) ! 1st wet ocean level at u- and v-points 447 446 ikbv = mikv(ji,jj) 448 zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt449 zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt447 zfru = 0.5 * e3u_n(ji,jj,ikbu) / rdt 448 zfrv = 0.5 * e3v_n(ji,jj,ikbv) / rdt 450 449 IF( ABS( tfrcoef2d(ji,jj) ) > zfru ) THEN 451 450 IF( ln_ctl ) THEN -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
r5836 r5845 44 44 45 45 !! * Substitutions 46 # include "domzgr_substitute.h90"47 46 # include "vectopt_loop_substitute.h90" 48 47 !!---------------------------------------------------------------------- … … 115 114 DO jj = 1, jpj ! R=zrau = (alpha / beta) (dk[t] / dk[s]) 116 115 DO ji = 1, jpi 117 zrw = ( fsdepw(ji,jj,jk ) - fsdept(ji,jj,jk) ) &118 & / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) )116 zrw = ( gdepw_n(ji,jj,jk ) - gdept_n(ji,jj,jk) ) & 117 & / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 119 118 ! 120 119 zaw = ( rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw ) & -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
r5836 r5845 29 29 PUBLIC zdf_evd ! called by step.F90 30 30 31 !! * Substitutions32 # include "domzgr_substitute.h90"33 31 !!---------------------------------------------------------------------- 34 32 !! NEMO/OPA 4.0 , NEMO Consortium (2011) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r5836 r5845 102 102 103 103 !! * Substitutions 104 # include "domzgr_substitute.h90"105 104 # include "vectopt_loop_substitute.h90" 106 105 !!---------------------------------------------------------------------- … … 204 203 avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) ) & 205 204 & * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) ) & 206 & / ( fse3uw_n(ji,jj,jk) & 207 & * fse3uw_b(ji,jj,jk) ) 205 & / ( e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) ) 208 206 avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) ) & 209 207 & * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) ) & 210 & / ( fse3vw_n(ji,jj,jk) & 211 & * fse3vw_b(ji,jj,jk) ) 208 & / ( e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) ) 212 209 eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * SQRT(en(ji,jj,jk)) / mxln(ji,jj,jk) 213 210 END DO … … 226 223 DO jj = 2, jpjm1 227 224 DO ji = fs_2, fs_jpim1 ! vector opt. 228 zup = mxln(ji,jj,jk) * fsdepw(ji,jj,mbkt(ji,jj)+1)229 zdown = vkarmn * fsdepw(ji,jj,jk) * ( -fsdepw(ji,jj,jk) + fsdepw(ji,jj,mbkt(ji,jj)+1) )225 zup = mxln(ji,jj,jk) * gdepw_n(ji,jj,mbkt(ji,jj)+1) 226 zdown = vkarmn * gdepw_n(ji,jj,jk) * ( -gdepw_n(ji,jj,jk) + gdepw_n(ji,jj,mbkt(ji,jj)+1) ) 230 227 zcoef = ( zup / MAX( zdown, rsmall ) ) 231 228 zwall (ji,jj,jk) = ( 1._wp + re2 * zcoef*zcoef ) * tmask(ji,jj,jk) … … 284 281 ! lower diagonal 285 282 z_elem_a(ji,jj,jk) = zcof * ( avm (ji,jj,jk ) + avm (ji,jj,jk-1) ) & 286 & / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk ) )283 & / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk ) ) 287 284 ! 288 285 ! upper diagonal 289 286 z_elem_c(ji,jj,jk) = zcof * ( avm (ji,jj,jk+1) + avm (ji,jj,jk ) ) & 290 & / ( fse3t(ji,jj,jk ) * fse3w(ji,jj,jk) )287 & / ( e3t_n(ji,jj,jk ) * e3w_n(ji,jj,jk) ) 291 288 ! 292 289 ! diagonal … … 320 317 ! 321 318 ! One level below 322 en(:,:,2) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1 * ((zhsro(:,:)+ fsdepw(:,:,2)) &319 en(:,:,2) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1 * ((zhsro(:,:)+gdepw_n(:,:,2)) & 323 320 & / zhsro(:,:) )**(1.5_wp*ra_sf))**(2._wp/3._wp) 324 321 en(:,:,2) = MAX(en(:,:,2), rn_emin ) … … 341 338 z_elem_b(:,:,2) = z_elem_b(:,:,2) + z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b 342 339 z_elem_a(:,:,2) = 0._wp 343 zkar(:,:) = (rl_sf + (vkarmn-rl_sf)*(1.-exp(-rtrans* fsdept(:,:,1)/zhsro(:,:)) ))340 zkar(:,:) = (rl_sf + (vkarmn-rl_sf)*(1.-exp(-rtrans*gdept_n(:,:,1)/zhsro(:,:)) )) 344 341 zflxs(:,:) = rsbc_tke2 * ustars2(:,:)**1.5_wp * zkar(:,:) & 345 & * ((zhsro(:,:)+ fsdept(:,:,1)) / zhsro(:,:) )**(1.5_wp*ra_sf)346 347 en(:,:,2) = en(:,:,2) + zflxs(:,:)/ fse3w(:,:,2)342 & * ((zhsro(:,:)+gdept_n(:,:,1)) / zhsro(:,:) )**(1.5_wp*ra_sf) 343 344 en(:,:,2) = en(:,:,2) + zflxs(:,:)/e3w_n(:,:,2) 348 345 ! 349 346 ! … … 508 505 ! lower diagonal 509 506 z_elem_a(ji,jj,jk) = zcof * ( avm (ji,jj,jk ) + avm (ji,jj,jk-1) ) & 510 & / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk ) )507 & / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk ) ) 511 508 ! upper diagonal 512 509 z_elem_c(ji,jj,jk) = zcof * ( avm (ji,jj,jk+1) + avm (ji,jj,jk ) ) & 513 & / ( fse3t(ji,jj,jk ) * fse3w(ji,jj,jk) )510 & / ( e3t_n(ji,jj,jk ) * e3w_n(ji,jj,jk) ) 514 511 ! diagonal 515 512 z_elem_b(ji,jj,jk) = 1._wp - z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk) & … … 539 536 ! 540 537 ! One level below 541 zkar(:,:) = (rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans* fsdepw(:,:,2)/zhsro(:,:) )))542 zdep(:,:) = (zhsro(:,:) + fsdepw(:,:,2)) * zkar(:,:)538 zkar(:,:) = (rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans*gdepw_n(:,:,2)/zhsro(:,:) ))) 539 zdep(:,:) = (zhsro(:,:) + gdepw_n(:,:,2)) * zkar(:,:) 543 540 psi (:,:,2) = rc0**rpp * en(:,:,2)**rmm * zdep(:,:)**rnn * tmask(:,:,1) 544 541 z_elem_a(:,:,2) = 0._wp … … 561 558 ! 562 559 ! Set psi vertical flux at the surface: 563 zkar(:,:) = rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans* fsdept(:,:,1)/zhsro(:,:) )) ! Lengh scale slope564 zdep(:,:) = ((zhsro(:,:) + fsdept(:,:,1)) / zhsro(:,:))**(rmm*ra_sf)560 zkar(:,:) = rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans*gdept_n(:,:,1)/zhsro(:,:) )) ! Lengh scale slope 561 zdep(:,:) = ((zhsro(:,:) + gdept_n(:,:,1)) / zhsro(:,:))**(rmm*ra_sf) 565 562 zflxs(:,:) = (rnn + rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:))*(1._wp + rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp) 566 563 zdep(:,:) = rsbc_psi1 * (zwall_psi(:,:,1)*avm(:,:,1)+zwall_psi(:,:,2)*avm(:,:,2)) * & 567 & ustars2(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + fsdept(:,:,1))**(rnn-1.)564 & ustars2(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept_n(:,:,1))**(rnn-1.) 568 565 zflxs(:,:) = zdep(:,:) * zflxs(:,:) 569 psi(:,:,2) = psi(:,:,2) + zflxs(:,:) / fse3w(:,:,2)566 psi(:,:,2) = psi(:,:,2) + zflxs(:,:) / e3w_n(:,:,2) 570 567 571 568 ! … … 593 590 ! 594 591 ! Just above last level, Dirichlet condition again (GOTM like) 595 zdep(ji,jj) = vkarmn * ( rn_bfrz0 + fse3t(ji,jj,ibotm1) )592 zdep(ji,jj) = vkarmn * ( rn_bfrz0 + e3t_n(ji,jj,ibotm1) ) 596 593 psi (ji,jj,ibotm1) = rc0**rpp * en(ji,jj,ibot )**rmm * zdep(ji,jj)**rnn 597 594 z_elem_a(ji,jj,ibotm1) = 0._wp … … 621 618 ! 622 619 ! Set psi vertical flux at the bottom: 623 zdep(ji,jj) = rn_bfrz0 + 0.5_wp* fse3t(ji,jj,ibotm1)620 zdep(ji,jj) = rn_bfrz0 + 0.5_wp*e3t_n(ji,jj,ibotm1) 624 621 zflxb = rsbc_psi2 * ( avm(ji,jj,ibot) + avm(ji,jj,ibotm1) ) & 625 622 & * (0.5_wp*(en(ji,jj,ibot)+en(ji,jj,ibotm1)))**rmm * zdep(ji,jj)**(rnn-1._wp) 626 psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / fse3w(ji,jj,ibotm1)623 psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / e3w_n(ji,jj,ibotm1) 627 624 END DO 628 625 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
r4990 r5845 36 36 REAL(wp) :: avt_c = 5.e-4_wp ! Kz criterion for the turbocline depth 37 37 38 !! * Substitutions39 # include "domzgr_substitute.h90"40 38 !!---------------------------------------------------------------------- 41 39 !! NEMO/OPA 4.0 , NEMO Consortium (2011) … … 105 103 DO ji = 1, jpi 106 104 ikt = mbkt(ji,jj) 107 hmlp(ji,jj) = hmlp(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * fse3w(ji,jj,jk)105 hmlp(ji,jj) = hmlp(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w_n(ji,jj,jk) 108 106 IF( hmlp(ji,jj) < zN2_c ) nmln(ji,jj) = MIN( jk , ikt ) + 1 ! Mixed layer level 109 107 END DO … … 127 125 iikn = nmln(ji,jj) 128 126 imkt = mikt(ji,jj) 129 hmld (ji,jj) = ( fsdepw(ji,jj,iiki ) - fsdepw(ji,jj,imkt ) ) * ssmask(ji,jj) ! Turbocline depth130 hmlp (ji,jj) = ( fsdepw(ji,jj,iikn ) - fsdepw(ji,jj,MAX( imkt,nla10 ) ) ) * ssmask(ji,jj) ! Mixed layer depth131 hmlpt(ji,jj) = ( fsdept(ji,jj,iikn-1) - fsdepw(ji,jj,imkt ) ) * ssmask(ji,jj) ! depth of the last T-point inside the mixed layer127 hmld (ji,jj) = ( gdepw_n(ji,jj,iiki ) - gdepw_n(ji,jj,imkt ) ) * ssmask(ji,jj) ! Turbocline depth 128 hmlp (ji,jj) = ( gdepw_n(ji,jj,iikn ) - gdepw_n(ji,jj,MAX( imkt,nla10 ) ) ) * ssmask(ji,jj) ! Mixed layer depth 129 hmlpt(ji,jj) = ( gdept_n(ji,jj,iikn-1) - gdepw_n(ji,jj,imkt ) ) * ssmask(ji,jj) ! depth of the last T-point inside the mixed layer 132 130 END DO 133 131 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
r5836 r5845 55 55 56 56 !! * Substitutions 57 # include " domzgr_substitute.h90"57 # include "vectopt_loop_substitute.h90" 58 58 !!---------------------------------------------------------------------- 59 59 !! NEMO/OPA 4.0 , NEMO Consortium (2011) … … 133 133 ! ----------------- 134 134 DO jj = 2, jpjm1 135 DO ji = 2,jpim1136 zcoef = 0.5 / fse3w(ji,jj,jk)135 DO ji = fs_2, fs_jpim1 136 zcoef = 0.5 / e3w_n(ji,jj,jk) 137 137 ! ! shear of horizontal velocity 138 138 zdku = zcoef * ( ub(ji-1,jj,jk-1) + ub(ji,jj,jk-1) & … … 151 151 z05alp = 0.5_wp * rn_alp 152 152 DO jj = 1, jpjm1 ! Eddy viscosity coefficients (avm) 153 DO ji = 1, jpim1153 DO ji = 1, fs_jpim1 154 154 avmu(ji,jj,jk) = umask(ji,jj,jk) * rn_avmri / ( 1. + z05alp*( zwx(ji+1,jj)+zwx(ji,jj) ) )**nn_ric 155 155 avmv(ji,jj,jk) = vmask(ji,jj,jk) * rn_avmri / ( 1. + z05alp*( zwx(ji,jj+1)+zwx(ji,jj) ) )**nn_ric … … 157 157 END DO 158 158 DO jj = 2, jpjm1 ! Eddy diffusivity coefficients (avt) 159 DO ji = 2,jpim1159 DO ji = fs_2, fs_jpim1 160 160 avt(ji,jj,jk) = tmric(ji,jj,jk) / ( 1._wp + rn_alp * zwx(ji,jj) ) & 161 161 & * ( avmu(ji,jj,jk) + avmu(ji-1,jj,jk) & … … 176 176 ! ------------------------------------------------------- 177 177 zflageos = ( 0.5 + SIGN( 0.5, nn_eos - 1. ) ) * rau0 178 DO jj = 1, jpj179 DO ji = 1, jpi178 DO jj = 2, jpjm1 179 DO ji = fs_2, fs_jpim1 180 180 zrhos = rhop(ji,jj,1) + zflageos * ( 1. - tmask(ji,jj,1) ) 181 181 zustar = SQRT( taum(ji,jj) / ( zrhos + rsmall ) ) … … 189 189 ! are always equal to the namelist values rn_wtmix/rn_wvmix 190 190 ! ------------------------------------------------------- 191 DO jj = 1, jpj192 DO ji = 1, jpi191 DO jj = 2, jpjm1 192 DO ji = fs_2, fs_jpim1 193 193 avmv(ji,jj,1) = MAX( avmv(ji,jj,1), rn_wvmix ) 194 194 avmu(ji,jj,1) = MAX( avmu(ji,jj,1), rn_wvmix ) … … 200 200 ! ------------------------------------------------------- 201 201 DO jk = 2, jpkm1 202 DO jj = 1, jpj203 DO ji = 1, jpi202 DO jj = 2, jpjm1 203 DO ji = fs_2, fs_jpim1 204 204 IF( fsdept(ji,jj,jk) < ekm_dep(ji,jj) ) THEN 205 205 avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk), rn_wvmix ) … … 212 212 213 213 DO jk = 1, jpkm1 214 DO jj = 1, jpj215 DO ji = 1, jpi214 DO jj = 2, jpjm1 215 DO ji = fs_2, fs_jpim1 216 216 avmv(ji,jj,jk) = avmv(ji,jj,jk) * vmask(ji,jj,jk) 217 217 avmu(ji,jj,jk) = avmu(ji,jj,jk) * umask(ji,jj,jk) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r5836 r5845 99 99 100 100 !! * Substitutions 101 # include "domzgr_substitute.h90"102 101 # include "vectopt_loop_substitute.h90" 103 102 !!---------------------------------------------------------------------- … … 294 293 ! 295 294 ! !* total energy produce by LC : cumulative sum over jk 296 zpelc(:,:,1) = MAX( rn2b(:,:,1), 0._wp ) * fsdepw(:,:,1) * fse3w(:,:,1)295 zpelc(:,:,1) = MAX( rn2b(:,:,1), 0._wp ) * gdepw_n(:,:,1) * e3w_n(:,:,1) 297 296 DO jk = 2, jpk 298 zpelc(:,:,jk) = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * fsdepw(:,:,jk) * fse3w(:,:,jk)297 zpelc(:,:,jk) = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * gdepw_n(:,:,jk) * e3w_n(:,:,jk) 299 298 END DO 300 299 ! !* finite Langmuir Circulation depth … … 312 311 DO jj = 1, jpj 313 312 DO ji = 1, jpi 314 zhlc(ji,jj) = fsdepw(ji,jj,imlc(ji,jj))313 zhlc(ji,jj) = gdepw_n(ji,jj,imlc(ji,jj)) 315 314 END DO 316 315 END DO … … 321 320 zus = zcof * SQRT( taum(ji,jj) ) ! Stokes drift 322 321 ! ! vertical velocity due to LC 323 zind = 0.5 - SIGN( 0.5, fsdepw(ji,jj,jk) - zhlc(ji,jj) )324 zwlc = zind * rn_lc * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) )322 zind = 0.5 - SIGN( 0.5, gdepw_n(ji,jj,jk) - zhlc(ji,jj) ) 323 zwlc = zind * rn_lc * zus * SIN( rpi * gdepw_n(ji,jj,jk) / zhlc(ji,jj) ) 325 324 ! ! TKE Langmuir circulation source term 326 325 en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) … … 344 343 & * ( un(ji,jj,jk-1) - un(ji ,jj,jk) ) & 345 344 & * ( ub(ji,jj,jk-1) - ub(ji ,jj,jk) ) * wumask(ji,jj,jk) & 346 & / ( fse3uw_n(ji,jj,jk) * fse3uw_b(ji,jj,jk) )345 & / ( e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) ) 347 346 z3dv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk ) + avm(ji,jj+1,jk) ) & 348 347 & * ( vn(ji,jj,jk-1) - vn(ji,jj ,jk) ) & 349 348 & * ( vb(ji,jj,jk-1) - vb(ji,jj ,jk) ) * wvmask(ji,jj,jk) & 350 & / ( fse3vw_n(ji,jj,jk) * fse3vw_b(ji,jj,jk) )349 & / ( e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) ) 351 350 END DO 352 351 END DO … … 377 376 zcof = zfact1 * tmask(ji,jj,jk) 378 377 zzd_up = zcof * ( avm (ji,jj,jk+1) + avm (ji,jj,jk ) ) & ! upper diagonal 379 & / ( fse3t(ji,jj,jk ) * fse3w(ji,jj,jk ) )378 & / ( e3t_n(ji,jj,jk ) * e3w_n(ji,jj,jk ) ) 380 379 zzd_lw = zcof * ( avm (ji,jj,jk ) + avm (ji,jj,jk-1) ) & ! lower diagonal 381 & / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk ) )380 & / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk ) ) 382 381 ! ! shear prod. at w-point weightened by mask 383 382 zesh2 = ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) ) & … … 438 437 ! ! TKE due to surface and internal wave breaking 439 438 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 439 !!gm BUG : in the exp remove the depth of ssh !!! 440 441 440 442 IF( nn_etau == 1 ) THEN !* penetration below the mixed layer (rn_efr fraction) 441 443 DO jk = 2, jpkm1 442 444 DO jj = 2, jpjm1 443 445 DO ji = fs_2, fs_jpim1 ! vector opt. 444 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( - fsdepw(ji,jj,jk) / htau(ji,jj) ) &446 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw_n(ji,jj,jk) / htau(ji,jj) ) & 445 447 & * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 446 448 END DO … … 451 453 DO ji = fs_2, fs_jpim1 ! vector opt. 452 454 jk = nmln(ji,jj) 453 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( - fsdepw(ji,jj,jk) / htau(ji,jj) ) &455 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw_n(ji,jj,jk) / htau(ji,jj) ) & 454 456 & * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 455 457 END DO … … 464 466 zdif = taum(ji,jj) - ztau ! mean of modulus - modulus of the mean 465 467 zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add ) ! apply some modifications... 466 en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( - fsdepw(ji,jj,jk) / htau(ji,jj) ) &468 en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -gdepw_n(ji,jj,jk) / htau(ji,jj) ) & 467 469 & * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 468 470 END DO … … 570 572 DO jj = 2, jpjm1 571 573 DO ji = fs_2, fs_jpim1 ! vector opt. 572 zemxl = MIN( fsdepw(ji,jj,jk) - fsdepw(ji,jj,mikt(ji,jj)), zmxlm(ji,jj,jk), &573 & fsdepw(ji,jj,mbkt(ji,jj)+1) - fsdepw(ji,jj,jk) )574 zemxl = MIN( gdepw_n(ji,jj,jk) - gdepw_n(ji,jj,mikt(ji,jj)), zmxlm(ji,jj,jk), & 575 & gdepw_n(ji,jj,mbkt(ji,jj)+1) - gdepw_n(ji,jj,jk) ) 574 576 ! wmask prevent zmxlm = 0 if jk = mikt(ji,jj) 575 zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk), fse3w(ji,jj,jk)) * (1 - wmask(ji,jj,jk))576 zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk), fse3w(ji,jj,jk)) * (1 - wmask(ji,jj,jk))577 zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),e3w_n(ji,jj,jk)) * (1 - wmask(ji,jj,jk)) 578 zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),e3w_n(ji,jj,jk)) * (1 - wmask(ji,jj,jk)) 577 579 END DO 578 580 END DO … … 583 585 DO jj = 2, jpjm1 584 586 DO ji = fs_2, fs_jpim1 ! vector opt. 585 zemxl = MIN( fse3w(ji,jj,jk), zmxlm(ji,jj,jk) )587 zemxl = MIN( e3w_n(ji,jj,jk), zmxlm(ji,jj,jk) ) 586 588 zmxlm(ji,jj,jk) = zemxl 587 589 zmxld(ji,jj,jk) = zemxl … … 594 596 DO jj = 2, jpjm1 595 597 DO ji = fs_2, fs_jpim1 ! vector opt. 596 zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )598 zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + e3t_n(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 597 599 END DO 598 600 END DO … … 601 603 DO jj = 2, jpjm1 602 604 DO ji = fs_2, fs_jpim1 ! vector opt. 603 zemxl = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )605 zemxl = MIN( zmxlm(ji,jj,jk+1) + e3t_n(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 604 606 zmxlm(ji,jj,jk) = zemxl 605 607 zmxld(ji,jj,jk) = zemxl … … 612 614 DO jj = 2, jpjm1 613 615 DO ji = fs_2, fs_jpim1 ! vector opt. 614 zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )616 zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + e3t_n(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 615 617 END DO 616 618 END DO … … 619 621 DO jj = 2, jpjm1 620 622 DO ji = fs_2, fs_jpim1 ! vector opt. 621 zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )623 zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + e3t_n(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 622 624 END DO 623 625 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
r5836 r5845 51 51 52 52 !! * Substitutions 53 # include "domzgr_substitute.h90"54 53 # include "vectopt_loop_substitute.h90" 55 54 !!---------------------------------------------------------------------- … … 126 125 zkz(:,:) = 0.e0 !* Associated potential energy consummed over the whole water column 127 126 DO jk = 2, jpkm1 128 zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk)127 zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 129 128 END DO 130 129 … … 144 143 DO jj= 1, jpj 145 144 DO ji= 1, jpi 146 ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj) &145 ztpc = ztpc + e3w_n(ji,jj,jk) * e1e2t(ji,jj) & 147 146 & * MAX( 0.e0, rn2(ji,jj,jk) ) * zav_tide(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 148 147 END DO … … 238 237 zsum2(:,:) = 0.e0 239 238 DO jk= 2, jpk 240 zsum1(:,:) = zsum1(:,:) + zempba_3d_1(:,:,jk) * fse3w(:,:,jk) * wmask(:,:,jk)241 zsum2(:,:) = zsum2(:,:) + zempba_3d_2(:,:,jk) * fse3w(:,:,jk) * wmask(:,:,jk)239 zsum1(:,:) = zsum1(:,:) + zempba_3d_1(:,:,jk) * e3w_n(:,:,jk) * wmask(:,:,jk) 240 zsum2(:,:) = zsum2(:,:) + zempba_3d_2(:,:,jk) * e3w_n(:,:,jk) * wmask(:,:,jk) 242 241 END DO 243 242 DO jj = 1, jpj … … 256 255 ! 257 256 zempba_3d(ji,jj,jk) = ztpc 258 zsum (ji,jj) = zsum(ji,jj) + ztpc * fse3w(ji,jj,jk)257 zsum (ji,jj) = zsum(ji,jj) + ztpc * e3w_n(ji,jj,jk) 259 258 END DO 260 259 END DO … … 275 274 zkz(:,:) = 0.e0 ! Associated potential energy consummed over the whole water column 276 275 DO jk = 2, jpkm1 277 zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * wmask(:,:,jk)276 zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * wmask(:,:,jk) 278 277 END DO 279 278 … … 293 292 DO jj= 1, jpj 294 293 DO ji= 1, jpi 295 ztpc = ztpc + e1e2t(ji,jj) * fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) ) &294 ztpc = ztpc + e1e2t(ji,jj) * e3w_n(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) ) & 296 295 & * zavt_itf(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 297 296 END DO … … 447 446 DO jj = 1, jpj 448 447 DO ji = 1, jpi 449 ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)448 ztpc = ztpc + e3w_n(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 450 449 END DO 451 450 END DO … … 461 460 zkz(:,:) = 0._wp 462 461 DO jk = 2, jpkm1 463 zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX(0.e0, rn2(:,:,jk)) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk)462 zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX(0.e0, rn2(:,:,jk)) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 464 463 END DO 465 464 ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz … … 489 488 DO jj = 1, jpj 490 489 DO ji = 1, jpi 491 ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)490 ztpc = ztpc + e3w_n(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 492 491 END DO 493 492 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/step.F90
r5836 r5845 41 41 PUBLIC stp ! called by nemogcm.F90 42 42 43 !! * Substitutions44 # include "domzgr_substitute.h90"45 !!gm # include "zdfddm_substitute.h90"46 43 !!---------------------------------------------------------------------- 47 44 !! NEMO/OPA 3.7 , NEMO Consortium (2015) … … 192 189 IF(ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations 193 190 !!gm 194 CALL eos ( tsn, rhd, rhop, fsdept_n(:,:,:) )! now in situ density for hpg computation191 CALL eos ( tsn, rhd, rhop, gdept_n(:,:,:) ) ! now in situ density for hpg computation 195 192 196 193 IF( ln_zps .AND. .NOT. ln_isfcav) & ! Partial steps: bottom before horizontal gradient … … 275 272 IF( ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations 276 273 !!gm 277 CALL eos ( tsa, rhd, rhop, fsdept_n(:,:,:) )! Time-filtered in situ density for hpg computation274 CALL eos ( tsa, rhd, rhop, gdept_n(:,:,:) ) ! Time-filtered in situ density for hpg computation 278 275 IF( ln_zps .AND. .NOT. ln_isfcav) & 279 & CALL zps_hde ( kstp, jpts, tsa, gtsu, gtsv, & 276 & CALL zps_hde ( kstp, jpts, tsa, gtsu, gtsv, & ! Partial steps: before horizontal gradient 280 277 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 281 278 IF( ln_zps .AND. ln_isfcav) & … … 288 285 IF( ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations 289 286 !!gm 290 CALL eos ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation287 CALL eos ( tsn, rhd, rhop, gdept_n(:,:,:) ) ! now in situ density for hpg computation 291 288 IF( ln_zps .AND. .NOT. ln_isfcav) & 292 289 & CALL zps_hde ( kstp, jpts, tsn, gtsu, gtsv, & ! Partial steps: bottom before horizontal gradient -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90
r5385 r5845 65 65 #endif 66 66 67 !! * Substitutions68 # include "domzgr_substitute.h90"69 67 !!---------------------------------------------------------------------- 70 68 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 104 102 !!---------------------------------------------------------------------- 105 103 REAL(wp), DIMENSION(3,61), INTENT(out) :: prgb ! tabulated attenuation coefficient 106 ! !104 ! 107 105 INTEGER :: jc ! dummy loop indice 108 106 INTEGER :: irgb ! temporary integer … … 188 186 zchl = zrgb(1,jc) 189 187 irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 ) 190 IF(lwp ) WRITE(numout,*) ' jc =', jc, ' Chl = ', zchl, ' irgb = ', irgb188 IF(lwp .AND. nn_print >= 1 ) WRITE(numout,*) ' jc =', jc, ' Chl = ', zchl, ' irgb = ', irgb 191 189 IF( irgb /= jc ) THEN 192 190 IF(lwp) WRITE(numout,*) ' jc =', jc, ' Chl = ', zchl, ' Chl class = ', irgb … … 210 208 !!---------------------------------------------------------------------- 211 209 REAL(wp), DIMENSION(3,61), INTENT(out) :: prgb ! tabulated attenuation coefficient 212 ! !210 ! 213 211 INTEGER :: jc, jb ! dummy loop indice 214 212 INTEGER :: irgb ! temporary integer … … 262 260 REAL(wp), INTENT(in) :: prldex ! longest depth of extinction 263 261 REAL(wp), INTENT(in) :: pqsr_frc ! frac. solar radiation which penetrates 264 ! !262 ! 265 263 INTEGER :: jk, pjl ! levels 266 264 REAL(wp) :: zhext ! deepest level till which light penetrates … … 276 274 DO jk = jpkm1, 1, -1 277 275 IF(SUM(tmask(:,:,jk)) > 0 ) THEN 278 zem = MAXVAL( fsdepw(:,:,jk+1) * tmask(:,:,jk) )276 zem = MAXVAL( gdepw_0(:,:,jk+1) * tmask(:,:,jk) ) 279 277 IF( zem >= zhext ) pjl = jk ! last T-level reached by Qsr 280 278 ELSE -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/SAS_SRC/diawri.F90
r5836 r5845 62 62 63 63 !! * Substitutions 64 # include "zdfddm_substitute.h90"65 # include "domzgr_substitute.h90"66 64 # include "vectopt_loop_substitute.h90" 67 65 !!---------------------------------------------------------------------- … … 107 105 !! ** Method : use iom_put 108 106 !!---------------------------------------------------------------------- 109 !!110 107 INTEGER, INTENT( in ) :: kt ! ocean time-step index 111 108 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/SAS_SRC/step.F90
r5510 r5845 16 16 USE oce ! ocean dynamics and tracers variables 17 17 USE dom_oce ! ocean space and time domain variables 18 USE in_out_manager ! I/O manager19 18 USE sbc_oce 20 19 USE sbccpl 20 USE daymod ! calendar (day routine) 21 USE sbcmod ! surface boundary condition (sbc routine) 22 USE sbcrnf ! surface boundary condition: runoff variables 23 USE eosbn2 ! equation of state (eos_bn2 routine) 24 USE diawri ! Standard run outputs (dia_wri routine) 25 USE bdy_par ! clem: mandatory for LIM3 26 #if defined key_bdy 27 USE bdydta ! clem: mandatory for LIM3 28 #endif 29 USE stpctl ! time stepping control (stp_ctl routine) 30 USE prtctl ! Print control (prt_ctl routine) 31 ! 32 USE in_out_manager ! I/O manager 33 USE timing ! Timing 21 34 USE iom ! 22 35 USE lbclnk … … 25 38 #endif 26 39 27 USE daymod ! calendar (day routine)28 29 USE sbcmod ! surface boundary condition (sbc routine)30 USE sbcrnf ! surface boundary condition: runoff variables31 32 USE eosbn2 ! equation of state (eos_bn2 routine)33 34 USE diawri ! Standard run outputs (dia_wri routine)35 USE stpctl ! time stepping control (stp_ctl routine)36 USE prtctl ! Print control (prt_ctl routine)37 38 USE timing ! Timing39 40 USE bdy_par ! clem: mandatory for LIM341 #if defined key_bdy42 USE bdydta ! clem: mandatory for LIM343 #endif44 45 40 IMPLICIT NONE 46 41 PRIVATE 47 42 48 PUBLIC stp ! called by opa.F9043 PUBLIC stp ! called by nemogcm.F90 49 44 50 !! * Substitutions51 # include "domzgr_substitute.h90"52 # include "zdfddm_substitute.h90"53 45 !!---------------------------------------------------------------------- 54 46 !! NEMO/OPA 3.3 , NEMO Consortium (2010) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
r5836 r5845 49 49 REAL(wp) :: xconv3 = 1.e+3_wp ! conversion from mol/l/atm to mol/m3/atm 50 50 51 !! * Substitutions52 # include "domzgr_substitute.h90"53 51 !!---------------------------------------------------------------------- 54 52 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 257 255 & * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) / 2. 258 256 ! Add the surface flux to the trend 259 tra(ji,jj,1,jpc14) = tra(ji,jj,1,jpc14) + qtr_c14(ji,jj) / fse3t(ji,jj,1)257 tra(ji,jj,1,jpc14) = tra(ji,jj,1,jpc14) + qtr_c14(ji,jj) / e3t_n(ji,jj,1) 260 258 261 259 ! cumulation of surface flux at each time step -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r5836 r5845 50 50 REAL(wp) :: xconv4 = 1.0e-12 ! conversion from mol/m3/atm to mol/m3/pptv 51 51 52 !! * Substitutions53 # include "domzgr_substitute.h90"54 52 !!---------------------------------------------------------------------- 55 53 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 167 165 & * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 168 166 ! Add the surface flux to the trend 169 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / fse3t(ji,jj,1)167 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / e3t_n(ji,jj,1) 170 168 171 169 ! cumulation of surface flux at each time step -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
r5836 r5845 60 60 61 61 !! * Substitutions 62 # include "domzgr_substitute.h90"63 62 # include "vectopt_loop_substitute.h90" 64 63 !!---------------------------------------------------------------------- … … 67 66 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 68 67 !!---------------------------------------------------------------------- 69 70 68 CONTAINS 71 69 … … 187 185 ! closure : flux grazing is redistributed below level jpkbio 188 186 zzoobod = tmminz * zzoo * zzoo 189 xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * fse3t(ji,jj,jk)187 xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * e3t_n(ji,jj,jk) 190 188 zboddet = fdbod * zzoobod 191 189 … … 242 240 IF( ln_diatrc .OR. lk_iomput ) THEN 243 241 ! convert fluxes in per day 244 ze3t = fse3t(ji,jj,jk) * 86400.242 ze3t = e3t_n(ji,jj,jk) * 86400. 245 243 zw2d(ji,jj,1) = zw2d(ji,jj,1) + zno3phy * ze3t 246 244 zw2d(ji,jj,2) = zw2d(ji,jj,2) + znh4phy * ze3t … … 363 361 IF( ln_diatrc .OR. lk_iomput ) THEN 364 362 ! convert fluxes in per day 365 ze3t = fse3t(ji,jj,jk) * 86400.363 ze3t = e3t_n(ji,jj,jk) * 86400. 366 364 zw2d(ji,jj,1) = zw2d(ji,jj,1) + zno3phy * ze3t 367 365 zw2d(ji,jj,2) = zw2d(ji,jj,2) + znh4phy * ze3t -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90
r5836 r5845 42 42 43 43 !! * Substitutions 44 # include "domzgr_substitute.h90"45 44 # include "vectopt_loop_substitute.h90" 46 45 !!---------------------------------------------------------------------- … … 95 94 DO jj = 2, jpjm1 96 95 DO ji = fs_2, fs_jpim1 97 ze3t = 1. / fse3t(ji,jj,jk)96 ze3t = 1. / e3t_n(ji,jj,jk) 98 97 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj) 99 98 END DO … … 110 109 DO ji = fs_2, fs_jpim1 111 110 ikt = mbkt(ji,jj) 112 tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikt)111 tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) + sedlam * sedpocn(ji,jj) / e3t_n(ji,jj,ikt) 113 112 ! Deposition of organic matter in the sediment 114 113 zwork = vsed * trn(ji,jj,ikt,jpdet) … … 121 120 DO jj = 2, jpjm1 122 121 DO ji = fs_2, fs_jpim1 123 tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / fse3t(ji,jj,1)122 tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / e3t_n(ji,jj,1) 124 123 END DO 125 124 END DO … … 212 211 DO jj = 1, jpj 213 212 DO ji = 1, jpi 214 zfluo = ( fsdepw(ji,jj,jk ) / fsdepw(ji,jj,jpkb) )**xhr215 zfluu = ( fsdepw(ji,jj,jk+1) / fsdepw(ji,jj,jpkb) )**xhr213 zfluo = ( gdepw_n(ji,jj,jk ) / gdepw_n(ji,jj,jpkb) )**xhr 214 zfluu = ( gdepw_n(ji,jj,jk+1) / gdepw_n(ji,jj,jpkb) )**xhr 216 215 IF( zfluo.GT.1. ) zfluo = 1._wp 217 216 zdm0(ji,jj,jk) = zfluo - zfluu -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90
r5836 r5845 40 40 REAL(wp), PUBLIC :: reddom ! redfield ratio (C:N) for DOM 41 41 42 !! * Substitutions43 # include "domzgr_substitute.h90"44 42 !!---------------------------------------------------------------------- 45 43 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 47 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 48 46 !!---------------------------------------------------------------------- 49 50 47 CONTAINS 51 48 … … 105 102 zkr = xkr0 + xkrp * EXP( xlr * zpig ) 106 103 zkg = xkg0 + xkgp * EXP( xlg * zpig ) 107 zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * fse3t(ji,jj,jk-1) )108 zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * fse3t(ji,jj,jk-1) )104 zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t_n(ji,jj,jk-1) ) 105 zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t_n(ji,jj,jk-1) ) 109 106 END DO 110 107 END DO … … 116 113 zkr = xkr0 + xkrp * EXP( xlr * zpig ) 117 114 zkg = xkg0 + xkgp * EXP( xlg * zpig ) 118 zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) )119 zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkg * fse3t(ji,jj,jk) ) )115 zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkr * e3t_n(ji,jj,jk) ) ) 116 zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkg * e3t_n(ji,jj,jk) ) ) 120 117 etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 121 118 END DO … … 138 135 DO jj = 1, jpj 139 136 DO ji = 1, jpi 140 heup(ji,jj) = fsdepw(ji,jj,neln(ji,jj))137 heup(ji,jj) = gdepw_n(ji,jj,neln(ji,jj)) 141 138 END DO 142 139 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90
r5836 r5845 34 34 REAL(wp), PUBLIC :: xhr ! coeff for martin''s remineralisation profile 35 35 36 !! * Substitutions37 # include "domzgr_substitute.h90"38 36 !!---------------------------------------------------------------------- 39 37 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 102 100 DO jj = 1, jpj 103 101 DO ji = 1, jpi 104 ztra(ji,jj,jk) = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk)102 ztra(ji,jj,jk) = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 105 103 tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra(ji,jj,jk) 106 104 END DO … … 111 109 IF( iom_use( "TDETSED" ) ) THEN 112 110 CALL wrk_alloc( jpi, jpj, zw2d ) 113 zw2d(:,:) = ztra(:,:,1) * fse3t(:,:,1) * 86400.111 zw2d(:,:) = ztra(:,:,1) * e3t_n(:,:,1) * 86400. 114 112 DO jk = 2, jpkm1 115 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * fse3t(:,:,jk) * 86400.113 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400. 116 114 END DO 117 115 CALL iom_put( "TDETSED", zw2d ) … … 121 119 IF( ln_diatrc ) THEN 122 120 CALL wrk_alloc( jpi, jpj, zw2d ) 123 zw2d(:,:) = ztra(:,:,1) * fse3t(:,:,1) * 86400.121 zw2d(:,:) = ztra(:,:,1) * e3t_n(:,:,1) * 86400. 124 122 DO jk = 2, jpkm1 125 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * fse3t(:,:,jk) * 86400.123 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400. 126 124 END DO 127 125 trc2d(:,:,jp_pcs0_2d + 7) = zw2d(:,:) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
r5836 r5845 34 34 PUBLIC p4z_bio 35 35 36 !! * Substitutions37 # include "domzgr_substitute.h90"38 36 !!---------------------------------------------------------------------- 39 37 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 70 68 DO jj = 1, jpj 71 69 DO ji = 1, jpi 72 IF( fsdepw(ji,jj,jk+1) > hmld(ji,jj) ) xdiss(ji,jj,jk) = 0.01 70 !!gm : use nmln and test on jk ... less memory acces 71 IF( gdepw_n(ji,jj,jk+1) > hmld(ji,jj) ) xdiss(ji,jj,jk) = 0.01 73 72 END DO 74 73 END DO 75 74 END DO 76 75 77 78 76 CALL p4z_opt ( kt, knt ) ! Optic: PAR in the water column 79 77 CALL p4z_sink ( kt, knt ) ! vertical flux of particulate organic matter -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
r5836 r5845 164 164 REAL(wp) :: devk55 = 0.3692E-3 165 165 166 !! * Substitutions167 # include "domzgr_substitute.h90"168 166 !!---------------------------------------------------------------------- 169 167 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 244 242 245 243 246 247 244 ! CHEMICAL CONSTANTS - DEEP OCEAN 248 245 ! ------------------------------- … … 252 249 253 250 ! SET PRESSION 254 zpres = 1.025e-1 * fsdept(ji,jj,jk)251 zpres = 1.025e-1 * gdept_n(ji,jj,jk) 255 252 256 253 ! SET ABSOLUTE TEMPERATURE -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
r5836 r5845 30 30 PUBLIC p4z_fechem_init ! called in trcsms_pisces.F90 31 31 32 !! * Shared module variables33 LOGICAL :: ln_fechem !: boolean for complex iron chemistryfollowing Tagliabue and voelker34 LOGICAL :: ln_ligvar !: boolean for variable ligand concentration following Tagliabue and voelker35 REAL(wp), PUBLIC :: xlam1 !: scavenging rate of Iron36 REAL(wp), PUBLIC :: xlamdust !: scavenging rate of Iron by dust37 REAL(wp), PUBLIC :: ligand !: ligand concentration in the ocean 38 32 LOGICAL :: ln_fechem !: boolean for complex iron chemistry following Tagliabue and voelker 33 LOGICAL :: ln_ligvar !: boolean for variable ligand concentration following Tagliabue and voelker 34 REAL(wp), PUBLIC :: xlam1 !: scavenging rate of Iron 35 REAL(wp), PUBLIC :: xlamdust !: scavenging rate of Iron by dust 36 REAL(wp), PUBLIC :: ligand !: ligand concentration in the ocean 37 38 !!gm Not DOCTOR norm !!! 39 39 REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con, kth 40 40 41 !! * Substitutions42 # include "domzgr_substitute.h90"43 41 !!---------------------------------------------------------------------- 44 42 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 61 59 !! and one particulate form (ln_fechem) 62 60 !!--------------------------------------------------------------------- 63 ! 64 INTEGER, INTENT(in) :: kt, knt ! ocean time step 61 INTEGER, INTENT(in) :: kt, knt ! ocean time step 65 62 ! 66 63 INTEGER :: ji, jj, jk, jic 64 CHARACTER (len=25) :: charout 67 65 REAL(wp) :: zdep, zlam1a, zlam1b, zlamfac 68 66 REAL(wp) :: zkeq, zfeequi, zfesatur, zfecoll … … 79 77 REAL(wp) :: ztfe, zoxy 80 78 REAL(wp) :: zstep 81 CHARACTER (len=25) :: charout82 79 !!--------------------------------------------------------------------- 83 80 ! 84 81 IF( nn_timing == 1 ) CALL timing_start('p4z_fechem') 85 82 ! 86 ! Allocate temporary workspace 87 CALL wrk_alloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig ) 83 CALL wrk_alloc( jpi,jpj,jpk, zFe3, zFeL1, zTL1, ztotlig ) 88 84 zFe3 (:,:,:) = 0. 89 85 zFeL1(:,:,:) = 0. 90 86 zTL1 (:,:,:) = 0. 91 87 IF( ln_fechem ) THEN 92 CALL wrk_alloc( jpi, jpj, jpk,zFe2, zFeL2, zTL2, zFeP )88 CALL wrk_alloc( jpi,jpj,jpk, zFe2, zFeL2, zTL2, zFeP ) 93 89 zFe2 (:,:,:) = 0. 94 90 zFeL2(:,:,:) = 0. … … 253 249 zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 254 250 zlamfac = MIN( 1. , zlamfac ) 255 zdep = MIN( 1., 1000. / fsdept(ji,jj,jk) ) 251 !!gm very small BUG : it is unlikely but possible that gdept_n = 0 ..... 252 zdep = MIN( 1., 1000. / gdept_n(ji,jj,jk) ) 256 253 zlam1b = xlam1 * MAX( 0.e0, ( trb(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) ) 257 254 zcoag = zfeequi * zlam1b * zstep + 1E-4 * ( 1. - zlamfac ) * zdep * zstep * trb(ji,jj,jk,jpfer) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
r5836 r5845 59 59 REAL(wp) :: xconv = 0.01_wp / 3600._wp !: coefficients for conversion 60 60 61 !! * Substitutions62 # include "domzgr_substitute.h90"63 61 !!---------------------------------------------------------------------- 64 62 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 182 180 oce_co2(ji,jj) = ( zfld - zflu ) * rfact2 * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 183 181 ! compute the trend 184 tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / fse3t(ji,jj,1)182 tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / e3t_n(ji,jj,1) 185 183 186 184 ! Compute O2 flux … … 188 186 zflu16 = trb(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj) 189 187 zoflx(ji,jj) = zfld16 - zflu16 190 tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / fse3t(ji,jj,1)188 tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / e3t_n(ji,jj,1) 191 189 END DO 192 190 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r5836 r5845 51 51 REAL(wp), DIMENSION(3,61), PUBLIC :: xkrgb !: tabulated attenuation coefficients for RGB absorption 52 52 53 !! * Substitutions54 # include "domzgr_substitute.h90"55 53 !!---------------------------------------------------------------------- 56 54 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 101 99 irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 102 100 ! 103 ekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk)104 ekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk)105 ekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk)101 ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t_n(ji,jj,jk) 102 ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t_n(ji,jj,jk) 103 ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t_n(ji,jj,jk) 106 104 END DO 107 105 END DO … … 162 160 neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer 163 161 ! ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 164 heup(ji,jj) = fsdepw(ji,jj,jk+1)! Euphotic layer depth162 heup(ji,jj) = gdepw_n(ji,jj,jk+1) ! Euphotic layer depth 165 163 ENDIF 166 164 END DO … … 179 177 DO jj = 1, jpj 180 178 DO ji = 1, jpi 181 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN182 zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot (ji,jj,jk) * fse3t(ji,jj,jk) ! remineralisation183 zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * fse3t(ji,jj,jk) ! production184 zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano (ji,jj,jk) * fse3t(ji,jj,jk) ! production185 zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat (ji,jj,jk) * fse3t(ji,jj,jk) ! production186 zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk)179 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 180 zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot (ji,jj,jk) * e3t_n(ji,jj,jk) ! remineralisation 181 zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t_n(ji,jj,jk) ! production 182 zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano (ji,jj,jk) * e3t_n(ji,jj,jk) ! production 183 zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat (ji,jj,jk) * e3t_n(ji,jj,jk) ! production 184 zdepmoy(ji,jj) = zdepmoy(ji,jj) + e3t_n(ji,jj,jk) 187 185 ENDIF 188 186 END DO … … 196 194 DO jj = 1, jpj 197 195 DO ji = 1, jpi 198 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN196 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 199 197 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 200 198 emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep … … 260 258 DO jj = 1, jpj 261 259 DO ji = 1, jpi 262 pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r )260 pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t_n(ji,jj,jk-1) * xsi0r ) 263 261 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb(ji,jj,jk-1 ) ) 264 262 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg(ji,jj,jk-1 ) ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r5836 r5845 54 54 REAL(wp) :: texcret2 !: 1 - excret2 55 55 56 !! * Substitutions57 # include "domzgr_substitute.h90"58 56 !!---------------------------------------------------------------------- 59 57 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 277 275 DO jj = 1, jpj 278 276 DO ji = 1, jpi 279 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN277 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 280 278 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * zmixnano(ji,jj) 281 279 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * zmixdiat(ji,jj) … … 321 319 DO jj = 1, jpj 322 320 DO ji = 1, jpi 323 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN321 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 324 322 zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj) 325 323 zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) … … 462 460 zw2d(:,:) = 0. 463 461 DO jk = 1, jpkm1 464 zw2d(:,:) = zw2d(:,:) + zprorca (:,:,jk) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by nano462 zw2d(:,:) = zw2d(:,:) + zprorca (:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by nano 465 463 ENDDO 466 464 CALL iom_put( "INTPPPHY" , zw2d ) … … 468 466 zw2d(:,:) = 0. 469 467 DO jk = 1, jpkm1 470 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by diatom468 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by diatom 471 469 ENDDO 472 470 CALL iom_put( "INTPPPHY2" , zw2d ) … … 475 473 zw2d(:,:) = 0. 476 474 DO jk = 1, jpkm1 477 zw2d(:,:) = zw2d(:,:) + ( zprorca(:,:,jk) + zprorcad(:,:,jk) ) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp475 zw2d(:,:) = zw2d(:,:) + ( zprorca(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 478 476 ENDDO 479 477 CALL iom_put( "INTPP" , zw2d ) … … 482 480 zw2d(:,:) = 0. 483 481 DO jk = 1, jpkm1 484 zw2d(:,:) = zw2d(:,:) + ( zpronew(:,:,jk) + zpronewd(:,:,jk) ) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated new prod482 zw2d(:,:) = zw2d(:,:) + ( zpronew(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated new prod 485 483 ENDDO 486 484 CALL iom_put( "INTPNEW" , zw2d ) … … 489 487 zw2d(:,:) = 0. 490 488 DO jk = 1, jpkm1 491 zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod489 zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod 492 490 ENDDO 493 491 CALL iom_put( "INTPBFE" , zw2d ) … … 496 494 zw2d(:,:) = 0. 497 495 DO jk = 1, jpkm1 498 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bsi prod496 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bsi prod 499 497 ENDDO 500 498 CALL iom_put( "INTPBSI" , zw2d ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
r5836 r5845 50 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitnh4 !: - - - - - 51 51 52 !! * Substitutions53 # include "domzgr_substitute.h90"54 52 !!---------------------------------------------------------------------- 55 53 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 103 101 DO ji = 1, jpi 104 102 zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 105 IF( fsdept(ji,jj,jk) < zdep ) THEN103 IF( gdept_n(ji,jj,jk) < zdep ) THEN 106 104 zdepbac(ji,jj,jk) = MIN( 0.7 * ( trb(ji,jj,jk,jpzoo) + 2.* trb(ji,jj,jk,jpmes) ), 4.e-6 ) 107 105 ztempbac(ji,jj) = zdepbac(ji,jj,jk) 108 106 ELSE 109 zdepmin = MIN( 1., zdep / fsdept(ji,jj,jk) )107 zdepmin = MIN( 1., zdep / gdept_n(ji,jj,jk) ) 110 108 zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj) 111 109 zdepprod(ji,jj,jk) = zdepmin**0.273 … … 283 281 ! ---------------------------------------------------------- 284 282 zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 285 zdep = MAX( 0., fsdept(ji,jj,jk) - zdep )283 zdep = MAX( 0., gdept_n(ji,jj,jk) - zdep ) 286 284 ztem = MAX( tsn(ji,jj,1,jp_tem), 0. ) 287 285 zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * znusil2 * zdep / wsbio2 ) * ztem / ( ztem + 10. ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
r5836 r5845 25 25 PUBLIC p4z_sbc_init 26 26 27 !! * Shared module variables28 27 LOGICAL , PUBLIC :: ln_dust !: boolean for dust input from the atmosphere 29 28 LOGICAL , PUBLIC :: ln_solub !: boolean for variable solubility of atmospheric iron … … 45 44 LOGICAL , PUBLIC :: ll_sbc 46 45 47 !! * Module variables48 46 LOGICAL :: ll_solub 49 47 … … 80 78 REAL(wp), PUBLIC :: rivdininput, rivdipinput, rivdsiinput 81 79 82 83 80 !! * Substitutions 84 # include "domzgr_substitute.h90"85 81 # include "vectopt_loop_substitute.h90" 86 82 !!---------------------------------------------------------------------- … … 89 85 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 90 86 !!---------------------------------------------------------------------- 91 92 87 CONTAINS 93 88 … … 163 158 DO jj = 1, jpj 164 159 DO ji = 1, jpi 165 nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / rno3 / ( 14E6 * ryyss * fse3t(ji,jj,1) + rtrn )160 nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / rno3 / ( 14E6 * ryyss * e3t_n(ji,jj,1) + rtrn ) 166 161 END DO 167 162 END DO … … 267 262 IF( lk_offline ) THEN 268 263 nk_rnf(:,:) = 1 269 h_rnf (:,:) = fsdept(:,:,1)264 h_rnf (:,:) = gdept_n(:,:,1) 270 265 ENDIF 271 266 … … 456 451 DO jj = 1, jpj 457 452 DO ji = 1, jpi 458 zexpide = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) )453 zexpide = MIN( 8.,( gdept_n(ji,jj,jk) / 500. )**(-1.5) ) 459 454 zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 460 455 zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 ) … … 466 461 ironsed(:,:,jpk) = 0._wp 467 462 DO jk = 1, jpkm1 468 ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( fse3t(:,:,jk) * rday )463 ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_n(:,:,jk) * rday ) 469 464 END DO 470 465 DEALLOCATE( zcmask) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
r5836 r5845 32 32 PUBLIC p4z_sed_alloc 33 33 34 35 !! * Module variables36 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrpot !: Nitrogen fixation 37 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,: ) :: sdenit !: Nitrate reduction in the sediments 38 36 REAL(wp) :: r1_rday !: inverse of rday 39 37 40 !! * Substitutions41 # include "domzgr_substitute.h90"42 38 !!---------------------------------------------------------------------- 43 39 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 100 96 DO jj = 1, jpj 101 97 DO ji = 1, jpi 102 zdep = rfact2 / fse3t(ji,jj,1)98 zdep = rfact2 / e3t_n(ji,jj,1) 103 99 zwflux = fmmflx(ji,jj) / 1000._wp 104 100 zfminus = MIN( 0._wp, -zwflux ) * trb(ji,jj,1,jpfer) * zdep … … 111 107 ! 112 108 IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) ) & 113 & CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! iron flux from ice109 & CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! iron flux from ice 114 110 ! 115 111 CALL wrk_dealloc( jpi, jpj, zironice ) … … 125 121 ! ! Iron and Si deposition at the surface 126 122 IF( ln_solub ) THEN 127 zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 55.85 + 3.e-10 * r1_ryyss123 zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 128 124 ELSE 129 zirondep(:,:,1) = dustsolub * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 55.85 + 3.e-10 * r1_ryyss125 zirondep(:,:,1) = dustsolub * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 130 126 ENDIF 131 zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 28.1132 zpdep (:,:) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 31. / po4r127 zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1 128 zpdep (:,:) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r 133 129 ! ! Iron solubilization of particles in the water column 134 130 ! ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ; wdust in m/j 135 131 zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday ) 136 132 DO jk = 2, jpkm1 137 zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( - fsdept(:,:,jk) / 540. )133 zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. ) 138 134 END DO 139 135 ! ! Iron solubilization of particles in the water column … … 145 141 IF( knt == nrdttrc ) THEN 146 142 IF( iom_use( "Irondep" ) ) & 147 & CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron143 & CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron 148 144 IF( iom_use( "pdust" ) ) & 149 145 & CALL iom_put( "pdust" , dust(:,:) / ( wdust * rday ) * tmask(:,:,1) ) ! dust concentration at surface … … 151 147 ELSE 152 148 IF( ln_diatrc ) & 153 & trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)149 & trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) 154 150 ENDIF 155 151 CALL wrk_dealloc( jpi, jpj, zpdep, zsidep ) … … 206 202 DO ji = 1, jpi 207 203 ikt = mbkt(ji,jj) 208 zdep = fse3t(ji,jj,ikt) / xstep204 zdep = e3t_n(ji,jj,ikt) / xstep 209 205 zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) ) 210 206 zwscal (ji,jj) = MIN( 0.99 * zdep, wscal (ji,jj,ikt) ) … … 230 226 zo2 = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) ) 231 227 zno3 = LOG10( MAX( 1. , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) ) 232 zdep = LOG10( fsdepw(ji,jj,ikt+1) )228 zdep = LOG10( gdepw_n(ji,jj,ikt+1) ) 233 229 zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3 & 234 230 & + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 … … 279 275 DO ji = 1, jpi 280 276 ikt = mbkt(ji,jj) 281 zdep = xstep / fse3t(ji,jj,ikt)277 zdep = xstep / e3t_n(ji,jj,ikt) 282 278 zws4 = zwsbio4(ji,jj) * zdep 283 279 zwsc = zwscal (ji,jj) * zdep … … 305 301 DO ji = 1, jpi 306 302 ikt = mbkt(ji,jj) 307 zdep = xstep / fse3t(ji,jj,ikt)303 zdep = xstep / e3t_n(ji,jj,ikt) 308 304 zws4 = zwsbio4(ji,jj) * zdep 309 305 zws3 = zwsbio3(ji,jj) * zdep … … 336 332 tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) ) 337 333 tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt 338 sdenit(ji,jj) = rdenit * zpdenit * fse3t(ji,jj,ikt)334 sdenit(ji,jj) = rdenit * zpdenit * e3t_n(ji,jj,ikt) 339 335 #endif 340 336 END DO … … 388 384 zwork1(:,:) = 0. 389 385 DO jk = 1, jpkm1 390 zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * fse3t(:,:,jk) * tmask(:,:,jk)386 zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * e3t_n(:,:,jk) * tmask(:,:,jk) 391 387 ENDDO 392 388 CALL iom_put( "INTNFIX" , zwork1 ) … … 395 391 ELSE 396 392 IF( ln_diatrc ) & 397 & trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)393 & trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) 398 394 ENDIF 399 395 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
r5836 r5845 65 65 #endif 66 66 67 !! * Substitutions68 # include "domzgr_substitute.h90"69 67 !!---------------------------------------------------------------------- 70 68 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 108 106 DO ji = 1,jpi 109 107 zmax = MAX( heup(ji,jj), hmld(ji,jj) ) 110 zfact = MAX( 0., fsdepw(ji,jj,jk+1) - zmax ) / 5000._wp108 zfact = MAX( 0., gdepw_n(ji,jj,jk+1) - zmax ) / 5000._wp 111 109 wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact 112 110 END DO … … 137 135 DO ji = 1, jpi 138 136 IF( tmask(ji,jj,jk) == 1) THEN 139 zwsmax = 0.5 * fse3t(ji,jj,jk) / xstep137 zwsmax = 0.5 * e3t_n(ji,jj,jk) / xstep 140 138 iiter1 = MAX( iiter1, INT( wsbio3(ji,jj,jk) / zwsmax ) ) 141 139 iiter2 = MAX( iiter2, INT( wsbio4(ji,jj,jk) / zwsmax ) ) … … 156 154 DO ji = 1, jpi 157 155 IF( tmask(ji,jj,jk) == 1 ) THEN 158 zwsmax = 0.5 * fse3t(ji,jj,jk) / xstep156 zwsmax = 0.5 * e3t_n(ji,jj,jk) / xstep 159 157 wsbio3(ji,jj,jk) = MIN( wsbio3(ji,jj,jk), zwsmax * FLOAT( iiter1 ) ) 160 158 wsbio4(ji,jj,jk) = MIN( wsbio4(ji,jj,jk), zwsmax * FLOAT( iiter2 ) ) … … 700 698 zl = zmin 701 699 zr = zmax 702 wmax = 0.5 * fse3t(1,1,jk) * rday * float(niter1max) / rfact2700 wmax = 0.5 * e3t_n(1,1,jk) * rday * float(niter1max) / rfact2 703 701 zdiv = xkr_zeta + xkr_eta - xkr_eta * zl 704 702 znum = zl - 1. … … 844 842 DO jj = 1, jpj 845 843 DO ji = 1, jpi 846 zigma = zwsink2(ji,jj,jk+1) * zstep / fse3w(ji,jj,jk+1)844 zigma = zwsink2(ji,jj,jk+1) * zstep / e3w_n(ji,jj,jk+1) 847 845 zew = zwsink2(ji,jj,jk+1) 848 846 psinkflx(ji,jj,jk+1) = -zew * ( trb(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep … … 858 856 DO jj = 1,jpj 859 857 DO ji = 1, jpi 860 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / fse3t(ji,jj,jk)858 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 861 859 trb(ji,jj,jk,jp_tra) = trb(ji,jj,jk,jp_tra) + zflx 862 860 END DO … … 869 867 DO jj = 1,jpj 870 868 DO ji = 1, jpi 871 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / fse3t(ji,jj,jk)869 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 872 870 ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx 873 871 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90
r5836 r5845 21 21 PUBLIC trc_wri_pisces 22 22 23 !! * Substitutions 24 # include "domzgr_substitute.h90" 25 23 !!---------------------------------------------------------------------- 24 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 25 !! $Id: trcnam.F90 5836 2015-10-26 14:49:40Z cetlod $ 26 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 27 !!---------------------------------------------------------------------- 26 28 CONTAINS 27 29 … … 57 59 zdic(:,:) = 0. 58 60 DO jk = 1, jpkm1 59 zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * fse3t(:,:,jk) * tmask(:,:,jk) * 12.61 zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * e3t_n(:,:,jk) * tmask(:,:,jk) * 12. 60 62 ENDDO 61 63 CALL iom_put( 'INTDIC', zdic ) … … 64 66 IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN ! Oxygen minimum concentration and depth 65 67 zo2min (:,:) = trn(:,:,1,jpoxy) * tmask(:,:,1) 66 zdepo2min(:,:) = fsdepw(:,:,1)* tmask(:,:,1)68 zdepo2min(:,:) = gdepw_n(:,:,1) * tmask(:,:,1) 67 69 DO jk = 2, jpkm1 68 70 DO jj = 1, jpj … … 71 73 IF( trn(ji,jj,jk,jpoxy) < zo2min(ji,jj) ) then 72 74 zo2min (ji,jj) = trn(ji,jj,jk,jpoxy) 73 zdepo2min(ji,jj) = fsdepw(ji,jj,jk)75 zdepo2min(ji,jj) = gdepw_n(ji,jj,jk) 74 76 ENDIF 75 77 ENDIF -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r5836 r5845 62 62 63 63 !! * Substitutions 64 # include "domzgr_substitute.h90"65 64 # include "vectopt_loop_substitute.h90" 66 65 !!---------------------------------------------------------------------- … … 109 108 ! !== effective transport ==! 110 109 DO jk = 1, jpkm1 111 zun(:,:,jk) = e2u (:,:) * fse3u(:,:,jk) * un(:,:,jk) ! eulerian transport112 zvn(:,:,jk) = e1v (:,:) * fse3v(:,:,jk) * vn(:,:,jk)110 zun(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * un(:,:,jk) ! eulerian transport 111 zvn(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 113 112 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 114 113 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r5836 r5845 43 43 44 44 !! * Substitutions 45 # include "domzgr_substitute.h90"46 45 # include "vectopt_loop_substitute.h90" 47 46 !!---------------------------------------------------------------------- … … 82 81 !! - save the trends ('key_trdmxl_trc') 83 82 !!---------------------------------------------------------------------- 84 !! 85 INTEGER, INTENT( in ) :: kt ! ocean time-step index 86 !! 87 INTEGER :: ji, jj, jk, jn, jl ! dummy loop indices 88 REAL(wp) :: ztra ! temporary scalars 83 INTEGER, INTENT(in) :: kt ! ocean time-step index 84 ! 85 INTEGER :: ji, jj, jk, jn, jl ! dummy loop indices 89 86 CHARACTER (len=22) :: charout 90 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd … … 105 102 ! 106 103 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 107 104 ! 108 105 jl = n_trc_index(jn) 109 106 CALL trc_dta( kt, sf_trcdta(jl),rf_trfac(jl) ) ! read tracer data at nit000 110 107 ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 111 108 ! 112 109 SELECT CASE ( nn_zdmp_tr ) 113 110 ! … … 116 113 DO jj = 2, jpjm1 117 114 DO ji = fs_2, fs_jpim1 ! vector opt. 118 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 119 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 115 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 120 116 END DO 121 117 END DO 122 118 END DO 123 !119 ! 124 120 CASE ( 1 ) !== no damping in the turbocline (avt > 5 cm2/s) ==! 125 121 DO jk = 1, jpkm1 … … 127 123 DO ji = fs_2, fs_jpim1 ! vector opt. 128 124 IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN 129 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 130 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 125 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 131 126 ENDIF 132 127 END DO 133 128 END DO 134 129 END DO 135 !130 ! 136 131 CASE ( 2 ) !== no damping in the mixed layer ==! 137 132 DO jk = 1, jpkm1 138 133 DO jj = 2, jpjm1 139 134 DO ji = fs_2, fs_jpim1 ! vector opt. 140 IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 141 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 142 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 135 IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN 136 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 143 137 END IF 144 138 END DO 145 139 END DO 146 140 END DO 147 !141 ! 148 142 END SELECT 149 143 ! … … 162 156 IF( l_trdtrc ) CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd ) 163 157 ! ! print mean trends (used for debugging) 164 IF( ln_ctl ) THEN 165 WRITE(charout, FMT="('dmp ')") ; CALL prt_ctl_trc_info(charout) 166 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 158 IF( ln_ctl ) THEN 159 WRITE(charout, FMT="('dmp ')") 160 CALL prt_ctl_trc_info(charout) 161 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 167 162 ENDIF 168 163 ! … … 170 165 ! 171 166 END SUBROUTINE trc_dmp 167 172 168 173 169 SUBROUTINE trc_dmp_ini -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r5836 r5845 47 47 48 48 !! * Substitutions 49 # include "domzgr_substitute.h90"50 49 # include "vectopt_loop_substitute.h90" 51 50 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r5836 r5845 31 31 32 32 !! * Substitutions 33 # include "domzgr_substitute.h90"34 33 # include "vectopt_loop_substitute.h90" 35 34 !!---------------------------------------------------------------------- … … 153 152 DO jj = 2, jpj 154 153 DO ji = fs_2, fs_jpim1 ! vector opt. 155 zse3t = 1. / fse3t(ji,jj,1)154 zse3t = 1. / e3t_n(ji,jj,1) 156 155 ! tracer flux at the ice/ocean interface (tracer/m2/s) 157 156 zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice … … 174 173 DO jj = 2, jpj 175 174 DO ji = fs_2, fs_jpim1 ! vector opt. 176 zse3t = zfact / fse3t(ji,jj,1)175 zse3t = zfact / e3t_n(ji,jj,1) 177 176 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 178 177 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r5836 r5845 40 40 41 41 !! * Substitutions 42 # include "domzgr_substitute.h90"43 42 # include "zdfddm_substitute.h90" 44 43 # include "vectopt_loop_substitute.h90" -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90
r5836 r5845 66 66 67 67 !! * Substitutions 68 # include "domzgr_substitute.h90"69 68 # include "zdfddm_substitute.h90" 70 69 !!---------------------------------------------------------------------- … … 175 174 DO jj = 1, jpj 176 175 DO ji = 1, jpi 177 IF( jk - nmld_trc(ji,jj) < 0 ) wkx_trc(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk)176 IF( jk - nmld_trc(ji,jj) < 0 ) wkx_trc(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 178 177 END DO 179 178 END DO … … 293 292 DO jj = 1,jpj 294 293 DO ji = 1,jpi 295 IF( jk - nmld_trc(ji,jj) < 0. ) wkx_trc(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk)294 IF( jk - nmld_trc(ji,jj) < 0. ) wkx_trc(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 296 295 END DO 297 296 END DO … … 417 416 DO jn = 1, jptra 418 417 IF( ln_trdtrc(jn) ) & 419 tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik) &418 tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - zavt / e3w_n(ji,jj,ik) * tmask(ji,jj,ik) & 420 419 & * ( trn(ji,jj,ik-1,jn) - trn(ji,jj,ik,jn) ) & 421 420 & / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90
r5341 r5845 21 21 22 22 INTEGER :: nummldw_trc ! logical unit for mld restart 23 23 24 !!--------------------------------------------------------------------------------- 24 25 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 26 27 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 27 28 !!--------------------------------------------------------------------------------- 28 29 29 CONTAINS 30 31 30 32 31 SUBROUTINE trd_mxl_trc_rst_write( kt ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
r5215 r5845 1 1 MODULE trcbc 2 2 !!====================================================================== 3 !! *** MODULE trc dta***3 !! *** MODULE trcbc *** 4 4 !! TOP : module for passive tracer boundary conditions 5 5 !!===================================================================== … … 40 40 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trccbc ! structure of data input CBC (file informations, fields read) 41 41 42 !! * Substitutions43 # include "domzgr_substitute.h90"44 42 !!---------------------------------------------------------------------- 45 43 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 58 56 !! - allocates passive tracer BC data structure 59 57 !!---------------------------------------------------------------------- 60 !61 58 INTEGER,INTENT(IN) :: ntrc ! number of tracers 62 59 INTEGER :: jl, jn ! dummy loop indices … … 242 239 ! 243 240 ENDIF 244 241 ! 245 242 DEALLOCATE( slf_i ) ! deallocate local field structure 246 243 IF( nn_timing == 1 ) CALL timing_stop('trc_bc_init') 247 244 ! 248 245 END SUBROUTINE trc_bc_init 249 246 … … 258 255 !! 259 256 !!---------------------------------------------------------------------- 260 261 ! NEMO262 257 USE fldread 263 264 !! * Arguments 258 ! 265 259 INTEGER, INTENT( in ) :: kt ! ocean time-step index 266 267 260 !!--------------------------------------------------------------------- 268 261 ! … … 295 288 ! 296 289 IF( nn_timing == 1 ) CALL timing_stop('trc_bc_read') 297 ! 298 290 ! 299 291 END SUBROUTINE trc_bc_read 292 300 293 #else 301 294 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r5385 r5845 36 36 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trcdta ! structure of input SST (file informations, fields read) 37 37 !$AGRIF_END_DO_NOT_TREAT 38 !! * Substitutions 39 # include "domzgr_substitute.h90" 38 40 39 !!---------------------------------------------------------------------- 41 40 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 189 188 DO ji = 1, jpi 190 189 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 191 zl = fsdept_n(ji,jj,jk)190 zl = gdept_n(ji,jj,jk) 192 191 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 193 192 ztp(jk) = sf_dta(1)%fnow(ji,jj,1) … … 220 219 ik = mbkt(ji,jj) 221 220 IF( ik > 1 ) THEN 222 zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )221 zl = ( gdept_1d(ik) - gdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 223 222 sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik-1) 224 223 ENDIF -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r5836 r5845 32 32 PUBLIC trc_init ! called by opa 33 33 34 !! * Substitutions35 # include "domzgr_substitute.h90"36 34 !!---------------------------------------------------------------------- 37 35 !! NEMO/TOP 4.0 , NEMO Consortium (2011) … … 119 117 ! ! masked grid volume 120 118 DO jk = 1, jpk 121 cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)119 cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 122 120 END DO 123 IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)! degrad option: reduction by facvol121 IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:) ! degrad option: reduction by facvol 124 122 ! ! total volume of the ocean 125 123 areatot = glob_sum( cvol(:,:,:) ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r5836 r5845 14 14 !!---------------------------------------------------------------------- 15 15 !!---------------------------------------------------------------------- 16 !! trc_rst : Restart for passive tracer 17 !!---------------------------------------------------------------------- 18 !!---------------------------------------------------------------------- 19 !! 'key_top' TOP models 20 !!---------------------------------------------------------------------- 16 !! trc_rst : Restart for passive tracer 21 17 !! trc_rst_opn : open restart file 22 18 !! trc_rst_read : read restart file … … 27 23 USE iom 28 24 USE daymod 25 29 26 IMPLICIT NONE 30 27 PRIVATE … … 35 32 PUBLIC trc_rst_cal 36 33 37 !! * Substitutions 38 # include "domzgr_substitute.h90" 39 34 !!---------------------------------------------------------------------- 35 !! NEMO/TOP 3.7 , NEMO Consortium (2010) 36 !! $Id$ 37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 38 !!---------------------------------------------------------------------- 40 39 CONTAINS 41 40 … … 288 287 ! 289 288 DO jk = 1, jpk 290 zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk)289 zvol(:,:,jk) = e1e2t(:,:) * e3t_a(:,:,jk) * tmask(:,:,jk) 291 290 END DO 292 291 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r5407 r5845 36 36 LOGICAL :: llnew 37 37 38 !! * Substitutions39 # include "domzgr_substitute.h90"40 38 !!---------------------------------------------------------------------- 41 39 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 68 66 IF( lk_vvl ) THEN ! update ocean volume due to ssh temporal evolution 69 67 DO jk = 1, jpk 70 cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)68 cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 71 69 END DO 72 70 IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:) ! degrad option: reduction by facvol -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
r5836 r5845 40 40 PUBLIC trc_sub_ssh ! called by trc_stp to reset physics variables 41 41 42 !!* Module variables43 42 REAL(wp) :: r1_ndttrc ! 1 / nn_dttrc 44 43 REAL(wp) :: r1_ndttrcp1 ! 1 / (nn_dttrc+1) … … 48 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp_tm , vslp_tm , wslpi_tm , wslpj_tm !: time mean 49 48 50 !! * Substitutions51 # include "domzgr_substitute.h90"52 49 !!---------------------------------------------------------------------- 53 50 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 88 85 IF( MOD( kt , nn_dttrc ) /= 0 ) THEN 89 86 ! 90 un_tm (:,:,:) = un_tm (:,:,:) + un (:,:,:) * fse3u(:,:,:)91 vn_tm (:,:,:) = vn_tm (:,:,:) + vn (:,:,:) * fse3v(:,:,:)92 tsn_tm (:,:,:,jp_tem) = tsn_tm (:,:,:,jp_tem) + tsn (:,:,:,jp_tem) * fse3t(:,:,:)93 tsn_tm (:,:,:,jp_sal) = tsn_tm (:,:,:,jp_sal) + tsn (:,:,:,jp_sal) * fse3t(:,:,:)94 rhop_tm (:,:,:) = rhop_tm (:,:,:) + rhop (:,:,:) * fse3t(:,:,:)95 avt_tm (:,:,:) = avt_tm (:,:,:) + avt (:,:,:) * fse3w(:,:,:)96 # if defined key_zdfddm 97 avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * fse3w(:,:,:)87 un_tm (:,:,:) = un_tm (:,:,:) + un (:,:,:) * e3u_n(:,:,:) 88 vn_tm (:,:,:) = vn_tm (:,:,:) + vn (:,:,:) * e3v_n(:,:,:) 89 tsn_tm (:,:,:,jp_tem) = tsn_tm (:,:,:,jp_tem) + tsn (:,:,:,jp_tem) * e3t_n(:,:,:) 90 tsn_tm (:,:,:,jp_sal) = tsn_tm (:,:,:,jp_sal) + tsn (:,:,:,jp_sal) * e3t_n(:,:,:) 91 rhop_tm (:,:,:) = rhop_tm (:,:,:) + rhop (:,:,:) * e3t_n(:,:,:) 92 avt_tm (:,:,:) = avt_tm (:,:,:) + avt (:,:,:) * e3w_n(:,:,:) 93 # if defined key_zdfddm 94 avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * e3w_n(:,:,:) 98 95 # endif 99 96 IF( l_ldfslp ) THEN … … 165 162 ! 166 163 ! 2. Create averages and reassign variables 167 un_tm (:,:,:) = un_tm (:,:,:) + un (:,:,:) * fse3u(:,:,:)168 vn_tm (:,:,:) = vn_tm (:,:,:) + vn (:,:,:) * fse3v(:,:,:)169 tsn_tm (:,:,:,jp_tem) = tsn_tm (:,:,:,jp_tem) + tsn (:,:,:,jp_tem) * fse3t(:,:,:)170 tsn_tm (:,:,:,jp_sal) = tsn_tm (:,:,:,jp_sal) + tsn (:,:,:,jp_sal) * fse3t(:,:,:)171 rhop_tm (:,:,:) = rhop_tm (:,:,:) + rhop (:,:,:) * fse3t(:,:,:)172 avt_tm (:,:,:) = avt_tm (:,:,:) + avt (:,:,:) * fse3w(:,:,:)173 # if defined key_zdfddm 174 avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * fse3w(:,:,:)164 un_tm (:,:,:) = un_tm (:,:,:) + un (:,:,:) * e3u_n(:,:,:) 165 vn_tm (:,:,:) = vn_tm (:,:,:) + vn (:,:,:) * e3v_n(:,:,:) 166 tsn_tm (:,:,:,jp_tem) = tsn_tm (:,:,:,jp_tem) + tsn (:,:,:,jp_tem) * e3t_n(:,:,:) 167 tsn_tm (:,:,:,jp_sal) = tsn_tm (:,:,:,jp_sal) + tsn (:,:,:,jp_sal) * e3t_n(:,:,:) 168 rhop_tm (:,:,:) = rhop_tm (:,:,:) + rhop (:,:,:) * e3t_n(:,:,:) 169 avt_tm (:,:,:) = avt_tm (:,:,:) + avt (:,:,:) * e3w_n(:,:,:) 170 # if defined key_zdfddm 171 avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * e3w_n(:,:,:) 175 172 # endif 176 173 IF( l_ldfslp ) THEN … … 244 241 DO jj = 1, jpj 245 242 DO ji = 1, jpi 246 z1_ne3t = r1_ndttrcp1 / fse3t(ji,jj,jk)247 z1_ne3u = r1_ndttrcp1 / fse3u(ji,jj,jk)248 z1_ne3v = r1_ndttrcp1 / fse3v(ji,jj,jk)249 z1_ne3w = r1_ndttrcp1 / fse3w(ji,jj,jk)243 z1_ne3t = r1_ndttrcp1 / e3t_n(ji,jj,jk) 244 z1_ne3u = r1_ndttrcp1 / e3u_n(ji,jj,jk) 245 z1_ne3v = r1_ndttrcp1 / e3v_n(ji,jj,jk) 246 z1_ne3w = r1_ndttrcp1 / e3w_n(ji,jj,jk) 250 247 ! 251 248 un (ji,jj,jk) = un_tm (ji,jj,jk) * z1_ne3u … … 300 297 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'top_sub_alloc : unable to allocate standard ocean arrays' ) 301 298 302 un_tm (:,:,:) = un (:,:,:) * fse3u(:,:,:)303 vn_tm (:,:,:) = vn (:,:,:) * fse3v(:,:,:)304 tsn_tm (:,:,:,jp_tem) = tsn (:,:,:,jp_tem) * fse3t(:,:,:)305 tsn_tm (:,:,:,jp_sal) = tsn (:,:,:,jp_sal) * fse3t(:,:,:)306 rhop_tm (:,:,:) = rhop (:,:,:) * fse3t(:,:,:)299 un_tm (:,:,:) = un (:,:,:) * e3u_n(:,:,:) 300 vn_tm (:,:,:) = vn (:,:,:) * e3v_n(:,:,:) 301 tsn_tm (:,:,:,jp_tem) = tsn (:,:,:,jp_tem) * e3t_n(:,:,:) 302 tsn_tm (:,:,:,jp_sal) = tsn (:,:,:,jp_sal) * e3t_n(:,:,:) 303 rhop_tm (:,:,:) = rhop (:,:,:) * e3t_n(:,:,:) 307 304 !!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 308 avt_tm (:,:,:) = avt (:,:,:) * fse3w(:,:,:)309 # if defined key_zdfddm 310 avs_tm (:,:,:) = avs (:,:,:) * fse3w(:,:,:)305 avt_tm (:,:,:) = avt (:,:,:) * e3w_n(:,:,:) 306 # if defined key_zdfddm 307 avs_tm (:,:,:) = avs (:,:,:) * e3w_n(:,:,:) 311 308 # endif 312 309 IF( l_ldfslp ) THEN … … 400 397 ! 401 398 ! Start new averages 402 un_tm (:,:,:) = un (:,:,:) * fse3u(:,:,:)403 vn_tm (:,:,:) = vn (:,:,:) * fse3v(:,:,:)404 tsn_tm (:,:,:,jp_tem) = tsn (:,:,:,jp_tem) * fse3t(:,:,:)405 tsn_tm (:,:,:,jp_sal) = tsn (:,:,:,jp_sal) * fse3t(:,:,:)406 rhop_tm (:,:,:) = rhop (:,:,:) * fse3t(:,:,:)407 avt_tm (:,:,:) = avt (:,:,:) * fse3w(:,:,:)408 # if defined key_zdfddm 409 avs_tm (:,:,:) = avs (:,:,:) * fse3w(:,:,:)399 un_tm (:,:,:) = un (:,:,:) * e3u_n(:,:,:) 400 vn_tm (:,:,:) = vn (:,:,:) * e3v_n(:,:,:) 401 tsn_tm (:,:,:,jp_tem) = tsn (:,:,:,jp_tem) * e3t_n(:,:,:) 402 tsn_tm (:,:,:,jp_sal) = tsn (:,:,:,jp_sal) * e3t_n(:,:,:) 403 rhop_tm (:,:,:) = rhop (:,:,:) * e3t_n(:,:,:) 404 avt_tm (:,:,:) = avt (:,:,:) * e3w_n(:,:,:) 405 # if defined key_zdfddm 406 avs_tm (:,:,:) = avs (:,:,:) * e3w_n(:,:,:) 410 407 # endif 411 408 IF( l_ldfslp ) THEN … … 495 492 zhdiv(:,:) = 0._wp 496 493 DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports 497 zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk)494 zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk) 498 495 END DO 499 496 ! ! Sea surface elevation time stepping … … 520 517 z1_2dt = 1.e0 / z2dt 521 518 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 522 ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise523 wn(:,:,jk) = wn(:,:,jk+1) - fse3t_n(:,:,jk) * hdivn(:,:,jk) &524 & - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) ) &519 ! - ML - need 3 lines here because replacement of e3t by its expression yields too long lines otherwise 520 wn(:,:,jk) = wn(:,:,jk+1) - e3t_n(:,:,jk) * hdivn(:,:,jk) & 521 & - ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) & 525 522 & * tmask(:,:,jk) * z1_2dt 526 523 #if defined key_bdy
Note: See TracChangeset
for help on using the changeset viewer.