/[MITgcm]/MITgcm/pkg/mnc/mnc_file.F
ViewVC logotype

Annotation of /MITgcm/pkg/mnc/mnc_file.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.2 - (hide annotations) (download)
Mon Jan 5 21:38:27 2004 UTC (20 years, 4 months ago) by edhill
Branch: MAIN
Changes since 1.1: +2 -2 lines 
 o add testing skeleton
1 edhill 1.2 C $Header: /u/u3/gcmpack/MITgcm/pkg/mnc/mnc_file.F,v 1.1 2004/01/05 06:20:07 edhill Exp $
2 edhill 1.1 C $Name: $
3    
4     #include "MNC_OPTIONS.h"
5    
6     C==================================================================
7    
8     SUBROUTINE MNC_FILE_OPEN(
9     I myThid,
10     I fname,
11     I itype )
12    
13     implicit none
14     #include "netcdf.inc"
15     #include "mnc_common.h"
16     #include "EEPARAMS.h"
17    
18     C Arguments
19     integer myThid
20     character*(*) fname
21     integer itype
22     C itype => [ 0=new | 1=append ]
23    
24     C Local Variables
25     integer i, err, fid, ind
26     character*(MNC_MAX_CHAR) aname
27     character*(MAX_LEN_MBUF) msgbuf
28    
29     C Is the file already open?
30     CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, ind)
31     IF ( ind .GT. 0 ) THEN
32     write(msgbuf,'(3a)') 'MNC_FILE_OPEN ERROR: ''', fname,
33     & ''' is already open -- cannot open twice'
34     CALL print_error( msgbuf, mythid )
35     stop 'ABNORMAL END: package MNC'
36     ENDIF
37    
38     IF ( itype .EQ. 0 ) THEN
39     C Create new file
40     err = NF_CREATE( fname, NF_CLOBBER, fid )
41     IF (err .NE. NF_NOERR) CALL MNC_HANDLE_ERR(myThid, err)
42     ELSEIF ( itype .EQ. 1 ) THEN
43     C Append to existing file
44     err = NF_OPEN( fname, NF_WRITE, fid )
45     IF (err .NE. NF_NOERR) CALL MNC_HANDLE_ERR(myThid, err)
46     ELSE
47     C Error
48     write(msgbuf,'(a,i5,a)') 'MNC_FILE_OPEN ERROR: ''', itype,
49     & ''' is not defined--should be: [0|1]'
50     ENDIF
51    
52     CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_f_names, ind)
53     mnc_f_names(ind) = fname
54     mnc_f_info(ind,1) = 1
55     mnc_f_info(ind,1) = fid
56    
57     END
58    
59     C==================================================================
60    
61     SUBROUTINE MNC_FILE_ADD_ATTR_STR(
62     I myThid,
63     I fname,
64     I atname,
65     I sval )
66    
67     implicit none
68     #include "netcdf.inc"
69     #include "mnc_common.h"
70     #include "EEPARAMS.h"
71    
72     C Arguments
73     integer myThid
74     character*(*) fname
75     character*(*) atname
76     character*(*) sval
77    
78     C Functions
79     integer ILNBLNK
80    
81     C Local Variables
82     integer i, err, fid, ind, n1,n2
83     character*(MNC_MAX_CHAR) s1, s2
84     character*(MAX_LEN_MBUF) msgbuf
85    
86     C Is the file open?
87     CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, ind)
88     IF ( ind .GT. 0 ) THEN
89     write(msgbuf,'(3a)') 'MNC ERROR: file ''',
90     & fname, ''' must be opened first'
91     CALL print_error( msgbuf, mythid )
92     stop 'ABNORMAL END: S/R MNC_FILE_ADD_ATTR_STR'
93     ENDIF
94     fid = mnc_f_info(ind,2)
95    
96     C Enter define mode
97     err = NF_REDEF(fid)
98     IF (err .NE. NF_NOERR) CALL MNC_HANDLE_ERR(myThid, err)
99    
100     s1(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
101     s2(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
102     n1 = ILNBLNK(atname)
103     n2 = ILNBLNK(sval)
104     s1(1:n1) = atname(1:n1)
105     s2(1:n2) = sval(1:n2)
106    
107     err = NF_PUT_ATT_TEXT(fid, NF_GLOBAL, s1, n2, s2)
108     IF (err .NE. NF_NOERR) CALL MNC_HANDLE_ERR(myThid, err)
109    
110     END
111    
112     C==================================================================
113    
114     SUBROUTINE MNC_FILE_ADD_ATTR_INT(
115     I myThid,
116     I fname,
117     I atname,
118     I ival )
119    
120     implicit none
121     #include "netcdf.inc"
122     #include "mnc_common.h"
123     #include "EEPARAMS.h"
124    
125     C Arguments
126     integer myThid
127     character*(*) fname, atname
128     integer ival
129    
130     C Functions
131     integer ILNBLNK
132    
133     C Local Variables
134     integer i, err, fid, ind, n1,n2
135     character*(MNC_MAX_CHAR) s1
136     character*(MAX_LEN_MBUF) msgbuf
137    
138     C Is the file open?
139     CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, ind)
140     IF ( ind .GT. 0 ) THEN
141     write(msgbuf,'(3a)') 'MNC ERROR: file ''',
142     & fname, ''' must be opened first'
143     CALL print_error( msgbuf, mythid )
144     stop 'ABNORMAL END: S/R MNC_FILE_ADD_ATTR_INT'
145     ENDIF
146     fid = mnc_f_info(ind,2)
147    
148     C Enter define mode
149     err = NF_REDEF(fid)
150     IF (err .NE. NF_NOERR) CALL MNC_HANDLE_ERR(myThid, err)
151    
152     s1(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
153     n1 = ILNBLNK(atname)
154     s1(1:n1) = atname(1:n1)
155    
156     err = NF_PUT_ATT_INT(fid, NF_GLOBAL, s1, NF_INT, ival)
157     IF (err .NE. NF_NOERR) CALL MNC_HANDLE_ERR(myThid, err)
158    
159     END
160    
161     C==================================================================
162    
163     SUBROUTINE MNC_FILE_ADD_ATTR_DBL(
164     I myThid,
165     I fname,
166     I atname,
167     I dval )
168    
169     #include "netcdf.inc"
170     #include "mnc_common.h"
171     #include "EEPARAMS.h"
172    
173     C Arguments
174     integer myThid
175     character*(*) fname, atname
176     _RL dval
177    
178     C Functions
179     integer ILNBLNK
180    
181     C Local Variables
182     integer i, err, fid, ind, n1,n2
183     character*(MNC_MAX_CHAR) s1
184     character*(MAX_LEN_MBUF) msgbuf
185    
186    
187     C Is the file open?
188     CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, ind)
189     IF ( ind .GT. 0 ) THEN
190     write(msgbuf,'(3a)') 'MNC ERROR: file ''',
191     & fname, ''' must be opened first'
192     CALL print_error( msgbuf, mythid )
193     stop 'ABNORMAL END: S/R MNC_FILE_ADD_ATTR_INT'
194     ENDIF
195 edhill 1.2 fid = mnc_f_info(ind,2)
196 edhill 1.1
197     C Enter define mode
198     err = NF_REDEF(fid)
199     IF (err .NE. NF_NOERR) CALL MNC_HANDLE_ERR(myThid, err)
200    
201     s1(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
202     n1 = ILNBLNK(atname)
203     s1(1:n1) = atname(1:n1)
204    
205     err = NF_PUT_ATT_DOUBLE(fid, NF_GLOBAL, s1, NF_DOUBLE, ival)
206     IF (err .NE. NF_NOERR) CALL MNC_HANDLE_ERR(myThid, err)
207    
208     END
209    
  ViewVC Help
Powered by ViewVC 1.1.22