source: trunk/NEMO/OPA_SRC/DOM/domwri.F90 @ 392

Last change on this file since 392 was 392, checked in by opalod, 15 years ago

RB:nemo_v1_update_038: first integration of Agrif :

  • add agrif to dynspg_flt_jki.F90
  • cosmetic change of key_AGRIF in key_agrif
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 13.0 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 , 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 , 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 , 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 , 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 , 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 , 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_s_coord
204         !                                                         ! 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# elif defined key_partial_steps
217         !                                                          ! z-coordinate with partial steps
218         CALL restput( inum4, 'hdept' , jpi, jpj, 1, 0, hdept  )    !    ! depth
219         CALL restput( inum4, 'hdepw' , jpi, jpj, 1, 0, hdepw  ) 
220
221         CALL restput( inum4, 'e3t_ps', jpi, jpj, jpk, 0, e3t_ps )  !    ! scale factors
222         CALL restput( inum4, 'e3u_ps', jpi, jpj, jpk, 0, e3u_ps )
223         CALL restput( inum4, 'e3v_ps', jpi, jpj, jpk, 0, e3v_ps )
224         CALL restput( inum4, 'e3w_ps', jpi, jpj, jpk, 0, e3w_ps )
225
226         CALL restput( inum4, 'gdept' , 1, 1, jpk, 0, gdept )       !    ! reference z-coord.
227         CALL restput( inum4, 'gdepw' , 1, 1, jpk, 0, gdepw )
228         CALL restput( inum4, 'e3t'   , 1, 1, jpk, 0, e3t   )
229         CALL restput( inum4, 'e3w'   , 1, 1, jpk, 0, e3w   )
230
231# else
232         !                                                          ! z-coordinate
233         CALL restput( inum4, 'gdept', 1, 1, jpk, 0, gdept )        !    ! depth
234         CALL restput( inum4, 'gdepw', 1, 1, jpk, 0, gdepw )
235         CALL restput( inum4, 'e3t'  , 1, 1, jpk, 0, e3t   )        !    ! scale factors
236         CALL restput( inum4, 'e3w'  , 1, 1, jpk, 0, e3w   )
237# endif
238
239         !                                     ! ============================
240         !                                     !        close the files
241         !                                     ! ============================
242         SELECT CASE ( nmsh )
243            CASE ( 1 )               
244               CALL restclo( inum0 )
245            CASE ( 2 )
246               CALL restclo( inum1 )
247               CALL restclo( inum2 )
248            CASE ( 3 )
249               CALL restclo( inum2 )
250               CALL restclo( inum3 )
251               CALL restclo( inum4 )
252         END SELECT
253
254   END SUBROUTINE dom_wri
255
256#endif
257
258   !!======================================================================
259END MODULE domwri
Note: See TracBrowser for help on using the repository browser.