Changeset 8300 for branches/UKMO
- Timestamp:
- 2017-07-08T17:26:56+02:00 (7 years ago)
- Location:
- branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM
- Files:
-
- 14 edited
-
CONFIG/SHARED/field_def.xml (modified) (1 diff)
-
NEMO/OPA_SRC/DYN/divcur.F90 (modified) (11 diffs)
-
NEMO/OPA_SRC/DYN/dynbfr.F90 (modified) (4 diffs)
-
NEMO/OPA_SRC/DYN/dynhpg.F90 (modified) (6 diffs)
-
NEMO/OPA_SRC/DYN/dynkeg.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/DYN/dynldf.F90 (modified) (4 diffs)
-
NEMO/OPA_SRC/DYN/dynldf_bilap.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/DYN/dynnxt.F90 (modified) (4 diffs)
-
NEMO/OPA_SRC/DYN/dynspg.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/DYN/dynspg_flt.F90 (modified) (6 diffs)
-
NEMO/OPA_SRC/DYN/dynvor.F90 (modified) (19 diffs)
-
NEMO/OPA_SRC/DYN/dynzad.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/DYN/dynzdf.F90 (modified) (4 diffs)
-
NEMO/OPA_SRC/DYN/dynzdf_imp.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/CONFIG/SHARED/field_def.xml
r8197 r8300 508 508 <field id="dia_vor_int-spg" long_name="vertical integral vorticity tendencies for spg" standard_name="vertically_integrated_vorticity_tendencies_spg" unit="s-2" grid_ref="grid_W_2D" /> 509 509 <field id="dia_vor_mean-spg" long_name="vertical mean vorticity tendencies for spg" standard_name="vertical_mean_vorticity_tendencies_spg" unit="s-2" grid_ref="grid_W_2D" /> 510 <field id="dia_vor_int-vor" long_name="vertical integral vorticity tendencies for vor" standard_name="vertically_integrated_vorticity_tendencies_vor" unit="s-2" grid_ref="grid_W_2D" /> 511 <field id="dia_vor_mean-vor" long_name="vertical mean vorticity tendencies for vor" standard_name="vertical_mean_vorticity_tendencies_vor" unit="s-2" grid_ref="grid_W_2D" /> 510 <field id="dia_vor_int-rvo" long_name="vertical integral vorticity tendencies for rvo" standard_name="vertically_integrated_vorticity_tendencies_rvo" unit="s-2" grid_ref="grid_W_2D" /> 511 <field id="dia_vor_mean-rvo" long_name="vertical mean vorticity tendencies for rvo" standard_name="vertical_mean_vorticity_tendencies_rvo" unit="s-2" grid_ref="grid_W_2D" /> 512 <field id="dia_vor_int-pvo" long_name="vertical integral vorticity tendencies for pvo" standard_name="vertically_integrated_vorticity_tendencies_pvo" unit="s-2" grid_ref="grid_W_2D" /> 513 <field id="dia_vor_mean-pvo" long_name="vertical mean vorticity tendencies for pvo" standard_name="vertical_mean_vorticity_tendencies_pvo" unit="s-2" grid_ref="grid_W_2D" /> 512 514 <field id="dia_vor_int-zad" long_name="vertical integral vorticity tendencies for zad" standard_name="vertically_integrated_vorticity_tendencies_zad" unit="s-2" grid_ref="grid_W_2D" /> 513 515 <field id="dia_vor_mean-zad" long_name="vertical mean vorticity tendencies for zad" standard_name="vertical_mean_vorticity_tendencies_zad" unit="s-2" grid_ref="grid_W_2D" /> 514 516 <field id="dia_vor_int-zdf" long_name="vertical integral vorticity tendencies for zdf" standard_name="vertically_integrated_vorticity_tendencies_zdf" unit="s-2" grid_ref="grid_W_2D" /> 515 517 <field id="dia_vor_mean-zdf" long_name="vertical mean vorticity tendencies for zdf" standard_name="vertical_mean_vorticity_tendencies_zdf" unit="s-2" grid_ref="grid_W_2D" /> 518 <field id="dia_vor_int-bfr" long_name="vertical integral vorticity tendencies for bfr" standard_name="vertically_integrated_vorticity_tendencies_bfr" unit="s-2" grid_ref="grid_W_2D" /> 519 <field id="dia_vor_mean-bfr" long_name="vertical mean vorticity tendencies for bfr" standard_name="vertical_mean_vorticity_tendencies_bfr" unit="s-2" grid_ref="grid_W_2D" /> 520 <field id="dia_vor_int-atf" long_name="vertical integral vorticity tendencies for atf" standard_name="vertically_integrated_vorticity_tendencies_atf" unit="s-2" grid_ref="grid_W_2D" /> 521 <field id="dia_vor_mean-atf" long_name="vertical mean vorticity tendencies for atf" standard_name="vertical_mean_vorticity_tendencies_atf" unit="s-2" grid_ref="grid_W_2D" /> 516 522 </field_group> 517 523 -
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
r8197 r8300 343 343 344 344 345 ! TODO - remove kt only used for validation 346 SUBROUTINE dyn_vrt_dia_3d( utend, vtend, id_dia_vor, kt) 345 SUBROUTINE dyn_vrt_dia_3d( utend, vtend, id_dia_vor) 347 346 348 347 !!---------------------------------------------------------------------- … … 360 359 REAL :: vtend(jpi,jpj,jpk) ! contribution to dv/dt 361 360 CHARACTER(len=3) :: id_dia_vor ! identifier for the diagnostic 362 INTEGER :: kt ! ocean time-step index TODO remove after validation363 361 ! 364 362 !!---------------------------------------------------------------------- … … 378 376 ! Calculate the vertical integrals of utend & of vtend 379 377 ! 380 ! TODO remove - for validation only381 IF ( kt == 1 ) THEN382 WRITE(numout, *) 'dyn_vrt_dia_3d id:', id_dia_vor, &383 & ':bathy:', bathy(17,12), &384 & ':mbathy:', mbathy(17,12)385 END IF386 387 378 DO jk = 1, jpkm1 388 379 DO jj = 2, jpjm1 … … 392 383 v_int(ji,jj) = v_int(ji,jj) + ( vtend(ji,jj,jk) * fse3v(ji,jj,jk) & 393 384 & * e2v(ji,jj) * vmask(ji,jj,jk) ) 394 395 ! TODO remove - for validation only396 IF ( kt == 1 .AND. ji == 17 .AND. jj == 12 ) THEN397 WRITE(numout, *) 'dyn_vrt_dia_3d id:', id_dia_vor, &398 & ' :ji: ', ji, &399 & ' :jj: ', jj, &400 & ' :jk: ', jk, &401 & ' :u_int:', u_int(ji,jj), &402 & ' :u_tend: ', utend(ji,jj,jk), &403 & ' :e1u: ', e1u(ji,jj), &404 & ' :umask: ', umask(ji,jj,jk), &405 & ' :fse3u: ', fse3u(ji,jj,jk)406 WRITE(numout, *) 'dyn_vrt_dia_3d id:', id_dia_vor, &407 & ' :ji: ', ji, &408 & ' :jj: ', jj, &409 & ' :jk: ', jk, &410 & ' :v_int:', v_int(ji,jj), &411 & ' :v_tend: ', vtend(ji,jj,jk), &412 & ' :e2v: ', e2v(ji,jj), &413 & ' :vmask: ', vmask(ji,jj,jk), &414 & ' :fse3v: ', fse3v(ji,jj,jk)415 END IF416 385 END DO 417 386 END DO 418 387 END DO 419 388 420 CALL dyn_vrt_dia_2d(u_int, v_int, id_dia_vor , kt)389 CALL dyn_vrt_dia_2d(u_int, v_int, id_dia_vor) 421 390 422 391 CALL wrk_dealloc(jpi, jpj, u_int) … … 426 395 427 396 428 ! TODO - remove kt only used for validation 429 SUBROUTINE dyn_vrt_dia_2d( u_int, v_int, id_dia_vor, kt) 397 SUBROUTINE dyn_vrt_dia_2d( u_int, v_int, id_dia_vor) 430 398 431 399 !!---------------------------------------------------------------------- … … 448 416 REAL :: v_int(jpi,jpj) ! v vertical integral 449 417 CHARACTER(len=3) :: id_dia_vor ! identifier for the vorticity diagnostic 450 INTEGER :: kt ! ocean time-step index TODO remove after validation451 418 ! 452 419 !!---------------------------------------------------------------------- … … 483 450 & - ( u_int(ji,jj+1) - u_int(ji,jj) ) ) & 484 451 & / ( e1f(ji,jj) * e2f(ji,jj) ) 485 486 ! TODO remove - for validation only487 IF ( kt == 1 .AND. ji == 17 .AND. jj == 12 ) THEN488 WRITE(numout, *) 'dyn_vrt_dia_2d id:', id_dia_vor, &489 & ':ji:', ji, &490 & ':jj:', jj, &491 & ':vor_int:', vor_int(ji,jj), &492 & ':v_int(i+1):', v_int(ji+1,jj), &493 & ':v_int:', v_int(ji,jj), &494 & ':u_int:', u_int(ji,jj), &495 & ':u_int(j+1):', u_int(ji,jj+1), &496 & ':e1f:', e1f(ji,jj), &497 & ':e2f:', e2f(ji,jj)498 END IF499 452 END DO 500 453 END DO … … 514 467 ikbv = mbkv(ji,jj) 515 468 516 IF ( ikbu.ne. 0.0_wp) THEN ! Don't divide by 0!469 IF (gdepw_n(ji,jj,ikbu+1) .ne. 0.0_wp) THEN ! Don't divide by 0! 517 470 u_mn(ji,jj) = u_int(ji,jj) / gdepw_n(ji,jj,ikbu+1) 518 471 ELSE … … 520 473 END IF 521 474 522 IF ( ikbv.ne. 0.0_wp) THEN ! Don't divide by 0!475 IF (gdepw_n(ji,jj,ikbv+1) .ne. 0.0_wp) THEN ! Don't divide by 0! 523 476 v_mn(ji,jj) = v_int(ji,jj) / gdepw_n(ji,jj,ikbv+1) 524 477 ELSE 525 478 v_mn(ji,jj) = 0.0_wp 526 END IF527 528 ! TODO remove - for validation only529 IF ( kt == 1 .AND. ji == 17 .AND. jj == 12 ) THEN530 WRITE(numout, *) 'dyn_vrt_dia_2d id:', id_dia_vor, &531 & ':gdepw_n(ikbu):', gdepw_n(ji,jj,ikbu+1), &532 & ':u_int:', u_int(ji,jj), &533 & ':u_mn:', u_mn(ji,jj), &534 & ':gdepw_n(ikbv):', gdepw_n(ji,jj,ikbv+1), &535 & ':v_int:', v_int(ji,jj), &536 & ':v_mn:', v_mn(ji,jj)537 479 END IF 538 480 END DO … … 549 491 & - ( u_mn(ji,jj+1) - u_mn(ji,jj) ) ) & 550 492 & / ( e1f(ji,jj) * e2f(ji,jj) ) 551 552 ! TODO remove - for validation only553 IF ( kt == 1 .AND. ji == 17 .AND. jj == 12 ) THEN554 WRITE(numout, *) 'dyn_vrt_dia_2d id:', id_dia_vor, &555 & ':ji:', ji, &556 & ':jj:', jj, &557 & ':vor_mn:', vor_mn(ji,jj), &558 & ':v_mn(i+1):', v_mn(ji+1,jj), &559 & ':v_mn:', v_mn(ji,jj), &560 & ':u_mn:', u_mn(ji,jj), &561 & ':u_mn(j+1):', u_mn(ji,jj+1), &562 & ':e1f:', e1f(ji,jj), &563 & ':e2f:', e2f(ji,jj)564 END IF565 493 END DO 566 494 END DO … … 568 496 ! Multiply by the surface mask 569 497 vor_mn(:,:) = vor_mn(:,:) * fmask(:,:,1) 570 571 498 572 499 ! Call iom_put for the vertical integral vorticity tendencies -
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
r6486 r8300 22 22 USE timing ! Timing 23 23 USE wrk_nemo ! Memory Allocation 24 USE divcur ! for dyn_vrt_dia 24 25 25 26 IMPLICIT NONE … … 52 53 INTEGER :: ikbu, ikbv ! local integers 53 54 REAL(wp) :: zm1_2dt ! local scalar 55 CHARACTER(len=3) :: id_dyn_vrt_bfr = "bfr" ! TODO remove once flags set properly 54 56 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 55 57 !!--------------------------------------------------------------------- … … 65 67 zm1_2dt = - 1._wp / ( 2._wp * rdt ) 66 68 67 IF( l_trddyn ) THEN ! temporary save of ua and va trends69 IF( l_trddyn .OR. ( id_dyn_vrt_bfr == "bfr" ) ) THEN ! temporary save of ua and va trends 68 70 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 69 71 ztrdu(:,:,:) = ua(:,:,:) … … 101 103 102 104 ! 103 IF( l_trddyn ) THEN ! save the vertical diffusive trends for further diagnostics105 IF( l_trddyn .OR. ( id_dyn_vrt_bfr == "bfr" ) ) THEN ! save the vertical diffusive trends for further diagnostics 104 106 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 105 107 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 106 CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt ) 108 IF( l_trddyn ) THEN 109 CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt ) 110 ENDIF 111 IF( id_dyn_vrt_bfr == "bfr" ) THEN 112 CALL dyn_vrt_dia_3d( ztrdu, ztrdv, id_dyn_vrt_bfr ) 113 ENDIF 107 114 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 108 115 ENDIF -
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r8197 r8300 83 83 !! - send trends to trd_dyn for futher diagnostics (l_trddyn=T) 84 84 !!---------------------------------------------------------------------- 85 INTEGER, INTENT(in) :: kt ! ocean time-step index 85 INTEGER, INTENT(in) :: kt ! ocean time-step index 86 CHARACTER(len=3) :: id_vrt_dia_hpg = "hpg" ! TODO remove once flags set properly 86 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 87 88 !!---------------------------------------------------------------------- … … 89 90 IF( nn_timing == 1 ) CALL timing_start('dyn_hpg') 90 91 ! 91 IF( l_trddyn ) THEN! Temporary saving of ua and va trends (l_trddyn)92 IF( l_trddyn .or. ( id_vrt_dia_hpg == "hpg" ) ) THEN ! Temporary saving of ua and va trends (l_trddyn) 92 93 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 93 94 ztrdu(:,:,:) = ua(:,:,:) … … 104 105 END SELECT 105 106 ! 106 IF( l_trddyn ) THEN ! save the hydrostatic pressure gradient trends for momentum trend diagnostics107 IF( l_trddyn .or. ( id_vrt_dia_hpg == "hpg" ) ) THEN ! save the hydrostatic pressure gradient trends for momentum trend diagnostics 107 108 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 108 109 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 109 CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt ) 110 ! 111 IF( id_vrt_dia_hpg == "hpg" ) THEN 112 CALL dyn_vrt_dia_3d( ztrdu, ztrdv, id_vrt_dia_hpg ) 113 END IF 114 IF( l_trddyn ) THEN 115 CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt ) 116 END IF 110 117 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 111 118 ENDIF … … 379 386 INTEGER, INTENT(in) :: kt ! ocean time-step index 380 387 !! 381 CHARACTER(len=3) :: id_vrt_dia_hpg = "hpg" ! TODO remove once flags set properly382 388 INTEGER :: ji, jj, jk ! dummy loop indices 383 389 REAL(wp) :: zcoef0, zuap, zvap, znad ! temporary scalars 384 390 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zhpj 385 REAL(wp), POINTER, DIMENSION(:,:,:) :: zuhpg, zvhpg386 391 !!---------------------------------------------------------------------- 387 392 ! 388 393 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj ) 389 CALL wrk_alloc( jpi,jpj,jpk, zuhpg, zvhpg )390 394 ! 391 395 IF( kt == nit000 ) THEN … … 415 419 zvap = -zcoef0 * ( rhd (ji,jj+1,1) + rhd (ji,jj,1) + 2._wp * znad ) & 416 420 & * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj) 417 ! combine gradient and correction418 zuhpg(ji,jj,1) = zhpi(ji,jj,1) + zuap419 zvhpg(ji,jj,1) = zhpj(ji,jj,1) + zvap420 421 ! add to the general momentum trend 421 ua(ji,jj,1) = ua(ji,jj,1) + z uhpg(ji,jj,1)422 va(ji,jj,1) = va(ji,jj,1) + z vhpg(ji,jj,1)422 ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap 423 va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) + zvap 423 424 END DO 424 425 END DO … … 440 441 zvap = -zcoef0 * ( rhd (ji ,jj+1,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & 441 442 & * ( fsde3w(ji ,jj+1,jk) - fsde3w(ji,jj,jk) ) / e2v(ji,jj) 442 ! combine gradient and correction443 zuhpg(ji,jj,jk) = zhpi(ji,jj,jk) + zuap444 zvhpg(ji,jj,jk) = zhpj(ji,jj,jk) + zvap445 443 ! add to the general momentum trend 446 ua(ji,jj,jk) = ua(ji,jj,jk) + z uhpg(ji,jj,jk)447 va(ji,jj,jk) = va(ji,jj,jk) + z vhpg(ji,jj,jk)444 ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap 445 va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) + zvap 448 446 END DO 449 447 END DO 450 448 END DO 451 !452 ! calculate dia_vor_int & dia_vor_mn if required453 IF ( id_vrt_dia_hpg == "hpg" ) THEN454 ! TODO - remove kt only used for validation455 CALL dyn_vrt_dia_3d(zuhpg, zvhpg, id_vrt_dia_hpg, kt)456 END IF457 449 ! 458 450 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) -
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
r8197 r8300 72 72 !! Hollingsworth et al., Quart. J. Roy. Meteor. Soc., 1983. 73 73 !!---------------------------------------------------------------------- 74 INTEGER, INTENT( in ) :: kt 75 INTEGER, INTENT( in ) :: kscheme 74 INTEGER, INTENT( in ) :: kt ! ocean time-step index 75 INTEGER, INTENT( in ) :: kscheme ! =0/1 type of KEG scheme 76 76 ! 77 77 CHARACTER(len=3) :: id_vrt_dia_keg = "keg" ! TODO remove once flags set properly 78 INTEGER :: ji, jj, jk! dummy loop indices79 REAL(wp) :: zu, zv! temporary scalars80 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhke , zhkei, zhkej78 INTEGER :: ji, jj, jk ! dummy loop indices 79 REAL(wp) :: zu, zv ! temporary scalars 80 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhke 81 81 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 82 82 !!---------------------------------------------------------------------- … … 84 84 IF( nn_timing == 1 ) CALL timing_start('dyn_keg') 85 85 ! 86 CALL wrk_alloc( jpi,jpj,jpk, zhke , zhkei, zhkej)86 CALL wrk_alloc( jpi,jpj,jpk, zhke ) 87 87 ! 88 88 IF( kt == nit000 ) THEN … … 92 92 ENDIF 93 93 94 IF( l_trddyn ) THEN ! Save ua and va trends94 IF( l_trddyn .or. ( id_vrt_dia_keg == "keg" ) ) THEN ! Save ua and va trends 95 95 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 96 96 ztrdu(:,:,:) = ua(:,:,:) … … 139 139 DO jj = 2, jpjm1 140 140 DO ji = fs_2, fs_jpim1 ! vector opt. 141 zhkei(ji,jj,jk) = - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 142 zhkej(ji,jj,jk) = - ( zhke(ji ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 143 ua(ji,jj,jk) = ua(ji,jj,jk) + zhkei(ji,jj,jk) 144 va(ji,jj,jk) = va(ji,jj,jk) + zhkej(ji,jj,jk) 141 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 142 va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 145 143 END DO 146 144 END DO 147 145 END DO 148 146 ! 149 IF ( id_vrt_dia_keg == "keg" ) THEN 150 ! TODO - remove kt only used for validation 151 CALL dyn_vrt_dia_3d(zhkei, zhkej, id_vrt_dia_keg, kt) 152 END IF 153 ! 154 IF( l_trddyn ) THEN ! save the Kinetic Energy trends for diagnostic 147 IF( l_trddyn .or. ( id_vrt_dia_keg == "keg" ) ) THEN ! save the Kinetic Energy trends for diagnostic 155 148 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 156 149 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 157 CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 150 ! 151 IF( id_vrt_dia_keg == "keg" ) THEN 152 CALL dyn_vrt_dia_3d( ztrdu, ztrdv, id_vrt_dia_keg ) 153 END IF 154 ! 155 IF( l_trddyn ) THEN 156 CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 157 END IF 158 ! 158 159 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 159 160 ENDIF … … 162 163 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 163 164 ! 164 CALL wrk_dealloc( jpi,jpj,jpk, zhke , zhkei, zhkej)165 CALL wrk_dealloc( jpi,jpj,jpk, zhke ) 165 166 ! 166 167 IF( nn_timing == 1 ) CALL timing_stop('dyn_keg') -
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
r6486 r8300 28 28 USE lib_mpp ! distribued memory computing library 29 29 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 30 USE wrk_nemo ! Memory Allocation 31 USE timing ! Timing 30 USE wrk_nemo ! Memory Allocation 31 USE timing ! Timing 32 USE divcur ! Used by dyn_vrt_dia 32 33 33 34 IMPLICIT NONE … … 57 58 INTEGER, INTENT(in) :: kt ! ocean time-step index 58 59 ! 60 CHARACTER(len=3) :: id_vrt_dia_ldf = "ldf" ! TODO Replace once proper flags in place 59 61 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 60 62 !!---------------------------------------------------------------------- … … 62 64 IF( nn_timing == 1 ) CALL timing_start('dyn_ldf') 63 65 ! 64 IF( l_trddyn ) THEN! temporary save of ta and sa trends66 IF( l_trddyn .or. ( id_vrt_dia_ldf == "ldf" ) ) THEN ! temporary save of ta and sa trends 65 67 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 66 68 ztrdu(:,:,:) = ua(:,:,:) … … 103 105 END SELECT 104 106 105 IF( l_trddyn ) THEN! save the horizontal diffusive trends for further diagnostics107 IF( l_trddyn .or. ( id_vrt_dia_ldf == "ldf" ) ) THEN ! save the horizontal diffusive trends for further diagnostics 106 108 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 107 109 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 108 CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt ) 110 IF( id_vrt_dia_ldf == "ldf" ) THEN 111 CALL dyn_vrt_dia_3d( ztrdu, ztrdv, id_vrt_dia_ldf ) 112 END IF 113 IF( l_trddyn ) THEN 114 CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt ) 115 END IF 109 116 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) 110 117 ENDIF -
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90
r8197 r8300 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_3d22 21 ! 23 22 USE in_out_manager ! I/O manager … … 76 75 INTEGER, INTENT(in) :: kt ! ocean time-step index 77 76 ! 78 CHARACTER(len=3) :: id_vrt_dia_ldf = "ldf" ! TODO remove once flags set properly79 77 INTEGER :: ji, jj, jk ! dummy loop indices 80 REAL(wp) :: z bt, ze2u, ze2v! temporary scalar78 REAL(wp) :: zua, zva, zbt, ze2u, ze2v ! temporary scalar 81 79 REAL(wp), POINTER, DIMENSION(:,: ) :: zcu, zcv 82 REAL(wp), POINTER, DIMENSION(:,:,:) :: zuf, zut, zlu, zlv , zua, zva80 REAL(wp), POINTER, DIMENSION(:,:,:) :: zuf, zut, zlu, zlv 83 81 !!---------------------------------------------------------------------- 84 82 ! … … 86 84 ! 87 85 CALL wrk_alloc( jpi, jpj, zcu, zcv ) 88 CALL wrk_alloc( jpi, jpj, jpk, zuf, zut, zlu, zlv , zua, zva)86 CALL wrk_alloc( jpi, jpj, jpk, zuf, zut, zlu, zlv ) 89 87 ! 90 88 IF( kt == nit000 .AND. lwp ) THEN … … 192 190 ze2u = e2u(ji,jj) * fse3u(ji,jj,jk) 193 191 ze2v = e1v(ji,jj) * fse3v(ji,jj,jk) 194 ! horizontal biharmonic diffusive trends multiplied by the 195 ! eddy viscosity coef. (at u- and v-points) 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 )) 192 ! 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) 202 198 ! add it to the general momentum trends 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)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 )) 205 201 END DO 206 202 END DO … … 209 205 END DO ! End of slab 210 206 ! ! =============== 211 IF ( id_vrt_dia_ldf == "ldf" ) THEN212 ! TODO - remove kt only used for validation213 CALL dyn_vrt_dia_3d(zua, zva, id_vrt_dia_ldf, kt)214 END IF215 !216 207 CALL wrk_dealloc( jpi, jpj, zcu, zcv ) 217 CALL wrk_dealloc( jpi, jpj, jpk, zuf, zut, zlu, zlv , zua, zva)208 CALL wrk_dealloc( jpi, jpj, jpk, zuf, zut, zlu, zlv ) 218 209 ! 219 210 IF( nn_timing == 1 ) CALL timing_stop('dyn_ldf_bilap') -
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r6487 r8300 46 46 USE prtctl ! Print control 47 47 USE timing ! Timing 48 USE divcur ! for dyn_vrt_dia 48 49 #if defined key_agrif 49 50 USE agrif_opa_interp … … 106 107 REAL(wp) :: zue3a, zue3n, zue3b, zuf, zec ! local scalars 107 108 REAL(wp) :: zve3a, zve3n, zve3b, zvf, z1_2dt ! - - 109 CHARACTER(len=3) :: id_dyn_vrt_atf = "atf" ! TODO remove once flags done 108 110 REAL(wp), POINTER, DIMENSION(:,:) :: zue, zve 109 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3u_f, ze3v_f, zua, zva … … 203 205 #endif 204 206 205 IF( l_trddyn ) THEN ! prepare the atf trend computation + some diagnostics207 IF( l_trddyn .OR. ( id_dyn_vrt_atf == "atf" ) ) THEN ! prepare the atf trend computation + some diagnostics 206 208 z1_2dt = 1._wp / (2. * rdt) ! Euler or leap-frog time step 207 IF( neuler == 0 .AND. kt == nit000 ) z1_2dt = 1._wp / rdt 208 ! 209 ! ! Kinetic energy and Conversion 210 IF( ln_KE_trd ) CALL trd_dyn( ua, va, jpdyn_ken, kt ) 211 ! 212 IF( ln_dyn_trd ) THEN ! 3D output: total momentum trends 213 zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt 214 zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt 215 CALL iom_put( "utrd_tot", zua ) ! total momentum trends, except the asselin time filter 216 CALL iom_put( "vtrd_tot", zva ) 209 IF( l_trddyn ) THEN 210 IF( neuler == 0 .AND. kt == nit000 ) z1_2dt = 1._wp / rdt 211 ! 212 ! ! Kinetic energy and Conversion 213 IF( ln_KE_trd ) CALL trd_dyn( ua, va, jpdyn_ken, kt ) 214 ! 215 IF( ln_dyn_trd ) THEN ! 3D output: total momentum trends 216 zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt 217 zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt 218 CALL iom_put( "utrd_tot", zua ) ! total momentum trends, except the asselin time filter 219 CALL iom_put( "vtrd_tot", zva ) 220 ENDIF 217 221 ENDIF 218 222 ! … … 392 396 ! 393 397 394 IF( l_trddyn ) THEN ! 3D output: asselin filter trends on momentum398 IF( l_trddyn .OR. ( id_dyn_vrt_atf == "atf" ) ) THEN ! 3D output: asselin filter trends on momentum 395 399 zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt 396 400 zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt 397 CALL trd_dyn( zua, zva, jpdyn_atf, kt ) 401 IF( id_dyn_vrt_atf == "atf" ) THEN ! 3D output: asselin filter trends on momentum 402 CALL dyn_vrt_dia_3d( zua, zva, id_dyn_vrt_atf ) 403 ENDIF 404 IF( l_trddyn ) THEN ! 3D output: asselin filter trends on momentum 405 CALL trd_dyn( zua, zva, jpdyn_atf, kt ) 406 ENDIF 398 407 ENDIF 399 408 ! -
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r6486 r8300 35 35 USE wrk_nemo ! Memory Allocation 36 36 USE timing ! Timing 37 USE divcur ! for dyn_vrt_dia_3d 37 38 38 39 … … 89 90 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 90 91 REAL(wp), POINTER, DIMENSION(:,:) :: zpice 92 CHARACTER(len=3) :: id_vrt_dia_spg = "spg" ! TODO remove once flags set properly 91 93 !!---------------------------------------------------------------------- 92 94 ! … … 99 101 100 102 101 IF( l_trddyn ) THEN! temporary save of ta and sa trends103 IF( l_trddyn .or. ( id_vrt_dia_spg == "spg" ) ) THEN ! temporary save of ta and sa trends 102 104 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 103 105 ztrdu(:,:,:) = ua(:,:,:) … … 188 190 END SELECT 189 191 ! 190 IF( l_trddyn ) THEN! save the surface pressure gradient trends for further diagnostics192 IF( l_trddyn .or. ( id_vrt_dia_spg == "spg" ) ) THEN ! save the surface pressure gradient trends for further diagnostics 191 193 SELECT CASE ( nspg ) 192 194 CASE ( 0, 1 ) … … 199 201 ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / z2dt - ztrdv(:,:,:) 200 202 END SELECT 201 CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 203 ! 204 IF( id_vrt_dia_spg == "spg" ) THEN 205 CALL dyn_vrt_dia_3d( ztrdu, ztrdv, id_vrt_dia_spg ) 206 END IF 207 ! 208 IF( l_trddyn ) THEN 209 CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 210 END IF 202 211 ! 203 212 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) -
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r8197 r8300 48 48 USE lib_fortran 49 49 USE timing ! Timing 50 USE divcur ! for dyn_vrt_dia_3d51 50 #if defined key_agrif 52 51 USE agrif_opa_interp … … 109 108 INTEGER, INTENT( out) :: kindic ! solver convergence flag (<0 if not converge) 110 109 ! 111 CHARACTER(len=3) :: id_vrt_dia_spg = "spg" ! TODO remove once flags set properly112 110 INTEGER :: ji, jj, jk ! dummy loop indices 113 111 REAL(wp) :: z2dt, z2dtg, zgcb, zbtd, ztdgu, ztdgv ! local scalars … … 132 130 ! ! gcx, gcxb 133 131 ENDIF 134 135 IF ( l_trddyn .OR. ( id_vrt_dia_spg == "spg" ) ) THEN136 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )137 END IF138 132 139 133 ! Local constant initialization … … 190 184 END DO 191 185 ! 192 193 IF ( l_trddyn .OR. ( id_vrt_dia_spg == "spg" ) ) THEN186 IF( l_trddyn ) THEN ! temporary save of spg trends 187 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 194 188 DO jk = 1, jpkm1 ! unweighted time stepping 195 189 DO jj = 2, jpjm1 … … 334 328 #endif 335 329 336 IF ( l_trddyn .OR. ( id_vrt_dia_spg == "spg" )) THEN330 IF( l_trddyn ) THEN 337 331 ztrdu(:,:,:) = ua(:,:,:) ! save the after velocity before the filtered SPG 338 332 ztrdv(:,:,:) = va(:,:,:) 339 333 ! 340 IF ( l_trddyn ) THEN 341 CALL wrk_alloc( jpi, jpj, zpw ) 342 ! 343 zpw(:,:) = - z2dt * gcx(:,:) 344 CALL iom_put( "ssh_flt" , zpw ) ! output equivalent ssh modification due to implicit filter 345 ! 346 ! ! save surface pressure flux: -pw at z=0 347 zpw(:,:) = - rau0 * grav * sshn(:,:) * wn(:,:,1) * tmask(:,:,1) 348 CALL iom_put( "pw0_exp" , zpw ) 349 zpw(:,:) = wn(:,:,1) 350 CALL iom_put( "w0" , zpw ) 351 zpw(:,:) = rau0 * z2dtg * gcx(:,:) * wn(:,:,1) * tmask(:,:,1) 352 CALL iom_put( "pw0_flt" , zpw ) 353 ! 354 CALL wrk_dealloc( jpi, jpj, zpw ) 355 ! 356 ENDIF 334 CALL wrk_alloc( jpi, jpj, zpw ) 335 ! 336 zpw(:,:) = - z2dt * gcx(:,:) 337 CALL iom_put( "ssh_flt" , zpw ) ! output equivalent ssh modification due to implicit filter 338 ! 339 ! ! save surface pressure flux: -pw at z=0 340 zpw(:,:) = - rau0 * grav * sshn(:,:) * wn(:,:,1) * tmask(:,:,1) 341 CALL iom_put( "pw0_exp" , zpw ) 342 zpw(:,:) = wn(:,:,1) 343 CALL iom_put( "w0" , zpw ) 344 zpw(:,:) = rau0 * z2dtg * gcx(:,:) * wn(:,:,1) * tmask(:,:,1) 345 CALL iom_put( "pw0_flt" , zpw ) 346 ! 347 CALL wrk_dealloc( jpi, jpj, zpw ) 348 ! 357 349 ENDIF 358 350 … … 371 363 END DO 372 364 373 IF ( l_trddyn .OR. ( id_vrt_dia_spg == "spg" )) THEN ! save the explicit SPG trends for further diagnostics365 IF( l_trddyn ) THEN ! save the explicit SPG trends for further diagnostics 374 366 ztrdu(:,:,:) = ( ua(:,:,:) - ztrdu(:,:,:) ) / z2dt 375 367 ztrdv(:,:,:) = ( va(:,:,:) - ztrdv(:,:,:) ) / z2dt 376 ! 377 IF ( l_trddyn ) THEN 378 CALL trd_dyn( ztrdu, ztrdv, jpdyn_spgflt, kt ) 379 END IF 380 ! 381 IF ( id_vrt_dia_spg == "spg" ) THEN 382 ! TODO remove kt after validation 383 CALL dyn_vrt_dia_3d( ztrdu, ztrdv, id_vrt_dia_spg, kt ) 384 END IF 368 CALL trd_dyn( ztrdu, ztrdv, jpdyn_spgflt, kt ) 385 369 ! 386 370 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) -
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r8197 r8300 81 81 INTEGER, INTENT( in ) :: kt ! ocean time-step index 82 82 ! 83 CHARACTER(len=3) :: id_vrt_dia_rvo = "rvo" ! TODO remove once flags set properly 84 CHARACTER(len=3) :: id_vrt_dia_pvo = "pvo" ! TODO remove once flags set properly 83 85 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 84 86 !!---------------------------------------------------------------------- … … 86 88 IF( nn_timing == 1 ) CALL timing_start('dyn_vor') 87 89 ! 88 IF( l_trddyn ) CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv )90 IF( l_trddyn .or. ( id_vrt_dia_rvo == "rvo" ) ) CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 89 91 ! 90 92 ! ! vorticity term … … 106 108 ! 107 109 CASE ( 0 ) ! energy conserving scheme 108 IF( l_trddyn ) THEN110 IF( l_trddyn .or. ( id_vrt_dia_rvo == "rvo" ) ) THEN 109 111 ztrdu(:,:,:) = ua(:,:,:) 110 112 ztrdv(:,:,:) = va(:,:,:) … … 112 114 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 113 115 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 114 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 116 IF( l_trddyn ) THEN 117 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 118 END IF 119 IF( id_vrt_dia_rvo == "rvo" ) THEN 120 CALL dyn_vrt_dia_3d( ztrdu, ztrdv, id_vrt_dia_rvo ) 121 END IF 115 122 ztrdu(:,:,:) = ua(:,:,:) 116 123 ztrdv(:,:,:) = va(:,:,:) … … 118 125 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 119 126 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 120 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 127 IF( l_trddyn ) THEN 128 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 129 END IF 130 IF( id_vrt_dia_pvo == "pvo" ) THEN 131 CALL dyn_vrt_dia_3d( ztrdu, ztrdv, id_vrt_dia_pvo ) 132 END IF 121 133 ELSE 122 134 CALL vor_ene( kt, ntot, ua, va ) ! total vorticity … … 124 136 ! 125 137 CASE ( 1 ) ! enstrophy conserving scheme 126 IF( l_trddyn ) THEN138 IF( l_trddyn .or. ( id_vrt_dia_rvo == "rvo" ) ) THEN 127 139 ztrdu(:,:,:) = ua(:,:,:) 128 140 ztrdv(:,:,:) = va(:,:,:) … … 130 142 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 131 143 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 132 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 144 IF( l_trddyn ) THEN 145 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 146 END IF 147 IF( id_vrt_dia_rvo == "rvo" ) THEN 148 CALL dyn_vrt_dia_3d( ztrdu, ztrdv, id_vrt_dia_rvo ) 149 END IF 133 150 ztrdu(:,:,:) = ua(:,:,:) 134 151 ztrdv(:,:,:) = va(:,:,:) … … 136 153 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 137 154 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 138 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 155 IF( l_trddyn ) THEN 156 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 157 END IF 158 IF( id_vrt_dia_pvo == "pvo" ) THEN 159 CALL dyn_vrt_dia_3d( ztrdu, ztrdv, id_vrt_dia_pvo ) 160 END IF 139 161 ELSE 140 162 CALL vor_ens( kt, ntot, ua, va ) ! total vorticity … … 142 164 ! 143 165 CASE ( 2 ) ! mixed ene-ens scheme 144 IF( l_trddyn ) THEN166 IF( l_trddyn .or. ( id_vrt_dia_rvo == "rvo" ) ) THEN 145 167 ztrdu(:,:,:) = ua(:,:,:) 146 168 ztrdv(:,:,:) = va(:,:,:) … … 148 170 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 149 171 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 150 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 172 IF( l_trddyn ) THEN 173 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 174 END IF 175 IF( id_vrt_dia_rvo == "rvo" ) THEN 176 CALL dyn_vrt_dia_3d( ztrdu, ztrdv, id_vrt_dia_rvo ) 177 END IF 151 178 ztrdu(:,:,:) = ua(:,:,:) 152 179 ztrdv(:,:,:) = va(:,:,:) … … 154 181 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 155 182 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 156 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 183 IF( l_trddyn ) THEN 184 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 185 END IF 186 IF( id_vrt_dia_pvo == "pvo" ) THEN 187 CALL dyn_vrt_dia_3d( ztrdu, ztrdv, id_vrt_dia_pvo ) 188 END IF 157 189 ELSE 158 190 CALL vor_mix( kt ) ! total vorticity (mix=ens-ene) … … 160 192 ! 161 193 CASE ( 3 ) ! energy and enstrophy conserving scheme 162 IF( l_trddyn ) THEN194 IF( l_trddyn .or. ( id_vrt_dia_rvo == "rvo" ) ) THEN 163 195 ztrdu(:,:,:) = ua(:,:,:) 164 196 ztrdv(:,:,:) = va(:,:,:) … … 166 198 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 167 199 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 168 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 200 IF( l_trddyn ) THEN 201 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 202 END IF 203 IF( id_vrt_dia_rvo == "rvo" ) THEN 204 CALL dyn_vrt_dia_3d( ztrdu, ztrdv, id_vrt_dia_rvo ) 205 END IF 169 206 ztrdu(:,:,:) = ua(:,:,:) 170 207 ztrdv(:,:,:) = va(:,:,:) … … 172 209 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 173 210 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 174 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 211 IF( l_trddyn ) THEN 212 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 213 END IF 214 IF( id_vrt_dia_pvo == "pvo" ) THEN 215 CALL dyn_vrt_dia_3d( ztrdu, ztrdv, id_vrt_dia_pvo ) 216 END IF 175 217 ELSE 176 218 CALL vor_een( kt, ntot, ua, va ) ! total vorticity … … 183 225 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 184 226 ! 185 IF( l_trddyn ) CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv )227 IF( l_trddyn .or. (id_vrt_dia_rvo == "rvo" ) ) CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 186 228 ! 187 229 IF( nn_timing == 1 ) CALL timing_stop('dyn_vor') … … 561 603 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pva ! total v-trend 562 604 !! 563 CHARACTER(len=3) :: id_vrt_dia_vor = "vor" ! TODO remove once flags set properly564 605 INTEGER :: ji, jj, jk ! dummy loop indices 565 606 INTEGER :: ierr ! local integer 566 REAL(wp) :: zfac12 607 REAL(wp) :: zfac12, zua, zva ! local scalars 567 608 REAL(wp) :: zmsk, ze3 ! local scalars 568 609 ! ! 3D workspace 569 610 REAL(wp), POINTER , DIMENSION(:,: ) :: zwx, zwy, zwz 570 611 REAL(wp), POINTER , DIMENSION(:,: ) :: ztnw, ztne, ztsw, ztse 571 REAL(wp), POINTER , DIMENSION(:,:,:) :: zua, zva572 612 #if defined key_vvl 573 613 REAL(wp), POINTER , DIMENSION(:,:,:) :: ze3f ! 3D workspace (lk_vvl=T) … … 581 621 CALL wrk_alloc( jpi, jpj, zwx , zwy , zwz ) 582 622 CALL wrk_alloc( jpi, jpj, ztnw, ztne, ztsw, ztse ) 583 CALL wrk_alloc( jpi, jpj, jpk, zua, zva )584 623 #if defined key_vvl 585 624 CALL wrk_alloc( jpi, jpj, jpk, ze3f ) … … 691 730 DO jj = 2, jpjm1 692 731 DO ji = fs_2, fs_jpim1 ! vector opt. 693 zua(ji,jj,jk) = + zfac12 / e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) & 694 & + ztnw(ji+1,jj) * zwy(ji+1,jj ) & 695 & + ztse(ji,jj ) * zwy(ji ,jj-1) & 696 & + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) 697 zva(ji,jj,jk) = - zfac12 / e2v(ji,jj) * ( ztsw(ji,jj+1) * zwx(ji-1,jj+1) & 698 & + ztse(ji,jj+1) * zwx(ji ,jj+1) & 699 & + ztnw(ji,jj ) * zwx(ji-1,jj ) & 700 & + ztne(ji,jj ) * zwx(ji ,jj ) ) 701 pua(ji,jj,jk) = pua(ji,jj,jk) + zua(ji,jj,jk) 702 pva(ji,jj,jk) = pva(ji,jj,jk) + zva(ji,jj,jk) 732 zua = + zfac12 / e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) & 733 & + ztse(ji,jj ) * zwy(ji ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) 734 zva = - zfac12 / e2v(ji,jj) * ( ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji ,jj+1) & 735 & + ztnw(ji,jj ) * zwx(ji-1,jj ) + ztne(ji,jj ) * zwx(ji ,jj ) ) 736 pua(ji,jj,jk) = pua(ji,jj,jk) + zua 737 pva(ji,jj,jk) = pva(ji,jj,jk) + zva 703 738 END DO 704 739 END DO … … 706 741 END DO ! End of slab 707 742 ! ! =============== 708 IF ( id_vrt_dia_vor == "vor" ) THEN709 ! TODO - remove kt only used for validation710 CALL dyn_vrt_dia_3d(zua, zva, id_vrt_dia_vor, kt)711 END IF712 !713 743 CALL wrk_dealloc( jpi, jpj, zwx , zwy , zwz ) 714 744 CALL wrk_dealloc( jpi, jpj, ztnw, ztne, ztsw, ztse ) 715 CALL wrk_dealloc( jpi, jpj, jpk, zua, zva )716 745 #if defined key_vvl 717 746 CALL wrk_dealloc( jpi, jpj, jpk, ze3f ) -
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
r8197 r8300 61 61 ! 62 62 CHARACTER(len=3) :: id_vrt_dia_zad = "zad" ! TODO remove once flags set properly 63 INTEGER :: ji, jj, jk ! dummy loop indices 63 INTEGER :: ji, jj, jk ! dummy loop indices 64 INTEGER :: zua, zva ! temporary scalars 64 65 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwuw , zwvw 65 66 REAL(wp), POINTER, DIMENSION(:,: ) :: zww 66 67 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 67 REAL(wp), POINTER, DIMENSION(:,:,:) :: zua, zva68 68 !!---------------------------------------------------------------------- 69 69 ! … … 71 71 ! 72 72 CALL wrk_alloc( jpi,jpj, zww ) 73 CALL wrk_alloc( jpi,jpj,jpk, zwuw , zwvw , zua, zva )73 CALL wrk_alloc( jpi,jpj,jpk, zwuw , zwvw ) 74 74 ! 75 75 IF( kt == nit000 ) THEN … … 78 78 ENDIF 79 79 80 IF( l_trddyn ) THEN ! Save ua and va trends80 IF( l_trddyn .OR. ( id_vrt_dia_zad == "zad" ) ) THEN ! Save ua and va trends 81 81 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 82 82 ztrdu(:,:,:) = ua(:,:,:) … … 123 123 DO ji = fs_2, fs_jpim1 ! vector opt. 124 124 ! ! vertical momentum advective trends 125 zua(ji,jj,jk) = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / & 126 & ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 127 zva(ji,jj,jk) = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / & 128 & ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 125 zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 126 zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 129 127 ! ! add the trends to the general momentum trends 130 ua(ji,jj,jk) = ua(ji,jj,jk) + zua (ji,jj,jk)131 va(ji,jj,jk) = va(ji,jj,jk) + zva (ji,jj,jk)128 ua(ji,jj,jk) = ua(ji,jj,jk) + zua 129 va(ji,jj,jk) = va(ji,jj,jk) + zva 132 130 END DO 133 131 END DO 134 132 END DO 135 133 136 IF( l_trddyn ) THEN! save the vertical advection trends for diagnostic134 IF( l_trddyn .OR. ( id_vrt_dia_zad == "zad" ) ) THEN ! save the vertical advection trends for diagnostic 137 135 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 138 136 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 139 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 137 ! 138 IF( id_vrt_dia_zad == "zad" ) THEN 139 CALL dyn_vrt_dia_3d( ztrdu, ztrdv, id_vrt_dia_zad ) 140 ENDIF 141 ! 142 IF( l_trddyn ) THEN 143 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 144 ENDIF 145 ! 140 146 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) 141 147 ENDIF … … 144 150 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 145 151 ! 146 IF ( id_vrt_dia_zad == "zad" ) THEN147 ! TODO - remove kt only used for validation148 CALL dyn_vrt_dia_3d(zua, zva, id_vrt_dia_zad, kt)149 END IF150 !151 152 CALL wrk_dealloc( jpi,jpj, zww ) 152 CALL wrk_dealloc( jpi,jpj,jpk, zwuw , zwvw , zua, zva )153 CALL wrk_dealloc( jpi,jpj,jpk, zwuw , zwvw ) 153 154 ! 154 155 IF( nn_timing == 1 ) CALL timing_stop('dyn_zad') -
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
r7875 r8300 27 27 USE wrk_nemo ! Memory Allocation 28 28 USE timing ! Timing 29 USE divcur ! for dyn_vrt_dia 29 30 30 31 IMPLICIT NONE … … 59 60 ! 60 61 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 62 CHARACTER(len=3) :: id_vrt_dia_zdf = "zdf" ! TODO remove once flags properly set 61 63 !!--------------------------------------------------------------------- 62 64 ! … … 68 70 ENDIF 69 71 70 IF( l_trddyn ) THEN! temporary save of ta and sa trends72 IF( l_trddyn .or. ( id_vrt_dia_zdf == "zdf" ) ) THEN ! temporary save of ta and sa trends 71 73 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 72 74 ztrdu(:,:,:) = ua(:,:,:) … … 88 90 END SELECT 89 91 90 IF( l_trddyn ) THEN! save the vertical diffusive trends for further diagnostics92 IF( l_trddyn .or. ( id_vrt_dia_zdf == "zdf" ) ) THEN ! save the vertical diffusive trends for further diagnostics 91 93 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 92 94 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 93 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt ) 95 ! 96 IF( id_vrt_dia_zdf == "zdf" ) THEN 97 CALL dyn_vrt_dia_3d( ztrdu, ztrdv, id_vrt_dia_zdf ) 98 END IF 99 ! 100 IF( l_trddyn ) THEN 101 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt ) 102 END IF 103 ! 94 104 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) 95 105 ENDIF -
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r8197 r8300 26 26 USE timing ! Timing 27 27 USE dynadv ! dynamics: vector invariant versus flux form 28 USE divcur ! for dyn_vrt_dia_3d29 28 USE dynspg_oce, ONLY: lk_dynspg_ts 30 29 … … 67 66 REAL(wp), INTENT(in) :: p2dt ! vertical profile of tracer time-step 68 67 !! 69 CHARACTER(len=3) :: id_vrt_dia_zdf = "zdf" ! TODO remove once flags set properly70 68 INTEGER :: ji, jj, jk ! dummy loop indices 71 69 INTEGER :: ikbu, ikbv ! local integers … … 73 71 REAL(wp) :: ze3ua, ze3va 74 72 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwd, zws 75 REAL(wp), POINTER, DIMENSION(:,:,:) :: zua, zva76 73 !!---------------------------------------------------------------------- 77 74 ! … … 79 76 ! 80 77 CALL wrk_alloc( jpi,jpj,jpk, zwi, zwd, zws ) 81 CALL wrk_alloc( jpi,jpj,jpk, zua, zva )82 78 ! 83 79 IF( kt == nit000 ) THEN … … 261 257 END DO 262 258 263 IF ( ( .NOT. lk_dynspg_ts ) .OR. ( id_vrt_dia_zdf == "zdf" ) ) THEN 259 #if ! defined key_dynspg_ts 264 260 ! Normalization to obtain the general momentum trend ua 265 DO jk = 1, jpkm1 266 DO jj = 2, jpjm1 267 DO ji = fs_2, fs_jpim1 ! vector opt. 268 zua(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) * z1_p2dt 269 END DO 270 END DO 271 END DO 272 IF ( .NOT. lk_dynspg_ts ) THEN 273 ua(:,:,:) = zua(:,:,:) 274 END IF 275 END IF 276 261 DO jk = 1, jpkm1 262 DO jj = 2, jpjm1 263 DO ji = fs_2, fs_jpim1 ! vector opt. 264 ua(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) * z1_p2dt 265 END DO 266 END DO 267 END DO 268 #endif 277 269 278 270 ! 3. Vertical diffusion on v … … 365 357 END DO 366 358 367 IF ( ( .NOT. lk_dynspg_ts ) .OR. ( id_vrt_dia_zdf == "zdf" ) ) THEN368 359 ! Normalization to obtain the general momentum trend va 369 DO jk = 1, jpkm1 370 DO jj = 2, jpjm1 371 DO ji = fs_2, fs_jpim1 ! vector opt. 372 zva(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) * z1_p2dt 373 END DO 374 END DO 375 END DO 376 IF ( id_vrt_dia_zdf == "zdf" ) THEN 377 ! TODO - remove kt only used for validation 378 CALL dyn_vrt_dia_3d(zua, zva, id_vrt_dia_zdf, kt) 379 END IF 380 IF ( .NOT. lk_dynspg_ts ) THEN 381 va(:,:,:) = zva(:,:,:) 382 END IF 383 END IF 360 #if ! defined key_dynspg_ts 361 DO jk = 1, jpkm1 362 DO jj = 2, jpjm1 363 DO ji = fs_2, fs_jpim1 ! vector opt. 364 va(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) * z1_p2dt 365 END DO 366 END DO 367 END DO 368 #endif 384 369 385 370 ! J. Chanut: Lines below are useless ? … … 407 392 ! 408 393 CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwd, zws) 409 CALL wrk_dealloc( jpi,jpj,jpk, zua, zva )410 394 ! 411 395 IF( nn_timing == 1 ) CALL timing_stop('dyn_zdf_imp')
Note: See TracChangeset
for help on using the changeset viewer.
