source: trunk/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90 @ 6140

Last change on this file since 6140 was 6140, checked in by timgraham, 5 years ago

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge —reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

  • Property svn:keywords set to Id
File size: 11.6 KB
Line 
1MODULE crsini   
2   !!======================================================================
3   !!                         ***  MODULE crsini  ***
4   !!            Manage the grid coarsening module initialization
5   !!======================================================================
6   !!  History     2012-05   (J. Simeon, G. Madec, C. Ethe, C. Calone) Original code
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!  crs_init    :
11   !!----------------------------------------------------------------------
12   USE par_kind, ONLY: wp
13   USE par_oce                  ! For parameter jpi,jpj,jphgr_msh
14   USE dom_oce                  ! For parameters in par_oce
15   USE crs                      ! Coarse grid domain
16   USE phycst, ONLY: omega, rad ! physical constants
17   USE crsdom
18   USE crsdomwri
19   USE crslbclnk
20   !
21   USE iom
22   USE in_out_manager
23   USE lib_mpp
24   USE wrk_nemo 
25   USE timing                   ! Timing
26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC   crs_init   ! called by nemogcm.F90 module
31
32   !!----------------------------------------------------------------------
33   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
34   !! $Id$
35   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
36   !!----------------------------------------------------------------------
37CONTAINS
38   
39   SUBROUTINE crs_init 
40      !!-------------------------------------------------------------------
41      !!                     *** SUBROUTINE crs_init
42      !!  ** Purpose : Initialization of the grid coarsening module 
43      !!               1. Read namelist
44      !!               X2. MOVE TO crs_dom.F90 Set the domain definitions for coarse grid
45      !!                 a. Define the coarse grid starting/ending indices on parent grid
46      !!                    Here is where the T-pivot or F-pivot grids are discerned
47      !!                 b. TODO.  Include option for north-centric or equator-centric binning.
48      !!                 (centered only for odd reduction factors; even reduction bins bias equator to the south)
49      !!               3. Mask and mesh creation. => calls to crsfun
50      !!                  a. Use crsfun_mask to generate tmask,umask, vmask, fmask.
51      !!                  b. Use crsfun_coordinates to get coordinates
52      !!                  c. Use crsfun_UV to get horizontal scale factors
53      !!                  d. Use crsfun_TW to get initial vertical scale factors   
54      !!               4. Volumes and weights jes.... TODO. Updates for vvl? Where to do this? crsstp.F90?
55      !!                  a. Calculate initial coarse grid box volumes: pvol_T, pvol_W
56      !!                  b. Calculate initial coarse grid surface-averaging weights
57      !!                  c. Calculate initial coarse grid volume-averaging weights
58      !!                 
59      !!               X5. MOVE TO crs_dom_wri.F90 Using iom_rstput output the initial meshmask.
60      !!               ?. Another set of "masks" to generate
61      !!                  are the u- and v- surface areas for U- and V- area-weighted means.
62      !!                  Need to put this somewhere in section 3?
63      !! jes. What do to about the vvl?  GM.  could separate the weighting (denominator), so
64      !! output C*dA or C*dV as summation not mran, then do mean (division) at moment of output.
65      !! As is, crsfun takes into account vvl.   
66      !!      Talked about pre-setting the surface array to avoid IF/ENDIF and division.
67      !!      But have then to make that preset array here and elsewhere.
68      !!      that is called every timestep...
69      !!
70      !!               - Read in pertinent data ?
71      !!-------------------------------------------------------------------
72      INTEGER  :: ji,jj,jk      ! dummy indices
73      INTEGER  :: ierr                                ! allocation error status
74      INTEGER  ::   ios                 ! Local integer output status for namelist read
75      REAL(wp), DIMENSION(:,:,:), POINTER :: ze3t, ze3u, ze3v, ze3w
76
77      NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, nn_msh_crs, nn_crs_kz, ln_crs_wn
78      !!----------------------------------------------------------------------
79      !
80      IF( nn_timing == 1 )  CALL timing_start('crs_init')
81      !
82      IF(lwp) THEN
83         WRITE(numout,*)
84         WRITE(numout,*) 'crs_init : Initializing the grid coarsening module '
85      ENDIF
86
87     !---------------------------------------------------------
88     ! 1. Read Namelist file
89     !---------------------------------------------------------
90     !
91
92      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
93      READ  ( numnam_ref, namcrs, IOSTAT = ios, ERR = 901)
94901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcrs in reference namelist', lwp )
95
96      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
97      READ  ( numnam_cfg, namcrs, IOSTAT = ios, ERR = 902 )
98902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcrs in configuration namelist', lwp )
99      IF(lwm) WRITE ( numond, namcrs )
100
101     IF(lwp) THEN
102        WRITE(numout,*)
103        WRITE(numout,*) 'crs_init: Namelist namcrs '
104        WRITE(numout,*) '   coarsening factor in i-direction      nn_factx   = ', nn_factx
105        WRITE(numout,*) '   coarsening factor in j-direction      nn_facty   = ', nn_facty
106        WRITE(numout,*) '   bin centering preference              nn_binref  = ', nn_binref
107        WRITE(numout,*) '   create (=1) a mesh file or not (=0)   nn_msh_crs = ', nn_msh_crs
108        WRITE(numout,*) '   type of Kz coarsening (0,1,2)         nn_crs_kz  = ', nn_crs_kz
109        WRITE(numout,*) '   wn coarsened or computed using hdivn  ln_crs_wn  = ', ln_crs_wn
110     ENDIF
111             
112     rfactx_r = 1. / nn_factx
113     rfacty_r = 1. / nn_facty
114
115     !---------------------------------------------------------
116     ! 2. Define Global Dimensions of the coarsened grid
117     !---------------------------------------------------------
118     CALL crs_dom_def     
119
120     !---------------------------------------------------------
121     ! 3. Mask and Mesh
122     !---------------------------------------------------------
123
124     !     Set up the masks and meshes     
125
126     !  3.a. Get the masks   
127 
128     CALL crs_dom_msk
129
130
131     !  3.b. Get the coordinates
132     !      Odd-numbered reduction factor, center coordinate on T-cell
133     !      Even-numbered reduction factor, center coordinate on U-,V- faces or f-corner.
134     !     
135     IF ( nresty /= 0 .AND. nrestx /= 0 ) THEN
136        CALL crs_dom_coordinates( gphit, glamt, 'T', gphit_crs, glamt_crs ) 
137        CALL crs_dom_coordinates( gphiu, glamu, 'U', gphiu_crs, glamu_crs )       
138        CALL crs_dom_coordinates( gphiv, glamv, 'V', gphiv_crs, glamv_crs ) 
139        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs ) 
140     ELSEIF ( nresty /= 0 .AND. nrestx == 0 ) THEN
141        CALL crs_dom_coordinates( gphiu, glamu, 'T', gphit_crs, glamt_crs )
142        CALL crs_dom_coordinates( gphiu, glamu, 'U', gphiu_crs, glamu_crs )
143        CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs )
144        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
145     ELSEIF ( nresty == 0 .AND. nrestx /= 0 ) THEN
146        CALL crs_dom_coordinates( gphiv, glamv, 'T', gphit_crs, glamt_crs )
147        CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs )
148        CALL crs_dom_coordinates( gphiv, glamv, 'V', gphiv_crs, glamv_crs )
149        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
150     ELSE
151        CALL crs_dom_coordinates( gphif, glamf, 'T', gphit_crs, glamt_crs )
152        CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs )
153        CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs )
154        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
155     ENDIF
156
157
158     !  3.c. Get the horizontal mesh
159
160     !      3.c.1 Horizontal scale factors
161
162     CALL crs_dom_hgr( e1t, e2t, 'T', e1t_crs, e2t_crs )
163     CALL crs_dom_hgr( e1u, e2u, 'U', e1u_crs, e2u_crs )
164     CALL crs_dom_hgr( e1v, e2v, 'V', e1v_crs, e2v_crs )
165     CALL crs_dom_hgr( e1f, e2f, 'F', e1f_crs, e2f_crs )
166
167     e1e2t_crs(:,:) = e1t_crs(:,:) * e2t_crs(:,:)
168     
169     
170     !      3.c.2 Coriolis factor 
171
172      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
173
174      CASE ( 0, 1, 4 )           ! mesh on the sphere
175
176         ff_crs(:,:) = 2. * omega * SIN( rad * gphif_crs(:,:) )
177
178      CASE DEFAULT 
179
180       IF(lwp)    WRITE(numout,*) 'crsini.F90. crs_init. Only jphgr_msh = 0, 1 or 4 supported' 
181 
182      END SELECT 
183
184     !    3.d.1 mbathy ( vertical k-levels of bathymetry )     
185
186     CALL crs_dom_bat
187     
188     !
189     CALL wrk_alloc( jpi,jpj,jpk,   ze3t, ze3u, ze3v, ze3w )
190     !
191     ze3t(:,:,:) = e3t_n(:,:,:)
192     ze3u(:,:,:) = e3u_n(:,:,:)
193     ze3v(:,:,:) = e3v_n(:,:,:)
194     ze3w(:,:,:) = e3w_n(:,:,:)
195
196     !    3.d.2   Surfaces
197     CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t  )
198     CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=ze3u )
199     CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=ze3v )
200   
201     facsurfu(:,:,:) = umask_crs(:,:,:) * e2e3u_msk(:,:,:) / e2e3u_crs(:,:,:)
202     facsurfv(:,:,:) = vmask_crs(:,:,:) * e1e3v_msk(:,:,:) / e1e3v_crs(:,:,:)
203
204     !    3.d.3   Vertical scale factors
205     !
206     CALL crs_dom_e3( e1t, e2t, ze3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs)
207     CALL crs_dom_e3( e1u, e2u, ze3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs)
208     CALL crs_dom_e3( e1v, e2v, ze3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs)
209     CALL crs_dom_e3( e1t, e2t, ze3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs)
210
211     ! Replace 0 by e3t_0 or e3w_0
212     DO jk = 1, jpk
213        DO ji = 1, jpi_crs
214           DO jj = 1, jpj_crs
215              IF( e3t_crs(ji,jj,jk) == 0._wp ) e3t_crs(ji,jj,jk) = e3t_1d(jk)
216              IF( e3w_crs(ji,jj,jk) == 0._wp ) e3w_crs(ji,jj,jk) = e3w_1d(jk)
217              IF( e3u_crs(ji,jj,jk) == 0._wp ) e3u_crs(ji,jj,jk) = e3t_1d(jk)
218              IF( e3v_crs(ji,jj,jk) == 0._wp ) e3v_crs(ji,jj,jk) = e3t_1d(jk)
219           ENDDO
220        ENDDO
221     ENDDO
222
223     !    3.d.3   Vertical depth (meters)
224     CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_crs, p_e3=ze3t, psgn=1.0 ) 
225     CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=ze3w, psgn=1.0 )
226
227
228     !---------------------------------------------------------
229     ! 4.  Coarse grid ocean volume and averaging weights
230     !---------------------------------------------------------
231     ! 4.a. Ocean volume or area unmasked and masked
232     CALL crs_dom_facvol( tmask, 'T', e1t, e2t, ze3t, ocean_volume_crs_t, facvol_t )
233     !
234     bt_crs(:,:,:) = ocean_volume_crs_t(:,:,:) * facvol_t(:,:,:)
235     !
236     r1_bt_crs(:,:,:) = 0._wp 
237     WHERE( bt_crs /= 0._wp ) r1_bt_crs(:,:,:) = 1._wp / bt_crs(:,:,:)
238
239     CALL crs_dom_facvol( tmask, 'W', e1t, e2t, ze3w, ocean_volume_crs_w, facvol_w )
240     !
241     !---------------------------------------------------------
242     ! 5.  Write out coarse meshmask  (see OPA_SRC/DOM/domwri.F90 for ideas later)
243     !---------------------------------------------------------
244
245     IF( nn_msh_crs > 0 ) THEN
246        CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
247        CALL crs_dom_wri     
248        CALL dom_grid_glo   ! Return to parent grid domain
249     ENDIF
250     
251      !---------------------------------------------------------
252      ! 7. Finish and clean-up
253      !---------------------------------------------------------
254      CALL wrk_dealloc( jpi,jpj,jpk,   ze3t, ze3u, ze3v, ze3w )
255      !
256   END SUBROUTINE crs_init
257   
258   !!======================================================================
259END MODULE crsini
Note: See TracBrowser for help on using the repository browser.