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/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/CRS – NEMO

source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/CRS/crsini.F90 @ 11954

Last change on this file since 11954 was 11671, checked in by acc, 5 years ago

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