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

Diff of /MITgcm/pkg/mnc/mnc_var.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 19:50:52 2004 UTC revision 1.5 by edhill, Thu Jan 8 07:24:47 2004 UTC
# Line 9  C======================================= Line 9  C=======================================
9       I     myThid,       I     myThid,
10       I     fname,       I     fname,
11       I     gname,       I     gname,
12         I     vname,
13         I     units )
14    
15          implicit none
16    #include "netcdf.inc"
17    
18    C     Arguments
19          integer myThid
20          character*(*) fname,gname,vname,units
21    
22          CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_DOUBLE)
23          RETURN
24          END
25    
26    C==================================================================
27    
28          SUBROUTINE MNC_VAR_INIT_REAL(
29         I     myThid,
30         I     fname,
31         I     gname,
32         I     vname,
33         I     units )
34    
35          implicit none
36    #include "netcdf.inc"
37    
38    C     Arguments
39          integer myThid
40          character*(*) fname,gname,vname,units
41    
42          CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_FLOAT)
43          RETURN
44          END
45    
46    C==================================================================
47    
48          SUBROUTINE MNC_VAR_INIT_INT(
49         I     myThid,
50         I     fname,
51         I     gname,
52         I     vname,
53         I     units )
54    
55          implicit none
56    #include "netcdf.inc"
57    
58    C     Arguments
59          integer myThid
60          character*(*) fname,gname,vname,units
61    
62          CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_INT)
63          RETURN
64          END
65    
66    C==================================================================
67    
68          SUBROUTINE MNC_VAR_INIT_ANY(
69         I     myThid,
70         I     fname,
71         I     gname,
72       I     vname,       I     vname,
73       I     fillval )       I     units,
74         I     vtype )
75    
76        implicit none        implicit none
77  #include "netcdf.inc"  #include "netcdf.inc"
# Line 19  C======================================= Line 80  C=======================================
80    
81  C     Arguments  C     Arguments
82        integer myThid        integer myThid
83        character*(*) fname        character*(*) fname,gname,vname,units
84        character*(*) gname        integer vtype
       character*(*) vname  
       _RL fillval  
