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 NEMO/trunk/tools/SIREN/src – NEMO

source: NEMO/trunk/tools/SIREN/src/global.f90 @ 9598

Last change on this file since 9598 was 9598, checked in by nicolasmartin, 6 years ago

Reorganisation plan for NEMO repository: changes to make compilation succeed with new structure
Juste one issue left with AGRIF_NORDIC with AGRIF preprocessing
Standardisation of routines header with version 4.0 and year 2018
Fix for some broken symlinks

File size: 6.3 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.
9!
10!> @author
11!> J.paul
12! REVISION HISTORY:
13!> @date November, 2013 - Initial Version
14!> @date September, 2015
15!> - define fill value for each variable type
16!
17!> @note Software governed by the CeCILL licence     (./LICENSE)
18!----------------------------------------------------------------------
19MODULE global
20   USE kind                         ! F90 kind parameter
21   USE netcdf
22
23   IMPLICIT NONE
24
25   PUBLIC :: dp_fill         !< default fill value
26   PUBLIC :: ip_nsep         !< number of separator listed
27   PUBLIC :: ip_ncom         !< number of comment character listed
28   PUBLIC :: cp_sep          !< list of separator
29   PUBLIC :: cp_com          !< list of comment character
30
31   PUBLIC :: ip_npoint       !< number of point on ARAKAWA C-grid
32   PUBLIC :: jp_T            !< indice for T-point on ARAKAWA C-grid
33   PUBLIC :: jp_U            !< indice for U-point on ARAKAWA C-grid
34   PUBLIC :: jp_V            !< indice for V-point on ARAKAWA C-grid
35   PUBLIC :: jp_F            !< indice for F-point on ARAKAWA C-grid
36   PUBLIC :: cp_grid_point   !< list of grid_point character
37
38   PUBLIC :: ip_maxdim       !< maximum number of dimension to be used
39   PUBLIC :: jp_I            !< indice for I-direction
40   PUBLIC :: jp_J            !< indice for J-direction
41   PUBLIC :: jp_K            !< indice for K-direction
42   PUBLIC :: jp_L            !< indice for L-direction
43   PUBLIC :: cp_dimorder     !< dimension order
44
45   PUBLIC :: ip_maxvar       !< maximum number of variable
46   PUBLIC :: ip_maxmtx       !< matrix variable maximum dimension
47   PUBLIC :: ip_maxseg       !< maximum number of segment
48   PUBLIC :: ip_ghost        !< number of ghost cell
49
50   PUBLIC :: ip_ninterp      !< number of available interpolation method
51   PUBLIC :: cp_interp_list  !< list of interpolation name
52   
53   PUBLIC :: ip_nextrap      !< number of available extrapolation method
54   PUBLIC :: cp_extrap_list  !< list of extrapolation name
55   
56   PUBLIC :: ip_nfilter      !< number of available filter
57   PUBLIC :: cp_filter_list  !< list of filter name
58
59   PUBLIC :: ip_ncard        !< number of cardinal point
60   PUBLIC :: cp_card         !< array of cardinal point
61   PUBLIC :: jp_north        !< indice for north boundary
62   PUBLIC :: jp_south        !< indice for south boundary
63   PUBLIC :: jp_east         !< indice for east  boundary
64   PUBLIC :: jp_west         !< indice for west  boundary
65
66   ! NOTE_avoid_public_variables_if_possible
67
68   INTEGER(i4)                             , PARAMETER :: ip_maxvar =200   !< maximum number of variable
69   INTEGER(i4)                             , PARAMETER :: ip_maxmtx =50    !< matrix variable maximum dimension (cf create_bathy)
70   INTEGER(i4)                             , PARAMETER :: ip_maxseg =10    !< maximum number of segment for each boundary
71
72   INTEGER(i4)                             , PARAMETER :: ip_nsep=2        !< number of separator listed
73   CHARACTER(1)     , DIMENSION(ip_nsep)   , PARAMETER :: cp_sep = (/'.','_'/) !< list of separator
74
75   INTEGER(i4)                             , PARAMETER :: ip_ncom=2        !< number of comment character listed
76   CHARACTER(1)     , DIMENSION(ip_ncom)   , PARAMETER :: cp_com = (/'#','!'/) !< list of comment character
77   
78   INTEGER(i4)                             , PARAMETER :: ip_ghost=1       !< number of ghost cell
79
80   INTEGER(i4)                             , PARAMETER :: ip_ninterp=3
81   CHARACTER(LEN=lc), DIMENSION(ip_ninterp), PARAMETER :: cp_interp_list = &
82   &  (/ 'nearest', &
83   &     'cubic  ', &
84   &     'linear '  /)
85
86   INTEGER(i4)                             , PARAMETER :: ip_nextrap=2
87   CHARACTER(LEN=lc), DIMENSION(ip_nextrap), PARAMETER :: cp_extrap_list = &
88   &  (/ 'dist_weight', &
89   &     'min_error  ' /)
90
91   INTEGER(i4)                             , PARAMETER :: ip_nfilter=5
92   CHARACTER(LEN=lc), DIMENSION(ip_nfilter), PARAMETER :: cp_filter_list = &
93   &  (/ 'butterworth', &
94   &     'blackman   ', &
95   &     'hamming    ', &
96   &     'hann       ', &
97   &     'gauss      '/)
98
99   REAL(dp)                                , PARAMETER :: dp_fill_i1=NF90_FILL_BYTE   !< byte fill value
100   REAL(dp)                                , PARAMETER :: dp_fill_i2=NF90_FILL_SHORT  !< short fill value
101   REAL(dp)                                , PARAMETER :: dp_fill_i4=NF90_FILL_INT    !< INT fill value
102   REAL(dp)                                , PARAMETER :: dp_fill_sp=NF90_FILL_FLOAT  !< real fill value
103   REAL(dp)                                , PARAMETER :: dp_fill=NF90_FILL_DOUBLE    !< double fill value
104
105   INTEGER(i4)                             , PARAMETER :: ip_npoint=4
106   INTEGER(i4)                             , PARAMETER :: jp_T=1
107   INTEGER(i4)                             , PARAMETER :: jp_U=2
108   INTEGER(i4)                             , PARAMETER :: jp_V=3
109   INTEGER(i4)                             , PARAMETER :: jp_F=4
110   CHARACTER(LEN=1), DIMENSION(ip_npoint)  , PARAMETER :: cp_grid_point = &
111   &  (/ 'T', 'U', 'V', 'F' /)
112
113
114   INTEGER(i4)                             , PARAMETER :: ip_maxdimcfg=10 !< maximum allowed dimension in configuration file
115   INTEGER(i4)                             , PARAMETER :: ip_maxdim=4
116   INTEGER(i4)                             , PARAMETER :: jp_I=1
117   INTEGER(i4)                             , PARAMETER :: jp_J=2
118   INTEGER(i4)                             , PARAMETER :: jp_K=3
119   INTEGER(i4)                             , PARAMETER :: jp_L=4
120   CHARACTER(LEN=ip_maxdim)                , PARAMETER :: cp_dimorder = 'xyzt' !< dimension order to output
121
122   INTEGER(i4), PARAMETER :: ip_ncard=4
123   CHARACTER(LEN=lc), DIMENSION(ip_ncard), PARAMETER :: cp_card = &
124   &  (/ 'north', &
125   &     'south', &
126   &     'east ', &
127   &     'west ' /)
128
129   INTEGER(i4), PARAMETER :: jp_north=1
130   INTEGER(i4), PARAMETER :: jp_south=2
131   INTEGER(i4), PARAMETER :: jp_east =3
132   INTEGER(i4), PARAMETER :: jp_west =4
133
134   INTEGER(i4)                             , PARAMETER :: ip_maxdumcfg = 10 !< maximum dummy variable, dimension, or attribute
135                                                                            !< in configuration file
136
137END MODULE global
138
Note: See TracBrowser for help on using the repository browser.