/[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.2 by edhill, Tue Jan 6 23:19:27 2004 UTC revision 1.19 by edhill, Fri Feb 24 20:39:10 2006 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    CBOP 1
8    C     !ROUTINE: MNC_VAR_INIT_DBL
9    
10    C     !INTERFACE:
11        SUBROUTINE MNC_VAR_INIT_DBL(        SUBROUTINE MNC_VAR_INIT_DBL(
      I     myThid,  
12       I     fname,       I     fname,
13       I     gname,       I     gname,
14       I     vname,       I     vname,
15       I     fillval )       I     irv,
16         I     myThid )
17    
18    C     !DESCRIPTION:
19    C     Create a double-precision real variable within a NetCDF file
20    C     context.
21          
22    C     !USES:
23          implicit none
24    #include "netcdf.inc"
25    
26    C     !INPUT PARAMETERS:
27          integer irv,myThid
28          character*(*) fname,gname,vname
29    CEOP
30    
31          CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_DOUBLE, irv,myThid)
32          RETURN
33          END
34    
35    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
36    CBOP 1
37    C     !ROUTINE: MNC_VAR_INIT_REAL
38    
39    C     !INTERFACE:
40          SUBROUTINE MNC_VAR_INIT_REAL(
41         I     fname,
42         I     gname,
43         I     vname,
44         I     irv,
45         I     myThid )
46    
47    C     !DESCRIPTION:
48    C     Create a single-precision real variable within a NetCDF file
49    C     context.
50          
51    C     !USES:
52          implicit none
53    #include "netcdf.inc"
54    
55    C     !INPUT PARAMETERS:
56          integer irv,myThid
57          character*(*) fname,gname,vname
58    CEOP
59    
60          CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_FLOAT, irv,myThid)
61          RETURN
62          END
63    
64    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
65    CBOP 1
66    C     !ROUTINE: MNC_VAR_INIT_INT
67    
68    C     !INTERFACE:
69          SUBROUTINE MNC_VAR_INIT_INT(
70         I     fname,
71         I     gname,
72         I     vname,
73         I     irv,
74         I     myThid )
75    
76    C     !DESCRIPTION:
77    C     Create an integer variable within a NetCDF file context.
78      
79    C     !USES:
80          implicit none
81    #include "netcdf.inc"
82    
83    C     !INPUT PARAMETERS:
84          integer irv,myThid
85          character*(*) fname,gname,vname
86    CEOP
87    
88          CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_INT, irv,myThid)
89          RETURN
90          END
91    
92    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
93    CBOP 1
94    C     !ROUTINE: MNC_VAR_INIT_ANY
95    
96    C     !INTERFACE:
97          SUBROUTINE MNC_VAR_INIT_ANY(
98         I     fname,
99         I     gname,
100         I     vname,
101         I     vtype,
102         I     irv,
103         I     myThid )
104    
105    C     !DESCRIPTION:
106    C     General function for creating variables within a NetCDF file
107    C     context.
108          
109    C     !USES:
110          implicit none
111    #include "netcdf.inc"
112    #include "mnc_common.h"
113    #include "EEPARAMS.h"
114    
115    C     !INPUT PARAMETERS:
116          integer irv,myThid
117          character*(*) fname,gname,vname
118          integer vtype
119    CEOP
120    
121    C     !LOCAL VARIABLES:
122          integer i,j,k, n, indf,indv, fid, nd, ngrid, is,ie, err
123          integer vid, nv, ind_g_finfo, needed, nvar
124          character*(MAX_LEN_MBUF) msgbuf
125          integer ids(20)
126          integer lenf,leng,lenv
127    
128    C     Functions
129          integer ILNBLNK
130    
131    C     Strip trailing spaces
132          lenf = ILNBLNK(fname)
133          leng = ILNBLNK(gname)
134          lenv = ILNBLNK(vname)
135    
136    C     Check that the file is open
137          CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
138          IF (indf .LT. 1) THEN
139            write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname,
140         &       ''' must be opened first'
141            CALL print_error(msgbuf, mythid)
142            stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
143          ENDIF
144          fid = mnc_f_info(indf,2)
145    
146    C     Check for sufficient storage space in mnc_fv_ids
147          needed = 1 + 3*(mnc_fv_ids(indf,1) + 1)
148          IF (needed .GE. MNC_MAX_INFO) THEN
149            write(msgbuf,'(2a,i7,a)') 'MNC ERROR: MNC_MAX_INFO exceeded',
150         &       ': please increase it to ', 2*MNC_MAX_INFO,
151         &       ' in the file ''pkg/mnc/mnc_common.h'''
152            CALL print_error(msgbuf, mythid)
153            stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
154          ENDIF
155    
156    C     Get the grid information
157          ngrid = mnc_f_info(indf,3)
158          IF (ngrid .LT. 1) THEN
159            write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:lenf),
160         &       ''' contains NO grids'
161            CALL print_error(msgbuf, mythid)
162            stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
163          ENDIF
164          DO i = 1,ngrid
165            j = 4 + (i-1)*3
166            k = mnc_f_info(indf,j)
167            n = ILNBLNK(mnc_g_names(k))
168            IF ((leng .EQ. n)
169         &       .AND. (mnc_g_names(k)(1:n) .EQ. gname(1:n))) THEN
170              ind_g_finfo = j
171              is = mnc_f_info(indf,(j+1))
172              ie = mnc_f_info(indf,(j+2))
173              nd = 0
174              DO k = is,ie
175                nd = nd + 1
176                ids(nd) = mnc_d_ids(mnc_fd_ind(indf,k))
177              ENDDO
178              GOTO 10
179            ENDIF
180          ENDDO
181          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
182         &     ''' does not contain grid ''', gname(1:leng), ''''
183          CALL print_error(msgbuf, mythid)
184          stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
185     10   CONTINUE
186    
187    C     Check if the variable is already defined
188          nvar = mnc_fv_ids(indf,1)
189          DO i = 1,nvar
190            j = 2 + 3*(i-1)
191            IF (mnc_v_names(mnc_fv_ids(indf,j)) .EQ. vname) THEN
192              k = mnc_f_info(indf,mnc_fv_ids(indf,j+2))
193              IF (mnc_g_names(k) .NE. gname) THEN
194                write(msgbuf,'(5a)') 'MNC ERROR: variable ''',
195         &           vname(1:lenv), ''' is already defined in file ''',
196         &           fname(1:lenf), ''' but using a different grid shape'
197                CALL print_error(msgbuf, mythid)
198                stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
199              ELSE
200    C           Its OK, the variable and grid names are the same
201                irv = 0
202                RETURN
203              ENDIF
204            ENDIF
205          ENDDO
206    
207          irv = 1
208    
209    C     Add the variable definition
210          CALL MNC_FILE_REDEF(fname, myThid)
211          err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid)
212          IF ( err .NE. NF_NOERR ) THEN
213            write(msgbuf,'(2a)') 'ERROR:  MNC will not ',
214         &       'overwrite variables in existing NetCDF'
215            CALL PRINT_ERROR( msgBuf, myThid )
216            write(msgbuf,'(2a)') '        files.  Please',
217         &       ' make sure that you are not trying to'
218            CALL PRINT_ERROR( msgBuf, myThid )
219            write(msgbuf,'(2a)') '        overwrite output',
220         &       'files from a previous model run!'
221            CALL PRINT_ERROR( msgBuf, myThid )
222            write(msgbuf,'(5a)') 'defining variable ''', vname(1:lenv),
223         &     ''' in file ''', fname(1:lenf), ''''
224            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
225          ENDIF
226    
227    C     Success, so save the variable info
228          CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID,mnc_v_names,indv, myThid)
229          mnc_v_names(indv)(1:lenv) = vname(1:lenv)
230          nv = mnc_fv_ids(indf,1)
231          i = 2 + nv*3
232          mnc_fv_ids(indf,i)   = indv
233          mnc_fv_ids(indf,i+1) = vid
234          mnc_fv_ids(indf,i+2) = ind_g_finfo
235          mnc_fv_ids(indf,1) = nv + 1
236    
237          RETURN
238          END
239    
240    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
241    CBOP 1
242    C     !ROUTINE: MNC_VAR_ADD_ATTR_STR
243    
244    C     !INTERFACE:
245          SUBROUTINE MNC_VAR_ADD_ATTR_STR(
246         I     fname,
247         I     vname,
248         I     atname,
249         I     sval,
250         I     myThid )
251    
252    C     !DESCRIPTION:
253    C     Subroutine for adding a character string attribute to a NetCDF
254    C     file.
255          
256    C     !USES:
257          implicit none
258    
259    C     !INPUT PARAMETERS:
260          integer myThid
261          character*(*) fname,vname,atname,sval
262    CEOP
263          real*8 dZero(1)
264          real*4 sZero(1)
265          integer iZero(1)
266          dZero(1) = 0.0D0
267          sZero(1) = 0.0
268          iZero(1) = 0
269    
270          CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
271         &     1, sval, 0, dZero, sZero, iZero, myThid)
272          RETURN
273          END
274    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
275    CBOP 1
276    C     !ROUTINE: MNC_VAR_ADD_ATTR_DBL
277    
278    C     !INTERFACE:
279          SUBROUTINE MNC_VAR_ADD_ATTR_DBL(
280         I     fname,
281         I     vname,
282         I     atname,
283         I     nv,
284         I     dval,
285         I     myThid )
286    
287    C     !DESCRIPTION:
288    C     Subroutine for adding a double-precision real attribute to a
289    C     NetCDF file.
290      
291    C     !USES:
292          implicit none
293    
294    C     !INPUT PARAMETERS:
295          integer myThid,nv
296          character*(*) fname,vname,atname
297          REAL*8 dval(*)
298    CEOP
299          real*4 sZero(1)
300          integer iZero(1)
301          sZero(1) = 0.0
302          iZero(1) = 0
303    
304          CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
305         &     2, ' ', nv, dval, sZero, iZero, myThid)
306          RETURN
307          END
308    
309    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
310    CBOP 1
311    C     !ROUTINE: MNC_VAR_ADD_ATTR_REAL
312    
313    C     !INTERFACE:
314          SUBROUTINE MNC_VAR_ADD_ATTR_REAL(
315         I     fname,
316         I     vname,
317         I     atname,
318         I     nv,
319         I     rval,
320         I     myThid )
321    
322    C     !DESCRIPTION:
323    C     Subroutine for adding a single-precision real attribute to a
324    C     NetCDF file.
325      
326    C     !USES:
327          implicit none
328    
329    C     !INPUT PARAMETERS:
330          integer myThid,nv
331          character*(*) fname,vname,atname
332          REAL*4 rval(*)
333    CEOP
334          real*8 dZero(1)
335          integer iZero(1)
336          dZero(1) = 0.0D0
337          iZero(1) = 0
338    
339          CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
340         &     3, ' ', nv, dZero, rval, iZero, myThid)
341          RETURN
342          END
343    
344    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
345    CBOP 1
346    C     !ROUTINE: MNC_VAR_ADD_ATTR_INT
347    
348    C     !INTERFACE:
349          SUBROUTINE MNC_VAR_ADD_ATTR_INT(
350         I     fname,
351         I     vname,
352         I     atname,
353         I     nv,
354         I     ival,
355         I     myThid )
356    
357    C     !DESCRIPTION:
358    C     Subroutine for adding an integer attribute to a
359    C     NetCDF file.
360          
361    C     !USES:
362          implicit none
363    
364    C     !INPUT PARAMETERS:
365          integer myThid,nv
366          character*(*) fname,vname,atname
367          integer ival(*)
368    CEOP
369          real*8 dZero(1)
370          real*4 sZero(1)
371          dZero(1) = 0.0D0
372          sZero(1) = 0.0
373    
374          CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
375         &     4, ' ', nv, dZero, sZero, ival, myThid)
376          RETURN
377          END
378    
379    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
380    CBOP 1
381    C     !ROUTINE: MNC_VAR_ADD_ATTR_ANY
382    
383    C     !INTERFACE:
384          SUBROUTINE MNC_VAR_ADD_ATTR_ANY(
385         I     fname,
386         I     vname,
387         I     atname,
388         I     atype, cs,len,dv,rv,iv,
389         I     myThid )
390    
391    C     !DESCRIPTION:
392    C     General subroutine for adding attributes to a NetCDF file.
393          
394    C     !USES:
395        implicit none        implicit none
396    #include "netcdf.inc"
397  #include "mnc_common.h"  #include "mnc_common.h"
398  #include "EEPARAMS.h"  #include "EEPARAMS.h"
399    
400    C     !INPUT PARAMETERS:
401          integer myThid,atype,len
402          character*(*) fname,vname,atname
403          character*(*) cs
404          REAL*8 dv(*)
405          REAL*4 rv(*)
406          integer iv(*)
407    CEOP
408    
409    C     !LOCAL VARIABLES:
410          integer n, indf,ind_fv_ids, fid,vid, err
411          character*(MAX_LEN_MBUF) msgbuf
412          integer lenf,lenv,lenat,lens
413    
414    C     Functions
415          integer ILNBLNK
416    
417    C     Strip trailing spaces
418          lenf = ILNBLNK(fname)
419          lenv = ILNBLNK(vname)
420          lenat = ILNBLNK(atname)
421          lens = ILNBLNK(cs)
422    
423          CALL MNC_GET_FVINDS(fname, vname, indf, ind_fv_ids, myThid)
424          IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
425            write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
426         &       ''' is not open or does not contain variable ''',
427         &       vname(1:lenv), ''''
428            CALL print_error(msgbuf, mythid)
429            stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_STR'
430          ENDIF
431          fid = mnc_f_info(indf,2)
432          vid = mnc_fv_ids(indf,(ind_fv_ids+1))
433    
434    C     Set the attribute
435          CALL MNC_FILE_REDEF(fname, myThid)
436          IF (atype .EQ. 1) THEN
437            err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)
438          ELSEIF (atype .EQ. 2) THEN
439            err = NF_PUT_ATT_DOUBLE(fid, vid, atname, NF_DOUBLE, len, dv)
440          ELSEIF (atype .EQ. 3) THEN
441            err = NF_PUT_ATT_REAL(fid, vid, atname, NF_FLOAT, len, rv)
442          ELSEIF (atype .EQ. 4) THEN
443            err = NF_PUT_ATT_INT(fid, vid, atname, NF_INT, len, iv)
444          ELSE
445            write(msgbuf,'(a,i10,a)') 'MNC ERROR: atype = ''', atype,
446         &       ''' is invalid--must be: [1-4]'
447            n = ILNBLNK(msgbuf)
448            CALL print_error(msgbuf(1:n), mythid)
449            stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_ANY'
450          ENDIF
451          write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),
452         &     ''' to file ''', fname(1:lenf), ''''
453          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
454    
455          RETURN
456          END
457    
458    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
459    
460          SUBROUTINE MNC_VAR_WRITE_DBL(
461         I     fname,
462         I     vname,
463         I     var,
464         I     myThid )
465    
466          implicit none
467    C     Arguments
468          integer myThid
469          character*(*) fname,vname
470          REAL*8 var(*)
471    
472          CALL MNC_VAR_WRITE_ANY(fname,vname,1,0,var,0.0,0, myThid)
473          RETURN
474          END
475    
476    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
477    
478          SUBROUTINE MNC_VAR_WRITE_REAL(
479         I     fname,
480         I     vname,
481         I     var,
482         I     myThid )
483    
484          implicit none
485    C     Arguments
486          integer myThid
487          character*(*) fname,vname
488          REAL*4 var(*)
489    
490          CALL MNC_VAR_WRITE_ANY(fname,vname,2,0,0.0D0,var,0, myThid)
491          RETURN
492          END
493    
494    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
495    
496          SUBROUTINE MNC_VAR_WRITE_INT(
497         I     fname,
498         I     vname,
499         I     var,
500         I     myThid )
501    
502          implicit none
503  C     Arguments  C     Arguments
504        integer myThid        integer myThid
505        character*(*) fname        character*(*) fname,vname
506        character*(*) gname        integer var(*)
507        character*(*) vname  
508        _RL fillval        CALL MNC_VAR_WRITE_ANY(fname,vname,3,0,0.0D0,0.0,var, myThid)
509          RETURN
510          END
511    
512    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
513    
514          SUBROUTINE MNC_VAR_APPEND_DBL(
515         I     fname,
516         I     vname,
517         I     var,
518         I     append,
519         I     myThid )
520    
521          implicit none
522    C     Arguments
523          integer myThid, append
524          character*(*) fname,vname
525          REAL*8 var(*)
526    
527          CALL MNC_VAR_WRITE_ANY(fname,vname,1,append,var,0.0,0, myThid)
528          RETURN
529          END
530    
531    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
532    
533          SUBROUTINE MNC_VAR_APPEND_REAL(
534         I     fname,
535         I     vname,
536         I     var,
537         I     append,
538         I     myThid )
539    
540          implicit none
541    C     Arguments
542          integer myThid, append
543          character*(*) fname,vname
544          REAL*4 var(*)
545    
546          CALL MNC_VAR_WRITE_ANY(fname,vname,2,append,0.0D0,var,0,myThid)
547          RETURN
548          END
549    
550    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
551    
552          SUBROUTINE MNC_VAR_APPEND_INT(
553         I     fname,
554         I     vname,
555         I     var,
556         I     append,
557         I     myThid )
558    
559          implicit none
560    C     Arguments
561          integer myThid, append
562          character*(*) fname,vname
563          integer var(*)
564    
565          CALL MNC_VAR_WRITE_ANY(fname,vname,3,append,0.0D0,0.0,var,myThid)
566          RETURN
567          END
568    
569    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
570    
571          SUBROUTINE MNC_VAR_WRITE_ANY(
572         I     fname,
573         I     vname,
574         I     vtype,
575         I     append,
576         I     dv,
577         I     rv,
578         I     iv,
579         I     myThid )
580    
581          implicit none
582    #include "netcdf.inc"
583    #include "mnc_common.h"
584    #include "EEPARAMS.h"
585    
586    C     Arguments
587          integer myThid, vtype
588          character*(*) fname,vname
589          REAL*8 dv(*)
590          REAL*4 rv(*)
591          integer iv(*)
592          integer append
593    
594  C     Functions  C     Functions
595        integer ILNBLNK        integer ILNBLNK
596    
597  C     Local Variables  C     Local Variables
598        integer i, ind, fid        integer i,j,k, n, indf,ind_fv_ids, fid,vid,did, ig, err, ds,de
599        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
600          integer lenf,lenv, lend
601          integer vstart(100), vcount(100)
602    
603  C     Is the file open?  C     Strip trailing spaces
604        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, ind)        lenf = ILNBLNK(fname)
605        IF ( ind .GT. 0 ) THEN        lenv = ILNBLNK(vname)
606          write(msgbuf,'(3a)') 'MNC ERROR: file ''',  
607       &       fname, ''' must be opened first'        CALL MNC_GET_FVINDS(fname, vname, indf, ind_fv_ids, myThid)
608          CALL print_error( msgbuf, mythid )        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
609          stop 'ABNORMAL END: S/R MNC_FILE_ADD_ATTR_INT'          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
610         &       ''' is not open or does not contain variable ''',
611         &       vname(1:lenv), ''''
612            CALL print_error(msgbuf, mythid)
613            stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_STR'
614          ENDIF
615          fid = mnc_f_info(indf,2)
616          vid = mnc_fv_ids(indf,(ind_fv_ids+1))
617    
618    C     Get the lengths from the dim IDs
619          ig = mnc_fv_ids(indf,(ind_fv_ids+2))
620          ds = mnc_f_info(indf,ig+1)
621          de = mnc_f_info(indf,ig+2)
622          k = 0
623          DO i = ds,de
624            k = k + 1
625            vstart(k) = 1
626            vcount(k) = mnc_d_size( mnc_fd_ind(indf,i) )
627          ENDDO
628    
629    C     Check for the unlimited dimension
630          j = mnc_d_size( mnc_fd_ind(indf,de) )
631          IF (j .LT. 1) THEN
632            did = mnc_d_ids( mnc_fd_ind(indf,de) )
633            err = NF_INQ_DIMLEN(fid, did, lend)
634            write(msgbuf,'(a)') 'reading current length of unlimited dim'
635            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
636            IF (append .GT. 0) THEN
637              lend = lend + append
638            ENDIF
639            IF (lend .LT. 1) lend = 1
640            vstart(k) = lend
641            vcount(k) = 1
642        ENDIF        ENDIF
643        fid = mnc_f_info(ind,2)  
644          CALL MNC_FILE_ENDDEF(fname, myThid)
645          IF (vtype .EQ. 1) THEN
646            err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)
647          ELSEIF (vtype .EQ. 2) THEN
648            err = NF_PUT_VARA_REAL(fid, vid, vstart, vcount, rv)
649          ELSEIF (vtype .EQ. 3) THEN
650            err = NF_PUT_VARA_INT(fid, vid, vstart, vcount, iv)
651          ELSE
652            write(msgbuf,'(a,i10,a)') 'MNC ERROR: vtype = ''', vtype,
653         &       ''' is invalid--must be: [1|2|3]'
654            n = ILNBLNK(msgbuf)
655            CALL print_error(msgbuf(1:n), mythid)
656            stop 'ABNORMAL END: S/R MNC_VAR_WRITE_ALL'
657          ENDIF  
658          write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),
659         &     ''' to file ''', fname(1:lenf), ''''
660          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
661    
662        RETURN        RETURN
663        END        END
664    
665    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
666    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.19
  ViewVC Help
Powered by ViewVC 1.1.22