/[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.3 by edhill, Wed Jan 7 07:29:13 2004 UTC revision 1.11 by edhill, Tue Jan 27 05:47:33 2004 UTC
# Line 3  C $Name$ Line 3  C $Name$
3                
4  #include "MNC_OPTIONS.h"  #include "MNC_OPTIONS.h"
5                
6  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7    
8        SUBROUTINE MNC_VAR_INIT_DBL(        SUBROUTINE MNC_VAR_INIT_DBL(
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---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
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---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
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---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
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
88    
89  C     Local Variables  C     Local Variables
90        integer i,j,k, n, indf,indv, fid, nd, ngrid, is,ie, err        integer i,j,k, n, indf,indv, fid, nd, ngrid, is,ie, err
91        integer vid, nv        integer vid, nv, ind_g_finfo, needed
92        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
93        integer rids(10), ids(10)        integer ids(20)
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 45  C     Check that the file is open Line 105  C     Check that the file is open
105          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname,          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname,
106       &       ''' must be opened first'       &       ''' must be opened first'
107          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
108          stop 'ABNORMAL END: S/R MNC_VAR_INIT_DBL'          stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
109        ENDIF        ENDIF
110        fid = mnc_f_info(indf,2)        fid = mnc_f_info(indf,2)
111    
112    C     Check for sufficient storage space in mnc_fv_ids
113          needed = 1 + 3*(mnc_fv_ids(indf,1) + 1)
114          IF (needed .GE. MNC_MAX_INFO) THEN
115            write(msgbuf,'(2a,i7,a)') 'MNC ERROR: MNC_MAX_INFO exceeded',
116         &       ': please increase it to ', 2*MNC_MAX_INFO,
117         &       ' in the file ''pkg/mnc/mnc_common.h'''
118            CALL print_error(msgbuf, mythid)
119            stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
120          ENDIF
121    
122  C     Get the grid information  C     Get the grid information
123        ngrid = mnc_f_info(indf,3)        ngrid = mnc_f_info(indf,3)
124        IF (ngrid .LT. 1) THEN        IF (ngrid .LT. 1) THEN
125          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:lenf),          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:lenf),
126       &       ''' contains NO grids'       &       ''' contains NO grids'
127          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
128          stop 'ABNORMAL END: S/R MNC_VAR_INIT_DBL'          stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
129        ENDIF        ENDIF
130        DO i = 1,ngrid        DO i = 1,ngrid
131          j = 4 + (i-1)*3          j = 4 + (i-1)*3
# Line 63  C     Get the grid information Line 133  C     Get the grid information
133          n = ILNBLNK(mnc_g_names(k))          n = ILNBLNK(mnc_g_names(k))
134          IF ((leng .EQ. n)          IF ((leng .EQ. n)
135       &       .AND. (mnc_g_names(k)(1:n) .EQ. gname(1:n))) THEN       &       .AND. (mnc_g_names(k)(1:n) .EQ. gname(1:n))) THEN
136              ind_g_finfo = j
137            is = mnc_f_info(indf,(j+1))            is = mnc_f_info(indf,(j+1))
138            ie = mnc_f_info(indf,(j+2))            ie = mnc_f_info(indf,(j+2))
139            nd = 0            nd = 0
140            DO k = is,ie            DO k = is,ie
141              nd = nd + 1              nd = nd + 1
142              ids(nd) = mnc_fg_ids(indf,k)              ids(nd) = mnc_d_ids(mnc_fd_ind(indf,k))
143            ENDDO            ENDDO
144            GOTO 10            GOTO 10
145          ENDIF          ENDIF
# Line 76  C     Get the grid information Line 147  C     Get the grid information
147        write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),        write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
148       &     ''' does not contain grid ''', gname(1:leng), ''''       &     ''' does not contain grid ''', gname(1:leng), ''''
149        CALL print_error(msgbuf, mythid)        CALL print_error(msgbuf, mythid)
150        stop 'ABNORMAL END: S/R MNC_VAR_INIT_DBL'        stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
151   10   CONTINUE   10   CONTINUE
152    
153  C     Add the variable definition  C     Add the variable definition
154        CALL MNC_FILE_REDEF(myThid, fname)        CALL MNC_FILE_REDEF(myThid, fname)
155        err = NF_DEF_VAR(fid, vname, NF_DOUBLE, nd, ids, vid)        err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid)
156        write(msgbuf,'(5a)') 'defining variable ''', vname(1:lenv),        write(msgbuf,'(5a)') 'defining variable ''', vname(1:lenv),
157       &     ''' in file ''', fname(1:lenf), ''''       &     ''' in file ''', fname(1:lenf), ''''
158        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
# Line 90  C     Success, so save the variable info Line 161  C     Success, so save the variable info
161        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)
162        mnc_v_names(indv)(1:lenv) = vname(1:lenv)        mnc_v_names(indv)(1:lenv) = vname(1:lenv)
163        nv = mnc_fv_ids(indf,1)        nv = mnc_fv_ids(indf,1)
164        i = 2 + nv*2        i = 2 + nv*3
165        j = i + 1        mnc_fv_ids(indf,i)   = indv
166        mnc_fv_ids(indf,i) = indv        mnc_fv_ids(indf,i+1) = vid
167        mnc_fv_ids(indf,j) = vid        mnc_fv_ids(indf,i+2) = ind_g_finfo
168        mnc_fv_ids(indf,1) = nv + 1        mnc_fv_ids(indf,1) = nv + 1
169    
170    C     Add the units
171          CALL MNC_VAR_ADD_ATTR_STR(myThid, fname, vname, 'units', units)
172    
173        RETURN        RETURN
174        END        END
175    
176  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
177    
178        SUBROUTINE MNC_VAR_ADD_ATTR_STR(        SUBROUTINE MNC_VAR_ADD_ATTR_STR(
179       I     myThid,       I     myThid,
# Line 109  C======================================= Line 183  C=======================================
183       I     sval )       I     sval )
184    
185        implicit none        implicit none
186    C     Arguments
187          integer myThid
188          character*(*) fname,vname,atname,sval
189    
190          CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,
191         &     1, sval, 0, 0.0D0, 0.0, 0)
192          RETURN
193          END
194    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
195    
196          SUBROUTINE MNC_VAR_ADD_ATTR_DBL(
197         I     myThid,
198         I     fname,
199         I     vname,
200         I     atname,
201         I     nv,
202         I     dval )
203    
204          implicit none
205    C     Arguments
206          integer myThid,nv
207          character*(*) fname,vname,atname
208          REAL*8 dval(*)
209    
210          CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,
211         &     2, ' ', nv, dval, 0.0, 0)
212          RETURN
213          END
214    
215    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
216    
217          SUBROUTINE MNC_VAR_ADD_ATTR_REAL(
218         I     myThid,
219         I     fname,
220         I     vname,
221         I     atname,
222         I     nv,
223         I     rval )
224    
225          implicit none
226    C     Arguments
227          integer myThid,nv
228          character*(*) fname,vname,atname
229          REAL*4 rval(*)
230    
231          CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,
232         &     3, ' ', nv, 0.0D0, rval, 0)
233          RETURN
234          END
235    
236    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
237    
238          SUBROUTINE MNC_VAR_ADD_ATTR_INT(
239         I     myThid,
240         I     fname,
241         I     vname,
242         I     atname,
243         I     nv,
244         I     ival )
245    
246          implicit none
247    C     Arguments
248          integer myThid,nv
249          character*(*) fname,vname,atname
250          integer ival(*)
251    
252          CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,
253         &     4, ' ', nv, 0.0D0, 0.0, ival)
254          RETURN
255          END
256    
257    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
258    
259          SUBROUTINE MNC_VAR_ADD_ATTR_ANY(
260         I     myThid,
261         I     fname,
262         I     vname,
263         I     atname,
264         I     atype, cs,len,dv,rv,iv )
265    
266          implicit none
267  #include "netcdf.inc"  #include "netcdf.inc"
268  #include "mnc_common.h"  #include "mnc_common.h"
269  #include "EEPARAMS.h"  #include "EEPARAMS.h"
270    
271  C     Arguments  C     Arguments
272        integer myThid        integer myThid,atype,len
273        character*(*) fname        character*(*) fname,vname,atname
274        character*(*) vname        character*(*) cs
275        character*(*) atname        REAL*8 dv(*)
276        character*(*) sval        REAL*4 rv(*)
277          integer iv(*)
278    
279  C     Functions  C     Functions
280        integer ILNBLNK        integer ILNBLNK
281    
282  C     Local Variables  C     Local Variables
283        integer i,j,k, n, nv, indf, fid,vid, err        integer n, indf,ind_fv_ids, fid,vid, err
284        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
285        integer lenf,lenv,lenat,lens        integer lenf,lenv,lenat,lens
286    
# Line 132  C     Strip trailing spaces Line 288  C     Strip trailing spaces
288        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
289        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
290        lenat = ILNBLNK(atname)        lenat = ILNBLNK(atname)
291        lens = ILNBLNK(sval)        lens = ILNBLNK(cs)
292    
293  C     Check that the file is open        CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)
294        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
295        IF (indf .LT. 1) THEN          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
296          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:lenf),       &       ''' is not open or does not contain variable ''',
297       &       ''' must be opened first'       &       vname(1:lenv), ''''
298          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
299          stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_STR'          stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_STR'
300        ENDIF        ENDIF
301        fid = mnc_f_info(indf,2)        fid = mnc_f_info(indf,2)
302          vid = mnc_fv_ids(indf,(ind_fv_ids+1))
 C     Find the vID  
       nv = mnc_fv_ids(indf,1)  
       DO i = 1,nv  
         k = 2*i  
         j = mnc_fv_ids(indf,k)  
         n = ILNBLNK(mnc_v_names(j))  
         IF ((n .EQ. lenv)  
      &       .AND. (mnc_v_names(j)(1:n) .EQ. vname(1:n))) THEN  
           k = k + 1  
           vid = mnc_fv_ids(indf,k)  
           GOTO 10  
         ENDIF  
       ENDDO  
       write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),  
      &     ''' does not contain variable ''', vname(1:lenv), ''''  
       CALL print_error(msgbuf, mythid)  
       stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_STR'  
  10   CONTINUE  
303    
304  C     Set the attribute  C     Set the attribute
305        CALL MNC_FILE_REDEF(myThid, fname)        CALL MNC_FILE_REDEF(myThid, fname)
306        err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, sval)        IF (atype .EQ. 1) THEN
307            err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)
308          ELSEIF (atype .EQ. 2) THEN
309            err = NF_PUT_ATT_DOUBLE(fid, vid, atname, NF_DOUBLE, len, dv)
310          ELSEIF (atype .EQ. 3) THEN
311            err = NF_PUT_ATT_REAL(fid, vid, atname, NF_FLOAT, len, rv)
312          ELSEIF (atype .EQ. 4) THEN
313            err = NF_PUT_ATT_INT(fid, vid, atname, NF_INT, len, iv)
314          ELSE
315            write(msgbuf,'(a,i10,a)') 'MNC ERROR: atype = ''', atype,
316         &       ''' is invalid--must be: [1-4]'
317            n = ILNBLNK(msgbuf)
318            CALL print_error(msgbuf(1:n), mythid)
319            stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_ANY'
320          ENDIF
321        write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),        write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),
322       &     ''' to file ''', fname(1:lenf), ''''       &     ''' to file ''', fname(1:lenf), ''''
323        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
# Line 173  C     Set the attribute Line 325  C     Set the attribute
325        RETURN        RETURN
326        END        END
327    
328    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
329    
330          SUBROUTINE MNC_VAR_WRITE_DBL(
331         I     myThid,
332         I     fname,
333         I     vname,
334         I     var )
335    
336          implicit none
337    C     Arguments
338          integer myThid
339          character*(*) fname,vname
340          REAL*8 var(*)
341    
342          CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,1,0,var,0.0,0)
343          RETURN
344          END
345    
346    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
347    
348          SUBROUTINE MNC_VAR_WRITE_REAL(
349         I     myThid,
350         I     fname,
351         I     vname,
352         I     var )
353    
354          implicit none
355    C     Arguments
356          integer myThid
357          character*(*) fname,vname
358          REAL*4 var(*)
359    
360          CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,2,0,0.0D0,var,0)
361          RETURN
362          END
363    
364    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
365    
366          SUBROUTINE MNC_VAR_WRITE_INT(
367         I     myThid,
368         I     fname,
369         I     vname,
370         I     var )
371    
372          implicit none
373    C     Arguments
374          integer myThid
375          character*(*) fname,vname
376          integer var(*)
377    
378          CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,3,0,0.0D0,0.0,var)
379          RETURN
380          END
381    
382    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
383    
384          SUBROUTINE MNC_VAR_APPEND_DBL(
385         I     myThid,
386         I     fname,
387         I     vname,
388         I     var,
389         I     append )
390    
391          implicit none
392    C     Arguments
393          integer myThid, append
394          character*(*) fname,vname
395          REAL*8 var(*)
396    
397          CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,1,append,var,0.0,0)
398          RETURN
399          END
400    
401    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
402    
403          SUBROUTINE MNC_VAR_APPEND_REAL(
404         I     myThid,
405         I     fname,
406         I     vname,
407         I     var,
408         I     append )
409    
410          implicit none
411    C     Arguments
412          integer myThid, append
413          character*(*) fname,vname
414          REAL*4 var(*)
415    
416          CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,2,append,0.0D0,var,0)
417          RETURN
418          END
419    
420    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
421    
422          SUBROUTINE MNC_VAR_APPEND_INT(
423         I     myThid,
424         I     fname,
425         I     vname,
426         I     var,
427         I     append )
428    
429          implicit none
430    C     Arguments
431          integer myThid, append
432          character*(*) fname,vname
433          integer var(*)
434    
435          CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,3,append,0.0D0,0.0,var)
436          RETURN
437          END
438    
439    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
440    
441          SUBROUTINE MNC_VAR_WRITE_ANY(
442         I     myThid,
443         I     fname,
444         I     vname,
445         I     vtype,
446         I     append,
447         I     dv,
448         I     rv,
449         I     iv )
450    
451          implicit none
452    #include "netcdf.inc"
453    #include "mnc_common.h"
454    #include "EEPARAMS.h"
455    
456    C     Arguments
457          integer myThid, vtype
458          character*(*) fname,vname
459          REAL*8 dv(*)
460          REAL*4 rv(*)
461          integer iv(*)
462          integer append
463    
464    C     Functions
465          integer ILNBLNK
466    
467    C     Local Variables
468          integer i,j,k, n, indf,ind_fv_ids, fid,vid,did, ig, err, ds,de
469          character*(MAX_LEN_MBUF) msgbuf
470          integer lenf,lenv, lend
471          integer vstart(100), vcount(100)
472    
473    C     Strip trailing spaces
474          lenf = ILNBLNK(fname)
475          lenv = ILNBLNK(vname)
476    
477          CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)
478          IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
479            write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
480         &       ''' is not open or does not contain variable ''',
481         &       vname(1:lenv), ''''
482            CALL print_error(msgbuf, mythid)
483            stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_STR'
484          ENDIF
485          fid = mnc_f_info(indf,2)
486          vid = mnc_fv_ids(indf,(ind_fv_ids+1))
487    
488    C     Get the lengths from the dim IDs
489          ig = mnc_fv_ids(indf,(ind_fv_ids+2))
490          ds = mnc_f_info(indf,ig+1)
491          de = mnc_f_info(indf,ig+2)
492          k = 0
493          DO i = ds,de
494            k = k + 1
495            vstart(k) = 1
496            vcount(k) = mnc_d_size( mnc_fd_ind(indf,i) )
497          ENDDO
498    
499    C     Check for the unlimited dimension
500          j = mnc_d_size( mnc_fd_ind(indf,de) )
501          IF (j .LT. 1) THEN
502            did = mnc_d_ids( mnc_fd_ind(indf,de) )
503            err = NF_INQ_DIMLEN(fid, did, lend)
504            write(msgbuf,'(a)') 'reading current length of unlimited dim'
505            CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
506            IF (append .GT. 0) THEN
507              lend = lend + append
508            ENDIF
509            IF (lend .LT. 1) lend = 1
510            vstart(k) = lend
511            vcount(k) = 1
512          ENDIF
513    
514          CALL MNC_FILE_ENDDEF(myThid, fname)
515          IF (vtype .EQ. 1) THEN
516            err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)
517          ELSEIF (vtype .EQ. 2) THEN
518            err = NF_PUT_VARA_REAL(fid, vid, vstart, vcount, rv)
519          ELSEIF (vtype .EQ. 3) THEN
520            err = NF_PUT_VARA_INT(fid, vid, vstart, vcount, iv)
521          ELSE
522            write(msgbuf,'(a,i10,a)') 'MNC ERROR: vtype = ''', vtype,
523         &       ''' is invalid--must be: [1|2|3]'
524            n = ILNBLNK(msgbuf)
525            CALL print_error(msgbuf(1:n), mythid)
526            stop 'ABNORMAL END: S/R MNC_VAR_WRITE_ALL'
527          ENDIF  
528          write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),
529         &     ''' to file ''', fname(1:lenf), ''''
530          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
531    
532          RETURN
533          END
534    
535    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
536    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22