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

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

CL : Add CVS Header and CeCILL licence information

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