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 6772 for branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 – NEMO

Ignore:
Timestamp:
2016-07-01T18:02:45+02:00 (8 years ago)
Author:
cbricaud
Message:

clean in coarsening branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r5602 r6772  
    4949   USE agrif_opa_interp 
    5050#endif 
     51   USE crs 
    5152 
    5253   IMPLICIT NONE 
     
    5657   PUBLIC   tra_nxt_fix   ! to be used in trcnxt 
    5758   PUBLIC   tra_nxt_vvl   ! to be used in trcnxt 
     59   PUBLIC   tra_nxt_vvl_crs ! to be used in trcnxt 
    5860 
    5961   REAL(wp) ::   rbcp   ! Brown & Campana parameters for semi-implicit hpg 
     
    349351   END SUBROUTINE tra_nxt_vvl 
    350352 
     353  SUBROUTINE tra_nxt_vvl_crs( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt ) 
     354      !!---------------------------------------------------------------------- 
     355      !!                   ***  ROUTINE tra_nxt_vvl  *** 
     356      !! 
     357      !! ** Purpose :   Time varying volume: apply the Asselin time filter   
     358      !!                and swap the tracer fields. 
     359      !!  
     360      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields. 
     361      !!              - save in (ta,sa) a thickness weighted average over the three  
     362      !!             time levels which will be used to compute rdn and thus the semi- 
     363      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T) 
     364      !!              - swap tracer fields to prepare the next time_step. 
     365      !!                This can be summurized for tempearture as: 
     366      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T 
     367      !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )    
     368      !!             ztm = 0                                                       otherwise 
     369      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) 
     370      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] ) 
     371      !!             tn  = ta  
     372      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call) 
     373      !! 
     374      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step 
     375      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T) 
     376      !!---------------------------------------------------------------------- 
     377      INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index 
     378      INTEGER         , INTENT(in   )                               ::  kit000   ! first time step index 
     379      REAL(wp)        , INTENT(in   ), DIMENSION(jpk)               ::  p2dt     ! time-step 
     380      CHARACTER(len=3), INTENT(in   )                               ::  cdtype   ! =TRA or TRC (tracer indicator) 
     381      INTEGER         , INTENT(in   )                               ::  kjpt     ! number of tracers 
     382      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb      ! before tracer fields 
     383      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptn      ! now tracer fields 
     384      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  pta      ! tracer trend 
     385      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc   ! surface tracer content 
     386      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc_b ! before surface tracer content 
     387 
     388      !!      
     389      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf   ! local logical 
     390      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices 
     391      REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar 
     392      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      - 
     393      !!---------------------------------------------------------------------- 
     394      !!---------------------------------------------------------------------- 
     395      ! 
     396      IF( kt == kit000 )  THEN 
     397         IF(lwp) WRITE(numout,*) 
     398         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype 
     399         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     400      ENDIF 
     401      ! 
     402      IF( cdtype == 'TRA' )  THEN 
     403         ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg 
     404         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration 
     405         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs 
     406      ELSE 
     407         ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg 
     408         ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration 
     409         ll_rnf     = .FALSE.          ! passive tracers or NO river runoffs 
     410      ENDIF 
     411      ! 
     412      DO jn = 1, kjpt 
     413         DO jk = 1, jpkm1 
     414            zfact1 = atfp * p2dt(jk) 
     415            zfact2 = zfact1 / rau0 
     416            DO jj = 1, jpj 
     417               DO ji = 1, jpi 
     418                  ze3t_b = fse3t_b_crs(ji,jj,jk) 
     419                  ze3t_n = fse3t_n_crs(ji,jj,jk) 
     420                  ze3t_a = fse3t_a_crs(ji,jj,jk) 
     421                  !                                         ! tracer content at Before, now and after 
     422                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b 
     423                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n 
     424                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a 
     425                  ! 
     426                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b 
     427                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b 
     428                  ! 
     429                  ze3t_f = ze3t_n + atfp * ze3t_d 
     430                  ztc_f  = ztc_n  + atfp * ztc_d 
     431                  ! 
     432                  IF( jk == 1 ) THEN           ! first level  
     433                     ze3t_f = ze3t_f - zfact2 * ( emp_b_crs(ji,jj) - emp_crs(ji,jj) + rnf_crs(ji,jj) - rnf_b_crs(ji,jj) ) 
     434                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) ) 
     435                  ENDIF 
     436!cbr as it is a subroutine dedicated to crs, TRA options are not necessary 
     437!cbr                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )   &     ! solar penetration (temperature only) 
     438!cbr                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
     439!cbr 
     440!cbr                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )   &                  ! river runoffs 
     441!cbr                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
     442!cbr                     &                              * fse3t_n(ji,jj,jk) / h_rnf(ji,jj) 
     443 
     444                  ze3t_f = 1.e0 / ze3t_f 
     445                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered 
     446                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta 
     447                  ! 
     448                  IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only) 
     449                     ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d ) 
     450                     pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average 
     451                  ENDIF 
     452               END DO 
     453            END DO 
     454         END DO 
     455         !  
     456      END DO 
     457      ! 
     458   END SUBROUTINE tra_nxt_vvl_crs 
     459 
     460 
    351461   !!====================================================================== 
    352462END MODULE tranxt 
Note: See TracChangeset for help on using the changeset viewer.