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

Last change on this file since 1601 was 1601, checked in by ctlod, 15 years ago

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