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.
in_out_manager.F90 in branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/IOM – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90 @ 2364

Last change on this file since 2364 was 2364, checked in by acc, 13 years ago

Added basic NetCDF4 chunking and compression support (key_netcdf4). See ticket #754
  • Property svn:keywords set to Id
File size: 16.9 KB
Line 
1MODULE in_out_manager   
2   !!======================================================================
3   !!                       ***  MODULE  in_out_manager  ***
4   !! Ocean physics:  vertical mixing coefficient compute from the tke
5   !!                 turbulent closure parameterization
6   !!=====================================================================
7   !! History :   1.0  !  2002-06  (G. Madec)   original code
8   !!             2.0  !  2006-07  (S. Masson)  iom, add ctl_stop, ctl_warn
9   !!             3.0  !  2008-06  (G. Madec)   add ctmp4 to ctmp10
10   !!             3.2  !  2009-08  (S. MAsson)  add new ctl_opn
11   !!----------------------------------------------------------------------
12
13   !!----------------------------------------------------------------------
14   !!   ctl_stop   : update momentum and tracer Kz from a tke scheme
15   !!   ctl_warn   : initialization, namelist read, and parameters control
16   !!   getunit    : give the index of an unused logical unit
17   !!----------------------------------------------------------------------
18   USE par_kind        ! kind definition
19   USE par_oce         ! ocean parameter
20   USE lib_print       ! formated print library
21
22   IMPLICIT NONE
23   PUBLIC
24
25   !!----------------------------------------------------------------------
26   !!                   namrun namelist parameters
27   !!----------------------------------------------------------------------
28   CHARACTER(len=16)  ::   cn_exp        = "exp0"      !: experiment name used for output filename
29   CHARACTER(len=32)  ::   cn_ocerst_in  = "restart"   !: suffix of ocean restart name (input)
30   CHARACTER(len=32)  ::   cn_ocerst_out = "restart"   !: suffix of ocean restart name (output)
31   LOGICAL            ::   ln_rstart     = .FALSE.     !: start from (F) rest or (T) a restart file
32   INTEGER            ::   nn_no         = 0           !: job number
33   INTEGER            ::   nn_rstctl     = 0           !: control of the time step (0, 1 or 2)
34   INTEGER            ::   nn_rstssh     = 0           !: hand made initilization of ssh or not (1/0)
35   INTEGER            ::   nn_it000      = 1           !: index of the first time step
36   INTEGER            ::   nn_itend      = 10          !: index of the last time step
37   INTEGER            ::   nn_date0      = 961115      !: initial calendar date aammjj
38   INTEGER            ::   nn_leapy      = 0           !: Leap year calendar flag (0/1 or 30)
39   INTEGER            ::   nn_istate     = 0           !: initial state output flag (0/1)
40   INTEGER            ::   nn_write      =   10        !: model standard output frequency
41   INTEGER            ::   nn_stock      =   10        !: restart file frequency
42   LOGICAL            ::   ln_dimgnnn    = .FALSE.     !: type of dimgout. (F): 1 file for all proc
43                                                       !:                  (T): 1 file per proc
44   LOGICAL            ::   ln_mskland    = .FALSE.     !: mask land points in NetCDF outputs (costly: + ~15%)
45   LOGICAL            ::   ln_clobber    = .FALSE.     !: clobber (overwrite) an existing file
46   INTEGER            ::   nn_chunksz    = 0           !: chunksize (bytes) for NetCDF file (working only with iom_nf90 routines)
47#if defined key_netcdf4
48   !!----------------------------------------------------------------------
49   !!                   namnc4 namelist parameters
50   !!----------------------------------------------------------------------
51                                                       !: =========================================================================
52                                                       !: The following four values determine the partitioning of the output fields
53                                                       !: into netcdf4 chunks. They are unrelated to the nn_chunk_sz setting which is
54                                                       !: for runtime optimisation. The individual netcdf4 chunks can be optionally
55                                                       !: gzipped (recommended) leading to significant reductions in I/O volumes
56   INTEGER            ::   nn_nchunks_i  = 1           !: number of chunks required in the i-dimension (only with iom_nf90 routines and key_netcdf4)
57   INTEGER            ::   nn_nchunks_j  = 1           !: number of chunks required in the j-dimension (only with iom_nf90 routines and key_netcdf4)
58   INTEGER            ::   nn_nchunks_k  = 1           !: number of chunks required in the k-dimension (only with iom_nf90 routines and key_netcdf4)
59   INTEGER            ::   nn_nchunks_t  = 1           !: number of chunks required in the t-dimension (only with iom_nf90 routines and key_netcdf4)
60   LOGICAL            ::   ln_nc4zip     = .TRUE.      !: netcdf4 usage. (T): chunk and compress output datasets using the HDF5 sublayers of netcdf4
61                                                       !:                (F): ignore chunking request and use the netcdf4 library to produce netcdf3-compatible files
62#endif
63
64!$AGRIF_DO_NOT_TREAT
65   TYPE, PUBLIC :: snc4_ctl                            !: netcdf4 chunking control structure (always needed for decision making)
66      SEQUENCE
67      INTEGER :: ni
68      INTEGER :: nj
69      INTEGER :: nk
70      LOGICAL :: luse
71   END TYPE snc4_ctl
72
73   TYPE(snc4_ctl) :: snc4set                          !: netcdf4 chunking control structure (always needed for decision making)
74!$AGRIF_END_DO_NOT_TREAT
75
76
77   !! conversion of DOCTOR norm namelist name into model name
78   !! (this should disappear in a near futur)
79
80   CHARACTER(len=16)  ::   cexper                      !: experiment name used for output filename
81   INTEGER            ::   no                          !: job number
82   INTEGER            ::   nrstdt                      !: control of the time step (0, 1 or 2)
83   INTEGER            ::   nit000                      !: index of the first time step
84   INTEGER            ::   nitend                      !: index of the last time step
85   INTEGER            ::   ndate0                      !: initial calendar date aammjj
86   INTEGER            ::   nleapy                      !: Leap year calendar flag (0/1 or 30)
87   INTEGER            ::   ninist                      !: initial state output flag (0/1)
88   INTEGER            ::   nwrite                      !: model standard output frequency
89   INTEGER            ::   nstock                      !: restart file frequency
90
91   !!----------------------------------------------------------------------
92   !! was in restart but moved here because of the OFF line... better solution should be found...
93   !!----------------------------------------------------------------------
94   INTEGER            ::   nitrst                 !: time step at which restart file should be written
95
96   !!----------------------------------------------------------------------
97   !!                    output monitoring
98   !!----------------------------------------------------------------------
99   LOGICAL            ::   ln_ctl     = .FALSE.   !: run control for debugging
100   INTEGER            ::   nn_print     =    0    !: level of print (0 no print)
101   INTEGER            ::   nn_ictls     =    0    !: Start i indice for the SUM control
102   INTEGER            ::   nn_ictle     =    0    !: End   i indice for the SUM control
103   INTEGER            ::   nn_jctls     =    0    !: Start j indice for the SUM control
104   INTEGER            ::   nn_jctle     =    0    !: End   j indice for the SUM control
105   INTEGER            ::   nn_isplt     =    1    !: number of processors following i
106   INTEGER            ::   nn_jsplt     =    1    !: number of processors following j
107   INTEGER            ::   nn_bench     =    0    !: benchmark parameter (0/1)
108   INTEGER            ::   nn_bit_cmp   =    0    !: bit reproducibility  (0/1)
109
110   !                                              !: OLD namelist names
111   INTEGER ::   nprint, nictls, nictle, njctls, njctle, isplt, jsplt, nbench
112
113   INTEGER            ::   ijsplt     =    1      !: nb of local domain = nb of processors
114
115   !!----------------------------------------------------------------------
116   !!                        logical units
117   !!----------------------------------------------------------------------
118   INTEGER            ::   numstp     =   -1      !: logical unit for time step
119   INTEGER            ::   numout     =    6      !: logical unit for output print
120   INTEGER            ::   numnam     =   -1      !: logical unit for namelist
121   INTEGER            ::   numnam_ice =   -1      !: logical unit for ice namelist
122   INTEGER            ::   numevo_ice =   -1      !: logical unit for ice variables (temp. evolution)
123   INTEGER            ::   numsol     =   -1      !: logical unit for solver statistics
124
125   !!----------------------------------------------------------------------
126   !!                          Run control 
127   !!----------------------------------------------------------------------
128   INTEGER            ::   nstop = 0                !: error flag (=number of reason for a premature stop run)
129   INTEGER            ::   nwarn = 0                !: warning flag (=number of warning found during the run)
130   CHARACTER(len=200) ::   ctmp1, ctmp2, ctmp3      !: temporary characters 1 to 3
131   CHARACTER(len=200) ::   ctmp4, ctmp5, ctmp6      !: temporary characters 4 to 6
132   CHARACTER(len=200) ::   ctmp7, ctmp8, ctmp9      !: temporary characters 7 to 9
133   CHARACTER(len=200) ::   ctmp10                   !: temporary character 10
134   CHARACTER (len=64) ::   cform_err = "(/,' ===>>> : E R R O R',     /,'         ===========',/)"       !:
135   CHARACTER (len=64) ::   cform_war = "(/,' ===>>> : W A R N I N G', /,'         ===============',/)"   !:
136   LOGICAL            ::   lwp      = .FALSE.       !: boolean : true on the 1st processor only
137   LOGICAL            ::   lsp_area = .TRUE.        !: to make a control print over a specific area
138   !!----------------------------------------------------------------------
139   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
140   !! $Id$
141   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
142   !!----------------------------------------------------------------------
143
144CONTAINS
145
146   SUBROUTINE ctl_stop( cd1, cd2, cd3, cd4, cd5,   &
147      &                 cd6, cd7, cd8, cd9, cd10 )
148      !!----------------------------------------------------------------------
149      !!                  ***  ROUTINE  stop_opa  ***
150      !!
151      !! ** Purpose :   print in ocean.outpput file a error message and
152      !!                increment the error number (nstop) by one.
153      !!----------------------------------------------------------------------
154      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5
155      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10
156      !!----------------------------------------------------------------------
157      !
158      nstop = nstop + 1 
159      IF(lwp) THEN
160         WRITE(numout,"(/,' ===>>> : E R R O R',     /,'         ===========',/)") 
161         IF( PRESENT(cd1 ) ) WRITE(numout,*) cd1
162         IF( PRESENT(cd2 ) ) WRITE(numout,*) cd2
163         IF( PRESENT(cd3 ) ) WRITE(numout,*) cd3
164         IF( PRESENT(cd4 ) ) WRITE(numout,*) cd4
165         IF( PRESENT(cd5 ) ) WRITE(numout,*) cd5
166         IF( PRESENT(cd6 ) ) WRITE(numout,*) cd6
167         IF( PRESENT(cd7 ) ) WRITE(numout,*) cd7
168         IF( PRESENT(cd8 ) ) WRITE(numout,*) cd8
169         IF( PRESENT(cd9 ) ) WRITE(numout,*) cd9
170         IF( PRESENT(cd10) ) WRITE(numout,*) cd10
171      ENDIF
172                               CALL FLUSH(numout    )
173      IF( numstp     /= -1 )   CALL FLUSH(numstp    )
174      IF( numsol     /= -1 )   CALL FLUSH(numsol    )
175      IF( numevo_ice /= -1 )   CALL FLUSH(numevo_ice)
176      !
177   END SUBROUTINE ctl_stop
178
179
180   SUBROUTINE ctl_warn( cd1, cd2, cd3, cd4, cd5,   &
181      &                 cd6, cd7, cd8, cd9, cd10 )
182      !!----------------------------------------------------------------------
183      !!                  ***  ROUTINE  stop_warn  ***
184      !!
185      !! ** Purpose :   print in ocean.outpput file a error message and
186      !!                increment the warning number (nwarn) by one.
187      !!----------------------------------------------------------------------
188      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5
189      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10
190      !!----------------------------------------------------------------------
191      !
192      nwarn = nwarn + 1 
193      IF(lwp) THEN
194         WRITE(numout,"(/,' ===>>> : W A R N I N G', /,'         ===============',/)") 
195         IF( PRESENT(cd1 ) ) WRITE(numout,*) cd1
196         IF( PRESENT(cd2 ) ) WRITE(numout,*) cd2
197         IF( PRESENT(cd3 ) ) WRITE(numout,*) cd3
198         IF( PRESENT(cd4 ) ) WRITE(numout,*) cd4
199         IF( PRESENT(cd5 ) ) WRITE(numout,*) cd5
200         IF( PRESENT(cd6 ) ) WRITE(numout,*) cd6
201         IF( PRESENT(cd7 ) ) WRITE(numout,*) cd7
202         IF( PRESENT(cd8 ) ) WRITE(numout,*) cd8
203         IF( PRESENT(cd9 ) ) WRITE(numout,*) cd9
204         IF( PRESENT(cd10) ) WRITE(numout,*) cd10
205      ENDIF
206      CALL FLUSH(numout)
207      !
208   END SUBROUTINE ctl_warn
209
210
211   SUBROUTINE ctl_opn ( knum, cdfile, cdstat, cdform, cdacce, klengh, kout, ldwp, karea )
212      !!----------------------------------------------------------------------
213      !!                  ***  ROUTINE ctl_opn  ***
214      !!
215      !! ** Purpose :   Open file and check if required file is available.
216      !!
217      !! ** Method  :   Fortan open
218      !!
219      !! History :
220      !!        !  1995-12  (G. Madec)  Original code
221      !!   8.5  !  2002-06  (G. Madec)  F90: Free form and module
222      !!----------------------------------------------------------------------
223
224      INTEGER          , INTENT(  out) ::   knum      ! logical unit to open
225      CHARACTER(len=*) , INTENT(in   ) ::   cdfile    ! file name to open
226      CHARACTER(len=*) , INTENT(in   ) ::   cdstat    ! disposition specifier
227      CHARACTER(len=*) , INTENT(in   ) ::   cdform    ! formatting specifier
228      CHARACTER(len=*) , INTENT(in   ) ::   cdacce    ! access specifier
229      INTEGER          , INTENT(in   ) ::   klengh    ! record length
230      INTEGER          , INTENT(in   ) ::   kout      ! number of logical units for write
231      LOGICAL          , INTENT(in   ) ::   ldwp      ! boolean term for print
232      INTEGER, OPTIONAL, INTENT(in   ) ::   karea     ! proc number
233      !!
234      CHARACTER(len=80) ::   clfile
235      INTEGER           ::   iost
236
237      ! adapt filename
238      ! ----------------
239      clfile = TRIM(cdfile)
240      IF( PRESENT( karea ) ) THEN
241         IF( karea > 1 )   WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1
242      ENDIF
243#if defined key_agrif
244      IF( .NOT. Agrif_Root() )   clfile = TRIM(Agrif_CFixed())//'_'//TRIM(clfile)
245      knum=Agrif_Get_Unit()
246#else
247      knum=getunit()
248#endif
249
250      iost=0
251      IF( cdacce(1:6) == 'DIRECT' )  THEN
252         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost )
253      ELSE
254         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat             , ERR=100, IOSTAT=iost )
255      ENDIF
256      IF( iost == 0 ) THEN
257         IF(ldwp) THEN
258            WRITE(kout,*) '     file   : ', clfile,' open ok'
259            WRITE(kout,*) '     unit   = ', knum
260            WRITE(kout,*) '     status = ', cdstat
261            WRITE(kout,*) '     form   = ', cdform
262            WRITE(kout,*) '     access = ', cdacce
263            WRITE(kout,*)
264         ENDIF
265      ENDIF
266100   CONTINUE
267      IF( iost /= 0 ) THEN
268         IF(ldwp) THEN
269            WRITE(kout,*)
270            WRITE(kout,*) ' ===>>>> : bad opening file: ', clfile
271            WRITE(kout,*) ' =======   ===  '
272            WRITE(kout,*) '           unit   = ', knum
273            WRITE(kout,*) '           status = ', cdstat
274            WRITE(kout,*) '           form   = ', cdform
275            WRITE(kout,*) '           access = ', cdacce
276            WRITE(kout,*) '           iostat = ', iost
277            WRITE(kout,*) '           we stop. verify the file '
278            WRITE(kout,*)
279         ENDIF
280         STOP 'ctl_opn bad opening'
281      ENDIF
282     
283   END SUBROUTINE ctl_opn
284
285
286   FUNCTION getunit()
287      !!----------------------------------------------------------------------
288      !!                  ***  FUNCTION  getunit  ***
289      !!
290      !! ** Purpose :   return the index of an unused logical unit
291      !!----------------------------------------------------------------------
292      INTEGER :: getunit
293      LOGICAL :: llopn 
294      !!----------------------------------------------------------------------
295      !
296      getunit = 15   ! choose a unit that is big enough then it is not already used in NEMO
297      llopn = .TRUE.
298      DO WHILE( (getunit < 998) .AND. llopn )
299         getunit = getunit + 1
300         INQUIRE( unit = getunit, opened = llopn )
301      END DO
302      IF( (getunit == 999) .AND. llopn ) THEN
303         CALL ctl_stop( 'getunit: All logical units until 999 are used...' )
304         getunit = -1
305      ENDIF
306      !
307   END FUNCTION getunit
308
309   !!=====================================================================
310END MODULE in_out_manager
Note: See TracBrowser for help on using the repository browser.