Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:42:01 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
4de8f8c098 Ed H*0001 #include "MNC_OPTIONS.h"
                0002 
e9b72f2bd9 Ed H*0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0004 CBOP 0
1b5fb69d21 Ed H*0005 C     !ROUTINE: MNC_FILE_CREATE
4de8f8c098 Ed H*0006 
1b5fb69d21 Ed H*0007 C     !INTERFACE:
a27dc5c859 Ed H*0008       SUBROUTINE MNC_FILE_CREATE( 
3f2ea2a4ed Ed H*0009      I     fname, 
                0010      I     myThid )
a27dc5c859 Ed H*0011 
1b5fb69d21 Ed H*0012 C     !DESCRIPTION:
                0013 C     Create a NetCDF file.
                0014       
                0015 C     !USES:
a27dc5c859 Ed H*0016       implicit none
                0017 
1b5fb69d21 Ed H*0018 C     !INPUT PARAMETERS:
a27dc5c859 Ed H*0019       integer myThid
                0020       character*(*) fname
e6bb5b2cc3 Ed H*0021 CEOP
a27dc5c859 Ed H*0022 
1b5fb69d21 Ed H*0023 C     !LOCAL VARIABLES:
b11e5981be Ed H*0024       integer indf
                0025 
3f2ea2a4ed Ed H*0026       CALL MNC_FILE_OPEN(fname, 0, indf, myThid)
a27dc5c859 Ed H*0027 
                0028       RETURN
                0029       END
                0030 
e9b72f2bd9 Ed H*0031 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0032 CBOP 0
1b5fb69d21 Ed H*0033 C     !ROUTINE: MNC_FILE_OPEN
a27dc5c859 Ed H*0034 
1b5fb69d21 Ed H*0035 C     !INTERFACE:
4de8f8c098 Ed H*0036       SUBROUTINE MNC_FILE_OPEN( 
                0037      I     fname, 
b11e5981be Ed H*0038      I     itype, 
3f2ea2a4ed Ed H*0039      O     indf, 
                0040      I     myThid )
4de8f8c098 Ed H*0041 
1b5fb69d21 Ed H*0042 C     !DESCRIPTION:
                0043 C     Open or create a NetCDF file.
                0044       
                0045 C     !USES:
4de8f8c098 Ed H*0046       implicit none
07155994b8 Mart*0047 #include "MNC_COMMON.h"
4de8f8c098 Ed H*0048 #include "EEPARAMS.h"
853ee6565e Jean*0049 #include "netcdf.inc"
4de8f8c098 Ed H*0050 
1b5fb69d21 Ed H*0051 C     !INPUT PARAMETERS:
b11e5981be Ed H*0052       integer myThid,indf
4de8f8c098 Ed H*0053       character*(*) fname
                0054       integer itype
a906dd2a24 Ed H*0055 C     itype => [ 0=new | 1=append | 2=read-only ]
e6bb5b2cc3 Ed H*0056 CEOP
4de8f8c098 Ed H*0057 
1b5fb69d21 Ed H*0058 C     !LOCAL VARIABLES:
a906dd2a24 Ed H*0059       integer n, err, fid, nf
4de8f8c098 Ed H*0060       character*(MAX_LEN_MBUF) msgbuf
e6bb5b2cc3 Ed H*0061 
1b5fb69d21 Ed H*0062 C     Functions
                0063       integer ILNBLNK
4de8f8c098 Ed H*0064 
                0065 C     Is the file already open?
