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 6225 for branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/trcnam.F90 – NEMO

Ignore:
Timestamp:
2016-01-08T10:35:19+01:00 (8 years ago)
Author:
jamesharle
Message:

Update MPP_BDY_UPDATE branch to be consistent with head of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r4624 r6225  
    2020   USE oce_trc           ! shared variables between ocean and passive tracers 
    2121   USE trc               ! passive tracers common variables 
    22    USE trcnam_trp        ! Transport namelist 
    2322   USE trcnam_pisces     ! PISCES namelist 
    2423   USE trcnam_cfc        ! CFC SMS namelist 
    2524   USE trcnam_c14b       ! C14 SMS namelist 
    2625   USE trcnam_my_trc     ! MY_TRC SMS namelist 
    27    USE trdmod_oce        
    28    USE trdmod_trc_oce 
     26   USE trd_oce        
     27   USE trdtrc_oce 
    2928   USE iom               ! I/O manager 
    3029 
     
    3534   PUBLIC trc_nam      ! called in trcini 
    3635 
    37    !! * Substitutions 
    38 #  include "top_substitute.h90" 
    3936   !!---------------------------------------------------------------------- 
    4037   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    41    !! $Id$  
     38   !! $Id$ 
    4239   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4340   !!---------------------------------------------------------------------- 
    44  
    4541CONTAINS 
    46  
    4742 
    4843   SUBROUTINE trc_nam 
     
    5752      !!--------------------------------------------------------------------- 
    5853      INTEGER  ::   jn                  ! dummy loop indice 
    59       !                                        !   Parameters of the run  
    60       IF( .NOT. lk_offline ) CALL trc_nam_run 
    61        
    62       !                                        !  passive tracer informations 
    63       CALL trc_nam_trc 
    64        
    65       !                                        !   Parameters of additional diagnostics 
    66       CALL trc_nam_dia 
    67  
    68       !                                        !   namelist of transport 
    69       CALL trc_nam_trp 
    70  
    71  
    72       IF( ln_rsttr )                      ln_trcdta = .FALSE.   ! restart : no need of clim data 
    73       ! 
    74       IF( ln_trcdmp .OR. ln_trcdmp_clo )  ln_trcdta = .TRUE.   ! damping : need to have clim data 
    75       ! 
    76       IF( .NOT.ln_trcdta ) THEN 
    77          ln_trc_ini(:) = .FALSE. 
    78       ENDIF 
    79  
    80      IF(lwp) THEN                   ! control print 
     54      !                                   
     55      IF( .NOT.lk_offline )   CALL trc_nam_run     ! Parameters of the run  
     56      !                
     57                              CALL trc_nam_trc     ! passive tracer informations 
     58      !                                         
     59                              CALL trc_nam_dia     ! Parameters of additional diagnostics 
     60      !                                       
     61      ! 
     62      IF( ln_rsttr                     )   ln_trcdta     = .FALSE.   ! restart : no need of clim data 
     63      ! 
     64      IF( ln_trcdmp .OR. ln_trcdmp_clo )   ln_trcdta     = .TRUE.   ! damping : need to have clim data 
     65      ! 
     66      IF( .NOT.ln_trcdta               )   ln_trc_ini(:) = .FALSE. 
     67 
     68      IF(lwp) THEN                   ! control print 
    8169         WRITE(numout,*) 
    8270         WRITE(numout,*) ' Namelist : namtrc' 
     
    11098 
    11199       
    112       rdttrc(:) = rdttra(:) * FLOAT( nn_dttrc )   ! vertical profile of passive tracer time-step 
     100      rdttrc = rdt * FLOAT( nn_dttrc )   ! passive tracer time-step 
    113101   
    114102      IF(lwp) THEN                   ! control print 
    115103        WRITE(numout,*)  
    116         WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc(1) 
     104        WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc 
    117105        WRITE(numout,*)  
    118106      ENDIF 
    119107 
    120108 
    121 #if defined key_trdmld_trc || defined key_trdtrc 
     109#if defined key_trdmxl_trc || defined key_trdtrc 
    122110 
    123111         REWIND( numnat_ref )              ! Namelist namtrc_trd in reference namelist : Passive tracer trends 
     
    132120         IF(lwp) THEN 
    133121            WRITE(numout,*) 
    134             WRITE(numout,*) ' trd_mld_trc_init : read namelist namtrc_trd                    ' 
     122            WRITE(numout,*) ' trd_mxl_trc_init : read namelist namtrc_trd                    ' 
    135123            WRITE(numout,*) ' ~~~~~~~~~~~~~~~~                                               ' 
    136124            WRITE(numout,*) '   * frequency of trends diagnostics   nn_trd_trc             = ', nn_trd_trc 
    137125            WRITE(numout,*) '   * control surface type              nn_ctls_trc            = ', nn_ctls_trc 
    138             WRITE(numout,*) '   * restart for ML diagnostics        ln_trdmld_trc_restart  = ', ln_trdmld_trc_restart 
     126            WRITE(numout,*) '   * restart for ML diagnostics        ln_trdmxl_trc_restart  = ', ln_trdmxl_trc_restart 
    139127            WRITE(numout,*) '   * flag to diagnose trends of                                 ' 
    140             WRITE(numout,*) '     instantantaneous or mean ML T/S   ln_trdmld_trc_instant  = ', ln_trdmld_trc_instant 
     128            WRITE(numout,*) '     instantantaneous or mean ML T/S   ln_trdmxl_trc_instant  = ', ln_trdmxl_trc_instant 
    141129            WRITE(numout,*) '   * unit conversion factor            rn_ucf_trc             = ', rn_ucf_trc 
    142130            DO jn = 1, jptra 
     
    147135 
    148136 
     137      ! Call the ice module for tracers 
     138      ! ------------------------------- 
     139                                  CALL trc_nam_ice 
     140 
    149141      ! namelist of SMS 
    150142      ! ---------------       
     
    167159   END SUBROUTINE trc_nam 
    168160 
     161 
    169162   SUBROUTINE trc_nam_run 
    170163      !!--------------------------------------------------------------------- 
     
    175168      !!--------------------------------------------------------------------- 
    176169      NAMELIST/namtrc_run/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, ln_top_euler, & 
    177         &                  cn_trcrst_in, cn_trcrst_out 
    178  
     170        &                  cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out 
     171      ! 
    179172      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    180  
    181       !!--------------------------------------------------------------------- 
    182  
    183  
    184       IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 
     173      !!--------------------------------------------------------------------- 
     174      ! 
     175      IF(lwp) WRITE(numout,*) 'trc_nam_run : read the passive tracer namelists' 
    185176      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    186177 
     
    216207 
    217208 
     209   SUBROUTINE trc_nam_ice 
     210      !!--------------------------------------------------------------------- 
     211      !!                     ***  ROUTINE trc_nam_ice *** 
     212      !! 
     213      !! ** Purpose :   Read the namelist for the ice effect on tracers 
     214      !! 
     215      !! ** Method  : - 
     216      !! 
     217      !!--------------------------------------------------------------------- 
     218      INTEGER :: jn      ! dummy loop indices 
     219      INTEGER :: ios     ! Local integer output status for namelist read 
     220      ! 
     221      TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer 
     222      !! 
     223      NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer 
     224      !!--------------------------------------------------------------------- 
     225      ! 
     226      IF(lwp) THEN 
     227         WRITE(numout,*) 
     228         WRITE(numout,*) 'trc_nam_ice : Read the namelist for trc_ice' 
     229         WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
     230      ENDIF 
     231 
     232      IF( nn_timing == 1 )  CALL timing_start('trc_nam_ice') 
     233 
     234      ! 
     235      REWIND( numnat_ref )              ! Namelist namtrc_ice in reference namelist : Passive tracer input data 
     236      READ  ( numnat_ref, namtrc_ice, IOSTAT = ios, ERR = 901) 
     237 901  IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ', lwp ) 
     238 
     239      REWIND( numnat_cfg )              ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients 
     240      READ  ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 ) 
     241 902  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist', lwp ) 
     242 
     243      IF( lwp ) THEN 
     244         WRITE(numout,*) ' ' 
     245         WRITE(numout,*) ' Sea ice tracers option (nn_ice_tr) : ', nn_ice_tr 
     246         WRITE(numout,*) ' ' 
     247      ENDIF 
     248 
     249      ! Assign namelist stuff 
     250      DO jn = 1, jptra 
     251         trc_ice_ratio(jn)  = sn_tri_tracer(jn)%trc_ratio 
     252         trc_ice_prescr(jn) = sn_tri_tracer(jn)%trc_prescr 
     253         cn_trc_o      (jn) = sn_tri_tracer(jn)%ctrc_o 
     254      END DO 
     255 
     256      IF( nn_timing == 1 )   CALL timing_stop('trc_nam_ice') 
     257      ! 
     258   END SUBROUTINE trc_nam_ice 
     259 
     260 
    218261   SUBROUTINE trc_nam_trc 
    219262      !!--------------------------------------------------------------------- 
     
    223266      !! 
    224267      !!--------------------------------------------------------------------- 
    225       TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput 
    226       !! 
    227       NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo 
    228    
    229268      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    230269      INTEGER  ::   jn                  ! dummy loop indice 
     270      ! 
     271      TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput 
     272      !! 
     273      NAMELIST/namtrc/ sn_tracer, ln_trcdta, ln_trcdmp, ln_trcdmp_clo 
    231274      !!--------------------------------------------------------------------- 
    232275      IF(lwp) WRITE(numout,*) 
    233       IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 
     276      IF(lwp) WRITE(numout,*) 'trc_nam_trc : read the passive tracer namelists' 
    234277      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    235  
    236278 
    237279      REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables 
     
    249291         ctrcun    (jn) = TRIM( sn_tracer(jn)%clunit  ) 
    250292         ln_trc_ini(jn) =       sn_tracer(jn)%llinit 
     293#if defined key_my_trc 
     294         ln_trc_sbc(jn) =       sn_tracer(jn)%llsbc 
     295         ln_trc_cbc(jn) =       sn_tracer(jn)%llcbc 
     296         ln_trc_obc(jn) =       sn_tracer(jn)%llobc 
     297#endif 
    251298         ln_trc_wri(jn) =       sn_tracer(jn)%llsave 
    252299      END DO 
    253        
    254     END SUBROUTINE trc_nam_trc 
     300      ! 
     301   END SUBROUTINE trc_nam_trc 
    255302 
    256303 
     
    265312      !!                ( (PISCES, CFC, MY_TRC ) 
    266313      !!--------------------------------------------------------------------- 
     314      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    267315      INTEGER ::  ierr 
    268 #if defined key_trdmld_trc  || defined key_trdtrc 
     316      !! 
     317#if defined key_trdmxl_trc  || defined key_trdtrc 
    269318      NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 
    270          &                ln_trdmld_trc_restart, ln_trdmld_trc_instant, & 
     319         &                ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, & 
    271320         &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 
    272321#endif 
    273322      NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio 
    274  
    275       INTEGER  ::   ios                 ! Local integer output status for namelist read 
    276       !!--------------------------------------------------------------------- 
    277  
    278       IF(lwp) WRITE(numout,*)  
    279       IF(lwp) WRITE(numout,*) 'trc_nam_dia : read the passive tracer diagnostics options' 
    280       IF(lwp) WRITE(numout,*) '~~~~~~~' 
     323      !!--------------------------------------------------------------------- 
    281324 
    282325      IF(lwp) WRITE(numout,*) 
     
    339382   !!---------------------------------------------------------------------- 
    340383   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    341    !! $Id$  
     384   !! $Id$ 
    342385   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    343386   !!====================================================================== 
    344 END MODULE  trcnam 
     387END MODULE trcnam 
Note: See TracChangeset for help on using the changeset viewer.