pkg/mnc/mnc_cw_udim.F

85c5caf7c2 Ed H*0001 #include "MNC_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0004 CBOP 0
1b5fb69d21 Ed H*0005 C !ROUTINE: MNC_CW_SET_UDIM
85c5caf7c2 Ed H*0006
1b5fb69d21 Ed H*0007 C !INTERFACE:
85c5caf7c2 Ed H*0008       SUBROUTINE MNC_CW_SET_UDIM(
                0009      I     fgname,
                0010      I     nudim,
                0011      I     myThid )
                0012
1b5fb69d21 Ed H*0013 C     !DESCRIPTION:
                0014 C     For a specified file group name, set the size of the NetCDF
e6bb5b2cc3 Ed H*0015 C     unlimited (or record) dimension.  The options are:
                0016 C     \begin{equation}
                0017 C       \label{eq:yo}
                0018 C       \mbox{\bf nudim} = \left\{
                0019 C         \begin{array}[htb]{cl}
                0020 C           >0,  &  \mbox{\small use the specified value} \\
                0021 C           0,   &  \mbox{\small use the largest currently defined value} \\
                0022 C           -1,  &  \mbox{\small increment the largest value and then use it} \\
                0023 C         \end{array}
                0024 C         \right.
                0025 C     \end{equation}
                0026
1b5fb69d21 Ed H*0027 C     !USES:
85c5caf7c2 Ed H*0028       implicit none
07155994b8 Mart*0029 #include "MNC_COMMON.h"
85c5caf7c2 Ed H*0030 #include "EEPARAMS.h"
                0031
1b5fb69d21 Ed H*0032 C     !INPUT PARAMETERS:
85c5caf7c2 Ed H*0033       integer nudim, myThid
                0034       character*(*) fgname
e6bb5b2cc3 Ed H*0035 CEOP
85c5caf7c2 Ed H*0036
1b5fb69d21 Ed H*0037 C     !LOCAL VARIABLES:
85c5caf7c2 Ed H*0038       integer fgf,fgl, indfg
                0039       character*(MAX_LEN_MBUF) msgbuf
e6bb5b2cc3 Ed H*0040
1b5fb69d21 Ed H*0041 C     Functions
                0042       integer IFNBLNK, ILNBLNK
85c5caf7c2 Ed H*0043
                0044 C     Check that this name is not already defined
                0045       fgf = IFNBLNK(fgname)
                0046       fgl = ILNBLNK(fgname)
                0047       CALL MNC_GET_IND(MNC_MAX_ID, fgname, mnc_cw_fgnm, indfg, myThid)
0007eca320 Ed H*0048       IF (indfg .LT. 1) THEN
                0049         CALL MNC_GET_NEXT_EMPTY_IND(
9705a0d5c6 Ed H*0050      &       MNC_MAX_ID, mnc_cw_fgnm, 'mnc_cw_fgnm', indfg, myThid)
ab11ba1276 Ed H*0051         mnc_cw_fgnm(indfg)(1:(fgl-fgf+1)) = fgname(fgf:fgl)
357126def9 Ed H*0052         mnc_cw_fgud(indfg) = 0
ab11ba1276 Ed H*0053         mnc_cw_fgig(indfg) = 0
85c5caf7c2 Ed H*0054       ENDIF
357126def9 Ed H*0055       IF (nudim .GT. 0) THEN
ab11ba1276 Ed H*0056         mnc_cw_fgig(indfg) = 0
357126def9 Ed H*0057         mnc_cw_fgud(indfg) = nudim
                0058         RETURN
                0059       ENDIF
ab11ba1276 Ed H*0060       IF (nudim .EQ. 0) THEN
                0061         mnc_cw_fgig(indfg) = 0
                0062         RETURN
                0063       ENDIF
357126def9 Ed H*0064       IF (nudim .EQ. -1) THEN
ab11ba1276 Ed H*0065         mnc_cw_fgig(indfg) = 1
357126def9 Ed H*0066         mnc_cw_fgud(indfg) = mnc_cw_fgud(indfg) + 1
                0067         RETURN
                0068       ENDIF
500776b010 Davi*0069       write(msgbuf,'(3a,i10,a)')
357126def9 Ed H*0070      &     'MNC_CW_SET_UDIM ERROR: for file group name ''',
                0071      &     fgname(fgf:fgl), ''' the unlim dim ''', nudim,
                0072      &     ''' is not allowed'
                0073       CALL print_error(msgbuf, mythid)
                0074       STOP 'ABNORMAL END: S/R MNC_CW_SET_UDIM'
85c5caf7c2 Ed H*0075
                0076       RETURN
                0077       END
                0078
                0079 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e6bb5b2cc3 Ed H*0080 CBOP 0
1b5fb69d21 Ed H*0081 C !ROUTINE: MNC_CW_GET_UDIM
85c5caf7c2 Ed H*0082
1b5fb69d21 Ed H*0083 C !INTERFACE:
85c5caf7c2 Ed H*0084       SUBROUTINE MNC_CW_GET_UDIM(
                0085      I     fgname,
                0086      O     nudim,
                0087      I     myThid )
                0088
1b5fb69d21 Ed H*0089 C     !DESCRIPTION:
                0090 C     For a specified file group name, get the size of the NetCDF
                0091 C     unlimited (or record) dimension.
                0092
                0093 C     !USES:
85c5caf7c2 Ed H*0094       implicit none
07155994b8 Mart*0095 #include "MNC_COMMON.h"
85c5caf7c2 Ed H*0096 #include "EEPARAMS.h"
                0097
1b5fb69d21 Ed H*0098 C     !INPUT PARAMETERS:
85c5caf7c2 Ed H*0099       integer nudim, myThid
                0100       character*(*) fgname
e6bb5b2cc3 Ed H*0101 CEOP
85c5caf7c2 Ed H*0102
1b5fb69d21 Ed H*0103 C     !LOCAL VARIABLES:
85c5caf7c2 Ed H*0104       integer fgf,fgl, indfg
                0105       character*(MAX_LEN_MBUF) msgbuf
e6bb5b2cc3 Ed H*0106
1b5fb69d21 Ed H*0107 C     Functions
                0108       integer IFNBLNK, ILNBLNK
85c5caf7c2 Ed H*0109
                0110       fgf = IFNBLNK(fgname)
                0111       fgl = ILNBLNK(fgname)
                0112       CALL MNC_GET_IND(MNC_MAX_ID, fgname, mnc_cw_fgnm, indfg, myThid)
                0113       IF (indfg .LT. 1) THEN
                0114         write(msgbuf,'(3a)')
357126def9 Ed H*0115      &       'MNC_CW_GET_UDIM ERROR: file group name ''',
85c5caf7c2 Ed H*0116      &       fgname(fgf:fgl), ''' is not defined'
                0117         CALL print_error(msgbuf, mythid)
357126def9 Ed H*0118         STOP 'ABNORMAL END: S/R MNC_CW_GET_UDIM'
85c5caf7c2 Ed H*0119       ENDIF
                0120       nudim = mnc_cw_fgud(indfg)
                0121
                0122       RETURN
                0123       END
                0124
                0125 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|