a906dd2a24 Ed H*0066       nf = ILNBLNK(fname)
ef92f00980 Ed H*0067       CALL MNC_GET_IND(MNC_MAX_FID, fname,mnc_f_names,indf,myThid)
b11e5981be Ed H*0068       IF (indf .GT. 0) THEN
a906dd2a24 Ed H*0069         write(msgbuf,'(3a)') 'MNC_FILE_OPEN ERROR: ''', fname(1:nf), 
4de8f8c098 Ed H*0070      &       ''' is already open -- cannot open twice'
b11e5981be Ed H*0071         CALL print_error(msgbuf, mythid)
4de8f8c098 Ed H*0072         stop 'ABNORMAL END: package MNC'
                0073       ENDIF
                0074 
16a9213e57 Ed H*0075       write(msgbuf,'(3a)') 'opening ''', fname(1:nf), ''''
b11e5981be Ed H*0076       IF (itype .EQ. 0) THEN
75987013ac Ed H*0077 
4de8f8c098 Ed H*0078 C       Create new file
75987013ac Ed H*0079         err = NF_CREATE(fname, NF_CLOBBER, fid)
3f2ea2a4ed Ed H*0080         CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
75987013ac Ed H*0081 
b11e5981be Ed H*0082       ELSEIF (itype .EQ. 1) THEN
75987013ac Ed H*0083 
4de8f8c098 Ed H*0084 C       Append to existing file
3f2ea2a4ed Ed H*0085         CALL MNC_FILE_READALL(fname, myThid)
75987013ac Ed H*0086 
4de8f8c098 Ed H*0087       ELSE
                0088 C       Error
                0089         write(msgbuf,'(a,i5,a)') 'MNC_FILE_OPEN ERROR: ''', itype, 
                0090      &       ''' is not defined--should be: [0|1]'
a27dc5c859 Ed H*0091         CALL print_error( msgbuf, mythid )
                0092         stop 'ABNORMAL END: S/R MNC_FILE_ADD_ATTR_STR'
4de8f8c098 Ed H*0093       ENDIF
                0094 
ef92f00980 Ed H*0095       CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_FID, mnc_f_names,
9705a0d5c6 Ed H*0096      &     'mnc_f_names', indf, myThid)
a27dc5c859 Ed H*0097       n = ILNBLNK(fname)
b11e5981be Ed H*0098       mnc_f_names(indf)(1:n) = fname(1:n)
                0099       mnc_f_info(indf,1) = 1
                0100       mnc_f_info(indf,2) = fid
                0101       mnc_f_info(indf,3) = 0
                0102       mnc_fv_ids(indf,1) = 0
                0103       mnc_f_alld(indf,1) = 0
4de8f8c098 Ed H*0104 
a27dc5c859 Ed H*0105       RETURN
4de8f8c098 Ed H*0106       END
                0107 
e9b72f2bd9 Ed H*0108 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0109 CBOP 0
1b5fb69d21 Ed H*0110 C     !ROUTINE: MNC_FILE_ADD_ATTR_STR
4de8f8c098 Ed H*0111 
1b5fb69d21 Ed H*0112 C     !INTERFACE:
4de8f8c098 Ed H*0113       SUBROUTINE MNC_FILE_ADD_ATTR_STR( 
                0114      I     fname, 
                0115      I     atname, 
3f2ea2a4ed Ed H*0116      I     sval, 
                0117      I     myThid )
4de8f8c098 Ed H*0118 
1b5fb69d21 Ed H*0119 C     !DESCRIPTION:
                0120 C     Add a character string attribute to a NetCDF file.
                0121 
                0122 C     !USES:
4de8f8c098 Ed H*0123       implicit none
1b5fb69d21 Ed H*0124 
                0125 C     !INPUT PARAMETERS:
dad4143247 Ed H*0126       integer myThid
a7ffe10af7 Ed H*0127       character*(*) fname, atname, sval
1b5fb69d21 Ed H*0128 CEOP
169a7aa8bd Jean*0129       real*4 sZero
                0130       sZero = 0.
4de8f8c098 Ed H*0131 
3f2ea2a4ed Ed H*0132       CALL MNC_FILE_ADD_ATTR_ANY(fname,atname, 1, 
169a7aa8bd Jean*0133      &     sval, 0, 0.0D0, sZero, 0, myThid )
a7ffe10af7 Ed H*0134       RETURN
                0135       END
4de8f8c098 Ed H*0136 
e9b72f2bd9 Ed H*0137 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0138 CBOP 0
1b5fb69d21 Ed H*0139 C     !ROUTINE: MNC_FILE_ADD_ATTR_DBL
4de8f8c098 Ed H*0140 
1b5fb69d21 Ed H*0141 C     !INTERFACE:
a7ffe10af7 Ed H*0142       SUBROUTINE MNC_FILE_ADD_ATTR_DBL( 
                0143      I     fname, 
                0144      I     atname, 
                0145      I     len, 
3f2ea2a4ed Ed H*0146      I     dval, 
                0147      I     myThid )
4de8f8c098 Ed H*0148 
1b5fb69d21 Ed H*0149 C     !DESCRIPTION:
                0150 C     Add a double-precision real attribute to a NetCDF file.
                0151 
                0152 C     !USES:
a7ffe10af7 Ed H*0153       implicit none
1b5fb69d21 Ed H*0154 
                0155 C     !INPUT PARAMETERS:
a7ffe10af7 Ed H*0156       integer myThid, len
                0157       character*(*) fname, atname
dad4143247 Ed H*0158       REAL*8 dval
1b5fb69d21 Ed H*0159 CEOP
169a7aa8bd Jean*0160       real*4 sZero
                0161       sZero = 0.
4de8f8c098 Ed H*0162 
3f2ea2a4ed Ed H*0163       CALL MNC_FILE_ADD_ATTR_ANY(fname,atname, 2, 
169a7aa8bd Jean*0164      &     ' ', len, dval, sZero, 0, myThid )
a27dc5c859 Ed H*0165       RETURN
4de8f8c098 Ed H*0166       END
                0167 
e9b72f2bd9 Ed H*0168 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0169 CBOP 0
1b5fb69d21 Ed H*0170 C     !ROUTINE: MNC_FILE_ADD_ATTR_REAL
4de8f8c098 Ed H*0171 
1b5fb69d21 Ed H*0172 C     !INTERFACE:
a7ffe10af7 Ed H*0173       SUBROUTINE MNC_FILE_ADD_ATTR_REAL( 
4de8f8c098 Ed H*0174      I     fname, 
                0175      I     atname, 
a7ffe10af7 Ed H*0176      I     len, 
3f2ea2a4ed Ed H*0177      I     rval, 
                0178      I     myThid )
4de8f8c098 Ed H*0179 
1b5fb69d21 Ed H*0180 C     !DESCRIPTION:
                0181 C     Add a single-precision real attribute to a NetCDF file.
                0182 
                0183 C     !USES:
4de8f8c098 Ed H*0184       implicit none
1b5fb69d21 Ed H*0185 
                0186 C     !INPUT PARAMETERS:
a7ffe10af7 Ed H*0187       integer myThid, len
4de8f8c098 Ed H*0188       character*(*) fname, atname
dad4143247 Ed H*0189       REAL*4 rval
1b5fb69d21 Ed H*0190 CEOP
4de8f8c098 Ed H*0191 
3f2ea2a4ed Ed H*0192       CALL MNC_FILE_ADD_ATTR_ANY(fname,atname, 3, 
                0193      &     ' ', len, 0.0D0, rval, 0, myThid )
a7ffe10af7 Ed H*0194       RETURN
                0195       END
4de8f8c098 Ed H*0196 
e9b72f2bd9 Ed H*0197 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0198 CBOP 0
1b5fb69d21 Ed H*0199 C     !ROUTINE: MNC_FILE_ADD_ATTR_INT
4de8f8c098 Ed H*0200 
1b5fb69d21 Ed H*0201 C     !INTERFACE:
a7ffe10af7 Ed H*0202       SUBROUTINE MNC_FILE_ADD_ATTR_INT( 
                0203      I     fname, 
                0204      I     atname, 
                0205      I     len, 
3f2ea2a4ed Ed H*0206      I     ival, 
                0207      I     myThid )
4de8f8c098 Ed H*0208 
1b5fb69d21 Ed H*0209 C     !DESCRIPTION:
                0210 C     Add an integer attribute to a NetCDF file.
                0211 
                0212 C     !USES:
a7ffe10af7 Ed H*0213       implicit none
1b5fb69d21 Ed H*0214 
                0215 C     !INPUT PARAMETERS:
a7ffe10af7 Ed H*0216       integer myThid, len, ival
                0217       character*(*) fname, atname
1b5fb69d21 Ed H*0218 CEOP
169a7aa8bd Jean*0219       real*4 sZero
                0220       sZero = 0.
4de8f8c098 Ed H*0221 
3f2ea2a4ed Ed H*0222       CALL MNC_FILE_ADD_ATTR_ANY(fname,atname, 4, 
169a7aa8bd Jean*0223      &     ' ', len, 0.0D0, sZero, ival, myThid )
a27dc5c859 Ed H*0224       RETURN
4de8f8c098 Ed H*0225       END
                0226 
e9b72f2bd9 Ed H*0227 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0228 CBOP 1
1b5fb69d21 Ed H*0229 C     !ROUTINE: MNC_FILE_ADD_ATTR_ANY
4de8f8c098 Ed H*0230 
1b5fb69d21 Ed H*0231 C     !INTERFACE:
a7ffe10af7 Ed H*0232       SUBROUTINE MNC_FILE_ADD_ATTR_ANY( 
4de8f8c098 Ed H*0233      I     fname, 
                0234      I     atname, 
3f2ea2a4ed Ed H*0235      I     atype, sv, len,dv,rv,iv, 
                0236      I     myThid )
4de8f8c098 Ed H*0237 
1b5fb69d21 Ed H*0238 C     !DESCRIPTION:
                0239 C     Add all attributes to a NetCDF file.
                0240 
                0241 C     !USES:
a7ffe10af7 Ed H*0242       implicit none
07155994b8 Mart*0243 #include "MNC_COMMON.h"
4de8f8c098 Ed H*0244 #include "EEPARAMS.h"
853ee6565e Jean*0245 #include "netcdf.inc"
4de8f8c098 Ed H*0246 
1b5fb69d21 Ed H*0247 C     !INPUT PARAMETERS:
a7ffe10af7 Ed H*0248       integer myThid, atype, len, iv
                0249       character*(*) fname, atname, sv
dad4143247 Ed H*0250       REAL*8 dv
                0251       REAL*4 rv
e6bb5b2cc3 Ed H*0252 CEOP
                0253 
1b5fb69d21 Ed H*0254 C     !LOCAL VARIABLES:
16a9213e57 Ed H*0255       integer n, nf, err, fid, ind, n1, lens
4de8f8c098 Ed H*0256       character*(MNC_MAX_CHAR) s1
                0257       character*(MAX_LEN_MBUF) msgbuf
e6bb5b2cc3 Ed H*0258 
1b5fb69d21 Ed H*0259 C     Functions
                0260       integer ILNBLNK
                0261 
907e360dab Ed H*0262 C     Verify that the file is open
ef92f00980 Ed H*0263       CALL MNC_GET_IND(MNC_MAX_FID, fname, mnc_f_names, ind, myThid)
907e360dab Ed H*0264       IF (ind .LT. 0) THEN
16a9213e57 Ed H*0265         nf = ILNBLNK( fname )
4de8f8c098 Ed H*0266         write(msgbuf,'(3a)') 'MNC ERROR: file ''',
16a9213e57 Ed H*0267      &       fname(1:nf), ''' must be opened first'
4de8f8c098 Ed H*0268         CALL print_error( msgbuf, mythid )
                0269         stop 'ABNORMAL END: S/R MNC_FILE_ADD_ATTR_INT'
                0270       ENDIF
d2129fb7fc Ed H*0271       fid = mnc_f_info(ind,2)
4de8f8c098 Ed H*0272 
                0273 C     Enter define mode
3f2ea2a4ed Ed H*0274       CALL MNC_FILE_REDEF(fname, myThid)
4de8f8c098 Ed H*0275 
                0276       s1(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
                0277       n1 = ILNBLNK(atname)
                0278       s1(1:n1) = atname(1:n1)
                0279 
a7ffe10af7 Ed H*0280       IF (atype .EQ. 1) THEN
                0281         lens = ILNBLNK(sv)
                0282         err = NF_PUT_ATT_TEXT(fid, NF_GLOBAL, s1, lens, sv)
3f2ea2a4ed Ed H*0283         CALL MNC_HANDLE_ERR(err,
                0284      &       'adding TEXT attribute in S/R MNC_FILE_ADD_ATTR_ANY', 
                0285      &       myThid)
a7ffe10af7 Ed H*0286       ELSEIF (atype .EQ. 2) THEN
                0287         err = NF_PUT_ATT_DOUBLE(fid, NF_GLOBAL, s1, NF_DOUBLE, len, dv)
3f2ea2a4ed Ed H*0288         CALL MNC_HANDLE_ERR(err,
                0289      &       'adding DOUBLE attribute in S/R MNC_FILE_ADD_ATTR_ANY',
                0290      &       myThid)
a7ffe10af7 Ed H*0291       ELSEIF (atype .EQ. 3) THEN
                0292         err = NF_PUT_ATT_REAL(fid, NF_GLOBAL, s1, NF_FLOAT, len, rv)
3f2ea2a4ed Ed H*0293         CALL MNC_HANDLE_ERR(err,
                0294      &       'adding REAL attribute in S/R MNC_FILE_ADD_ATTR_ANY',
                0295      &       myThid)
a7ffe10af7 Ed H*0296       ELSEIF (atype .EQ. 4) THEN
                0297         err = NF_PUT_ATT_INT(fid, NF_GLOBAL, s1, NF_INT, len, iv)
3f2ea2a4ed Ed H*0298         CALL MNC_HANDLE_ERR(err,
                0299      &       'adding INT attribute in S/R MNC_FILE_ADD_ATTR_ANY',
                0300      &       myThid)
a7ffe10af7 Ed H*0301       ELSE
                0302         write(msgbuf,'(a,i10,a)') 'MNC ERROR: atype = ''', atype, 
                0303      &       ''' is invalid--must be: [1-4]'
                0304         n = ILNBLNK(msgbuf)
                0305         CALL print_error(msgbuf(1:n), mythid)
                0306         stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_ANY'
                0307       ENDIF
a27dc5c859 Ed H*0308 
                0309       RETURN
                0310       END
                0311 
e9b72f2bd9 Ed H*0312 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0313 CBOP 1
1b5fb69d21 Ed H*0314 C     !ROUTINE: MNC_FILE_CLOSE
a27dc5c859 Ed H*0315 
1b5fb69d21 Ed H*0316 C     !INTERFACE:
a27dc5c859 Ed H*0317       SUBROUTINE MNC_FILE_CLOSE( 
3f2ea2a4ed Ed H*0318      I     fname, 
                0319      I     myThid )
a27dc5c859 Ed H*0320 
1b5fb69d21 Ed H*0321 C     !DESCRIPTION:
                0322 C     Close a NetCDF file.
                0323       
                0324 C     !USES:
a27dc5c859 Ed H*0325       implicit none
07155994b8 Mart*0326 #include "MNC_COMMON.h"
a27dc5c859 Ed H*0327 #include "EEPARAMS.h"
853ee6565e Jean*0328 #include "netcdf.inc"
a27dc5c859 Ed H*0329 
1b5fb69d21 Ed H*0330 C     !INPUT PARAMETERS:
a27dc5c859 Ed H*0331       integer myThid
                0332       character*(*) fname
e6bb5b2cc3 Ed H*0333 CEOP
a27dc5c859 Ed H*0334 
1b5fb69d21 Ed H*0335 C     !LOCAL VARIABLES:
a906dd2a24 Ed H*0336       integer i,j,k,n, err, fid, indf, nf
a27dc5c859 Ed H*0337       character*(MAX_LEN_MBUF) msgbuf
e6bb5b2cc3 Ed H*0338 
1b5fb69d21 Ed H*0339 C     Functions
                0340       integer ILNBLNK
a27dc5c859 Ed H*0341 
a906dd2a24 Ed H*0342       nf = ILNBLNK(fname)
                0343 
a27dc5c859 Ed H*0344 C     Check that the file is open
ef92f00980 Ed H*0345       CALL MNC_GET_IND(MNC_MAX_FID, fname, mnc_f_names, indf, myThid)
a906dd2a24 Ed H*0346       IF (indf .LT. 1) THEN
                0347         write(msgbuf,'(3a)') 'MNC Warning: file ''', fname(1:nf), 
