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/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/IOM – NEMO

source: branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90 @ 2625

Last change on this file since 2625 was 2625, checked in by gm, 13 years ago

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