Changeset 8300


Ignore:
Timestamp:
2017-07-08T17:26:56+02:00 (5 years ago)
Author:
glong
Message:

Changed diagnostics to calculate the contributions by taking after-before before going into the specific numerical scheme for the model.

Location:
branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM
Files:
14 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/CONFIG/SHARED/field_def.xml

    r8197 r8300  
    508508        <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" /> 
    509509        <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" /> 
    512514        <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" /> 
    513515        <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" /> 
    514516        <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" /> 
    515517        <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" /> 
    516522      </field_group> 
    517523           
  • branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r8197 r8300  
    343343 
    344344 
    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) 
    347346 
    348347      !!---------------------------------------------------------------------- 
     
    360359      REAL             :: vtend(jpi,jpj,jpk) ! contribution to dv/dt 
    361360      CHARACTER(len=3) :: id_dia_vor         ! identifier for the diagnostic 
    362       INTEGER          :: kt                 ! ocean time-step index TODO remove after validation 
    363361      ! 
    364362      !!---------------------------------------------------------------------- 
     
    378376      ! Calculate the vertical integrals of utend & of vtend 
    379377      ! 
    380       ! TODO remove - for validation only 
    381       IF ( kt == 1 ) THEN 
    382           WRITE(numout, *) 'dyn_vrt_dia_3d id:', id_dia_vor,       & 
    383                  &         ':bathy:', bathy(17,12),                & 
    384                  &         ':mbathy:', mbathy(17,12) 
    385       END IF 
    386        
    387378      DO jk = 1, jpkm1 
    388379          DO jj = 2, jpjm1 
     
    392383                  v_int(ji,jj) = v_int(ji,jj) + ( vtend(ji,jj,jk) * fse3v(ji,jj,jk) & 
    393384                                 &                 * e2v(ji,jj) * vmask(ji,jj,jk) ) 
    394  
    395                   ! TODO remove - for validation only 
    396                   IF ( kt == 1 .AND. ji == 17 .AND. jj == 12 ) THEN 
    397                       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 IF 
    416385              END DO 
    417386          END DO 
    418387      END DO 
    419388 
    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) 
    421390 
    422391      CALL wrk_dealloc(jpi, jpj, u_int) 
     
    426395 
    427396 
    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) 
    430398 
    431399      !!---------------------------------------------------------------------- 
     
    448416      REAL             :: v_int(jpi,jpj)  ! v vertical integral 
    449417      CHARACTER(len=3) :: id_dia_vor      ! identifier for the vorticity diagnostic 
    450       INTEGER          :: kt              ! ocean time-step index TODO remove after validation 
    451418      ! 
    452419      !!---------------------------------------------------------------------- 
     
    483450                  &              - ( u_int(ji,jj+1) - u_int(ji,jj) ) )   & 
    484451                  &            / ( e1f(ji,jj)    * e2f(ji,jj) ) 
    485  
    486               ! TODO remove - for validation only 
    487               IF ( kt == 1 .AND. ji == 17 .AND. jj == 12 ) THEN 
    488                   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 IF 
    499452          END DO 
    500453      END DO 
     
    514467              ikbv = mbkv(ji,jj) 
    515468 
    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! 
    517470                  u_mn(ji,jj) = u_int(ji,jj) / gdepw_n(ji,jj,ikbu+1) 
    518471              ELSE 
     
    520473              END IF 
    521474 
    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! 
    523476                  v_mn(ji,jj) = v_int(ji,jj) / gdepw_n(ji,jj,ikbv+1) 
    524477              ELSE 
    525478                  v_mn(ji,jj) = 0.0_wp 
    526               END IF 
    527  
    528               ! TODO remove - for validation only 
    529               IF ( kt == 1 .AND. ji == 17 .AND. jj == 12 ) THEN 
    530                   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) 
    537479              END IF 
    538480          END DO 
     
    549491                  &             - ( u_mn(ji,jj+1) - u_mn(ji,jj) ) )      & 
    550492                  &          / ( e1f(ji,jj)   * e2f(ji,jj) ) 
    551  
    552               ! TODO remove - for validation only 
    553               IF ( kt == 1 .AND. ji == 17 .AND. jj == 12 ) THEN 
    554                   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 IF 
    565493          END DO 
    566494      END DO 
     
    568496      ! Multiply by the surface mask 
    569497      vor_mn(:,:) = vor_mn(:,:) * fmask(:,:,1) 
    570  
    571498 
    572499      ! Call iom_put for the vertical integral vorticity tendencies 
  • branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90

    r6486 r8300  
    2222   USE timing         ! Timing 
    2323   USE wrk_nemo       ! Memory Allocation 
     24   USE divcur         ! for dyn_vrt_dia 
    2425 
    2526   IMPLICIT NONE 
     
    5253      INTEGER  ::   ikbu, ikbv   ! local integers 
    5354      REAL(wp) ::   zm1_2dt      ! local scalar 
     55      CHARACTER(len=3) ::  id_dyn_vrt_bfr = "bfr"    ! TODO remove once flags set properly 
    5456      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    5557      !!--------------------------------------------------------------------- 
     
    6567        zm1_2dt = - 1._wp / ( 2._wp * rdt ) 
    6668 
    67         IF( l_trddyn )   THEN                      ! temporary save of ua and va trends 
     69        IF( l_trddyn .OR. ( id_dyn_vrt_bfr == "bfr" ) )   THEN                      ! temporary save of ua and va trends 
    6870           CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
    6971           ztrdu(:,:,:) = ua(:,:,:) 
     
    101103 
    102104        ! 
    103         IF( l_trddyn )   THEN                      ! save the vertical diffusive trends for further diagnostics 
     105        IF( l_trddyn .OR. ( id_dyn_vrt_bfr == "bfr" ) )   THEN                      ! save the vertical diffusive trends for further diagnostics 
    104106           ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    105107           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 
    107114           CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
    108115        ENDIF 
  • branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r8197 r8300  
    8383      !!             - send trends to trd_dyn for futher diagnostics (l_trddyn=T) 
    8484      !!---------------------------------------------------------------------- 
    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 
    8687      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    8788      !!---------------------------------------------------------------------- 
     
    8990      IF( nn_timing == 1 )  CALL timing_start('dyn_hpg') 
    9091      ! 
    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) 
    9293         CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
    9394         ztrdu(:,:,:) = ua(:,:,:) 
     
    104105      END SELECT 
    105106      ! 
    106       IF( l_trddyn ) THEN      ! save the hydrostatic pressure gradient trends for momentum trend diagnostics 
     107      IF( l_trddyn .or. ( id_vrt_dia_hpg == "hpg" ) ) THEN      ! save the hydrostatic pressure gradient trends for momentum trend diagnostics 
    107108         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    108109         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 
    110117         CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
    111118      ENDIF 
     
    379386      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    380387      !! 
    381       CHARACTER(len=3) :: id_vrt_dia_hpg = "hpg" ! TODO remove once flags set properly 
    382388      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
    383389      REAL(wp) ::   zcoef0, zuap, zvap, znad   ! temporary scalars 
    384390      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj 
    385       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zuhpg, zvhpg 
    386391      !!---------------------------------------------------------------------- 
    387392      ! 
    388393      CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj ) 
    389       CALL wrk_alloc( jpi,jpj,jpk, zuhpg, zvhpg ) 
    390394      ! 
    391395      IF( kt == nit000 ) THEN 
     
    415419            zvap = -zcoef0 * ( rhd   (ji,jj+1,1) + rhd   (ji,jj,1) + 2._wp * znad )   & 
    416420               &           * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj) 
    417             ! combine gradient and correction 
    418             zuhpg(ji,jj,1) = zhpi(ji,jj,1) + zuap 
    419             zvhpg(ji,jj,1) = zhpj(ji,jj,1) + zvap 
    420421            ! add to the general momentum trend 
    421             ua(ji,jj,1) = ua(ji,jj,1) + zuhpg(ji,jj,1) 
    422             va(ji,jj,1) = va(ji,jj,1) + zvhpg(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 
    423424         END DO 
    424425      END DO 
     
    440441               zvap = -zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   & 
    441442                  &           * ( fsde3w(ji  ,jj+1,jk) - fsde3w(ji,jj,jk) ) / e2v(ji,jj) 
    442                ! combine gradient and correction 
    443                zuhpg(ji,jj,jk) = zhpi(ji,jj,jk) + zuap 
    444                zvhpg(ji,jj,jk) = zhpj(ji,jj,jk) + zvap 
    445443               ! add to the general momentum trend 
    446                ua(ji,jj,jk) = ua(ji,jj,jk) + zuhpg(ji,jj,jk) 
    447                va(ji,jj,jk) = va(ji,jj,jk) + zvhpg(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 
    448446            END DO 
    449447         END DO 
    450448      END DO 
    451       ! 
    452       ! calculate dia_vor_int & dia_vor_mn if required 
    453       IF ( id_vrt_dia_hpg == "hpg" ) THEN 
    454           ! TODO - remove kt only used for validation 
    455           CALL dyn_vrt_dia_3d(zuhpg, zvhpg, id_vrt_dia_hpg, kt) 
    456       END IF 
    457449      ! 
    458450      CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) 
  • branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90

    r8197 r8300  
    7272      !!                 Hollingsworth et al., Quart. J. Roy. Meteor. Soc., 1983. 
    7373      !!---------------------------------------------------------------------- 
    74       INTEGER, INTENT( in ) ::   kt         ! ocean time-step index 
    75       INTEGER, INTENT( in ) ::   kscheme    ! =0/1   type of KEG scheme  
     74      INTEGER, INTENT( in ) ::   kt        ! ocean time-step index 
     75      INTEGER, INTENT( in ) ::   kscheme   ! =0/1   type of KEG scheme  
    7676      ! 
    7777      CHARACTER(len=3) :: id_vrt_dia_keg = "keg" ! TODO remove once flags set properly 
    78       INTEGER  ::  ji, jj, jk               ! dummy loop indices 
    79       REAL(wp) ::  zu, zv                   ! temporary scalars 
    80       REAL(wp), POINTER, DIMENSION(:,:,:) :: zhke, zhkei, zhkej 
     78      INTEGER  ::   ji, jj, jk             ! dummy loop indices 
     79      REAL(wp) ::   zu, zv                 ! temporary scalars 
     80      REAL(wp), POINTER, DIMENSION(:,:,:) :: zhke 
    8181      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv  
    8282      !!---------------------------------------------------------------------- 
     
    8484      IF( nn_timing == 1 )   CALL timing_start('dyn_keg') 
    8585      ! 
    86       CALL wrk_alloc( jpi,jpj,jpk,   zhke, zhkei, zhkej ) 
     86      CALL wrk_alloc( jpi,jpj,jpk,   zhke ) 
    8787      ! 
    8888      IF( kt == nit000 ) THEN 
     
    9292      ENDIF 
    9393 
    94       IF( l_trddyn ) THEN           ! Save ua and va trends 
     94      IF( l_trddyn .or. ( id_vrt_dia_keg == "keg" ) ) THEN           ! Save ua and va trends 
    9595         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
    9696         ztrdu(:,:,:) = ua(:,:,:)  
     
    139139         DO jj = 2, jpjm1 
    140140            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) 
    145143            END DO  
    146144         END DO 
    147145      END DO 
    148146      ! 
    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 
    155148         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    156149         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         ! 
    158159         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
    159160      ENDIF 
     
    162163         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    163164      ! 
    164       CALL wrk_dealloc( jpi,jpj,jpk,   zhke, zhkei, zhkej ) 
     165      CALL wrk_dealloc( jpi,jpj,jpk,   zhke ) 
    165166      ! 
    166167      IF( nn_timing == 1 )   CALL timing_stop('dyn_keg') 
  • branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90

    r6486 r8300  
    2828   USE lib_mpp        ! distribued memory computing library 
    2929   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 
    3233 
    3334   IMPLICIT NONE 
     
    5758      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    5859      ! 
     60      CHARACTER(len=3)    ::   id_vrt_dia_ldf = "ldf"  ! TODO Replace once proper flags in place 
    5961      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    6062      !!---------------------------------------------------------------------- 
     
    6264      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf') 
    6365      ! 
    64       IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends 
     66      IF( l_trddyn .or. ( id_vrt_dia_ldf == "ldf" ) )   THEN               ! temporary save of ta and sa trends 
    6567         CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
    6668         ztrdu(:,:,:) = ua(:,:,:)  
     
    103105      END SELECT 
    104106 
    105       IF( l_trddyn ) THEN                        ! save the horizontal diffusive trends for further diagnostics 
     107      IF( l_trddyn .or. ( id_vrt_dia_ldf == "ldf" ) ) THEN    ! save the horizontal diffusive trends for further diagnostics 
    106108         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    107109         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 
    109116         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
    110117      ENDIF 
  • branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90

    r8197 r8300  
    1919   USE dom_oce         ! ocean space and time domain 
    2020   USE ldfdyn_oce      ! ocean dynamics: lateral physics 
    21    USE divcur          ! for dyn_vrt_dia_3d 
    2221   ! 
    2322   USE in_out_manager  ! I/O manager 
     
    7675      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7776      ! 
    78       CHARACTER(len=3) :: id_vrt_dia_ldf = "ldf"  ! TODO remove once flags set properly 
    7977      INTEGER  ::   ji, jj, jk                  ! dummy loop indices 
    80       REAL(wp) ::   zbt, ze2u, ze2v             ! temporary scalar 
     78      REAL(wp) ::   zua, zva, zbt, ze2u, ze2v   ! temporary scalar 
    8179      REAL(wp), POINTER, DIMENSION(:,:  ) :: zcu, zcv 
    82       REAL(wp), POINTER, DIMENSION(:,:,:) :: zuf, zut, zlu, zlv, zua, zva 
     80      REAL(wp), POINTER, DIMENSION(:,:,:) :: zuf, zut, zlu, zlv 
    8381      !!---------------------------------------------------------------------- 
    8482      ! 
     
    8684      ! 
    8785      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 )  
    8987      ! 
    9088      IF( kt == nit000 .AND. lwp ) THEN 
     
    192190               ze2u = e2u(ji,jj) * fse3u(ji,jj,jk) 
    193191               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) 
    202198               ! 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 )) 
    205201            END DO 
    206202         END DO 
     
    209205      END DO                                           !   End of slab 
    210206      !                                                ! =============== 
    211       IF ( id_vrt_dia_ldf == "ldf" ) THEN 
    212           ! TODO - remove kt only used for validation 
    213           CALL dyn_vrt_dia_3d(zua, zva, id_vrt_dia_ldf, kt) 
    214       END IF 
    215       ! 
    216207      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 )  
    218209      ! 
    219210      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  
    4646   USE prtctl          ! Print control 
    4747   USE timing          ! Timing 
     48   USE divcur          ! for dyn_vrt_dia 
    4849#if defined key_agrif 
    4950   USE agrif_opa_interp 
     
    106107      REAL(wp) ::   zue3a, zue3n, zue3b, zuf, zec      ! local scalars 
    107108      REAL(wp) ::   zve3a, zve3n, zve3b, zvf, z1_2dt   !   -      - 
     109      CHARACTER(len=3) ::  id_dyn_vrt_atf = "atf"      ! TODO remove once flags done 
    108110      REAL(wp), POINTER, DIMENSION(:,:)   ::  zue, zve 
    109111      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ze3u_f, ze3v_f, zua, zva  
     
    203205#endif 
    204206 
    205       IF( l_trddyn ) THEN             ! prepare the atf trend computation + some diagnostics 
     207      IF( l_trddyn .OR. ( id_dyn_vrt_atf == "atf" ) ) THEN             ! prepare the atf trend computation + some diagnostics 
    206208         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 
    217221         ENDIF 
    218222         ! 
     
    392396      ! 
    393397 
    394       IF( l_trddyn ) THEN                ! 3D output: asselin filter trends on momentum 
     398      IF( l_trddyn .OR. ( id_dyn_vrt_atf == "atf" ) ) THEN                ! 3D output: asselin filter trends on momentum 
    395399         zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt 
    396400         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 
    398407      ENDIF 
    399408      ! 
  • branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r6486 r8300  
    3535   USE wrk_nemo       ! Memory Allocation 
    3636   USE timing         ! Timing 
     37   USE divcur         ! for dyn_vrt_dia_3d 
    3738 
    3839 
     
    8990      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    9091      REAL(wp), POINTER, DIMENSION(:,:)   ::  zpice 
     92      CHARACTER(len=3) ::  id_vrt_dia_spg = "spg"          ! TODO remove once flags set properly 
    9193      !!---------------------------------------------------------------------- 
    9294      ! 
     
    99101 
    100102 
    101       IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends 
     103      IF( l_trddyn .or. ( id_vrt_dia_spg == "spg" ) )   THEN      ! temporary save of ta and sa trends 
    102104         CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )  
    103105         ztrdu(:,:,:) = ua(:,:,:) 
     
    188190      END SELECT 
    189191      !                     
    190       IF( l_trddyn )   THEN                      ! save the surface pressure gradient trends for further diagnostics 
     192      IF( l_trddyn .or. ( id_vrt_dia_spg == "spg" ) )   THEN      ! save the surface pressure gradient trends for further diagnostics 
    191193         SELECT CASE ( nspg ) 
    192194         CASE ( 0, 1 ) 
     
    199201            ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / z2dt - ztrdv(:,:,:) 
    200202         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 
    202211         ! 
    203212         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  
  • branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r8197 r8300  
    4848   USE lib_fortran 
    4949   USE timing          ! Timing 
    50    USE divcur          ! for dyn_vrt_dia_3d 
    5150#if defined key_agrif 
    5251   USE agrif_opa_interp 
     
    109108      INTEGER, INTENT(  out) ::   kindic   ! solver convergence flag (<0 if not converge) 
    110109      ! 
    111       CHARACTER(len=3) ::  id_vrt_dia_spg = "spg" ! TODO remove once flags set properly 
    112110      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    113111      REAL(wp) ::   z2dt, z2dtg, zgcb, zbtd, ztdgu, ztdgv   ! local scalars 
     
    132130         !                                                        ! gcx, gcxb 
    133131      ENDIF 
    134  
    135       IF ( l_trddyn .OR. ( id_vrt_dia_spg == "spg" ) )   THEN 
    136          CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
    137       END IF 
    138132 
    139133      ! Local constant initialization 
     
    190184         END DO 
    191185         ! 
    192                                           ! temporary save of spg trends 
    193          IF ( l_trddyn .OR. ( id_vrt_dia_spg == "spg" ) )   THEN 
     186         IF( l_trddyn )   THEN                      ! temporary save of spg trends 
     187            CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
    194188            DO jk = 1, jpkm1              ! unweighted time stepping  
    195189               DO jj = 2, jpjm1 
     
    334328#endif       
    335329 
    336       IF ( l_trddyn .OR. ( id_vrt_dia_spg == "spg" ) )   THEN                      
     330      IF( l_trddyn )   THEN                      
    337331         ztrdu(:,:,:) = ua(:,:,:)                 ! save the after velocity before the filtered SPG 
    338332         ztrdv(:,:,:) = va(:,:,:) 
    339333         ! 
    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         !                                    
    357349      ENDIF 
    358350       
     
    371363      END DO 
    372364 
    373       IF ( l_trddyn .OR. ( id_vrt_dia_spg == "spg" ) )   THEN                      ! save the explicit SPG trends for further diagnostics 
     365      IF( l_trddyn )   THEN                      ! save the explicit SPG trends for further diagnostics 
    374366         ztrdu(:,:,:) = ( ua(:,:,:) - ztrdu(:,:,:) ) / z2dt 
    375367         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 ) 
    385369         ! 
    386370         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  
  • branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r8197 r8300  
    8181      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    8282      ! 
     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 
    8385      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    8486      !!---------------------------------------------------------------------- 
     
    8688      IF( nn_timing == 1 )  CALL timing_start('dyn_vor') 
    8789      ! 
    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 ) 
    8991      ! 
    9092      !                                          ! vorticity term  
     
    106108         ! 
    107109      CASE ( 0 )                                       ! energy conserving scheme 
    108          IF( l_trddyn )   THEN 
     110         IF( l_trddyn .or. ( id_vrt_dia_rvo == "rvo" ) )   THEN 
    109111            ztrdu(:,:,:) = ua(:,:,:) 
    110112            ztrdv(:,:,:) = va(:,:,:) 
     
    112114            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    113115            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 
    115122            ztrdu(:,:,:) = ua(:,:,:) 
    116123            ztrdv(:,:,:) = va(:,:,:) 
     
    118125            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    119126            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 
    121133         ELSE 
    122134            CALL vor_ene( kt, ntot, ua, va )                ! total vorticity 
     
    124136         ! 
    125137      CASE ( 1 )                                       ! enstrophy conserving scheme 
    126          IF( l_trddyn )   THEN     
     138         IF( l_trddyn .or. ( id_vrt_dia_rvo == "rvo" ) )   THEN 
    127139            ztrdu(:,:,:) = ua(:,:,:) 
    128140            ztrdv(:,:,:) = va(:,:,:) 
     
    130142            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    131143            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 
    133150            ztrdu(:,:,:) = ua(:,:,:) 
    134151            ztrdv(:,:,:) = va(:,:,:) 
     
    136153            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    137154            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 
    139161         ELSE 
    140162            CALL vor_ens( kt, ntot, ua, va )                ! total vorticity 
     
    142164         ! 
    143165      CASE ( 2 )                                       ! mixed ene-ens scheme 
    144          IF( l_trddyn )   THEN 
     166         IF( l_trddyn .or. ( id_vrt_dia_rvo == "rvo" ) )   THEN 
    145167            ztrdu(:,:,:) = ua(:,:,:) 
    146168            ztrdv(:,:,:) = va(:,:,:) 
     
    148170            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    149171            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 
    151178            ztrdu(:,:,:) = ua(:,:,:) 
    152179            ztrdv(:,:,:) = va(:,:,:) 
     
    154181            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    155182            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 
    157189         ELSE 
    158190            CALL vor_mix( kt )                               ! total vorticity (mix=ens-ene) 
     
    160192         ! 
    161193      CASE ( 3 )                                       ! energy and enstrophy conserving scheme 
    162          IF( l_trddyn )   THEN 
     194         IF( l_trddyn .or. ( id_vrt_dia_rvo == "rvo" ) )   THEN 
    163195            ztrdu(:,:,:) = ua(:,:,:) 
    164196            ztrdv(:,:,:) = va(:,:,:) 
     
    166198            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    167199            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 
    169206            ztrdu(:,:,:) = ua(:,:,:) 
    170207            ztrdv(:,:,:) = va(:,:,:) 
     
    172209            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    173210            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 
    175217         ELSE 
    176218            CALL vor_een( kt, ntot, ua, va )                ! total vorticity 
     
    183225         &                     tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    184226      ! 
    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 ) 
    186228      ! 
    187229      IF( nn_timing == 1 )  CALL timing_stop('dyn_vor') 
     
    561603      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend 
    562604      !! 
    563       CHARACTER(len=3) :: id_vrt_dia_vor = "vor"                  ! TODO remove once flags set properly 
    564605      INTEGER  ::   ji, jj, jk                                    ! dummy loop indices 
    565606      INTEGER  ::   ierr                                          ! local integer 
    566       REAL(wp) ::   zfac12                                        ! local scalars 
     607      REAL(wp) ::   zfac12, zua, zva                              ! local scalars 
    567608      REAL(wp) ::   zmsk, ze3                                     ! local scalars 
    568609      !                                                           !  3D workspace  
    569610      REAL(wp), POINTER    , DIMENSION(:,:  )         :: zwx, zwy, zwz 
    570611      REAL(wp), POINTER    , DIMENSION(:,:  )         :: ztnw, ztne, ztsw, ztse 
    571       REAL(wp), POINTER    , DIMENSION(:,:,:)         :: zua, zva 
    572612#if defined key_vvl 
    573613      REAL(wp), POINTER    , DIMENSION(:,:,:)         :: ze3f     !  3D workspace (lk_vvl=T) 
     
    581621      CALL wrk_alloc( jpi, jpj,      zwx , zwy , zwz        )  
    582622      CALL wrk_alloc( jpi, jpj,      ztnw, ztne, ztsw, ztse )  
    583       CALL wrk_alloc( jpi, jpj, jpk, zua, zva               )  
    584623#if defined key_vvl 
    585624      CALL wrk_alloc( jpi, jpj, jpk, ze3f                   ) 
     
    691730         DO jj = 2, jpjm1 
    692731            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 
    703738            END DO   
    704739         END DO   
     
    706741      END DO                                           !   End of slab 
    707742      !                                                ! =============== 
    708       IF ( id_vrt_dia_vor == "vor" ) THEN 
    709           ! TODO - remove kt only used for validation 
    710           CALL dyn_vrt_dia_3d(zua, zva, id_vrt_dia_vor, kt) 
    711       END IF 
    712       ! 
    713743      CALL wrk_dealloc( jpi, jpj,      zwx , zwy , zwz        )  
    714744      CALL wrk_dealloc( jpi, jpj,      ztnw, ztne, ztsw, ztse )  
    715       CALL wrk_dealloc( jpi, jpj, jpk, zua, zva               )  
    716745#if defined key_vvl 
    717746      CALL wrk_dealloc( jpi, jpj, jpk, ze3f                   ) 
  • branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

    r8197 r8300  
    6161      ! 
    6262      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 
    6465      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwuw , zwvw 
    6566      REAL(wp), POINTER, DIMENSION(:,:  ) ::  zww 
    6667      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    67       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zua, zva 
    6868      !!---------------------------------------------------------------------- 
    6969      ! 
     
    7171      ! 
    7272      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 ) 
    7474      ! 
    7575      IF( kt == nit000 ) THEN 
     
    7878      ENDIF 
    7979 
    80       IF( l_trddyn )   THEN         ! Save ua and va trends 
     80      IF( l_trddyn .OR. ( id_vrt_dia_zad == "zad" ) )   THEN         ! Save ua and va trends 
    8181         CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )  
    8282         ztrdu(:,:,:) = ua(:,:,:)  
     
    123123            DO ji = fs_2, fs_jpim1       ! vector opt. 
    124124               !                         ! 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) ) 
    129127               !                         ! 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 
    132130            END DO   
    133131         END DO   
    134132      END DO 
    135133 
    136       IF( l_trddyn ) THEN           ! save the vertical advection trends for diagnostic 
     134      IF( l_trddyn .OR. ( id_vrt_dia_zad == "zad" ) ) THEN      ! save the vertical advection trends for diagnostic 
    137135         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    138136         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         ! 
    140146         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  
    141147      ENDIF 
     
    144150         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    145151      ! 
    146       IF ( id_vrt_dia_zad == "zad" ) THEN 
    147           ! TODO - remove kt only used for validation 
    148           CALL dyn_vrt_dia_3d(zua, zva, id_vrt_dia_zad, kt) 
    149       END IF 
    150       ! 
    151152      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 ) 
    153154      ! 
    154155      IF( nn_timing == 1 )  CALL timing_stop('dyn_zad') 
  • branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90

    r7875 r8300  
    2727   USE wrk_nemo        ! Memory Allocation 
    2828   USE timing          ! Timing 
     29   USE divcur          ! for dyn_vrt_dia 
    2930 
    3031   IMPLICIT NONE 
     
    5960      ! 
    6061      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
     62      CHARACTER(len=3) :: id_vrt_dia_zdf = "zdf"   ! TODO remove once flags properly set 
    6163      !!--------------------------------------------------------------------- 
    6264      ! 
     
    6870      ENDIF 
    6971 
    70       IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends 
     72      IF( l_trddyn .or. ( id_vrt_dia_zdf == "zdf" ) )   THEN      ! temporary save of ta and sa trends 
    7173         CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )  
    7274         ztrdu(:,:,:) = ua(:,:,:) 
     
    8890      END SELECT 
    8991 
    90       IF( l_trddyn )   THEN                      ! save the vertical diffusive trends for further diagnostics 
     92      IF( l_trddyn .or. ( id_vrt_dia_zdf == "zdf" ) )   THEN      ! save the vertical diffusive trends for further diagnostics 
    9193         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    9294         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         ! 
    94104         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  
    95105      ENDIF 
  • branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r8197 r8300  
    2626   USE timing          ! Timing 
    2727   USE dynadv          ! dynamics: vector invariant versus flux form 
    28    USE divcur          ! for dyn_vrt_dia_3d 
    2928   USE dynspg_oce, ONLY: lk_dynspg_ts 
    3029 
     
    6766      REAL(wp), INTENT(in) ::  p2dt   ! vertical profile of tracer time-step 
    6867      !! 
    69       CHARACTER(len=3) ::   id_vrt_dia_zdf = "zdf" ! TODO remove once flags set properly 
    7068      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    7169      INTEGER  ::   ikbu, ikbv   ! local integers 
     
    7371      REAL(wp) ::   ze3ua, ze3va 
    7472      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwd, zws 
    75       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zua, zva 
    7673      !!---------------------------------------------------------------------- 
    7774      ! 
     
    7976      ! 
    8077      CALL wrk_alloc( jpi,jpj,jpk, zwi, zwd, zws )  
    81       CALL wrk_alloc( jpi,jpj,jpk, zua, zva      )  
    8278      ! 
    8379      IF( kt == nit000 ) THEN 
     
    261257      END DO 
    262258 
    263       IF ( ( .NOT. lk_dynspg_ts ) .OR. ( id_vrt_dia_zdf == "zdf" ) ) THEN 
     259#if ! defined key_dynspg_ts 
    264260      ! 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 
    277269 
    278270      ! 3. Vertical diffusion on v 
     
    365357      END DO 
    366358 
    367       IF ( ( .NOT. lk_dynspg_ts ) .OR. ( id_vrt_dia_zdf == "zdf" ) ) THEN 
    368359      ! 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 
    384369 
    385370      ! J. Chanut: Lines below are useless ? 
     
    407392      ! 
    408393      CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwd, zws)  
    409       CALL wrk_dealloc( jpi,jpj,jpk, zua, zva     )  
    410394      ! 
    411395      IF( nn_timing == 1 )  CALL timing_stop('dyn_zdf_imp') 
Note: See TracChangeset for help on using the changeset viewer.