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.
trcnam_idtra.F90 in branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/TOP_SRC/IDTRA – NEMO

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcnam_idtra.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 4 years ago

The Dr Hook changes from my perl code.

File size: 6.4 KB
Line 
1MODULE trcnam_idtra
2   !!======================================================================
3   !!                         ***  MODULE trcnam_idtra  ***
4   !! TOP :   initialisation of some run parameters for IDEAL-TRACER chemical model
5   !!======================================================================
6   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trcnam.idtra.h90
7   !!----------------------------------------------------------------------
8#if defined key_idtra
9   !!----------------------------------------------------------------------
10   !!   'key_idtra'                                               IDEAL-TRACER tracers
11   !!----------------------------------------------------------------------
12   !! trc_nam_idtra      : IDEAL-TRACER model initialisation
13   !!----------------------------------------------------------------------
14   USE oce_trc         ! Ocean variables
15   USE par_trc         ! TOP parameters
16   USE trc             ! TOP variables
17   USE trcsms_idtra    ! IDEAL-TRACER specific variable
18   USE iom             ! I/O manager
19
20   USE yomhook, ONLY: lhook, dr_hook
21   USE parkind1, ONLY: jprb, jpim
22
23   IMPLICIT NONE
24   PRIVATE
25
26   PUBLIC   trc_nam_idtra   ! called by trcnam.F90 module
27
28   !!----------------------------------------------------------------------
29   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
30   !! $Id$
31   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
32   !!----------------------------------------------------------------------
33
34CONTAINS
35
36   SUBROUTINE trc_nam_idtra
37      !!-------------------------------------------------------------------
38      !!                  ***  ROUTINE trc_nam_idtra  ***
39      !!
40      !! ** Purpose :   Definition some run parameter for IDEAL-TRACER model
41      !!
42      !! ** Method  :   Read the namidtra namelist and check the parameter
43      !!       values called at the first timestep (nit000)
44      !!
45      !! ** input   :   Namelist namidtra
46      !!----------------------------------------------------------------------
47      INTEGER  :: numnatm_ref = -1   ! Logical unit for reference ID-TRA namelist
48      INTEGER  :: numnatm_cfg = -1   ! Logical unit for configuration ID-TRA namelist
49      INTEGER  :: numonc      = -1   ! Logical unit for output namelist
50      INTEGER  :: ios                 ! Local integer output status for namelist read
51      REAL(wp) :: tmp_decay          !! Years ; half time decay of our idealize tracer
52      REAL(wp) :: TDECyr, TDEC   
53      !! ----------------------------------------------------------------
54      NAMELIST/namidtra/tmp_decay
55      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
56      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
57      REAL(KIND=jprb)               :: zhook_handle
58
59      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRC_NAM_IDTRA'
60
61      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
62
63      !!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
64      !! Jpalm -- 4-11-2014
65      !! namelist for idealize tracer
66      !! only thing in namelist is the chosen half time decay
67      !! no atmospheric conditions, cause we do impose a surface concentration of 1,
68      !! and no additionnal diagnostics,
69      !! because the only thing we are interested in is the water mass concentration on this tracer.
70      !!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
71      IF(lwp) WRITE(numout,*)
72      IF(lwp) WRITE(numout,*) ' trc_nam_idtra: read IDEAL-TRACER namelist'
73      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
74      !!
75      !! Open the namelist file :
76      !!~~~~~~~~~~~~~~~~~~~~~~~~~~~~
77      CALL ctl_opn( numnatm_ref, 'namelist_idtra_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
78      CALL ctl_opn( numnatm_cfg, 'namelist_idtra_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
79      IF(lwm) CALL ctl_opn( numonc, 'output.namelist.idtra', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
80      !! Read the namelists :
81      !!~~~~~~~~~~~~~~~~~~~~~~~
82      !! First namelist of our idealize tracer :
83      !! read the decay 1/2 time of our tracer, to define in the namelist.
84      !! tmp_decay = 1y ; 10y ; 100y or 1000y depending of which water mass you want to track
85      !!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
86
87      REWIND( numnatm_ref )              ! Namelist namidtra in reference namelist : IDTRA parameters
88      READ  ( numnatm_ref, namidtra, IOSTAT = ios, ERR = 901)
89901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namidtra in reference namelist', lwp )
90
91      REWIND( numnatm_cfg )              ! Namelist namidtra in configuration namelist : IDTRA parameters
92      READ  ( numnatm_cfg, namidtra, IOSTAT = ios, ERR = 902 )
93902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namidtra in configuration namelist', lwp )
94      IF(lwm) WRITE ( numonc, namidtra )
95
96      IF(lwp) WRITE(numout,*) '   -  half time decay of our idealize tracer : ', tmp_decay
97
98      ! decroissance radioactive du traceur ideal
99      ! ---------------------------------------
100      ! TDECyr = 12.43/LOG(2.)             !! Tricium as example
101       TDECyr = tmp_decay/LOG(2.)          !! Idealise tracer -- with tmp_decay given in the idtracer namelist
102       TDEC = TDECyr*365.*24.*60.*60.      !! translate in second
103       FDEC = EXP( -rdt/TDEC )
104
105
106!! #if defined key_trc_diaadd  && ! defined key_iomput
107      !!
108      !!  -Here you can add tracers names to be read
109      !! in a namelist.
110      !!  -But this is not necessary with the iomput module
111      !! cause names are written in the Iodef file.
112      !!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
113
114!! #endif
115
116      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
117   END SUBROUTINE trc_nam_idtra
118
119#else
120   !!----------------------------------------------------------------------
121   !!  Dummy module :                                                No IDEAL-TRACER
122   !!----------------------------------------------------------------------
123CONTAINS
124   SUBROUTINE trc_nam_idtra                      ! Empty routine
125   INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
126   INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
127   REAL(KIND=jprb)               :: zhook_handle
128
129   CHARACTER(LEN=*), PARAMETER :: RoutineName='TRC_NAM_IDTRA'
130
131   IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
132
133   IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
134   END  SUBROUTINE  trc_nam_idtra
135#endif
136
137   !!======================================================================
138END MODULE trcnam_idtra
139
140
141
142
143
144
Note: See TracBrowser for help on using the repository browser.