Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
MODULE crs
!!======================================================================
!! *** MODULE crs_dom ***
!! Declare the coarse grid domain and other public variables
!! then allocate them if needed.
!!======================================================================
!! History 2012-06 Editing (J. Simeon, G. Madec, C. Ethe, C. Calone) Original code
!!----------------------------------------------------------------------
USE par_oce
USE dom_oce
USE in_out_manager
IMPLICIT NONE
PUBLIC
PUBLIC crs_dom_alloc ! Called from crsini.F90
PUBLIC crs_dom_alloc2 ! Called from crsini.F90
PUBLIC dom_grid_glo
PUBLIC dom_grid_crs
! Domain variables
INTEGER :: jpiglo_crs , & !: 1st dimension of global coarse grid domain
jpjglo_crs !: 2nd dimension of global coarse grid domain
INTEGER :: jpi_crs , & !: 1st dimension of local coarse grid domain
jpj_crs !: 2nd dimension of local coarse grid domain
INTEGER :: jpi_full , & !: 1st dimension of local parent grid domain
jpj_full !: 2nd dimension of local parent grid domain
INTEGER :: nistr , njstr
INTEGER :: niend , njend
INTEGER :: jpi_crsm1, jpj_crsm1 !: loop indices
INTEGER :: jpiglo_crsm1, jpjglo_crsm1 !: loop indices
!!$ INTEGER :: nperio_full, nperio_crs !: jperio of parent and coarse grids
!!$ INTEGER :: npolj_full, npolj_crs !: north fold mark
INTEGER :: jpiglo_full, jpjglo_full !: jpiglo / jpjglo
INTEGER :: npiglo, npjglo !: jpjglo
INTEGER :: Nis0_full, Njs0_full !: starting indices of internal sub-domain on parent grid
INTEGER :: Nie0_full, Nje0_full !: ending indices of internal sub-domain on parent grid
INTEGER :: Nis0_crs , Njs0_crs !: starting indices of internal sub-domain on coarse grid
INTEGER :: Nie0_crs , Nje0_crs !: ending indices of internal sub-domain on coarse grid
INTEGER :: narea_full, narea_crs !: node
INTEGER :: jpnij_full, jpnij_crs !: =jpni*jpnj, the pe decomposition
!!$ INTEGER :: jpim1_full, jpjm1_full !:
INTEGER :: nimpp_full, njmpp_full !: global position of point (1,1) of subdomain on parent grid
INTEGER :: nimpp_crs, njmpp_crs !: set to 1,1 for now . Valid only for monoproc
INTEGER, DIMENSION(:), ALLOCATABLE :: mis_crs, mie_crs, mis2_crs, mie2_crs ! starting and ending i-indices of parent subset
INTEGER, DIMENSION(:), ALLOCATABLE :: mjs_crs, mje_crs, mjs2_crs, mje2_crs ! starting and ending j-indices of parent subset
INTEGER, DIMENSION(:), ALLOCATABLE :: mjg_crs, mig_crs
INTEGER, DIMENSION(:), ALLOCATABLE :: mi0_crs, mi1_crs, mj0_crs, mj1_crs
INTEGER :: mxbinctr, mybinctr ! central point in grid box
!!$ INTEGER, DIMENSION(:), ALLOCATABLE :: jpiall_crs, jpiall_full !: dimensions of every subdomain
!!$ INTEGER, DIMENSION(:), ALLOCATABLE :: nis0all_crs, nis0all_full !: first, last indoor index for each i-domain
!!$ INTEGER, DIMENSION(:), ALLOCATABLE :: nie0all_crs, nie0all_full !: first, last indoor index for each j-domain
!!$ INTEGER, DIMENSION(:), ALLOCATABLE :: nimppt_crs, nimppt_full !: first, last indoor index for each j-domain
!!$ INTEGER, DIMENSION(:), ALLOCATABLE :: jpjall_crs, jpjall_full !: dimensions of every subdomain
!!$ INTEGER, DIMENSION(:), ALLOCATABLE :: njs0all_crs, njs0all_full !: first, last indoor index for each i-domain
!!$ INTEGER, DIMENSION(:), ALLOCATABLE :: nje0all_crs, nje0all_full !: first, last indoor index for each j-domain
!!$ INTEGER, DIMENSION(:), ALLOCATABLE :: njmppt_crs, njmppt_full !: first, last indoor index for each j-domain
! Masks
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmask_crs, umask_crs, vmask_crs, fmask_crs
REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: rnfmsk_crs
! Scale factors
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: e1t_crs, e2t_crs, e1e2t_crs ! horizontal scale factors grid type T
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: e1u_crs, e2u_crs ! horizontal scale factors grid type U
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: e1v_crs, e2v_crs ! horizontal scale factors grid type V
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: e1f_crs, e2f_crs ! horizontal scale factors grid type F
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_crs, e3u_crs, e3v_crs, e3f_crs, e3w_crs
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_max_crs, e3u_max_crs, e3v_max_crs, e3f_max_crs, e3w_max_crs
! Surface
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e1e2w_crs, e2e3u_crs, e1e3v_crs
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e1e2w_msk, e2e3u_msk, e1e3v_msk
! vertical scale factors
! Coordinates
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gphit_crs, glamt_crs, gphif_crs, glamf_crs
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gphiu_crs, glamu_crs, gphiv_crs, glamv_crs
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ff_crs
INTEGER, DIMENSION(:,:), ALLOCATABLE :: mbathy_crs, mbkt_crs, mbku_crs, mbkv_crs
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: gdept_crs, gdepu_crs, gdepv_crs, gdepw_crs
! Weights
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: facsurfv, facsurfu, facvol_t, facvol_w
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ocean_volume_crs_t, ocean_volume_crs_w, bt_crs, r1_bt_crs
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: crs_surfu_wgt, crs_surfv_wgt, crs_surfw_wgt, crs_volt_wgt
! CRS Namelist
INTEGER :: nn_factx = 3 !: reduction factor of x-dimension of the parent grid
INTEGER :: nn_facty = 3 !: reduction factor of y-dimension of the parent grid
INTEGER :: nn_binref = 0 !: 0 = binning starts north fold (equator could be asymmetric)
!: 1 = binning centers at equator (north fold my have artifacts)
!: for even reduction factors, equator placed in bin biased south
LOGICAL :: ln_msh_crs = .TRUE. !: =T Create a meshmask file for CRS
INTEGER :: nn_crs_kz = 0 !: type of Kz coarsening ( =0->VOL ; =1->MAX ; =2->MIN)
LOGICAL :: ln_crs_wn = .FALSE. !: coarsening wn or computation using horizontal divergence
!
INTEGER :: nrestx, nresty !: for determining odd or even reduction factor
! Grid reduction factors
REAL(wp) :: rfactx_r !: inverse of x-dim reduction factor
REAL(wp) :: rfacty_r !: inverse of y-dim reduction factor
REAL(wp) :: rfactxy
! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields
REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tsn_crs
REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: un_crs, vn_crs, wn_crs
REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: hdivn_crs
REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: sshn_crs
!
! Surface fluxes to pass to TOP
REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: qsr_crs, fr_i_crs, wndm_crs
REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: emp_crs, emp_b_crs, sfx_crs
REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: utau_crs, vtau_crs
REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: rnf_crs
! Vertical diffusion
REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: avt_crs !: temperature vertical diffusivity coeff. [m2/s] at w-point
REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: avs_crs !: salinity vertical diffusivity coeff. [m2/s] at w-point
! Mixing and Mixed Layer Depth
INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: nmln_crs, hmld_crs, hmlp_crs, hmlpt_crs
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: crs.F90 15033 2021-06-21 10:24:45Z smasson $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
INTEGER FUNCTION crs_dom_alloc()
!!-------------------------------------------------------------------
!! *** FUNCTION crs_dom_alloc ***
!! ** Purpose : Allocate public crs arrays
!!-------------------------------------------------------------------
!! Local variables
INTEGER, DIMENSION(17) :: ierr
ierr(:) = 0
! Set up bins for coarse grid, horizontal only.
ALLOCATE( mis2_crs(jpiglo_crs), mie2_crs(jpiglo_crs), &
& mjs2_crs(jpjglo_crs), mje2_crs(jpjglo_crs), &
& mi0_crs (jpiglo_crs), mi1_crs (jpiglo_crs), &
& mj0_crs (jpjglo_crs), mj1_crs (jpjglo_crs), &
& mig_crs (jpi_crs) , mjg_crs (jpj_crs) , STAT=ierr(1) )
! Set up Mask and Mesh
ALLOCATE( tmask_crs(jpi_crs,jpj_crs,jpk) , fmask_crs(jpi_crs,jpj_crs,jpk) , &
& umask_crs(jpi_crs,jpj_crs,jpk) , vmask_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(2))
ALLOCATE( rnfmsk_crs(jpi_crs,jpj_crs), STAT=ierr(3) )
ALLOCATE( gphit_crs(jpi_crs,jpj_crs) , glamt_crs(jpi_crs,jpj_crs) , &
& gphiu_crs(jpi_crs,jpj_crs) , glamu_crs(jpi_crs,jpj_crs) , &
& gphiv_crs(jpi_crs,jpj_crs) , glamv_crs(jpi_crs,jpj_crs) , &
& gphif_crs(jpi_crs,jpj_crs) , glamf_crs(jpi_crs,jpj_crs) , &
& ff_crs(jpi_crs,jpj_crs) , STAT=ierr(4))
ALLOCATE( e1t_crs(jpi_crs,jpj_crs) , e2t_crs(jpi_crs,jpj_crs) , &
& e1u_crs(jpi_crs,jpj_crs) , e2u_crs(jpi_crs,jpj_crs) , &
& e1v_crs(jpi_crs,jpj_crs) , e2v_crs(jpi_crs,jpj_crs) , &
& e1f_crs(jpi_crs,jpj_crs) , e2f_crs(jpi_crs,jpj_crs) , &
& e1e2t_crs(jpi_crs,jpj_crs), STAT=ierr(5))
ALLOCATE( e3t_crs(jpi_crs,jpj_crs,jpk) , e3w_crs(jpi_crs,jpj_crs,jpk) , &
& e3u_crs(jpi_crs,jpj_crs,jpk) , e3v_crs(jpi_crs,jpj_crs,jpk) , &
& e3f_crs(jpi_crs,jpj_crs,jpk) , e1e2w_msk(jpi_crs,jpj_crs,jpk) , &
& e2e3u_msk(jpi_crs,jpj_crs,jpk) , e1e3v_msk(jpi_crs,jpj_crs,jpk) , &
& e1e2w_crs(jpi_crs,jpj_crs,jpk) , e2e3u_crs(jpi_crs,jpj_crs,jpk) , &
& e1e3v_crs(jpi_crs,jpj_crs,jpk) , e3t_max_crs(jpi_crs,jpj_crs,jpk), &
& e3w_max_crs(jpi_crs,jpj_crs,jpk), e3u_max_crs(jpi_crs,jpj_crs,jpk), &
& e3v_max_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(6))
ALLOCATE( facsurfv(jpi_crs,jpj_crs,jpk), facsurfu(jpi_crs,jpj_crs,jpk) , &
& facvol_t(jpi_crs,jpj_crs,jpk), facvol_w(jpi_crs,jpj_crs,jpk) , &
& ocean_volume_crs_t(jpi_crs,jpj_crs,jpk), ocean_volume_crs_w(jpi_crs,jpj_crs,jpk), &
& bt_crs(jpi_crs,jpj_crs,jpk) , r1_bt_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(7))
ALLOCATE( crs_surfu_wgt(jpi_crs,jpj_crs,jpk), crs_surfv_wgt(jpi_crs,jpj_crs,jpk) , &
& crs_surfw_wgt(jpi_crs,jpj_crs,jpk), crs_volt_wgt(jpi_crs,jpj_crs,jpk) , STAT=ierr(8))
ALLOCATE( mbathy_crs(jpi_crs,jpj_crs), mbkt_crs(jpi_crs,jpj_crs) , &
& mbku_crs(jpi_crs,jpj_crs) , mbkv_crs(jpi_crs,jpj_crs) , STAT=ierr(9))
ALLOCATE( gdept_crs(jpi_crs,jpj_crs,jpk), gdepu_crs(jpi_crs,jpj_crs,jpk) , &
& gdepv_crs(jpi_crs,jpj_crs,jpk), gdepw_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(10) )
ALLOCATE( un_crs(jpi_crs,jpj_crs,jpk) , vn_crs (jpi_crs,jpj_crs,jpk) , &
& wn_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(11))
ALLOCATE( sshn_crs(jpi_crs,jpj_crs), emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), &
& qsr_crs(jpi_crs ,jpj_crs), wndm_crs(jpi_crs,jpj_crs), utau_crs(jpi_crs,jpj_crs) , &
& vtau_crs(jpi_crs,jpj_crs), rnf_crs(jpi_crs ,jpj_crs), &
& fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs), STAT=ierr(12) )
ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk), &
& avs_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(13) )
ALLOCATE( nmln_crs(jpi_crs,jpj_crs) , hmld_crs(jpi_crs,jpj_crs) , &
& hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(14) )
!!$ ALLOCATE( nimppt_crs (jpnij) , jpiall_crs (jpnij) , nis0all_crs (jpnij) , nie0all_crs (jpnij), &
!!$ & nimppt_full(jpnij) , jpiall_full(jpnij) , nis0all_full(jpnij) , nie0all_full(jpnij), &
!!$ njmppt_crs (jpnij) , jpjall_crs (jpnij) , njs0all_crs (jpnij) , nje0all_crs (jpnij), &
!!$ & njmppt_full(jpnij) , jpjall_full(jpnij) , njs0all_full(jpnij) , nje0all_full(jpnij) , STAT=ierr(15) )
crs_dom_alloc = MAXVAL(ierr)
!
END FUNCTION crs_dom_alloc
INTEGER FUNCTION crs_dom_alloc2()
!!-------------------------------------------------------------------
!! *** FUNCTION crs_dom_alloc ***
!! ** Purpose : Allocate public crs arrays
!!-------------------------------------------------------------------
!! Local variables
INTEGER, DIMENSION(1) :: ierr
ierr(:) = 0
ALLOCATE( mjs_crs(Nje0_crs) , mje_crs(Nje0_crs), mis_crs(Nie0_crs) , mie_crs(Nie0_crs), STAT=ierr(1) )
crs_dom_alloc2 = MAXVAL(ierr)
END FUNCTION crs_dom_alloc2
SUBROUTINE dom_grid_glo
!!--------------------------------------------------------------------
!! *** MODULE dom_grid_glo ***
!!
!! ** Purpose : +Return back to parent grid domain
!!---------------------------------------------------------------------
! Return to parent grid domain
jpi = jpi_full
jpj = jpj_full
!!$ jpim1 = jpim1_full
!!$ jpjm1 = jpjm1_full
!!$ jperio = nperio_full
!!$ npolj = npolj_full
jpiglo = jpiglo_full
jpjglo = jpjglo_full
jpi = jpi_full
jpj = jpj_full
Nis0 = Nis0_full
Njs0 = Njs0_full
Nie0 = Nie0_full
Nje0 = Nje0_full
nimpp = nimpp_full
njmpp = njmpp_full
!!$ jpiall (:) = jpiall_full (:)
!!$ nis0all(:) = nis0all_full(:)
!!$ nie0all(:) = nie0all_full(:)
!!$ nimppt (:) = nimppt_full (:)
!!$ jpjall (:) = jpjall_full (:)
!!$ njs0all(:) = njs0all_full(:)
!!$ nje0all(:) = nje0all_full(:)
!!$ njmppt (:) = njmppt_full (:)
END SUBROUTINE dom_grid_glo
SUBROUTINE dom_grid_crs
!!--------------------------------------------------------------------
!! *** MODULE dom_grid_crs ***
!!
!! ** Purpose : Save the parent grid information & Switch to coarse grid domain
!!---------------------------------------------------------------------
!
! Switch to coarse grid domain
jpi = jpi_crs
jpj = jpj_crs
!!$ jpim1 = jpi_crsm1
!!$ jpjm1 = jpj_crsm1
!!$ jperio = nperio_crs
!!$ npolj = npolj_crs
jpiglo = jpiglo_crs
jpjglo = jpjglo_crs
jpi = jpi_crs
jpj = jpj_crs
Nis0 = Nis0_crs
Nie0 = Nie0_crs
Nje0 = Nje0_crs
Njs0 = Njs0_crs
nimpp = nimpp_crs
njmpp = njmpp_crs
!!$ jpiall (:) = jpiall_crs (:)
!!$ nis0all(:) = nis0all_crs(:)
!!$ nie0all(:) = nie0all_crs(:)
!!$ nimppt (:) = nimppt_crs (:)
!!$ jpjall (:) = jpjall_crs (:)
!!$ njs0all(:) = njs0all_crs(:)
!!$ nje0all(:) = nje0all_crs(:)
!!$ njmppt (:) = njmppt_crs (:)
!
END SUBROUTINE dom_grid_crs
!!======================================================================
END MODULE crs