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 @ 3790

Last change on this file since 3790 was 3790, checked in by cetlod, 12 years ago

2013/dev_r3411_CNRS4_IOCRS : major bugs corrections
File size: 14.0 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 par_oce 
10   USE dom_oce,  ONLY: nperio, narea, npolj, nlci, nlcj, nldi, nldj, nlei, nlej
11
12   IMPLICIT NONE
13   PUBLIC
14
15   
16      PUBLIC crs_dom_alloc  ! Called from crsini.F90
17   PUBLIC dom_grid_glo   
18   PUBLIC dom_grid_crs   
19
20      ! Domain variables
21      INTEGER  ::  jpiglo_crs ,   &             !: 1st dimension of global coarse grid domain
22                   jpjglo_crs                   !: 2nd dimension of global coarse grid domain
23      INTEGER  ::  jpi_crs ,   &                !: 1st dimension of local coarse grid domain
24                   jpj_crs                      !: 2nd dimension of local coarse grid domain
25      INTEGER  ::  jpi_full ,  &                !: 1st dimension of local parent grid domain
26                   jpj_full                     !: 2nd dimension of local parent grid domain
27
28      INTEGER  ::  jpi_crsm1, jpj_crsm1         !: loop indices     
29      INTEGER  ::  jpiglo_crsm1, jpjglo_crsm1   !: loop indices     
30      INTEGER  ::  nperio_full, nperio_crs      !: jperio of parent and coarse grids
31      INTEGER  ::  npolj_full, npolj_crs        !: north fold mark
32      INTEGER  ::  jpiglo_full, jpjglo_full     !: jpiglo / jpjglo
33      INTEGER  ::  npiglo, npjglo      !: jpjglo
34      INTEGER  ::  nlci_full, nlcj_full         !: i-, j-dimension of local or sub domain on parent grid
35      INTEGER  ::  nldi_full, nldj_full         !: starting indices of internal sub-domain on parent grid
36      INTEGER  ::  nlei_full, nlej_full         !: ending indices of internal sub-domain on parent grid
37      INTEGER  ::  nlci_crs, nlcj_crs           !: i-, j-dimension of local or sub domain on coarse grid
38      INTEGER  ::  nldi_crs, nldj_crs           !: starting indices of internal sub-domain on coarse grid
39      INTEGER  ::  nlei_crs, nlej_crs           !: ending indices of internal sub-domain on coarse grid
40      INTEGER  ::  narea_full, narea_crs        !: node
41      INTEGER  ::  jpnij_full, jpnij_crs        !: =jpni*jpnj, the pe decomposition
42      INTEGER  ::  jpim1_full, jpjm1_full       !:
43      INTEGER  ::  nimpp_full, njmpp_full       !: global position of point (1,1) of subdomain on parent grid
44      INTEGER  ::  nimpp_crs, njmpp_crs         !: set to 1,1 for now .  Valid only for monoproc
45
46
47      INTEGER, DIMENSION(:), ALLOCATABLE :: mis_crs, mie_crs, mjs_crs, mje_crs
48                                                ! starting and ending indices of parent subset
49      INTEGER  :: mxbinctr, mybinctr            ! central point in grid box
50 
51      ! Masks
52      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmask_crs, umask_crs, vmask_crs, fmask_crs
53      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: tmask_i_crs, rnfmsk_crs     
54
55      ! Scale factors
56      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1t_crs, e2t_crs, e1e2t_crs ! horizontal scale factors grid type T
57      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1u_crs, e2u_crs ! horizontal scale factors grid type U
58      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1v_crs, e2v_crs ! horizontal scale factors grid type V
59      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1f_crs, e2f_crs ! horizontal scale factors grid type F
60      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_crs, e3u_crs, e3v_crs, e3f_crs, e3w_crs
61      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: fse3t_crs, fse3u_crs, fse3v_crs, fse3f_crs, fse3w_crs
62      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: fse3t_n_crs, fse3t_b_crs, fse3t_a_crs
63     
64      ! Surface
65      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e1e2w_msk, e2e3u_msk, e1e3v_msk, e1e2w, e2e3u, e1e3v
66                                                                  ! vertical scale factors
67      ! Coordinates
68      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphit_crs, glamt_crs, gphif_crs, glamf_crs 
69      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphiu_crs, glamu_crs, gphiv_crs, glamv_crs 
70      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: ff_crs
71      INTEGER,  DIMENSION(:,:),   ALLOCATABLE :: mbathy_crs, mbkt_crs, mbku_crs, mbkv_crs
72      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: gdept_crs, gdepu_crs, gdepv_crs, gdepw_crs
73
74      ! Weights
75      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: facsurfv, facsurfu, facvol_t, facvol_w
76      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ocean_volume_crs_t, ocean_volume_crs_w, bt_crs, r1_bt_crs
77      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: crs_surfu_wgt, crs_surfv_wgt, crs_surfw_wgt, crs_volt_wgt
78
79      ! CRS Namelist
80      INTEGER           :: nn_factx   = 3       !: reduction factor of x-dimension of the parent grid
81      INTEGER           :: nn_facty   = 3       !: reduction factor of y-dimension of the parent grid
82      CHARACTER(len=5)  :: cn_binref  = 'NORTH' !: NORTH = binning starts north fold (equator could be asymmetric)
83                                                !: EQUAT = binning centers at equator (north fold my have artifacts)     
84                                                !:    for even reduction factors, equator placed in bin biased south
85      INTEGER           :: nn_fcrs    = 3       !: frequence of coarsening
86      INTEGER           :: nn_msh_crs = 1       !: Organization of mesh mask output
87                                                !: 0 = no mesh mask output
88                                                !: 1 = unified mesh mask output
89                                                !: 2 = 2 separate mesh mask output
90                                                !: 3 = 3 separate mesh mask output
91      CHARACTER(len=11) :: cn_ocerstcrs         !: root name of restart files for coarsened variables
92         
93      ! Grid reduction factors
94      REAL(wp)     ::  rfactx_r                !: inverse of x-dim reduction factor
95      REAL(wp)     ::  rfacty_r                !: inverse of y-dim reduction factor
96      REAL(wp)     ::  rfactxy 
97
98      !! Horizontal grid parameters for domhgr
99      !! =====================================
100      INTEGER  ::   nphgr_msh_crs = 0   !: type of horizontal mesh
101      !                                 !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
102      !                                 !  = 1 geographical mesh on the sphere with regular grid-spacing
103      !                                 !  = 2 f-plane with regular grid-spacing
104      !                                 !  = 3 beta-plane with regular grid-spacing
105      !                                 !  = 4 Mercator grid with T/U point at the equator
106     
107      ! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields
108      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsn_crs
109      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: un_crs, vn_crs, wn_crs
110      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: hdivn_crs   
111      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: sshn_crs   
112
113      !
114      ! Surface fluxes to pass to TOP
115      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE        ::  wndm_crs, qsr_crs, emp_crs, emps_crs
116
117      ! Vertical diffusion
118      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avt_crs           !: vert. diffusivity coef. [m2/s] at w-point for temp 
119# if defined key_zdfddm
120      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avs_crs           !: salinity vertical diffusivity coeff. [m2/s] at w-point
121# endif
122
123      ! Mixing and Mixed Layer Depth
124      INTEGER,  PUBLIC, ALLOCATABLE, DIMENSION(:,:)    ::  nmln_crs, hmld_crs, hmlp_crs, hmlpt_crs                       
125
126      ! Direction of lateral diffusion
127
128
129CONTAINS
130   
131   INTEGER FUNCTION crs_dom_alloc()
132      !!-------------------------------------------------------------------
133      !!                     *** FUNCTION crs_dom_alloc ***
134      !!  ** Purpose :   Allocate public crs arrays 
135      !!-------------------------------------------------------------------
136      !! Local variables
137      INTEGER, DIMENSION(15) :: ierr
138
139      ierr(:) = 0
140
141      ! Set up bins for coarse grid, horizontal only.
142      ALLOCATE( mis_crs(jpiglo_crs) , mie_crs(jpiglo_crs) , mjs_crs(jpjglo_crs) , mje_crs(jpjglo_crs), STAT=ierr(1) )
143
144      ! Set up Mask and Mesh
145
146      ALLOCATE( tmask_crs(jpi_crs,jpj_crs,jpk) , fmask_crs(jpi_crs,jpj_crs,jpk) ,  &
147         &      umask_crs(jpi_crs,jpj_crs,jpk) , vmask_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(2))
148
149      ALLOCATE( tmask_i_crs(jpi_crs,jpj_crs), rnfmsk_crs(jpi_crs,jpj_crs), STAT=ierr(3) )
150
151      ALLOCATE( gphit_crs(jpi_crs,jpj_crs) , glamt_crs(jpi_crs,jpj_crs) , & 
152         &      gphiu_crs(jpi_crs,jpj_crs) , glamu_crs(jpi_crs,jpj_crs) , &
153         &      gphiv_crs(jpi_crs,jpj_crs) , glamv_crs(jpi_crs,jpj_crs) , &
154         &      gphif_crs(jpi_crs,jpj_crs) , glamf_crs(jpi_crs,jpj_crs) , &
155         &      ff_crs(jpi_crs,jpj_crs)    , STAT=ierr(4))
156
157      ALLOCATE( e1t_crs(jpi_crs,jpj_crs) , e2t_crs(jpi_crs,jpj_crs) , & 
158         &      e1u_crs(jpi_crs,jpj_crs) , e2u_crs(jpi_crs,jpj_crs) , & 
159         &      e1v_crs(jpi_crs,jpj_crs) , e2v_crs(jpi_crs,jpj_crs) , &
160         &      e1f_crs(jpi_crs,jpj_crs) , e2f_crs(jpi_crs,jpj_crs) , &
161         &      e1e2t_crs(jpi_crs,jpj_crs), STAT=ierr(5))
162
163      ALLOCATE( fse3t_crs(jpi_crs,jpj_crs,jpk)  , fse3w_crs(jpi_crs,jpj_crs,jpk) , & 
164         &      fse3u_crs(jpi_crs,jpj_crs,jpk)  , fse3v_crs(jpi_crs,jpj_crs,jpk) , & 
165         &      e3t_crs(jpi_crs,jpj_crs,jpk)    , e3w_crs(jpi_crs,jpj_crs,jpk)   , & 
166         &      e3u_crs(jpi_crs,jpj_crs,jpk)    , e3v_crs(jpi_crs,jpj_crs,jpk)   , &
167         &      e3f_crs(jpi_crs,jpj_crs,jpk)    , fse3f_crs(jpi_crs,jpj_crs,jpk) , & 
168         &      fse3t_b_crs(jpi_crs,jpj_crs,jpk), fse3t_n_crs(jpi_crs,jpj_crs,jpk),&
169         &      fse3t_a_crs(jpi_crs,jpj_crs,jpk), e1e2w_msk(jpi_crs,jpj_crs,jpk) , &
170         &      e2e3u_msk(jpi_crs,jpj_crs,jpk)  , e1e3v_msk(jpi_crs,jpj_crs,jpk) , &
171         &      e1e2w(jpi_crs,jpj_crs,jpk)      , e2e3u(jpi_crs,jpj_crs,jpk)     , &
172         &      e1e3v(jpi_crs,jpj_crs,jpk)      , STAT=ierr(6))
173
174
175      ALLOCATE( facsurfv(jpi_crs,jpj_crs,jpk) , facsurfu(jpi_crs,jpj_crs,jpk) , & 
176         &      facvol_t(jpi_crs,jpj_crs,jpk) , facvol_w(jpi_crs,jpj_crs,jpk) , &
177         &      ocean_volume_crs_t(jpi_crs,jpj_crs,jpk) , ocean_volume_crs_w(jpi_crs,jpj_crs,jpk), &
178         &      bt_crs(jpi_crs,jpj_crs,jpk)   , r1_bt_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(7))
179
180
181      ALLOCATE( crs_surfu_wgt(jpi_crs,jpj_crs,jpk) , crs_surfv_wgt(jpi_crs,jpj_crs,jpk) , & 
182         &      crs_surfw_wgt(jpi_crs,jpj_crs,jpk) , crs_volt_wgt(jpi_crs,jpj_crs,jpk) , STAT=ierr(8))
183
184
185      ALLOCATE( mbathy_crs(jpi_crs,jpj_crs) , mbkt_crs(jpi_crs,jpj_crs) , &
186         &      mbku_crs(jpi_crs,jpj_crs)   , mbkv_crs(jpi_crs,jpj_crs) , STAT=ierr(9))
187
188      ALLOCATE( gdept_crs(jpi_crs,jpj_crs,jpk) , gdepu_crs(jpi_crs,jpj_crs,jpk) , &
189         &      gdepv_crs(jpi_crs,jpj_crs,jpk) , gdepw_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(10) )
190
191
192      ALLOCATE( un_crs(jpi_crs,jpj_crs,jpk) , vn_crs(jpi_crs,jpj_crs,jpk) , &
193         &      wn_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(11))
194
195      ALLOCATE( sshn_crs(jpi_crs,jpj_crs),  emp_crs(jpi_crs,jpj_crs)    , &
196         &      qsr_crs(jpi_crs,jpj_crs) ,  wndm_crs(jpi_crs,jpj_crs)    , &
197         &      emps_crs(jpi_crs,jpj_crs),        STAT=ierr(12)  )
198 
199      ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk),    &
200# if defined key_zdfddm
201         &      avs_crs(jpi_crs,jpj_crs,jpk),    &
202# endif
203         &      STAT=ierr(13) )
204
205      ALLOCATE( nmln_crs(jpi_crs,jpj_crs) , hmld_crs(jpi_crs,jpj_crs) , &
206         &      hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(14) )
207
208
209      crs_dom_alloc = MAXVAL(ierr)
210
211   END FUNCTION crs_dom_alloc
212   
213   SUBROUTINE dom_grid_glo
214      !!--------------------------------------------------------------------
215      !!                       ***  MODULE dom_grid_glo  ***
216      !!
217      !! ** Purpose : +Return back to parent grid domain
218      !!---------------------------------------------------------------------
219
220      !                         Return to parent grid domain
221      jpi    = jpi_full
222      jpj    = jpj_full
223      jpim1  = jpim1_full
224      jpjm1  = jpjm1_full
225      nperio = nperio_full
226
227      npolj  = npolj_full
228      jpnij  = jpnij_full
229      narea  = narea_full
230      jpiglo = jpiglo_full
231      jpjglo = jpjglo_full
232
233      nlcj   = nlcj_full
234      nlci   = nlci_full
235      nldi   = nldi_full
236      nlei   = nlei_full
237      nlej   = nlej_full
238
239      nldj   = nldj_full
240
241   END SUBROUTINE dom_grid_glo
242
243   SUBROUTINE dom_grid_crs
244      !!--------------------------------------------------------------------
245      !!                       ***  MODULE dom_grid_crs  ***
246      !!
247      !! ** Purpose :  Save the parent grid information & Switch to coarse grid domain
248      !!---------------------------------------------------------------------
249
250      !                         Save the parent grid information
251      jpi_full    = jpi
252      jpj_full    = jpj
253      jpim1_full  = jpim1
254      jpjm1_full  = jpjm1
255      nperio_full = nperio
256
257      npolj_full  = npolj
258      jpnij_full  = jpnij
259      narea_full  = narea
260      jpiglo_full = jpiglo
261      jpjglo_full = jpjglo
262
263      nlcj_full   = nlcj
264      nlci_full   = nlci
265      nldi_full   = nldi
266      nlei_full   = nlei
267      nlej_full   = nlej
268      nldj_full   = nldj
269
270      !                        Switch to coarse grid domain
271      jpi    = jpi_crs
272      jpj    = jpj_crs
273      jpim1  = jpi_crsm1
274      jpjm1  = jpj_crsm1
275      nperio = nperio_crs
276
277      npolj  = npolj_crs
278      jpnij  = jpnij_crs
279      narea  = narea_crs
280      jpiglo = jpiglo_crs
281      jpjglo = jpjglo_crs
282
283      nlci   = nlci_crs
284      nlcj   = nlcj_crs
285      nldi   = nldi_crs
286      nlei   = nlei_crs
287      nlej   = nlej_crs
288
289      nldj   = nldj_crs
290
291   END SUBROUTINE dom_grid_crs
292   !!======================================================================
293
294END MODULE crs_dom
295
Note: See TracBrowser for help on using the repository browser.