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

Last change on this file since 719 was 719, checked in by ctlod, 17 years ago

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