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.F90 in NEMO/trunk/src/OCE/CRS – NEMO

source: NEMO/trunk/src/OCE/CRS/crs.F90

Last change on this file was 15033, checked in by smasson, 3 years ago

trunk: suppress jpim1 et jpjm1, #2699

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