pkg/mnc/mnc_cw_citer.F

5bc9611487 Ed H*0001 #include "MNC_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004
                0005 CBOP 0
                0006 C     !ROUTINE: MNC_CW_CITER_SETG
                0007
                0008 C     !INTERFACE:
                0009       SUBROUTINE MNC_CW_CITER_SETG(
                0010      I     igroup,
                0011      I     iflag, ival_curr, ival_next,
                0012      I     myThid )
                0013
                0014 C     !DESCRIPTION:
                0015 C     Set CITER information for group "igroup"
                0016
                0017 C     !USES:
                0018       implicit none
07155994b8 Mart*0019 #include "MNC_COMMON.h"
5bc9611487 Ed H*0020
                0021 C     !INPUT PARAMETERS:
                0022       integer igroup, iflag, ival_curr, ival_next, myThid
                0023 CEOP
                0024
01902801fa Ed H*0025 C     !LOCAL VARIABLES:
                0026       integer i
                0027
5bc9611487 Ed H*0028       mnc_cw_cit(1,igroup) = iflag
                0029       IF ( ival_curr .GT. 0 ) THEN
01902801fa Ed H*0030
                0031         IF ( mnc_cw_cit(2,igroup) .NE. ival_curr ) THEN
                0032
                0033 C         The current iteration number has changed so we need to reset
                0034 C         the unlimited dimension for all the files in this citer group
                0035           DO i = 1,MNC_MAX_ID
                0036             IF ( mnc_cw_fgci(i) .eq. igroup ) THEN
                0037               mnc_cw_fgud(i) = 0
                0038             ENDIF
                0039           ENDDO
                0040
                0041           mnc_cw_cit(2,igroup) = ival_curr
                0042
                0043         ENDIF
                0044
5bc9611487 Ed H*0045       ENDIF
                0046       IF ( ival_next .GT. 0 ) THEN
                0047         mnc_cw_cit(3,igroup) = ival_next
                0048       ENDIF
                0049
                0050       RETURN
                0051       END
                0052
                0053 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0054
                0055 CBOP 0
                0056 C     !ROUTINE: MNC_CW_CITER_GETG
                0057
                0058 C     !INTERFACE:
                0059       SUBROUTINE MNC_CW_CITER_GETG(
                0060      I     igroup,
                0061      O     iflag, ival_curr, ival_next,
                0062      I     myThid )
                0063
                0064 C     !DESCRIPTION:
                0065 C     Get the current CITER information for group "igroup"
                0066
                0067 C     !USES:
                0068       implicit none
07155994b8 Mart*0069 #include "MNC_COMMON.h"
5bc9611487 Ed H*0070
                0071 C     !INPUT PARAMETERS:
                0072       integer igroup, iflag, ival_curr, ival_next, myThid
                0073 CEOP
                0074
                0075       iflag     = mnc_cw_cit(1,igroup)
                0076       ival_curr = mnc_cw_cit(2,igroup)
                0077       ival_next = mnc_cw_cit(3,igroup)
                0078
                0079       RETURN
                0080       END
                0081
                0082 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0083
                0084 CBOP 0
                0085 C     !ROUTINE: MNC_CW_SET_CITER
                0086
                0087 C     !INTERFACE:
                0088       SUBROUTINE MNC_CW_SET_CITER(
                0089      I     fgname,
                0090      I     igroup,
                0091      I     iflag, ival_curr, ival_next,
                0092      I     myThid )
                0093
                0094 C     !DESCRIPTION:
                0095 C     Set the flag and/or current iteration value
                0096
                0097 C     !USES:
                0098       implicit none
