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.
par_oce.F90 in branches/dev_2802_OBStools/NEMOGCM/TOOLS/OBSTOOLS/src – NEMO

source: branches/dev_2802_OBStools/NEMOGCM/TOOLS/OBSTOOLS/src/par_oce.F90 @ 3000

Last change on this file since 3000 was 3000, checked in by djlea, 12 years ago

Updated obstools. Addition of headers to programs which explain what each utility does and how to run it. All the programs now build using the naketools utility.

File size: 12.1 KB
Line 
1MODULE par_oce
2   !!======================================================================
3   !!                        ***  par_oce  ***
4   !! Ocean :   set the ocean parameters
5   !!======================================================================
6   !! History :  OPA  !  1991     (Imbard, Levy, Madec)  Original code
7   !!   NEMO     1.0  !  2004-01  (G. Madec, J.-M. Molines)  Free form and module
8   !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add jpts, jp_tem & jp_sal
9   !!----------------------------------------------------------------------
10   USE par_kind          ! kind parameters
11
12   IMPLICIT NONE
13   PUBLIC
14
15   !!----------------------------------------------------------------------
16   !!   Domain decomposition
17   !!----------------------------------------------------------------------
18   !! if we dont use massively parallel computer (parameters jpni=jpnj=1) so jpiglo=jpi and jpjglo=jpj
19   INTEGER, PUBLIC            ::   jpni         !: number of processors following i
20   INTEGER, PUBLIC            ::   jpnj         !: number of processors following j
21   INTEGER, PUBLIC            ::   jpnij        !: nb of local domain = nb of processors ( <= jpni x jpnj )
22   INTEGER, PUBLIC, PARAMETER ::   jpr2di = 0   !: number of columns for extra outer halo
23   INTEGER, PUBLIC, PARAMETER ::   jpr2dj = 0   !: number of rows    for extra outer halo
24   INTEGER, PUBLIC, PARAMETER ::   jpreci = 1   !: number of columns for overlap
25   INTEGER, PUBLIC, PARAMETER ::   jprecj = 1   !: number of rows    for overlap
26
27   !! Ocean Domain sizes
28   !! ------------------
29   !!   data           domain   (jpidta,jpjdta)
30   !!   global or zoom domain   (jpiglo,jpjglo)
31   !!   local          domain   ( jpi  , jpj  )
32   
33!#if   defined key_orca_r4
34!   !!---------------------------------------------------------------------
35!   !!   'key_orca_r4'   :                           global ocean : ORCA R4
36!   !!---------------------------------------------------------------------
37!#             include "par_ORCA_R4.h90"
38!#elif defined key_orca_r2
39!   !!---------------------------------------------------------------------
40!   !!   'key_orca_r2'   :                           global ocean : ORCA R4
41!   !!---------------------------------------------------------------------
42!#             include "par_ORCA_R2.h90"
43!#elif defined key_orca_r1
44!   !!---------------------------------------------------------------------
45!   !!   'key_orca_r1'   :                           global ocean : ORCA R1
46!   !!---------------------------------------------------------------------
47!#             include "par_ORCA_R1.h90"
48!#elif defined key_orca_r05
49!   !!---------------------------------------------------------------------
50!   !!   'key_orca_r05'  :                          global ocean : ORCA R05
51!   !!---------------------------------------------------------------------
52!#             include "par_ORCA_R05.h90"
53!#elif defined key_orca_r025
54!   !!---------------------------------------------------------------------
55!   !!   'key_orca_r025' :                         global ocean : ORCA R025
56!   !!---------------------------------------------------------------------
57!#             include "par_ORCA_R025.h90"
58!#elif defined key_eel_r2
59!   !!---------------------------------------------------------------------
60!   !!   'key_eel_r2'    :                                 channel : EEL R2
61!   !!---------------------------------------------------------------------
62!#             include "par_EEL_R2.h90"
63!#elif defined key_eel_r5
64!   !!---------------------------------------------------------------------
65!   !!   'key_eel_r5'    :                                 channel : EEL R5
66!   !!---------------------------------------------------------------------
67!#             include "par_EEL_R5.h90"
68!#elif defined key_eel_r6
69!   !!---------------------------------------------------------------------
70!   !!   'key_eel_r6'    :                                 channel : EEL R6
71!   !!---------------------------------------------------------------------
72!#             include "par_EEL_R6.h90"
73!#elif defined key_gyre
74!   !!---------------------------------------------------------------------
75!   !!   'key_gyre'      :                        mid-latitude basin : GYRE
76!   !!---------------------------------------------------------------------
77!#             include "par_GYRE.h90"
78!#elif defined key_pomme_r025
79!   !!---------------------------------------------------------------------
80!   !!   'key_pomme_r025':                        regional basin : POMME025
81!   !!---------------------------------------------------------------------
82!#             include "par_POMME_R025.h90"
83!#else
84   !!---------------------------------------------------------------------
85   !!   default option  :                               small closed basin
86   !!---------------------------------------------------------------------
87   CHARACTER(len=16), PUBLIC, PARAMETER ::   cp_cfg = "default"   !: name of the configuration
88   INTEGER          , PUBLIC, PARAMETER ::   jp_cfg = 0           !: resolution of the configuration
89
90   ! data size                                       !!! * size of all input files *
91   INTEGER, PUBLIC, PARAMETER ::   jpidta  = 10       !: 1st lateral dimension ( >= jpi )
92   INTEGER, PUBLIC, PARAMETER ::   jpjdta  = 12       !: 2nd    "         "    ( >= jpj )
93   INTEGER, PUBLIC, PARAMETER ::   jpkdta  = 31       !: number of levels      ( >= jpk )
94
95   ! global or zoom domain size                      !!! * computational domain *
96   INTEGER, PUBLIC, PARAMETER ::   jpiglo  = jpidta   !: 1st dimension of global domain --> i
97   INTEGER, PUBLIC, PARAMETER ::   jpjglo  = jpjdta   !: 2nd    -                  -    --> j
98   INTEGER, PUBLIC            ::   jpk     = jpkdta   !: number of vertical levels
99   ! zoom starting position
100   INTEGER, PUBLIC, PARAMETER ::   jpizoom =   1      !: left bottom (i,j) indices of the zoom
101   INTEGER, PUBLIC, PARAMETER ::   jpjzoom =   1      !: in data domain indices
102
103   ! Domain characteristics
104   INTEGER, PUBLIC, PARAMETER ::   jperio  =  0       !: lateral cond. type (between 0 and 6)
105   !                                                  !  = 0 closed                 ;   = 1 cyclic East-West
106   !                                                  !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot
107   !                                                  !  = 4 cyclic East-West AND North fold T-point pivot
108   !                                                  !  = 5 North fold F-point pivot
109   !                                                  !  = 6 cyclic East-West AND North fold F-point pivot
110
111   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
112   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
113   REAL(wp), PUBLIC, PARAMETER ::   pp_not_used       = 999999._wp   !: vertical grid parameter
114   REAL(wp), PUBLIC, PARAMETER ::   pp_to_be_computed = 999999._wp   !:    -      -       -
115
116
117   !! Horizontal grid parameters for domhgr
118   !! =====================================
119   INTEGER, PUBLIC, PARAMETER  ::   jphgr_msh = 0   !: type of horizontal mesh
120   !                                                !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
121   !                                                !  = 1 geographical mesh on the sphere with regular grid-spacing
122   !                                                !  = 2 f-plane with regular grid-spacing
123   !                                                !  = 3 beta-plane with regular grid-spacing
124   !                                                !  = 4 Mercator grid with T/U point at the equator
125
126   REAL(wp) , PUBLIC, PARAMETER ::   ppglam0  =    0.0_wp   !: longitude of first raw and column T-point (jphgr_msh = 1)
127   REAL(wp) , PUBLIC, PARAMETER ::   ppgphi0  =  -35.0_wp   !: latitude  of first raw and column T-point (jphgr_msh = 1)
128   !                                                        !  used for Coriolis & Beta parameters (jphgr_msh = 2 or 3)
129   REAL(wp) , PUBLIC, PARAMETER ::   ppe1_deg =    1.0_wp   !: zonal      grid-spacing (degrees)
130   REAL(wp) , PUBLIC, PARAMETER ::   ppe2_deg =    0.5_wp   !: meridional grid-spacing (degrees)
131   REAL(wp) , PUBLIC, PARAMETER ::   ppe1_m   = 5000.0_wp   !: zonal      grid-spacing (degrees)
132   REAL(wp) , PUBLIC, PARAMETER ::   ppe2_m   = 5000.0_wp   !: meridional grid-spacing (degrees)
133
134   !! Vertical grid parameter for domzgr
135   !! ==================================
136   REAL(wp), PUBLIC, PARAMETER ::   ppsur = -4762.96143546300_wp   !: ORCA r4, r2 and r05 coefficients
137   REAL(wp), PUBLIC, PARAMETER ::   ppa0  =   255.58049070440_wp   !: (default coefficients)
138   REAL(wp), PUBLIC, PARAMETER ::   ppa1  =   245.58132232490_wp   !:
139   REAL(wp), PUBLIC, PARAMETER ::   ppkth =    21.43336197938_wp   !:
140   REAL(wp), PUBLIC, PARAMETER ::   ppacr =     3.00000000000_wp   !:
141   !
142   !  If both ppa0 ppa1 and ppsur are specified to 0, then
143   !  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
144   REAL(wp), PUBLIC, PARAMETER ::   ppdzmin = 10._wp     !: Minimum vertical spacing
145   REAL(wp), PUBLIC, PARAMETER ::   pphmax  = 5000._wp   !: Maximum depth
146   !
147   LOGICAL , PUBLIC, PARAMETER ::   ldbletanh = .TRUE.   !: Use/do not use double tanf function for vertical coordinates
148   REAL(wp), PUBLIC, PARAMETER ::   ppa2  =   100.760928500000_wp   !: Double tanh function parameters
149   REAL(wp), PUBLIC, PARAMETER ::   ppkth2=    48.029893720000_wp   !:
150   REAL(wp), PUBLIC, PARAMETER ::   ppacr2=    13.000000000000_wp   !:
151   !
152!#endif
153
154
155   !!---------------------------------------------------------------------
156   !! Active tracer parameters
157   !!---------------------------------------------------------------------
158   INTEGER, PUBLIC, PARAMETER ::   jpts   = 2    !: Number of active tracers (=2, i.e. T & S )
159   INTEGER, PUBLIC, PARAMETER ::   jp_tem = 1    !: indice for temperature
160   INTEGER, PUBLIC, PARAMETER ::   jp_sal = 2    !: indice for salinity
161
162   !!---------------------------------------------------------------------
163   !! Domain Matrix size  (if AGRIF, they are not all parameters)
164   !!---------------------------------------------------------------------
165#if defined key_agrif
166   INTEGER, PUBLIC, PARAMETER ::   nbghostcells = 1                             !: number of ghost cells
167   INTEGER, PUBLIC            ::   nbcellsx     = jpiglo - 2 - 2*nbghostcells   !: number of cells in i-direction
168   INTEGER, PUBLIC            ::   nbcellsy     = jpjglo - 2 - 2*nbghostcells   !: number of cells in j-direction
169   !
170#endif
171   INTEGER, PUBLIC  ::   jpi   ! = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   !: first  dimension
172   INTEGER, PUBLIC  ::   jpj   ! = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   !: second dimension
173   INTEGER, PUBLIC  ::   jpk   ! = jpkdta                                             !: third dimension
174   INTEGER, PUBLIC  ::   jpim1 ! = jpi-1                                            !: inner domain indices
175   INTEGER, PUBLIC  ::   jpjm1 ! = jpj-1                                            !:   -     -      -
176   INTEGER, PUBLIC  ::   jpkm1 ! = jpk-1                                            !:   -     -      -
177   INTEGER, PUBLIC  ::   jpij  ! = jpi*jpj                                          !:  jpi x jpj
178
179   !!---------------------------------------------------------------------
180   !! Optimization/control flags
181   !!---------------------------------------------------------------------
182#if defined key_esopa
183   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .TRUE.   !: flag to activate the all options
184#else
185   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .FALSE.  !: flag to activate the all options
186#endif
187
188#if defined key_vectopt_loop
189   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .TRUE.   !: vector optimization flag
190#else
191   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .FALSE.  !: vector optimization flag
192#endif
193
194   !!----------------------------------------------------------------------
195   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
196   !! $Id: par_oce.F90 2715 2011-03-30 15:58:35Z rblod $
197   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
198   !!======================================================================
199END MODULE par_oce
Note: See TracBrowser for help on using the repository browser.