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 trunk/NEMO/OFF_SRC/DOM – NEMO

source: trunk/NEMO/OFF_SRC/DOM/domrea.F90 @ 1641

Last change on this file since 1641 was 1641, checked in by cetlod, 15 years ago

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