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.
crs_dom.F90 in branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS – NEMO

source: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs_dom.F90 @ 3626

Last change on this file since 3626 was 3626, checked in by cetlod, 11 years ago

branch 2013/dev_r3411_CNRS4_IOCRS minor correction

File size: 13.8 KB
Line 
1MODULE crs_dom   
2   !!======================================================================
3   !!                         ***  MODULE crs_dom  ***
4   !!        Declare the coarse grid domain and other public variables
5   !!        then allocate them if needed.
6   !!======================================================================
7   !!  History     2012-06  Editing  (J. Simeon, G. Madec, C. Ethe) Original code
8   !!----------------------------------------------------------------------
9   USE dom_oce,  ONLY: jpk         ! For parameters in par_oce (jperio, lk_vvl) 
10   USE par_kind, ONLY: wp
11   USE par_oce,  ONLY: jpts
12
13   IMPLICIT NONE
14   PUBLIC
15
16   PUBLIC crs_dom_alloc  ! Called from crsini.F90
17
18      ! Domain variables
19      INTEGER  ::  jpiglo_crs ,   &             !: 1st dimension of global coarse grid domain
20                   jpjglo_crs                   !: 2nd dimension of global coarse grid domain
21      INTEGER  ::  jpi_crs ,   &                !: 1st dimension of local coarse grid domain
22                   jpj_crs                      !: 2nd dimension of local coarse grid domain
23      INTEGER  ::  jpi_full ,  &                !: 1st dimension of local parent grid domain
24                   jpj_full                     !: 2nd dimension of local parent grid domain
25
26      INTEGER  ::  jpi_crsm1, jpj_crsm1         !: loop indices     
27      INTEGER  ::  jpiglo_crsm1, jpjglo_crsm1   !: loop indices     
28      INTEGER  ::  nperio_full, nperio_crs      !: jperio of parent and coarse grids
29      INTEGER  ::  npolj_full, npolj_crs        !: north fold mark
30      INTEGER  ::  npiglo_full, npiglo_crs, npiglo      !: jpiglo
31      INTEGER  ::  npjglo_full, npjglo_crs, npjglo      !: jpjglo
32      INTEGER  ::  nlci_full, nlcj_full         !: i-, j-dimension of local or sub domain on parent grid
33      INTEGER  ::  nldi_full, nldj_full         !: starting indices of internal sub-domain on parent grid
34      INTEGER  ::  nlei_full, nlej_full         !: ending indices of internal sub-domain on parent grid
35      INTEGER  ::  nlci_crs, nlcj_crs           !: i-, j-dimension of local or sub domain on coarse grid
36      INTEGER  ::  nldi_crs, nldj_crs           !: starting indices of internal sub-domain on coarse grid
37      INTEGER  ::  nlei_crs, nlej_crs           !: ending indices of internal sub-domain on coarse grid
38      INTEGER  ::  narea_full, narea_crs        !: node
39      INTEGER  ::  jpnij_full, jpnij_crs        !: =jpni*jpnj, the pe decomposition
40      INTEGER  ::  jpim1_full, jpjm1_full       !:
41      INTEGER  ::  nimpp_full, njmpp_full       !: global position of point (1,1) of subdomain on parent grid
42      INTEGER  ::  nimpp_crs, njmpp_crs         !: set to 1,1 for now .  Valid only for monoproc
43
44
45      INTEGER, DIMENSION(:), ALLOCATABLE :: mis_crs, mie_crs, mjs_crs, mje_crs
46                                                ! starting and ending indices of parent subset
47      INTEGER  :: mxbinctr, mybinctr            ! central point in grid box
48 
49      ! Masks
50      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmask_crs, umask_crs, vmask_crs, fmask_crs
51      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: tmask_i_crs, rnfmsk_crs     
52
53      ! Scale factors
54      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1t_crs, e2t_crs, e1e2t_crs ! horizontal scale factors grid type T
55      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1u_crs, e2u_crs ! horizontal scale factors grid type U
56      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1v_crs, e2v_crs ! horizontal scale factors grid type V
57      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1f_crs, e2f_crs ! horizontal scale factors grid type F
58      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_crs, e3u_crs, e3v_crs, e3w_crs
59      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: fse3t_crs, fse3u_crs, fse3v_crs, fse3w_crs
60      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: fse3t_n_crs, fse3t_b_crs, fse3t_a_crs
61
62                                                                  ! vertical scale factors
63      ! Coordinates
64      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphit_crs, glamt_crs, gphif_crs, glamf_crs 
65      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphiu_crs, glamu_crs, gphiv_crs, glamv_crs 
66      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: ff_crs
67      INTEGER,  DIMENSION(:,:),   ALLOCATABLE :: mbathy_crs, mbkt_crs, mbku_crs, mbkv_crs
68      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: gdept_crs, gdepu_crs, gdepv_crs, gdepw_crs
69
70      ! Weights
71      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: facsurfv, facsurfu, facvol_t, facvol_w
72      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ocean_volume_crs_t, ocean_volume_crs_w
73      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: crs_surfu_wgt, crs_surfv_wgt, crs_surfw_wgt, crs_volt_wgt
74
75      ! CRS Namelist
76      INTEGER           :: nn_factx   = 3       !: reduction factor of x-dimension of the parent grid
77      INTEGER           :: nn_facty   = 3       !: reduction factor of y-dimension of the parent grid
78      CHARACTER(len=5)  :: cn_binref  = 'NORTH' !: NORTH = binning starts north fold (equator could be asymmetric)
79                                                !: EQUAT = binning centers at equator (north fold my have artifacts)     
80                                                !:    for even reduction factors, equator placed in bin biased south
81      INTEGER           :: nn_fcrs    = 3       !: frequence of coarsening
82      INTEGER           :: nn_msh_crs = 1       !: Organization of mesh mask output
83                                                !: 0 = no mesh mask output
84                                                !: 1 = unified mesh mask output
85                                                !: 2 = 2 separate mesh mask output
86                                                !: 3 = 3 separate mesh mask output
87      CHARACTER(len=11) :: cn_ocerstcrs         !: root name of restart files for coarsened variables
88         
89      ! Grid reduction factors
90      REAL(wp)     ::  rfactx_r                !: inverse of x-dim reduction factor
91      REAL(wp)     ::  rfacty_r                !: inverse of y-dim reduction factor
92      REAL(wp)     ::  rfactxy 
93
94      !! Horizontal grid parameters for domhgr
95      !! =====================================
96      INTEGER  ::   nphgr_msh_crs = 0   !: type of horizontal mesh
97      !                                 !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
98      !                                 !  = 1 geographical mesh on the sphere with regular grid-spacing
99      !                                 !  = 2 f-plane with regular grid-spacing
100      !                                 !  = 3 beta-plane with regular grid-spacing
101      !                                 !  = 4 Mercator grid with T/U point at the equator
102     
103      ! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields
104!      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsn_crs, tsb_crs, tsa_crs
105!      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: un_crs, vn_crs, wn_crs
106!      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: ut_crs, vt_crs, wt_crs, us_crs, vs_crs, ws_crs
107!      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: rhd_crs, rhop_crs, hdivn_crs   
108!      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: sshb_crs, sshn_crs, ssha_crs   
109!      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: sshun_crs, sshvn_crs, sshfn_crs
110!      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: sshub_crs, sshvb_crs, sshua_crs, sshva_crs
111!      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: hu_crs, hv_crs
112!      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: hdivbt_crs
113!      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: ssh_b_crs, ssh_a_crs, ssh_un_crs, ssh_vn_crs        ! instantaneous fields
114
115
116      !
117      ! Surface fluxes to pass to TOP
118 !     REAL(wp), DIMENSION(:,:)  , ALLOCATABLE      ::  utau_crs, vtau_crs, wndm_crs, qsr_crs
119 !     REAL(wp), DIMENSION(:,:)  , ALLOCATABLE      ::  del_emp_crs, sum_emp_crs
120 !     REAL(wp), DIMENSION(:,:)  , ALLOCATABLE      ::  emp_crs, emp_b_crs, emps_crs
121 !     REAL(wp), DIMENSION(:,:)  , ALLOCATABLE      ::  rnf_crs, fr_i_crs, h_rnf_crs
122   
123      !
124      ! Lateral diffusivity (tracers) to pass to TOP
125!      REAL(wp)                                     ::  rldf_crs, rn_aht_0_crs, aht0_crs, ahtb0_crs
126
127!#if defined key_traldf_c3d
128!      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::   ahtt_crs, ahtu_crs, ahtv_crs, ahtw_crs   !: 3D coefficients at T-,U-,V-,W-points
129!      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::   aeiu_crs, aeiv_crs, aeiw_crs   
130!#elif defined key_traldf_c2d
131!      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   ahtt_crs, ahtu_crs, ahtv_crs, ahtw_crs   !: 2D coefficients at T-,U-,V-,W-points
132!      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   aeiu_crs, aeiv_crs, aeiw_crs   
133!#elif defined key_traldf_c1d
134!      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:)     ::   ahtt_crs, ahtu_crs, ahtv_crs, ahtw_crs   !: 1D coefficients at T-,U-,V-,W-points
135!      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:)     ::   aeiu_crs, aeiv_crs, aeiw_crs   
136!#else
137!      REAL(wp), PUBLIC                                ::   ahtt_crs, ahtu_crs, ahtv_crs, ahtw_crs   !: scalar coefficients at T-,U-,V-,W-points
138!#endif
139
140 
141      ! Vertical diffusion
142!      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avt_crs           !: vert. diffusivity coef. [m2/s] at w-point for temp 
143!# if defined key_zdfddm
144!      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avs_crs           !: salinity vertical diffusivity coeff. [m2/s] at w-point
145!# endif
146
147      ! Mixing and Mixed Layer Depth
148!      INTEGER,  PUBLIC, ALLOCATABLE, DIMENSION(:,:)    ::  nmln_crs, hmld_crs, hmlp_crs, hmlpt_crs                       
149
150      ! Direction of lateral diffusion
151
152
153
154CONTAINS
155   
156   INTEGER FUNCTION crs_dom_alloc()
157      !!-------------------------------------------------------------------
158      !!                     *** FUNCTION crs_dom_alloc ***
159      !!  ** Purpose :   Allocate public crs arrays 
160      !!-------------------------------------------------------------------
161      !! Local variables
162      INTEGER, DIMENSION(10) :: ierr
163
164      ierr(:) = 0
165
166      ! Set up bins for coarse grid, horizontal only.
167      ALLOCATE( mis_crs(jpiglo_crs) , mie_crs(jpiglo_crs) , mjs_crs(jpjglo_crs) , mje_crs(jpjglo_crs), STAT=ierr(1) )
168
169      ! Set up Mask and Mesh
170
171      ALLOCATE( tmask_crs(jpi_crs,jpj_crs,jpk) , fmask_crs(jpi_crs,jpj_crs,jpk) ,  &
172         &      umask_crs(jpi_crs,jpj_crs,jpk) , vmask_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(2))
173
174      ALLOCATE( tmask_i_crs(jpi_crs,jpj_crs), rnfmsk_crs(jpi_crs,jpj_crs), STAT=ierr(3) )
175
176      ALLOCATE( gphit_crs(jpi_crs,jpj_crs) , glamt_crs(jpi_crs,jpj_crs) , & 
177         &      gphiu_crs(jpi_crs,jpj_crs) , glamu_crs(jpi_crs,jpj_crs) , &
178         &      gphiv_crs(jpi_crs,jpj_crs) , glamv_crs(jpi_crs,jpj_crs) , &
179         &      gphif_crs(jpi_crs,jpj_crs) , glamf_crs(jpi_crs,jpj_crs) , &
180         &      ff_crs(jpi_crs,jpj_crs)    , STAT=ierr(4))
181
182      ALLOCATE( e1t_crs(jpi_crs,jpj_crs) , e2t_crs(jpi_crs,jpj_crs) , & 
183         &      e1u_crs(jpi_crs,jpj_crs) , e2u_crs(jpi_crs,jpj_crs) , & 
184         &      e1v_crs(jpi_crs,jpj_crs) , e2v_crs(jpi_crs,jpj_crs) , &
185         &      e1f_crs(jpi_crs,jpj_crs) , e2f_crs(jpi_crs,jpj_crs) , &
186         &      e1e2t_crs(jpi_crs,jpj_crs), STAT=ierr(5))
187
188      ALLOCATE( fse3t_crs(jpi_crs,jpj_crs,jpk)  , fse3w_crs(jpi_crs,jpj_crs,jpk) , & 
189         &      fse3u_crs(jpi_crs,jpj_crs,jpk)  , fse3v_crs(jpi_crs,jpj_crs,jpk) , & 
190         &      e3t_crs(jpi_crs,jpj_crs,jpk)    , e3w_crs(jpi_crs,jpj_crs,jpk)   , & 
191         &      e3u_crs(jpi_crs,jpj_crs,jpk)    , e3v_crs(jpi_crs,jpj_crs,jpk)   , &
192         &      fse3t_b_crs(jpi_crs,jpj_crs,jpk), fse3t_n_crs(jpi_crs,jpj_crs,jpk),&
193         &      fse3t_a_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(6))
194
195
196      ALLOCATE( facsurfv(jpi_crs,jpj_crs,jpk) , facsurfu(jpi_crs,jpj_crs,jpk) , & 
197         &      facvol_t(jpi_crs,jpj_crs,jpk) , facvol_w(jpi_crs,jpj_crs,jpk) , &
198         &      ocean_volume_crs_t(jpi_crs,jpj_crs,jpk) , ocean_volume_crs_w(jpi_crs,jpj_crs,jpk) , STAT=ierr(7))
199
200
201      ALLOCATE( crs_surfu_wgt(jpi_crs,jpj_crs,jpk) , crs_surfv_wgt(jpi_crs,jpj_crs,jpk) , & 
202         &      crs_surfw_wgt(jpi_crs,jpj_crs,jpk) , crs_volt_wgt(jpi_crs,jpj_crs,jpk) , STAT=ierr(8))
203
204
205      ALLOCATE( mbathy_crs(jpi_crs,jpj_crs) , mbkt_crs(jpi_crs,jpj_crs) , &
206         &      mbku_crs(jpi_crs,jpj_crs)   , mbkv_crs(jpi_crs,jpj_crs) , STAT=ierr(9))
207
208      ALLOCATE( gdept_crs(jpi_crs,jpj_crs,jpk) , gdepu_crs(jpi_crs,jpj_crs,jpk) , &
209         &      gdepv_crs(jpi_crs,jpj_crs,jpk) , gdepw_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(10) )
210
211
212!      ALLOCATE( un_crs(jpi_crs,jpj_crs,jpk) ,   vn_crs(jpi_crs,jpj_crs,jpk) , &
213!         &      wn_crs(jpi_crs,jpj_crs,jpk) ,                                 &
214!         &      ut_crs(jpi_crs,jpj_crs,jpk) ,   vt_crs(jpi_crs,jpj_crs,jpk) , &
215!         &      us_crs(jpi_crs,jpj_crs,jpk) ,   vs_crs(jpi_crs,jpj_crs,jpk) , &
216!         &      wt_crs(jpi_crs,jpj_crs,jpk) ,   ws_crs(jpi_crs,jpj_crs,jpk) , &
217!         &     rhd_crs(jpi_crs,jpj_crs,jpk) , rhop_crs(jpi_crs,jpj_crs,jpk) , &
218!         &      STAT=ierr(11))
219
220!      ALLOCATE( sshb_crs(jpi_crs,jpj_crs)   , sshn_crs(jpi_crs,jpj_crs)   , &
221!         &      sshun_crs(jpi_crs,jpj_crs)  , sshvn_crs(jpi_crs,jpj_crs)  , &
222!         &      sshfn_crs(jpi_crs,jpj_crs)  , emp_crs(jpi_crs,jpj_crs)    , &
223!         &      del_emp_crs(jpi_crs,jpj_crs), sum_emp_crs(jpi_crs,jpj_crs), &
224!         &      emp_b_crs(jpi_crs,jpj_crs)  , emps_crs(jpi_crs,jpj_crs)   , &
225!         &      ssh_b_crs(jpi_crs,jpj_crs)  , ssh_a_crs(jpi_crs,jpj_crs)  , &
226!         &      STAT=ierr(12)  )
227 
228!      ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts) , tsb_crs(jpi_crs,jpj_crs,jpk,jpts) , &
229!         &     tsa_crs(jpi_crs,jpj_crs,jpk,jpts) , STAT=ierr(13) )
230
231      crs_dom_alloc = MAXVAL(ierr)
232
233   END FUNCTION crs_dom_alloc
234   
235   !!======================================================================
236
237END MODULE crs_dom
238
Note: See TracBrowser for help on using the repository browser.