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

Last change on this file since 467 was 454, checked in by opalod, 18 years ago

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