New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 9019 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90 – NEMO

Ignore:
Timestamp:
2017-12-13T15:58:53+01:00 (6 years ago)
Author:
timgraham
Message:

Merge of dev_CNRS_2017 into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90

    r6140 r9019  
    99 
    1010   !!---------------------------------------------------------------------- 
    11    !!   trd_glo      : domain averaged budget of trends (including kinetic energy and T^2 trends) 
    12    !!   glo_dyn_wri  : print dynamic trends in ocean.output file 
    13    !!   glo_tra_wri  : print global T & T^2 trends in ocean.output file 
    14    !!   trd_glo_init : initialization step 
     11   !!   trd_glo       : domain averaged budget of trends (including kinetic energy and T^2 trends) 
     12   !!   glo_dyn_wri   : print dynamic trends in ocean.output file 
     13   !!   glo_tra_wri   : print global T & T^2 trends in ocean.output file 
     14   !!   trd_glo_init  : initialization step 
    1515   !!---------------------------------------------------------------------- 
    16    USE oce             ! ocean dynamics and tracers variables 
    17    USE dom_oce         ! ocean space and time domain variables 
    18    USE sbc_oce         ! surface boundary condition: ocean 
    19    USE trd_oce         ! trends: ocean variables 
    20    USE phycst          ! physical constants 
    21    USE ldftra          ! lateral diffusion: eddy diffusivity & EIV coeff. 
    22    USE ldfdyn          ! ocean dynamics: lateral physics 
    23    USE zdf_oce         ! ocean vertical physics 
    24    USE zdfbfr          ! bottom friction 
    25    USE zdfddm          ! ocean vertical physics: double diffusion 
    26    USE eosbn2          ! equation of state 
    27    USE phycst          ! physical constants 
     16   USE oce            ! ocean dynamics and tracers variables 
     17   USE dom_oce        ! ocean space and time domain variables 
     18   USE sbc_oce        ! surface boundary condition: ocean 
     19   USE trd_oce        ! trends: ocean variables 
     20   USE phycst         ! physical constants 
     21   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff. 
     22   USE ldfdyn         ! ocean dynamics: lateral physics 
     23   USE zdf_oce        ! ocean vertical physics 
     24   USE zdfdrg         ! ocean vertical physics: bottom friction 
     25   USE zdfddm         ! ocean vertical physics: double diffusion 
     26   USE eosbn2         ! equation of state 
     27   USE phycst         ! physical constants 
    2828   ! 
    29    USE lib_mpp         ! distibuted memory computing library 
    30    USE in_out_manager  ! I/O manager 
    31    USE iom             ! I/O manager library 
    32    USE wrk_nemo        ! Memory allocation 
     29   USE lib_mpp        ! distibuted memory computing library 
     30   USE in_out_manager ! I/O manager 
     31   USE iom            ! I/O manager library 
    3332 
    3433   IMPLICIT NONE 
     
    5352   !! * Substitutions 
    5453#  include "vectopt_loop_substitute.h90" 
    55 #  include "zdfddm_substitute.h90" 
    5654   !!---------------------------------------------------------------------- 
    5755   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    7876      INTEGER ::   ikbu, ikbv      ! local integers 
    7977      REAL(wp)::   zvm, zvt, zvs, z1_2rau0   ! local scalars 
    80       REAL(wp), POINTER, DIMENSION(:,:)  :: ztswu, ztswv, z2dx, z2dy   ! 2D workspace  
    81       !!---------------------------------------------------------------------- 
    82  
    83       CALL wrk_alloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy ) 
    84  
     78      REAL(wp), DIMENSION(jpi,jpj)  :: ztswu, ztswv, z2dx, z2dy   ! 2D workspace  
     79      !!---------------------------------------------------------------------- 
     80      ! 
    8581      IF( MOD(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN 
    8682         ! 
     
    124120               DO jj = 1, jpjm1 
    125121                  DO ji = 1, jpim1 
    126                      zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
    127                         &                  * e1u    (ji  ,jj  ) * e2u    (ji,jj) * e3u_n(ji,jj,jk) 
    128                      zvs = ptrdy(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   & 
    129                         &                  * e1v    (ji  ,jj  ) * e2v    (ji,jj) * e3u_n(ji,jj,jk) 
     122                     zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
     123                        &                                     * e1e2u  (ji,jj) * e3u_n(ji,jj,jk) 
     124                     zvs = ptrdy(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   & 
     125                        &                                     * e1e2v  (ji,jj) * e3u_n(ji,jj,jk) 
    130126                     umo(ktrd) = umo(ktrd) + zvt 
    131127                     vmo(ktrd) = vmo(ktrd) + zvs 
     
    139135               DO jj = 1, jpjm1 
    140136                  DO ji = 1, jpim1 
    141                      zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
    142                         &                       * z1_2rau0 * e1u    (ji  ,jj  ) * e2u    (ji,jj) 
    143                      zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   & 
    144                         &                       * z1_2rau0 * e1v    (ji  ,jj  ) * e2v    (ji,jj) * e3u_n(ji,jj,jk) 
     137                     zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
     138                        &                                                     * z1_2rau0       * e1e2u(ji,jj) 
     139                     zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   & 
     140                        &                                                     * z1_2rau0       * e1e2v(ji,jj) 
    145141                     umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 
    146142                     vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs 
     
    152148            IF( ktrd == jpdyn_atf ) THEN     ! last trend (asselin time filter) 
    153149               ! 
    154                IF( ln_bfrimp ) THEN                   ! implicit bfr case: compute separately the bottom friction  
     150               IF( ln_drgimp ) THEN                   ! implicit drag case: compute separately the bottom friction  
    155151                  z1_2rau0 = 0.5_wp / rau0 
    156152                  DO jj = 1, jpjm1 
     
    158154                        ikbu = mbku(ji,jj)                  ! deepest ocean u- & v-levels 
    159155                        ikbv = mbkv(ji,jj) 
    160                         zvt = bfrua(ji,jj) * un(ji,jj,ikbu) * e1u(ji,jj) * e2v(ji,jj) 
    161                         zvs = bfrva(ji,jj) * vn(ji,jj,ikbv) * e1v(ji,jj) * e2v(ji,jj) 
     156                        zvt = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * un(ji,jj,ikbu) * e1e2u(ji,jj) 
     157                        zvs = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vn(ji,jj,ikbv) * e1e2v(ji,jj) 
    162158                        umo(jpdyn_bfri) = umo(jpdyn_bfri) + zvt 
    163159                        vmo(jpdyn_bfri) = vmo(jpdyn_bfri) + zvs 
     
    166162                  END DO 
    167163               ENDIF 
     164!!gm top drag case is missing  
    168165               !  
    169166               CALL glo_dyn_wri( kt )                 ! print the results in ocean.output 
     
    179176      ENDIF 
    180177      ! 
    181       CALL wrk_dealloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy ) 
    182       ! 
    183178   END SUBROUTINE trd_glo 
    184179 
     
    194189      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    195190      REAL(wp) ::   zcof         ! local scalar 
    196       REAL(wp), POINTER, DIMENSION(:,:,:)  ::  zkx, zky, zkz, zkepe   
    197       !!---------------------------------------------------------------------- 
    198  
    199       CALL wrk_alloc( jpi, jpj, jpk, zkx, zky, zkz, zkepe ) 
     191      REAL(wp), DIMENSION(jpi,jpj,jpk)  ::  zkx, zky, zkz, zkepe   
     192      !!---------------------------------------------------------------------- 
    200193 
    201194      ! I. Momentum trends 
     
    284277            &      + vmo(jpdyn_bfr) + vmo(jpdyn_atf) ) / tvolv 
    285278            WRITE (numout,9513) umo(jpdyn_tau) / tvolu, vmo(jpdyn_tau) / tvolv 
    286             IF( ln_bfrimp )   WRITE (numout,9514) umo(jpdyn_bfri) / tvolu, vmo(jpdyn_bfri) / tvolv 
     279            IF( ln_drgimp )   WRITE (numout,9514) umo(jpdyn_bfri) / tvolu, vmo(jpdyn_bfri) / tvolv 
    287280         ENDIF 
    288281 
     
    323316            &      + hke(jpdyn_bfr) + hke(jpdyn_atf) ) / tvolt 
    324317            WRITE (numout,9533) hke(jpdyn_tau) / tvolt 
    325             IF( ln_bfrimp )   WRITE (numout,9534) hke(jpdyn_bfri) / tvolt 
     318            IF( ln_drgimp )   WRITE (numout,9534) hke(jpdyn_bfri) / tvolt 
    326319         ENDIF 
    327320 
     
    373366      ENDIF 
    374367      ! 
    375       CALL wrk_dealloc( jpi, jpj, jpk, zkx, zky, zkz, zkepe ) 
    376       ! 
    377368   END SUBROUTINE glo_dyn_wri 
    378369 
Note: See TracChangeset for help on using the changeset viewer.