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/OFF_SRC – NEMO

source: trunk/NEMO/OFF_SRC/ctlopn.f90 @ 325

Last change on this file since 325 was 325, checked in by opalod, 18 years ago

Initial revision
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.6 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      IMPLICIT NONE
15
16      INTEGER, INTENT( in ) ::   &
17         knum,     & ! logical unit to open
18         krequ,    & ! =1 file required (stop if not exist)
19         !           ! =0 file not required (create the file if does not exist)
20         kout,     & ! number of logical units for write
21         klengh      ! record length
22
23      INTEGER ::   iost
24      CHARACTER (len=* ), INTENT( in ) ::   &
25         cdacce,   & ! access specifier
26         cdform,   & ! formatting specifier
27         cdstat      ! disposition specifier
28      CHARACTER (len=* ), INTENT( in ) ::   &
29         cdfile      ! file name to open
30
31      LOGICAL ::  ldwp   ! boolean term for print
32      !!----------------------------------------------------------------------
33      !!  OPA 9.0 , LOCEAN-IPSL (2005)
34      !! $Header$
35      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
36      !!----------------------------------------------------------------------
37
38
39      ! 1. Required file
40      ! ----------------
41
42      IF( krequ == 1 ) THEN
43
44         iost=0
45         IF( cdacce(1:6) == 'DIRECT' )  THEN
46            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
47               STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost )
48         ELSE
49            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
50               STATUS=cdstat, ERR=100, IOSTAT=iost)
51         ENDIF
52         IF( iost == 0 ) THEN
53            IF(ldwp) THEN
54               WRITE(kout,*) '     file   : ', cdfile,' open ok'
55               WRITE(kout,*) '     unit   = ', knum
56               WRITE(kout,*) '     status = ', cdstat
57               WRITE(kout,*) '     form   = ', cdform
58               WRITE(kout,*) '     access = ', cdacce
59               WRITE(kout,*)
60            ENDIF
61         ENDIF
62100      CONTINUE
63         IF( iost /= 0 ) THEN
64            IF(ldwp) THEN
65               WRITE(kout,*)
66               WRITE(kout,*) ' ===>>>> : bad opening file: ', cdfile
67               WRITE(kout,*) ' =======   ===  '
68               WRITE(kout,*) '           unit   = ', knum
69               WRITE(kout,*) '           status = ', cdstat
70               WRITE(kout,*) '           form   = ', cdform
71               WRITE(kout,*) '           access = ', cdacce
72               WRITE(kout,*) '           iostat = ', iost
73               WRITE(kout,*) '           we stop. verify the file '
74               WRITE(kout,*)
75            ENDIF
76            STOP 'ctlopn bad opening'
77         ENDIF
78         
79         
80         ! 2. Not required, file create if not exist
81         ! -----------------------------------------
82         
83      ELSEIF( krequ == 0 ) THEN
84
85         iost = 0
86         IF( cdacce(1:6) == 'DIRECT' ) THEN
87            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
88               STATUS=cdstat, RECL=klengh, ERR=200, IOSTAT=iost )
89         ELSE
90            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
91               STATUS=cdstat, ERR=200, IOSTAT=iost )
92         ENDIF
93         IF(iost == 0) THEN
94            IF(ldwp) THEN
95               WRITE(kout,*) '     file   : ', cdfile,' open ok'
96               WRITE(kout,*) '     unit   = ', knum
97               WRITE(kout,*) '     status = ', cdstat
98               WRITE(kout,*) '     form   = ', cdform
99               WRITE(kout,*) '     access = ', cdacce
100               WRITE(kout,*)
101            ENDIF
102         ENDIF
103200      CONTINUE
104         IF( iost /= 0 ) THEN
105            iost = 0
106            IF(ldwp) THEN
107               WRITE(kout,*)
108               WRITE(kout,*) '     ===>>>> : file ', cdfile,   &
109                  ' does not exist: it is created'
110               WRITE(kout,*) ' =======   ===  '
111            ENDIF
112            IF( cdacce(1:6) == 'DIRECT' ) THEN
113               OPEN( UNIT=knum, FILE=cdfile, FORM=cdform,   &
114                  ACCESS=cdacce, STATUS=cdstat,   &
115                  RECL=klengh, ERR=210, IOSTAT=iost )
116            ELSE
117               OPEN( UNIT=knum, FILE=cdfile, FORM=cdform,   &
118                  ACCESS=cdacce, STATUS=cdstat, ERR=210,   &
119                  IOSTAT=iost )
120            ENDIF
121            IF(ldwp) THEN
122               WRITE(kout,*) '     file   : ', cdfile,' open ok'
123               WRITE(kout,*) '     unit   = ', knum
124               WRITE(kout,*) '     status = ', cdstat
125               WRITE(kout,*) '     form   = ', cdform
126               WRITE(kout,*) '     access = ', cdacce
127               WRITE(kout,*)
128            ENDIF
129210         CONTINUE
130            IF( iost /= 0 ) THEN
131               IF(ldwp) THEN
132                  WRITE(kout,*) ' logical unit ',knum,' iostat = ', iost
133                  WRITE(kout,*) ' we stop. verify the file ', cdfile
134                  WRITE(kout,*)
135               ENDIF
136               STOP '001'
137            ENDIF
138         ENDIF
139         
140      ELSE
141         
142         IF(ldwp) THEN
143            WRITE(kout,*)
144            WRITE(kout,*) ' ctlopn : invalid option, krequ = ', krequ
145            WRITE(kout,*) ' ~~~~~~   call for file ', cdfile
146            WRITE(kout,*)
147         ENDIF
148
149
150         STOP 'ctlopn invalid option'
151      ENDIF
152     
153   END SUBROUTINE ctlopn
Note: See TracBrowser for help on using the repository browser.