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.
crsini.F90 in NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/CRS – NEMO

source: NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/CRS/crsini.F90 @ 12625

Last change on this file since 12625 was 12625, checked in by techene, 4 years ago

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