C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/mnc/mnc_dim.F,v 1.10 2004/04/02 16:12:48 edhill Exp $ C $Name: $ #include "MNC_OPTIONS.h" C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CBOP 0 C !ROUTINE: MNC_DIM_INIT C !INTERFACE: SUBROUTINE MNC_DIM_INIT( I fname, I dname, I dlen, I myThid ) C !DESCRIPTION: C Create a dimension within the MNC look-up tables. C !INPUT PARAMETERS: integer myThid, dlen character*(*) fname, dname CEOP CALL MNC_DIM_INIT_ALL(fname, dname, dlen, 'Y', myThid) RETURN END C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CBOP 1 C !ROUTINE: MNC_DIM_INIT_ALL C !INTERFACE: SUBROUTINE MNC_DIM_INIT_ALL( I fname, I dname, I dlen, I doWrite, I myThid ) C !DESCRIPTION: C Create a dimension within the MNC look-up tables. C !USES: implicit none #include "netcdf.inc" #include "mnc_common.h" #include "EEPARAMS.h" C !INPUT PARAMETERS: integer myThid, dlen character*(*) fname, dname character*(1) doWrite CEOP C !LOCAL VARIABLES: integer i,j, indf,indd, n,nf, dnf,dnl integer ntmp, idd, err, tlen character*(MAX_LEN_MBUF) msgbuf C Functions integer ILNBLNK, IFNBLNK nf = ILNBLNK(fname) dnf = IFNBLNK(dname) dnl = ILNBLNK(dname) C Verify that the file exists CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid) IF ( indf .LT. 1 ) THEN write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf), & ''' does not exist' CALL print_error( msgbuf, mythid ) stop 'ABNORMAL END: S/R MNC_DIM_INIT' ENDIF C Verify that the dim is not currently defined within the file n = mnc_f_alld(indf,1) DO i = 1,n j = mnc_f_alld(indf,i+1) ntmp = ILNBLNK(mnc_d_names(j)) IF ((ntmp .EQ. (dnl-dnf+1)) & .AND. (dname(dnf:dnl) .EQ. mnc_d_names(j)(1:ntmp))) THEN IF (mnc_d_size(j) .NE. dlen) THEN IF ((mnc_d_size(j) .GT. 0) .OR. (dlen .GT. 0)) THEN write(msgbuf,'(5a)') 'MNC ERROR: dimension ''', & dname(dnf:dnl), ''' already exists within file ''', & fname(1:nf), ''' and its size cannot be changed' CALL print_error(msgbuf, mythid) stop 'ABNORMAL END: S/R MNC_DIM_INIT' ELSE C Its OK, the names are the same and both are specifying the C unlimited dimension RETURN ENDIF ELSE C Its OK, the names and sizes are identical RETURN ENDIF ENDIF ENDDO CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_d_names, indd, myThid) C Create the dim within the file IF (doWrite(1:1) .EQ. 'Y') THEN tlen = dlen IF (dlen .LT. 1) tlen = NF_UNLIMITED CALL MNC_FILE_REDEF(fname, myThid) err = NF_DEF_DIM(mnc_f_info(indf,2), dname(dnf:dnl), tlen, idd) write(msgbuf,'(5a)') 'MNC_DIM_INIT ERROR: cannot create ', & 'dim ''', dname(dnf:dnl), ''' in file ''', fname(1:nf) CALL MNC_HANDLE_ERR(err, msgbuf, myThid) ENDIF C Add to tables mnc_d_names(indd)(1:(dnl-dnf+1)) = dname(dnf:dnl) mnc_d_size(indd) = dlen mnc_d_ids(indd) = idd mnc_f_alld(indf,1) = n + 1 mnc_f_alld(indf,n+2) = indd RETURN END C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CBOP 1 C !ROUTINE: MNC_DIM_UNLIM_SIZE C !INTERFACE: SUBROUTINE MNC_DIM_UNLIM_SIZE( I fname, I unlim_sz, I myThid ) C !DESCRIPTION: C Get the size of the unlimited dimension. C !USES: implicit none #include "netcdf.inc" #include "mnc_common.h" #include "EEPARAMS.h" C !INPUT PARAMETERS: integer myThid, unlim_sz character*(*) fname CEOP C !LOCAL VARIABLES: integer i,j, nf, indf, fid, unlimid, err character*(MAX_LEN_MBUF) msgbuf C Functions integer ILNBLNK, IFNBLNK nf = ILNBLNK(fname) C Verify that the file exists CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid) IF (indf .LT. 1) THEN write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf), & ''' does not exist' CALL print_error(msgbuf, mythid) stop 'ABNORMAL END: S/R MNC_DIM_UNLIM_SIZE' ENDIF fid = mnc_f_info(indf,2) C Find the unlimited dim and its current size unlim_sz = -1 DO i = 1,mnc_f_alld(indf,1) j = mnc_f_alld(indf,i+1) IF (mnc_d_size(j) .EQ. -1) THEN unlimid = mnc_d_ids(j) err = NF_INQ_DIMLEN(fid, unlimid, unlim_sz) write(msgbuf,'(3a)') 'MNC_DIM_UNLIM_SIZE ERROR: cannot ', & 'determine unlimited dim size in file ''', fname(1:nf) CALL MNC_HANDLE_ERR(err, msgbuf, myThid) RETURN ENDIF ENDDO RETURN END C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|