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 8882 for branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90 – NEMO

Ignore:
Timestamp:
2017-12-01T18:44:09+01:00 (6 years ago)
Author:
flavoni
Message:

dev_CNRS_2017 branch: merged dev_r7881_ENHANCE09_RK3 with trunk r8864

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r8698 r8882  
    3131   USE iom            ! I/O manager library 
    3232   USE lib_mpp        ! MPP library 
    33    USE wrk_nemo       ! Memory allocation 
    3433 
    3534   IMPLICIT NONE 
     
    4241 
    4342   !! * Substitutions 
    44 #  include "zdfddm_substitute.h90" 
    4543#  include "vectopt_loop_substitute.h90" 
    4644   !!---------------------------------------------------------------------- 
     
    8381      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   ptra    ! now tracer variable 
    8482      ! 
    85       INTEGER  ::   jk   ! loop indices 
    86       REAL(wp), POINTER, DIMENSION(:,:,:)  ::   zwt, zws, ztrdt, ztrds   ! 3D workspace 
    87       !!---------------------------------------------------------------------- 
    88       ! 
    89       CALL wrk_alloc( jpi, jpj, jpk, ztrds ) 
     83      INTEGER ::   jk   ! loop indices 
     84      REAL(wp),        DIMENSION(jpi,jpj,jpk) ::   ztrds             ! 3D workspace 
     85      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zwt, zws, ztrdt   ! 3D workspace 
     86      !!---------------------------------------------------------------------- 
    9087      !       
    9188      IF( .NOT. ALLOCATED( trdtx ) ) THEN      ! allocate trdtra arrays 
     
    104101                                 ztrds(:,:,:) = 0._wp 
    105102                                 CALL trd_tra_mng( trdt, ztrds, ktrd, kt ) 
     103 !!gm Gurvan, verify the jptra_evd trend please ! 
    106104         CASE( jptra_evd )   ;   avt_evd(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 
    107105         CASE DEFAULT                 ! other trends: masked trends 
     
    124122         CASE( jptra_zdfp )           ! diagnose the "PURE" Kz trend (here: just before the swap) 
    125123            !                         ! iso-neutral diffusion case otherwise jptra_zdf is "PURE" 
    126             CALL wrk_alloc( jpi, jpj, jpk, zwt, zws, ztrdt ) 
     124            ALLOCATE( zwt(jpi,jpj,jpk), zws(jpi,jpj,jpk), ztrdt(jpi,jpj,jpk) ) 
    127125            ! 
    128126            zwt(:,:, 1 ) = 0._wp   ;   zws(:,:, 1 ) = 0._wp            ! vertical diffusive fluxes 
     
    130128            DO jk = 2, jpk 
    131129               zwt(:,:,jk) = avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 
    132                zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 
     130               zws(:,:,jk) = avs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 
    133131            END DO 
    134132            ! 
     
    154152            CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt )   
    155153            ! 
    156             CALL wrk_dealloc( jpi, jpj, jpk, zwt, zws, ztrdt ) 
     154            DEALLOCATE( zwt, zws, ztrdt ) 
    157155            ! 
    158156         CASE DEFAULT                 ! other trends: mask and send T & S trends to trd_tra_mng 
     
    176174         ! 
    177175      ENDIF 
    178       ! 
    179       CALL wrk_dealloc( jpi, jpj, jpk, ztrds ) 
    180176      ! 
    181177   END SUBROUTINE trd_tra 
     
    307303      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    308304      INTEGER ::   ikbu, ikbv   ! local integers 
    309       REAL(wp), POINTER, DIMENSION(:,:)   ::   z2dx, z2dy   ! 2D workspace  
     305      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   z2dx, z2dy   ! 2D workspace  
    310306      !!---------------------------------------------------------------------- 
    311307      ! 
     
    316312      ! This total trend is done every time step 
    317313      CASE( jptra_tot  )   ;   CALL iom_put( "ttrd_tot" , ptrdx )           ! model total trend 
    318          CALL iom_put( "strd_tot" , ptrdy ) 
     314                               CALL iom_put( "strd_tot" , ptrdy ) 
    319315      END SELECT 
    320  
     316      ! 
    321317      ! These trends are done every second time step. When 1ts output is selected must go different (2ts) file from standard T-file 
    322318      IF( MOD( kt, 2 ) == 0 ) THEN 
    323319         SELECT CASE( ktrd ) 
    324          CASE( jptra_xad  )   ;   CALL iom_put( "ttrd_xad" , ptrdx )        ! x- horizontal advection 
    325             CALL iom_put( "strd_xad" , ptrdy ) 
    326          CASE( jptra_yad  )   ;   CALL iom_put( "ttrd_yad" , ptrdx )        ! y- horizontal advection 
    327             CALL iom_put( "strd_yad" , ptrdy ) 
    328          CASE( jptra_zad  )   ;   CALL iom_put( "ttrd_zad" , ptrdx )        ! z- vertical   advection 
    329             CALL iom_put( "strd_zad" , ptrdy ) 
    330             IF( ln_linssh ) THEN                   ! cst volume : adv flux through z=0 surface 
    331                CALL wrk_alloc( jpi, jpj, z2dx, z2dy ) 
    332                z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / e3t_n(:,:,1) 
    333                z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / e3t_n(:,:,1) 
    334                CALL iom_put( "ttrd_sad", z2dx ) 
    335                CALL iom_put( "strd_sad", z2dy ) 
    336                CALL wrk_dealloc( jpi, jpj, z2dx, z2dy ) 
    337             ENDIF 
    338          CASE( jptra_totad  ) ;   CALL iom_put( "ttrd_totad" , ptrdx )      ! total   advection 
    339             CALL iom_put( "strd_totad" , ptrdy ) 
    340          CASE( jptra_ldf  )   ;   CALL iom_put( "ttrd_ldf" , ptrdx )        ! lateral diffusion 
    341             CALL iom_put( "strd_ldf" , ptrdy ) 
    342          CASE( jptra_zdf  )   ;   CALL iom_put( "ttrd_zdf" , ptrdx )        ! vertical diffusion (including Kz contribution) 
    343             CALL iom_put( "strd_zdf" , ptrdy ) 
    344          CASE( jptra_zdfp )   ;   CALL iom_put( "ttrd_zdfp", ptrdx )        ! PURE vertical diffusion (no isoneutral contribution) 
    345             CALL iom_put( "strd_zdfp", ptrdy ) 
    346          CASE( jptra_evd )    ;   CALL iom_put( "ttrd_evd", ptrdx )         ! EVD trend (convection) 
    347             CALL iom_put( "strd_evd", ptrdy ) 
    348          CASE( jptra_dmp  )   ;   CALL iom_put( "ttrd_dmp" , ptrdx )        ! internal restoring (damping) 
    349             CALL iom_put( "strd_dmp" , ptrdy ) 
    350          CASE( jptra_bbl  )   ;   CALL iom_put( "ttrd_bbl" , ptrdx )        ! bottom boundary layer 
    351             CALL iom_put( "strd_bbl" , ptrdy ) 
    352          CASE( jptra_npc  )   ;   CALL iom_put( "ttrd_npc" , ptrdx )        ! static instability mixing 
    353             CALL iom_put( "strd_npc" , ptrdy ) 
    354          CASE( jptra_bbc  )   ;   CALL iom_put( "ttrd_bbc" , ptrdx )        ! geothermal heating   (only on temperature) 
    355          CASE( jptra_nsr  )   ;   CALL iom_put( "ttrd_qns" , ptrdx(:,:,1) ) ! surface forcing + runoff (ln_rnf=T) 
    356             CALL iom_put( "strd_cdt" , ptrdy(:,:,1) )        ! output as 2D surface fields 
    357          CASE( jptra_qsr  )   ;   CALL iom_put( "ttrd_qsr" , ptrdx )        ! penetrative solar radiat. (only on temperature) 
     320         CASE( jptra_xad  )   ;   CALL iom_put( "ttrd_xad"  , ptrdx )        ! x- horizontal advection 
     321                                  CALL iom_put( "strd_xad" , ptrdy ) 
     322         CASE( jptra_yad  )   ;   CALL iom_put( "ttrd_yad"  , ptrdx )        ! y- horizontal advection 
     323                                  CALL iom_put( "strd_yad" , ptrdy ) 
     324         CASE( jptra_zad  )   ;   CALL iom_put( "ttrd_zad"  , ptrdx )        ! z- vertical   advection 
     325                                  CALL iom_put( "strd_zad" , ptrdy ) 
     326                                  IF( ln_linssh ) THEN                   ! cst volume : adv flux through z=0 surface 
     327                                     ALLOCATE( z2dx(jpi,jpj), z2dy(jpi,jpj) ) 
     328                                     z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / e3t_n(:,:,1) 
     329                                     z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / e3t_n(:,:,1) 
     330                                     CALL iom_put( "ttrd_sad", z2dx ) 
     331                                     CALL iom_put( "strd_sad", z2dy ) 
     332                                     DEALLOCATE( z2dx, z2dy ) 
     333                                  ENDIF 
     334         CASE( jptra_totad  ) ;   CALL iom_put( "ttrd_totad", ptrdx )        ! total   advection 
     335                                  CALL iom_put( "strd_totad", ptrdy ) 
     336         CASE( jptra_ldf  )   ;   CALL iom_put( "ttrd_ldf"  , ptrdx )        ! lateral diffusion 
     337                                  CALL iom_put( "strd_ldf" , ptrdy ) 
     338         CASE( jptra_zdf  )   ;   CALL iom_put( "ttrd_zdf"  , ptrdx )        ! vertical diffusion (including Kz contribution) 
     339                                  CALL iom_put( "strd_zdf" , ptrdy ) 
     340         CASE( jptra_zdfp )   ;   CALL iom_put( "ttrd_zdfp" , ptrdx )        ! PURE vertical diffusion (no isoneutral contribution) 
     341                                  CALL iom_put( "strd_zdfp" , ptrdy ) 
     342         CASE( jptra_evd )    ;   CALL iom_put( "ttrd_evd"  , ptrdx )        ! EVD trend (convection) 
     343                                  CALL iom_put( "strd_evd"  , ptrdy ) 
     344         CASE( jptra_dmp  )   ;   CALL iom_put( "ttrd_dmp"  , ptrdx )        ! internal restoring (damping) 
     345                                  CALL iom_put( "strd_dmp" , ptrdy ) 
     346         CASE( jptra_bbl  )   ;   CALL iom_put( "ttrd_bbl"  , ptrdx )        ! bottom boundary layer 
     347                                  CALL iom_put( "strd_bbl" , ptrdy ) 
     348         CASE( jptra_npc  )   ;   CALL iom_put( "ttrd_npc"  , ptrdx )        ! static instability mixing 
     349                                  CALL iom_put( "strd_npc" , ptrdy ) 
     350         CASE( jptra_bbc  )   ;   CALL iom_put( "ttrd_bbc"  , ptrdx )        ! geothermal heating   (only on temperature) 
     351         CASE( jptra_nsr  )   ;   CALL iom_put( "ttrd_qns"  , ptrdx(:,:,1) ) ! surface forcing + runoff (ln_rnf=T) 
     352                                  CALL iom_put( "strd_cdt" , ptrdy(:,:,1) )        ! output as 2D surface fields 
     353         CASE( jptra_qsr  )   ;   CALL iom_put( "ttrd_qsr"  , ptrdx )        ! penetrative solar radiat. (only on temperature) 
    358354         END SELECT 
    359355         ! the Asselin filter trend  is also every other time step but needs to be lagged one time step 
     
    366362      END IF 
    367363      ! 
     364      ! These trends are done every second time step. When 1ts output is selected must go different (2ts) file from standard T-file 
     365      IF( MOD( kt, 2 ) == 0 ) THEN 
     366         SELECT CASE( ktrd ) 
     367         CASE( jptra_xad  )   ;   CALL iom_put( "ttrd_xad"  , ptrdx )         ! x- horizontal advection 
     368                                  CALL iom_put( "strd_xad"  , ptrdy ) 
     369         CASE( jptra_yad  )   ;   CALL iom_put( "ttrd_yad"  , ptrdx )         ! y- horizontal advection 
     370                                  CALL iom_put( "strd_yad"  , ptrdy ) 
     371         CASE( jptra_zad  )   ;   CALL iom_put( "ttrd_zad"  , ptrdx )         ! z- vertical   advection 
     372                                  CALL iom_put( "strd_zad"  , ptrdy ) 
     373                                  IF( ln_linssh ) THEN                   ! cst volume : adv flux through z=0 surface 
     374                                     ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) ) 
     375                                     z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / e3t_n(:,:,1) 
     376                                     z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / e3t_n(:,:,1) 
     377                                     CALL iom_put( "ttrd_sad", z2dx ) 
     378                                     CALL iom_put( "strd_sad", z2dy ) 
     379                                     DEALLOCATE( z2dx, z2dy ) 
     380                                  ENDIF 
     381         CASE( jptra_totad  ) ;   CALL iom_put( "ttrd_totad", ptrdx )         ! total   advection 
     382                                  CALL iom_put( "strd_totad", ptrdy ) 
     383         CASE( jptra_ldf  )   ;   CALL iom_put( "ttrd_ldf"  , ptrdx )         ! lateral diffusion 
     384                                  CALL iom_put( "strd_ldf"  , ptrdy ) 
     385         CASE( jptra_zdf  )   ;   CALL iom_put( "ttrd_zdf"  , ptrdx )         ! vertical diffusion (including Kz contribution) 
     386                                  CALL iom_put( "strd_zdf"  , ptrdy ) 
     387         CASE( jptra_zdfp )   ;   CALL iom_put( "ttrd_zdfp" , ptrdx )         ! PURE vertical diffusion (no isoneutral contribution) 
     388                                  CALL iom_put( "strd_zdfp" , ptrdy ) 
     389         CASE( jptra_evd )    ;   CALL iom_put( "ttrd_evd"  , ptrdx )         ! EVD trend (convection) 
     390                                  CALL iom_put( "strd_evd"  , ptrdy ) 
     391         CASE( jptra_dmp  )   ;   CALL iom_put( "ttrd_dmp"  , ptrdx )         ! internal restoring (damping) 
     392                                  CALL iom_put( "strd_dmp"  , ptrdy ) 
     393         CASE( jptra_bbl  )   ;   CALL iom_put( "ttrd_bbl"  , ptrdx )         ! bottom boundary layer 
     394                                  CALL iom_put( "strd_bbl"  , ptrdy ) 
     395         CASE( jptra_npc  )   ;   CALL iom_put( "ttrd_npc"  , ptrdx )         ! static instability mixing 
     396                                  CALL iom_put( "strd_npc"  , ptrdy ) 
     397         CASE( jptra_bbc  )   ;   CALL iom_put( "ttrd_bbc"  , ptrdx )         ! geothermal heating   (only on temperature) 
     398         CASE( jptra_nsr  )   ;   CALL iom_put( "ttrd_qns"  , ptrdx(:,:,1) )  ! surface forcing + runoff (ln_rnf=T) 
     399                                  CALL iom_put( "strd_cdt"  , ptrdy(:,:,1) )        ! output as 2D surface fields 
     400         CASE( jptra_qsr  )   ;   CALL iom_put( "ttrd_qsr"  , ptrdx )         ! penetrative solar radiat. (only on temperature) 
     401         END SELECT 
     402         ! the Asselin filter trend  is also every other time step but needs to be lagged one time step 
     403         ! Even when 1ts output is selected can go to the same (2ts) file as the trends plotted every even time step. 
     404      ELSEIF( MOD( kt, 2 ) == 1 ) THEN 
     405         SELECT CASE( ktrd ) 
     406         CASE( jptra_atf  )   ;   CALL iom_put( "ttrd_atf" , ptrdx )        ! asselin time Filter 
     407                                  CALL iom_put( "strd_atf" , ptrdy ) 
     408         END SELECT 
     409      ENDIF 
     410      ! 
    368411   END SUBROUTINE trd_tra_iom 
    369412 
Note: See TracChangeset for help on using the changeset viewer.