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 6043 for branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90 – NEMO

Ignore:
Timestamp:
2015-12-14T10:27:28+01:00 (8 years ago)
Author:
timgraham
Message:

Merged head of trunk into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r5600 r6043  
    1818   USE oce_trc         ! ocean dynamics and tracers variables 
    1919   USE trc             ! ocean passive tracers variables 
    20    USE trcnam_trp      ! passive tracers transport namelist variables 
    2120   USE trcdta 
    2221   USE tradmp 
     
    2928   PRIVATE 
    3029 
    31    PUBLIC trc_dmp            ! routine called by step.F90 
    32    PUBLIC trc_dmp_clo        ! routine called by step.F90 
    33    PUBLIC trc_dmp_alloc      ! routine called by nemogcm.F90 
     30   PUBLIC trc_dmp       
     31   PUBLIC trc_dmp_clo    
     32   PUBLIC trc_dmp_alloc   
     33   PUBLIC trc_dmp_ini     
     34 
     35   INTEGER , PUBLIC ::   nn_zdmp_tr    ! = 0/1/2 flag for damping in the mixed layer 
     36   CHARACTER(LEN=200) , PUBLIC :: cn_resto_tr    !File containing restoration coefficient 
    3437 
    3538   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   restotr   ! restoring coeff. on tracers (s-1) 
     
    4043 
    4144   !! * Substitutions 
    42 #  include "top_substitute.h90" 
     45#  include "domzgr_substitute.h90" 
     46#  include "vectopt_loop_substitute.h90" 
    4347   !!---------------------------------------------------------------------- 
    4448   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    9094      IF( nn_timing == 1 )  CALL timing_start('trc_dmp') 
    9195      ! 
    92       ! 0. Initialization (first time-step only) 
    93       !    -------------- 
    94       IF( kt == nittrc000 ) CALL trc_dmp_init 
    95  
    9696      IF( l_trdtrc )   CALL wrk_alloc( jpi, jpj, jpk, ztrtrd )   ! temporary save of trends 
    9797      ! 
     
    171171   END SUBROUTINE trc_dmp 
    172172 
     173   SUBROUTINE trc_dmp_ini 
     174      !!---------------------------------------------------------------------- 
     175      !!                  ***  ROUTINE trc_dmp_ini  *** 
     176      !!  
     177      !! ** Purpose :   Initialization for the newtonian damping  
     178      !! 
     179      !! ** Method  :   read the nammbf namelist and check the parameters 
     180      !!              called by trc_dmp at the first timestep (nittrc000) 
     181      !!---------------------------------------------------------------------- 
     182      ! 
     183      INTEGER ::  ios                 ! Local integer output status for namelist read 
     184      INTEGER :: imask  !local file handle 
     185      ! 
     186      NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr 
     187      !!---------------------------------------------------------------------- 
     188 
     189      IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init') 
     190      ! 
     191 
     192      REWIND( numnat_ref )              ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping 
     193      READ  ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909) 
     194909   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist', lwp ) 
     195 
     196      REWIND( numnat_cfg )              ! Namelist namtrc_dmp in configuration namelist : Passive tracers newtonian damping 
     197      READ  ( numnat_cfg, namtrc_dmp, IOSTAT = ios, ERR = 910) 
     198910   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist', lwp ) 
     199      IF(lwm) WRITE ( numont, namtrc_dmp ) 
     200 
     201      IF(lwp) THEN                       ! Namelist print 
     202         WRITE(numout,*) 
     203         WRITE(numout,*) 'trc_dmp : Passive tracers newtonian damping' 
     204         WRITE(numout,*) '~~~~~~~' 
     205         WRITE(numout,*) '   Namelist namtrc_dmp : set damping parameter' 
     206         WRITE(numout,*) '      mixed layer damping option     nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)' 
     207         WRITE(numout,*) '      Restoration coeff file    cn_resto_tr = ', cn_resto_tr 
     208      ENDIF 
     209      ! 
     210      IF( lzoom .AND. .NOT.lk_c1d )   nn_zdmp_tr = 0           ! restoring to climatology at closed north or south boundaries 
     211      SELECT CASE ( nn_zdmp_tr ) 
     212      CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column' 
     213      CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)' 
     214      CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer' 
     215      CASE DEFAULT 
     216         WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr 
     217         CALL ctl_stop(ctmp1) 
     218      END SELECT 
     219 
     220      IF( .NOT.lk_c1d ) THEN 
     221         IF( .NOT. ln_tradmp )   & 
     222            &   CALL ctl_stop( 'passive trace damping need ln_tradmp to compute damping coef.' ) 
     223         ! 
     224         !                          ! Read damping coefficients from file 
     225         !Read in mask from file 
     226         CALL iom_open ( cn_resto_tr, imask) 
     227         CALL iom_get  ( imask, jpdom_autoglo, 'resto', restotr) 
     228         CALL iom_close( imask ) 
     229         ! 
     230      ENDIF 
     231      IF( nn_timing == 1 )  CALL timing_stop('trc_dmp_init') 
     232      ! 
     233   END SUBROUTINE trc_dmp_ini 
     234 
    173235   SUBROUTINE trc_dmp_clo( kt ) 
    174236      !!--------------------------------------------------------------------- 
     
    303365 
    304366 
    305    SUBROUTINE trc_dmp_init 
    306       !!---------------------------------------------------------------------- 
    307       !!                  ***  ROUTINE trc_dmp_init  *** 
    308       !!  
    309       !! ** Purpose :   Initialization for the newtonian damping  
    310       !! 
    311       !! ** Method  :   read the nammbf namelist and check the parameters 
    312       !!              called by trc_dmp at the first timestep (nittrc000) 
    313       !!---------------------------------------------------------------------- 
    314       ! 
    315       INTEGER :: imask  !local file handle 
    316  
    317       IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init') 
    318       ! 
    319  
    320       IF( lzoom )   nn_zdmp_tr = 0           ! restoring to climatology at closed north or south boundaries 
    321       SELECT CASE ( nn_zdmp_tr ) 
    322       CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column' 
    323       CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)' 
    324       CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer' 
    325       CASE DEFAULT 
    326          WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr 
    327          CALL ctl_stop(ctmp1) 
    328       END SELECT 
    329  
    330       IF( .NOT. ln_tradmp )   & 
    331          &   CALL ctl_stop( 'passive trace damping need key_tradmp to compute damping coef.' ) 
    332       ! 
    333       !                          ! Read damping coefficients from file 
    334       !Read in mask from file 
    335       CALL iom_open ( cn_resto_tr, imask) 
    336       CALL iom_get  ( imask, jpdom_autoglo, 'resto', restotr) 
    337       CALL iom_close( imask ) 
    338       ! 
    339       IF( nn_timing == 1 )  CALL timing_stop('trc_dmp_init') 
    340       ! 
    341    END SUBROUTINE trc_dmp_init 
    342  
    343367#else 
    344368   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.