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

source: tags/nemo_dev_x9/NEMO/OPA_SRC/DOM/domwri.F90 @ 5385

Last change on this file since 5385 was 116, checked in by opalod, 20 years ago

CT : UPDATE075 : Save the mbathy 2D array and the 3D scale factors e3t_ps and e3w_ps in partial steps in the mesh_zgr.nc file
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 12.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 , LODYC-IPSL  (2003)
24   !!----------------------------------------------------------------------
25
26CONTAINS
27
28#if defined key_fdir
29   !!----------------------------------------------------------------------
30   !!   'key_fdir' :                                     direct access file
31   !!----------------------------------------------------------------------
32#  include "domwri_fdir.h90"
33
34#elif ( defined key_mpp_mpi || defined key_mpp_shmem ) && defined key_dimgout
35   !!----------------------------------------------------------------------
36   !!   'key_mpp_mpi'     OR
37   !!   'key_mpp_shmem'
38   !!   'key_dimgout' :         each processor makes its own direct access file
39   !!                      use build_nc_meshmask off line to retrieve
40   !!                      a ioipsl compliant meshmask file
41   !!----------------------------------------------------------------------
42#  include "domwri_dimg.h90"
43
44
45#else
46   !!----------------------------------------------------------------------
47   !!   Default option :                                        NetCDF file
48   !!----------------------------------------------------------------------
49
50   SUBROUTINE dom_wri
51      !!----------------------------------------------------------------------
52      !!                  ***  ROUTINE dom_wri  ***
53      !!                   
54      !! ** Purpose :   Create the NetCDF file(s) which contain(s) all the
55      !!      ocean domain informations (mesh and mask arrays). This (these)
56      !!      file(s) is (are) used for visualisation (SAXO software) and
57      !!      diagnostic computation.
58      !!
59      !! ** Method  :   Write in a file all the arrays generated in routines
60      !!      domhgr, domzgr, and dommsk. Note: the file contain depends on
61      !!      the vertical coord. used (z-coord, partial steps, s-coord)
62      !!                    nmsh = 1  :   'mesh_mask.nc' file
63      !!                         = 2  :   'mesh.nc' and mask.nc' files
64      !!                         = 3  :   'mesh_hgr.nc', 'mesh_zgr.nc' and
65      !!                                  'mask.nc' files
66      !!      For huge size domain, use option 2 or 3 depending on your
67      !!      vertical coordinate.
68      !!
69      !! ** output file :
70      !!      meshmask.nc  : domain size, horizontal grid-point position,
71      !!                     masks, depth and vertical scale factors
72      !!
73      !! History :
74      !!        !  97-02  (G. Madec)  Original code
75      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
76      !!   9.0  !  02-08  (G. Madec)  F90 and several file
77      !!----------------------------------------------------------------------
78      !! * Modules used
79      USE ioipsl
80
81      !! * Local declarations
82      INTEGER  ::                & !!! * temprary units for :
83         inum0 ,                 &  ! 'mesh_mask.nc' file
84         inum1 ,                 &  ! 'mesh.nc'      file
85         inum2 ,                 &  ! 'mask.nc'      file
86         inum3 ,                 &  ! 'mesh_hgr.nc'  file
87         inum4                      ! 'mesh_zgr.nc'  file
88      INTEGER  ::   itime           !  output from restini ???
89      REAL(wp) ::   zdate0
90      REAL(wp), DIMENSION(jpi,jpj) ::   &
91         zprt                       ! temporary array for bathymetry
92
93      CHARACTER (len=21) ::      &
94         clnam0 = 'mesh_mask',   &  ! filename (mesh and mask informations)
95         clnam1 = 'mesh'     ,   &  ! filename (mesh informations)
96         clnam2 = 'mask'     ,   &  ! filename (mask informations)
97         clnam3 = 'mesh_hgr' ,   &  ! filename (horizontal mesh informations)
98         clnam4 = 'mesh_zgr'        ! filename (vertical   mesh informations)
99      !!----------------------------------------------------------------------
100
101       IF(lwp) WRITE(numout,*)
102       IF(lwp) WRITE(numout,*) 'dom_wri : create NetCDF mesh and mask information file(s)'
103       IF(lwp) WRITE(numout,*) '~~~~~~~'
104
105      CALL ymds2ju( 0, 1, 1, 0.e0, zdate0 )    ! calendar initialization
106
107!       note that mbathy has been modified in dommsk or in solver.
108!       it is the number of non-zero "w" levels in the water, and the minimum
109!       value (on land) is 2. We define zprt as the number of "T" points in the ocean
110!       at any location, and zero on land.
111!
112      zprt = tmask(:,:,1)*(mbathy-1)
113
114      SELECT CASE (nmsh)
115         !                                     ! ============================
116         CASE ( 1 )                            !  create 'mesh_mask.nc' file
117            !                                  ! ============================
118
119            IF(lwp) WRITE(numout,*) '          one file in "mesh_mask.nc" '
120            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mesh_mask.nc' file
121            &             jpk   , gdept , trim(clnam0)        ,  &   ! in unit inum0
122            &             itime , zdate0, rdt   , inum0          )
123            inum2 = inum0                                            ! put all the informations
124            inum3 = inum0                                            ! in unit inum0
125            inum4 = inum0
126
127            !                                  ! ============================
128         CASE ( 2 )                            !  create 'mesh.nc' and
129            !                                  !         'mask.nc' files
130            !                                  ! ============================
131
132            IF(lwp) WRITE(numout,*) '          two files in "mesh.nc" and "mask.nc" '
133            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mesh.nc' file
134            &             jpk   , gdept , trim(clnam1)        ,  &   ! in unit inum1
135            &             itime , zdate0, rdt   , inum1          )
136            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mask.nc' file
137            &             jpk   , gdept , trim(clnam2)        ,  &   ! in unit inum2
138            &             itime , zdate0, rdt   , inum2          )
139            inum3 = inum1                                            ! put mesh informations
140            inum4 = inum1                                            ! in unit inum1
141
142            !                                  ! ============================
143         CASE ( 3 )                            !  create 'mesh_hgr.nc'
144            !                                  !         'mesh_zgr.nc' and
145            !                                  !         'mask.nc'     files
146            !                                  ! ============================
147
148            IF(lwp) WRITE(numout,*) '          three files in "mesh_hgr.nc" , mesh_zgr.nc" and "mask.nc" '
149            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mesh_hgr.nc' file
150            &             jpk   , gdept , trim(clnam3)        ,  &   ! in unit inum3
151            &             itime , zdate0, rdt   , inum3          )
152            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mesh_zgr.nc' file
153            &             jpk   , gdept , trim(clnam4)        ,  &   ! in unit inum4
154            &             itime , zdate0, rdt   , inum4          )
155            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mask.nc' file
156            &             jpk   , gdept , trim(clnam2)        ,  &   ! in unit inum2
157            &             itime , zdate0, rdt   , inum2          ) 
158
159         END SELECT
160
161         !                                                         ! masks (inum2)
162         CALL restput( inum2, 'tmask', jpi, jpj, jpk, 0, tmask ) 
163         CALL restput( inum2, 'umask', jpi, jpj, jpk, 0, umask )
164         CALL restput( inum2, 'vmask', jpi, jpj, jpk, 0, vmask )
165         CALL restput( inum2, 'fmask', jpi, jpj, jpk, 0, fmask )
166
167         !                                                         ! horizontal mesh (inum3)
168         CALL restput( inum3, 'glamt', jpi, jpj, 1, 0, glamt )     !    ! latitude
169         CALL restput( inum3, 'glamu', jpi, jpj, 1, 0, glamu )
170         CALL restput( inum3, 'glamv', jpi, jpj, 1, 0, glamv )
171         CALL restput( inum3, 'glamf', jpi, jpj, 1, 0, glamf )
172
173         CALL restput( inum3, 'gphit', jpi, jpj, 1, 0, gphit )     !    ! longitude
174         CALL restput( inum3, 'gphiu', jpi, jpj, 1, 0, gphiu )
175         CALL restput( inum3, 'gphiv', jpi, jpj, 1, 0, gphiv )
176         CALL restput( inum3, 'gphif', jpi, jpj, 1, 0, gphif )
177
178         CALL restput( inum3, 'e1t', jpi, jpj, 1, 0, e1t )         !    ! e1 scale factors
179         CALL restput( inum3, 'e1u', jpi, jpj, 1, 0, e1u )
180         CALL restput( inum3, 'e1v', jpi, jpj, 1, 0, e1v )
181         CALL restput( inum3, 'e1f', jpi, jpj, 1, 0, e1f )
182
183         CALL restput( inum3, 'e2t', jpi, jpj, 1, 0, e2t )         !    ! e2 scale factors
184         CALL restput( inum3, 'e2u', jpi, jpj, 1, 0, e2u )
185         CALL restput( inum3, 'e2v', jpi, jpj, 1, 0, e2v )
186         CALL restput( inum3, 'e2f', jpi, jpj, 1, 0, e2f )
187
188         CALL restput( inum3, 'ff', jpi, jpj, 1, 0, ff )           !    ! coriolis factor
189
190         CALL restput( inum4, 'mbathy', jpi, jpj, 1, 0, zprt )
191
192# if defined key_s_coord
193         !                                                         ! s-coordinate
194         CALL restput( inum4, 'hbatt', jpi, jpj, 1, 0, hbatt )      !    ! depth
195         CALL restput( inum4, 'hbatu', jpi, jpj, 1, 0, hbatu ) 
196         CALL restput( inum4, 'hbatv', jpi, jpj, 1, 0, hbatv )
197         CALL restput( inum4, 'hbatf', jpi, jpj, 1, 0, hbatf )
198
199         CALL restput( inum4, 'gsigt', 1, 1, jpk, 0, gsigt )        !    ! scaling coef.
200         CALL restput( inum4, 'gsigw', 1, 1, jpk, 0, gsigw ) 
201         CALL restput( inum4, 'gsi3w', 1, 1, jpk, 0, gsi3w )
202         CALL restput( inum4, 'esigt', 1, 1, jpk, 0, esigt )
203         CALL restput( inum4, 'esigw', 1, 1, jpk, 0, esigw )
204
205# elif defined key_partial_steps
206         !                                                          ! z-coordinate with partial steps
207         CALL restput( inum4, 'hdept' , jpi, jpj, 1, 0, hdept  )    !    ! depth
208         CALL restput( inum4, 'hdepw' , jpi, jpj, 1, 0, hdepw  ) 
209
210         CALL restput( inum4, 'e3t_ps', jpi, jpj, jpk, 0, e3t_ps )  !    ! scale factors
211         CALL restput( inum4, 'e3u_ps', jpi, jpj, jpk, 0, e3u_ps )
212         CALL restput( inum4, 'e3v_ps', jpi, jpj, jpk, 0, e3v_ps )
213         CALL restput( inum4, 'e3w_ps', jpi, jpj, jpk, 0, e3w_ps )
214
215         CALL restput( inum4, 'gdept' , 1, 1, jpk, 0, gdept )       !    ! reference z-coord.
216         CALL restput( inum4, 'gdepw' , 1, 1, jpk, 0, gdepw )
217         CALL restput( inum4, 'e3t'   , 1, 1, jpk, 0, e3t   )
218         CALL restput( inum4, 'e3w'   , 1, 1, jpk, 0, e3w   )
219
220# else
221         !                                                          ! z-coordinate
222         CALL restput( inum4, 'gdept', 1, 1, jpk, 0, gdept )        !    ! depth
223         CALL restput( inum4, 'gdepw', 1, 1, jpk, 0, gdepw )
224         CALL restput( inum4, 'e3t'  , 1, 1, jpk, 0, e3t   )        !    ! scale factors
225         CALL restput( inum4, 'e3w'  , 1, 1, jpk, 0, e3w   )
226# endif
227
228         !                                     ! ============================
229         !                                     !        close the files
230         !                                     ! ============================
231         SELECT CASE ( nmsh )
232            CASE ( 1 )               
233               CALL restclo( inum0 )
234            CASE ( 2 )
235               CALL restclo( inum1 )
236               CALL restclo( inum2 )
237            CASE ( 3 )
238               CALL restclo( inum2 )
239               CALL restclo( inum3 )
240               CALL restclo( inum4 )
241         END SELECT
242
243   END SUBROUTINE dom_wri
244
245#endif
246
247   !!======================================================================
248END MODULE domwri
Note: See TracBrowser for help on using the repository browser.