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

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

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