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

source: trunk/NEMO/OPA_SRC/IOM/in_out_manager.F90 @ 1581

Last change on this file since 1581 was 1581, checked in by smasson, 15 years ago

ctlopn cleanup, see ticket:515 and ticket:237
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 13.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#if defined key_agrif
22   USE Agrif_Util
23#endif
24
25   IMPLICIT NONE
26   PUBLIC
27
28   !!----------------------------------------------------------------------
29   !!                   namrun namelist parameters
30   !!----------------------------------------------------------------------
31   CHARACTER(len=16)  ::   cexper        = "exp0"      !: experiment name used for output filename
32   CHARACTER(len=32)  ::   cn_ocerst_in  = "restart"   !: suffix of ocean restart name (input)
33   CHARACTER(len=32)  ::   cn_ocerst_out = "restart"   !: suffix of ocean restart name (output)
34   LOGICAL            ::   ln_rstart     = .FALSE.     !: start from (F) rest or (T) a restart file
35   INTEGER            ::   no            = 0           !: job number
36   INTEGER            ::   nrstdt        = 0           !: control of the time step (0, 1 or 2)
37   INTEGER            ::   nn_rstssh     = 0           !: hand made initilization of ssh or not (1/0)
38   INTEGER            ::   nit000        = 1           !: index of the first time step
39   INTEGER            ::   nitend        = 10          !: index of the last time step
40   INTEGER            ::   ndate0        = 961115      !: initial calendar date aammjj
41   INTEGER            ::   nleapy        = 0           !: Leap year calendar flag (0/1 or 30)
42   INTEGER            ::   ninist        = 0           !: initial state output flag (0/1)
43   LOGICAL            ::   ln_dimgnnn    = .FALSE.     !: type of dimgout. (F): 1 file for all proc
44                                                       !:                  (T): 1 file per proc
45   LOGICAL            ::   ln_mskland    = .FALSE.     !: mask land points in NetCDF outputs (costly: + ~15%)
46   LOGICAL            ::   ln_clobber    = .FALSE.     !: clobber (overwrite) an existing file
47   INTEGER            ::   nn_chunksz    = 0           !: chunksize (bytes) for NetCDF file (working only with iom_nf90 routines)
48   !!----------------------------------------------------------------------
49   !! was in restart but moved here because of the OFF line... better solution should be found...
50   !!----------------------------------------------------------------------
51   INTEGER            ::   nitrst                 !: time step at which restart file should be written
52   !!----------------------------------------------------------------------
53   !!                    output monitoring
54   !!----------------------------------------------------------------------
55   LOGICAL            ::   ln_ctl     = .FALSE.   !: run control for debugging
56   INTEGER            ::   nstock     =   10      !: restart file frequency
57   INTEGER            ::   nprint     =    0      !: level of print (0 no print)
58   INTEGER            ::   nwrite     =   10      !: restart file frequency
59   INTEGER            ::   nictls     =    0      !: Start i indice for the SUM control
60   INTEGER            ::   nictle     =    0      !: End   i indice for the SUM control
61   INTEGER            ::   njctls     =    0      !: Start j indice for the SUM control
62   INTEGER            ::   njctle     =    0      !: End   j indice for the SUM control
63   INTEGER            ::   isplt      =    1      !: number of processors following i
64   INTEGER            ::   jsplt      =    1      !: number of processors following j
65   INTEGER            ::   ijsplt     =    1      !: nb of local domain = nb of processors
66   INTEGER            ::   nbench     =    0      !: benchmark parameter (0/1)
67   INTEGER            ::   nbit_cmp   =    0      !: bit reproducibility  (0/1)
68   !!----------------------------------------------------------------------
69   !!                        logical units
70   !!----------------------------------------------------------------------
71   INTEGER            ::   numstp                 !: logical unit for time step
72   INTEGER            ::   numout     =    6      !: logical unit for output print
73   INTEGER            ::   numnam                 !: logical unit for namelist
74   INTEGER            ::   numnam_ice             !: logical unit for ice namelist
75   INTEGER            ::   numevo_ice             !: logical unit for ice variables (temp. evolution)
76   INTEGER            ::   numsol                 !: logical unit for solver statistics
77   INTEGER            ::   numwri                 !: logical unit for output write
78   INTEGER            ::   numgap                 !: logical unit for differences diagnostic
79   INTEGER            ::   numbol                 !: logical unit for "bol" diagnostics
80   INTEGER            ::   numptr                 !: logical unit for Poleward TRansports
81   INTEGER            ::   numflo                 !: logical unit for drifting floats
82
83   !!----------------------------------------------------------------------
84   !!                          Run control 
85   !!----------------------------------------------------------------------
86
87   INTEGER            ::   nstop = 0                !: error flag (=number of reason for a premature stop run)
88   INTEGER            ::   nwarn = 0                !: warning flag (=number of warning found during the run)
89   CHARACTER(len=200) ::   ctmp1, ctmp2, ctmp3      !: temporary characters 1 to 3
90   CHARACTER(len=200) ::   ctmp4, ctmp5, ctmp6      !: temporary characters 4 to 6
91   CHARACTER(len=200) ::   ctmp7, ctmp8, ctmp9      !: temporary characters 7 to 9
92   CHARACTER(len=200) ::   ctmp10                   !: temporary character 10
93   CHARACTER (len=64) ::   cform_err = "(/,' ===>>> : E R R O R',     /,'         ===========',/)"       !:
94   CHARACTER (len=64) ::   cform_war = "(/,' ===>>> : W A R N I N G', /,'         ===============',/)"   !:
95   LOGICAL            ::   lwp      = .FALSE.       !: boolean : true on the 1st processor only
96   LOGICAL            ::   lsp_area = .TRUE.        !: to make a control print over a specific area
97   !!----------------------------------------------------------------------
98   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008)
99   !! $Id$
100   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
101   !!----------------------------------------------------------------------
102
103CONTAINS
104
105   SUBROUTINE ctl_stop( cd1, cd2, cd3, cd4, cd5,   &
106      &                 cd6, cd7, cd8, cd9, cd10 )
107      !!----------------------------------------------------------------------
108      !!                  ***  ROUTINE  stop_opa  ***
109      !!
110      !! ** Purpose :   print in ocean.outpput file a error message and
111      !!                increment the error number (nstop) by one.
112      !!----------------------------------------------------------------------
113      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5
114      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10
115      !!----------------------------------------------------------------------
116      !
117      nstop = nstop + 1 
118      IF(lwp) THEN
119         WRITE(numout,"(/,' ===>>> : E R R O R',     /,'         ===========',/)") 
120         IF( PRESENT(cd1 ) ) WRITE(numout,*) cd1
121         IF( PRESENT(cd2 ) ) WRITE(numout,*) cd2
122         IF( PRESENT(cd3 ) ) WRITE(numout,*) cd3
123         IF( PRESENT(cd4 ) ) WRITE(numout,*) cd4
124         IF( PRESENT(cd5 ) ) WRITE(numout,*) cd5
125         IF( PRESENT(cd6 ) ) WRITE(numout,*) cd6
126         IF( PRESENT(cd7 ) ) WRITE(numout,*) cd7
127         IF( PRESENT(cd8 ) ) WRITE(numout,*) cd8
128         IF( PRESENT(cd9 ) ) WRITE(numout,*) cd9
129         IF( PRESENT(cd10) ) WRITE(numout,*) cd10
130      ENDIF
131      CALL FLUSH(numout)
132      !
133   END SUBROUTINE ctl_stop
134
135
136   SUBROUTINE ctl_warn( cd1, cd2, cd3, cd4, cd5,   &
137      &                 cd6, cd7, cd8, cd9, cd10 )
138      !!----------------------------------------------------------------------
139      !!                  ***  ROUTINE  stop_warn  ***
140      !!
141      !! ** Purpose :   print in ocean.outpput file a error message and
142      !!                increment the warning number (nwarn) by one.
143      !!----------------------------------------------------------------------
144      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5
145      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10
146      !!----------------------------------------------------------------------
147      !
148      nwarn = nwarn + 1 
149      IF(lwp) THEN
150         WRITE(numout,"(/,' ===>>> : W A R N I N G', /,'         ===============',/)") 
151         IF( PRESENT(cd1 ) ) WRITE(numout,*) cd1
152         IF( PRESENT(cd2 ) ) WRITE(numout,*) cd2
153         IF( PRESENT(cd3 ) ) WRITE(numout,*) cd3
154         IF( PRESENT(cd4 ) ) WRITE(numout,*) cd4
155         IF( PRESENT(cd5 ) ) WRITE(numout,*) cd5
156         IF( PRESENT(cd6 ) ) WRITE(numout,*) cd6
157         IF( PRESENT(cd7 ) ) WRITE(numout,*) cd7
158         IF( PRESENT(cd8 ) ) WRITE(numout,*) cd8
159         IF( PRESENT(cd9 ) ) WRITE(numout,*) cd9
160         IF( PRESENT(cd10) ) WRITE(numout,*) cd10
161      ENDIF
162      CALL FLUSH(numout)
163      !
164   END SUBROUTINE ctl_warn
165
166
167   SUBROUTINE ctl_opn ( knum, cdfile, cdstat, cdform, cdacce, klengh, kout, ldwp, karea )
168      !!----------------------------------------------------------------------
169      !!                  ***  ROUTINE ctl_opn  ***
170      !!
171      !! ** Purpose :   Open file and check if required file is available.
172      !!
173      !! ** Method  :   Fortan open
174      !!
175      !! History :
176      !!        !  1995-12  (G. Madec)  Original code
177      !!   8.5  !  2002-06  (G. Madec)  F90: Free form and module
178      !!----------------------------------------------------------------------
179
180      INTEGER          , INTENT(  out) ::   knum      ! logical unit to open
181      CHARACTER(len=*) , INTENT(in   ) ::   cdfile    ! file name to open
182      CHARACTER(len=*) , INTENT(in   ) ::   cdstat    ! disposition specifier
183      CHARACTER(len=*) , INTENT(in   ) ::   cdform    ! formatting specifier
184      CHARACTER(len=*) , INTENT(in   ) ::   cdacce    ! access specifier
185      INTEGER          , INTENT(in   ) ::   klengh    ! record length
186      INTEGER          , INTENT(in   ) ::   kout      ! number of logical units for write
187      LOGICAL          , INTENT(in   ) ::   ldwp      ! boolean term for print
188      INTEGER, OPTIONAL, INTENT(in   ) ::   karea     ! proc number
189      !!
190      CHARACTER(len=80) ::   clfile
191      INTEGER           ::   iost
192
193      ! adapt filename
194      ! ----------------
195      clfile = TRIM(cdfile)
196      IF( PRESENT( karea ) ) THEN
197         IF( karea > 1 )   WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1
198      ENDIF
199#if defined key_agrif
200      IF( .NOT. Agrif_Root() )   clfile = TRIM(Agrif_CFixed())//'_'//TRIM(clfile)
201      knum=Agrif_Get_Unit()
202#else
203      knum=getunit()
204#endif
205
206      iost=0
207      IF( cdacce(1:6) == 'DIRECT' )  THEN
208         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost )
209      ELSE
210         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat             , ERR=100, IOSTAT=iost )
211      ENDIF
212      IF( iost == 0 ) THEN
213         IF(ldwp) THEN
214            WRITE(kout,*) '     file   : ', clfile,' open ok'
215            WRITE(kout,*) '     unit   = ', knum
216            WRITE(kout,*) '     status = ', cdstat
217            WRITE(kout,*) '     form   = ', cdform
218            WRITE(kout,*) '     access = ', cdacce
219            WRITE(kout,*)
220         ENDIF
221      ENDIF
222100   CONTINUE
223      IF( iost /= 0 ) THEN
224         IF(ldwp) THEN
225            WRITE(kout,*)
226            WRITE(kout,*) ' ===>>>> : bad opening file: ', clfile
227            WRITE(kout,*) ' =======   ===  '
228            WRITE(kout,*) '           unit   = ', knum
229            WRITE(kout,*) '           status = ', cdstat
230            WRITE(kout,*) '           form   = ', cdform
231            WRITE(kout,*) '           access = ', cdacce
232            WRITE(kout,*) '           iostat = ', iost
233            WRITE(kout,*) '           we stop. verify the file '
234            WRITE(kout,*)
235         ENDIF
236         STOP 'ctl_opn bad opening'
237      ENDIF
238     
239   END SUBROUTINE ctl_opn
240
241
242   FUNCTION getunit()
243      !!----------------------------------------------------------------------
244      !!                  ***  FUNCTION  getunit  ***
245      !!
246      !! ** Purpose :   return the index of an unused logical unit
247      !!----------------------------------------------------------------------
248      INTEGER :: getunit
249      LOGICAL :: llopn 
250      !!----------------------------------------------------------------------
251      !
252      getunit = 15   ! choose a unit that is big enough then it is not already used in NEMO
253      llopn = .TRUE.
254      DO WHILE( (getunit < 998) .AND. llopn )
255         getunit = getunit + 1
256         INQUIRE( unit = getunit, opened = llopn )
257      END DO
258      IF( (getunit == 999) .AND. llopn ) THEN
259         CALL ctl_stop( 'getunit: All logical units until 999 are used...' )
260         getunit = -1
261      ENDIF
262      !
263   END FUNCTION getunit
264
265   !!=====================================================================
266END MODULE in_out_manager
Note: See TracBrowser for help on using the repository browser.