/[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.18 by edhill, Sun Dec 26 15:24:50 2004 UTC revision 1.24 by utke, Fri Jun 20 20:36:58 2008 UTC
# Line 12  C     !INTERFACE: Line 12  C     !INTERFACE:
12       I     fname,       I     fname,
13       I     gname,       I     gname,
14       I     vname,       I     vname,
15         I     irv,
16       I     myThid )       I     myThid )
17    
18  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 23  C     !USES: Line 24  C     !USES:
24  #include "netcdf.inc"  #include "netcdf.inc"
25    
26  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
27        integer myThid        integer irv,myThid
28        character*(*) fname,gname,vname        character*(*) fname,gname,vname
29  CEOP  CEOP
30    
31        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_DOUBLE, myThid)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_DOUBLE, irv,myThid)
32        RETURN        RETURN
33        END        END
34    
# Line 40  C     !INTERFACE: Line 41  C     !INTERFACE:
41       I     fname,       I     fname,
42       I     gname,       I     gname,
43       I     vname,       I     vname,
44         I     irv,
45       I     myThid )       I     myThid )
46    
47  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 51  C     !USES: Line 53  C     !USES:
53  #include "netcdf.inc"  #include "netcdf.inc"
54    
55  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
56        integer myThid        integer irv,myThid
57        character*(*) fname,gname,vname        character*(*) fname,gname,vname
58  CEOP  CEOP
59    
60        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_FLOAT, myThid)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_FLOAT, irv,myThid)
61        RETURN        RETURN
62        END        END
63    
# Line 68  C     !INTERFACE: Line 70  C     !INTERFACE:
70       I     fname,       I     fname,
71       I     gname,       I     gname,
72       I     vname,       I     vname,
73         I     irv,
74       I     myThid )       I     myThid )
75    
76  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 78  C     !USES: Line 81  C     !USES:
81  #include "netcdf.inc"  #include "netcdf.inc"
82    
83  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
84        integer myThid        integer irv,myThid
85        character*(*) fname,gname,vname        character*(*) fname,gname,vname
86  CEOP  CEOP
87    
88        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_INT, myThid)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_INT, irv,myThid)
89        RETURN        RETURN
90        END        END
91    
# Line 96  C     !INTERFACE: Line 99  C     !INTERFACE:
99       I     gname,       I     gname,
100       I     vname,       I     vname,
101       I     vtype,       I     vtype,
102         I     irv,
103       I     myThid )       I     myThid )
104    
105  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 104  C     context. Line 108  C     context.
108                
109  C     !USES:  C     !USES:
110        implicit none        implicit none
111  #include "netcdf.inc"  #include "MNC_COMMON.h"
 #include "mnc_common.h"  
112  #include "EEPARAMS.h"  #include "EEPARAMS.h"
113    #include "netcdf.inc"
114    
115  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
116        integer myThid        integer irv,myThid
117        character*(*) fname,gname,vname        character*(*) fname,gname,vname
118        integer vtype        integer vtype
119  CEOP  CEOP
120    
121  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
122        integer i,j,k, n, indf,indv, fid, nd, ngrid, is,ie, err        integer i,j,k, n, nf, indf,indv, fid, nd, ngrid, is,ie, err
123        integer vid, nv, ind_g_finfo, needed, nvar        integer vid, nv, ind_g_finfo, needed, nvar
124        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
125        integer ids(20)        integer ids(20)
# Line 130  C     Strip trailing spaces Line 134  C     Strip trailing spaces
134        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
135    
136  C     Check that the file is open  C     Check that the file is open
137        CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)        CALL MNC_GET_IND(MNC_MAX_FID, fname, mnc_f_names, indf, myThid)
138        IF (indf .LT. 1) THEN        IF (indf .LT. 1) THEN
139          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname,          nf = ILNBLNK( fname )
140            write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),
141       &       ''' must be opened first'       &       ''' must be opened first'
142          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
143          stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'          stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
# Line 144  C     Check for sufficient storage space Line 149  C     Check for sufficient storage space
149        IF (needed .GE. MNC_MAX_INFO) THEN        IF (needed .GE. MNC_MAX_INFO) THEN
150          write(msgbuf,'(2a,i7,a)') 'MNC ERROR: MNC_MAX_INFO exceeded',          write(msgbuf,'(2a,i7,a)') 'MNC ERROR: MNC_MAX_INFO exceeded',
151       &       ': please increase it to ', 2*MNC_MAX_INFO,       &       ': please increase it to ', 2*MNC_MAX_INFO,
152       &       ' in the file ''pkg/mnc/mnc_common.h'''       &       ' in the file ''pkg/mnc/MNC_COMMON.h'''
153          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
154          stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'          stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
155        ENDIF        ENDIF
# Line 194  C     Check if the variable is already d Line 199  C     Check if the variable is already d
199              stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'              stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
200            ELSE            ELSE
201  C           Its OK, the variable and grid names are the same  C           Its OK, the variable and grid names are the same
202                irv = 0
203              RETURN              RETURN
204            ENDIF            ENDIF
205          ENDIF          ENDIF
206        ENDDO        ENDDO
207    
208          irv = 1
209    
210  C     Add the variable definition  C     Add the variable definition
211        CALL MNC_FILE_REDEF(fname, myThid)        CALL MNC_FILE_REDEF(fname, myThid)
212        err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid)        err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid)
# Line 218  C     Add the variable definition Line 226  C     Add the variable definition
226        ENDIF        ENDIF
227    
228  C     Success, so save the variable info  C     Success, so save the variable info
229        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID,mnc_v_names,indv, myThid)        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID,mnc_v_names,'mnc_v_names',
230         &     indv, myThid)
231        mnc_v_names(indv)(1:lenv) = vname(1:lenv)        mnc_v_names(indv)(1:lenv) = vname(1:lenv)
232        nv = mnc_fv_ids(indf,1)        nv = mnc_fv_ids(indf,1)
233        i = 2 + nv*3        i = 2 + nv*3
# Line 386  C     General subroutine for adding attr Line 395  C     General subroutine for adding attr
395                
396  C     !USES:  C     !USES:
397        implicit none        implicit none
398  #include "netcdf.inc"  #include "MNC_COMMON.h"
 #include "mnc_common.h"  
399  #include "EEPARAMS.h"  #include "EEPARAMS.h"
400    #include "netcdf.inc"
401    
402  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
403        integer myThid,atype,len        integer myThid,atype,len
# Line 572  C---+----1----+----2----+----3----+----4 Line 581  C---+----1----+----2----+----3----+----4
581       I     myThid )       I     myThid )
582    
583        implicit none        implicit none
584  #include "netcdf.inc"  #include "MNC_COMMON.h"
 #include "mnc_common.h"  
585  #include "EEPARAMS.h"  #include "EEPARAMS.h"
586    #include "netcdf.inc"
587    
588  C     Arguments  C     Arguments
589        integer myThid, vtype        integer myThid, vtype
Legend:
Removed from v.1.18  
changed lines
  Added in v.1.24
  ViewVC Help
Powered by ViewVC 1.1.22