a27dc5c859 Ed H*0348      &       ''' is already closed'
                0349         CALL print_error( msgbuf, mythid )
                0350         RETURN
                0351       ENDIF
a906dd2a24 Ed H*0352       fid = mnc_f_info(indf,2)
a27dc5c859 Ed H*0353       err = NF_CLOSE(fid)
a906dd2a24 Ed H*0354       write(msgbuf,'(3a)') ' cannot close file ''', fname(1:nf), ''''
3f2ea2a4ed Ed H*0355       CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
a27dc5c859 Ed H*0356 
75987013ac Ed H*0357 C     Clear all the info associated with this file
                0358 C     variables
a906dd2a24 Ed H*0359       n = mnc_fv_ids(indf,1)
a27dc5c859 Ed H*0360       IF (n .GE. 1) THEN
                0361         DO i = 1,n
75987013ac Ed H*0362           j = 2 + 3*(i - 1)
a906dd2a24 Ed H*0363           k = mnc_fv_ids(indf,j)
a27dc5c859 Ed H*0364           mnc_v_names(k)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
                0365         ENDDO
a906dd2a24 Ed H*0366         DO i = 1,MNC_MAX_INFO
                0367           mnc_fv_ids(indf,i) = 0
75987013ac Ed H*0368         ENDDO
a27dc5c859 Ed H*0369       ENDIF
75987013ac Ed H*0370 C     dims
a906dd2a24 Ed H*0371       n = mnc_f_alld(indf,1)
                0372       mnc_f_alld(indf,1) = 0
dad4143247 Ed H*0373       DO i = 1,n
a906dd2a24 Ed H*0374         j = mnc_f_alld(indf,i+1)
75987013ac Ed H*0375         mnc_d_ids(j)  = 0
                0376         mnc_d_size(j) = 0
dad4143247 Ed H*0377         mnc_d_names(j)(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
a906dd2a24 Ed H*0378         mnc_f_alld(indf,i+1) = 0
dad4143247 Ed H*0379       ENDDO
75987013ac Ed H*0380 C     grids
a906dd2a24 Ed H*0381       n = mnc_f_info(indf,3)
75987013ac Ed H*0382       IF (n .GT. 0) THEN
                0383         DO i = 1,n
                0384           j = 4 + 3*(i - 1)
a906dd2a24 Ed H*0385           k = mnc_f_info(indf,j)
75987013ac Ed H*0386           mnc_g_names(k)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
                0387         ENDDO
                0388         DO i = 1,MNC_MAX_INFO
a906dd2a24 Ed H*0389           mnc_fd_ind(indf,i) = 0
                0390           mnc_f_info(indf,i) = 0
75987013ac Ed H*0391         ENDDO
                0392       ENDIF
                0393 C     file name
ef92f00980 Ed H*0394       DO i = 1,MNC_MAX_PATH
                0395         mnc_f_names(indf)(i:i) = ' '
                0396       ENDDO
4de8f8c098 Ed H*0397 
a27dc5c859 Ed H*0398       RETURN
4de8f8c098 Ed H*0399       END
                0400 
e9b72f2bd9 Ed H*0401 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0402 CBOP 0
1b5fb69d21 Ed H*0403 C     !ROUTINE: MNC_FILE_CLOSE_ALL_MATCHING
907e360dab Ed H*0404 
1b5fb69d21 Ed H*0405 C     !INTERFACE:
251b9a88c9 Ed H*0406       SUBROUTINE MNC_FILE_CLOSE_ALL_MATCHING( 
3f2ea2a4ed Ed H*0407      I     fname, 
                0408      I     myThid ) 
251b9a88c9 Ed H*0409 
1b5fb69d21 Ed H*0410 C     !DESCRIPTION:
                0411 C     Close all files matching a character string.
                0412       
                0413 C     !USES:
251b9a88c9 Ed H*0414       implicit none
07155994b8 Mart*0415 #include "MNC_COMMON.h"
251b9a88c9 Ed H*0416 #include "EEPARAMS.h"
853ee6565e Jean*0417 #include "netcdf.inc"
251b9a88c9 Ed H*0418 
1b5fb69d21 Ed H*0419 C     !INPUT PARAMETERS:
251b9a88c9 Ed H*0420       integer myThid
                0421       character*(*) fname
e6bb5b2cc3 Ed H*0422 CEOP
251b9a88c9 Ed H*0423 
1b5fb69d21 Ed H*0424 C     !LOCAL VARIABLES:
                0425       integer i,n
e6bb5b2cc3 Ed H*0426 
251b9a88c9 Ed H*0427 C     Functions
                0428       integer ILNBLNK
                0429 
                0430       n = ILNBLNK(fname)
ef92f00980 Ed H*0431       DO i = 1,MNC_MAX_FID
251b9a88c9 Ed H*0432 
                0433 C       Check that the file is open
                0434         IF (fname(1:n) .EQ. mnc_f_names(i)(1:n)) THEN
3f2ea2a4ed Ed H*0435           CALL MNC_FILE_CLOSE(mnc_f_names(i), myThid)
251b9a88c9 Ed H*0436         ENDIF
                0437 
                0438       ENDDO
                0439 
                0440       RETURN
                0441       END
                0442 
e9b72f2bd9 Ed H*0443 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0444 CBOP 0
1b5fb69d21 Ed H*0445 C     !ROUTINE: MNC_FILE_CLOSE_ALL
251b9a88c9 Ed H*0446 
1b5fb69d21 Ed H*0447 C     !INTERFACE:
251b9a88c9 Ed H*0448       SUBROUTINE MNC_FILE_CLOSE_ALL( 
                0449      I     myThid ) 
                0450 
1b5fb69d21 Ed H*0451 C     !DESCRIPTION:
b03b61c263 Ed H*0452 C     Close all NetCDF files.
1b5fb69d21 Ed H*0453       
                0454 C     !USES:
251b9a88c9 Ed H*0455       implicit none
07155994b8 Mart*0456 #include "MNC_COMMON.h"
251b9a88c9 Ed H*0457 #include "EEPARAMS.h"
853ee6565e Jean*0458 #include "netcdf.inc"
251b9a88c9 Ed H*0459 
1b5fb69d21 Ed H*0460 C     !INPUT PARAMETERS:
251b9a88c9 Ed H*0461       integer myThid
e6bb5b2cc3 Ed H*0462 CEOP
251b9a88c9 Ed H*0463 
1b5fb69d21 Ed H*0464 C     !LOCAL VARIABLES:
251b9a88c9 Ed H*0465       integer i
ef92f00980 Ed H*0466       character*(MNC_MAX_PATH) bpath
                0467 
                0468       DO i = 1,MNC_MAX_PATH
                0469         bpath(i:i) = ' '
                0470       ENDDO
251b9a88c9 Ed H*0471 
ef92f00980 Ed H*0472       DO i = 1,MNC_MAX_FID
251b9a88c9 Ed H*0473 
                0474 C       Check that the file is open
ef92f00980 Ed H*0475         IF (mnc_f_names(i)(1:MNC_MAX_PATH) 
                0476      &       .NE. bpath(1:MNC_MAX_PATH)) THEN
3f2ea2a4ed Ed H*0477           CALL MNC_FILE_CLOSE(mnc_f_names(i), myThid)
251b9a88c9 Ed H*0478         ENDIF
                0479 
                0480       ENDDO
                0481 
                0482       RETURN
                0483       END
                0484 
e9b72f2bd9 Ed H*0485 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0486 CBOP 0
1b5fb69d21 Ed H*0487 C     !ROUTINE: MNC_FILE_REDEF
251b9a88c9 Ed H*0488 
1b5fb69d21 Ed H*0489 C     !INTERFACE:
907e360dab Ed H*0490       SUBROUTINE MNC_FILE_REDEF( 
3f2ea2a4ed Ed H*0491      I     fname, 
                0492      I     myThid )
907e360dab Ed H*0493 
1b5fb69d21 Ed H*0494 C     !DESCRIPTION:
                0495 C     Set the NetCDF file to DEFINE mode.
                0496       
                0497 C     !USES:
907e360dab Ed H*0498       implicit none
07155994b8 Mart*0499 #include "MNC_COMMON.h"
907e360dab Ed H*0500 #include "EEPARAMS.h"
853ee6565e Jean*0501 #include "netcdf.inc"
907e360dab Ed H*0502 
1b5fb69d21 Ed H*0503 C     !INPUT PARAMETERS:
907e360dab Ed H*0504       integer myThid
                0505       character*(*) fname
e6bb5b2cc3 Ed H*0506 CEOP
907e360dab Ed H*0507 
1b5fb69d21 Ed H*0508 C     !LOCAL VARIABLES:
dad4143247 Ed H*0509       integer ind, fid, def, err, n
907e360dab Ed H*0510       character*(MAX_LEN_MBUF) msgbuf
e6bb5b2cc3 Ed H*0511 
1b5fb69d21 Ed H*0512 C     Functions
                0513       integer ILNBLNK
907e360dab Ed H*0514 
                0515 C     Verify that the file is open
ef92f00980 Ed H*0516       CALL MNC_GET_IND(MNC_MAX_FID, fname, mnc_f_names, ind, myThid)
907e360dab Ed H*0517       IF (ind .LT. 0) THEN
dad4143247 Ed H*0518         n = ILNBLNK(fname)
907e360dab Ed H*0519         write(msgbuf,'(3a)') 'MNC ERROR: file ''',
dad4143247 Ed H*0520      &       fname(1:n), ''' must be opened first'
907e360dab Ed H*0521         CALL print_error( msgbuf, mythid )
                0522         stop 'ABNORMAL END: S/R MNC_FILE_REDEF'
                0523       ENDIF
                0524       def = mnc_f_info(ind,1)
                0525       fid = mnc_f_info(ind,2)
                0526 
                0527       IF (def .NE. 1) THEN
                0528 C       Enter define mode
                0529         err = NF_REDEF(fid)
3f2ea2a4ed Ed H*0530         CALL MNC_HANDLE_ERR(err, 
                0531      &       'entering define mode in S/R MNC_FILE_REDEF', myThid)
907e360dab Ed H*0532         mnc_f_info(ind,1) = 1
                0533       ENDIF
                0534 
                0535       RETURN
                0536       END
                0537 
e9b72f2bd9 Ed H*0538 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0539 CBOP 0
1b5fb69d21 Ed H*0540 C     !ROUTINE: MNC_FILE_ENDDEF
907e360dab Ed H*0541 
1b5fb69d21 Ed H*0542 C     !INTERFACE:
907e360dab Ed H*0543       SUBROUTINE MNC_FILE_ENDDEF( 
3f2ea2a4ed Ed H*0544      I     fname, 
                0545      I     myThid )
907e360dab Ed H*0546 
1b5fb69d21 Ed H*0547 C     !DESCRIPTION:
                0548 C     End DEFINE mode for a NetCDF file.
                0549       
                0550 C     !USES:
907e360dab Ed H*0551       implicit none
07155994b8 Mart*0552 #include "MNC_COMMON.h"
907e360dab Ed H*0553 #include "EEPARAMS.h"
853ee6565e Jean*0554 #include "netcdf.inc"
907e360dab Ed H*0555 
1b5fb69d21 Ed H*0556 C     !INPUT PARAMETERS:
907e360dab Ed H*0557       integer myThid
                0558       character*(*) fname
e6bb5b2cc3 Ed H*0559 CEOP
907e360dab Ed H*0560 
1b5fb69d21 Ed H*0561 C     !LOCAL VARIABLES:
dad4143247 Ed H*0562       integer ind, fid, def, err, n
907e360dab Ed H*0563       character*(MAX_LEN_MBUF) msgbuf
e6bb5b2cc3 Ed H*0564 
1b5fb69d21 Ed H*0565 C     Functions
                0566       integer ILNBLNK
907e360dab Ed H*0567 
                0568 C     Verify that the file is open
ef92f00980 Ed H*0569       CALL MNC_GET_IND(MNC_MAX_FID, fname, mnc_f_names, ind, myThid)
907e360dab Ed H*0570       IF (ind .LT. 0) THEN
dad4143247 Ed H*0571         n = ILNBLNK(fname)
907e360dab Ed H*0572         write(msgbuf,'(3a)') 'MNC ERROR: file ''',
dad4143247 Ed H*0573      &       fname(1:n), ''' must be opened first'
907e360dab Ed H*0574         CALL print_error( msgbuf, mythid )
                0575         stop 'ABNORMAL END: S/R MNC_FILE_REDEF'
                0576       ENDIF
                0577       def = mnc_f_info(ind,1)
                0578       fid = mnc_f_info(ind,2)
                0579 
                0580       IF (def .NE. 2) THEN
                0581 C       Enter define mode
                0582         err = NF_ENDDEF(fid)
3f2ea2a4ed Ed H*0583         CALL MNC_HANDLE_ERR(err, 
                0584      &       'ending define mode in S/R MNC_FILE_ENDDEF', myThid)
907e360dab Ed H*0585         mnc_f_info(ind,1) = 2
                0586       ENDIF
                0587 
                0588       RETURN
                0589       END
                0590 
e9b72f2bd9 Ed H*0591 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0592 CBOP 1
e40d346a32 Ed H*0593 C     !ROUTINE: MNC_FILE_READALL
75987013ac Ed H*0594 
e6bb5b2cc3 Ed H*0595 C     !INTERFACE:
75987013ac Ed H*0596       SUBROUTINE MNC_FILE_READALL( 
3f2ea2a4ed Ed H*0597      I     fname, 
                0598      I     myThid ) 
75987013ac Ed H*0599 
e6bb5b2cc3 Ed H*0600 C     !DESCRIPTION:
                0601 C     Try to open and read a NetCDF file.
                0602       
                0603 C     !USES:
75987013ac Ed H*0604       implicit none
                0605 #include "EEPARAMS.h"
853ee6565e Jean*0606 #include "netcdf.inc"
75987013ac Ed H*0607 
1b5fb69d21 Ed H*0608 C     !INPUT PARAMETERS:
75987013ac Ed H*0609       integer myThid
                0610       character*(*) fname
e6bb5b2cc3 Ed H*0611 CEOP
75987013ac Ed H*0612 
                0613 C     Functions
                0614       integer IFNBLNK, ILNBLNK
                0615 
                0616 C     Local Variables
b11e5981be Ed H*0617       integer ierr, nff,nlf, indf
3623ff8097 Ed H*0618       character*(MAX_LEN_MBUF) msgbuf
                0619 
                0620       nff = IFNBLNK(fname)
                0621       nlf = ILNBLNK(fname)
3f2ea2a4ed Ed H*0622       CALL MNC_FILE_TRY_READ(fname, ierr, indf, myThid)
3623ff8097 Ed H*0623       write(msgbuf,'(3a)') 'MNC ERROR: cannot open file ''', 
                0624      &     fname(nff:nlf), ''' for read/write access'
3f2ea2a4ed Ed H*0625       CALL MNC_HANDLE_ERR(ierr, msgbuf, myThid)
3623ff8097 Ed H*0626 
                0627       RETURN
                0628       END
                0629 
                0630 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0631 CBOP 1
1b5fb69d21 Ed H*0632 C     !ROUTINE: MNC_FILE_TRY_READ
3623ff8097 Ed H*0633 
1b5fb69d21 Ed H*0634 C     !INTERFACE:
3623ff8097 Ed H*0635       SUBROUTINE MNC_FILE_TRY_READ( 
                0636      I     fname, 
b11e5981be Ed H*0637      O     ierr, 
3f2ea2a4ed Ed H*0638      O     indf, 
                0639      I     myThid ) 
3623ff8097 Ed H*0640 
1b5fb69d21 Ed H*0641 C     !DESCRIPTION:
                0642 C     Try to open and read a NetCDF file.
                0643       
                0644 C     !USES:
3623ff8097 Ed H*0645       implicit none
07155994b8 Mart*0646 #include "MNC_COMMON.h"
3623ff8097 Ed H*0647 #include "EEPARAMS.h"
853ee6565e Jean*0648 #include "netcdf.inc"
3623ff8097 Ed H*0649 
1b5fb69d21 Ed H*0650 C     !INPUT PARAMETERS:
b11e5981be Ed H*0651       integer myThid, ierr, indf
3623ff8097 Ed H*0652       character*(*) fname
                0653 
1b5fb69d21 Ed H*0654 C     !LOCAL VARIABLES:
75987013ac Ed H*0655       integer i,j,k, fid, err, ndim,nvar,ngat,unlimid
b11e5981be Ed H*0656       integer dlen, id, xtype, nat, nff,nlf, iv
75987013ac Ed H*0657       integer ndv, did, ns,ne, n1,n2, indg, indv
                0658       character*(MAX_LEN_MBUF) msgbuf
                0659       character*(NF_MAX_NAME) name
                0660       integer idlist(NF_MAX_VAR_DIMS)
                0661       character*(MNC_MAX_CHAR) dnames(20)
1b5fb69d21 Ed H*0662 CEOP
                0663 C     Functions
                0664       integer IFNBLNK, ILNBLNK
75987013ac Ed H*0665 
                0666 C     Open and save the filename and fID
                0667       nff = IFNBLNK(fname)
                0668       nlf = ILNBLNK(fname)
                0669       err = NF_OPEN(fname, NF_WRITE, fid)
3623ff8097 Ed H*0670       ierr = NF_NOERR
                0671       IF (err .NE. NF_NOERR) THEN
                0672         ierr = err
                0673         RETURN
                0674       ENDIF
ef92f00980 Ed H*0675       CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_FID, mnc_f_names,
9705a0d5c6 Ed H*0676      &     'mnc_f_names', indf, myThid)
75987013ac Ed H*0677       mnc_f_names(indf)(1:(nlf-nff+1)) = fname(nff:nlf)
                0678       mnc_f_info(indf,2) = fid
                0679 
                0680 C     Get the overall number of entities
                0681       err = NF_INQ(fid, ndim, nvar, ngat, unlimid)
                0682       write(msgbuf,'(4a)') 'MNC ERROR: cannot read number of dims',
                0683      &     ' in file ''', fname(nff:nlf), ''''
3f2ea2a4ed Ed H*0684       CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
75987013ac Ed H*0685 
                0686 C     Read each dimension and save the information
                0687       DO id = 1,ndim
                0688         err = NF_INQ_DIM(fid, id, name, dlen)
                0689         write(msgbuf,'(2a,i5,3a)') 'MNC ERROR: cannot read dimension',
                0690      &       ' info for dim ''', id, ''' in file ''', 
                0691      &       fname(nff:nlf), ''''
3f2ea2a4ed Ed H*0692         CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
75987013ac Ed H*0693         IF (id .EQ. unlimid) THEN
                0694           dlen = -1
                0695         ENDIF
                0696         ns = IFNBLNK(name)
                0697         ne = ILNBLNK(name)
e40d346a32 Ed H*0698 
3f2ea2a4ed Ed H*0699         CALL MNC_DIM_INIT_ALL(fname,name(ns:ne),dlen,'N', myThid)
75987013ac Ed H*0700         DO i = 1,mnc_f_alld(indf,1)
                0701           j = mnc_f_alld(indf,i+1)
                0702           n1 = IFNBLNK(mnc_d_names(j))
                0703           n2 = ILNBLNK(mnc_d_names(j))
                0704           IF (((ne-ns) .EQ. (n2-n1)) 
                0705      &         .AND. (mnc_d_names(j)(ns:ne) .EQ. name(ns:ne))) THEN
                0706             mnc_d_ids(j) = id
                0707             goto 10
                0708           ENDIF
                0709         ENDDO
                0710  10     CONTINUE
                0711       ENDDO
                0712 
                0713 C     Read and save each variable
                0714       DO id = 1,nvar
                0715         err = NF_INQ_VAR(fid, id, name, xtype, ndv, idlist, nat)
                0716         write(msgbuf,'(2a,i5,3a)') 'MNC ERROR: cannot read variable',
                0717      &       ' info for variable ''', id, ''' in file ''', 
                0718      &       fname(nff:nlf), ''''
3f2ea2a4ed Ed H*0719         CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
75987013ac Ed H*0720         n1 = IFNBLNK(name)
                0721         n2 = ILNBLNK(name)
e40d346a32 Ed H*0722 
75987013ac Ed H*0723 C       Create a grid for this variable
                0724         DO i = 1,ndv
                0725           did = idlist(i)
                0726           dnames(i)(1:MNC_MAX_CHAR) = mnc_d_names(did)(1:MNC_MAX_CHAR)
                0727         ENDDO
e40d346a32 Ed H*0728 
3f2ea2a4ed Ed H*0729         CALL MNC_GRID_INIT_ALL(fname, name, ndv, dnames, indg, myThid)
75987013ac Ed H*0730 
                0731 C       Update the tables
9705a0d5c6 Ed H*0732         CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID,mnc_v_names,
                0733      &       'mnc_v_names', indv,myThid)
75987013ac Ed H*0734         mnc_v_names(indv)(1:(n2-n1+1)) = name(n1:n2)
                0735         iv = 2 + 3*mnc_fv_ids(indf,1)
                0736         mnc_fv_ids(indf,iv)   = indv
                0737         mnc_fv_ids(indf,iv+1) = id
                0738         DO i = 1,mnc_f_info(indf,3)
                0739           j = 4 + 3*(i-1)
                0740           k = mnc_f_info(indf,j)
                0741           IF (k .EQ. indg) THEN
                0742             mnc_fv_ids(indf,iv+2) = j
                0743             GOTO 20
                0744           ENDIF
                0745         ENDDO
                0746  20     CONTINUE
                0747         mnc_fv_ids(indf,1) = mnc_fv_ids(indf,1) + 1
                0748         
                0749       ENDDO
                0750 
                0751       RETURN
                0752       END
                0753 
e6bb5b2cc3 Ed H*0754 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!