pkg/mnc/mnc_dim.F

a27dc5c859 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
d5d5c6127e Ed H*0005 C     !ROUTINE: MNC_DIM_INIT
1b5fb69d21 Ed H*0006
d5d5c6127e Ed H*0007 C     !INTERFACE:
a27dc5c859 Ed H*0008       SUBROUTINE MNC_DIM_INIT(
dad4143247 Ed H*0009      I     fname,
a27dc5c859 Ed H*0010      I     dname,
3f2ea2a4ed Ed H*0011      I     dlen,
                0012      I     myThid )
a27dc5c859 Ed H*0013
d5d5c6127e Ed H*0014 C     !DESCRIPTION:
1b5fb69d21 Ed H*0015 C     Create a dimension within the MNC look-up tables.
d5d5c6127e Ed H*0016
                0017 C     !INPUT PARAMETERS:
75987013ac Ed H*0018       integer myThid, dlen
                0019       character*(*) fname, dname
d5d5c6127e Ed H*0020 CEOP
75987013ac Ed H*0021
3f2ea2a4ed Ed H*0022       CALL MNC_DIM_INIT_ALL(fname, dname, dlen, 'Y', myThid)
75987013ac Ed H*0023
                0024       RETURN
                0025       END
                0026
e9b72f2bd9 Ed H*0027 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0028 CBOP 1
d5d5c6127e Ed H*0029 C     !ROUTINE: MNC_DIM_INIT_ALL
1b5fb69d21 Ed H*0030
d5d5c6127e Ed H*0031 C     !INTERFACE:
75987013ac Ed H*0032       SUBROUTINE MNC_DIM_INIT_ALL(
                0033      I     fname,
                0034      I     dname,
                0035      I     dlen,
3f2ea2a4ed Ed H*0036      I     doWrite,
                0037      I     myThid )
75987013ac Ed H*0038
d5d5c6127e Ed H*0039 C     !DESCRIPTION:
1b5fb69d21 Ed H*0040 C     Create a dimension within the MNC look-up tables.
d5d5c6127e Ed H*0041
d77e828db7 Ed H*0042 C     !USES:
                0043       implicit none
                0044
                0045 C     !INPUT PARAMETERS:
                0046       integer myThid, dlen
                0047       character*(*) fname, dname
                0048       character*(1) doWrite
                0049 CEOP
                0050
e40d346a32 Ed H*0051       CALL MNC_DIM_INIT_ALL_CV(fname,dname,dlen,doWrite,-1,-1,myThid)
d77e828db7 Ed H*0052
                0053       RETURN
                0054       END
                0055
                0056 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0057 CBOP 1
                0058 C     !ROUTINE: MNC_DIM_INIT_ALL_CV
                0059
                0060 C     !INTERFACE:
                0061       SUBROUTINE MNC_DIM_INIT_ALL_CV(
                0062      I     fname,
                0063      I     dname,
                0064      I     dlen,
                0065      I     doWrite,
                0066      I     bi,bj,
                0067      I     myThid )
                0068
                0069 C     !DESCRIPTION:
                0070 C     Create a dimension within the MNC look-up tables.
                0071
d5d5c6127e Ed H*0072 C     !USES:
a27dc5c859 Ed H*0073       implicit none
07155994b8 Mart*0074 #include "MNC_COMMON.h"
a27dc5c859 Ed H*0075 #include "EEPARAMS.h"
853ee6565e Jean*0076 #include "netcdf.inc"
a27dc5c859 Ed H*0077
d5d5c6127e Ed H*0078 C     !INPUT PARAMETERS:
d77e828db7 Ed H*0079       integer myThid, dlen, bi,bj
75987013ac Ed H*0080       character*(*) fname, dname
                0081       character*(1) doWrite
e6bb5b2cc3 Ed H*0082 CEOP
a27dc5c859 Ed H*0083
d5d5c6127e Ed H*0084 C     !LOCAL VARIABLES:
1b5fb69d21 Ed H*0085       integer i,j, indf,indd, n,nf, dnf,dnl
                0086       integer ntmp, idd, err, tlen
