/[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.11 by edhill, Tue Jan 27 05:47:33 2004 UTC revision 1.12 by edhill, Wed Feb 4 05:45:09 2004 UTC
# Line 9  C---+----1----+----2----+----3----+----4 Line 9  C---+----1----+----2----+----3----+----4
9       I     myThid,       I     myThid,
10       I     fname,       I     fname,
11       I     gname,       I     gname,
12       I     vname,       I     vname )
      I     units )  
13    
14        implicit none        implicit none
15  #include "netcdf.inc"  #include "netcdf.inc"
16    
17  C     Arguments  C     Arguments
18        integer myThid        integer myThid
19        character*(*) fname,gname,vname,units        character*(*) fname,gname,vname
20    
21        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_DOUBLE)        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname, NF_DOUBLE)
22        RETURN        RETURN
23        END        END
24    
# Line 29  C---+----1----+----2----+----3----+----4 Line 28  C---+----1----+----2----+----3----+----4
28       I     myThid,       I     myThid,
29       I     fname,       I     fname,
30       I     gname,       I     gname,
31       I     vname,       I     vname )
      I     units )  
32    
33        implicit none        implicit none
34  #include "netcdf.inc"  #include "netcdf.inc"
35    
36  C     Arguments  C     Arguments
37        integer myThid        integer myThid
38        character*(*) fname,gname,vname,units        character*(*) fname,gname,vname
39    
40        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_FLOAT)        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname, NF_FLOAT)
41        RETURN        RETURN
42        END        END
43    
# Line 49  C---+----1----+----2----+----3----+----4 Line 47  C---+----1----+----2----+----3----+----4
47       I     myThid,       I     myThid,
48       I     fname,       I     fname,
49       I     gname,       I     gname,
50       I     vname,       I     vname )
      I     units )  
51    
52        implicit none        implicit none
53  #include "netcdf.inc"  #include "netcdf.inc"
54    
55  C     Arguments  C     Arguments
56        integer myThid        integer myThid
57        character*(*) fname,gname,vname,units        character*(*) fname,gname,vname
58    
59        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_INT)        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname, NF_INT)
60        RETURN        RETURN
61        END        END
62    
# Line 70  C---+----1----+----2----+----3----+----4 Line 67  C---+----1----+----2----+----3----+----4
67       I     fname,       I     fname,
68       I     gname,       I     gname,
69       I     vname,       I     vname,
      I     units,  
70       I     vtype )       I     vtype )
71    
72        implicit none        implicit none
# Line 80  C---+----1----+----2----+----3----+----4 Line 76  C---+----1----+----2----+----3----+----4
76    
77  C     Arguments  C     Arguments
78        integer myThid        integer myThid
79        character*(*) fname,gname,vname,units        character*(*) fname,gname,vname
80        integer vtype        integer vtype
81    
82  C     Functions  C     Functions
# Line 88  C     Functions Line 84  C     Functions
84    
85  C     Local Variables  C     Local Variables
86        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
87        integer vid, nv, ind_g_finfo, needed        integer vid, nv, ind_g_finfo, needed, nvar
88        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
89        integer ids(20)        integer ids(20)
90        integer lenf,leng,lenv,lenu        integer lenf,leng,lenv
91    
92  C     Strip trailing spaces  C     Strip trailing spaces
93        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
94        leng = ILNBLNK(gname)        leng = ILNBLNK(gname)
95        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
       lenu = ILNBLNK(units)  
96    
97  C     Check that the file is open  C     Check that the file is open
98        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 150  C     Get the grid information Line 145  C     Get the grid information
145        stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'        stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
146   10   CONTINUE   10   CONTINUE
147    
148    C     Check if the variable is already defined
149          nvar = mnc_fv_ids(indf,1)
150          DO i = 1,nvar
151            j = 2 + 3*(i-1)
152            IF (mnc_v_names(mnc_fv_ids(indf,j)) .EQ. vname) THEN
153              k = mnc_f_info(indf,mnc_fv_ids(indf,j+2))
154              IF (mnc_g_names(k) .NE. gname) THEN
155                write(msgbuf,'(5a)') 'MNC ERROR: variable ''',
156         &           vname(1:lenv), ''' is already defined in file ''',
157         &           fname(1:lenf), ''' but using a different grid shape'
158                CALL print_error(msgbuf, mythid)
159                stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
160              ELSE
161    C           Its OK, the variable and grid names are the same
162                RETURN
163              ENDIF
164            ENDIF
165          ENDDO
166    
167  C     Add the variable definition  C     Add the variable definition
168        CALL MNC_FILE_REDEF(myThid, fname)        CALL MNC_FILE_REDEF(myThid, fname)
169        err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid)        err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid)
# Line 167  C     Success, so save the variable info Line 181  C     Success, so save the variable info
181        mnc_fv_ids(indf,i+2) = ind_g_finfo        mnc_fv_ids(indf,i+2) = ind_g_finfo
182        mnc_fv_ids(indf,1) = nv + 1        mnc_fv_ids(indf,1) = nv + 1
183    
 C     Add the units  
       CALL MNC_VAR_ADD_ATTR_STR(myThid, fname, vname, 'units', units)  
   
184        RETURN        RETURN
185        END        END
186    
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22