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

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

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