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

source: trunk/NEMO/OPA_SRC/DOM/domwri.F90 @ 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: 13.5 KB
Line 
1MODULE domwri
2   !!======================================================================
3   !!                       ***  MODULE domwri  ***
4   !! Ocean initialization : write the ocean domain mesh ask file(s)
5   !!======================================================================
6
7   !!----------------------------------------------------------------------
8   !!   dom_wri        : create and write mesh and mask file(s)
9   !!                    nmsh = 1  :   mesh_mask file
10   !!                         = 2  :   mesh and mask file
11   !!                         = 3  :   mesh_hgr, mesh_zgr and mask
12   !!----------------------------------------------------------------------
13   !! * Modules used
14   USE dom_oce         ! ocean space and time domain
15   USE in_out_manager
16
17   IMPLICIT NONE
18   PRIVATE
19
20   !! * Accessibility
21   PUBLIC dom_wri        ! routine called by inidom.F90
22   !!----------------------------------------------------------------------
23   !!   OPA 9.0 , LOCEAN-IPSL (2005)
24   !! $Header$
25   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
26   !!----------------------------------------------------------------------
27
28CONTAINS
29
30#if ( defined key_mpp_mpi || defined key_mpp_shmem ) && defined key_dimgout
31   !!----------------------------------------------------------------------
32   !!   'key_mpp_mpi'     OR
33   !!   'key_mpp_shmem'
34   !!   'key_dimgout' :         each processor makes its own direct access file
35   !!                      use build_nc_meshmask off line to retrieve
36   !!                      a ioipsl compliant meshmask file
37   !!----------------------------------------------------------------------
38#  include "domwri_dimg.h90"
39
40#else
41   !!----------------------------------------------------------------------
42   !!   Default option :                                        NetCDF file
43   !!----------------------------------------------------------------------
44
45   SUBROUTINE dom_wri
46      !!----------------------------------------------------------------------
47      !!                  ***  ROUTINE dom_wri  ***
48      !!                   
49      !! ** Purpose :   Create the NetCDF file(s) which contain(s) all the
50      !!      ocean domain informations (mesh and mask arrays). This (these)
51      !!      file(s) is (are) used for visualisation (SAXO software) and
52      !!      diagnostic computation.
53      !!
54      !! ** Method  :   Write in a file all the arrays generated in routines
55      !!      domhgr, domzgr, and dommsk. Note: the file contain depends on
56      !!      the vertical coord. used (z-coord, partial steps, s-coord)
57      !!                    nmsh = 1  :   'mesh_mask.nc' file
58      !!                         = 2  :   'mesh.nc' and mask.nc' files
59      !!                         = 3  :   'mesh_hgr.nc', 'mesh_zgr.nc' and
60      !!                                  'mask.nc' files
61      !!      For huge size domain, use option 2 or 3 depending on your
62      !!      vertical coordinate.
63      !!
64      !! ** output file :
65      !!      meshmask.nc  : domain size, horizontal grid-point position,
66      !!                     masks, depth and vertical scale factors
67      !!
68      !! History :
69      !!        !  97-02  (G. Madec)  Original code
70      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
71      !!   9.0  !  02-08  (G. Madec)  F90 and several file
72      !!----------------------------------------------------------------------
73      !! * Modules used
74      USE ioipsl
75
76      !! * Local declarations
77      INTEGER  ::                & !!! * temprary units for :
78         inum0 ,                 &  ! 'mesh_mask.nc' file
79         inum1 ,                 &  ! 'mesh.nc'      file
80         inum2 ,                 &  ! 'mask.nc'      file
81         inum3 ,                 &  ! 'mesh_hgr.nc'  file
82         inum4                      ! 'mesh_zgr.nc'  file
83      INTEGER  ::   itime           !  output from restini ???
84      REAL(wp) ::   zdate0
85      REAL(wp), DIMENSION(jpi,jpj) ::   &
86         zprt                       ! temporary array for bathymetry
87
88      CHARACTER (len=21) ::      &
89         clnam0  ,   &  ! filename (mesh and mask informations)
90         clnam1  ,   &  ! filename (mesh informations)
91         clnam2  ,   &  ! filename (mask informations)
92         clnam3  ,   &  ! filename (horizontal mesh informations)
93         clnam4         ! filename (vertical   mesh informations)
94      !!----------------------------------------------------------------------
95
96       IF(lwp) WRITE(numout,*)
97       IF(lwp) WRITE(numout,*) 'dom_wri : create NetCDF mesh and mask information file(s)'
98       IF(lwp) WRITE(numout,*) '~~~~~~~'
99
100       clnam0 = 'mesh_mask'  ! filename (mesh and mask informations)
101       clnam1 = 'mesh'       ! filename (mesh informations)
102       clnam2 = 'mask'       ! filename (mask informations)
103       clnam3 = 'mesh_hgr'   ! filename (horizontal mesh informations)
104       clnam4 = 'mesh_zgr'   ! filename (vertical   mesh informations)
105
106#if defined key_agrif
107      IF ( .NOT. Agrif_Root() ) THEN
108         clnam0 = TRIM(Agrif_CFixed())//'_'//TRIM(clnam0)
109         clnam1 = TRIM(Agrif_CFixed())//'_'//TRIM(clnam1)
110         clnam2 = TRIM(Agrif_CFixed())//'_'//TRIM(clnam2)
111         clnam3 = TRIM(Agrif_CFixed())//'_'//TRIM(clnam3)
112         clnam4 = TRIM(Agrif_CFixed())//'_'//TRIM(clnam4)
113      ENDIF
114#endif
115
116      CALL ymds2ju( 0, 1, 1, 0.e0, zdate0 )    ! calendar initialization
117
118!       note that mbathy has been modified in dommsk or in solver.
119!       it is the number of non-zero "w" levels in the water, and the minimum
120!       value (on land) is 2. We define zprt as the number of "T" points in the ocean
121!       at any location, and zero on land.
122!
123      zprt = tmask(:,:,1)*(mbathy-1)
124
125      SELECT CASE (nmsh)
126         !                                     ! ============================
127         CASE ( 1 )                            !  create 'mesh_mask.nc' file
128            !                                  ! ============================
129
130            IF(lwp) WRITE(numout,*) '          one file in "mesh_mask.nc" '
131            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mesh_mask.nc' file
132            &             jpk   , gdept_0 , trim(clnam0)        ,  &   ! in unit inum0
133            &             itime , zdate0, rdt   , inum0 , domain_id=nidom )
134            inum2 = inum0                                            ! put all the informations
135            inum3 = inum0                                            ! in unit inum0
136            inum4 = inum0
137
138            !                                  ! ============================
139         CASE ( 2 )                            !  create 'mesh.nc' and
140            !                                  !         'mask.nc' files
141            !                                  ! ============================
142
143            IF(lwp) WRITE(numout,*) '          two files in "mesh.nc" and "mask.nc" '
144            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mesh.nc' file
145            &             jpk   , gdept_0 , trim(clnam1)        ,  &   ! in unit inum1
146            &             itime , zdate0, rdt   , inum1, domain_id=nidom )
147            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mask.nc' file
148            &             jpk   , gdept_0 , trim(clnam2)        ,  &   ! in unit inum2
149            &             itime , zdate0, rdt   , inum2, domain_id=nidom )
150            inum3 = inum1                                            ! put mesh informations
151            inum4 = inum1                                            ! in unit inum1
152
153            !                                  ! ============================
154         CASE ( 3 )                            !  create 'mesh_hgr.nc'
155            !                                  !         'mesh_zgr.nc' and
156            !                                  !         'mask.nc'     files
157            !                                  ! ============================
158
159            IF(lwp) WRITE(numout,*) '          three files in "mesh_hgr.nc" , mesh_zgr.nc" and "mask.nc" '
160            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mesh_hgr.nc' file
161            &             jpk   , gdept_0 , trim(clnam3)        ,  &   ! in unit inum3
162            &             itime , zdate0, rdt   , inum3, domain_id=nidom )
163            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mesh_zgr.nc' file
164            &             jpk   , gdept_0 , trim(clnam4)        ,  &   ! in unit inum4
165            &             itime , zdate0, rdt   , inum4, domain_id=nidom )
166            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mask.nc' file
167            &             jpk   , gdept_0 , trim(clnam2)        ,  &   ! in unit inum2
168            &             itime , zdate0, rdt   , inum2, domain_id=nidom )
169
170         END SELECT
171
172         !                                                         ! masks (inum2)
173         CALL restput( inum2, 'tmask', jpi, jpj, jpk, 0, tmask ) 
174         CALL restput( inum2, 'umask', jpi, jpj, jpk, 0, umask )
175         CALL restput( inum2, 'vmask', jpi, jpj, jpk, 0, vmask )
176         CALL restput( inum2, 'fmask', jpi, jpj, jpk, 0, fmask )
177
178         !                                                         ! horizontal mesh (inum3)
179         CALL restput( inum3, 'glamt', jpi, jpj, 1, 0, glamt )     !    ! latitude
180         CALL restput( inum3, 'glamu', jpi, jpj, 1, 0, glamu )
181         CALL restput( inum3, 'glamv', jpi, jpj, 1, 0, glamv )
182         CALL restput( inum3, 'glamf', jpi, jpj, 1, 0, glamf )
183
184         CALL restput( inum3, 'gphit', jpi, jpj, 1, 0, gphit )     !    ! longitude
185         CALL restput( inum3, 'gphiu', jpi, jpj, 1, 0, gphiu )
186         CALL restput( inum3, 'gphiv', jpi, jpj, 1, 0, gphiv )
187         CALL restput( inum3, 'gphif', jpi, jpj, 1, 0, gphif )
188
189         CALL restput( inum3, 'e1t', jpi, jpj, 1, 0, e1t )         !    ! e1 scale factors
190         CALL restput( inum3, 'e1u', jpi, jpj, 1, 0, e1u )
191         CALL restput( inum3, 'e1v', jpi, jpj, 1, 0, e1v )
192         CALL restput( inum3, 'e1f', jpi, jpj, 1, 0, e1f )
193
194         CALL restput( inum3, 'e2t', jpi, jpj, 1, 0, e2t )         !    ! e2 scale factors
195         CALL restput( inum3, 'e2u', jpi, jpj, 1, 0, e2u )
196         CALL restput( inum3, 'e2v', jpi, jpj, 1, 0, e2v )
197         CALL restput( inum3, 'e2f', jpi, jpj, 1, 0, e2f )
198
199         CALL restput( inum3, 'ff', jpi, jpj, 1, 0, ff )           !    ! coriolis factor
200
201         CALL restput( inum4, 'mbathy', jpi, jpj, 1, 0, zprt )
202
203#if ! defined key_zco
204         IF( ln_sco ) THEN                                         ! s-coordinate
205            CALL restput( inum4, 'hbatt', jpi, jpj, 1, 0, hbatt )      !    ! depth
206            CALL restput( inum4, 'hbatu', jpi, jpj, 1, 0, hbatu ) 
207            CALL restput( inum4, 'hbatv', jpi, jpj, 1, 0, hbatv )
208            CALL restput( inum4, 'hbatf', jpi, jpj, 1, 0, hbatf )
209   
210            CALL restput( inum4, 'gsigt', 1, 1, jpk, 0, gsigt )        !    ! scaling coef.
211            CALL restput( inum4, 'gsigw', 1, 1, jpk, 0, gsigw ) 
212            CALL restput( inum4, 'gsi3w', 1, 1, jpk, 0, gsi3w )
213            CALL restput( inum4, 'esigt', 1, 1, jpk, 0, esigt )
214            CALL restput( inum4, 'esigw', 1, 1, jpk, 0, esigw )
215
216            CALL restput( inum4, 'e3t', jpi, jpj, jpk, 0, e3t )       !    ! scale factors
217            CALL restput( inum4, 'e3u', jpi, jpj, jpk, 0, e3u )
218            CALL restput( inum4, 'e3v', jpi, jpj, jpk, 0, e3v )
219            CALL restput( inum4, 'e3w', jpi, jpj, jpk, 0, e3w )
220
221            CALL restput( inum4, 'gdept_0' , jpi, jpj, jpk, 0, gdept_0 )  !    ! stretched system
222            CALL restput( inum4, 'gdepw_0' , jpi, jpj, jpk, 0, gdepw_0 )
223         ENDIF
224
225         IF( ln_zps ) THEN                                         ! z-coordinate - partial steps
226            CALL restput( inum4, 'hdept' , jpi, jpj, 1, 0, hdept  )    !    ! depth
227            CALL restput( inum4, 'hdepw' , jpi, jpj, 1, 0, hdepw  ) 
228
229            CALL restput( inum4, 'e3t' , jpi, jpj, jpk, 0, e3t )      !    ! scale factors
230            CALL restput( inum4, 'e3u' , jpi, jpj, jpk, 0, e3u )
231            CALL restput( inum4, 'e3v' , jpi, jpj, jpk, 0, e3v )
232            CALL restput( inum4, 'e3w' , jpi, jpj, jpk, 0, e3w )
233
234            CALL restput( inum4, 'gdept_0', 1, 1, jpk, 0, gdept_0 )   !    ! reference z-coord.
235            CALL restput( inum4, 'gdepw_0', 1, 1, jpk, 0, gdepw_0 )
236            CALL restput( inum4, 'e3t_0'  , 1, 1, jpk, 0, e3t_0   )
237            CALL restput( inum4, 'e3w_0'  , 1, 1, jpk, 0, e3w_0   )
238         ENDIF
239
240#endif
241
242         IF( ln_zco ) THEN
243         !                                                         ! z-coordinate - full steps
244            CALL restput( inum4, 'gdept_0', 1, 1, jpk, 0, gdept_0 )   !    ! depth
245            CALL restput( inum4, 'gdepw_0', 1, 1, jpk, 0, gdepw_0 )
246            CALL restput( inum4, 'e3t_0'  , 1, 1, jpk, 0, e3t_0   )   !    ! scale factors
247            CALL restput( inum4, 'e3w_0'  , 1, 1, jpk, 0, e3w_0   )
248         ENDIF
249
250         !                                     ! ============================
251         !                                     !        close the files
252         !                                     ! ============================
253         SELECT CASE ( nmsh )
254            CASE ( 1 )               
255               CALL restclo( inum0 )
256            CASE ( 2 )
257               CALL restclo( inum1 )
258               CALL restclo( inum2 )
259            CASE ( 3 )
260               CALL restclo( inum2 )
261               CALL restclo( inum3 )
262               CALL restclo( inum4 )
263         END SELECT
264
265   END SUBROUTINE dom_wri
266
267#endif
268
269   !!======================================================================
270END MODULE domwri
Note: See TracBrowser for help on using the repository browser.