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 branches/nemo_v3_3_beta/NEMOGCM/NEMO/OFF_SRC – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OFF_SRC/domrea.F90 @ 2281

Last change on this file since 2281 was 2281, checked in by smasson, 14 years ago

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