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/UKMO/NEMO_4.0_mirror_text_diagnostics/src/OCE/CRS – NEMO

source: NEMO/branches/UKMO/NEMO_4.0_mirror_text_diagnostics/src/OCE/CRS/crsini.F90 @ 10986

Last change on this file since 10986 was 10986, checked in by andmirek, 5 years ago

GMED 462 add flush
File size: 11.4 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      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
83      READ  ( numnam_ref, namcrs, IOSTAT = ios, ERR = 901)
84901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcrs in reference namelist', lwp )
85      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
86      READ  ( numnam_cfg, namcrs, IOSTAT = ios, ERR = 902 )
87902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcrs in configuration namelist', lwp )
88      IF(lwm .AND. nprint > 2) WRITE ( numond, namcrs )
89
90     IF(lwp) THEN
91        WRITE(numout,*)
92        WRITE(numout,*) 'crs_init : Initializing the grid coarsening module'
93        WRITE(numout,*) '~~~~~~~~'
94        WRITE(numout,*) '   Namelist namcrs '
95        WRITE(numout,*) '      coarsening factor in i-direction      nn_factx   = ', nn_factx
96        WRITE(numout,*) '      coarsening factor in j-direction      nn_facty   = ', nn_facty
97        WRITE(numout,*) '      bin centering preference              nn_binref  = ', nn_binref
98        WRITE(numout,*) '      create a mesh file (=T)               ln_msh_crs = ', ln_msh_crs
99        WRITE(numout,*) '      type of Kz coarsening (0,1,2)         nn_crs_kz  = ', nn_crs_kz
100        WRITE(numout,*) '      wn coarsened or computed using hdivn  ln_crs_wn  = ', ln_crs_wn
101        IF(lflush) CALL FLUSH(numout)
102     ENDIF
103             
104     rfactx_r = 1. / nn_factx
105     rfacty_r = 1. / nn_facty
106
107     !---------------------------------------------------------
108     ! 2. Define Global Dimensions of the coarsened grid
109     !---------------------------------------------------------
110     CALL crs_dom_def     
111
112     !---------------------------------------------------------
113     ! 3. Mask and Mesh
114     !---------------------------------------------------------
115
116     !     Set up the masks and meshes     
117
118     !  3.a. Get the masks   
119 
120     CALL crs_dom_msk
121
122
123     !  3.b. Get the coordinates
124     !      Odd-numbered reduction factor, center coordinate on T-cell
125     !      Even-numbered reduction factor, center coordinate on U-,V- faces or f-corner.
126     !     
127     IF ( nresty /= 0 .AND. nrestx /= 0 ) THEN
128        CALL crs_dom_coordinates( gphit, glamt, 'T', gphit_crs, glamt_crs ) 
129        CALL crs_dom_coordinates( gphiu, glamu, 'U', gphiu_crs, glamu_crs )       
130        CALL crs_dom_coordinates( gphiv, glamv, 'V', gphiv_crs, glamv_crs ) 
131        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs ) 
132     ELSEIF ( nresty /= 0 .AND. nrestx == 0 ) THEN
133        CALL crs_dom_coordinates( gphiu, glamu, 'T', gphit_crs, glamt_crs )
134        CALL crs_dom_coordinates( gphiu, glamu, 'U', gphiu_crs, glamu_crs )
135        CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs )
136        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
137     ELSEIF ( nresty == 0 .AND. nrestx /= 0 ) THEN
138        CALL crs_dom_coordinates( gphiv, glamv, 'T', gphit_crs, glamt_crs )
139        CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs )
140        CALL crs_dom_coordinates( gphiv, glamv, 'V', gphiv_crs, glamv_crs )
141        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
142     ELSE
143        CALL crs_dom_coordinates( gphif, glamf, 'T', gphit_crs, glamt_crs )
144        CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs )
145        CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs )
146        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
147     ENDIF
148
149
150     !  3.c. Get the horizontal mesh
151
152     !      3.c.1 Horizontal scale factors
153
154     CALL crs_dom_hgr( e1t, e2t, 'T', e1t_crs, e2t_crs )
155     CALL crs_dom_hgr( e1u, e2u, 'U', e1u_crs, e2u_crs )
156     CALL crs_dom_hgr( e1v, e2v, 'V', e1v_crs, e2v_crs )
157     CALL crs_dom_hgr( e1f, e2f, 'F', e1f_crs, e2f_crs )
158
159     e1e2t_crs(:,:) = e1t_crs(:,:) * e2t_crs(:,:)
160     
161     
162     !      3.c.2 Coriolis factor 
163
164!!gm  Not sure CRS needs Coriolis parameter....
165!!gm  If needed, then update this to have Coriolis at both f- and t-points
166
167      ff_crs(:,:) = 2. * omega * SIN( rad * gphif_crs(:,:) )
168
169      CALL ctl_warn( 'crsini: CAUTION, CRS only designed for Coriolis defined on the sphere' ) 
170 
171
172     !    3.d.1 mbathy ( vertical k-levels of bathymetry )     
173
174     CALL crs_dom_bat
175     
176     !
177     ze3t(:,:,:) = e3t_n(:,:,:)
178     ze3u(:,:,:) = e3u_n(:,:,:)
179     ze3v(:,:,:) = e3v_n(:,:,:)
180     ze3w(:,:,:) = e3w_n(:,:,:)
181
182     !    3.d.2   Surfaces
183     CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t  )
184     CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=ze3u )
185     CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=ze3v )
186   
187     facsurfu(:,:,:) = umask_crs(:,:,:) * e2e3u_msk(:,:,:) / e2e3u_crs(:,:,:)
188     facsurfv(:,:,:) = vmask_crs(:,:,:) * e1e3v_msk(:,:,:) / e1e3v_crs(:,:,:)
189
190     !    3.d.3   Vertical scale factors
191     !
192     CALL crs_dom_e3( e1t, e2t, ze3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs)
193     CALL crs_dom_e3( e1u, e2u, ze3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs)
194     CALL crs_dom_e3( e1v, e2v, ze3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs)
195     CALL crs_dom_e3( e1t, e2t, ze3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs)
196
197     ! Replace 0 by e3t_0 or e3w_0
198     DO jk = 1, jpk
199        DO ji = 1, jpi_crs
200           DO jj = 1, jpj_crs
201              IF( e3t_crs(ji,jj,jk) == 0._wp ) e3t_crs(ji,jj,jk) = e3t_1d(jk)
202              IF( e3w_crs(ji,jj,jk) == 0._wp ) e3w_crs(ji,jj,jk) = e3w_1d(jk)
203              IF( e3u_crs(ji,jj,jk) == 0._wp ) e3u_crs(ji,jj,jk) = e3t_1d(jk)
204              IF( e3v_crs(ji,jj,jk) == 0._wp ) e3v_crs(ji,jj,jk) = e3t_1d(jk)
205           ENDDO
206        ENDDO
207     ENDDO
208
209     !    3.d.3   Vertical depth (meters)
210     CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_crs, p_e3=ze3t, psgn=1.0 ) 
211     CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=ze3w, psgn=1.0 )
212
213
214     !---------------------------------------------------------
215     ! 4.  Coarse grid ocean volume and averaging weights
216     !---------------------------------------------------------
217     ! 4.a. Ocean volume or area unmasked and masked
218     CALL crs_dom_facvol( tmask, 'T', e1t, e2t, ze3t, ocean_volume_crs_t, facvol_t )
219     !
220     bt_crs(:,:,:) = ocean_volume_crs_t(:,:,:) * facvol_t(:,:,:)
221     !
222     r1_bt_crs(:,:,:) = 0._wp 
223     WHERE( bt_crs /= 0._wp ) r1_bt_crs(:,:,:) = 1._wp / bt_crs(:,:,:)
224
225     CALL crs_dom_facvol( tmask, 'W', e1t, e2t, ze3w, ocean_volume_crs_w, facvol_w )
226     !
227     !---------------------------------------------------------
228     ! 5.  Write out coarse meshmask  (see OCE/DOM/domwri.F90 for ideas later)
229     !---------------------------------------------------------
230
231     IF( ln_msh_crs ) THEN
232        CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
233        CALL crs_dom_wri     
234        CALL dom_grid_glo   ! Return to parent grid domain
235     ENDIF
236     
237      !---------------------------------------------------------
238      ! 7. Finish and clean-up
239      !---------------------------------------------------------
240      !
241   END SUBROUTINE crs_init
242   
243   !!======================================================================
244END MODULE crsini
Note: See TracBrowser for help on using the repository browser.