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.
trctrp_lec.F90 in branches/dev_001_GM/NEMO/TOP_SRC/TRP – NEMO

source: branches/dev_001_GM/NEMO/TOP_SRC/TRP/trctrp_lec.F90 @ 772

Last change on this file since 772 was 772, checked in by gm, 16 years ago

dev_001_GM - change the name of cpp key to key_top, key_lobster, key_pisces, key_kriest and the corresponding lk_

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 10.7 KB
Line 
1MODULE trctrp_lec
2   !!======================================================================
3   !!                       ***  MODULE  trctrp_lec  ***
4   !! TOP :   namelist read options for transport
5   !!======================================================================
6   !! History :   1.0  !  2004-03  (C. Ethe)  Original code
7   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
8   !!----------------------------------------------------------------------
9#if defined key_top
10   !!----------------------------------------------------------------------
11   !!   'key_top'                                                TOP models
12   !!----------------------------------------------------------------------
13   !!   trc_trp_lec  : read the passive tracer namelist for transport
14   !!----------------------------------------------------------------------
15   USE oce_trc             ! ocean dynamics and active tracers variables
16   USE trc                 ! ocean passive tracers variables
17
18   IMPLICIT NONE
19   PRIVATE
20
21   PUBLIC   trc_trp_lec    ! routine called by step module
22 
23   !                                                  !!: ** Advection (nam_traadv) **
24   LOGICAL , PUBLIC ::   ln_trcadv_cen2   = .FALSE.   !: 2nd order centered scheme flag
25   LOGICAL , PUBLIC ::   ln_trcadv_tvd    = .FALSE.   !: TVD scheme flag
26   LOGICAL , PUBLIC ::   ln_trcadv_muscl  = .FALSE.   !: MUSCL scheme flag
27   LOGICAL , PUBLIC ::   ln_trcadv_muscl2 = .FALSE.   !: MUSCL2 scheme flag
28   LOGICAL , PUBLIC ::   ln_trcadv_smolar = .TRUE.    !: Smolarkiewicz scheme flag
29
30   !                                                 !!: **  bottom boundary layer (nambbl) **
31   REAL(wp), PUBLIC ::   atrcbbl = 1.e+3              ! lateral coeff. for bottom boundary layer scheme (m2/s)
32
33   !                                                 !!: ** lateral mixing namelist (nam_trcldf) **
34   LOGICAL , PUBLIC ::   ln_trcldf_diff  = .FALSE.    !: flag of perform or not the lateral diff.
35   LOGICAL , PUBLIC ::   ln_trcldf_lap   = .TRUE.     !: laplacian operator
36   LOGICAL , PUBLIC ::   ln_trcldf_bilap = .FALSE.    !: bilaplacian operator
37   LOGICAL , PUBLIC ::   ln_trcldf_level = .FALSE.    !: iso-level direction
38   LOGICAL , PUBLIC ::   ln_trcldf_hor   = .FALSE.    !: horizontal (geopotential) direction
39   LOGICAL , PUBLIC ::   ln_trcldf_iso   = .TRUE.     !: iso-neutral direction
40
41   !                                                 !!: flag of the lateral diff. scheme used
42   LOGICAL , PUBLIC ::   l_trcldf_lap                 !: iso-level laplacian operator
43   LOGICAL , PUBLIC ::   l_trcldf_bilap               !: iso-level bilaplacian operator
44   LOGICAL , PUBLIC ::   l_trcldf_bilapg              !: geopotential bilap. (s-coord)
45   LOGICAL , PUBLIC ::   l_trcldf_iso                 !: iso-neutral laplacian or horizontal lapacian (s-coord)
46   LOGICAL , PUBLIC ::   l_trczdf_iso                 !: idem for the vertical component
47   LOGICAL , PUBLIC ::   l_trczdf_iso_vo              !: idem with vectopt_memory
48   LOGICAL , PUBLIC ::   l_trcldf_iso_zps             !: iso-neutral laplacian (partial steps)
49
50   !                                                 !!: ** Vertical diffusion (nam_trczdf) **
51   LOGICAL , PUBLIC ::   ln_trczdf_exp = .FALSE.      !: explicit vertical diffusion scheme flag
52
53   !                                                 !!: ** vertical diffusion (namzdf) **
54   INTEGER , PUBLIC ::   n_trczdf_exp = 3             !: number of sub-time step (explicit time stepping)
55
56   LOGICAL , PUBLIC ::   l_trczdf_exp     = .FALSE.   !: explicit vertical diffusion
57   LOGICAL , PUBLIC ::   l_trczdf_imp     = .FALSE.   !: implicit vertical diffusion
58
59#if defined key_trcdmp
60   !                                                 !!: ** newtonian damping namelist (nam_trcdmp) **
61   INTEGER  , PUBLIC ::   ndmptr   =   -1             !: = 0/-1/'latitude' for damping over tracers
62   INTEGER  , PUBLIC ::   ndmpftr  =    2             !: = 1 create a damping.coeff NetCDF file
63   INTEGER  , PUBLIC ::   nmldmptr =    0             !: = 0/1/2 flag for damping in the mixed layer
64
65   !                                                 !!: ** newtonian damping (namdmp) **
66   REAL(wp) , PUBLIC ::   sdmptr   =   50.            !: surface time scale for internal damping (days)
67   REAL(wp) , PUBLIC ::   bdmptr   =  360.            !: bottom time scale for internal damping (days)
68   REAL(wp) , PUBLIC ::   hdmptr   =  800.            !: depth of transition between sdmp and bdmp (meters)
69#endif
70   !!----------------------------------------------------------------------
71   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
72   !! $Id$
73   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
74   !!----------------------------------------------------------------------
75
76CONTAINS
77
78   SUBROUTINE trc_trp_lec
79      !!----------------------------------------------------------------------
80      !!                  ***  ROUTINE trc_trp_lec  ***
81      !!               
82      !! ** Purpose :   Read Namelist for tracer transport option
83      !!----------------------------------------------------------------------
84      NAMELIST/namtrcadv/ ln_trcadv_cen2 , ln_trcadv_tvd,   &
85         &                 ln_trcadv_muscl, ln_trcadv_muscl2, ln_trcadv_smolar
86#if  defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
87      NAMELIST/namtrcbbl/ atrcbbl
88#endif
89      NAMELIST/namtrcldf/  ln_trcldf_diff  , ln_trcldf_lap  , ln_trcldf_bilap, &
90         &                 ln_trcldf_level, ln_trcldf_hor, ln_trcldf_iso,   &
91         &                 ahtrc0, ahtrb0, aeivtr0, trcrat
92      NAMELIST/namtrczdf/ ln_trczdf_exp, n_trczdf_exp
93#if defined key_trcdmp
94      NAMELIST/namtrcdmp/ ndmptr, ndmpftr, nmldmptr, sdmptr, bdmptr, hdmptr
95#endif
96      !!----------------------------------------------------------------------
97
98      IF(lwp) WRITE(numout,*)
99      IF(lwp) WRITE(numout,*) ' trc_trp_lec: read namelist for tracer transport'
100      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
101
102      !                                ! tracer advection scheme
103      REWIND( numnat )                 !   ! Read Namelist namtrcadv
104      READ  ( numnat, namtrcadv )
105
106      IF(lwp) THEN                     !   ! Control print
107         WRITE(numout,*)
108         WRITE(numout,*) '   Namelist namtrcadv : chose a advection scheme for tracers'
109         WRITE(numout,*) '      2nd order advection scheme     ln_trcadv_cen2   = ', ln_trcadv_cen2
110         WRITE(numout,*) '      TVD advection scheme           ln_trcadv_tvd    = ', ln_trcadv_tvd
111         WRITE(numout,*) '      MUSCL  advection scheme        ln_trcadv_muscl  = ', ln_trcadv_muscl
112         WRITE(numout,*) '      MUSCL2 advection scheme        ln_trcadv_muscl2 = ', ln_trcadv_muscl2
113         WRITE(numout,*) '      SMOLARKIEWICZ advection scheme ln_trcadv_smolar = ', ln_trcadv_smolar
114      ENDIF
115
116#if  defined key_trcbbl_dif
117      !                                ! Bottom boundary layer
118      REWIND( numnat )                 !   ! Read Namelist namtrcbbl
119      READ  ( numnat, namtrcbbl )
120
121      IF(lwp) THEN                     !   ! Control print
122         WRITE(numout,*)
123         WRITE(numout,*) '   Namelist namtrcbbl : set Diffusive Bottom Boundary Layer parameters'
124         WRITE(numout,*) '      bottom boundary layer coef.    atrcbbl = ', atrcbbl
125# if defined key_trcbbl_adv
126         WRITE(numout,*) '   * Advective Bottom Boundary Layer'
127# endif
128      ENDIF
129#endif
130
131      !                                ! Lateral physics on tracers   
132      REWIND( numnat )                 !   ! Read Namelist namtrcldf
133      READ  ( numnat, namtrcldf )
134
135      IF(lwp) THEN                     !   ! Control print
136         WRITE(numout,*)
137         WRITE(numout,*) '   Namelist namtrcldf : set lateral mixing parameters (type, direction, coefficients)'
138         WRITE(numout,*) '      perform lateral diffusion or not               ln_trcldf_diff  = ', ln_trcldf_diff
139         WRITE(numout,*) '      laplacian operator                             ln_trcldf_lap   = ', ln_trcldf_lap
140         WRITE(numout,*) '      bilaplacian operator                           ln_trcldf_bilap = ', ln_trcldf_bilap
141         WRITE(numout,*) '      iso-level                                      ln_trcldf_level = ', ln_trcldf_level
142         WRITE(numout,*) '      horizontal (geopotential)                      ln_trcldf_hor   = ', ln_trcldf_hor
143         WRITE(numout,*) '      iso-neutral                                    ln_trcldf_iso   = ', ln_trcldf_iso
144         WRITE(numout,*) '      lateral eddy diffusivity                              ahtrc0   = ', ahtrc0
145         WRITE(numout,*) '      background hor. diffusivity                            ahtrb0  = ', ahtrb0
146         WRITE(numout,*) '      eddy induced velocity coef.                           aeivtr0  = ', aeivtr0
147         WRITE(numout,*) '      ratio between passive and active tracer diffusion coef  trcrat = ', trcrat
148      ENDIF
149
150      !                                ! Vertical mixing
151      REWIND( numnat )                 !   ! Read namtrczdf namelist
152      READ  ( numnat, namtrczdf )
153
154      IF(lwp) THEN                     !   ! Control print
155         WRITE(numout,*)
156         WRITE(numout,*) '   Namelist namtrczdf : set vertical diffusion parameters'
157         WRITE(numout,*) '      time splitting / backward scheme ln_trczdf_exp = ', ln_trczdf_exp
158         WRITE(numout,*) '      number of time step               n_trczdf_exp = ', n_trczdf_exp
159      ENDIF
160
161# if defined key_trcdmp
162      !                                ! passive tracres damping term
163      REWIND( numnat )                 !   ! Read Namelist namtdp
164      READ  ( numnat, namtrcdmp )
165      IF( lzoom )   nmldmptr = 0           ! restoring to climatology at closed north or south boundaries
166
167      IF(lwp) THEN                     !   ! Control print
168         WRITE(numout,*)
169         WRITE(numout,*) '   Namelist namtrcdmp : set damping parameter'
170         WRITE(numout,*) '      tracers damping option         ndmptr   = ', ndmptr
171         WRITE(numout,*) '      create a damping.coeff file    ndmpftr  = ', ndmpftr
172         WRITE(numout,*) '      mixed layer damping option     nmldmptr = ', nmldmptr, '(zoom: forced to 0)'
173         WRITE(numout,*) '      surface time scale (days)      sdmptr   = ', sdmptr
174         WRITE(numout,*) '      bottom time scale (days)       bdmptr   = ', bdmptr
175         WRITE(numout,*) '      depth of transition (meters)   hdmptr   = ', hdmptr
176      ENDIF
177#endif
178      !
179   END SUBROUTINE trc_trp_lec
180   
181#else
182   !!----------------------------------------------------------------------
183   !!   Dummy module :                                         No TOP model
184   !!----------------------------------------------------------------------
185CONTAINS
186   SUBROUTINE trc_trp_lec              ! Empty routine
187   END SUBROUTINE trc_trp_lec
188#endif
189
190  !!======================================================================
191END MODULE trctrp_lec
Note: See TracBrowser for help on using the repository browser.