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 3317 for branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90 – NEMO

Ignore:
Timestamp:
2012-02-23T12:21:08+01:00 (12 years ago)
Author:
gm
Message:

Ediag branche: #927 restructuration of the trdicp computation - part I

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90

    r3316 r3317  
    1111#if  defined key_trdtra || defined key_trddyn || defined key_trdmld || defined key_trdvor || defined key_esopa 
    1212   !!---------------------------------------------------------------------- 
    13    !!   trd_mod          : manage the type of trend diagnostics 
    14    !!   trd_3Diom        : output 3D momentum and/or tracer trends using IOM 
    15    !!   trd_budget       : domain averaged budget of trends (including kinetic energy and tracer variance trends) 
    16    !!   trd_mod_init     : Initialization step 
    17    !!---------------------------------------------------------------------- 
    18    USE oce                     ! ocean dynamics and tracers variables 
    19    USE dom_oce                 ! ocean space and time domain variables 
    20    USE zdf_oce                 ! ocean vertical physics variables 
    21    USE trdmod_oce              ! ocean variables trends 
    22    USE ldftra_oce              ! ocean active tracers lateral physics 
    23    USE sbc_oce                 ! surface boundary condition: ocean 
    24    USE phycst                  ! physical constants 
    25    USE trdvor                  ! ocean vorticity trends  
    26    USE trdicp                  ! ocean bassin integral constraints properties 
    27    USE trdmld                  ! ocean active mixed layer tracers trends  
    28    USE in_out_manager          ! I/O manager 
    29    USE iom                 ! I/O manager library 
    30    USE lib_mpp                 ! MPP library 
    31    USE wrk_nemo                ! Memory allocation 
     13   !!   trd_mod       : manage the type of trend diagnostics 
     14   !!   trd_3Diom     : output 3D momentum and/or tracer trends using IOM 
     15   !!   trd_mod_init  : Initialization step 
     16   !!---------------------------------------------------------------------- 
     17   USE oce            ! ocean dynamics and tracers variables 
     18   USE dom_oce        ! ocean space and time domain variables 
     19   USE zdf_oce        ! ocean vertical physics variables 
     20   USE trdmod_oce     ! ocean variables trends 
     21   USE zdfbfr         ! bottom friction 
     22   USE ldftra_oce     ! ocean active tracers lateral physics 
     23   USE sbc_oce        ! surface boundary condition: ocean 
     24   USE phycst         ! physical constants 
     25   USE trdvor         ! ocean vorticity trends  
     26   USE trdicp         ! ocean bassin integral constraints properties 
     27   USE trdmld         ! ocean active mixed layer tracers trends  
     28   USE in_out_manager ! I/O manager 
     29   USE iom            ! I/O manager library 
     30   USE lib_mpp        ! MPP library 
     31   USE wrk_nemo       ! Memory allocation 
    3232 
    3333   IMPLICIT NONE 
     
    8989      IF( lk_trdvor .AND. ctype == 'DYN' ) THEN    ! II. Vorticity trends 
    9090         !                                         !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    91          SELECT CASE ( ktrd )  
    92          CASE ( jpdyn_trd_hpg )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_prg )   ! Hydrostatique Pressure Gradient  
    93          CASE ( jpdyn_trd_keg )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_keg )   ! KE Gradient  
    94          CASE ( jpdyn_trd_rvo )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_rvo )   ! Relative Vorticity  
    95          CASE ( jpdyn_trd_pvo )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_pvo )   ! Planetary Vorticity Term  
    96          CASE ( jpdyn_trd_ldf )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_ldf )   ! Horizontal Diffusion  
    97          CASE ( jpdyn_trd_zad )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_zad )   ! Vertical Advection  
    98          CASE ( jpdyn_trd_spg )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_spg )   ! Surface Pressure Grad.  
    99          CASE ( jpdyn_trd_zdf )                                                      ! Vertical Diffusion  
     91         SELECT CASE( ktrd )  
     92         CASE( jpdyn_trd_hpg )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_prg )   ! Hydrostatique Pressure Gradient  
     93         CASE( jpdyn_trd_keg )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_keg )   ! KE Gradient  
     94         CASE( jpdyn_trd_rvo )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_rvo )   ! Relative Vorticity  
     95         CASE( jpdyn_trd_pvo )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_pvo )   ! Planetary Vorticity Term  
     96         CASE( jpdyn_trd_ldf )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_ldf )   ! Horizontal Diffusion  
     97         CASE( jpdyn_trd_zad )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_zad )   ! Vertical Advection  
     98         CASE( jpdyn_trd_spg )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_spg )   ! Surface Pressure Grad.  
     99         CASE( jpdyn_trd_zdf )                                                      ! Vertical Diffusion  
    100100            ztswu(:,:) = 0.e0   ;   ztswv(:,:) = 0.e0 
    101101            DO jj = 2, jpjm1                                                             ! wind stress trends 
    102102               DO ji = fs_2, fs_jpim1   ! vector opt. 
    103                   ztswu(ji,jj) = ( utau_b(ji,jj) + utau(ji,jj) ) / ( fse3u(ji,jj,1) * rau0 ) 
    104                   ztswv(ji,jj) = ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( fse3v(ji,jj,1) * rau0 ) 
     103                  ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( fse3u(ji,jj,1) * rau0 ) 
     104                  ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( fse3v(ji,jj,1) * rau0 ) 
    105105               END DO 
    106106            END DO 
     
    157157 
    158158 
    159    SUBROUTINE trd_budget( ptrdx, ptrdy, ktrd, ctype, kt ) 
    160       !!--------------------------------------------------------------------- 
    161       !!                  ***  ROUTINE trd_budget  *** 
    162       !!  
    163       !! ** Purpose : integral constraint diagnostics for momentum and/or tracer trends 
    164       !!               
    165       !!---------------------------------------------------------------------- 
    166       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend  
    167       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend 
    168       INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
    169       CHARACTER(len=3)          , INTENT(in   ) ::   ctype   ! momentum or tracers trends type 'DYN'/'TRA' 
    170       INTEGER                   , INTENT(in   ) ::   kt      ! time step 
    171       !! 
    172       INTEGER ::   ji, jj   ! dummy loop indices 
    173       REAL(wp), POINTER, DIMENSION(:,:)  :: ztswu, ztswv, z2dx, z2dy   ! 2D workspace  
    174       !!---------------------------------------------------------------------- 
    175  
    176       CALL wrk_alloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy ) 
    177  
    178       IF( MOD(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN 
    179          ! 
    180          IF( lk_trdtra .AND. ctype == 'TRA' ) THEN       ! active tracer trends 
    181             SELECT CASE ( ktrd ) 
    182             CASE ( jptra_trd_ldf )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_ldf, ctype )   ! lateral diff 
    183             CASE ( jptra_trd_zdf )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_zdf, ctype )   ! vertical diff (Kz) 
    184             CASE ( jptra_trd_bbc )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_bbc, ctype )   ! bottom boundary cond 
    185             CASE ( jptra_trd_bbl )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_bbl, ctype )   ! bottom boundary layer 
    186             CASE ( jptra_trd_npc )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_npc, ctype )   ! static instability mixing 
    187             CASE ( jptra_trd_dmp )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_dmp, ctype )   ! damping 
    188             CASE ( jptra_trd_qsr )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_qsr, ctype )   ! penetrative solar radiat. 
    189             CASE ( jptra_trd_nsr )   ;   z2dx(:,:) = ptrdx(:,:,1)                          ! non solar radiation 
    190                                          z2dy(:,:) = ptrdy(:,:,1) 
    191                                          CALL trd_icp( z2dx , z2dy , jpicpt_nsr, ctype ) 
    192             CASE ( jptra_trd_xad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_xad, ctype )   ! x- horiz adv 
    193             CASE ( jptra_trd_yad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_yad, ctype )   ! y- horiz adv 
    194             CASE ( jptra_trd_zad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype )   ! z- vertical adv  
    195                                          !                                                 ! surface flux 
    196                                          IF( lk_vvl ) THEN                                      ! variable volume = zero 
    197                                             z2dx(:,:) = 0._wp 
    198                                             z2dy(:,:) = 0._wp 
    199                                          ELSE                                                   ! constant volume = wn*tsn/e3t 
    200                                             z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / fse3t(:,:,1) 
    201                                             z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / fse3t(:,:,1) 
    202                                          ENDIF 
    203                                          CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype )  
    204             END SELECT 
    205          ENDIF 
    206  
    207          IF( lk_trddyn .AND. ctype == 'DYN' ) THEN       ! momentum trends  
    208             ! 
    209             SELECT CASE ( ktrd ) 
    210             CASE( jpdyn_trd_hpg )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_hpg, ctype )   ! hydrost. pressure gradient 
    211             CASE( jpdyn_trd_spg )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_spg, ctype )   ! surface pressure grad. 
    212             CASE( jpdyn_trd_pvo )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_pvo, ctype )   ! planetary vorticity 
    213             CASE( jpdyn_trd_rvo )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_rvo, ctype )   ! relative  vorticity or metric term 
    214             CASE( jpdyn_trd_keg )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_keg, ctype )   ! KE gradient         or hor. advection 
    215             CASE( jpdyn_trd_zad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_zad, ctype )   ! vertical  advection  
    216             CASE( jpdyn_trd_ldf )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_ldf, ctype )   ! lateral  diffusion  
    217             CASE( jpdyn_trd_zdf )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_zdf, ctype )   ! vertical diffusion (icluding bfr & tau) 
    218                                         ztswu(:,:) = ( utau_b(ji,jj) + utau(ji,jj) ) / ( fse3u(:,:,1) * rau0 ) 
    219                                         ztswv(:,:) = ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( fse3v(:,:,1) * rau0 ) 
    220                                         CALL trd_icp( ztswu, ztswv, jpicpd_swf, ctype )   ! wind stress trends 
    221             CASE( jpdyn_trd_bfr )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_bfr, ctype )   ! bottom friction trends 
    222             END SELECT 
    223             ! 
    224          ENDIF 
    225          ! 
    226       ENDIF 
    227       ! 
    228       CALL wrk_dealloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy ) 
    229       ! 
    230    END SUBROUTINE trd_budget 
    231  
    232  
    233159   SUBROUTINE trd_3Diom( ptrdx, ptrdy, ktrd, ctype, kt ) 
    234160      !!--------------------------------------------------------------------- 
     
    244170      !! 
    245171      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    246       REAL(wp), POINTER, DIMENSION(:,:)   ::   z2dx, z2dy, ztswu, ztswv    ! 2D workspace  
    247       REAL(wp), POINTER, DIMENSION(:,:,:) ::   z3dx, z3dy                  ! 3D workspace  
     172      INTEGER ::   ikbu, ikbv   ! local integers 
     173      REAL(wp), POINTER, DIMENSION(:,:)   ::   z2dx, z2dy, ztswu, ztswv   ! 2D workspace  
     174      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z3dx, z3dy                 ! 3D workspace  
    248175      !!---------------------------------------------------------------------- 
    249176 
     
    253180         ! 
    254181         SELECT CASE( ktrd ) 
    255          CASE( jptra_trd_xad )   ;   CALL iom_put( "ttrd_xad", ptrdx )        ! x- horizontal advection 
    256                                      CALL iom_put( "strd_xad", ptrdy ) 
    257          CASE( jptra_trd_yad )   ;   CALL iom_put( "ttrd_yad", ptrdx )        ! y- horizontal advection 
    258                                      CALL iom_put( "strd_yad", ptrdy ) 
    259          CASE( jptra_trd_zad )   ;   CALL iom_put( "ttrd_zad", ptrdx )        ! z- vertical   advection 
    260                                      CALL iom_put( "strd_zad", ptrdy ) 
    261                                      IF( .NOT.lk_vvl ) THEN                   ! cst volume : adv flux through z=0 surface 
    262                                         z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / fse3t(:,:,1) 
    263                                         z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / fse3t(:,:,1) 
    264                                         CALL iom_put( "ttrd_sad", z2dx ) 
    265                                         CALL iom_put( "strd_sad", z2dy ) 
    266                                      ENDIF 
    267          CASE( jptra_trd_ldf )   ;   CALL iom_put( "ttrd_ldf", ptrdx )        ! lateral diffusion 
    268                                      CALL iom_put( "strd_ldf", ptrdy ) 
    269          CASE( jptra_trd_zdf )   ;   CALL iom_put( "ttrd_zdf", ptrdx )        ! vertical diffusion (including Kz contribution) 
    270                                      CALL iom_put( "strd_zdf", ptrdy ) 
    271          CASE( jptra_trd_dmp )   ;   CALL iom_put( "ttrd_dmp", ptrdx )        ! internal restoring (damping) 
    272                                      CALL iom_put( "strd_dmp", ptrdy ) 
    273          CASE( jptra_trd_bbl )   ;   CALL iom_put( "ttrd_bbl", ptrdx )        ! bottom boundary layer 
    274                                      CALL iom_put( "strd_bbl", ptrdy ) 
    275          CASE( jptra_trd_npc )   ;   CALL iom_put( "ttrd_npc", ptrdx )        ! static instability mixing 
    276                                      CALL iom_put( "strd_npc", ptrdy ) 
    277          CASE( jptra_trd_qsr )   ;   CALL iom_put( "ttrd_qsr", ptrdx )        ! penetrative solar radiat. (only on temperature) 
    278          CASE( jptra_trd_nsr )   ;   CALL iom_put( "ttrd_qns", ptrdx(:,:,1) ) ! non-solar     radiation   (only on temperature) 
    279          CASE( jptra_trd_bbc )   ;   CALL iom_put( "ttrd_bbc", ptrdx )        ! geothermal heating   (only on temperature) 
     182         CASE( jptra_trd_xad  )   ;   CALL iom_put( "ttrd_xad" , ptrdx )        ! x- horizontal advection 
     183                                      CALL iom_put( "strd_xad" , ptrdy ) 
     184         CASE( jptra_trd_yad  )   ;   CALL iom_put( "ttrd_yad" , ptrdx )        ! y- horizontal advection 
     185                                      CALL iom_put( "strd_yad" , ptrdy ) 
     186         CASE( jptra_trd_zad  )   ;   CALL iom_put( "ttrd_zad" , ptrdx )        ! z- vertical   advection 
     187                                      CALL iom_put( "strd_zad" , ptrdy ) 
     188                                      IF( .NOT.lk_vvl ) THEN                   ! cst volume : adv flux through z=0 surface 
     189                                         z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / fse3t(:,:,1) 
     190                                         z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / fse3t(:,:,1) 
     191                                         CALL iom_put( "ttrd_sad", z2dx ) 
     192                                         CALL iom_put( "strd_sad", z2dy ) 
     193                                      ENDIF 
     194         CASE( jptra_trd_ldf  )   ;   CALL iom_put( "ttrd_ldf" , ptrdx )        ! lateral diffusion 
     195                                      CALL iom_put( "strd_ldf" , ptrdy ) 
     196         CASE( jptra_trd_zdf  )   ;   CALL iom_put( "ttrd_zdf" , ptrdx )        ! vertical diffusion (including Kz contribution) 
     197                                      CALL iom_put( "strd_zdf" , ptrdy ) 
     198         CASE( jptra_trd_zdfp )   ;   CALL iom_put( "ttrd_zdfp", ptrdx )        ! PURE vertical diffusion (no isoneutral contribution) 
     199                                      CALL iom_put( "strd_zdfp", ptrdy ) 
     200         CASE( jptra_trd_dmp  )   ;   CALL iom_put( "ttrd_dmp" , ptrdx )        ! internal restoring (damping) 
     201                                      CALL iom_put( "strd_dmp" , ptrdy ) 
     202         CASE( jptra_trd_bbl  )   ;   CALL iom_put( "ttrd_bbl" , ptrdx )        ! bottom boundary layer 
     203                                      CALL iom_put( "strd_bbl" , ptrdy ) 
     204         CASE( jptra_trd_npc  )   ;   CALL iom_put( "ttrd_npc" , ptrdx )        ! static instability mixing 
     205                                      CALL iom_put( "strd_npc" , ptrdy ) 
     206         CASE( jptra_trd_nsr  )   ;   CALL iom_put( "ttrd_qns" , ptrdx )        ! surface forcing + runoff (ln_rnf=T) 
     207                                      CALL iom_put( "strd_cdt" , ptrdy ) 
     208         CASE( jptra_trd_qsr  )   ;   CALL iom_put( "ttrd_qsr" , ptrdx )        ! penetrative solar radiat. (only on temperature) 
     209         CASE( jptra_trd_bbc  )   ;   CALL iom_put( "ttrd_bbc" , ptrdx )        ! geothermal heating   (only on temperature) 
     210         CASE( jptra_trd_atf  )   ;   CALL iom_put( "ttrd_atf" , ptrdx )        ! asselin time Filter 
     211                                      CALL iom_put( "strd_atf" , ptrdy ) 
     212 
    280213         END SELECT 
    281214      ENDIF 
     
    322255                                     CALL iom_put( "utrd_tau", z2dx ) 
    323256                                     CALL iom_put( "vtrd_tau", z2dy ) 
    324          CASE( jpdyn_trd_bfr )   ;   CALL iom_put( "utrd_bfr", ptrdx )    ! bottom friction term 
    325                                      CALL iom_put( "vtrd_bfr", ptrdy ) 
     257         CASE( jpdyn_trd_bfr ) 
     258            IF( .NOT.ln_bfrimp )     CALL iom_put( "utrd_bfr", ptrdx )    ! bottom friction (explicit case) 
     259            IF( .NOT.ln_bfrimp )     CALL iom_put( "vtrd_bfr", ptrdy ) 
     260!!gm only valid if ln_bfrimp=T otherwise the bottom stress as to be recomputed.... 
     261 
     262         CASE( jpdyn_trd_atf )   ;   CALL iom_put( "utrd_atf", ptrdx )    ! asselin filter trends  
     263                                     CALL iom_put( "vtrd_atf", ptrdy ) 
     264            IF( ln_bfrimp ) THEN                                          ! bottom friction (implicit case) 
     265               z3dx(:,:,:) = 0._wp   ;   z3dy(:,:,:) = 0._wp                 ! after velocity known (now filed at this stage) 
     266               DO jk = 1, jpkm1 
     267                  DO jj = 2, jpjm1 
     268                     DO ji = 2, jpim1 
     269                        ikbu = mbku(ji,jj)          ! deepest ocean u- & v-levels 
     270                        ikbv = mbkv(ji,jj) 
     271                        z3dx(ji,jj,jk) = bfrua(ji,jj) * un(ji,jj,ikbu) / fse3u(ji,jj,ikbu) 
     272                        z3dy(ji,jj,jk) = bfrva(ji,jj) * vn(ji,jj,ikbv) / fse3v(ji,jj,ikbv) 
     273                     END DO 
     274                  END DO 
     275               END DO 
     276                                     CALL iom_put( "utrd_bfr", z3dx )    ! bottom friction (implicit) 
     277                                     CALL iom_put( "vtrd_bfr", z3dy ) 
     278            ENDIF 
     279            ! 
    326280         END SELECT 
    327281         ! 
Note: See TracChangeset for help on using the changeset viewer.