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 7158 for branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/TOP_SRC/TRP – NEMO

Ignore:
Timestamp:
2016-10-29T01:21:05+02:00 (8 years ago)
Author:
clem
Message:

debug branch

Location:
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/TOP_SRC/TRP
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r5385 r7158  
    3232 
    3333   PUBLIC   trc_adv          ! routine called by step module 
    34    PUBLIC   trc_adv_alloc    ! routine called by nemogcm module 
    3534 
    3635   INTEGER ::   nadv   ! choice of the type of advection scheme 
    37    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra 
    38    !                                                    ! except at nitrrc000 (=rdttra) if neuler=0 
     36 
     37   REAL(wp) ::   r2dttrc  ! vertical profile time-step, = 2 rdt 
     38   !                                                    ! except at nitrrc000 (=rdt) if neuler=0 
    3939 
    4040   !! * Substitutions 
    … …  
    4747   !!---------------------------------------------------------------------- 
    4848CONTAINS 
    49  
    50    INTEGER FUNCTION trc_adv_alloc() 
    51       !!---------------------------------------------------------------------- 
    52       !!                  ***  ROUTINE trc_adv_alloc  *** 
    53       !!---------------------------------------------------------------------- 
    54  
    55       ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc ) 
    56  
    57       IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.') 
    58  
    59    END FUNCTION trc_adv_alloc 
    6049 
    6150 
    … …  
    8473 
    8574      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000 
    86          r2dt(:) =  rdttrc(:)           ! = rdttrc (use or restarting with Euler time stepping) 
     75         r2dttrc =  rdttrc           ! = rdttrc (use or restarting with Euler time stepping) 
    8776      ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1 
    88          r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
     77         r2dttrc = 2. * rdttrc       ! = 2 rdttrc (leapfrog) 
    8978      ENDIF 
    9079      !                                                   ! effective transport 
    … …  
    112101      ! 
    113102      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==! 
    114       CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )   !  2nd order centered 
    115       CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  TVD  
    116       CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra, ln_trcadv_msc_ups )   !  MUSCL  
    117       CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  MUSCL2  
    118       CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  UBS  
    119       CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  QUICKEST  
     103      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',          zun, zvn, zwn, trb, trn, tra, jptra )   !  2nd order centered 
     104      CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra )   !  TVD  
     105      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb,      tra, jptra, ln_trcadv_msc_ups )   !  MUSCL  
     106      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra )   !  MUSCL2  
     107      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra )   !  UBS  
     108      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra )   !  QUICKEST  
    120109      ! 
    121110      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==! 
    … …  
    123112         WRITE(charout, FMT="('adv1')")  ; CALL prt_ctl_trc_info(charout) 
    124113                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    125          CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
     114         CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra )           
    126115         WRITE(charout, FMT="('adv2')")  ; CALL prt_ctl_trc_info(charout) 
    127116                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    128          CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra, ln_trcadv_msc_ups  )           
     117         CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb,      tra, jptra, ln_trcadv_msc_ups  )           
    129118         WRITE(charout, FMT="('adv3')")  ; CALL prt_ctl_trc_info(charout) 
    130119                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    131          CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
     120         CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra )           
    132121         WRITE(charout, FMT="('adv4')")  ; CALL prt_ctl_trc_info(charout) 
    133122                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    134          CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
     123         CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra )           
    135124         WRITE(charout, FMT="('adv5')")  ; CALL prt_ctl_trc_info(charout) 
    136125                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    137          CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
     126         CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra )           
    138127         WRITE(charout, FMT="('adv6')")  ; CALL prt_ctl_trc_info(charout) 
    139128                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 

  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r6204 r7158  
    4141 
    4242   PUBLIC   trc_nxt          ! routine called by step.F90 
    43    PUBLIC   trc_nxt_alloc    ! routine called by nemogcm.F90 
    4443 
    45    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt 
     44   REAL(wp) ::   r2dttrc 
    4645 
    4746   !!---------------------------------------------------------------------- 
    … …  
    5150   !!---------------------------------------------------------------------- 
    5251CONTAINS 
    53  
    54    INTEGER FUNCTION trc_nxt_alloc() 
    55       !!---------------------------------------------------------------------- 
    56       !!                   ***  ROUTINE trc_nxt_alloc  *** 
    57       !!---------------------------------------------------------------------- 
    58       ALLOCATE( r2dt(jpk), STAT=trc_nxt_alloc ) 
    59       ! 
    60       IF( trc_nxt_alloc /= 0 )   CALL ctl_warn('trc_nxt_alloc : failed to allocate array') 
    61       ! 
    62    END FUNCTION trc_nxt_alloc 
    6352 
    6453 
    … …  
    117106 
    118107      ! set time step size (Euler/Leapfrog) 
    119       IF( neuler == 0 .AND. kt ==  nittrc000 ) THEN  ;  r2dt(:) =     rdttrc(:)   ! at nittrc000             (Euler) 
    120       ELSEIF( kt <= nittrc000 + nn_dttrc )     THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog) 
     108      IF( neuler == 0 .AND. kt ==  nittrc000 ) THEN  ;  r2dttrc =     rdttrc   ! at nittrc000             (Euler) 
     109      ELSEIF( kt <= nittrc000 + nn_dttrc )     THEN  ;  r2dttrc = 2.* rdttrc   ! at nit000 or nit000+1 (Leapfrog) 
    121110      ENDIF 
    122111 
    … …  
    147136         DO jn = 1, jptra 
    148137            DO jk = 1, jpkm1 
    149                zfact = 1.e0 / r2dt(jk)  
     138               zfact = 1.e0 / r2dttrc  
    150139               ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact  
    151140               CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) 

  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r6971 r7158  
    2727 
    2828   PUBLIC   trc_sbc   ! routine called by step.F90 
    29  
    30    REAL(wp) ::   r2dt  !  time-step at surface 
    3129 
    3230   !! * Substitutions 
    … …  
    8785 
    8886      IF( ln_top_euler) THEN 
    89          r2dt =  rdttrc(1)              ! = rdttrc (use Euler time stepping) 
     87         r2dt =  rdttrc              ! = rdttrc (use Euler time stepping) 
    9088      ELSE 
    9189         IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000 
    92             r2dt = rdttrc(1)           ! = rdttrc (restarting with Euler time stepping) 
     90            r2dt = rdttrc            ! = rdttrc (restarting with Euler time stepping) 
    9391         ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1 
    94             r2dt = 2. * rdttrc(1)       ! = 2 rdttrc (leapfrog) 
     92            r2dt = 2. * rdttrc       ! = 2 rdttrc (leapfrog) 
    9593         ENDIF 
    9694      ENDIF 

  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90

    r5385 r7158  
    2727 
    2828   PUBLIC   trc_zdf          ! called by step.F90  
    29    PUBLIC   trc_zdf_alloc    ! called by nemogcm.F90  
    3029 
    3130   INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used 
    3231      !                                ! defined from ln_zdf...  namlist logicals) 
    33    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  r2dt   ! vertical profile time-step, = 2 rdttra 
    34       !                                                 ! except at nittrc000 (=rdttra) if neuler=0 
     32   REAL(wp) ::  r2dttrc   ! vertical profile time-step, = 2 rdt 
     33      !                   ! except at nittrc000 (=rdt) if neuler=0 
    3534 
    3635   !! * Substitutions 
    … …  
    4544CONTAINS 
    4645    
    47    INTEGER FUNCTION trc_zdf_alloc() 
    48       !!---------------------------------------------------------------------- 
    49       !!                  ***  ROUTINE trc_zdf_alloc  *** 
    50       !!---------------------------------------------------------------------- 
    51       ALLOCATE( r2dt(jpk) , STAT=trc_zdf_alloc ) 
    52       ! 
    53       IF( trc_zdf_alloc /= 0 )   CALL ctl_warn('trc_zdf_alloc : failed to allocate array.') 
    54       ! 
    55    END FUNCTION trc_zdf_alloc 
    56  
    5746 
    5847   SUBROUTINE trc_zdf( kt ) 
    … …  
    7463 
    7564      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000 
    76          r2dt(:) =  rdttrc(:)           ! = rdttrc (use or restarting with Euler time stepping) 
     65         r2dttrc =  rdttrc           ! = rdttrc (use or restarting with Euler time stepping) 
    7766      ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1 
    78          r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
     67         r2dttrc = 2. * rdttrc       ! = 2 rdttrc (leapfrog) 
    7968      ENDIF 
    8069 
    … …  
    8675      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend 
    8776      CASE ( -1 )                                       ! esopa: test all possibility with control print 
    88          CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )  
     77         CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dttrc, nn_trczdf_exp, trb, tra, jptra )  
    8978         WRITE(charout, FMT="('zdf1 ')") ;  CALL prt_ctl_trc_info(charout) 
    9079                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    91          CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra )  
     80         CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc,                trb, tra, jptra )  
    9281         WRITE(charout, FMT="('zdf2 ')") ;  CALL prt_ctl_trc_info(charout) 
    9382                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    94       CASE ( 0 ) ;  CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme  
    95       CASE ( 1 ) ;  CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra )    !   implicit scheme           
     83      CASE ( 0 ) ;  CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dttrc, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme  
     84      CASE ( 1 ) ;  CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc,                trb, tra, jptra )    !   implicit scheme           
    9685 
    9786      END SELECT 
    … …  
    10089         DO jn = 1, jptra 
    10190            DO jk = 1, jpkm1 
    102                ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dt(jk) ) - ztrtrd(:,:,jk,jn) 
     91               ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dttrc ) - ztrtrd(:,:,jk,jn) 
    10392            END DO 
    10493            CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) 
Note: See TracChangeset for help on using the changeset viewer.