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.
domrea.F90 in branches/nemo_v3_3_beta/NEMOGCM/NEMO/OFF_SRC – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OFF_SRC/domrea.F90 @ 2444

Last change on this file since 2444 was 2444, checked in by cetlod, 13 years ago

Improvment of OFFLINE in v3.3beta (review done by gm) : clean the style in all routines, suppression of key_zdfddm
  • Property svn:keywords set to Id
File size: 14.1 KB
Line 
1MODULE domrea
2   !!======================================================================
3   !!                       ***  MODULE domrea  ***
4   !! Ocean initialization : read the ocean domain meshmask file(s)
5   !!======================================================================
6
7   !!----------------------------------------------------------------------
8   !!   dom_rea        : read mesh and mask file(s)
9   !!                    nmsh = 1  :   mesh_mask file
10   !!                         = 2  :   mesh and mask file
11   !!                         = 3  :   mesh_hgr, mesh_zgr and mask
12   !!----------------------------------------------------------------------
13   USE dom_oce         ! ocean space and time domain
14   USE dommsk          ! domain: masks
15   USE in_out_manager  ! I/O manager
16
17   IMPLICIT NONE
18   PRIVATE
19
20   PUBLIC   dom_rea    ! routine called by inidom.F90
21   !!----------------------------------------------------------------------
22   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
23   !! $Id$
24   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
25   !!----------------------------------------------------------------------
26
27CONTAINS
28
29#if   defined key_mpp_mpi   &&   defined key_dimgout
30   !!----------------------------------------------------------------------
31   !!   'key_mpp_mpi'     OR
32   !!   'key_dimgout' :         each processor makes its own direct access file
33   !!                      use build_nc_meshmask off line to retrieve
34   !!                      a ioipsl compliant meshmask file
35   !!----------------------------------------------------------------------
36#  include "domrea_dimg.h90"
37
38#else
39   !!----------------------------------------------------------------------
40   !!   Default option :                                        NetCDF file
41   !!----------------------------------------------------------------------
42
43   SUBROUTINE dom_rea
44      !!----------------------------------------------------------------------
45      !!                  ***  ROUTINE dom_rea  ***
46      !!                   
47      !! ** Purpose :  Read the NetCDF file(s) which contain(s) all the
48      !!      ocean domain informations (mesh and mask arrays). This (these)
49      !!      file(s) is (are) used for visualisation (SAXO software) and
50      !!      diagnostic computation.
51      !!
52      !! ** Method  :   Read in a file all the arrays generated in routines
53      !!      domhgr, domzgr, and dommsk. Note: the file contain depends on
54      !!      the vertical coord. used (z-coord, partial steps, s-coord)
55      !!                    nmsh = 1  :   'mesh_mask.nc' file
56      !!                         = 2  :   'mesh.nc' and mask.nc' files
57      !!                         = 3  :   'mesh_hgr.nc', 'mesh_zgr.nc' and
58      !!                                  'mask.nc' files
59      !!      For huge size domain, use option 2 or 3 depending on your
60      !!      vertical coordinate.
61      !!
62      !! ** input file :
63      !!      meshmask.nc  : domain size, horizontal grid-point position,
64      !!                     masks, depth and vertical scale factors
65      !!----------------------------------------------------------------------
66      USE iom
67      !!
68      INTEGER  ::   ji, jj, jk   ! dummy loop indices
69      INTEGER  ::   ik, inum0 , inum1 , inum2 , inum3 , inum4   ! local integers
70      REAL(wp) ::   zrefdep         ! local real
71      REAL(wp), DIMENSION(jpi,jpj) ::   zprt   ! 2D workspace
72      !!----------------------------------------------------------------------
73
74      IF(lwp) WRITE(numout,*)
75      IF(lwp) WRITE(numout,*) 'dom_rea : read NetCDF mesh and mask information file(s)'
76      IF(lwp) WRITE(numout,*) '~~~~~~~'
77
78      zprt(:,:) = 0._wp
79
80      SELECT CASE (nmsh)
81         !                                     ! ============================
82         CASE ( 1 )                            !  create 'mesh_mask.nc' file
83            !                                  ! ============================
84
85            IF(lwp) WRITE(numout,*) '          one file in "mesh_mask.nc" '
86            CALL iom_open( 'mesh_mask', inum0 )
87
88            inum2 = inum0                                            ! put all the informations
89            inum3 = inum0                                            ! in unit inum0
90            inum4 = inum0
91
92            !                                  ! ============================
93         CASE ( 2 )                            !  create 'mesh.nc' and
94            !                                  !         'mask.nc' files
95            !                                  ! ============================
96
97            IF(lwp) WRITE(numout,*) '          two files in "mesh.nc" and "mask.nc" '
98            CALL iom_open( 'mesh', inum1 )
99            CALL iom_open( 'mask', inum2 )
100
101            inum3 = inum1                                            ! put mesh informations
102            inum4 = inum1                                            ! in unit inum1
103
104            !                                  ! ============================
105         CASE ( 3 )                            !  create 'mesh_hgr.nc'
106            !                                  !         'mesh_zgr.nc' and
107            !                                  !         'mask.nc'     files
108            !                                  ! ============================
109
110            IF(lwp) WRITE(numout,*) '          three files in "mesh_hgr.nc" , "mesh_zgr.nc" and "mask.nc" '
111            CALL iom_open( 'mesh_hgr', inum3 ) ! create 'mesh_hgr.nc'
112            CALL iom_open( 'mesh_zgr', inum4 ) ! create 'mesh_zgr.nc'
113            CALL iom_open( 'mask'    , inum2 ) ! create 'mask.nc'
114
115         END SELECT
116
117         !                                                         ! masks (inum2)
118         CALL iom_get( inum2, jpdom_data, 'tmask', tmask )
119         CALL iom_get( inum2, jpdom_data, 'umask', umask )
120         CALL iom_get( inum2, jpdom_data, 'vmask', vmask )
121         CALL iom_get( inum2, jpdom_data, 'fmask', fmask )
122
123#if defined key_c1d
124         ! set umask and vmask equal tmask in 1D configuration
125         IF(lwp) WRITE(numout,*)
126         IF(lwp) WRITE(numout,*) '**********  1D configuration : set umask and vmask equal tmask ********'
127         IF(lwp) WRITE(numout,*) '**********                                                     ********'
128
129         umask(:,:,:) = tmask(:,:,:)
130         vmask(:,:,:) = tmask(:,:,:)
131#endif
132
133#if defined key_degrad
134         CALL iom_get( inum2, jpdom_data, 'facvolt', facvol )
135#endif
136
137         !                                                         ! horizontal mesh (inum3)
138         CALL iom_get( inum3, jpdom_data, 'glamt', glamt )
139         CALL iom_get( inum3, jpdom_data, 'glamu', glamu )
140         CALL iom_get( inum3, jpdom_data, 'glamv', glamv )
141         CALL iom_get( inum3, jpdom_data, 'glamf', glamf )
142
143         CALL iom_get( inum3, jpdom_data, 'gphit', gphit )
144         CALL iom_get( inum3, jpdom_data, 'gphiu', gphiu )
145         CALL iom_get( inum3, jpdom_data, 'gphiv', gphiv )
146         CALL iom_get( inum3, jpdom_data, 'gphif', gphif )
147
148         CALL iom_get( inum3, jpdom_data, 'e1t', e1t )
149         CALL iom_get( inum3, jpdom_data, 'e1u', e1u )
150         CALL iom_get( inum3, jpdom_data, 'e1v', e1v )
151         
152         CALL iom_get( inum3, jpdom_data, 'e2t', e2t )
153         CALL iom_get( inum3, jpdom_data, 'e2u', e2u )
154         CALL iom_get( inum3, jpdom_data, 'e2v', e2v )
155
156         CALL iom_get( inum3, jpdom_data, 'ff', ff )
157
158         CALL iom_get( inum4, jpdom_data, 'mbathy', zprt )
159     
160         DO jj = 1, jpj
161            DO ji = 1, jpi
162               mbathy(ji,jj) = MAX( zprt(ji,jj) * tmask(ji,jj,1), 1._wp ) + 1
163            ENDDO
164         ENDDO
165
166         IF( ln_sco ) THEN                                         ! s-coordinate
167            CALL iom_get( inum4, jpdom_data, 'hbatt', hbatt )
168            CALL iom_get( inum4, jpdom_data, 'hbatu', hbatu )
169            CALL iom_get( inum4, jpdom_data, 'hbatv', hbatv )
170            CALL iom_get( inum4, jpdom_data, 'hbatf', hbatf )
171           
172            CALL iom_get( inum4, jpdom_unknown, 'gsigt', gsigt ) ! scaling coef.
173            CALL iom_get( inum4, jpdom_unknown, 'gsigw', gsigw )
174            CALL iom_get( inum4, jpdom_unknown, 'gsi3w', gsi3w ) 
175            CALL iom_get( inum4, jpdom_unknown, 'esigt', esigt )
176            CALL iom_get( inum4, jpdom_unknown, 'esigw', esigw )
177
178            CALL iom_get( inum4, jpdom_data, 'e3t', e3t ) ! scale factors
179            CALL iom_get( inum4, jpdom_data, 'e3u', e3u )
180            CALL iom_get( inum4, jpdom_data, 'e3v', e3v )
181            CALL iom_get( inum4, jpdom_data, 'e3w', e3w )
182
183            CALL iom_get( inum4, jpdom_unknown, 'gdept_0', gdept_0 ) ! depth
184            CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', gdepw_0 )
185         ENDIF
186
187 
188         IF( ln_zps ) THEN   
189            ! Vertical coordinates and scales factors
190            CALL iom_get( inum4, jpdom_unknown, 'gdept_0', gdept_0 ) ! depth
191            CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', gdepw_0 )
192            CALL iom_get( inum4, jpdom_unknown, 'e3t_0'  , e3t_0   )
193            CALL iom_get( inum4, jpdom_unknown, 'e3w_0'  , e3w_0   )
194                                      ! z-coordinate - partial steps
195            IF( nmsh <= 6 ) THEN                                   !    ! 3D vertical scale factors
196              CALL iom_get( inum4, jpdom_data, 'e3t', e3t ) ! scale factors
197              CALL iom_get( inum4, jpdom_data, 'e3u', e3u )
198              CALL iom_get( inum4, jpdom_data, 'e3v', e3v )
199              CALL iom_get( inum4, jpdom_data, 'e3w', e3w )
200            ELSE                                                   !    ! 2D bottom scale factors
201              CALL iom_get( inum4, jpdom_data, 'e3t_ps', e3tp )
202              CALL iom_get( inum4, jpdom_data, 'e3w_ps', e3wp )
203            END IF
204
205            IF( iom_varid( inum4, 'gdept', ldstop = .FALSE. ) > 0 ) THEN
206              CALL iom_get( inum4, jpdom_data, 'gdept', gdept ) ! scale factors
207              CALL iom_get( inum4, jpdom_data, 'gdepw', gdepw )
208            ELSE                                                   !    ! 2D bottom depth
209              CALL iom_get( inum4, jpdom_data, 'hdept', hdept )   ! depth
210              CALL iom_get( inum4, jpdom_data, 'hdepw', hdepw )
211         
212              DO jk = 1,jpk
213                gdept(:,:,jk) = gdept_0(jk)
214                gdepw(:,:,jk) = gdepw_0(jk)
215              ENDDO
216
217              DO jj = 1, jpj
218                DO ji = 1, jpi
219                  ik = mbathy(ji,jj) - 1
220                  ! ocean point only
221                  IF( ik > 0 ) THEN
222                     ! max ocean level case
223                     gdepw(ji,jj,ik+1) = hdepw(ji,jj)
224                     gdept(ji,jj,ik  ) = hdept(ji,jj)
225                     gdept(ji,jj,ik+1) = gdept(ji,jj,ik) + e3t(ji,jj,ik)
226                  ENDIF
227                END DO
228              END DO
229
230            ENDIF
231
232         ENDIF
233
234         IF( ln_zco ) THEN
235           ! Vertical coordinates and scales factors
236           CALL iom_get( inum4, jpdom_unknown, 'gdept_0', gdept_0 ) ! depth
237           CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', gdepw_0 )
238           CALL iom_get( inum4, jpdom_unknown, 'e3t_0'  , e3t_0   )
239           CALL iom_get( inum4, jpdom_unknown, 'e3w_0'  , e3w_0   )
240         ENDIF
241
242!!gm BUG in s-coordinate this does not work!
243      ! deepest/shallowest W level Above/Below ~10m
244      zrefdep = 10._wp - ( 0.1_wp * MINVAL(e3w_0) )                  ! ref. depth with tolerance (10% of minimum layer thickness)
245      nlb10 = MINLOC( gdepw_0, mask = gdepw_0 > zrefdep, dim = 1 )   ! shallowest W level Below ~10m
246      nla10 = nlb10 - 1                                              ! deepest    W level Above ~10m
247!!gm end bug
248
249      ! Control printing : Grid informations (if not restart)
250      ! ----------------
251
252      IF(lwp .AND. .NOT.ln_rstart ) THEN
253         WRITE(numout,*)
254         WRITE(numout,*) '          longitude and e1 scale factors'
255         WRITE(numout,*) '          ------------------------------'
256         WRITE(numout,9300) ( ji, glamt(ji,1), glamu(ji,1),   &
257            glamv(ji,1), glamf(ji,1),   &
258            e1t(ji,1), e1u(ji,1),   &
259            e1v(ji,1), ji = 1, jpi,10)
2609300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    &
261            f19.10, 1x, f19.10, 1x, f19.10 )
262
263         WRITE(numout,*)
264         WRITE(numout,*) '          latitude and e2 scale factors'
265         WRITE(numout,*) '          -----------------------------'
266         WRITE(numout,9300) ( jj, gphit(1,jj), gphiu(1,jj),   &
267            &                     gphiv(1,jj), gphif(1,jj),   &
268            &                     e2t  (1,jj), e2u  (1,jj),   &
269            &                     e2v  (1,jj), jj = 1, jpj, 10 )
270      ENDIF
271
272
273      IF( nprint == 1 .AND. lwp ) THEN
274         WRITE(numout,*) '          e1u e2u '
275         CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
276         CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
277         WRITE(numout,*) '          e1v e2v  '
278         CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
279         CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
280      ENDIF
281
282      IF(lwp) THEN
283         WRITE(numout,*)
284         WRITE(numout,*) '              Reference z-coordinate depth and scale factors:'
285         WRITE(numout, "(9x,' level   gdept    gdepw     e3t      e3w  ')" )
286         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_0(jk), gdepw_0(jk), e3t_0(jk), e3w_0(jk), jk = 1, jpk )
287      ENDIF
288
289      DO jk = 1, jpk
290         IF( e3w_0  (jk) <= 0._wp .OR. e3t_0  (jk) <= 0._wp )   CALL ctl_stop( ' e3w_0 or e3t_0 =< 0 ' )
291         IF( gdepw_0(jk) <  0._wp .OR. gdept_0(jk) <  0._wp )   CALL ctl_stop( ' gdepw_0 or gdept_0 < 0 ' )
292      END DO
293      !                                     ! ============================
294      !                                     !        close the files
295      !                                     ! ============================
296      SELECT CASE ( nmsh )
297         CASE ( 1 )               
298            CALL iom_close( inum0 )
299         CASE ( 2 )
300            CALL iom_close( inum1 )
301            CALL iom_close( inum2 )
302         CASE ( 3 )
303            CALL iom_close( inum2 )
304            CALL iom_close( inum3 )
305            CALL iom_close( inum4 )
306      END SELECT
307      !
308   END SUBROUTINE dom_rea
309
310#endif
311
312   !!======================================================================
313END MODULE domrea
Note: See TracBrowser for help on using the repository browser.