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.
ctlopn.F90 in trunk/NEMO/OPA_SRC – NEMO

source: trunk/NEMO/OPA_SRC/ctlopn.F90 @ 1057

Last change on this file since 1057 was 719, checked in by ctlod, 17 years ago

get back to the nemo_v2_3 version for trunk
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 6.0 KB
Line 
1   SUBROUTINE ctlopn ( knum, cdfile, cdstat, cdform, cdacce,   &
2                       klengh, kout, ldwp, krequ )
3      !!----------------------------------------------------------------------
4      !!                  ***  ROUTINE ctlopn  ***
5      !!
6      !! ** Purpose :   Open file and check if required file is available.
7      !!
8      !! ** Method  :   Fortan open
9      !!
10      !! History :
11      !!        !  95-12  (G. Madec)  Original code
12      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
13      !!----------------------------------------------------------------------
14#if defined key_agrif
15      USE Agrif_Util
16#endif
17      USE in_out_manager
18      IMPLICIT NONE
19
20      INTEGER, INTENT( out ) ::   &
21         knum      ! logical unit to open
22      INTEGER, INTENT( in ) ::   &
23         krequ,    & ! =1 file required (stop if not exist)
24         !           ! =0 file not required (create the file if does not exist)
25         kout,     & ! number of logical units for write
26         klengh      ! record length
27      CHARACTER (len=* ), INTENT( in ) ::   &
28         cdacce,   & ! access specifier
29         cdform,   & ! formatting specifier
30         cdstat      ! disposition specifier
31#if !defined key_agrif
32      CHARACTER (len=* ), INTENT( in ) ::   &
33         cdfile      ! file name to open
34#else
35      CHARACTER (len=* ), INTENT( inout ) ::   &
36         cdfile      ! file name to open
37#endif
38
39      INTEGER ::   iost
40      LOGICAL ::  ldwp   ! boolean term for print
41
42      !!----------------------------------------------------------------------
43      !!  OPA 9.0 , LOCEAN-IPSL (2005)
44      !! $Header$
45      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
46      !!----------------------------------------------------------------------
47
48#if defined key_agrif
49      if ( .NOT. Agrif_Root() ) then
50         cdfile= TRIM(Agrif_CFixed())//'_'//TRIM(cdfile)
51      endif
52        knum=Agrif_Get_Unit()
53#else
54        knum=getunit()
55#endif
56
57      ! 1. Required file
58      ! ----------------
59
60      IF( krequ == 1 ) THEN
61
62         iost=0
63         IF( cdacce(1:6) == 'DIRECT' )  THEN
64            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
65               STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost )
66         ELSE
67            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
68               STATUS=cdstat, ERR=100, IOSTAT=iost)
69         ENDIF
70         IF( iost == 0 ) THEN
71            IF(ldwp) THEN
72               WRITE(kout,*) '     file   : ', cdfile,' open ok'
73               WRITE(kout,*) '     unit   = ', knum
74               WRITE(kout,*) '     status = ', cdstat
75               WRITE(kout,*) '     form   = ', cdform
76               WRITE(kout,*) '     access = ', cdacce
77               WRITE(kout,*)
78            ENDIF
79         ENDIF
80100      CONTINUE
81         IF( iost /= 0 ) THEN
82            IF(ldwp) THEN
83               WRITE(kout,*)
84               WRITE(kout,*) ' ===>>>> : bad opening file: ', cdfile
85               WRITE(kout,*) ' =======   ===  '
86               WRITE(kout,*) '           unit   = ', knum
87               WRITE(kout,*) '           status = ', cdstat
88               WRITE(kout,*) '           form   = ', cdform
89               WRITE(kout,*) '           access = ', cdacce
90               WRITE(kout,*) '           iostat = ', iost
91               WRITE(kout,*) '           we stop. verify the file '
92               WRITE(kout,*)
93            ENDIF
94            STOP 'ctlopn bad opening'
95         ENDIF
96         
97         
98         ! 2. Not required, file create if not exist
99         ! -----------------------------------------
100         
101      ELSEIF( krequ == 0 ) THEN
102
103         iost = 0
104         IF( cdacce(1:6) == 'DIRECT' ) THEN
105            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
106               STATUS=cdstat, RECL=klengh, ERR=200, IOSTAT=iost )
107         ELSE
108            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
109               STATUS=cdstat, ERR=200, IOSTAT=iost )
110         ENDIF
111         IF(iost == 0) THEN
112            IF(ldwp) THEN
113               WRITE(kout,*) '     file   : ', cdfile,' open ok'
114               WRITE(kout,*) '     unit   = ', knum
115               WRITE(kout,*) '     status = ', cdstat
116               WRITE(kout,*) '     form   = ', cdform
117               WRITE(kout,*) '     access = ', cdacce
118               WRITE(kout,*)
119            ENDIF
120         ENDIF
121200      CONTINUE
122         IF( iost /= 0 ) THEN
123            iost = 0
124            IF(ldwp) THEN
125               WRITE(kout,*)
126               WRITE(kout,*) '     ===>>>> : file ', cdfile,   &
127                  ' does not exist: it is created'
128               WRITE(kout,*) ' =======   ===  '
129            ENDIF
130            IF( cdacce(1:6) == 'DIRECT' ) THEN
131               OPEN( UNIT=knum, FILE=cdfile, FORM=cdform,   &
132                  ACCESS=cdacce, STATUS=cdstat,   &
133                  RECL=klengh, ERR=210, IOSTAT=iost )
134            ELSE
135               OPEN( UNIT=knum, FILE=cdfile, FORM=cdform,   &
136                  ACCESS=cdacce, STATUS=cdstat, ERR=210,   &
137                  IOSTAT=iost )
138            ENDIF
139            IF(ldwp) THEN
140               WRITE(kout,*) '     file   : ', cdfile,' open ok'
141               WRITE(kout,*) '     unit   = ', knum
142               WRITE(kout,*) '     status = ', cdstat
143               WRITE(kout,*) '     form   = ', cdform
144               WRITE(kout,*) '     access = ', cdacce
145               WRITE(kout,*)
146            ENDIF
147210         CONTINUE
148            IF( iost /= 0 ) THEN
149               IF(ldwp) THEN
150                  WRITE(kout,*) ' logical unit ',knum,' iostat = ', iost
151                  WRITE(kout,*) ' we stop. verify the file ', cdfile
152                  WRITE(kout,*)
153               ENDIF
154               STOP '001'
155            ENDIF
156         ENDIF
157         
158      ELSE
159         
160         IF(ldwp) THEN
161            WRITE(kout,*)
162            WRITE(kout,*) ' ctlopn : invalid option, krequ = ', krequ
163            WRITE(kout,*) ' ~~~~~~   call for file ', cdfile
164            WRITE(kout,*)
165         ENDIF
166
167
168         STOP 'ctlopn invalid option'
169      ENDIF
170     
171   END SUBROUTINE ctlopn
Note: See TracBrowser for help on using the repository browser.