a27dc5c859 Ed H*0087       character*(MAX_LEN_MBUF) msgbuf
e6bb5b2cc3 Ed H*0088
1b5fb69d21 Ed H*0089 C     Functions
                0090       integer ILNBLNK, IFNBLNK
a27dc5c859 Ed H*0091
dad4143247 Ed H*0092       nf = ILNBLNK(fname)
75987013ac Ed H*0093
                0094       dnf = IFNBLNK(dname)
                0095       dnl = ILNBLNK(dname)
dad4143247 Ed H*0096
                0097 C     Verify that the file exists
ef92f00980 Ed H*0098       CALL MNC_GET_IND(MNC_MAX_FID, fname, mnc_f_names, indf, myThid)
dad4143247 Ed H*0099       IF ( indf .LT. 1 ) THEN
                0100         write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),
                0101      &       ''' does not exist'
a27dc5c859 Ed H*0102         CALL print_error( msgbuf, mythid )
dad4143247 Ed H*0103         stop 'ABNORMAL END: S/R MNC_DIM_INIT'
a27dc5c859 Ed H*0104       ENDIF
dad4143247 Ed H*0105
                0106 C     Verify that the dim is not currently defined within the file
                0107       n = mnc_f_alld(indf,1)
                0108       DO i = 1,n
                0109         j = mnc_f_alld(indf,i+1)
b11e5981be Ed H*0110         ntmp = ILNBLNK(mnc_d_names(j))
75987013ac Ed H*0111         IF ((ntmp .EQ. (dnl-dnf+1))
b11e5981be Ed H*0112      &       .AND. (dname(dnf:dnl) .EQ. mnc_d_names(j)(1:ntmp))) THEN
                0113           IF (mnc_d_size(j) .NE. dlen) THEN
                0114             IF ((mnc_d_size(j) .GT. 0) .OR. (dlen .GT. 0)) THEN
                0115               write(msgbuf,'(5a)') 'MNC ERROR: dimension ''',
                0116      &             dname(dnf:dnl), ''' already exists within file ''',
                0117      &             fname(1:nf), ''' and its size cannot be changed'
                0118               CALL print_error(msgbuf, mythid)
                0119               stop 'ABNORMAL END: S/R MNC_DIM_INIT'
                0120             ELSE
                0121 C             Its OK, the names are the same and both are specifying the
                0122 C             unlimited dimension
                0123               RETURN
                0124             ENDIF
                0125           ELSE
                0126 C           Its OK, the names and sizes are identical
                0127             RETURN
                0128           ENDIF
dad4143247 Ed H*0129         ENDIF
                0130       ENDDO
                0131
9705a0d5c6 Ed H*0132       CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_d_names,
                0133      &     'mnc_d_names', indd, myThid)
a27dc5c859 Ed H*0134
75987013ac Ed H*0135 C     Create the dim within the file
                0136       IF (doWrite(1:1) .EQ. 'Y') THEN
                0137
                0138         tlen = dlen
                0139         IF (dlen .LT. 1)  tlen = NF_UNLIMITED
                0140
3f2ea2a4ed Ed H*0141         CALL MNC_FILE_REDEF(fname, myThid)
75987013ac Ed H*0142         err = NF_DEF_DIM(mnc_f_info(indf,2), dname(dnf:dnl), tlen, idd)
                0143         write(msgbuf,'(5a)') 'MNC_DIM_INIT ERROR: cannot create ',
                0144      &       'dim ''', dname(dnf:dnl), ''' in file ''', fname(1:nf)
3f2ea2a4ed Ed H*0145         CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
75987013ac Ed H*0146
d77e828db7 Ed H*0147 C       Create and write the associated CF-convention
                0148 C       coordinate variable
                0149         IF (bi .GT. -1) THEN
                0150           CALL MNC_CW_WRITE_CVAR(fname, dname(dnf:dnl),
                0151      &         mnc_f_info(indf,2), idd, bi, bj, myThid)
                0152         ENDIF
                0153
