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

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

initialisation of local variable, see ticket:351
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 13.2 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) = zprt(ji,jj) * tmask(ji,jj,1) + 1
190            ENDDO
191         ENDDO
192
193         ! Vertical coordinates and scales factors
194         !
195         CALL iom_get( inum4, jpdom_unknown, 'gdept_0', gdept_0 ) ! depth
196         CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', gdepw_0 )
197         CALL iom_get( inum4, jpdom_unknown, 'e3t_0'  , e3t_0   )
198         CALL iom_get( inum4, jpdom_unknown, 'e3w_0'  , e3w_0   )
199
200#if ! defined key_zco
201
202         CALL iom_get( inum4, jpdom_data, 'e3t', e3t ) ! scale factors
203         CALL iom_get( inum4, jpdom_data, 'e3u', e3u )
204         CALL iom_get( inum4, jpdom_data, 'e3v', e3v )
205         CALL iom_get( inum4, jpdom_data, 'e3w', e3w )
206 
207         DO jk = 1,jpk
208            gdept(:,:,jk) = gdept_0(jk)
209            gdepw(:,:,jk) = gdepw_0(jk)
210         END DO
211         
212         IF( ln_sco ) THEN                                         ! s-coordinate
213
214            CALL iom_get( inum4, jpdom_data, 'hbatt', hbatt )
215            CALL iom_get( inum4, jpdom_data, 'hbatu', hbatu )
216            CALL iom_get( inum4, jpdom_data, 'hbatv', hbatv )
217            CALL iom_get( inum4, jpdom_data, 'hbatf', hbatf )
218           
219            CALL iom_get( inum4, jpdom_unknown, 'gsigt', gsigt ) ! scaling coef.
220            CALL iom_get( inum4, jpdom_unknown, 'gsigw', gsigw )
221            CALL iom_get( inum4, jpdom_unknown, 'gsi3w', gsi3w ) 
222            CALL iom_get( inum4, jpdom_unknown, 'esigt', esigt )
223            CALL iom_get( inum4, jpdom_unknown, 'esigw', esigw )
224
225         ENDIF
226
227         IF( ln_zps ) THEN   
228                                      ! z-coordinate - partial steps
229            CALL iom_get( inum4, jpdom_data, 'hdept', hdept )   ! depth
230            CALL iom_get( inum4, jpdom_data, 'hdepw', hdepw )
231         
232            DO jj = 1, jpj
233               DO ji = 1, jpi
234                  ik = mbathy(ji,jj) - 1
235                  ! ocean point only
236                  IF( ik > 0 ) THEN
237                     ! max ocean level case
238                     gdepw(ji,jj,ik+1) = hdepw(ji,jj)
239                     gdept(ji,jj,ik  ) = hdept(ji,jj)
240                     gdept(ji,jj,ik+1) = gdept(ji,jj,ik) + e3t(ji,jj,ik)
241                  ENDIF
242               END DO
243            END DO
244
245         ENDIF
246           
247# endif
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. .OR. e3t_0(jk) <= 0. ) CALL ctl_stop ( ' e3w_0 or e3t_0 =< 0 ' )
291         IF( gdepw_0(jk) < 0. .OR. gdept_0(jk) < 0.) CALL ctl_stop( ' gdepw_0 or gdept_0 < 0 ' )
292      END DO
293
294         !                                     ! ============================
295         !                                     !        close the files
296         !                                     ! ============================
297         SELECT CASE ( nmsh )
298            CASE ( 1 )               
299               CALL iom_close( inum0 )
300            CASE ( 2 )
301               CALL iom_close( inum1 )
302               CALL iom_close( inum2 )
303            CASE ( 3 )
304               CALL iom_close( inum2 )
305               CALL iom_close( inum3 )
306               CALL iom_close( inum4 )
307         END SELECT
308
309   END SUBROUTINE dom_rea
310
311#endif
312
313   !!======================================================================
314END MODULE domrea
Note: See TracBrowser for help on using the repository browser.