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

Last change on this file since 1152 was 1152, checked in by rblod, 16 years ago

Convert cvs header to svn Id, step II

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 13.0 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 = 0.
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
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_c1d
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
188         ! Vertical coordinates and scales factors
189         !
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
195#if ! defined key_zco
196
197         CALL iom_get( inum4, jpdom_data, 'e3t', e3t ) ! scale factors
198         CALL iom_get( inum4, jpdom_data, 'e3u', e3u )
199         CALL iom_get( inum4, jpdom_data, 'e3v', e3v )
200         CALL iom_get( inum4, jpdom_data, 'e3w', e3w )
201 
202         DO jk = 1,jpk
203            gdept(:,:,jk) = gdept_0(jk)
204            gdepw(:,:,jk) = gdepw_0(jk)
205         END DO
206         
207         IF( ln_sco ) THEN                                         ! s-coordinate
208
209            CALL iom_get( inum4, jpdom_data, 'hbatt', hbatt )
210            CALL iom_get( inum4, jpdom_data, 'hbatu', hbatu )
211            CALL iom_get( inum4, jpdom_data, 'hbatv', hbatv )
212            CALL iom_get( inum4, jpdom_data, 'hbatf', hbatf )
213           
214            CALL iom_get( inum4, jpdom_unknown, 'gsigt', gsigt ) ! scaling coef.
215            CALL iom_get( inum4, jpdom_unknown, 'gsigw', gsigw )
216            CALL iom_get( inum4, jpdom_unknown, 'gsi3w', gsi3w ) 
217            CALL iom_get( inum4, jpdom_unknown, 'esigt', esigt )
218            CALL iom_get( inum4, jpdom_unknown, 'esigw', esigw )
219
220         ENDIF
221
222         IF( ln_zps ) THEN   
223                                      ! z-coordinate - partial steps
224            CALL iom_get( inum4, jpdom_data, 'hdept', hdept )   ! depth
225            CALL iom_get( inum4, jpdom_data, 'hdepw', hdepw )
226         
227            DO jj = 1, jpj
228               DO ji = 1, jpi
229                  ik = mbathy(ji,jj) - 1
230                  ! ocean point only
231                  IF( ik > 0 ) THEN
232                     ! max ocean level case
233                     gdepw(ji,jj,ik+1) = hdepw(ji,jj)
234                     gdept(ji,jj,ik  ) = hdept(ji,jj)
235                     gdept(ji,jj,ik+1) = gdept(ji,jj,ik) + e3t(ji,jj,ik)
236                  ENDIF
237               END DO
238            END DO
239
240         ENDIF
241           
242# endif
243
244      ! Control printing : Grid informations (if not restart)
245      ! ----------------
246
247      IF(lwp .AND. .NOT.ln_rstart ) THEN
248         WRITE(numout,*)
249         WRITE(numout,*) '          longitude and e1 scale factors'
250         WRITE(numout,*) '          ------------------------------'
251         WRITE(numout,9300) ( ji, glamt(ji,1), glamu(ji,1),   &
252            glamv(ji,1), glamf(ji,1),   &
253            e1t(ji,1), e1u(ji,1),   &
254            e1v(ji,1), ji = 1, jpi,10)
2559300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    &
256            f19.10, 1x, f19.10, 1x, f19.10 )
257
258         WRITE(numout,*)
259         WRITE(numout,*) '          latitude and e2 scale factors'
260         WRITE(numout,*) '          -----------------------------'
261         WRITE(numout,9300) ( jj, gphit(1,jj), gphiu(1,jj),   &
262            &                     gphiv(1,jj), gphif(1,jj),   &
263            &                     e2t  (1,jj), e2u  (1,jj),   &
264            &                     e2v  (1,jj), jj = 1, jpj, 10 )
265      ENDIF
266
267
268      IF( nprint == 1 .AND. lwp ) THEN
269         WRITE(numout,*) '          e1u e2u '
270         CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
271         CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
272         WRITE(numout,*) '          e1v e2v  '
273         CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
274         CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
275      ENDIF
276
277      IF(lwp) THEN
278         WRITE(numout,*)
279         WRITE(numout,*) '              Reference z-coordinate depth and scale factors:'
280         WRITE(numout, "(9x,' level   gdept    gdepw     e3t      e3w  ')" )
281         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_0(jk), gdepw_0(jk), e3t_0(jk), e3w_0(jk), jk = 1, jpk )
282      ENDIF
283
284      DO jk = 1, jpk
285         IF( e3w_0(jk) <= 0. .OR. e3t_0(jk) <= 0. ) CALL ctl_stop ( ' e3w_0 or e3t_0 =< 0 ' )
286         IF( gdepw_0(jk) < 0. .OR. gdept_0(jk) < 0.) CALL ctl_stop( ' gdepw_0 or gdept_0 < 0 ' )
287      END DO
288
289         !                                     ! ============================
290         !                                     !        close the files
291         !                                     ! ============================
292         SELECT CASE ( nmsh )
293            CASE ( 1 )               
294               CALL iom_close( inum0 )
295            CASE ( 2 )
296               CALL iom_close( inum1 )
297               CALL iom_close( inum2 )
298            CASE ( 3 )
299               CALL iom_close( inum2 )
300               CALL iom_close( inum3 )
301               CALL iom_close( inum4 )
302         END SELECT
303
304   END SUBROUTINE dom_rea
305
306#endif
307
308   !!======================================================================
309END MODULE domrea
Note: See TracBrowser for help on using the repository browser.