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 9299 for branches/UKMO/r6232_tracer_advection/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90 – NEMO

Ignore:
Timestamp:
2018-02-01T13:12:00+01:00 (6 years ago)
Author:
jcastill
Message:

First implementation of tracers - it has not been properly tested yet

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/r6232_tracer_advection/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r9295 r9299  
    285285      !! ** Purpose :   output 3D tracer trends using IOM 
    286286      !!---------------------------------------------------------------------- 
    287       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend  
    288       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend 
    289       INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
    290       INTEGER                   , INTENT(in   ) ::   kt      ! time step 
    291       !! 
    292       INTEGER ::   ji, jj, jk   ! dummy loop indices 
    293       INTEGER ::   ikbu, ikbv   ! local integers 
    294       REAL(wp), POINTER, DIMENSION(:,:)   ::   z2dx, z2dy   ! 2D workspace  
    295       !!---------------------------------------------------------------------- 
    296       ! 
    297 !!gm Rq: mask the trends already masked in trd_tra, but lbc_lnk should probably be added 
    298       ! 
    299       SELECT CASE( ktrd ) 
    300       CASE( jptra_xad  )   ;   CALL iom_put( "ttrd_xad" , ptrdx )        ! x- horizontal advection 
    301                                CALL iom_put( "strd_xad" , ptrdy ) 
    302       CASE( jptra_yad  )   ;   CALL iom_put( "ttrd_yad" , ptrdx )        ! y- horizontal advection 
    303                                CALL iom_put( "strd_yad" , ptrdy ) 
    304       CASE( jptra_zad  )   ;   CALL iom_put( "ttrd_zad" , ptrdx )        ! z- vertical   advection 
    305                                CALL iom_put( "strd_zad" , ptrdy ) 
    306                                IF( .NOT. lk_vvl ) THEN                   ! cst volume : adv flux through z=0 surface 
    307                                   CALL wrk_alloc( jpi, jpj, z2dx, z2dy ) 
    308                                   z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / fse3t(:,:,1) 
    309                                   z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / fse3t(:,:,1) 
    310                                   CALL iom_put( "ttrd_sad", z2dx ) 
    311                                   CALL iom_put( "strd_sad", z2dy ) 
    312                                   CALL wrk_dealloc( jpi, jpj, z2dx, z2dy ) 
    313                                ENDIF 
    314       CASE( jptra_ldf  )   ;   CALL iom_put( "ttrd_ldf" , ptrdx )        ! lateral diffusion 
    315                                CALL iom_put( "strd_ldf" , ptrdy ) 
    316       CASE( jptra_zdf  )   ;   CALL iom_put( "ttrd_zdf" , ptrdx )        ! vertical diffusion (including Kz contribution) 
    317                                CALL iom_put( "strd_zdf" , ptrdy ) 
    318       CASE( jptra_zdfp )   ;   CALL iom_put( "ttrd_zdfp", ptrdx )        ! PURE vertical diffusion (no isoneutral contribution) 
    319                                CALL iom_put( "strd_zdfp", ptrdy ) 
    320       CASE( jptra_dmp  )   ;   CALL iom_put( "ttrd_dmp" , ptrdx )        ! internal restoring (damping) 
    321                                CALL iom_put( "strd_dmp" , ptrdy ) 
    322       CASE( jptra_bbl  )   ;   CALL iom_put( "ttrd_bbl" , ptrdx )        ! bottom boundary layer 
    323                                CALL iom_put( "strd_bbl" , ptrdy ) 
    324       CASE( jptra_npc  )   ;   CALL iom_put( "ttrd_npc" , ptrdx )        ! static instability mixing 
    325                                CALL iom_put( "strd_npc" , ptrdy ) 
    326       CASE( jptra_nsr  )   ;   CALL iom_put( "ttrd_qns" , ptrdx )        ! surface forcing + runoff (ln_rnf=T) 
    327                                CALL iom_put( "strd_cdt" , ptrdy ) 
    328       CASE( jptra_qsr  )   ;   CALL iom_put( "ttrd_qsr" , ptrdx )        ! penetrative solar radiat. (only on temperature) 
    329       CASE( jptra_bbc  )   ;   CALL iom_put( "ttrd_bbc" , ptrdx )        ! geothermal heating   (only on temperature) 
    330       CASE( jptra_atf  )   ;   CALL iom_put( "ttrd_atf" , ptrdx )        ! asselin time Filter 
    331                                CALL iom_put( "strd_atf" , ptrdy ) 
    332       END SELECT 
    333       ! 
     287      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend   
     288      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend  
     289      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index  
     290      INTEGER                   , INTENT(in   ) ::   kt      ! time step  
     291      !!  
     292      INTEGER ::   ji, jj, jk   ! dummy loop indices  
     293      INTEGER ::   ikbu, ikbv   ! local integers  
     294      REAL(wp), POINTER, DIMENSION(:,:)   ::   z2dx, z2dy   ! 2D workspace   
     295      !!----------------------------------------------------------------------  
     296      !  
     297      !!gm Rq: mask the trends already masked in trd_tra, but lbc_lnk should probably be added  
     298      !  
     299      ! These trends are done every second time step. When 1ts output is selected must go different (2ts) file from standard T-file  
     300      IF( MOD( kt, 2 ) == 0 ) THEN  
     301         SELECT CASE( ktrd )  
     302         CASE( jptra_xad  )   ;   CALL iom_put( "ttrd_xad" , ptrdx )        ! x- horizontal advection  
     303            CALL iom_put( "strd_xad" , ptrdy )  
     304         CASE( jptra_yad  )   ;   CALL iom_put( "ttrd_yad" , ptrdx )        ! y- horizontal advection  
     305            CALL iom_put( "strd_yad" , ptrdy )  
     306         CASE( jptra_zad  )   ;   CALL iom_put( "ttrd_zad" , ptrdx )        ! z- vertical   advection  
     307            CALL iom_put( "strd_zad" , ptrdy )  
     308            IF( .NOT. lk_vvl ) THEN                   ! cst volume : adv flux through z=0 surface  
     309               CALL wrk_alloc( jpi, jpj, z2dx, z2dy )  
     310               z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / fse3t(:,:,1)  
     311               z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / fse3t(:,:,1)  
     312               CALL iom_put( "ttrd_sad", z2dx )  
     313               CALL iom_put( "strd_sad", z2dy )  
     314               CALL wrk_dealloc( jpi, jpj, z2dx, z2dy )  
     315            ENDIF  
     316         CASE( jptra_ldf  )   ;   CALL iom_put( "ttrd_ldf" , ptrdx )        ! lateral diffusion  
     317            CALL iom_put( "strd_ldf" , ptrdy )  
     318         CASE( jptra_zdf  )   ;   CALL iom_put( "ttrd_zdf" , ptrdx )        ! vertical diffusion (including Kz contribution)  
     319            CALL iom_put( "strd_zdf" , ptrdy )  
     320         CASE( jptra_zdfp )   ;   CALL iom_put( "ttrd_zdfp", ptrdx )        ! PURE vertical diffusion (no isoneutral contribution)  
     321            CALL iom_put( "strd_zdfp", ptrdy )  
     322         CASE( jptra_dmp  )   ;   CALL iom_put( "ttrd_dmp" , ptrdx )        ! internal restoring (damping)  
     323            CALL iom_put( "strd_dmp" , ptrdy )  
     324         CASE( jptra_bbl  )   ;   CALL iom_put( "ttrd_bbl" , ptrdx )        ! bottom boundary layer  
     325            CALL iom_put( "strd_bbl" , ptrdy )  
     326         CASE( jptra_npc  )   ;   CALL iom_put( "ttrd_npc" , ptrdx )        ! static instability mixing  
     327            CALL iom_put( "strd_npc" , ptrdy )  
     328         CASE( jptra_bbc  )   ;   CALL iom_put( "ttrd_bbc" , ptrdx )        ! geothermal heating   (only on temperature)  
     329         CASE( jptra_nsr  )   ;   CALL iom_put( "ttrd_qns" , ptrdx(:,:,1) ) ! surface forcing + runoff (ln_rnf=T)  
     330            CALL iom_put( "strd_cdt" , ptrdy(:,:,1) )        ! output as 2D surface fields  
     331         CASE( jptra_qsr  )   ;   CALL iom_put( "ttrd_qsr" , ptrdx )        ! penetrative solar radiat. (only on temperature)  
     332         END SELECT  
     333         ! the Asselin filter trend  is also every other time step but needs to be lagged one time step  
     334         ! Even when 1ts output is selected can go to the same (2ts) file as the trends plotted every even time step.  
     335      ELSE IF( MOD( kt, 2 ) == 1 ) THEN  
     336         SELECT CASE( ktrd )  
     337         CASE( jptra_atf  )   ;   CALL iom_put( "ttrd_atf" , ptrdx )        ! asselin time Filter  
     338            CALL iom_put( "strd_atf" , ptrdy )  
     339         END SELECT  
     340      END IF  
     341      !  
    334342   END SUBROUTINE trd_tra_iom 
    335343 
Note: See TracChangeset for help on using the changeset viewer.