07155994b8 Mart*0099 #include "MNC_COMMON.h"
5bc9611487 Ed H*0100 #include "EEPARAMS.h"
                0101
                0102 C     !INPUT PARAMETERS:
                0103       integer igroup, iflag, ival_curr, ival_next, myThid
                0104       character*(*) fgname
                0105 CEOP
                0106
                0107 C     !LOCAL VARIABLES:
                0108       integer fgf,fgl, indfg
                0109       character*(MAX_LEN_MBUF) msgbuf
                0110
                0111 C     Functions
                0112       integer IFNBLNK, ILNBLNK
                0113
                0114 C     Check that this name is not already defined
                0115       fgf = IFNBLNK(fgname)
                0116       fgl = ILNBLNK(fgname)
                0117       CALL MNC_GET_IND(MNC_MAX_ID, fgname, mnc_cw_fgnm, indfg, myThid)
                0118       IF (indfg .LT. 1) THEN
                0119 C       Error if this file group name is not set
                0120         write(msgbuf,'(3a)')
                0121      &       'MNC_CW_SET_CITER ERROR: the file group name ''',
                0122      &       fgname(fgf:fgl), ''' does not exist'
                0123         CALL print_error(msgbuf, mythid)
                0124         STOP 'ABNORMAL END: S/R MNC_CW_SET_CITER'
                0125       ENDIF
                0126
                0127       IF (igroup .LT. 1) THEN
                0128         igroup = mnc_cw_fgci(indfg)
                0129       ELSE
                0130         mnc_cw_fgci(indfg) = igroup
                0131       ENDIF
                0132       IF ((igroup .LT. 1) .OR. (igroup .GT. MNC_MAX_INFO)) THEN
                0133         write(msgbuf,'(4a)')
                0134      &       'MNC_CW_SET_CITER ERROR: invalid igroup index for ',
                0135      &       'file group name ''', fgname(fgf:fgl), ''''
                0136         CALL print_error(msgbuf, mythid)
                0137         STOP 'ABNORMAL END: S/R MNC_CW_SET_CITER'
                0138       ENDIF
                0139
                0140       CALL MNC_CW_CITER_SETG( igroup,
                0141      &     iflag, ival_curr, ival_next, myThid )
                0142
                0143       RETURN
                0144       END
                0145
                0146 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0147
                0148 CBOP 0
                0149 C     !ROUTINE: MNC_CW_GET_CITER
                0150
                0151 C     !INTERFACE:
                0152       SUBROUTINE MNC_CW_GET_CITER(
                0153      I     fgname,
                0154      O     igroup,
                0155      O     iflag, ival_curr, ival_next,
                0156      I     myThid )
                0157
                0158 C     !DESCRIPTION:
                0159 C     Set the flag and/or current iteration value
                0160
                0161 C     !USES:
                0162       implicit none
07155994b8 Mart*0163 #include "MNC_COMMON.h"
5bc9611487 Ed H*0164 #include "EEPARAMS.h"
                0165
                0166 C     !INPUT PARAMETERS:
                0167       integer igroup, iflag, ival_curr, ival_next, myThid
                0168       character*(*) fgname
                0169 CEOP
                0170
                0171 C     !LOCAL VARIABLES:
                0172       integer fgf,fgl, indfg
                0173       character*(MAX_LEN_MBUF) msgbuf
                0174
                0175 C     Functions
                0176       integer IFNBLNK, ILNBLNK
                0177
                0178 C     Check that this name is not already defined
                0179       fgf = IFNBLNK(fgname)
                0180       fgl = ILNBLNK(fgname)
                0181       CALL MNC_GET_IND(MNC_MAX_ID, fgname, mnc_cw_fgnm, indfg, myThid)
                0182       IF (indfg .LT. 1) THEN
                0183 C       Error if this file group name is not set
                0184         write(msgbuf,'(3a)')
                0185      &       'MNC_CW_SET_CITER ERROR: the file group name ''',
                0186      &       fgname(fgf:fgl), ''' does not exist'
                0187         CALL print_error(msgbuf, mythid)
                0188         STOP 'ABNORMAL END: S/R MNC_CW_SET_CITER'
                0189       ENDIF
                0190
                0191       igroup = mnc_cw_fgci(indfg)
                0192       IF ((igroup .LT. 1) .OR. (igroup .GT. MNC_MAX_INFO)) THEN
                0193         igroup    = -1
                0194         iflag     = -1
                0195         ival_curr = -1
                0196         ival_next = -1
                0197       ELSE
                0198         CALL MNC_CW_CITER_GETG( igroup,
                0199      &       iflag, ival_curr, ival_next, myThid )
                0200       ENDIF
                0201
                0202
                0203       RETURN
                0204       END
                0205
                0206 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0207