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 tags/nemo_dev_x6/NEMO/OPA_SRC/DOM – NEMO

source: tags/nemo_dev_x6/NEMO/OPA_SRC/DOM/domwri_dimg.h90 @ 158

Last change on this file since 158 was 107, checked in by opalod, 20 years ago

CT : UPDATE068 : Add binary output possibilities with the dimg output format
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.1 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      CHARACTER (len=21) ::      &
52         clnam0 = 'mesh_mask',   &  ! filename (mesh and mask informations)
53         clnam1 = 'mesh'     ,   &  ! filename (mesh informations)
54         clnam2 = 'mask'     ,   &  ! filename (mask informations)
55         clnam3 = 'mesh_hgr' ,   &  ! filename (horizontal mesh informations)
56         clnam4 = 'mesh_zgr'        ! filename (vertical   mesh informations)
57      !!----------------------------------------------------------------------
58
59       IF(lwp) WRITE(numout,*)
60       IF(lwp) WRITE(numout,*) 'dom_wri : create direct access  mesh and mask information files'
61       IF(lwp) WRITE(numout,*) '~~~~~~~'
62
63       inum0 = 11
64       irecl8 = jpi*jpj*wp
65       ios1 = 0 ; ios2 = 0
66       IF (lk_zps ) ios1= 1
67       IF (lk_sco ) ios2= 1
68   
69       SELECT CASE (nmsh )
70          !                                    !==============================
71          CASE ( 1 )                           !  create 'mesh_mask' file
72             !                                 !==============================
73             IF (lwp) WRITE(numout,*) '          one file in "mesh_mask.dimgproc '
74             OPEN(inum0,FILE=trim(clnam0)//'.mpp', &
75                & FORM='UNFORMATTED', ACCESS='DIRECT', RECL = irecl8 )
76             IF (lwp )WRITE(inum0,REC=1 ) irecl8, nmsh, ios1,ios2 , &
77            &  ndastp, adatrj, jpi,jpj,jpk,  &
78            &  jpni,jpnj,jpnij,jpiglo,jpjglo, &
79            &  nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
80
81             inum2 = inum0
82             inum3 = inum0
83             inum4 = inum0
84
85            !                                  ! ============================
86         CASE ( 2 )                            !  create 'mesh' and
87            !                                  !         'mask' files
88            !                                  ! ============================
89
90            IF(lwp) WRITE(numout,*) '          two files in "mesh" and "mask" '
91            inum1 = 12
92            inum2 = 13
93            OPEN(inum1,FILE=trim(clnam1)//'.mpp', &
94                & FORM='UNFORMATTED', ACCESS='DIRECT', RECL = irecl8 )
95             IF (lwp) WRITE(inum1,REC=1 ) irecl8, nmsh, ios1,ios2 , &
96            &  ndastp, adatrj, jpi,jpj,jpk,  &
97            &  jpni,jpnj,jpnij,jpiglo,jpjglo, &
98            &  nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
99
100             inum3 = inum1
101             inum4 = inum1
102            OPEN(inum2,FILE=trim(clnam2)//'.mpp', &
103                & FORM='UNFORMATTED', ACCESS='DIRECT', RECL = irecl8 )
104             IF (lwp) WRITE(inum2,REC=1 ) irecl8, nmsh, ios1,ios2 , &
105            &  ndastp, adatrj, jpi,jpj,jpk,  &
106            &  jpni,jpnj,jpnij,jpiglo,jpjglo, &
107            &  nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
108
109            !                                  ! ============================
110         CASE ( 3 )                            !  create 'mesh_hgr'
111            !                                  !         'mesh_zgr' and
112            !                                  !         'mask'     files
113            !                                  ! ============================
114
115            IF(lwp) WRITE(numout,*) '          three files in "mesh_hgr" , mesh_zgr" and "mask" '
116            inum3 = 14
117            inum2 = 13
118            inum4 = 15
119
120            OPEN(inum3,FILE=trim(clnam3)//'.mpp', &
121                & FORM='UNFORMATTED', ACCESS='DIRECT', RECL = irecl8 )
122             IF (lwp) WRITE(inum3,REC=1 ) irecl8, nmsh, ios1,ios2 , &
123            &  ndastp, adatrj, jpi,jpj,jpk,  &
124            &  jpni,jpnj,jpnij,jpiglo,jpjglo, &
125            &  nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
126
127            OPEN(inum2,FILE=trim(clnam2)//'.mpp', &
128                & FORM='UNFORMATTED', ACCESS='DIRECT', RECL = irecl8 )
129             IF (lwp) WRITE(inum2,REC=1 ) irecl8, nmsh, ios1,ios2 , &
130            &  ndastp, adatrj, jpi,jpj,jpk,  &
131            &  jpni,jpnj,jpnij,jpiglo,jpjglo, &
132            &  nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
133
134            OPEN(inum4,FILE=trim(clnam4)//'.mpp', &
135                & FORM='UNFORMATTED', ACCESS='DIRECT', RECL = irecl8 )
136             IF (lwp) WRITE(inum4,REC=1 ) irecl8, nmsh, ios1,ios2 , &
137            &  ndastp, adatrj, jpi,jpj,jpk,  &
138            &  jpni,jpnj,jpnij,jpiglo,jpjglo, &
139            &  nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
140         
141         END SELECT
142       
143         irecv(:) = 2
144         ! tmask
145         DO jk=1,jpk
146             irec=irecv(inum2) + (jk -1 ) + jpk * (narea - 1 )
147             WRITE(inum2,REC=irec) tmask(:,:,jk)
148         END DO
149         irecv(inum2) = irecv(inum2) + jpk * jpnij
150         !
151         ! umask
152         DO jk=1,jpk
153             irec=irecv(inum2) + (jk -1 ) + jpk * (narea - 1 )
154             WRITE(inum2,REC=irec) umask(:,:,jk)
155         END DO
156         irecv(inum2) = irecv(inum2) + jpk * jpnij
157         !
158         ! vmask
159         DO jk=1,jpk
160             irec=irecv(inum2) + (jk -1 ) + jpk * (narea - 1 )
161             WRITE(inum2,REC=irec) vmask(:,:,jk)
162         END DO
163         irecv(inum2) = irecv(inum2) + jpk * jpnij
164         !
165         ! fmask
166         DO jk=1,jpk
167             irec=irecv(inum2) + (jk -1 ) + jpk * (narea - 1 )
168             WRITE(inum2,REC=irec) fmask(:,:,jk)
169         END DO
170         irecv(inum2) = irecv(inum2) + jpk * jpnij
171         !
172         ! glam
173         irec = irecv(inum3) + (narea - 1 )
174         WRITE(inum3,REC=irec) glamt(:,:)
175         irecv(inum3) = irecv(inum3) + jpnij
176       
177         irec = irecv(inum3) + (narea - 1 )
178         WRITE(inum3,REC=irec) glamu(:,:)
179         irecv(inum3) = irecv(inum3) + jpnij
180
181         irec = irecv(inum3) + (narea - 1 )
182         WRITE(inum3,REC=irec) glamv(:,:)
183         irecv(inum3) = irecv(inum3) + jpnij
184
185         irec = irecv(inum3) + (narea - 1 )
186         WRITE(inum3,REC=irec) glamf(:,:)
187         irecv(inum3) = irecv(inum3) + jpnij
188         !
189         ! gphi
190         irec = irecv(inum3) + (narea - 1 )
191         WRITE(inum3,REC=irec) gphit(:,:)
192         irecv(inum3) = irecv(inum3) + jpnij
193       
194         irec = irecv(inum3) + (narea - 1 )
195         WRITE(inum3,REC=irec) gphiu(:,:)
196         irecv(inum3) = irecv(inum3) + jpnij
197
198         irec = irecv(inum3) + (narea - 1 )
199         WRITE(inum3,REC=irec) gphiv(:,:)
200         irecv(inum3) = irecv(inum3) + jpnij
201
202         irec = irecv(inum3) + (narea - 1 )
203         WRITE(inum3,REC=irec) gphif(:,:)
204         irecv(inum3) = irecv(inum3) + jpnij
205         !
206         ! e1
207         irec = irecv(inum3) + (narea - 1 )
208         WRITE(inum3,REC=irec) e1t(:,:)
209         irecv(inum3) = irecv(inum3) + jpnij
210       
211         irec = irecv(inum3) + (narea - 1 )
212         WRITE(inum3,REC=irec) e1u(:,:)
213         irecv(inum3) = irecv(inum3) + jpnij
214
215         irec = irecv(inum3) + (narea - 1 )
216         WRITE(inum3,REC=irec) e1v(:,:)
217         irecv(inum3) = irecv(inum3) + jpnij
218
219         irec = irecv(inum3) + (narea - 1 )
220         WRITE(inum3,REC=irec) e1f(:,:)
221         irecv(inum3) = irecv(inum3) + jpnij
222         !
223         ! e2
224         irec = irecv(inum3) + (narea - 1 )
225         WRITE(inum3,REC=irec) e2t(:,:)
226         irecv(inum3) = irecv(inum3) + jpnij
227       
228         irec = irecv(inum3) + (narea - 1 )
229         WRITE(inum3,REC=irec) e2u(:,:)
230         irecv(inum3) = irecv(inum3) + jpnij
231
232         irec = irecv(inum3) + (narea - 1 )
233         WRITE(inum3,REC=irec) e2v(:,:)
234         irecv(inum3) = irecv(inum3) + jpnij
235
236         irec = irecv(inum3) + (narea - 1 )
237         WRITE(inum3,REC=irec) e2f(:,:)
238         irecv(inum3) = irecv(inum3) + jpnij
239         !
240         ! ff
241         irec = irecv(inum3) + (narea - 1 )
242         WRITE(inum3,REC=irec) ff(:,:)
243         irecv(inum3) = irecv(inum3) + jpnij
244         
245           
246#if defined key_s_coord
247         !
248         ! hbat
249         irec = irecv(inum4) + (narea - 1 )
250         WRITE(inum4,REC=irec) hbatt(:,:)
251         irecv(inum4) = irecv(inum4) + jpnij
252       
253         irec = irecv(inum4) + (narea - 1 )
254         WRITE(inum4,REC=irec) hbatu(:,:)
255         irecv(inum4) = irecv(inum4) + jpnij
256
257         irec = irecv(inum4) + (narea - 1 )
258         WRITE(inum4,REC=irec) hbatv(:,:)
259         irecv(inum4) = irecv(inum4) + jpnij
260
261         irec = irecv(inum4) + (narea - 1 )
262         WRITE(inum4,REC=irec) hbatf(:,:)
263         irecv(inum4) = irecv(inum4) + jpnij
264         !
265         ! gsig and esig ( as vectors of jpk per record )
266         irec =  irecv(inum4) + (narea - 1 )
267         WRITE(inum4,REC=irec) gsigt(:)
268         irecv(inum4) = irecv(inum4) + jpnij
269
270         irec =  irecv(inum4) + (narea - 1 )
271         WRITE(inum4,REC=irec) gsigw(:)
272         irecv(inum4) = irecv(inum4) + jpnij
273
274         irec =  irecv(inum4) + (narea - 1 )
275         WRITE(inum4,REC=irec) gsi3w(:)
276         irecv(inum4) = irecv(inum4) + jpnij
277
278         irec =  irecv(inum4) + (narea - 1 )
279         WRITE(inum4,REC=irec) esigt(:)
280         irecv(inum4) = irecv(inum4) + jpnij
281
282         irec =  irecv(inum4) + (narea - 1 )
283         WRITE(inum4,REC=irec) esigw(:)
284         irecv(inum4) = irecv(inum4) + jpnij
285
286# elif defined key_partial_steps
287         !
288         ! hdep
289         irec = irecv(inum4) + (narea - 1 )
290         WRITE(inum4,REC=irec) hdept(:,:)
291         irecv(inum4) = irecv(inum4) + jpnij
292       
293         irec = irecv(inum4) + (narea - 1 )
294         WRITE(inum4,REC=irec) hdepw(:,:)
295         irecv(inum4) = irecv(inum4) + jpnij
296         !
297         ! e3
298         irec = irecv(inum4) + (narea - 1 )
299         WRITE(inum4,REC=irec) e3tp(:,:)
300         irecv(inum4) = irecv(inum4) + jpnij
301       
302         irec = irecv(inum4) + (narea - 1 )
303         WRITE(inum4,REC=irec) e3wp(:,:)
304         irecv(inum4) = irecv(inum4) + jpnij
305         !
306         ! e3u_ps e3v_ps (3D)
307         DO jk=1,jpk
308             irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 )
309             WRITE(inum4,REC=irec) e3u_ps(:,:,jk)
310         END DO
311         irecv(inum4) = irecv(inum4) + jpk * jpnij
312         
313         DO jk=1,jpk
314             irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 )
315             WRITE(inum4,REC=irec) e3v_ps(:,:,jk)
316         END DO
317         irecv(inum4) = irecv(inum4) + jpk * jpnij
318         !
319         ! gdep
320         irec =  irecv(inum4) + (narea - 1 )
321         WRITE(inum4,REC=irec) gdept(:)
322         irecv(inum4) = irecv(inum4) + jpnij
323
324         irec =  irecv(inum4) + (narea - 1 )
325         WRITE(inum4,REC=irec) gdepw(:)
326         irecv(inum4) = irecv(inum4) + jpnij
327         !
328         ! e3
329         irec =  irecv(inum4) + (narea - 1 )
330         WRITE(inum4,REC=irec) e3t(:)
331         irecv(inum4) = irecv(inum4) + jpnij
332
333         irec =  irecv(inum4) + (narea - 1 )
334         WRITE(inum4,REC=irec) e3w(:)
335#else
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         irecv(inum4) = irecv(inum4) + jpnij
354         !
355#endif
356         !                                     ! ============================
357         !                                     !        close the files
358         !                                     ! ============================
359         SELECT CASE ( nmsh )
360            CASE ( 1 )
361               CLOSE ( inum0 )
362            CASE ( 2 )
363               CLOSE ( inum1 )
364               CLOSE ( inum2 )
365            CASE ( 3 )
366               CLOSE ( inum2 )
367               CLOSE ( inum3 )
368               CLOSE ( inum4 )
369         END SELECT
370
371   END SUBROUTINE dom_wri
Note: See TracBrowser for help on using the repository browser.