pkg/grdchk/grdchk_ctrl_fname.F

1052c30783 Jean*0001 #include "GRDCHK_OPTIONS.h"
                0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
                0005
                0006 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0007 CBOP
                0008 C !ROUTINE: GRDCHK_CTRL_FNAME
                0009
                0010 C !INTERFACE:
                0011       SUBROUTINE GRDCHK_CTRL_FNAME(
5cf4364659 Mart*0012      U                              fName,
                0013      U                              grdchk_index,
                0014      I                              myThid )
1052c30783 Jean*0015
                0016 C     !DESCRIPTION:
5cf4364659 Mart*0017 C     associate control file-name with the grdchk_index,
                0018 C     depending on which one is set
1052c30783 Jean*0019
                0020 C     !USES:
                0021       IMPLICIT NONE
                0022 C     == Global variables ===
                0023 #include "EEPARAMS.h"
                0024 #include "SIZE.h"
                0025 #include "CTRL_SIZE.h"
                0026 #include "CTRL.h"
                0027 #include "CTRL_GENARR.h"
                0028 #ifdef ALLOW_OBCS_CONTROL
                0029 # include "CTRL_OBCS.h"
                0030 #endif
                0031
                0032 C     !INPUT/OUTPUT PARAMETERS:
                0033 C     fName        :: name of the CTRL var/file matching grdchk_index
                0034 C     grdchk_index :: grdchk index of CTRL variable to perturb
                0035 C     myThid       :: my Thread Id number
                0036       CHARACTER*(MAX_LEN_FNAM) fName
                0037       INTEGER grdchk_index
                0038       INTEGER myThid
                0039
                0040 C     !FUNCTIONS:
5cf4364659 Mart*0041       INTEGER  ILNBLNK
                0042       EXTERNAL ILNBLNK
1052c30783 Jean*0043
                0044 C     !LOCAL VARIABLES:
                0045 C     msgBuf     :: Informational/error message buffer
                0046       CHARACTER*(MAX_LEN_MBUF) msgBuf
5cf4364659 Mart*0047       INTEGER il, jl, ivar
1052c30783 Jean*0048 CEOP
                0049
5cf4364659 Mart*0050       IF ( grdchk_index .EQ. UNSET_I ) THEN
                0051 C--   If not set, determine grdchk_index from fName (= grdchkvarname)
                0052        IF ( fName .NE. ' ' ) THEN
                0053         jl = ILNBLNK(fName)
                0054         DO ivar = 1, maxcvars
                0055          IF ( grdchk_index .EQ. UNSET_I ) THEN
                0056           il = ILNBLNK(ncvarfname(ivar))
                0057           IF ( il.EQ.jl .AND. ncvarfname(ivar)(1:il).EQ.fName(1:il) )
                0058      &      grdchk_index = ivar
                0059          ENDIF
                0060         ENDDO
                0061        ENDIF
                0062
                0063        IF ( grdchk_index .EQ. UNSET_I ) THEN
                0064         WRITE(msgBuf,'(3A)') 'S/R GRDCHK_CTRL_FNAME: ',
                0065      &       'grdchkvarindex is not set and could not be determined ',
                0066      &       'from grdchkvarname'
1052c30783 Jean*0067         CALL PRINT_ERROR( msgBuf, myThid )
                0068         STOP 'ABNORMAL END: S/R GRDCHK_CTRL_FNAME'
5cf4364659 Mart*0069        ENDIF
1052c30783 Jean*0070
5cf4364659 Mart*0071       ELSEIF ( grdchk_index.LE.0 .OR. grdchk_index.GT.maxcvars ) THEN
                0072 C--   check for valid index value
1052c30783 Jean*0073
5cf4364659 Mart*0074         WRITE(msgBuf,'(2A,I8)') 'GRDCHK_CTRL_FNAME: ',
                0075      &        'Invalid grdchk_index=', grdchk_index
                0076         CALL PRINT_ERROR( msgBuf, myThid )
                0077         STOP 'ABNORMAL END: S/R GRDCHK_CTRL_FNAME'
1052c30783 Jean*0078
5cf4364659 Mart*0079       ELSEIF ( fName .NE. ' ' ) THEN
                0080 C--   IF both grdchk_index and fName are set, check for consistency
                0081        jl = ILNBLNK(fName)
                0082        il = ILNBLNK(ncvarfname(grdchk_index))
                0083        IF ( il.NE.jl .OR.
                0084      &      fName(1:il) .NE. ncvarfname(grdchk_index)(1:il) ) THEN
                0085         WRITE(msgBuf,'(5A)') 'S/R GRDCHK_CTRL_FNAME: ',
                0086      &       'fName(grdchkvarindex) = ', fName(1:jl),
                0087      &       ' .NE. ncvarfname = ', ncvarfname(grdchk_index)(1:il)
                0088         CALL PRINT_ERROR( msgBuf, myThid )
                0089         STOP 'ABNORMAL END: S/R GRDCHK_CTRL_FNAME'
                0090        ENDIF
1052c30783 Jean*0091
                0092       ELSE
5cf4364659 Mart*0093 C--   set fName from grdchk_index:
                0094         fName = ncvarfname( grdchk_index )
1052c30783 Jean*0095       ENDIF
                0096
                0097       RETURN
                0098       END