Changeset 7649


Ignore:
Timestamp:
2017-02-06T16:21:14+01:00 (4 years ago)
Author:
glong
Message:

dyn_vrt_dia subroutine added and calls added for most processes - spg, zdf, and bfr not yet done

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

Legend:

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

    r6876 r7649  
    499499        <field id="tke"          long_name="Turbulent Kinetic Energy"                  unit="m2/s2"    /> 
    500500        <field id="tke_niw"      long_name="Turbulent Kinetic Energy due to near-inertial wave breaking"  unit="m2/s2" /> 
     501        <!-- diag_vor_int and diag_vor_mn: available with TODO FLAGS and TODO FLAGS --> 
     502        <field id="dia_vor_int"    long_name="vertical integral vorticity tendencies"  standard_name="vertically_integrated_vorticity_tendencies"   unit="s-2"      grid_ref="grid_W_2D" /> 
     503        <field id="dia_vor_mn"    long_name="vertical mean vorticity tendencies"  standard_name="vertical_mean_vorticity_tendencies"   unit="s-2"      grid_ref="grid_W_2D" /> 
    501504      </field_group> 
    502505           
  • branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r6487 r7649  
    3535   USE wrk_nemo        ! Memory Allocation 
    3636   USE timing          ! Timing 
     37   USE iom             ! I/O Manager for dyn_vrt_dia 
    3738 
    3839   IMPLICIT NONE 
    3940   PRIVATE 
    4041 
    41    PUBLIC   div_cur    ! routine called by step.F90 and istate.F90 
     42   PUBLIC   div_cur     ! routine called by step.F90 and istate.F90 
     43   PUBLIC   dyn_vrt_dia ! routine called by various modules 
    4244 
    4345   !! * Substitutions 
     
    338340    
    339341#endif 
     342 
     343 
     344   SUBROUTINE dyn_vrt_dia( utend, vtend, id_dia_vor_int, id_dia_vor_mn) 
     345 
     346      !!---------------------------------------------------------------------- 
     347      !! 
     348      !! ** Purpose :  compute the integral and mean vorticity tendencies. 
     349      !! 
     350      !! ** Action : a) Calculate the vertical integrals of utend & of vtend 
     351      !!                (u_int & v_int) 
     352      !!             b) Calculate the vorticity tendencies for the vertical 
     353      !!                integrals. 
     354      !!             c) Calculate the vertical means, u_mn, v_mn from u_int 
     355      !!                and v_int by dividing by the depth 
     356      !!             d) Calculate the vorticity tendencies for the vertical 
     357      !!                means 
     358      !!             e) Call iom_put for the vertical integral vorticity 
     359      !!                tendencies (using id_dia_vor_int) 
     360      !!             f) Call iom_put for the vertical mean vorticity 
     361      !!                tendencies (using id_dia_vor_mn) 
     362      !! 
     363      !!---------------------------------------------------------------------- 
     364      REAL :: utend(jpi,jpj,jpk) ! contribution to du/dt 
     365      REAL :: vtend(jpi,jpj,jpk) ! contribution to dv/dt 
     366      INTEGER :: id_dia_vor_int  ! identifier for the vertical integral vorticity diagnostic 
     367      INTEGER :: id_dia_vor_mn   ! identifier for the vertical mean vorticity diagnostic 
     368      ! 
     369      !!---------------------------------------------------------------------- 
     370      ! 
     371      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     372      INTEGER  ::   ikbu, ikbv   ! dummy loop indices 
     373      ! 
     374      REAL(wp), POINTER, DIMENSION(:,:) :: u_int   ! u vertical integral 
     375      REAL(wp), POINTER, DIMENSION(:,:) :: v_int   ! v vertical integral 
     376      REAL(wp), POINTER, DIMENSION(:,:) :: u_mn    ! u vertical means 
     377      REAL(wp), POINTER, DIMENSION(:,:) :: v_mn    ! u vertical means 
     378      REAL(wp), POINTER, DIMENSION(:,:) :: vor_int ! vort trend of vert integrals 
     379      REAL(wp), POINTER, DIMENSION(:,:) :: vor_mn  ! vort trend of vert means 
     380 
     381      CALL wrk_alloc(jpi, jpj, u_int) 
     382      CALL wrk_alloc(jpi, jpj, v_int) 
     383      CALL wrk_alloc(jpi, jpj, u_mn) 
     384      CALL wrk_alloc(jpi, jpj, v_mn) 
     385      CALL wrk_alloc(jpi, jpj, vor_int) 
     386      CALL wrk_alloc(jpi, jpj, vor_mn) 
     387 
     388      u_int(:,:) = 0.0_wp 
     389      v_int(:,:) = 0.0_wp 
     390 
     391      ! 
     392      ! Calculate the vertical integrals of utend & of vtend 
     393      ! 
     394       
     395      DO jk = 1,jpk 
     396          DO jj = 1,jpj 
     397              DO ji = 1,jpi 
     398                  u_int(ji,jj) = u_int(ji,jj) + utend(ji,jj,jk)*fse3u(ji,jj,jk) 
     399                  v_int(ji,jj) = v_int(ji,jj) + vtend(ji,jj,jk)*fse3v(ji,jj,jk) 
     400              END DO 
     401          END DO 
     402      END DO 
     403 
     404      ! 
     405      ! Calculate the vorticity tendencies for the vertical integrals. 
     406      ! 1/e1e2 * ((e2*d(vtend)/dx) - (e1*d(utend)/dy)) 
     407      ! 
     408 
     409      DO jj = 1,jpjm1 
     410          DO ji = 1,jpim1 
     411              vor_int(ji,jj) = ( v_int(ji+1,jj) * e2v(ji+1,jj)     & 
     412                  &            - v_int(ji,jj)   * e2v(ji,jj)       & 
     413                  &            + u_int(ji,jj)   * e1u(ji,jj)       & 
     414                  &            - u_int(ji,jj+1) * e1u(ji,jj+1) )   & 
     415                  &           / ( e1f(ji,jj)    * e2f(ji,jj) ) 
     416          END DO 
     417      END DO 
     418 
     419 
     420      ! 
     421      ! Calculate the vertical means, u_mn, v_mn from u_int & v_int by dividing 
     422      ! by the depth 
     423      ! mbku & mbkv - vertical index of the bottom last U- & W- ocean level 
     424      ! 
     425 
     426      DO jj = 1, jpj 
     427          DO ji = 1, jpi 
     428              ikbu = mbku(ji,jj) 
     429              ikbv = mbkv(ji,jj) 
     430 
     431              IF (ikbu .ne. 0.0_wp) THEN      ! Don't divide by 0! 
     432                  u_mn(ji,jj) = u_int(ji,jj) / ikbu 
     433              ELSE 
     434                  u_mn(ji,jj) = 0.0_wp 
     435              END IF 
     436 
     437              IF (ikbv .ne. 0.0_wp) THEN      ! Don't divide by 0! 
     438                  v_mn(ji,jj) = v_int(ji,jj) / ikbv 
     439              ELSE 
     440                  v_mn(ji,jj) = 0.0_wp 
     441              END IF 
     442          END DO 
     443      END DO 
     444 
     445      ! 
     446      ! Calculate the vorticity tendencies for the vertical means 
     447      ! 1/e1e2 * ((e2*d(v_mn)/dx) - (e1*d(u_mn)/dy)) 
     448      ! 
     449 
     450      DO jj = 1,jpjm1 
     451          DO ji = 1,jpim1 
     452              vor_mn(ji,jj) = ( v_mn(ji+1,jj) * e2v(ji+1,jj)     & 
     453                  &           - v_mn(ji,jj)   * e2v(ji,jj)       & 
     454                  &           + u_mn(ji,jj)   * e1u(ji,jj)       & 
     455                  &           - u_mn(ji,jj+1) * e1u(ji,jj+1) )   & 
     456                  &          / ( e1f(ji,jj)   * e2f(ji,jj) ) 
     457          END DO 
     458      END DO 
     459 
     460 
     461      ! Call iom_put for the vertical integral vorticity tendencies 
     462      IF (id_dia_vor_int == 1) THEN 
     463          CALL iom_put( "dia_vor_int", vor_int(:,:)) 
     464      ENDIF 
     465 
     466      ! Call iom_put for the vertical mean vorticity tendencies 
     467      IF (id_dia_vor_int == 1) THEN 
     468          CALL iom_put( "dia_vor_mn", vor_mn(:,:)) 
     469      ENDIF 
     470 
     471      CALL wrk_dealloc(jpi, jpj, u_int) 
     472      CALL wrk_dealloc(jpi, jpj, v_int) 
     473      CALL wrk_dealloc(jpi, jpj, u_mn) 
     474      CALL wrk_dealloc(jpi, jpj, v_mn) 
     475      CALL wrk_dealloc(jpi, jpj, vor_int) 
     476      CALL wrk_dealloc(jpi, jpj, vor_mn) 
     477 
     478   END SUBROUTINE dyn_vrt_dia 
     479 
     480 
    340481   !!====================================================================== 
    341482END MODULE divcur 
  • branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r6486 r7649  
    3636   USE trd_oce         ! trends: ocean variables 
    3737   USE trddyn          ! trend manager: dynamics 
     38   USE divcur          ! for dyn_vrt_dia 
    3839   ! 
    3940   USE in_out_manager  ! I/O manager 
     
    378379      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    379380      !! 
     381      INTEGER  ::   id_dia_vrt_hpg_int  = 1    ! TODO remove once flags set properly 
     382      INTEGER  ::   id_dia_vrt_hpg_mean = 1    ! TODO remove once flags set properly 
    380383      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
    381384      REAL(wp) ::   zcoef0, zuap, zvap, znad   ! temporary scalars 
     
    401404      DO jj = 2, jpjm1 
    402405         DO ji = fs_2, fs_jpim1   ! vector opt. 
    403             ! hydrostatic pressure gradient along s-surfaces 
    404             zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( fse3w(ji+1,jj  ,1) * ( znad + rhd(ji+1,jj  ,1) )   & 
    405                &                                  - fse3w(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) ) ) 
    406             zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( fse3w(ji  ,jj+1,1) * ( znad + rhd(ji  ,jj+1,1) )   & 
    407                &                                  - fse3w(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) ) ) 
    408406            ! s-coordinate pressure gradient correction 
    409407            zuap = -zcoef0 * ( rhd   (ji+1,jj,1) + rhd   (ji,jj,1) + 2._wp * znad )   & 
     
    411409            zvap = -zcoef0 * ( rhd   (ji,jj+1,1) + rhd   (ji,jj,1) + 2._wp * znad )   & 
    412410               &           * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj) 
     411            ! hydrostatic pressure gradient along s-surfaces 
     412            zhpi(ji,jj,1) = zuap + zcoef0 / e1u(ji,jj) * ( fse3w(ji+1,jj  ,1) * ( znad + rhd(ji+1,jj  ,1) )   & 
     413               &                                  - fse3w(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) ) ) 
     414            zhpj(ji,jj,1) = zvap + zcoef0 / e2v(ji,jj) * ( fse3w(ji  ,jj+1,1) * ( znad + rhd(ji  ,jj+1,1) )   & 
     415               &                                  - fse3w(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) ) ) 
    413416            ! add to the general momentum trend 
    414             ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap 
    415             va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) + zvap 
     417            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) 
     418            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) 
    416419         END DO 
    417420      END DO 
     
    421424         DO jj = 2, jpjm1 
    422425            DO ji = fs_2, fs_jpim1   ! vector opt. 
    423                ! hydrostatic pressure gradient along s-surfaces 
    424                zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   & 
    425                   &           * (  fse3w(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   & 
    426                   &              - fse3w(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad )  ) 
    427                zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   & 
    428                   &           * (  fse3w(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad )   & 
    429                   &              - fse3w(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad )  ) 
    430426               ! s-coordinate pressure gradient correction 
    431427               zuap = -zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   & 
     
    433429               zvap = -zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   & 
    434430                  &           * ( fsde3w(ji  ,jj+1,jk) - fsde3w(ji,jj,jk) ) / e2v(ji,jj) 
     431               ! hydrostatic pressure gradient along s-surfaces with correction 
     432               zhpi(ji,jj,jk) = zuap + zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   & 
     433                  &           * (  fse3w(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   & 
     434                  &              - fse3w(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad )  ) 
     435               zhpj(ji,jj,jk) = zvap + zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   & 
     436                  &           * (  fse3w(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad )   & 
     437                  &              - fse3w(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad )  ) 
    435438               ! add to the general momentum trend 
    436                ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap 
    437                va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) + zvap 
     439               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) 
     440               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) 
    438441            END DO 
    439442         END DO 
    440443      END DO 
     444      ! 
     445      ! calculate dia_vor_int & dia_vor_mn if required 
     446      IF ( ( id_dia_vrt_hpg_int == 1 ) .or. ( id_dia_vrt_hpg_mean == 1 ) ) THEN 
     447          CALL dyn_vrt_dia(zhpi, zhpj, id_dia_vrt_hpg_int, id_dia_vrt_hpg_mean) 
     448      END IF 
    441449      ! 
    442450      CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) 
  • branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90

    r6486 r7649  
    1717   USE trd_oce         ! trends: ocean variables 
    1818   USE trddyn          ! trend manager: dynamics 
     19   USE divcur          ! for dyn_vrt_dia 
    1920   ! 
    2021   USE in_out_manager  ! I/O manager 
     
    7172      !!                 Hollingsworth et al., Quart. J. Roy. Meteor. Soc., 1983. 
    7273      !!---------------------------------------------------------------------- 
    73       INTEGER, INTENT( in ) ::   kt        ! ocean time-step index 
    74       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  
    7576      ! 
    76       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    77       REAL(wp) ::   zu, zv       ! temporary scalars 
    78       REAL(wp), POINTER, DIMENSION(:,:,:) :: zhke 
     77      INTEGER  ::   id_dia_vrt_keg_int  = 1 ! TODO remove once flags set properly 
     78      INTEGER  ::   id_dia_vrt_keg_mean = 1 ! TODO remove once flags set properly 
     79      INTEGER  ::   ji, jj, jk              ! dummy loop indices 
     80      REAL(wp) ::   zu, zv                  ! temporary scalars 
     81      REAL(wp), POINTER, DIMENSION(:,:,:) :: zhke, zhkei, zhkej 
    7982      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv  
    8083      !!---------------------------------------------------------------------- 
     
    8285      IF( nn_timing == 1 )   CALL timing_start('dyn_keg') 
    8386      ! 
    84       CALL wrk_alloc( jpi,jpj,jpk,   zhke ) 
     87      CALL wrk_alloc( jpi,jpj,jpk,   zhke, zhkei, zhkej ) 
    8588      ! 
    8689      IF( kt == nit000 ) THEN 
     
    137140         DO jj = 2, jpjm1 
    138141            DO ji = fs_2, fs_jpim1   ! vector opt. 
    139                ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 
    140                va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 
     142               zhkei(ji,jj,jk) = - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 
     143               zhkej(ji,jj,jk) = - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 
     144               ua(ji,jj,jk) = ua(ji,jj,jk) + zhkei(ji,jj,jk) 
     145               va(ji,jj,jk) = va(ji,jj,jk) + zhkej(ji,jj,jk) 
    141146            END DO  
    142147         END DO 
    143148      END DO 
     149      ! 
     150      IF ( ( id_dia_vrt_keg_int == 1 ) .or. ( id_dia_vrt_keg_mean == 1 ) ) THEN 
     151          CALL dyn_vrt_dia(zhkei, zhkej, id_dia_vrt_keg_int, id_dia_vrt_keg_mean) 
     152      END IF 
    144153      ! 
    145154      IF( l_trddyn ) THEN                 ! save the Kinetic Energy trends for diagnostic 
     
    153162         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    154163      ! 
    155       CALL wrk_dealloc( jpi,jpj,jpk,   zhke ) 
     164      CALL wrk_dealloc( jpi,jpj,jpk,   zhke, zhkei, zhkej ) 
    156165      ! 
    157166      IF( nn_timing == 1 )   CALL timing_stop('dyn_keg') 
  • branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90

    r6486 r7649  
    1919   USE dom_oce         ! ocean space and time domain 
    2020   USE ldfdyn_oce      ! ocean dynamics: lateral physics 
     21   USE divcur          ! for dyn_vrt_dia 
    2122   ! 
    2223   USE in_out_manager  ! I/O manager 
     
    7576      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7677      ! 
     78      INTEGER  :: id_dia_vrt_ldf_int  = 1      ! TODO remove once flags set properly 
     79      INTEGER  :: id_dia_vrt_ldf_mean = 1      ! TODO remove once flags set properly 
    7780      INTEGER  ::   ji, jj, jk                  ! dummy loop indices 
    78       REAL(wp) ::   zua, zva, zbt, ze2u, ze2v   ! temporary scalar 
     81      REAL(wp) ::   zbt, ze2u, ze2v             ! temporary scalar 
    7982      REAL(wp), POINTER, DIMENSION(:,:  ) :: zcu, zcv 
    80       REAL(wp), POINTER, DIMENSION(:,:,:) :: zuf, zut, zlu, zlv 
     83      REAL(wp), POINTER, DIMENSION(:,:,:) :: zuf, zut, zlu, zlv, zua, zva 
    8184      !!---------------------------------------------------------------------- 
    8285      ! 
     
    8487      ! 
    8588      CALL wrk_alloc( jpi, jpj,      zcu, zcv           ) 
    86       CALL wrk_alloc( jpi, jpj, jpk, zuf, zut, zlu, zlv )  
     89      CALL wrk_alloc( jpi, jpj, jpk, zuf, zut, zlu, zlv, zua, zva )  
    8790      ! 
    8891      IF( kt == nit000 .AND. lwp ) THEN 
     
    191194               ze2v = e1v(ji,jj) * fse3v(ji,jj,jk) 
    192195               ! horizontal biharmonic diffusive trends 
    193                zua = - ( zuf(ji  ,jj,jk) - zuf(ji,jj-1,jk) ) / ze2u   & 
    194                   &  + ( zut(ji+1,jj,jk) - zut(ji,jj  ,jk) ) / e1u(ji,jj) 
    195  
    196                zva = + ( zuf(ji,jj  ,jk) - zuf(ji-1,jj,jk) ) / ze2v   & 
    197                   &  + ( zut(ji,jj+1,jk) - zut(ji  ,jj,jk) ) / e2v(ji,jj) 
     196               zua(ji,jj,jk) = - ( zuf(ji  ,jj,jk) - zuf(ji,jj-1,jk) ) / ze2u   & 
     197                  &  + ( zut(ji+1,jj,jk) - zut(ji,jj  ,jk) ) / e1u(ji,jj)       & 
     198                  &  * ( fsahmu(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag )) 
     199               zva(ji,jj,jk) = + ( zuf(ji,jj  ,jk) - zuf(ji-1,jj,jk) ) / ze2v   & 
     200                  &  + ( zut(ji,jj+1,jk) - zut(ji  ,jj,jk) ) / e2v(ji,jj)       & 
     201                  &  * ( fsahmv(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag )) 
    198202               ! add it to the general momentum trends 
    199                ua(ji,jj,jk) = ua(ji,jj,jk) + zua * ( fsahmu(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag )) 
    200                va(ji,jj,jk) = va(ji,jj,jk) + zva * ( fsahmv(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag )) 
     203               ua(ji,jj,jk) = ua(ji,jj,jk) + zua(ji,jj,jk) 
     204               va(ji,jj,jk) = va(ji,jj,jk) + zva(ji,jj,jk) 
    201205            END DO 
    202206         END DO 
     
    205209      END DO                                           !   End of slab 
    206210      !                                                ! =============== 
     211      IF ( ( id_dia_vrt_ldf_int == 1 ) .or. ( id_dia_vrt_ldf_mean == 1 ) ) THEN 
     212          CALL dyn_vrt_dia(zua, zva, id_dia_vrt_ldf_int, id_dia_vrt_ldf_mean) 
     213      END IF 
     214      ! 
    207215      CALL wrk_dealloc( jpi, jpj,      zcu, zcv           ) 
    208       CALL wrk_dealloc( jpi, jpj, jpk, zuf, zut, zlu, zlv )  
     216      CALL wrk_dealloc( jpi, jpj, jpk, zuf, zut, zlu, zlv, zua, zva )  
    209217      ! 
    210218      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_bilap') 
  • branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r6486 r7649  
    3838   USE wrk_nemo       ! Memory Allocation 
    3939   USE timing         ! Timing 
     40   USE divcur         ! For dyn_vrt_dia 
    4041 
    4142 
     
    560561      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend 
    561562      !! 
     563      INTEGER  :: id_dia_vrt_vor_int = 1                          ! TODO remove once flags set properly 
     564      INTEGER  :: id_dia_vrt_vor_mn  = 1                          ! TODO remove once flags set properly 
    562565      INTEGER  ::   ji, jj, jk                                    ! dummy loop indices 
    563566      INTEGER  ::   ierr                                          ! local integer 
    564       REAL(wp) ::   zfac12, zua, zva                              ! local scalars 
     567      REAL(wp) ::   zfac12                                        ! local scalars 
    565568      REAL(wp) ::   zmsk, ze3                                     ! local scalars 
    566569      !                                                           !  3D workspace  
    567570      REAL(wp), POINTER    , DIMENSION(:,:  )         :: zwx, zwy, zwz 
    568571      REAL(wp), POINTER    , DIMENSION(:,:  )         :: ztnw, ztne, ztsw, ztse 
     572      REAL(wp), POINTER    , DIMENSION(:,:,:)         :: zua, zva 
    569573#if defined key_vvl 
    570574      REAL(wp), POINTER    , DIMENSION(:,:,:)         :: ze3f     !  3D workspace (lk_vvl=T) 
     
    578582      CALL wrk_alloc( jpi, jpj,      zwx , zwy , zwz        )  
    579583      CALL wrk_alloc( jpi, jpj,      ztnw, ztne, ztsw, ztse )  
     584      CALL wrk_alloc( jpi, jpj, jpk, zua, zva               )  
    580585#if defined key_vvl 
    581586      CALL wrk_alloc( jpi, jpj, jpk, ze3f                   ) 
     
    687692         DO jj = 2, jpjm1 
    688693            DO ji = fs_2, fs_jpim1   ! vector opt. 
    689                zua = + zfac12 / e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   & 
    690                   &                           + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) 
    691                zva = - zfac12 / e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   & 
    692                   &                           + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) ) 
    693                pua(ji,jj,jk) = pua(ji,jj,jk) + zua 
    694                pva(ji,jj,jk) = pva(ji,jj,jk) + zva 
     694               zua(ji,jj,jk) = + zfac12 / e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  )     & 
     695                  &                                     + ztnw(ji+1,jj) * zwy(ji+1,jj  )     & 
     696                  &                                     + ztse(ji,jj  ) * zwy(ji  ,jj-1)     & 
     697                  &                                     + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) 
     698               zva(ji,jj,jk) = - zfac12 / e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1)     & 
     699                  &                                     + ztse(ji,jj+1) * zwx(ji  ,jj+1)     & 
     700                  &                                     + ztnw(ji,jj  ) * zwx(ji-1,jj  )     & 
     701                  &                                     + ztne(ji,jj  ) * zwx(ji  ,jj  ) ) 
     702               pua(ji,jj,jk) = pua(ji,jj,jk) + zua(ji,jj,jk) 
     703               pva(ji,jj,jk) = pva(ji,jj,jk) + zva(ji,jj,jk) 
    695704            END DO   
    696705         END DO   
     
    698707      END DO                                           !   End of slab 
    699708      !                                                ! =============== 
     709      IF ( ( id_dia_vrt_vor_int == 1 ) .or. ( id_dia_vrt_vor_mn == 1 ) ) THEN 
     710          CALL dyn_vrt_dia(zua, zva, id_dia_vrt_vor_int, id_dia_vrt_vor_mn) 
     711      END IF 
     712      ! 
    700713      CALL wrk_dealloc( jpi, jpj,      zwx , zwy , zwz        )  
    701714      CALL wrk_dealloc( jpi, jpj,      ztnw, ztne, ztsw, ztse )  
     715      CALL wrk_dealloc( jpi, jpj, jpk, zua, zva               )  
    702716#if defined key_vvl 
    703717      CALL wrk_dealloc( jpi, jpj, jpk, ze3f                   ) 
  • branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

    r6486 r7649  
    1818   USE trd_oce        ! trends: ocean variables 
    1919   USE trddyn         ! trend manager: dynamics 
     20   USE divcur         ! for dyn_vrt_dia 
    2021   ! 
    2122   USE in_out_manager ! I/O manager 
     
    5960      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx 
    6061      ! 
    61       INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    62       REAL(wp) ::   zua, zva        ! temporary scalars 
     62      INTEGER  ::   id_dia_vrt_zad_int  = 1  ! TODO remove once flags set properly 
     63      INTEGER  ::   id_dia_vrt_zad_mean = 1  ! TODO remove once flags set properly 
     64      INTEGER  ::   ji, jj, jk               ! dummy loop indices 
    6365      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwuw , zwvw 
    6466      REAL(wp), POINTER, DIMENSION(:,:  ) ::  zww 
    6567      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
     68      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zua, zva 
    6669      !!---------------------------------------------------------------------- 
    6770      ! 
     
    6972      ! 
    7073      CALL wrk_alloc( jpi,jpj, zww )  
    71       CALL wrk_alloc( jpi,jpj,jpk, zwuw , zwvw )  
     74      CALL wrk_alloc( jpi,jpj,jpk, zwuw , zwvw, zua, zva )  
    7275      ! 
    7376      IF( kt == nit000 ) THEN 
     
    121124            DO ji = fs_2, fs_jpim1       ! vector opt. 
    122125               !                         ! vertical momentum advective trends 
    123                zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    124                zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 
     126               zua(ji,jj,jk) = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) /            & 
     127                   &                ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     128               zva(ji,jj,jk) = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) /            & 
     129                   &                ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 
    125130               !                         ! add the trends to the general momentum trends 
    126                ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
    127                va(ji,jj,jk) = va(ji,jj,jk) + zva 
     131               ua(ji,jj,jk) = ua(ji,jj,jk) + zua(ji,jj,jk) 
     132               va(ji,jj,jk) = va(ji,jj,jk) + zva(ji,jj,jk) 
    128133            END DO   
    129134         END DO   
     
    140145         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    141146      ! 
     147      IF ( ( id_dia_vrt_zad_int == 1 ) .or. ( id_dia_vrt_zad_mean == 1 ) ) THEN 
     148          CALL dyn_vrt_dia(zua, zva, id_dia_vrt_zad_int, id_dia_vrt_zad_mean) 
     149      END IF 
     150      ! 
    142151      CALL wrk_dealloc( jpi,jpj, zww )  
    143       CALL wrk_dealloc( jpi,jpj,jpk, zwuw , zwvw )  
     152      CALL wrk_dealloc( jpi,jpj,jpk, zwuw , zwvw, zua, zva )  
    144153      ! 
    145154      IF( nn_timing == 1 )  CALL timing_stop('dyn_zad') 
Note: See TracChangeset for help on using the changeset viewer.