Changeset 7649
- Timestamp:
- 2017-02-06T16:21:14+01:00 (7 years ago)
- Location:
- branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM
- Files:
-
- 7 edited
-
CONFIG/SHARED/field_def.xml (modified) (1 diff)
-
NEMO/OPA_SRC/DYN/divcur.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/DYN/dynhpg.F90 (modified) (6 diffs)
-
NEMO/OPA_SRC/DYN/dynkeg.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/DYN/dynldf_bilap.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/DYN/dynvor.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/DYN/dynzad.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/CONFIG/SHARED/field_def.xml
r6876 r7649 499 499 <field id="tke" long_name="Turbulent Kinetic Energy" unit="m2/s2" /> 500 500 <field id="tke_niw" long_name="Turbulent Kinetic Energy due to near-inertial wave breaking" unit="m2/s2" /> 501 <!-- diag_vor_int and diag_vor_mn: available with TODO FLAGS and TODO FLAGS --> 502 <field id="dia_vor_int" long_name="vertical integral vorticity tendencies" standard_name="vertically_integrated_vorticity_tendencies" unit="s-2" grid_ref="grid_W_2D" /> 503 <field id="dia_vor_mn" long_name="vertical mean vorticity tendencies" standard_name="vertical_mean_vorticity_tendencies" unit="s-2" grid_ref="grid_W_2D" /> 501 504 </field_group> 502 505 -
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
r6487 r7649 35 35 USE wrk_nemo ! Memory Allocation 36 36 USE timing ! Timing 37 USE iom ! I/O Manager for dyn_vrt_dia 37 38 38 39 IMPLICIT NONE 39 40 PRIVATE 40 41 41 PUBLIC div_cur ! routine called by step.F90 and istate.F90 42 PUBLIC div_cur ! routine called by step.F90 and istate.F90 43 PUBLIC dyn_vrt_dia ! routine called by various modules 42 44 43 45 !! * Substitutions … … 338 340 339 341 #endif 342 343 344 SUBROUTINE dyn_vrt_dia( utend, vtend, id_dia_vor_int, id_dia_vor_mn) 345 346 !!---------------------------------------------------------------------- 347 !! 348 !! ** Purpose : compute the integral and mean vorticity tendencies. 349 !! 350 !! ** Action : a) Calculate the vertical integrals of utend & of vtend 351 !! (u_int & v_int) 352 !! b) Calculate the vorticity tendencies for the vertical 353 !! integrals. 354 !! c) Calculate the vertical means, u_mn, v_mn from u_int 355 !! and v_int by dividing by the depth 356 !! d) Calculate the vorticity tendencies for the vertical 357 !! means 358 !! e) Call iom_put for the vertical integral vorticity 359 !! tendencies (using id_dia_vor_int) 360 !! f) Call iom_put for the vertical mean vorticity 361 !! tendencies (using id_dia_vor_mn) 362 !! 363 !!---------------------------------------------------------------------- 364 REAL :: utend(jpi,jpj,jpk) ! contribution to du/dt 365 REAL :: vtend(jpi,jpj,jpk) ! contribution to dv/dt 366 INTEGER :: id_dia_vor_int ! identifier for the vertical integral vorticity diagnostic 367 INTEGER :: id_dia_vor_mn ! identifier for the vertical mean vorticity diagnostic 368 ! 369 !!---------------------------------------------------------------------- 370 ! 371 INTEGER :: ji, jj, jk ! dummy loop indices 372 INTEGER :: ikbu, ikbv ! dummy loop indices 373 ! 374 REAL(wp), POINTER, DIMENSION(:,:) :: u_int ! u vertical integral 375 REAL(wp), POINTER, DIMENSION(:,:) :: v_int ! v vertical integral 376 REAL(wp), POINTER, DIMENSION(:,:) :: u_mn ! u vertical means 377 REAL(wp), POINTER, DIMENSION(:,:) :: v_mn ! u vertical means 378 REAL(wp), POINTER, DIMENSION(:,:) :: vor_int ! vort trend of vert integrals 379 REAL(wp), POINTER, DIMENSION(:,:) :: vor_mn ! vort trend of vert means 380 381 CALL wrk_alloc(jpi, jpj, u_int) 382 CALL wrk_alloc(jpi, jpj, v_int) 383 CALL wrk_alloc(jpi, jpj, u_mn) 384 CALL wrk_alloc(jpi, jpj, v_mn) 385 CALL wrk_alloc(jpi, jpj, vor_int) 386 CALL wrk_alloc(jpi, jpj, vor_mn) 387 388 u_int(:,:) = 0.0_wp 389 v_int(:,:) = 0.0_wp 390 391 ! 392 ! Calculate the vertical integrals of utend & of vtend 393 ! 394 395 DO jk = 1,jpk 396 DO jj = 1,jpj 397 DO ji = 1,jpi 398 u_int(ji,jj) = u_int(ji,jj) + utend(ji,jj,jk)*fse3u(ji,jj,jk) 399 v_int(ji,jj) = v_int(ji,jj) + vtend(ji,jj,jk)*fse3v(ji,jj,jk) 400 END DO 401 END DO 402 END DO 403 404 ! 405 ! Calculate the vorticity tendencies for the vertical integrals. 406 ! 1/e1e2 * ((e2*d(vtend)/dx) - (e1*d(utend)/dy)) 407 ! 408 409 DO jj = 1,jpjm1 410 DO ji = 1,jpim1 411 vor_int(ji,jj) = ( v_int(ji+1,jj) * e2v(ji+1,jj) & 412 & - v_int(ji,jj) * e2v(ji,jj) & 413 & + u_int(ji,jj) * e1u(ji,jj) & 414 & - u_int(ji,jj+1) * e1u(ji,jj+1) ) & 415 & / ( e1f(ji,jj) * e2f(ji,jj) ) 416 END DO 417 END DO 418 419 420 ! 421 ! Calculate the vertical means, u_mn, v_mn from u_int & v_int by dividing 422 ! by the depth 423 ! mbku & mbkv - vertical index of the bottom last U- & W- ocean level 424 ! 425 426 DO jj = 1, jpj 427 DO ji = 1, jpi 428 ikbu = mbku(ji,jj) 429 ikbv = mbkv(ji,jj) 430 431 IF (ikbu .ne. 0.0_wp) THEN ! Don't divide by 0! 432 u_mn(ji,jj) = u_int(ji,jj) / ikbu 433 ELSE 434 u_mn(ji,jj) = 0.0_wp 435 END IF 436 437 IF (ikbv .ne. 0.0_wp) THEN ! Don't divide by 0! 438 v_mn(ji,jj) = v_int(ji,jj) / ikbv 439 ELSE 440 v_mn(ji,jj) = 0.0_wp 441 END IF 442 END DO 443 END DO 444 445 ! 446 ! Calculate the vorticity tendencies for the vertical means 447 ! 1/e1e2 * ((e2*d(v_mn)/dx) - (e1*d(u_mn)/dy)) 448 ! 449 450 DO jj = 1,jpjm1 451 DO ji = 1,jpim1 452 vor_mn(ji,jj) = ( v_mn(ji+1,jj) * e2v(ji+1,jj) & 453 & - v_mn(ji,jj) * e2v(ji,jj) & 454 & + u_mn(ji,jj) * e1u(ji,jj) & 455 & - u_mn(ji,jj+1) * e1u(ji,jj+1) ) & 456 & / ( e1f(ji,jj) * e2f(ji,jj) ) 457 END DO 458 END DO 459 460 461 ! Call iom_put for the vertical integral vorticity tendencies 462 IF (id_dia_vor_int == 1) THEN 463 CALL iom_put( "dia_vor_int", vor_int(:,:)) 464 ENDIF 465 466 ! Call iom_put for the vertical mean vorticity tendencies 467 IF (id_dia_vor_int == 1) THEN 468 CALL iom_put( "dia_vor_mn", vor_mn(:,:)) 469 ENDIF 470 471 CALL wrk_dealloc(jpi, jpj, u_int) 472 CALL wrk_dealloc(jpi, jpj, v_int) 473 CALL wrk_dealloc(jpi, jpj, u_mn) 474 CALL wrk_dealloc(jpi, jpj, v_mn) 475 CALL wrk_dealloc(jpi, jpj, vor_int) 476 CALL wrk_dealloc(jpi, jpj, vor_mn) 477 478 END SUBROUTINE dyn_vrt_dia 479 480 340 481 !!====================================================================== 341 482 END MODULE divcur -
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r6486 r7649 36 36 USE trd_oce ! trends: ocean variables 37 37 USE trddyn ! trend manager: dynamics 38 USE divcur ! for dyn_vrt_dia 38 39 ! 39 40 USE in_out_manager ! I/O manager … … 378 379 INTEGER, INTENT(in) :: kt ! ocean time-step index 379 380 !! 381 INTEGER :: id_dia_vrt_hpg_int = 1 ! TODO remove once flags set properly 382 INTEGER :: id_dia_vrt_hpg_mean = 1 ! TODO remove once flags set properly 380 383 INTEGER :: ji, jj, jk ! dummy loop indices 381 384 REAL(wp) :: zcoef0, zuap, zvap, znad ! temporary scalars … … 401 404 DO jj = 2, jpjm1 402 405 DO ji = fs_2, fs_jpim1 ! vector opt. 403 ! hydrostatic pressure gradient along s-surfaces404 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) ) )408 406 ! s-coordinate pressure gradient correction 409 407 zuap = -zcoef0 * ( rhd (ji+1,jj,1) + rhd (ji,jj,1) + 2._wp * znad ) & … … 411 409 zvap = -zcoef0 * ( rhd (ji,jj+1,1) + rhd (ji,jj,1) + 2._wp * znad ) & 412 410 & * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj) 411 ! hydrostatic pressure gradient along s-surfaces 412 zhpi(ji,jj,1) = zuap + zcoef0 / e1u(ji,jj) * ( fse3w(ji+1,jj ,1) * ( znad + rhd(ji+1,jj ,1) ) & 413 & - fse3w(ji ,jj ,1) * ( znad + rhd(ji ,jj ,1) ) ) 414 zhpj(ji,jj,1) = zvap + zcoef0 / e2v(ji,jj) * ( fse3w(ji ,jj+1,1) * ( znad + rhd(ji ,jj+1,1) ) & 415 & - fse3w(ji ,jj ,1) * ( znad + rhd(ji ,jj ,1) ) ) 413 416 ! add to the general momentum trend 414 ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap415 va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) + zvap417 ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) 418 va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) 416 419 END DO 417 420 END DO … … 421 424 DO jj = 2, jpjm1 422 425 DO ji = fs_2, fs_jpim1 ! vector opt. 423 ! hydrostatic pressure gradient along s-surfaces424 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 ) )430 426 ! s-coordinate pressure gradient correction 431 427 zuap = -zcoef0 * ( rhd (ji+1,jj ,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & … … 433 429 zvap = -zcoef0 * ( rhd (ji ,jj+1,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & 434 430 & * ( fsde3w(ji ,jj+1,jk) - fsde3w(ji,jj,jk) ) / e2v(ji,jj) 431 ! hydrostatic pressure gradient along s-surfaces with correction 432 zhpi(ji,jj,jk) = zuap + zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj) & 433 & * ( fse3w(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) & 434 & - fse3w(ji ,jj,jk) * ( rhd(ji ,jj,jk) + rhd(ji ,jj,jk-1) + 2*znad ) ) 435 zhpj(ji,jj,jk) = zvap + zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj) & 436 & * ( fse3w(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) & 437 & - fse3w(ji,jj ,jk) * ( rhd(ji,jj, jk) + rhd(ji,jj ,jk-1) + 2*znad ) ) 435 438 ! add to the general momentum trend 436 ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap437 va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) + zvap439 ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) 440 va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) 438 441 END DO 439 442 END DO 440 443 END DO 444 ! 445 ! calculate dia_vor_int & dia_vor_mn if required 446 IF ( ( id_dia_vrt_hpg_int == 1 ) .or. ( id_dia_vrt_hpg_mean == 1 ) ) THEN 447 CALL dyn_vrt_dia(zhpi, zhpj, id_dia_vrt_hpg_int, id_dia_vrt_hpg_mean) 448 END IF 441 449 ! 442 450 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) -
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
r6486 r7649 17 17 USE trd_oce ! trends: ocean variables 18 18 USE trddyn ! trend manager: dynamics 19 USE divcur ! for dyn_vrt_dia 19 20 ! 20 21 USE in_out_manager ! I/O manager … … 71 72 !! Hollingsworth et al., Quart. J. Roy. Meteor. Soc., 1983. 72 73 !!---------------------------------------------------------------------- 73 INTEGER, INTENT( in ) :: kt ! ocean time-step index74 INTEGER, INTENT( in ) :: kscheme ! =0/1 type of KEG scheme74 INTEGER, INTENT( in ) :: kt ! ocean time-step index 75 INTEGER, INTENT( in ) :: kscheme ! =0/1 type of KEG scheme 75 76 ! 76 INTEGER :: ji, jj, jk ! dummy loop indices 77 REAL(wp) :: zu, zv ! temporary scalars 78 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhke 77 INTEGER :: id_dia_vrt_keg_int = 1 ! TODO remove once flags set properly 78 INTEGER :: id_dia_vrt_keg_mean = 1 ! TODO remove once flags set properly 79 INTEGER :: ji, jj, jk ! dummy loop indices 80 REAL(wp) :: zu, zv ! temporary scalars 81 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhke, zhkei, zhkej 79 82 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 80 83 !!---------------------------------------------------------------------- … … 82 85 IF( nn_timing == 1 ) CALL timing_start('dyn_keg') 83 86 ! 84 CALL wrk_alloc( jpi,jpj,jpk, zhke )87 CALL wrk_alloc( jpi,jpj,jpk, zhke, zhkei, zhkej ) 85 88 ! 86 89 IF( kt == nit000 ) THEN … … 137 140 DO jj = 2, jpjm1 138 141 DO ji = fs_2, fs_jpim1 ! vector opt. 139 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 140 va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 142 zhkei(ji,jj,jk) = - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 143 zhkej(ji,jj,jk) = - ( zhke(ji ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 144 ua(ji,jj,jk) = ua(ji,jj,jk) + zhkei(ji,jj,jk) 145 va(ji,jj,jk) = va(ji,jj,jk) + zhkej(ji,jj,jk) 141 146 END DO 142 147 END DO 143 148 END DO 149 ! 150 IF ( ( id_dia_vrt_keg_int == 1 ) .or. ( id_dia_vrt_keg_mean == 1 ) ) THEN 151 CALL dyn_vrt_dia(zhkei, zhkej, id_dia_vrt_keg_int, id_dia_vrt_keg_mean) 152 END IF 144 153 ! 145 154 IF( l_trddyn ) THEN ! save the Kinetic Energy trends for diagnostic … … 153 162 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 154 163 ! 155 CALL wrk_dealloc( jpi,jpj,jpk, zhke )164 CALL wrk_dealloc( jpi,jpj,jpk, zhke, zhkei, zhkej ) 156 165 ! 157 166 IF( nn_timing == 1 ) CALL timing_stop('dyn_keg') -
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90
r6486 r7649 19 19 USE dom_oce ! ocean space and time domain 20 20 USE ldfdyn_oce ! ocean dynamics: lateral physics 21 USE divcur ! for dyn_vrt_dia 21 22 ! 22 23 USE in_out_manager ! I/O manager … … 75 76 INTEGER, INTENT(in) :: kt ! ocean time-step index 76 77 ! 78 INTEGER :: id_dia_vrt_ldf_int = 1 ! TODO remove once flags set properly 79 INTEGER :: id_dia_vrt_ldf_mean = 1 ! TODO remove once flags set properly 77 80 INTEGER :: ji, jj, jk ! dummy loop indices 78 REAL(wp) :: z ua, zva, zbt, ze2u, ze2v! temporary scalar81 REAL(wp) :: zbt, ze2u, ze2v ! temporary scalar 79 82 REAL(wp), POINTER, DIMENSION(:,: ) :: zcu, zcv 80 REAL(wp), POINTER, DIMENSION(:,:,:) :: zuf, zut, zlu, zlv 83 REAL(wp), POINTER, DIMENSION(:,:,:) :: zuf, zut, zlu, zlv, zua, zva 81 84 !!---------------------------------------------------------------------- 82 85 ! … … 84 87 ! 85 88 CALL wrk_alloc( jpi, jpj, zcu, zcv ) 86 CALL wrk_alloc( jpi, jpj, jpk, zuf, zut, zlu, zlv )89 CALL wrk_alloc( jpi, jpj, jpk, zuf, zut, zlu, zlv, zua, zva ) 87 90 ! 88 91 IF( kt == nit000 .AND. lwp ) THEN … … 191 194 ze2v = e1v(ji,jj) * fse3v(ji,jj,jk) 192 195 ! horizontal biharmonic diffusive trends 193 zua = - ( zuf(ji ,jj,jk) - zuf(ji,jj-1,jk) ) / ze2u & 194 & + ( zut(ji+1,jj,jk) - zut(ji,jj ,jk) ) / e1u(ji,jj) 195 196 zva = + ( zuf(ji,jj ,jk) - zuf(ji-1,jj,jk) ) / ze2v & 197 & + ( zut(ji,jj+1,jk) - zut(ji ,jj,jk) ) / e2v(ji,jj) 196 zua(ji,jj,jk) = - ( zuf(ji ,jj,jk) - zuf(ji,jj-1,jk) ) / ze2u & 197 & + ( zut(ji+1,jj,jk) - zut(ji,jj ,jk) ) / e1u(ji,jj) & 198 & * ( fsahmu(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag )) 199 zva(ji,jj,jk) = + ( zuf(ji,jj ,jk) - zuf(ji-1,jj,jk) ) / ze2v & 200 & + ( zut(ji,jj+1,jk) - zut(ji ,jj,jk) ) / e2v(ji,jj) & 201 & * ( fsahmv(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag )) 198 202 ! add it to the general momentum trends 199 ua(ji,jj,jk) = ua(ji,jj,jk) + zua * ( fsahmu(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag ))200 va(ji,jj,jk) = va(ji,jj,jk) + zva * ( fsahmv(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag ))203 ua(ji,jj,jk) = ua(ji,jj,jk) + zua(ji,jj,jk) 204 va(ji,jj,jk) = va(ji,jj,jk) + zva(ji,jj,jk) 201 205 END DO 202 206 END DO … … 205 209 END DO ! End of slab 206 210 ! ! =============== 211 IF ( ( id_dia_vrt_ldf_int == 1 ) .or. ( id_dia_vrt_ldf_mean == 1 ) ) THEN 212 CALL dyn_vrt_dia(zua, zva, id_dia_vrt_ldf_int, id_dia_vrt_ldf_mean) 213 END IF 214 ! 207 215 CALL wrk_dealloc( jpi, jpj, zcu, zcv ) 208 CALL wrk_dealloc( jpi, jpj, jpk, zuf, zut, zlu, zlv )216 CALL wrk_dealloc( jpi, jpj, jpk, zuf, zut, zlu, zlv, zua, zva ) 209 217 ! 210 218 IF( nn_timing == 1 ) CALL timing_stop('dyn_ldf_bilap') -
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r6486 r7649 38 38 USE wrk_nemo ! Memory Allocation 39 39 USE timing ! Timing 40 USE divcur ! For dyn_vrt_dia 40 41 41 42 … … 560 561 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pva ! total v-trend 561 562 !! 563 INTEGER :: id_dia_vrt_vor_int = 1 ! TODO remove once flags set properly 564 INTEGER :: id_dia_vrt_vor_mn = 1 ! TODO remove once flags set properly 562 565 INTEGER :: ji, jj, jk ! dummy loop indices 563 566 INTEGER :: ierr ! local integer 564 REAL(wp) :: zfac12 , zua, zva! local scalars567 REAL(wp) :: zfac12 ! local scalars 565 568 REAL(wp) :: zmsk, ze3 ! local scalars 566 569 ! ! 3D workspace 567 570 REAL(wp), POINTER , DIMENSION(:,: ) :: zwx, zwy, zwz 568 571 REAL(wp), POINTER , DIMENSION(:,: ) :: ztnw, ztne, ztsw, ztse 572 REAL(wp), POINTER , DIMENSION(:,:,:) :: zua, zva 569 573 #if defined key_vvl 570 574 REAL(wp), POINTER , DIMENSION(:,:,:) :: ze3f ! 3D workspace (lk_vvl=T) … … 578 582 CALL wrk_alloc( jpi, jpj, zwx , zwy , zwz ) 579 583 CALL wrk_alloc( jpi, jpj, ztnw, ztne, ztsw, ztse ) 584 CALL wrk_alloc( jpi, jpj, jpk, zua, zva ) 580 585 #if defined key_vvl 581 586 CALL wrk_alloc( jpi, jpj, jpk, ze3f ) … … 687 692 DO jj = 2, jpjm1 688 693 DO ji = fs_2, fs_jpim1 ! vector opt. 689 zua = + zfac12 / e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) & 690 & + ztse(ji,jj ) * zwy(ji ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) 691 zva = - zfac12 / e2v(ji,jj) * ( ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji ,jj+1) & 692 & + ztnw(ji,jj ) * zwx(ji-1,jj ) + ztne(ji,jj ) * zwx(ji ,jj ) ) 693 pua(ji,jj,jk) = pua(ji,jj,jk) + zua 694 pva(ji,jj,jk) = pva(ji,jj,jk) + zva 694 zua(ji,jj,jk) = + zfac12 / e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) & 695 & + ztnw(ji+1,jj) * zwy(ji+1,jj ) & 696 & + ztse(ji,jj ) * zwy(ji ,jj-1) & 697 & + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) 698 zva(ji,jj,jk) = - zfac12 / e2v(ji,jj) * ( ztsw(ji,jj+1) * zwx(ji-1,jj+1) & 699 & + ztse(ji,jj+1) * zwx(ji ,jj+1) & 700 & + ztnw(ji,jj ) * zwx(ji-1,jj ) & 701 & + ztne(ji,jj ) * zwx(ji ,jj ) ) 702 pua(ji,jj,jk) = pua(ji,jj,jk) + zua(ji,jj,jk) 703 pva(ji,jj,jk) = pva(ji,jj,jk) + zva(ji,jj,jk) 695 704 END DO 696 705 END DO … … 698 707 END DO ! End of slab 699 708 ! ! =============== 709 IF ( ( id_dia_vrt_vor_int == 1 ) .or. ( id_dia_vrt_vor_mn == 1 ) ) THEN 710 CALL dyn_vrt_dia(zua, zva, id_dia_vrt_vor_int, id_dia_vrt_vor_mn) 711 END IF 712 ! 700 713 CALL wrk_dealloc( jpi, jpj, zwx , zwy , zwz ) 701 714 CALL wrk_dealloc( jpi, jpj, ztnw, ztne, ztsw, ztse ) 715 CALL wrk_dealloc( jpi, jpj, jpk, zua, zva ) 702 716 #if defined key_vvl 703 717 CALL wrk_dealloc( jpi, jpj, jpk, ze3f ) -
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
r6486 r7649 18 18 USE trd_oce ! trends: ocean variables 19 19 USE trddyn ! trend manager: dynamics 20 USE divcur ! for dyn_vrt_dia 20 21 ! 21 22 USE in_out_manager ! I/O manager … … 59 60 INTEGER, INTENT(in) :: kt ! ocean time-step inedx 60 61 ! 61 INTEGER :: ji, jj, jk ! dummy loop indices 62 REAL(wp) :: zua, zva ! temporary scalars 62 INTEGER :: id_dia_vrt_zad_int = 1 ! TODO remove once flags set properly 63 INTEGER :: id_dia_vrt_zad_mean = 1 ! TODO remove once flags set properly 64 INTEGER :: ji, jj, jk ! dummy loop indices 63 65 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwuw , zwvw 64 66 REAL(wp), POINTER, DIMENSION(:,: ) :: zww 65 67 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 68 REAL(wp), POINTER, DIMENSION(:,:,:) :: zua, zva 66 69 !!---------------------------------------------------------------------- 67 70 ! … … 69 72 ! 70 73 CALL wrk_alloc( jpi,jpj, zww ) 71 CALL wrk_alloc( jpi,jpj,jpk, zwuw , zwvw )74 CALL wrk_alloc( jpi,jpj,jpk, zwuw , zwvw, zua, zva ) 72 75 ! 73 76 IF( kt == nit000 ) THEN … … 121 124 DO ji = fs_2, fs_jpim1 ! vector opt. 122 125 ! ! vertical momentum advective trends 123 zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 124 zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 126 zua(ji,jj,jk) = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / & 127 & ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 128 zva(ji,jj,jk) = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / & 129 & ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 125 130 ! ! add the trends to the general momentum trends 126 ua(ji,jj,jk) = ua(ji,jj,jk) + zua 127 va(ji,jj,jk) = va(ji,jj,jk) + zva 131 ua(ji,jj,jk) = ua(ji,jj,jk) + zua(ji,jj,jk) 132 va(ji,jj,jk) = va(ji,jj,jk) + zva(ji,jj,jk) 128 133 END DO 129 134 END DO … … 140 145 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 141 146 ! 147 IF ( ( id_dia_vrt_zad_int == 1 ) .or. ( id_dia_vrt_zad_mean == 1 ) ) THEN 148 CALL dyn_vrt_dia(zua, zva, id_dia_vrt_zad_int, id_dia_vrt_zad_mean) 149 END IF 150 ! 142 151 CALL wrk_dealloc( jpi,jpj, zww ) 143 CALL wrk_dealloc( jpi,jpj,jpk, zwuw , zwvw )152 CALL wrk_dealloc( jpi,jpj,jpk, zwuw , zwvw, zua, zva ) 144 153 ! 145 154 IF( nn_timing == 1 ) CALL timing_stop('dyn_zad')
Note: See TracChangeset
for help on using the changeset viewer.
