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 branches/UKMO/dev_r10171_test_crs_AMM7/NEMOGCM/NEMO/OPA_SRC/CRS – NEMO

source: branches/UKMO/dev_r10171_test_crs_AMM7/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90 @ 10239

Last change on this file since 10239 was 10239, checked in by cmao, 5 years ago

Copy in changes to dev_r5003_MERCATOR6_CRS at r10234

File size: 23.3 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   USE lbcnfd
13
14   IMPLICIT NONE
15   PUBLIC
16
17   
18   PUBLIC crs_dom_alloc  ! Called from crsini.F90
19   PUBLIC dom_grid_glo   
20   PUBLIC dom_grid_crs 
21
22      ! Domain variables
23      INTEGER  ::  jpiglo_crs ,   &             !: 1st dimension of global coarse grid domain
24                   jpjglo_crs                   !: 2nd dimension of global coarse grid domain
25      INTEGER  ::  jpi_crs ,   &                !: 1st dimension of local coarse grid domain
26                   jpj_crs                      !: 2nd dimension of local coarse grid domain
27      INTEGER  ::  jpi_full ,  &                !: 1st dimension of local parent grid domain
28                   jpj_full                     !: 2nd dimension of local parent grid domain
29
30      INTEGER  ::  nistr , njstr
31      INTEGER  ::  niend , njend
32
33      INTEGER  ::  jpi_crsm1, jpj_crsm1         !: loop indices     
34      INTEGER  ::  jpiglo_crsm1, jpjglo_crsm1   !: loop indices     
35      INTEGER  ::  npolj_full, npolj_crs        !: north fold mark
36      INTEGER  ::  jpiglo_full, jpjglo_full     !: jpiglo / jpjglo
37      INTEGER  ::  npiglo, npjglo               !: jpjglo
38      INTEGER  ::  nlci_full, nlcj_full         !: i-, j-dimension of local or sub domain on parent grid
39      INTEGER  ::  nldi_full, nldj_full         !: starting indices of internal sub-domain on parent grid
40      INTEGER  ::  nlei_full, nlej_full         !: ending indices of internal sub-domain on parent grid
41      INTEGER  ::  nlci_crs, nlcj_crs           !: i-, j-dimension of local or sub domain on coarse grid
42      INTEGER  ::  nldi_crs, nldj_crs           !: starting indices of internal sub-domain on coarse grid
43      INTEGER  ::  nlei_crs, nlej_crs           !: ending indices of internal sub-domain on coarse grid
44
45      INTEGER  ::  narea_full, narea_crs        !: node
46      INTEGER  ::  jpnij_full, jpnij_crs        !: =jpni*jpnj, the pe decomposition
47      INTEGER  ::  jpim1_full, jpjm1_full       !:
48      INTEGER  ::  nimpp_full, njmpp_full       !: global position of point (1,1) of subdomain on parent grid
49      INTEGER  ::  nimpp_crs, njmpp_crs         !: set to 1,1 for now .  Valid only for monoproc
50      INTEGER  ::  nreci_full, nrecj_full
51      INTEGER  ::  nreci_crs, nrecj_crs
52      !cc
53      INTEGER ::   noea_full, nowe_full        !: index of the local neighboring processors in
54      INTEGER ::   noso_full, nono_full        !: east, west, south and north directions
55      INTEGER ::   npne_full, npnw_full        !: index of north east and north west processor
56      INTEGER ::   npse_full, npsw_full        !: index of south east and south west processor
57      INTEGER ::   nbne_full, nbnw_full        !: logical of north east & north west processor
58      INTEGER ::   nbse_full, nbsw_full        !: logical of south east & south west processor
59      INTEGER ::   nidom_full                  !: ???
60      INTEGER ::   nproc_full                  !:number for local processor
61      INTEGER ::   nbondi_full, nbondj_full    !: mark of i- and j-direction local boundaries
62      INTEGER ::   noea_crs, nowe_crs          !: index of the local neighboring processors in
63      INTEGER ::   noso_crs, nono_crs          !: east, west, south and north directions
64      INTEGER ::   npne_crs, npnw_crs          !: index of north east and north west processor
65      INTEGER ::   npse_crs, npsw_crs          !: index of south east and south west processor
66      INTEGER ::   nbne_crs, nbnw_crs          !: logical of north east & north west processor
67      INTEGER ::   nbse_crs, nbsw_crs          !: logical of south east & south west processor
68      INTEGER ::   nidom_crs                   !: ???
69      INTEGER ::   nproc_crs                   !:number for local processor
70      INTEGER ::   nbondi_crs, nbondj_crs      !: mark of i- and j-direction local boundaries
71     
72      INTEGER ::  nfsloop_full,nfeloop_full 
73      INTEGER ::  nfsloop_crs ,nfeloop_crs
74
75      INTEGER, DIMENSION(:), ALLOCATABLE :: mis_crs, mie_crs, mis2_crs, mie2_crs  ! starting and ending i-indices of parent subset
76      INTEGER, DIMENSION(:), ALLOCATABLE :: mjs_crs, mje_crs, mjs2_crs, mje2_crs  ! starting and ending  j-indices of parent subset
77      INTEGER, DIMENSION(:), ALLOCATABLE :: mjg_crs, mig_crs
78      INTEGER, DIMENSION(:), ALLOCATABLE :: mi0_crs, mi1_crs, mj0_crs, mj1_crs
79      INTEGER                            :: mxbinctr, mybinctr                    ! central point in grid box
80      INTEGER, DIMENSION(:), ALLOCATABLE :: nlcit_crs, nlcit_full                 ! dimensions of every subdomain
81      INTEGER, DIMENSION(:), ALLOCATABLE :: nldit_crs, nldit_full                 ! first, last indoor index for each i-domain
82      INTEGER, DIMENSION(:), ALLOCATABLE :: nleit_crs, nleit_full                 ! first, last indoor index for each j-domain
83      INTEGER, DIMENSION(:), ALLOCATABLE :: nimppt_crs, nimppt_full               ! first, last indoor index for each j-domain
84      INTEGER, DIMENSION(:), ALLOCATABLE :: nlcjt_crs, nlcjt_full                 ! dimensions of every subdomain
85      INTEGER, DIMENSION(:), ALLOCATABLE :: nldjt_crs, nldjt_full                 ! first, last indoor index for each i-domain
86      INTEGER, DIMENSION(:), ALLOCATABLE :: nlejt_crs, nlejt_full                 ! first, last indoor index for each j-domain
87      INTEGER, DIMENSION(:), ALLOCATABLE :: njmppt_crs, njmppt_full               ! first, last indoor index for each j-domain
88
89      INTEGER, DIMENSION(:,:), ALLOCATABLE ::   nfiimpp_full
90      INTEGER, DIMENSION(:,:), ALLOCATABLE ::   nfiimpp_crs
91 
92      ! Masks
93      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE,SAVE :: tmask_crs, umask_crs, vmask_crs, fmask_crs
94      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE,SAVE :: tmask_i_crs, rnfmsk_crs, tpol_crs, fpol_crs
95     
96      ! Scale factors
97      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1t_crs, e2t_crs, e1e2t_crs ! horizontal scale factors grid type T
98      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1u_crs, e2u_crs            ! horizontal scale factors grid type U
99      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1v_crs, e2v_crs            ! horizontal scale factors grid type V
100      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1f_crs, e2f_crs            ! horizontal scale factors grid type F
101
102      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: ht_0_crs
103      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_0_crs, e3u_0_crs, e3v_0_crs, e3f_0_crs, e3w_0_crs
104      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_max_0_crs, e3u_max_0_crs, e3v_max_0_crs, e3f_max_0_crs, e3w_max_0_crs
105
106#if defined key_vvl
107      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_b_crs, e3u_b_crs, e3v_b_crs, e3f_b_crs, e3w_b_crs
108      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_n_crs, e3u_n_crs, e3v_n_crs, e3f_n_crs, e3w_n_crs
109      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_a_crs, e3u_a_crs, e3v_a_crs, e3f_a_crs, e3w_a_crs
110      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_max_n_crs, e3u_max_n_crs, e3v_max_n_crs, e3f_max_n_crs, e3w_max_n_crs
111#endif
112
113      ! Surface
114      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e1e2w_crs, e2e3u_crs, e1e3v_crs
115      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e1e2w_msk, e2e3u_msk, e1e3v_msk
116     
117      ! Coordinates
118      REAL(wp), DIMENSION(:,:),   ALLOCATABLE,SAVE :: gphit_crs, glamt_crs, gphif_crs, glamf_crs 
119      REAL(wp), DIMENSION(:,:),   ALLOCATABLE,SAVE :: gphiu_crs, glamu_crs, gphiv_crs, glamv_crs 
120      REAL(wp), DIMENSION(:,:),   ALLOCATABLE,SAVE :: ff_crs
121      INTEGER,  DIMENSION(:,:),   ALLOCATABLE,SAVE :: mbathy_crs, mbkt_crs, mbku_crs, mbkv_crs
122      INTEGER,  DIMENSION(:,:),   ALLOCATABLE,SAVE :: mikt_crs
123
124      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE,SAVE :: gdept_0_crs, gdepu_0_crs, gdepv_0_crs, gdepw_0_crs
125#if defined key_vvl
126      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE,SAVE :: gdept_n_crs, gdepu_n_crs, gdepv_n_crs, gdepw_n_crs
127#endif
128
129      ! Weights
130      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: facsurfv, facsurfu, facvol_t, facvol_w
131      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ocean_volume_crs_t, ocean_volume_crs_w, bt_crs, r1_bt_crs
132      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: crs_surfu_wgt, crs_surfv_wgt, crs_surfw_wgt, crs_volt_wgt
133
134      ! Namelist
135      INTEGER           :: nn_factx   = 3       !: reduction factor of x-dimension of the parent grid
136      INTEGER           :: nn_facty   = 3       !: reduction factor of y-dimension of the parent grid
137      INTEGER           :: nn_msh_crs = 1       !: Organization of mesh mask output
138                                                !: 0 = no mesh mask output
139                                                !: 1 = unified mesh mask output
140                                                !: 2 = 2 separate mesh mask output
141                                                !: 3 = 3 separate mesh mask output
142      INTEGER           :: nn_crs_kz    =    0       !: type of Kz coarsening ( =0->VOL ; =1->MAX ; =2->MIN)
143      LOGICAL           :: ln_crs_wn    = .FALSE.    !: coarsening wn or computation using horizontal divergence
144      LOGICAL, PUBLIC   :: ln_crs_top   = .FALSE.    !:coarsening online for the bio
145      !
146
147      ! Grid reduction factors
148      REAL(wp)     ::  rfactx_r                !: inverse of x-dim reduction factor
149      REAL(wp)     ::  rfacty_r                !: inverse of y-dim reduction factor
150      REAL(wp)     ::  rfactxy 
151      INTEGER      :: nrestx, nresty           !: for determining odd or even reduction factor
152      INTEGER, DIMENSION(:), ALLOCATABLE      :: nfactx,nfacty
153
154
155      ! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields
156      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsb_crs,tsn_crs,tsa_crs,rab_crs_n
157      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: un_crs, vn_crs, wn_crs
158      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: ub_crs, vb_crs
159      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: hdivb_crs , hdivn_crs   
160      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: sshb_crs, sshn_crs , ssha_crs
161      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: rhop_crs,rhd_crs,rn2_crs,rb2_crs
162      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: gru_crs, grv_crs
163      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: gtsu_crs, gtsv_crs
164      !
165      ! Surface fluxes to pass to TOP
166      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: qsr_crs, fr_i_crs, wndm_crs
167      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: emp_crs, emp_b_crs, sfx_crs
168      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: fmmflx_crs
169      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: utau_crs, vtau_crs, taum_crs
170      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: rnf_crs,rnf_b_crs,h_rnf_crs
171      INTEGER , PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: nk_rnf_crs
172      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: fwfisf_b_crs, fwfisf_crs
173      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: trc_i_crs,trc_o_crs
174      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: sbc_trc_crs, sbc_trc_b_crs
175
176      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: uslp_crs, wslpi_crs          !: i_slope at U- and W-points
177      REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: vslp_crs, wslpj_crs          !: j-slope at V- and W-points
178
179      ! Horizontal diffusion
180#if defined key_traldf_c3d
181      REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahtt_crs, ahtu_crs, ahtv_crs, ahtw_crs   !: ** 3D coefficients ** at T-,U-,V-,W-points
182#elif defined key_traldf_c2d
183      REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ahtt_crs, ahtu_crs, ahtv_crs, ahtw_crs   !: ** 2D coefficients ** at T-,U-,V-,W-points
184#elif defined key_traldf_c1d
185      REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   ahtt_crs, ahtu_crs, ahtv_crs, ahtw_crs   !: ** 1D coefficients ** at T-,U-,V-,W-points
186#else
187      REAL(wp), PUBLIC                                      ::   ahtt_crs, ahtu_crs, ahtv_crs, ahtw_crs   !: ** 0D coefficients ** at T-,U-,V-,W-points
188#endif
189      REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   r_fact_lap_crs
190
191      ! Vertical diffusion
192      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avt_crs           !: vert. diffusivity coef. [m2/s] at w-point for temp 
193      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  en_crs            !: vert. diffusivity coef. [m2/s] at w-point for temp 
194      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)    ::  avtb_2d_crs       !: vert. diffusivity coef. [m2/s] at w-point for temp 
195# if defined key_zdfddm
196      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avs_crs           !: salinity vertical diffusivity coeff. [m2/s] at w-point
197# endif
198
199      ! Mixing and Mixed Layer Depth
200      INTEGER,  PUBLIC, DIMENSION(:,:) , ALLOCATABLE ::  nmln_crs
201      REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: hmlp_crs , hmlpt_crs , hmld_crs
202
203      ! Direction of lateral diffusion
204
205
206   !! $Id$
207CONTAINS
208   
209   INTEGER FUNCTION crs_dom_alloc()
210      !!-------------------------------------------------------------------
211      !!                     *** FUNCTION crs_dom_alloc ***
212      !!  ** Purpose :   Allocate public crs arrays 
213      !!-------------------------------------------------------------------
214      !! Local variables
215      INTEGER, DIMENSION(15) :: ierr
216
217      ierr(:) = 0
218
219      ! Set up bins for coarse grid, horizontal only.
220     ALLOCATE( mis2_crs(jpiglo_crs), mie2_crs(jpiglo_crs),  &
221       &       mjs2_crs(jpjglo_crs), mje2_crs(jpjglo_crs),  &
222       &       mi0_crs (jpiglo_crs), mi1_crs (jpiglo_crs),  &
223       &       mj0_crs (jpjglo_crs), mj1_crs (jpjglo_crs),  &
224       &       mig_crs (jpi_crs)   , mjg_crs (jpj_crs)   ,  & 
225       &       mis_crs (jpi_crs)   , mie_crs (jpi_crs)   ,  &
226       &       mjs_crs (jpj_crs)   , mje_crs (jpj_crs)   ,  &
227       &       nfactx  (jpi_crs)   , nfacty  (jpj_crs)   ,  &
228       &       nimppt_crs(jpnij) , nlcit_crs(jpnij) , nldit_crs(jpnij) , nleit_crs(jpnij) , &
229       &       nimppt_full(jpnij), nlcit_full(jpnij), nldit_full(jpnij), nleit_full(jpnij), &
230       &       njmppt_crs(jpnij) , nlcjt_crs(jpnij) , nldjt_crs(jpnij) , nlejt_crs(jpnij) , &
231       &       njmppt_full(jpnij), nlcjt_full(jpnij), nldjt_full(jpnij), nlejt_full(jpnij), &
232       &       nfiimpp_full(jpni,jpnj) , nfiimpp_crs(jpni,jpnj) , STAT=ierr(1) ) 
233
234      ! Set up Mask and Mesh
235      ALLOCATE( tmask_crs(jpi_crs,jpj_crs,jpk) , fmask_crs(jpi_crs,jpj_crs,jpk) ,  &
236         &      umask_crs(jpi_crs,jpj_crs,jpk) , vmask_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(2))
237
238      ALLOCATE( tmask_i_crs(jpi_crs,jpj_crs)   , rnfmsk_crs(jpi_crs,jpj_crs), &
239      &         tpol_crs(jpiglo_crs,jpjglo_crs), fpol_crs(jpiglo_crs,jpjglo_crs), STAT=ierr(3) )
240
241      ALLOCATE( gphit_crs(jpi_crs,jpj_crs) , glamt_crs(jpi_crs,jpj_crs) , & 
242         &      gphiu_crs(jpi_crs,jpj_crs) , glamu_crs(jpi_crs,jpj_crs) , &
243         &      gphiv_crs(jpi_crs,jpj_crs) , glamv_crs(jpi_crs,jpj_crs) , &
244         &      gphif_crs(jpi_crs,jpj_crs) , glamf_crs(jpi_crs,jpj_crs) , &
245         &      ff_crs(jpi_crs,jpj_crs)    , STAT=ierr(4))
246
247      ALLOCATE( e1t_crs(jpi_crs,jpj_crs) , e2t_crs(jpi_crs,jpj_crs) , & 
248         &      e1u_crs(jpi_crs,jpj_crs) , e2u_crs(jpi_crs,jpj_crs) , & 
249         &      e1v_crs(jpi_crs,jpj_crs) , e2v_crs(jpi_crs,jpj_crs) , &
250         &      e1f_crs(jpi_crs,jpj_crs) , e2f_crs(jpi_crs,jpj_crs) , &
251         &      e1e2t_crs(jpi_crs,jpj_crs), STAT=ierr(5))
252
253      ALLOCATE( e3t_0_crs(jpi_crs,jpj_crs,jpk)    , e3w_0_crs(jpi_crs,jpj_crs,jpk)    , &
254         &      e3u_0_crs(jpi_crs,jpj_crs,jpk)    , e3v_0_crs(jpi_crs,jpj_crs,jpk)    , &
255         &           ht_0_crs(jpi_crs,jpj_crs),                                     &
256#if defined key_vvl
257         &      e3t_b_crs(jpi_crs,jpj_crs,jpk)    , e3w_b_crs(jpi_crs,jpj_crs,jpk)    , &
258         &      e3u_b_crs(jpi_crs,jpj_crs,jpk)    , e3v_b_crs(jpi_crs,jpj_crs,jpk)    , &
259         &      e3t_n_crs(jpi_crs,jpj_crs,jpk)    , e3w_n_crs(jpi_crs,jpj_crs,jpk)    , &
260         &      e3u_n_crs(jpi_crs,jpj_crs,jpk)    , e3v_n_crs(jpi_crs,jpj_crs,jpk)    , &
261         &      e3t_a_crs(jpi_crs,jpj_crs,jpk)    , e3w_a_crs(jpi_crs,jpj_crs,jpk)    , &
262         &      e3u_a_crs(jpi_crs,jpj_crs,jpk)    , e3v_a_crs(jpi_crs,jpj_crs,jpk)    , &
263#endif
264         &      e1e2w_msk(jpi_crs,jpj_crs,jpk)  , &
265         &      e2e3u_msk(jpi_crs,jpj_crs,jpk)  , e1e3v_msk(jpi_crs,jpj_crs,jpk)  , &
266         &      e1e2w_crs(jpi_crs,jpj_crs,jpk)  , e2e3u_crs(jpi_crs,jpj_crs,jpk)  , &
267         &      e1e3v_crs(jpi_crs,jpj_crs,jpk)  , &
268         &      e3t_max_0_crs(jpi_crs,jpj_crs,jpk), e3w_max_0_crs(jpi_crs,jpj_crs,jpk) , &
269         &      e3u_max_0_crs(jpi_crs,jpj_crs,jpk), e3v_max_0_crs(jpi_crs,jpj_crs,jpk) , &
270#if defined key_vvl
271         &      e3t_max_n_crs(jpi_crs,jpj_crs,jpk), e3w_max_n_crs(jpi_crs,jpj_crs,jpk) , &
272         &      e3u_max_n_crs(jpi_crs,jpj_crs,jpk), e3v_max_n_crs(jpi_crs,jpj_crs,jpk) , &
273#endif
274         &      STAT=ierr(6))
275
276
277      ALLOCATE( facsurfv(jpi_crs,jpj_crs,jpk), facsurfu(jpi_crs,jpj_crs,jpk) , & 
278         &      facvol_t(jpi_crs,jpj_crs,jpk), facvol_w(jpi_crs,jpj_crs,jpk) , &
279         &      ocean_volume_crs_t(jpi_crs,jpj_crs,jpk), ocean_volume_crs_w(jpi_crs,jpj_crs,jpk), &
280         &      bt_crs(jpi_crs,jpj_crs,jpk)  , r1_bt_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(7))
281
282
283      ALLOCATE( crs_surfu_wgt(jpi_crs,jpj_crs,jpk), crs_surfv_wgt(jpi_crs,jpj_crs,jpk) , & 
284         &      crs_surfw_wgt(jpi_crs,jpj_crs,jpk), crs_volt_wgt(jpi_crs,jpj_crs,jpk) , STAT=ierr(8))
285
286
287      ALLOCATE( mbathy_crs(jpi_crs,jpj_crs), mbkt_crs(jpi_crs,jpj_crs) , &
288         &      mbku_crs(jpi_crs,jpj_crs)  , mbkv_crs(jpi_crs,jpj_crs) , & 
289         &      mikt_crs(jpi_crs,jpj_crs)  , STAT=ierr(9))
290
291      ALLOCATE( gdept_0_crs(jpi_crs,jpj_crs,jpk), gdepu_0_crs(jpi_crs,jpj_crs,jpk) , &
292         &      gdepv_0_crs(jpi_crs,jpj_crs,jpk), gdepw_0_crs(jpi_crs,jpj_crs,jpk) , &
293#if defined key_vvl
294         &      gdept_n_crs(jpi_crs,jpj_crs,jpk), gdepu_n_crs(jpi_crs,jpj_crs,jpk) , &
295         &      gdepv_n_crs(jpi_crs,jpj_crs,jpk), gdepw_n_crs(jpi_crs,jpj_crs,jpk) , &
296#endif
297         & STAT=ierr(10))
298
299
300      ALLOCATE( ub_crs(jpi_crs,jpj_crs,jpk) , vb_crs(jpi_crs,jpj_crs,jpk) , &
301         &      un_crs(jpi_crs,jpj_crs,jpk) , vn_crs(jpi_crs,jpj_crs,jpk)    ,  wn_crs(jpi_crs,jpj_crs,jpk) ,&
302         &      hdivb_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk) , &
303         &      rhop_crs(jpi_crs,jpj_crs,jpk)  , &
304         &      rb2_crs(jpi_crs,jpj_crs,jpk) ,rn2_crs(jpi_crs,jpj_crs,jpk) , &
305         &      rhd_crs(jpi_crs,jpj_crs,jpk)   , rab_crs_n(jpi_crs,jpj_crs,jpk,jpts) , &
306         &      avtb_2d_crs(jpi_crs,jpj_crs), &
307         &      gtsu_crs(jpi_crs,jpj_crs,jpts) ,gtsv_crs(jpi_crs,jpj_crs,jpts) , &
308                gru_crs(jpi_crs,jpj_crs) ,grv_crs(jpi_crs,jpj_crs) , STAT=ierr(11))
309
310     ALLOCATE( sshb_crs(jpi_crs,jpj_crs), sshn_crs(jpi_crs,jpj_crs),  ssha_crs(jpi_crs,jpj_crs), &
311         &     qsr_crs(jpi_crs ,jpj_crs), wndm_crs(jpi_crs,jpj_crs), utau_crs(jpi_crs,jpj_crs) , &
312         &     vtau_crs(jpi_crs,jpj_crs), taum_crs(jpi_crs,jpj_crs),  &
313         &     rnf_crs (jpi_crs,jpj_crs), rnf_b_crs(jpi_crs ,jpj_crs), nk_rnf_crs(jpi_crs ,jpj_crs), h_rnf_crs(jpi_crs ,jpj_crs), &
314         &     emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), &
315         &     fwfisf_crs(jpi_crs,jpj_crs), fwfisf_b_crs(jpi_crs,jpj_crs), &
316         &     sbc_trc_crs (jpi_crs,jpj_crs,jpts), sbc_trc_b_crs(jpi_crs,jpj_crs,jpts), &
317         &     trc_i_crs (jpi_crs,jpj_crs,jpts), trc_o_crs(jpi_crs,jpj_crs,jpts), &
318         &     fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs), fmmflx_crs(jpi_crs ,jpj_crs),  STAT=ierr(12)  )
319
320#if defined key_traldf_c3d
321      ALLOCATE( ahtt_crs(jpi_crs,jpj_crs,jpk) , ahtu_crs(jpi_crs,jpj_crs,jpk) , &
322              & ahtv_crs(jpi_crs,jpj_crs,jpk) , ahtw_crs(jpi_crs,jpj_crs,jpk) , &
323#elif defined key_traldf_c2d
324      ALLOCATE( ahtt_crs(jpi_crs,jpj_crs    ) , ahtu_crs(jpi_crs,jpj_crs    ) , &
325              & ahtv_crs(jpi_crs,jpj_crs    ) , ahtw_crs(jpi_crs,jpj_crs    ) , &
326#elif defined key_traldf_c1d
327      ALLOCATE( ahtt_crs(        jpk) , ahtu_crs(        jpk) , ahtv_crs(        jpk) , ahtw_crs(        jpk) , &
328#else
329      ALLOCATE( &
330#endif
331              & r_fact_lap_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(13) )
332
333     ALLOCATE( tsb_crs(jpi_crs,jpj_crs,jpk,jpts), tsn_crs(jpi_crs,jpj_crs,jpk,jpts), tsa_crs(jpi_crs,jpj_crs,jpk,jpts),  &
334               en_crs(jpi_crs,jpj_crs,jpk),   avt_crs(jpi_crs,jpj_crs,jpk),    &
335# if defined key_zdfddm
336         &      avs_crs(jpi_crs,jpj_crs,jpk),    &
337# endif
338         &      STAT=ierr(14) )
339
340      ALLOCATE( nmln_crs(jpi_crs,jpj_crs) , hmld_crs(jpi_crs,jpj_crs) , &
341         &      hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(15) )
342
343      crs_dom_alloc = MAXVAL(ierr)
344
345   END FUNCTION crs_dom_alloc
346
347   SUBROUTINE dom_grid_glo
348      !!--------------------------------------------------------------------
349      !!                       ***  MODULE dom_grid_glo  ***
350      !!
351      !! ** Purpose : +Return back to parent grid domain
352      !!---------------------------------------------------------------------
353
354      !                         Return to parent grid domain
355      jpi    = jpi_full
356      jpj    = jpj_full
357      jpim1  = jpim1_full
358      jpjm1  = jpjm1_full
359
360      npolj  = npolj_full
361      jpiglo = jpiglo_full
362      jpjglo = jpjglo_full
363
364      nlci   = nlci_full
365      nlcj   = nlcj_full
366      nldi   = nldi_full
367      nldj   = nldj_full
368      nlei   = nlei_full
369      nlej   = nlej_full
370      nimpp  = nimpp_full
371      njmpp  = njmpp_full
372     
373      nlcit(:)  = nlcit_full(:)
374      nldit(:)  = nldit_full(:)
375      nleit(:)  = nleit_full(:)
376      nimppt(:) = nimppt_full(:)
377      nlcjt(:)  = nlcjt_full(:)
378      nldjt(:)  = nldjt_full(:)
379      nlejt(:)  = nlejt_full(:)
380      njmppt(:) = njmppt_full(:)
381
382      nfsloop = nfsloop_full
383      nfeloop = nfeloop_full
384
385      nfiimpp(:,:) = nfiimpp_full(:,:)
386
387   END SUBROUTINE dom_grid_glo
388
389   SUBROUTINE dom_grid_crs
390      !!--------------------------------------------------------------------
391      !!                       ***  MODULE dom_grid_crs  ***
392      !!
393      !! ** Purpose :  Save the parent grid information & Switch to coarse grid domain
394      !!---------------------------------------------------------------------
395      !
396      !                        Switch to coarse grid domain
397      jpi    = jpi_crs
398      jpj    = jpj_crs
399      jpim1  = jpi_crsm1
400      jpjm1  = jpj_crsm1
401
402      npolj  = npolj_crs
403      jpiglo = jpiglo_crs
404      jpjglo = jpjglo_crs
405
406
407      nlci   = nlci_crs
408      nlcj   = nlcj_crs
409      nldi   = nldi_crs
410      nlei   = nlei_crs
411      nlej   = nlej_crs
412      nldj   = nldj_crs
413      nimpp  = nimpp_crs
414      njmpp  = njmpp_crs
415     
416      nlcit(:)  = nlcit_crs(:)
417      nldit(:)  = nldit_crs(:)
418      nleit(:)  = nleit_crs(:)
419      nimppt(:) = nimppt_crs(:)
420      nlcjt(:)  = nlcjt_crs(:)
421      nldjt(:)  = nldjt_crs(:)
422      nlejt(:)  = nlejt_crs(:)
423      njmppt(:) = njmppt_crs(:)
424
425      nfsloop = nfsloop_crs
426      nfeloop = nfeloop_crs
427
428      nfiimpp(:,:) = nfiimpp_crs(:,:)
429
430      !
431   END SUBROUTINE dom_grid_crs
432   
433     
434   !!======================================================================
435
436END MODULE crs
437
Note: See TracBrowser for help on using the repository browser.