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

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

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

revision 1.4 by edhill, Wed Jan 7 07:29:12 2004 UTC revision 1.5 by edhill, Thu Jan 8 07:24:47 2004 UTC
# Line 92  C======================================= Line 92  C=======================================
92       I     sval )       I     sval )
93    
94        implicit none        implicit none
 #include "netcdf.inc"  
 #include "mnc_common.h"  
 #include "EEPARAMS.h"  
   
95  C     Arguments  C     Arguments
96        integer myThid        integer myThid, len
97        character*(*) fname        character*(*) fname, atname, sval
       character*(*) atname  
       character*(*) sval  
   
 C     Functions  
       integer ILNBLNK  
   
 C     Local Variables  
       integer i, err, fid, ind, n1,n2  
       character*(MNC_MAX_CHAR) s1, s2  
       character*(MAX_LEN_MBUF) msgbuf  
       character*(MAX_LEN_MBUF) name  
98    
99  C     Is the file open?        CALL MNC_FILE_ADD_ATTR_ANY(myThid,fname,atname, 1,
100        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, ind)       &     sval, 0, 0.0D0, 0.0, 0 )
101        IF (ind .LT. 1) THEN        RETURN
102          write(msgbuf,'(3a)') 'MNC ERROR: file ''',        END
      &       fname, ''' must be opened first'  
         CALL print_error( msgbuf, mythid )  
         stop 'ABNORMAL END: S/R MNC_FILE_ADD_ATTR_STR'  
       ENDIF  
       fid = mnc_f_info(ind,2)  
103    
104  C     Enter define mode  C==================================================================
       CALL MNC_FILE_REDEF(myThid, fname)  
105    
106        s1(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)        SUBROUTINE MNC_FILE_ADD_ATTR_DBL(
107        s2(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)       I     myThid,
108        n1 = ILNBLNK(atname)       I     fname,
109        n2 = ILNBLNK(sval)       I     atname,
110        s1(1:n1) = atname(1:n1)       I     len,
111        s2(1:n2) = sval(1:n2)       I     dval )
112    
113        err = NF_PUT_ATT_TEXT(fid, NF_GLOBAL, s1, n2, s2)        implicit none
114        CALL MNC_HANDLE_ERR(myThid, err,  C     Arguments
115       &     'adding attribute in S/R MNC_FILE_ADD_ATTR_STR')        integer myThid, len
116          character*(*) fname, atname
117          _RL dval
118    
119          CALL MNC_FILE_ADD_ATTR_ANY(myThid,fname,atname, 2,
120         &     ' ', len, dval, 0.0, 0 )
121        RETURN        RETURN
122        END        END
123    
124  C==================================================================  C==================================================================
125    
126        SUBROUTINE MNC_FILE_ADD_ATTR_INT(        SUBROUTINE MNC_FILE_ADD_ATTR_REAL(
127       I     myThid,       I     myThid,
128       I     fname,       I     fname,
129       I     atname,       I     atname,
130       I     ival )       I     len,
131         I     rval )
132    
133        implicit none        implicit none
 #include "netcdf.inc"  
 #include "mnc_common.h"  
 #include "EEPARAMS.h"  
   
134  C     Arguments  C     Arguments
135        integer myThid        integer myThid, len
136        character*(*) fname, atname        character*(*) fname, atname
137        integer ival        _RS rval
138    
139  C     Functions        CALL MNC_FILE_ADD_ATTR_ANY(myThid,fname,atname, 3,
140        integer ILNBLNK       &     ' ', len, 0.0D0, rval, 0 )
141          RETURN
142  C     Local Variables        END
       integer i, err, fid, ind, n1,n2  
       character*(MNC_MAX_CHAR) s1  
       character*(MAX_LEN_MBUF) msgbuf  
   
 C     Is the file open?  
       CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, ind)  
       IF ( ind .GT. 0 ) THEN  
         write(msgbuf,'(3a)') 'MNC ERROR: file ''',  
      &       fname, ''' must be opened first'  
         CALL print_error( msgbuf, mythid )  
         stop 'ABNORMAL END: S/R MNC_FILE_ADD_ATTR_INT'  
       ENDIF  
       fid = mnc_f_info(ind,2)  
143    
144  C     Enter define mode  C==================================================================
       CALL MNC_FILE_REDEF(myThid, fname)  
145    
146        s1(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)        SUBROUTINE MNC_FILE_ADD_ATTR_INT(
147        n1 = ILNBLNK(atname)       I     myThid,
148        s1(1:n1) = atname(1:n1)       I     fname,
149         I     atname,
150         I     len,
151         I     ival )
152    
153        err = NF_PUT_ATT_INT(fid, NF_GLOBAL, s1, NF_INT, ival)        implicit none
154        CALL MNC_HANDLE_ERR(myThid, err,  C     Arguments
155       &     'adding attribute in S/R MNC_FILE_ADD_ATTR_INT')        integer myThid, len, ival
156          character*(*) fname, atname
157    
158          CALL MNC_FILE_ADD_ATTR_ANY(myThid,fname,atname, 4,
159         &     ' ', len, 0.0D0, 0.0, ival )
160        RETURN        RETURN
161        END        END
162    
163  C==================================================================  C==================================================================
164    
165        SUBROUTINE MNC_FILE_ADD_ATTR_DBL(        SUBROUTINE MNC_FILE_ADD_ATTR_ANY(
166       I     myThid,       I     myThid,
167       I     fname,       I     fname,
168       I     atname,       I     atname,
169       I     dval )       I     atype, sv, len,dv,rv,iv )
170    
171          implicit none
172  #include "netcdf.inc"  #include "netcdf.inc"
173  #include "mnc_common.h"  #include "mnc_common.h"
174  #include "EEPARAMS.h"  #include "EEPARAMS.h"
175    
176  C     Arguments  C     Arguments
177        integer myThid        integer myThid, atype, len, iv
178        character*(*) fname, atname        character*(*) fname, atname, sv
179        _RL dval        _RL dv
180          _RS rv
181          
182  C     Functions  C     Functions
183        integer ILNBLNK        integer ILNBLNK
184    
185  C     Local Variables  C     Local Variables
186        integer i, err, fid, ind, n1,n2        integer i, n, err, fid, ind, n1,n2, lens
187        character*(MNC_MAX_CHAR) s1        character*(MNC_MAX_CHAR) s1
188        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
189                
# Line 230  C     Enter define mode Line 204  C     Enter define mode
204        n1 = ILNBLNK(atname)        n1 = ILNBLNK(atname)
205        s1(1:n1) = atname(1:n1)        s1(1:n1) = atname(1:n1)
206    
207        err = NF_PUT_ATT_DOUBLE(fid, NF_GLOBAL, s1, NF_DOUBLE, ival)        IF (atype .EQ. 1) THEN
208            lens = ILNBLNK(sv)
209            err = NF_PUT_ATT_TEXT(fid, NF_GLOBAL, s1, lens, sv)
210          ELSEIF (atype .EQ. 2) THEN
211            err = NF_PUT_ATT_DOUBLE(fid, NF_GLOBAL, s1, NF_DOUBLE, len, dv)
212          ELSEIF (atype .EQ. 3) THEN
213            err = NF_PUT_ATT_REAL(fid, NF_GLOBAL, s1, NF_FLOAT, len, rv)
214          ELSEIF (atype .EQ. 4) THEN
215            err = NF_PUT_ATT_INT(fid, NF_GLOBAL, s1, NF_INT, len, iv)
216          ELSE
217            write(msgbuf,'(a,i10,a)') 'MNC ERROR: atype = ''', atype,
218         &       ''' is invalid--must be: [1-4]'
219            n = ILNBLNK(msgbuf)
220            CALL print_error(msgbuf(1:n), mythid)
221            stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_ANY'
222          ENDIF
223        CALL MNC_HANDLE_ERR(myThid, err,        CALL MNC_HANDLE_ERR(myThid, err,
224       &     'adding attribute in S/R MNC_FILE_ADD_ATTR_DBL')       &     'adding attribute in S/R MNC_FILE_ADD_ATTR_DBL')
225    
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22