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.
global.f90 in branches/2013/dev_rev4119_MERCATOR4_CONFMAN/NEMOGCM/TOOLS/SIREN/src – NEMO

source: branches/2013/dev_rev4119_MERCATOR4_CONFMAN/NEMOGCM/TOOLS/SIREN/src/global.f90 @ 4213

Last change on this file since 4213 was 4213, checked in by cbricaud, 10 years ago

first draft of the CONFIGURATION MANAGER demonstrator

File size: 4.2 KB
Line 
1!----------------------------------------------------------------------
2! NEMO system team, System and Interface for oceanic RElocable Nesting
3!----------------------------------------------------------------------
4!
5! MODULE: global
6!
7! DESCRIPTION:
8!> @brief This module defines global variables, and parameters that can't
9!> be associated with a module
10!
11!> @author
12!> J.paul
13! REVISION HISTORY:
14!> @date Nov, 2013 - Initial Version
15!
16!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
17!----------------------------------------------------------------------
18MODULE global
19   USE kind                         ! F90 kind parameter
20   USE netcdf
21
22   IMPLICIT NONE
23
24   PUBLIC :: dg_fill !< default fill value
25   PUBLIC :: ig_nsep !< number of separator listed
26   PUBLIC :: ig_ncom !< number of comment character listed
27   PUBLIC :: cg_sep  !< list of separator
28   PUBLIC :: cg_com  !< list of comment character
29
30   PUBLIC :: ig_npoint
31   PUBLIC :: jp_T
32   PUBLIC :: jp_U
33   PUBLIC :: jp_V
34   PUBLIC :: jp_F
35
36   PUBLIC :: ig_ndim
37   PUBLIC :: jp_I
38   PUBLIC :: jp_J
39   PUBLIC :: jp_K
40   PUBLIC :: jp_L
41
42   PUBLIC :: ig_maxvar  !< maximum number of variable
43   PUBLIC :: ig_maxmtx  !< matrix variable maximum dimension
44   PUBLIC :: ig_maxseg  !< maximum number of segment
45   PUBLIC :: ig_ghost   !< number of ghost cell
46
47   PUBLIC :: ig_ninterp      !< number of available interpolation method
48   PUBLIC :: cg_interp_list  !< list of interpolation name
49   
50   PUBLIC :: ig_nextrap      !< number of available extrapolation method
51   PUBLIC :: cg_extrap_list  !< list of extrapolation name
52   
53   PUBLIC :: ig_nfilter      !< number of available filter
54   PUBLIC :: cg_filter_list  !< list of filter name
55
56   PRIVATE
57   ! NOTE_avoid_public_variables_if_possible
58
59   INTEGER(i4)                             , PARAMETER :: ig_maxvar =200   !< maximum number of variable
60   INTEGER(i4)                             , PARAMETER :: ig_maxmtx =100   !< matrix variable maximum dimension (cf create_bathy)
61   INTEGER(i4)                             , PARAMETER :: ig_maxseg =50    !< maximum number of segment for each boundary
62
63   INTEGER(i4)                             , PARAMETER :: ig_nsep=2  !< number of separator listed
64   CHARACTER(1)     , DIMENSION(ig_nsep)   , PARAMETER :: cg_sep = (/'.','_'/) !< list of separator
65
66   INTEGER(i4)                             , PARAMETER :: ig_ncom=2  !< number of comment character listed
67   CHARACTER(1)     , DIMENSION(ig_ncom)   , PARAMETER :: cg_com = (/'#','!'/) !< list of comment character
68   
69   INTEGER(i4)                             , PARAMETER :: ig_ghost=1    !< number of ghost cell
70
71   INTEGER(i4)                             , PARAMETER :: ig_ninterp=3
72   CHARACTER(LEN=lc), DIMENSION(ig_ninterp), PARAMETER :: cg_interp_list = &
73   &  (/ 'nearest', &
74   &     'cubic  ', &
75   &     'linear '  /)
76
77   INTEGER(i4)                             , PARAMETER :: ig_nextrap=2
78   CHARACTER(LEN=lc), DIMENSION(ig_nextrap), PARAMETER :: cg_extrap_list = &
79   &  (/ 'dist_weight', &
80   &     'min_error  ' /)
81
82   INTEGER(i4)                             , PARAMETER :: ig_nfilter=5
83   CHARACTER(LEN=lc), DIMENSION(ig_nfilter), PARAMETER :: cg_filter_list = &
84   &  (/ 'butterworth', &
85   &     'blackman   ', &
86   &     'hamming    ', &
87   &     'hann       ', &
88   &     'gauss      '/)
89
90   REAL(dp)                                , PARAMETER :: dg_fill=NF90_FILL_DOUBLE !< default fill value
91   INTEGER(i4)                             , PARAMETER :: ig_fill=NF90_FILL_INT    !< default fill value
92
93   INTEGER(i4)                             , PARAMETER :: ig_npoint=4
94   INTEGER(i4)                             , PARAMETER :: jp_T=1
95   INTEGER(i4)                             , PARAMETER :: jp_U=2
96   INTEGER(i4)                             , PARAMETER :: jp_V=3
97   INTEGER(i4)                             , PARAMETER :: jp_F=4
98
99   INTEGER(i4)                             , PARAMETER :: ig_ndim=2
100   INTEGER(i4)                             , PARAMETER :: jp_I=1
101   INTEGER(i4)                             , PARAMETER :: jp_J=2
102   INTEGER(i4)                             , PARAMETER :: jp_K=3
103   INTEGER(i4)                             , PARAMETER :: jp_L=4
104
105END MODULE global
106
Note: See TracBrowser for help on using the repository browser.