/[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.9 by edhill, Sun Jan 18 23:23:15 2004 UTC revision 1.12 by edhill, Wed Feb 4 05:45:09 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,       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    
25  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
26    
27        SUBROUTINE MNC_VAR_INIT_REAL(        SUBROUTINE MNC_VAR_INIT_REAL(
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    
44  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
45    
46        SUBROUTINE MNC_VAR_INIT_INT(        SUBROUTINE MNC_VAR_INIT_INT(
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    
63  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
64    
65        SUBROUTINE MNC_VAR_INIT_ANY(        SUBROUTINE MNC_VAR_INIT_ANY(
66       I     myThid,       I     myThid,
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======================================= Line 76  C=======================================
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 139  C     Get the grid information Line 134  C     Get the grid information
134            nd = 0            nd = 0
135            DO k = is,ie            DO k = is,ie
136              nd = nd + 1              nd = nd + 1
137              ids(nd) = mnc_fg_ids(indf,k)              ids(nd) = mnc_d_ids(mnc_fd_ind(indf,k))
138            ENDDO            ENDDO
139            GOTO 10            GOTO 10
140          ENDIF          ENDIF
# 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 162  C     Success, so save the variable info Line 176  C     Success, so save the variable info
176        mnc_v_names(indv)(1:lenv) = vname(1:lenv)        mnc_v_names(indv)(1:lenv) = vname(1:lenv)
177        nv = mnc_fv_ids(indf,1)        nv = mnc_fv_ids(indf,1)
178        i = 2 + nv*3        i = 2 + nv*3
179        j = i + 1        mnc_fv_ids(indf,i)   = indv
180        k = i + 2        mnc_fv_ids(indf,i+1) = vid
181        mnc_fv_ids(indf,i) = indv        mnc_fv_ids(indf,i+2) = ind_g_finfo
       mnc_fv_ids(indf,j) = vid  
       mnc_fv_ids(indf,k) = 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    
187  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
188    
189        SUBROUTINE MNC_VAR_ADD_ATTR_STR(        SUBROUTINE MNC_VAR_ADD_ATTR_STR(
190       I     myThid,       I     myThid,
# Line 193  C     Arguments Line 202  C     Arguments
202       &     1, sval, 0, 0.0D0, 0.0, 0)       &     1, sval, 0, 0.0D0, 0.0, 0)
203        RETURN        RETURN
204        END        END
205  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
206    
207        SUBROUTINE MNC_VAR_ADD_ATTR_DBL(        SUBROUTINE MNC_VAR_ADD_ATTR_DBL(
208       I     myThid,       I     myThid,
# Line 214  C     Arguments Line 223  C     Arguments
223        RETURN        RETURN
224        END        END
225    
226  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
227    
228        SUBROUTINE MNC_VAR_ADD_ATTR_REAL(        SUBROUTINE MNC_VAR_ADD_ATTR_REAL(
229       I     myThid,       I     myThid,
# Line 235  C     Arguments Line 244  C     Arguments
244        RETURN        RETURN
245        END        END
246    
247  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
248    
249        SUBROUTINE MNC_VAR_ADD_ATTR_INT(        SUBROUTINE MNC_VAR_ADD_ATTR_INT(
250       I     myThid,       I     myThid,
# Line 256  C     Arguments Line 265  C     Arguments
265        RETURN        RETURN
266        END        END
267    
268  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
269    
270        SUBROUTINE MNC_VAR_ADD_ATTR_ANY(        SUBROUTINE MNC_VAR_ADD_ATTR_ANY(
271       I     myThid,       I     myThid,
# Line 327  C     Set the attribute Line 336  C     Set the attribute
336        RETURN        RETURN
337        END        END
338    
339  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
340    
341        SUBROUTINE MNC_VAR_WRITE_DBL(        SUBROUTINE MNC_VAR_WRITE_DBL(
342       I     myThid,       I     myThid,
# Line 345  C     Arguments Line 354  C     Arguments
354        RETURN        RETURN
355        END        END
356    
357  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
358    
359        SUBROUTINE MNC_VAR_WRITE_REAL(        SUBROUTINE MNC_VAR_WRITE_REAL(
360       I     myThid,       I     myThid,
# Line 363  C     Arguments Line 372  C     Arguments
372        RETURN        RETURN
373        END        END
374    
375  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
376    
377        SUBROUTINE MNC_VAR_WRITE_INT(        SUBROUTINE MNC_VAR_WRITE_INT(
378       I     myThid,       I     myThid,
# Line 381  C     Arguments Line 390  C     Arguments
390        RETURN        RETURN
391        END        END
392    
393  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
394    
395        SUBROUTINE MNC_VAR_APPEND_DBL(        SUBROUTINE MNC_VAR_APPEND_DBL(
396       I     myThid,       I     myThid,
# Line 400  C     Arguments Line 409  C     Arguments
409        RETURN        RETURN
410        END        END
411    
412  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
413    
414        SUBROUTINE MNC_VAR_APPEND_REAL(        SUBROUTINE MNC_VAR_APPEND_REAL(
415       I     myThid,       I     myThid,
# Line 419  C     Arguments Line 428  C     Arguments
428        RETURN        RETURN
429        END        END
430    
431  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
432    
433        SUBROUTINE MNC_VAR_APPEND_INT(        SUBROUTINE MNC_VAR_APPEND_INT(
434       I     myThid,       I     myThid,
# Line 438  C     Arguments Line 447  C     Arguments
447        RETURN        RETURN
448        END        END
449    
450  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
451    
452        SUBROUTINE MNC_VAR_WRITE_ANY(        SUBROUTINE MNC_VAR_WRITE_ANY(
453       I     myThid,       I     myThid,
# Line 501  C     Get the lengths from the dim IDs Line 510  C     Get the lengths from the dim IDs
510  C     Check for the unlimited dimension  C     Check for the unlimited dimension
511        j = mnc_d_size( mnc_fd_ind(indf,de) )        j = mnc_d_size( mnc_fd_ind(indf,de) )
512        IF (j .LT. 1) THEN        IF (j .LT. 1) THEN
513          did = mnc_fg_ids(indf,de)          did = mnc_d_ids( mnc_fd_ind(indf,de) )
514          err = NF_INQ_DIMLEN(fid, did, lend)          err = NF_INQ_DIMLEN(fid, did, lend)
515          write(msgbuf,'(a)') 'reading current length of unlimited dim'          write(msgbuf,'(a)') 'reading current length of unlimited dim'
516          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
# Line 534  C     Check for the unlimited dimension Line 543  C     Check for the unlimited dimension
543        RETURN        RETURN
544        END        END
545    
546    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
547    
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22