85    
86  C     Functions  C     Functions
87        integer ILNBLNK        integer ILNBLNK
# Line 32  C     Local Variables Line 91  C     Local Variables
91        integer vid, nv, ind_g_finfo        integer vid, nv, ind_g_finfo
92        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
93        integer rids(10), ids(10)        integer rids(10), ids(10)
94        integer lenf,leng,lenv        integer lenf,leng,lenv,lenu
95    
96  C     Strip trailing spaces  C     Strip trailing spaces
97        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
98        leng = ILNBLNK(gname)        leng = ILNBLNK(gname)
99        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
100          lenu = ILNBLNK(units)
101    
102  C     Check that the file is open  C     Check that the file is open
103        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)
# Line 82  C     Get the grid information Line 142  C     Get the grid information
142    
143  C     Add the variable definition  C     Add the variable definition
144        CALL MNC_FILE_REDEF(myThid, fname)        CALL MNC_FILE_REDEF(myThid, fname)
145        err = NF_DEF_VAR(fid, vname, NF_DOUBLE, nd, ids, vid)        err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid)
146        write(msgbuf,'(5a)') 'defining variable ''', vname(1:lenv),        write(msgbuf,'(5a)') 'defining variable ''', vname(1:lenv),
147       &     ''' in file ''', fname(1:lenf), ''''       &     ''' in file ''', fname(1:lenf), ''''
148        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
# Line 91  C     Success, so save the variable info Line 151  C     Success, so save the variable info
151        CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_v_names, indv)        CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_v_names, indv)
152        mnc_v_names(indv)(1:lenv) = vname(1:lenv)        mnc_v_names(indv)(1:lenv) = vname(1:lenv)
153        nv = mnc_fv_ids(indf,1)        nv = mnc_fv_ids(indf,1)
154        i = 2 + nv*2        i = 2 + nv*3
155        j = i + 1        j = i + 1
156        k = i + 2        k = i + 2
157        mnc_fv_ids(indf,i) = indv        mnc_fv_ids(indf,i) = indv
# Line 99  C     Success, so save the variable info Line 159  C     Success, so save the variable info
159        mnc_fv_ids(indf,k) = ind_g_finfo        mnc_fv_ids(indf,k) = ind_g_finfo
160        mnc_fv_ids(indf,1) = nv + 1        mnc_fv_ids(indf,1) = nv + 1
161    
162    C     Add the units
163          CALL MNC_VAR_ADD_ATTR_STR(myThid, fname, vname, 'units', units)
164    
165        RETURN        RETURN
166        END        END
167    
# Line 112  C======================================= Line 175  C=======================================
175       I     sval )       I     sval )
176    
177        implicit none        implicit none
178    C     Arguments
179          integer myThid
180          character*(*) fname,vname,atname,sval
181    
182          CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,
183         &     1, sval, 0, 0.0D0, 0.0, 0)
184          RETURN
185          END
186    C==================================================================
187    
188          SUBROUTINE MNC_VAR_ADD_ATTR_DBL(
189         I     myThid,
190         I     fname,
191         I     vname,
192         I     atname,
193         I     nv,
194         I     dval )
195    
196          implicit none
197    C     Arguments
198          integer myThid,nv
199          character*(*) fname,vname,atname
200          _RL dval(*)
201    
202          CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,
203         &     2, ' ', nv, dval, 0.0, 0)
204          RETURN
205          END
206    
207    C==================================================================
208    
209          SUBROUTINE MNC_VAR_ADD_ATTR_REAL(
210         I     myThid,
211         I     fname,
212         I     vname,
213         I     atname,
214         I     nv,
215         I     rval )
216    
217          implicit none
218    C     Arguments
219          integer myThid,nv
220          character*(*) fname,vname,atname
221          _RS rval(*)
222    
223          CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,
224         &     3, ' ', nv, 0.0D0, rval, 0)
225          RETURN
226          END
227    
228    C==================================================================
229    
230          SUBROUTINE MNC_VAR_ADD_ATTR_INT(
231         I     myThid,
232         I     fname,
233         I     vname,
234         I     atname,
235         I     nv,
236         I     ival )
237    
238          implicit none
239    C     Arguments
240          integer myThid,nv
241          character*(*) fname,vname,atname
242          integer ival(*)
243    
244          CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,
245         &     4, ' ', nv, 0.0D0, 0.0, ival)
246          RETURN
247          END
248    
249    C==================================================================
250    
251          SUBROUTINE MNC_VAR_ADD_ATTR_ANY(
252         I     myThid,
253         I     fname,
254         I     vname,
255         I     atname,
256         I     atype, cs,len,dv,rv,iv )
257    
258          implicit none
259  #include "netcdf.inc"  #include "netcdf.inc"
260  #include "mnc_common.h"  #include "mnc_common.h"
261  #include "EEPARAMS.h"  #include "EEPARAMS.h"
262    
263  C     Arguments  C     Arguments
264        integer myThid        integer myThid,atype,len
265        character*(*) fname        character*(*) fname,vname,atname
266        character*(*) vname        character*(*) cs
267        character*(*) atname        _RL dv(*)
268        character*(*) sval        _RS rv(*)
269          integer iv(*)
270    
271  C     Functions  C     Functions
272        integer ILNBLNK        integer ILNBLNK
# Line 135  C     Strip trailing spaces Line 280  C     Strip trailing spaces
280        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
281        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
282        lenat = ILNBLNK(atname)        lenat = ILNBLNK(atname)
283        lens = ILNBLNK(sval)        lens = ILNBLNK(cs)
284    
285        CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)        CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)
286        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
# Line 150  C     Strip trailing spaces Line 295  C     Strip trailing spaces
295    
296  C     Set the attribute  C     Set the attribute
297        CALL MNC_FILE_REDEF(myThid, fname)        CALL MNC_FILE_REDEF(myThid, fname)
298        err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, sval)        print *, 'atype = ', atype
299          IF (atype .EQ. 1) THEN
300            err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)
301          ELSEIF (atype .EQ. 2) THEN
302            err = NF_PUT_ATT_DOUBLE(fid, vid, atname, NF_DOUBLE, len, dv)
303          ELSEIF (atype .EQ. 3) THEN
304            err = NF_PUT_ATT_REAL(fid, vid, atname, NF_FLOAT, len, rv)
305          ELSEIF (atype .EQ. 4) THEN
306            err = NF_PUT_ATT_INT(fid, vid, atname, NF_INT, len, iv)
307          ELSE
308            write(msgbuf,'(a,i10,a)') 'MNC ERROR: atype = ''', atype,
309         &       ''' is invalid--must be: [1-4]'
310            n = ILNBLNK(msgbuf)
311            CALL print_error(msgbuf(1:n), mythid)
312            stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_ANY'
313          ENDIF
314        write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),        write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),
315       &     ''' to file ''', fname(1:lenf), ''''       &     ''' to file ''', fname(1:lenf), ''''
316        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
# Line 167  C======================================= Line 327  C=======================================
327       I     var )       I     var )
328    
329        implicit none        implicit none
330    C     Arguments
331          integer myThid
332          character*(*) fname,vname
333          _RL var(*)
334    
335          CALL MNC_VAR_WRITE_ANY(myThid,fname,vname, 1, var, 0.0, 0 )
336          RETURN
337          END
338    
339    C==================================================================
340    
341          SUBROUTINE MNC_VAR_WRITE_REAL(
342         I     myThid,
343         I     fname,
344         I     vname,
345         I     var )
346    
347          implicit none
348    C     Arguments
349          integer myThid
350          character*(*) fname,vname
351          _RS var(*)
352    
353          CALL MNC_VAR_WRITE_ANY(myThid,fname,vname, 2, 0.0D0, var, 0 )
354          RETURN
355          END
356    
357    C==================================================================
358    
359          SUBROUTINE MNC_VAR_WRITE_INT(
360         I     myThid,
361         I     fname,
362         I     vname,
363         I     var )
364    
365          implicit none
366    C     Arguments
367          integer myThid
368          character*(*) fname,vname
369          integer var(*)
370    
371          CALL MNC_VAR_WRITE_ANY(myThid,fname,vname, 3, 0.0D0, 0.0, var )
372          RETURN
373          END
374    
375    C==================================================================
376    
377          SUBROUTINE MNC_VAR_WRITE_ANY(
378         I     myThid,
379         I     fname,
380         I     vname,
381         I     vtype,
382         I     dv,
383         I     rv,
384         I     iv )
385    
386          implicit none
387  #include "netcdf.inc"  #include "netcdf.inc"
388  #include "mnc_common.h"  #include "mnc_common.h"
389  #include "EEPARAMS.h"  #include "EEPARAMS.h"
390    
391  C     Arguments  C     Arguments
392        integer myThid        integer myThid, vtype
393        character*(*) fname        character*(*) fname,vname
394        character*(*) vname        _RL dv(*)
395        _RL var(*)        _RS rv(*)
396          integer iv(*)
397    
398  C     Functions  C     Functions
399        integer ILNBLNK        integer ILNBLNK
# Line 226  C     Check for the unlimited dimension Line 444  C     Check for the unlimited dimension
444        ENDIF        ENDIF
445    
446        CALL MNC_FILE_ENDDEF(myThid, fname)        CALL MNC_FILE_ENDDEF(myThid, fname)
447        err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, var)        IF (vtype .EQ. 1) THEN
448            err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)
449          ELSEIF (vtype .EQ. 2) THEN
450            err = NF_PUT_VARA_REAL(fid, vid, vstart, vcount, rv)
451          ELSEIF (vtype .EQ. 3) THEN
452            err = NF_PUT_VARA_INT(fid, vid, vstart, vcount, iv)
453          ELSE
454            write(msgbuf,'(a,i10,a)') 'MNC ERROR: vtype = ''', vtype,
455         &       ''' is invalid--must be: [1|2|3]'
456            n = ILNBLNK(msgbuf)
457            CALL print_error(msgbuf(1:n), mythid)
458            stop 'ABNORMAL END: S/R MNC_VAR_WRITE_ALL'
459          ENDIF  
460        write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),        write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),
461       &     ''' to file ''', fname(1:lenf), ''''       &     ''' to file ''', fname(1:lenf), ''''
462        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22