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

source: trunk/NEMO/OPA_SRC/DOM/domwri_dimg.h90 @ 199

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

CT : UPDATE140 : Add the storage of mbathy in order to be 100% compatible with standard domwri.F90 output

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.8 KB
Line 
1   SUBROUTINE dom_wri
2      !!----------------------------------------------------------------------
3      !!                  ***  ROUTINE dom_wri  ***   'key_mpp'
4      !!
5      !! ** Purpose :   Create 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  :   Write 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_wri : create 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 )                           !  create '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 )WRITE(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 )                            !  create '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) WRITE(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) WRITE(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 )                            !  create '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) WRITE(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) WRITE(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) WRITE(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             WRITE(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             WRITE(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             WRITE(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             WRITE(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         WRITE(inum3,REC=irec) glamt(:,:)
178         irecv(inum3) = irecv(inum3) + jpnij
179       
180         irec = irecv(inum3) + (narea - 1 )
181         WRITE(inum3,REC=irec) glamu(:,:)
182         irecv(inum3) = irecv(inum3) + jpnij
183
184         irec = irecv(inum3) + (narea - 1 )
185         WRITE(inum3,REC=irec) glamv(:,:)
186         irecv(inum3) = irecv(inum3) + jpnij
187
188         irec = irecv(inum3) + (narea - 1 )
189         WRITE(inum3,REC=irec) glamf(:,:)
190         irecv(inum3) = irecv(inum3) + jpnij
191         !
192         ! gphi
193         irec = irecv(inum3) + (narea - 1 )
194         WRITE(inum3,REC=irec) gphit(:,:)
195         irecv(inum3) = irecv(inum3) + jpnij
196       
197         irec = irecv(inum3) + (narea - 1 )
198         WRITE(inum3,REC=irec) gphiu(:,:)
199         irecv(inum3) = irecv(inum3) + jpnij
200
201         irec = irecv(inum3) + (narea - 1 )
202         WRITE(inum3,REC=irec) gphiv(:,:)
203         irecv(inum3) = irecv(inum3) + jpnij
204
205         irec = irecv(inum3) + (narea - 1 )
206         WRITE(inum3,REC=irec) gphif(:,:)
207         irecv(inum3) = irecv(inum3) + jpnij
208         !
209         ! e1
210         irec = irecv(inum3) + (narea - 1 )
211         WRITE(inum3,REC=irec) e1t(:,:)
212         irecv(inum3) = irecv(inum3) + jpnij
213       
214         irec = irecv(inum3) + (narea - 1 )
215         WRITE(inum3,REC=irec) e1u(:,:)
216         irecv(inum3) = irecv(inum3) + jpnij
217
218         irec = irecv(inum3) + (narea - 1 )
219         WRITE(inum3,REC=irec) e1v(:,:)
220         irecv(inum3) = irecv(inum3) + jpnij
221
222         irec = irecv(inum3) + (narea - 1 )
223         WRITE(inum3,REC=irec) e1f(:,:)
224         irecv(inum3) = irecv(inum3) + jpnij
225         !
226         ! e2
227         irec = irecv(inum3) + (narea - 1 )
228         WRITE(inum3,REC=irec) e2t(:,:)
229         irecv(inum3) = irecv(inum3) + jpnij
230       
231         irec = irecv(inum3) + (narea - 1 )
232         WRITE(inum3,REC=irec) e2u(:,:)
233         irecv(inum3) = irecv(inum3) + jpnij
234
235         irec = irecv(inum3) + (narea - 1 )
236         WRITE(inum3,REC=irec) e2v(:,:)
237         irecv(inum3) = irecv(inum3) + jpnij
238
239         irec = irecv(inum3) + (narea - 1 )
240         WRITE(inum3,REC=irec) e2f(:,:)
241         irecv(inum3) = irecv(inum3) + jpnij
242         !
243         ! ff
244         irec = irecv(inum3) + (narea - 1 )
245         WRITE(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          zprt = tmask(:,:,1)*(mbathy-1)
255         irec = irecv(inum4) + (narea - 1 )
256         WRITE(inum4,REC=irec) zprt(:,:)
257         irecv(inum4) = irecv(inum4) + jpnij
258
259#if defined key_s_coord
260         !
261         ! hbat
262         irec = irecv(inum4) + (narea - 1 )
263         WRITE(inum4,REC=irec) hbatt(:,:)
264         irecv(inum4) = irecv(inum4) + jpnij
265       
266         irec = irecv(inum4) + (narea - 1 )
267         WRITE(inum4,REC=irec) hbatu(:,:)
268         irecv(inum4) = irecv(inum4) + jpnij
269
270         irec = irecv(inum4) + (narea - 1 )
271         WRITE(inum4,REC=irec) hbatv(:,:)
272         irecv(inum4) = irecv(inum4) + jpnij
273
274         irec = irecv(inum4) + (narea - 1 )
275         WRITE(inum4,REC=irec) hbatf(:,:)
276         irecv(inum4) = irecv(inum4) + jpnij
277         !
278         ! gsig and esig ( as vectors of jpk per record )
279         irec =  irecv(inum4) + (narea - 1 )
280         WRITE(inum4,REC=irec) gsigt(:)
281         irecv(inum4) = irecv(inum4) + jpnij
282
283         irec =  irecv(inum4) + (narea - 1 )
284         WRITE(inum4,REC=irec) gsigw(:)
285         irecv(inum4) = irecv(inum4) + jpnij
286
287         irec =  irecv(inum4) + (narea - 1 )
288         WRITE(inum4,REC=irec) gsi3w(:)
289         irecv(inum4) = irecv(inum4) + jpnij
290
291         irec =  irecv(inum4) + (narea - 1 )
292         WRITE(inum4,REC=irec) esigt(:)
293         irecv(inum4) = irecv(inum4) + jpnij
294
295         irec =  irecv(inum4) + (narea - 1 )
296         WRITE(inum4,REC=irec) esigw(:)
297         irecv(inum4) = irecv(inum4) + jpnij
298
299# elif defined key_partial_steps
300         !
301         ! hdep
302         irec = irecv(inum4) + (narea - 1 )
303         WRITE(inum4,REC=irec) hdept(:,:)
304         irecv(inum4) = irecv(inum4) + jpnij
305       
306         irec = irecv(inum4) + (narea - 1 )
307         WRITE(inum4,REC=irec) hdepw(:,:)
308         irecv(inum4) = irecv(inum4) + jpnij
309         !
310         ! e3t_ps (3D)
311         DO jk=1,jpk
312             irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 )
313             WRITE(inum4,REC=irec) e3t_ps(:,:,jk)
314         END DO
315         irecv(inum4) = irecv(inum4) + jpk * jpnij
316
317         ! e3u_ps e3v_ps e3w_ps (3D)
318         DO jk=1,jpk
319             irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 )
320             WRITE(inum4,REC=irec) e3u_ps(:,:,jk)
321         END DO
322         irecv(inum4) = irecv(inum4) + jpk * jpnij
323         
324         DO jk=1,jpk
325             irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 )
326             WRITE(inum4,REC=irec) e3v_ps(:,:,jk)
327         END DO
328         irecv(inum4) = irecv(inum4) + jpk * jpnij
329
330         DO jk=1,jpk
331             irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 )
332             WRITE(inum4,REC=irec) e3w_ps(:,:,jk)
333         END DO
334         irecv(inum4) = irecv(inum4) + jpk * jpnij
335         !
336         !
337         ! gdep
338         irec =  irecv(inum4) + (narea - 1 )
339         WRITE(inum4,REC=irec) gdept(:)
340         irecv(inum4) = irecv(inum4) + jpnij
341
342         irec =  irecv(inum4) + (narea - 1 )
343         WRITE(inum4,REC=irec) gdepw(:)
344         irecv(inum4) = irecv(inum4) + jpnij
345         !
346         ! e3
347         irec =  irecv(inum4) + (narea - 1 )
348         WRITE(inum4,REC=irec) e3t(:)
349         irecv(inum4) = irecv(inum4) + jpnij
350
351         irec =  irecv(inum4) + (narea - 1 )
352         WRITE(inum4,REC=irec) e3w(:)
353#else
354         !
355         ! gdep
356         irec =  irecv(inum4) + (narea - 1 )
357         WRITE(inum4,REC=irec) gdept(:)
358         irecv(inum4) = irecv(inum4) + jpnij
359
360         irec =  irecv(inum4) + (narea - 1 )
361         WRITE(inum4,REC=irec) gdepw(:)
362         irecv(inum4) = irecv(inum4) + jpnij
363         !
364         ! e3
365         irec =  irecv(inum4) + (narea - 1 )
366         WRITE(inum4,REC=irec) e3t(:)
367         irecv(inum4) = irecv(inum4) + jpnij
368
369         irec =  irecv(inum4) + (narea - 1 )
370         WRITE(inum4,REC=irec) e3w(:)
371         irecv(inum4) = irecv(inum4) + jpnij
372         !
373#endif
374         !                                     ! ============================
375         !                                     !        close the files
376         !                                     ! ============================
377         SELECT CASE ( nmsh )
378            CASE ( 1 )
379               CLOSE ( inum0 )
380            CASE ( 2 )
381               CLOSE ( inum1 )
382               CLOSE ( inum2 )
383            CASE ( 3 )
384               CLOSE ( inum2 )
385               CLOSE ( inum3 )
386               CLOSE ( inum4 )
387         END SELECT
388
389   END SUBROUTINE dom_wri
Note: See TracBrowser for help on using the repository browser.