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

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

nemo_v1_update_033 : CT : Switch to IOIPSL-3-0 new library
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 12.3 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 = 'mesh_mask',   &  ! filename (mesh and mask informations)
90         clnam1 = 'mesh'     ,   &  ! filename (mesh informations)
91         clnam2 = 'mask'     ,   &  ! filename (mask informations)
92         clnam3 = 'mesh_hgr' ,   &  ! filename (horizontal mesh informations)
93         clnam4 = 'mesh_zgr'        ! 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      CALL ymds2ju( 0, 1, 1, 0.e0, zdate0 )    ! calendar initialization
101
102!       note that mbathy has been modified in dommsk or in solver.
103!       it is the number of non-zero "w" levels in the water, and the minimum
104!       value (on land) is 2. We define zprt as the number of "T" points in the ocean
105!       at any location, and zero on land.
106!
107      zprt = tmask(:,:,1)*(mbathy-1)
108
109      SELECT CASE (nmsh)
110         !                                     ! ============================
111         CASE ( 1 )                            !  create 'mesh_mask.nc' file
112            !                                  ! ============================
113
114            IF(lwp) WRITE(numout,*) '          one file in "mesh_mask.nc" '
115            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mesh_mask.nc' file
116            &             jpk   , gdept , trim(clnam0)        ,  &   ! in unit inum0
117            &             itime , zdate0, rdt   , inum0 , domain_id=nidom )
118            inum2 = inum0                                            ! put all the informations
119            inum3 = inum0                                            ! in unit inum0
120            inum4 = inum0
121
122            !                                  ! ============================
123         CASE ( 2 )                            !  create 'mesh.nc' and
124            !                                  !         'mask.nc' files
125            !                                  ! ============================
126
127            IF(lwp) WRITE(numout,*) '          two files in "mesh.nc" and "mask.nc" '
128            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mesh.nc' file
129            &             jpk   , gdept , trim(clnam1)        ,  &   ! in unit inum1
130            &             itime , zdate0, rdt   , inum1, domain_id=nidom )
131            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mask.nc' file
132            &             jpk   , gdept , trim(clnam2)        ,  &   ! in unit inum2
133            &             itime , zdate0, rdt   , inum2, domain_id=nidom )
134            inum3 = inum1                                            ! put mesh informations
135            inum4 = inum1                                            ! in unit inum1
136
137            !                                  ! ============================
138         CASE ( 3 )                            !  create 'mesh_hgr.nc'
139            !                                  !         'mesh_zgr.nc' and
140            !                                  !         'mask.nc'     files
141            !                                  ! ============================
142
143            IF(lwp) WRITE(numout,*) '          three files in "mesh_hgr.nc" , mesh_zgr.nc" and "mask.nc" '
144            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mesh_hgr.nc' file
145            &             jpk   , gdept , trim(clnam3)        ,  &   ! in unit inum3
146            &             itime , zdate0, rdt   , inum3, domain_id=nidom )
147            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mesh_zgr.nc' file
148            &             jpk   , gdept , trim(clnam4)        ,  &   ! in unit inum4
149            &             itime , zdate0, rdt   , inum4, domain_id=nidom )
150            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mask.nc' file
151            &             jpk   , gdept , trim(clnam2)        ,  &   ! in unit inum2
152            &             itime , zdate0, rdt   , inum2, domain_id=nidom )
153
154         END SELECT
155
156         !                                                         ! masks (inum2)
157         CALL restput( inum2, 'tmask', jpi, jpj, jpk, 0, tmask ) 
158         CALL restput( inum2, 'umask', jpi, jpj, jpk, 0, umask )
159         CALL restput( inum2, 'vmask', jpi, jpj, jpk, 0, vmask )
160         CALL restput( inum2, 'fmask', jpi, jpj, jpk, 0, fmask )
161
162         !                                                         ! horizontal mesh (inum3)
163         CALL restput( inum3, 'glamt', jpi, jpj, 1, 0, glamt )     !    ! latitude
164         CALL restput( inum3, 'glamu', jpi, jpj, 1, 0, glamu )
165         CALL restput( inum3, 'glamv', jpi, jpj, 1, 0, glamv )
166         CALL restput( inum3, 'glamf', jpi, jpj, 1, 0, glamf )
167
168         CALL restput( inum3, 'gphit', jpi, jpj, 1, 0, gphit )     !    ! longitude
169         CALL restput( inum3, 'gphiu', jpi, jpj, 1, 0, gphiu )
170         CALL restput( inum3, 'gphiv', jpi, jpj, 1, 0, gphiv )
171         CALL restput( inum3, 'gphif', jpi, jpj, 1, 0, gphif )
172
173         CALL restput( inum3, 'e1t', jpi, jpj, 1, 0, e1t )         !    ! e1 scale factors
174         CALL restput( inum3, 'e1u', jpi, jpj, 1, 0, e1u )
175         CALL restput( inum3, 'e1v', jpi, jpj, 1, 0, e1v )
176         CALL restput( inum3, 'e1f', jpi, jpj, 1, 0, e1f )
177
178         CALL restput( inum3, 'e2t', jpi, jpj, 1, 0, e2t )         !    ! e2 scale factors
179         CALL restput( inum3, 'e2u', jpi, jpj, 1, 0, e2u )
180         CALL restput( inum3, 'e2v', jpi, jpj, 1, 0, e2v )
181         CALL restput( inum3, 'e2f', jpi, jpj, 1, 0, e2f )
182
183         CALL restput( inum3, 'ff', jpi, jpj, 1, 0, ff )           !    ! coriolis factor
184
185         CALL restput( inum4, 'mbathy', jpi, jpj, 1, 0, zprt )
186
187# if defined key_s_coord
188         !                                                         ! s-coordinate
189         CALL restput( inum4, 'hbatt', jpi, jpj, 1, 0, hbatt )      !    ! depth
190         CALL restput( inum4, 'hbatu', jpi, jpj, 1, 0, hbatu ) 
191         CALL restput( inum4, 'hbatv', jpi, jpj, 1, 0, hbatv )
192         CALL restput( inum4, 'hbatf', jpi, jpj, 1, 0, hbatf )
193
194         CALL restput( inum4, 'gsigt', 1, 1, jpk, 0, gsigt )        !    ! scaling coef.
195         CALL restput( inum4, 'gsigw', 1, 1, jpk, 0, gsigw ) 
196         CALL restput( inum4, 'gsi3w', 1, 1, jpk, 0, gsi3w )
197         CALL restput( inum4, 'esigt', 1, 1, jpk, 0, esigt )
198         CALL restput( inum4, 'esigw', 1, 1, jpk, 0, esigw )
199
200# elif defined key_partial_steps
201         !                                                          ! z-coordinate with partial steps
202         CALL restput( inum4, 'hdept' , jpi, jpj, 1, 0, hdept  )    !    ! depth
203         CALL restput( inum4, 'hdepw' , jpi, jpj, 1, 0, hdepw  ) 
204
205         CALL restput( inum4, 'e3t_ps', jpi, jpj, jpk, 0, e3t_ps )  !    ! scale factors
206         CALL restput( inum4, 'e3u_ps', jpi, jpj, jpk, 0, e3u_ps )
207         CALL restput( inum4, 'e3v_ps', jpi, jpj, jpk, 0, e3v_ps )
208         CALL restput( inum4, 'e3w_ps', jpi, jpj, jpk, 0, e3w_ps )
209
210         CALL restput( inum4, 'gdept' , 1, 1, jpk, 0, gdept )       !    ! reference z-coord.
211         CALL restput( inum4, 'gdepw' , 1, 1, jpk, 0, gdepw )
212         CALL restput( inum4, 'e3t'   , 1, 1, jpk, 0, e3t   )
213         CALL restput( inum4, 'e3w'   , 1, 1, jpk, 0, e3w   )
214
215# else
216         !                                                          ! z-coordinate
217         CALL restput( inum4, 'gdept', 1, 1, jpk, 0, gdept )        !    ! depth
218         CALL restput( inum4, 'gdepw', 1, 1, jpk, 0, gdepw )
219         CALL restput( inum4, 'e3t'  , 1, 1, jpk, 0, e3t   )        !    ! scale factors
220         CALL restput( inum4, 'e3w'  , 1, 1, jpk, 0, e3w   )
221# endif
222
223         !                                     ! ============================
224         !                                     !        close the files
225         !                                     ! ============================
226         SELECT CASE ( nmsh )
227            CASE ( 1 )               
228               CALL restclo( inum0 )
229            CASE ( 2 )
230               CALL restclo( inum1 )
231               CALL restclo( inum2 )
232            CASE ( 3 )
233               CALL restclo( inum2 )
234               CALL restclo( inum3 )
235               CALL restclo( inum4 )
236         END SELECT
237
238   END SUBROUTINE dom_wri
239
240#endif
241
242   !!======================================================================
243END MODULE domwri
Note: See TracBrowser for help on using the repository browser.