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 @ 496

Last change on this file since 496 was 495, checked in by opalod, 18 years ago

nemo_v1_update_063:CE+RB: use of IOM for offline passive tracers
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.9 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   !!   $Header$
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 = 0.
95
96      REAL(wp), DIMENSION(1,1,jpk) :: &
97         zt1d
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
106      SELECT CASE (nmsh)
107         !                                     ! ============================
108         CASE ( 1 )                            !  create 'mesh_mask.nc' file
109            !                                  ! ============================
110
111            IF(lwp) WRITE(numout,*) '          one file in "mesh_mask.nc" '
112            CALL iom_open( 'mesh_mask', inum0 )
113
114            inum2 = inum0                                            ! put all the informations
115            inum3 = inum0                                            ! in unit inum0
116            inum4 = inum0
117
118            !                                  ! ============================
119         CASE ( 2 )                            !  create 'mesh.nc' and
120            !                                  !         'mask.nc' files
121            !                                  ! ============================
122
123            IF(lwp) WRITE(numout,*) '          two files in "mesh.nc" and "mask.nc" '
124            CALL iom_open( 'mesh', inum1 )
125            CALL iom_open( 'mask', inum2 )
126
127            inum3 = inum1                                            ! put mesh informations
128            inum4 = inum1                                            ! in unit inum1
129
130            !                                  ! ============================
131         CASE ( 3 )                            !  create 'mesh_hgr.nc'
132            !                                  !         'mesh_zgr.nc' and
133            !                                  !         'mask.nc'     files
134            !                                  ! ============================
135
136            IF(lwp) WRITE(numout,*) '          three files in "mesh_hgr.nc" , mesh_zgr.nc" and "mask.nc" '
137            CALL iom_open( 'mesh_hgr', inum3 ) ! create 'mesh_hgr.nc'
138            CALL iom_open( 'mesh_zgr', inum4 ) ! create 'mesh_zgr.nc'
139            CALL iom_open( 'mask'    , inum2 ) ! create 'mask.nc'
140
141         END SELECT
142
143         !                                                         ! masks (inum2)
144         CALL iom_get( inum2, jpdom_data, 'tmask', tmask )
145         CALL iom_get( inum2, jpdom_data, 'umask', umask )
146         CALL iom_get( inum2, jpdom_data, 'vmask', vmask )
147         CALL iom_get( inum2, jpdom_data, 'fmask', fmask )
148
149#if defined key_cfg_1d
150         ! set umask and vmask equal tmask in 1D configuration
151         IF(lwp) WRITE(numout,*)
152         IF(lwp) WRITE(numout,*) '**********  1D configuration : set umask and vmask equal tmask ********'
153         IF(lwp) WRITE(numout,*) '**********                                                     ********'
154
155         umask(:,:,:) = tmask(:,:,:)
156         vmask(:,:,:) = tmask(:,:,:)
157#endif
158
159#if defined key_off_degrad
160         CALL iom_get( inum2, jpdom_data, 'facvolt', facvol )
161#endif
162
163         !                                                         ! horizontal mesh (inum3)
164         CALL iom_get( inum3, jpdom_data, 'glamt', glamt )
165         CALL iom_get( inum3, jpdom_data, 'glamu', glamu )
166         CALL iom_get( inum3, jpdom_data, 'glamv', glamv )
167         CALL iom_get( inum3, jpdom_data, 'glamf', glamf )
168
169         CALL iom_get( inum3, jpdom_data, 'gphit', gphit )
170         CALL iom_get( inum3, jpdom_data, 'gphiu', gphiu )
171         CALL iom_get( inum3, jpdom_data, 'gphiv', gphiv )
172         CALL iom_get( inum3, jpdom_data, 'gphif', gphif )
173
174         CALL iom_get( inum3, jpdom_data, 'e1t', e1t )
175         CALL iom_get( inum3, jpdom_data, 'e1u', e1u )
176         CALL iom_get( inum3, jpdom_data, 'e1v', e1v )
177         
178         CALL iom_get( inum3, jpdom_data, 'e2t', e2t )
179         CALL iom_get( inum3, jpdom_data, 'e2u', e2u )
180         CALL iom_get( inum3, jpdom_data, 'e2v', e2v )
181
182         CALL iom_get( inum3, jpdom_data, 'ff', ff )
183
184         CALL iom_get( inum4, jpdom_data, 'mbathy', zprt )
185         mbathy(:,:) = zprt(:,:) * tmask(:,:,1) + 1
186
187#if ! defined key_zco
188         IF( ln_sco ) THEN                                         ! s-coordinate
189            CALL iom_get( inum4, jpdom_data, 'hbatt', hbatt )
190            CALL iom_get( inum4, jpdom_data, 'hbatu', hbatu )
191            CALL iom_get( inum4, jpdom_data, 'hbatv', hbatv )
192            CALL iom_get( inum4, jpdom_data, 'hbatf', hbatf )
193           
194            CALL iom_get( inum4, jpdom_unknown, 'gsigt', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) ) ! scaling coef.
195            gsigt(:) = zt1d(1,1,:) 
196            CALL iom_get( inum4, jpdom_unknown, 'gsigw', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) )
197            gsigw(:) = zt1d(1,1,:) 
198            CALL iom_get( inum4, jpdom_unknown, 'gsi3w', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) ) 
199            gsi3w(:) = zt1d(1,1,:) 
200            CALL iom_get( inum4, jpdom_unknown, 'esigt', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) )
201            esigt(:) = zt1d(1,1,:) 
202            CALL iom_get( inum4, jpdom_unknown, 'esigw', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) )
203            esigw(:) = zt1d(1,1,:) 
204
205            CALL iom_get( inum4, jpdom_data, 'e3t', e3t ) ! scale factors
206            CALL iom_get( inum4, jpdom_data, 'e3u', e3u )
207            CALL iom_get( inum4, jpdom_data, 'e3v', e3v )
208            CALL iom_get( inum4, jpdom_data, 'e3w', e3w )
209
210            CALL iom_get( inum4, jpdom_unknown, 'gdept_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) ) ! depth
211            gdept_0(:) = zt1d(1,1,:) 
212            CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) )
213            gdepw_0(:) = zt1d(1,1,:) 
214         ENDIF
215
216         IF( ln_zps ) THEN                                         ! z-coordinate - partial steps
217            CALL iom_get( inum4, jpdom_data, 'hdept', hdept )   ! depth
218            CALL iom_get( inum4, jpdom_data, 'hdepw', hdepw )
219
220            CALL iom_get( inum4, jpdom_data, 'e3t', e3t ) ! scale factors
221            CALL iom_get( inum4, jpdom_data, 'e3u', e3u )
222            CALL iom_get( inum4, jpdom_data, 'e3v', e3v )
223            CALL iom_get( inum4, jpdom_data, 'e3w', e3w )
224            !                                                          ! reference z-coord.
225            CALL iom_get( inum4, jpdom_unknown, 'gdept_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) ) 
226            gdept_0(:) = zt1d(1,1,:) 
227            CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) )
228            gdepw_0(:) = zt1d(1,1,:) 
229            CALL iom_get( inum4, jpdom_unknown, 'e3t_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) )
230            e3t_0(:) = zt1d(1,1,:) 
231            CALL iom_get( inum4, jpdom_unknown, 'e3w_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) )
232            e3w_0(:) = zt1d(1,1,:) 
233 
234            DO jk = 1,jpk
235               gdept(:,:,jk) = gdept(jk)
236               gdepw(:,:,jk) = gdepw(jk)
237            END DO
238         
239            DO jj = 1, jpj
240               DO ji = 1, jpi
241                  ik = mbathy(ji,jj) - 1
242                  ! ocean point only
243                  IF( ik > 0 ) THEN
244                     ! max ocean level case
245                     gdepw(ji,jj,ik+1) = hdepw(ji,jj)
246                     gdept(ji,jj,ik  ) = hdept(ji,jj)
247                     gdept(ji,jj,ik+1) = gdept(ji,jj,ik) + e3t(ji,jj,ik)
248                  ENDIF
249               END DO
250            END DO
251         ENDIF
252           
253
254# else
255         !                                                                     !  z-coord.
256         CALL iom_get( inum4, jpdom_unknown, 'gdept_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) ) ! depth 
257         gdept_0(:) = zt1d(1,1,:) 
258         CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) )
259         gdepw_0(:) = zt1d(1,1,:) 
260         CALL iom_get( inum4, jpdom_unknown, 'e3t_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) ) ! scale factors
261         e3t_0(:) = zt1d(1,1,:) 
262         CALL iom_get( inum4, jpdom_unknown, 'e3w_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) )
263         e3w_0(:) = zt1d(1,1,:) 
264
265# endif
266
267      ! Control printing : Grid informations (if not restart)
268      ! ----------------
269
270      IF(lwp .AND. .NOT.ln_rstart ) THEN
271         WRITE(numout,*)
272         WRITE(numout,*) '          longitude and e1 scale factors'
273         WRITE(numout,*) '          ------------------------------'
274         WRITE(numout,9300) ( ji, glamt(ji,1), glamu(ji,1),   &
275            glamv(ji,1), glamf(ji,1),   &
276            e1t(ji,1), e1u(ji,1),   &
277            e1v(ji,1), ji = 1, jpi,10)
2789300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    &
279            f19.10, 1x, f19.10, 1x, f19.10 )
280
281         WRITE(numout,*)
282         WRITE(numout,*) '          latitude and e2 scale factors'
283         WRITE(numout,*) '          -----------------------------'
284         WRITE(numout,9300) ( jj, gphit(1,jj), gphiu(1,jj),   &
285            &                     gphiv(1,jj), gphif(1,jj),   &
286            &                     e2t  (1,jj), e2u  (1,jj),   &
287            &                     e2v  (1,jj), jj = 1, jpj, 10 )
288      ENDIF
289
290
291      IF( nprint == 1 .AND. lwp ) THEN
292         WRITE(numout,*) '          e1u e2u '
293         CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
294         CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
295         WRITE(numout,*) '          e1v e2v  '
296         CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
297         CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
298      ENDIF
299
300      IF(lwp) THEN
301         WRITE(numout,*)
302         WRITE(numout,*) '              Reference z-coordinate depth and scale factors:'
303         WRITE(numout, "(9x,' level   gdept    gdepw     e3t      e3w  ')" )
304         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_0(jk), gdepw_0(jk), e3t_0(jk), e3w_0(jk), jk = 1, jpk )
305      ENDIF
306
307      DO jk = 1, jpk
308         IF( e3w_0(jk) <= 0. .OR. e3t_0(jk) <= 0. ) CALL ctl_stop ( ' e3w_0 or e3t_0 =< 0 ' )
309         IF( gdepw_0(jk) < 0. .OR. gdept_0(jk) < 0.) CALL ctl_stop( ' gdepw_0 or gdept_0 < 0 ' )
310      END DO
311
312         !                                     ! ============================
313         !                                     !        close the files
314         !                                     ! ============================
315         SELECT CASE ( nmsh )
316            CASE ( 1 )               
317               CALL iom_close( inum0 )
318            CASE ( 2 )
319               CALL iom_close( inum1 )
320               CALL iom_close( inum2 )
321            CASE ( 3 )
322               CALL iom_close( inum2 )
323               CALL iom_close( inum3 )
324               CALL iom_close( inum4 )
325         END SELECT
326
327   END SUBROUTINE dom_rea
328
329#endif
330
331   !!======================================================================
332END MODULE domrea
Note: See TracBrowser for help on using the repository browser.