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_dimg.h90 in trunk/NEMO/OFF_SRC/DOM – NEMO

source: trunk/NEMO/OFF_SRC/DOM/domrea_dimg.h90 @ 325

Last change on this file since 325 was 325, checked in by opalod, 19 years ago

Initial revision
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.7 KB
Line 
1   SUBROUTINE dom_rea
2      !!----------------------------------------------------------------------
3      !!                  ***  ROUTINE dom_rea  ***   'key_mpp'
4      !!
5      !! ** Purpose :   READ the direct access files which contains all the
6      !!      ocean domain informations (mesh and mask arrays). These
7      !!      files are used for visualisation (SAXO software) and
8      !!      diagnostic computation.
9      !!
10      !! ** Method  :   READ in a file all the arrays generated in routines
11      !!      domhgr, domzgr, and dommsk. Note: the file contain depends on
12      !!      the vertical coord. used (z-coord, partial steps, s-coord)
13      !!    For mpp output direct access files are used and each processor
14      !!    uses a record range. Off line program (build_nc_meshmask) can be used
15      !!    to reconstruct the Netcdf files
16      !!                    nmsh = 1  :   'mesh_mask.nc' file
17      !!                         = 2  :   'mesh.nc' and mask.nc' files
18      !!                         = 3  :   'mesh_hgr.nc', 'mesh_zgr.nc' and
19      !!                                  'mask.nc' files
20      !!      For huge size domain, use option 2 or 3 depending on your
21      !!      vertical coordinate.
22      !!
23      !! ** output file :
24      !!      meshmask.nc  : domain size, horizontal grid-point position,
25      !!                     masks, depth and vertical scale factors
26      !!
27      !! History :
28      !!        !  97-02  (G. Madec)  Original code
29      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
30      !!   9.0  !  02-08  (G. Madec)  F90 and several file
31      !!        !  04-01  (J.M. Molines) MPP i/o
32      !!----------------------------------------------------------------------
33      !! * Modules used
34      USE lib_mpp
35      USE daymod
36
37      !! * Local declarations
38      !! * Local declarations
39      INTEGER  ::                & !!! * temprary units for :
40         inum0 ,                 &  ! 'mesh_mask.nc' file
41         inum1 ,                 &  ! 'mesh.nc'      file
42         inum2 ,                 &  ! 'mask.nc'      file
43         inum3 ,                 &  ! 'mesh_hgr.nc'  file
44         inum4                      ! 'mesh_zgr.nc'  file
45      INTEGER  ::   itime           !  output from restini ???
46      INTEGER  ::   irecl8, irec    ! Record length (bytes) for output file
47      INTEGER  ::   jk              ! loop index
48      INTEGER  ::   ios1, ios2
49      INTEGER, DIMENSION(11:15)  :: irecv ! index of this array will be inumxxx
50      REAL(wp) ::   zdate0
51      REAL(wp), DIMENSION(jpi,jpj) ::   &
52         zprt                       ! temporary array for bathymetry
53
54      CHARACTER (len=21) ::      &
55         clnam0 = 'mesh_mask',   &  ! filename (mesh and mask informations)
56         clnam1 = 'mesh'     ,   &  ! filename (mesh informations)
57         clnam2 = 'mask'     ,   &  ! filename (mask informations)
58         clnam3 = 'mesh_hgr' ,   &  ! filename (horizontal mesh informations)
59         clnam4 = 'mesh_zgr'        ! filename (vertical   mesh informations)
60      !!----------------------------------------------------------------------
61
62       IF(lwp) WRITE(numout,*)
63       IF(lwp) WRITE(numout,*) 'dom_rea : read direct access  mesh and mask information files'
64       IF(lwp) WRITE(numout,*) '~~~~~~~'
65
66       inum0 = 11
67       irecl8 = jpi*jpj*wp
68       ios1 = 0 ; ios2 = 0
69       IF (lk_zps ) ios1= 1
70       IF (lk_sco ) ios2= 1
71   
72       SELECT CASE (nmsh )
73          !                                    !==============================
74          CASE ( 1 )                           !  read 'mesh_mask' file
75             !                                 !==============================
76             IF (lwp) WRITE(numout,*) '          one file in "mesh_mask.dimgproc '
77             OPEN(inum0,FILE=trim(clnam0)//'.mpp', &
78                & FORM='UNFORMATTED', ACCESS='DIRECT', RECL = irecl8 )
79             IF (lwp )READ(inum0,REC=1 ) irecl8, nmsh, ios1,ios2 , &
80            &  ndastp, adatrj, jpi,jpj,jpk,  &
81            &  jpni,jpnj,jpnij,jpiglo,jpjglo, &
82            &  nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
83
84             inum2 = inum0
85             inum3 = inum0
86             inum4 = inum0
87
88            !                                  ! ============================
89         CASE ( 2 )                            !  read 'mesh' and
90            !                                  !         'mask' files
91            !                                  ! ============================
92
93            IF(lwp) WRITE(numout,*) '          two files in "mesh" and "mask" '
94            inum1 = 12
95            inum2 = 13
96            OPEN(inum1,FILE=trim(clnam1)//'.mpp', &
97                & FORM='UNFORMATTED', ACCESS='DIRECT', RECL = irecl8 )
98             IF (lwp) READ(inum1,REC=1 ) irecl8, nmsh, ios1,ios2 , &
99            &  ndastp, adatrj, jpi,jpj,jpk,  &
100            &  jpni,jpnj,jpnij,jpiglo,jpjglo, &
101            &  nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
102
103             inum3 = inum1
104             inum4 = inum1
105            OPEN(inum2,FILE=trim(clnam2)//'.mpp', &
106                & FORM='UNFORMATTED', ACCESS='DIRECT', RECL = irecl8 )
107             IF (lwp) READ(inum2,REC=1 ) irecl8, nmsh, ios1,ios2 , &
108            &  ndastp, adatrj, jpi,jpj,jpk,  &
109            &  jpni,jpnj,jpnij,jpiglo,jpjglo, &
110            &  nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
111
112            !                                  ! ============================
113         CASE ( 3 )                            !  read 'mesh_hgr'
114            !                                  !         'mesh_zgr' and
115            !                                  !         'mask'     files
116            !                                  ! ============================
117
118            IF(lwp) WRITE(numout,*) '          three files in "mesh_hgr" , mesh_zgr" and "mask" '
119            inum3 = 14
120            inum2 = 13
121            inum4 = 15
122
123            OPEN(inum3,FILE=trim(clnam3)//'.mpp', &
124                & FORM='UNFORMATTED', ACCESS='DIRECT', RECL = irecl8 )
125             IF (lwp) READ(inum3,REC=1 ) irecl8, nmsh, ios1,ios2 , &
126            &  ndastp, adatrj, jpi,jpj,jpk,  &
127            &  jpni,jpnj,jpnij,jpiglo,jpjglo, &
128            &  nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
129
130            OPEN(inum2,FILE=trim(clnam2)//'.mpp', &
131                & FORM='UNFORMATTED', ACCESS='DIRECT', RECL = irecl8 )
132             IF (lwp) READ(inum2,REC=1 ) irecl8, nmsh, ios1,ios2 , &
133            &  ndastp, adatrj, jpi,jpj,jpk,  &
134            &  jpni,jpnj,jpnij,jpiglo,jpjglo, &
135            &  nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
136
137            OPEN(inum4,FILE=trim(clnam4)//'.mpp', &
138                & FORM='UNFORMATTED', ACCESS='DIRECT', RECL = irecl8 )
139             IF (lwp) READ(inum4,REC=1 ) irecl8, nmsh, ios1,ios2 , &
140            &  ndastp, adatrj, jpi,jpj,jpk,  &
141            &  jpni,jpnj,jpnij,jpiglo,jpjglo, &
142            &  nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
143         
144         END SELECT
145       
146         irecv(:) = 2
147         ! tmask
148         DO jk=1,jpk
149             irec=irecv(inum2) + (jk -1 ) + jpk * (narea - 1 )
150             READ(inum2,REC=irec) tmask(:,:,jk)
151         END DO
152         irecv(inum2) = irecv(inum2) + jpk * jpnij
153         !
154         ! umask
155         DO jk=1,jpk
156             irec=irecv(inum2) + (jk -1 ) + jpk * (narea - 1 )
157             READ(inum2,REC=irec) umask(:,:,jk)
158         END DO
159         irecv(inum2) = irecv(inum2) + jpk * jpnij
160         !
161         ! vmask
162         DO jk=1,jpk
163             irec=irecv(inum2) + (jk -1 ) + jpk * (narea - 1 )
164             READ(inum2,REC=irec) vmask(:,:,jk)
165         END DO
166         irecv(inum2) = irecv(inum2) + jpk * jpnij
167         !
168         ! fmask
169         DO jk=1,jpk
170             irec=irecv(inum2) + (jk -1 ) + jpk * (narea - 1 )
171             READ(inum2,REC=irec) fmask(:,:,jk)
172         END DO
173         irecv(inum2) = irecv(inum2) + jpk * jpnij
174         !
175         ! glam
176         irec = irecv(inum3) + (narea - 1 )
177         READ(inum3,REC=irec) glamt(:,:)
178         irecv(inum3) = irecv(inum3) + jpnij
179       
180         irec = irecv(inum3) + (narea - 1 )
181         READ(inum3,REC=irec) glamu(:,:)
182         irecv(inum3) = irecv(inum3) + jpnij
183
184         irec = irecv(inum3) + (narea - 1 )
185         READ(inum3,REC=irec) glamv(:,:)
186         irecv(inum3) = irecv(inum3) + jpnij
187
188         irec = irecv(inum3) + (narea - 1 )
189         READ(inum3,REC=irec) glamf(:,:)
190         irecv(inum3) = irecv(inum3) + jpnij
191         !
192         ! gphi
193         irec = irecv(inum3) + (narea - 1 )
194         READ(inum3,REC=irec) gphit(:,:)
195         irecv(inum3) = irecv(inum3) + jpnij
196       
197         irec = irecv(inum3) + (narea - 1 )
198         READ(inum3,REC=irec) gphiu(:,:)
199         irecv(inum3) = irecv(inum3) + jpnij
200
201         irec = irecv(inum3) + (narea - 1 )
202         READ(inum3,REC=irec) gphiv(:,:)
203         irecv(inum3) = irecv(inum3) + jpnij
204
205         irec = irecv(inum3) + (narea - 1 )
206         READ(inum3,REC=irec) gphif(:,:)
207         irecv(inum3) = irecv(inum3) + jpnij
208         !
209         ! e1
210         irec = irecv(inum3) + (narea - 1 )
211         READ(inum3,REC=irec) e1t(:,:)
212         irecv(inum3) = irecv(inum3) + jpnij
213       
214         irec = irecv(inum3) + (narea - 1 )
215         READ(inum3,REC=irec) e1u(:,:)
216         irecv(inum3) = irecv(inum3) + jpnij
217
218         irec = irecv(inum3) + (narea - 1 )
219         READ(inum3,REC=irec) e1v(:,:)
220         irecv(inum3) = irecv(inum3) + jpnij
221
222         irec = irecv(inum3) + (narea - 1 )
223         READ(inum3,REC=irec) e1f(:,:)
224         irecv(inum3) = irecv(inum3) + jpnij
225         !
226         ! e2
227         irec = irecv(inum3) + (narea - 1 )
228         READ(inum3,REC=irec) e2t(:,:)
229         irecv(inum3) = irecv(inum3) + jpnij
230       
231         irec = irecv(inum3) + (narea - 1 )
232         READ(inum3,REC=irec) e2u(:,:)
233         irecv(inum3) = irecv(inum3) + jpnij
234
235         irec = irecv(inum3) + (narea - 1 )
236         READ(inum3,REC=irec) e2v(:,:)
237         irecv(inum3) = irecv(inum3) + jpnij
238
239         irec = irecv(inum3) + (narea - 1 )
240         READ(inum3,REC=irec) e2f(:,:)
241         irecv(inum3) = irecv(inum3) + jpnij
242         !
243         ! ff
244         irec = irecv(inum3) + (narea - 1 )
245         READ(inum3,REC=irec) ff(:,:)
246         irecv(inum3) = irecv(inum3) + jpnij
247         !
248         ! mbathy
249         !       note that mbathy has been modified in dommsk or in solver.
250         !       it is the number of non-zero "w" levels in the water, and the minimum
251         !       value (on land) is 2. We define zprt as the number of "T" points in the ocean
252         !       at any location, and zero on land.
253         !
254         irec = irecv(inum4) + (narea - 1 )
255         READ(inum4,REC=irec) zprt(:,:)
256         irecv(inum4) = irecv(inum4) + jpnij
257
258          mbathy=zprt*tmask(:,:,1)+1
259
260#if defined key_s_coord
261         !
262         ! hbat
263         irec = irecv(inum4) + (narea - 1 )
264         READ(inum4,REC=irec) hbatt(:,:)
265         irecv(inum4) = irecv(inum4) + jpnij
266       
267         irec = irecv(inum4) + (narea - 1 )
268         READ(inum4,REC=irec) hbatu(:,:)
269         irecv(inum4) = irecv(inum4) + jpnij
270
271         irec = irecv(inum4) + (narea - 1 )
272         READ(inum4,REC=irec) hbatv(:,:)
273         irecv(inum4) = irecv(inum4) + jpnij
274
275         irec = irecv(inum4) + (narea - 1 )
276         READ(inum4,REC=irec) hbatf(:,:)
277         irecv(inum4) = irecv(inum4) + jpnij
278         !
279         ! gsig and esig ( as vectors of jpk per record )
280         irec =  irecv(inum4) + (narea - 1 )
281         READ(inum4,REC=irec) gsigt(:)
282         irecv(inum4) = irecv(inum4) + jpnij
283
284         irec =  irecv(inum4) + (narea - 1 )
285         READ(inum4,REC=irec) gsigw(:)
286         irecv(inum4) = irecv(inum4) + jpnij
287
288         irec =  irecv(inum4) + (narea - 1 )
289         READ(inum4,REC=irec) gsi3w(:)
290         irecv(inum4) = irecv(inum4) + jpnij
291
292         irec =  irecv(inum4) + (narea - 1 )
293         READ(inum4,REC=irec) esigt(:)
294         irecv(inum4) = irecv(inum4) + jpnij
295
296         irec =  irecv(inum4) + (narea - 1 )
297         READ(inum4,REC=irec) esigw(:)
298         irecv(inum4) = irecv(inum4) + jpnij
299
300# elif defined key_partial_steps
301         !
302         ! hdep
303         irec = irecv(inum4) + (narea - 1 )
304         READ(inum4,REC=irec) hdept(:,:)
305         irecv(inum4) = irecv(inum4) + jpnij
306       
307         irec = irecv(inum4) + (narea - 1 )
308         READ(inum4,REC=irec) hdepw(:,:)
309         irecv(inum4) = irecv(inum4) + jpnij
310         !
311         ! e3t_ps (3D)
312         DO jk=1,jpk
313             irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 )
314             READ(inum4,REC=irec) e3t_ps(:,:,jk)
315         END DO
316         irecv(inum4) = irecv(inum4) + jpk * jpnij
317
318         ! e3u_ps e3v_ps e3w_ps (3D)
319         DO jk=1,jpk
320             irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 )
321             READ(inum4,REC=irec) e3u_ps(:,:,jk)
322         END DO
323         irecv(inum4) = irecv(inum4) + jpk * jpnij
324         
325         DO jk=1,jpk
326             irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 )
327             READ(inum4,REC=irec) e3v_ps(:,:,jk)
328         END DO
329         irecv(inum4) = irecv(inum4) + jpk * jpnij
330
331         DO jk=1,jpk
332             irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 )
333             READ(inum4,REC=irec) e3w_ps(:,:,jk)
334         END DO
335         irecv(inum4) = irecv(inum4) + jpk * jpnij
336         !
337         !
338         ! gdep
339         irec =  irecv(inum4) + (narea - 1 )
340         READ(inum4,REC=irec) gdept(:)
341         irecv(inum4) = irecv(inum4) + jpnij
342
343         irec =  irecv(inum4) + (narea - 1 )
344         READ(inum4,REC=irec) gdepw(:)
345         irecv(inum4) = irecv(inum4) + jpnij
346         !
347         ! e3
348         irec =  irecv(inum4) + (narea - 1 )
349         READ(inum4,REC=irec) e3t(:)
350         irecv(inum4) = irecv(inum4) + jpnij
351
352         irec =  irecv(inum4) + (narea - 1 )
353         READ(inum4,REC=irec) e3w(:)
354#else
355         !
356         ! gdep
357         irec =  irecv(inum4) + (narea - 1 )
358         READ(inum4,REC=irec) gdept(:)
359         irecv(inum4) = irecv(inum4) + jpnij
360
361         irec =  irecv(inum4) + (narea - 1 )
362         READ(inum4,REC=irec) gdepw(:)
363         irecv(inum4) = irecv(inum4) + jpnij
364         !
365         ! e3
366         irec =  irecv(inum4) + (narea - 1 )
367         READ(inum4,REC=irec) e3t(:)
368         irecv(inum4) = irecv(inum4) + jpnij
369
370         irec =  irecv(inum4) + (narea - 1 )
371         READ(inum4,REC=irec) e3w(:)
372         irecv(inum4) = irecv(inum4) + jpnij
373         !
374#endif
375         !                                     ! ============================
376         !                                     !        close the files
377         !                                     ! ============================
378         SELECT CASE ( nmsh )
379            CASE ( 1 )
380               CLOSE ( inum0 )
381            CASE ( 2 )
382               CLOSE ( inum1 )
383               CLOSE ( inum2 )
384            CASE ( 3 )
385               CLOSE ( inum2 )
386               CLOSE ( inum3 )
387               CLOSE ( inum4 )
388         END SELECT
389
390   END SUBROUTINE dom_rea
Note: See TracBrowser for help on using the repository browser.