a27dc5c859 Ed H*0154       ENDIF
                0155
                0156 C     Add to tables
75987013ac Ed H*0157       mnc_d_names(indd)(1:(dnl-dnf+1)) = dname(dnf:dnl)
dad4143247 Ed H*0158       mnc_d_size(indd) = dlen
75987013ac Ed H*0159       mnc_d_ids(indd) = idd
dad4143247 Ed H*0160       mnc_f_alld(indf,1) = n + 1
                0161       mnc_f_alld(indf,n+2) = indd
a27dc5c859 Ed H*0162
                0163       RETURN
                0164       END
                0165
ef84d10314 Ed H*0166 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0167 CBOP 1
1b5fb69d21 Ed H*0168 C     !ROUTINE: MNC_DIM_UNLIM_SIZE
ef84d10314 Ed H*0169
1b5fb69d21 Ed H*0170 C     !INTERFACE:
ef84d10314 Ed H*0171       SUBROUTINE MNC_DIM_UNLIM_SIZE(
                0172      I     fname,
3f2ea2a4ed Ed H*0173      I     unlim_sz,
                0174      I     myThid )
ef84d10314 Ed H*0175
1b5fb69d21 Ed H*0176 C     !DESCRIPTION:
                0177 C     Get the size of the unlimited dimension.
                0178
                0179 C     !USES:
ef84d10314 Ed H*0180       implicit none
07155994b8 Mart*0181 #include "MNC_COMMON.h"
ef84d10314 Ed H*0182 #include "EEPARAMS.h"
853ee6565e Jean*0183 #include "netcdf.inc"
ef84d10314 Ed H*0184
1b5fb69d21 Ed H*0185 C     !INPUT PARAMETERS:
ef84d10314 Ed H*0186       integer myThid, unlim_sz
                0187       character*(*) fname
e6bb5b2cc3 Ed H*0188 CEOP
ef84d10314 Ed H*0189
1b5fb69d21 Ed H*0190 C     !LOCAL VARIABLES:
ef84d10314 Ed H*0191       integer i,j, nf, indf, fid, unlimid, err
                0192       character*(MAX_LEN_MBUF) msgbuf
e6bb5b2cc3 Ed H*0193
1b5fb69d21 Ed H*0194 C     Functions
d77e828db7 Ed H*0195       integer ILNBLNK
ef84d10314 Ed H*0196
                0197       nf = ILNBLNK(fname)
                0198
                0199 C     Verify that the file exists
ef92f00980 Ed H*0200       CALL MNC_GET_IND(MNC_MAX_FID, fname, mnc_f_names, indf, myThid)
ef84d10314 Ed H*0201       IF (indf .LT. 1) THEN
                0202         write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),
                0203      &       ''' does not exist'
                0204         CALL print_error(msgbuf, mythid)
                0205         stop 'ABNORMAL END: S/R MNC_DIM_UNLIM_SIZE'
                0206       ENDIF
                0207       fid = mnc_f_info(indf,2)
                0208
                0209 C     Find the unlimited dim and its current size
                0210       unlim_sz = -1
                0211       DO i = 1,mnc_f_alld(indf,1)
                0212         j = mnc_f_alld(indf,i+1)
                0213         IF (mnc_d_size(j) .EQ. -1) THEN
                0214           unlimid = mnc_d_ids(j)
                0215           err = NF_INQ_DIMLEN(fid, unlimid, unlim_sz)
                0216           write(msgbuf,'(3a)') 'MNC_DIM_UNLIM_SIZE ERROR: cannot ',
                0217      &         'determine unlimited dim size in file ''', fname(1:nf)
3f2ea2a4ed Ed H*0218           CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
ef84d10314 Ed H*0219           RETURN
                0220         ENDIF
                0221       ENDDO
                0222
                0223       RETURN
                0224       END
                0225
                0226
                0227 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0228