      SUBROUTINE ADJBLK (BLKNUM,ROW,TOTBLK,DELBLK,ERROR)
      IMPLICIT NONE
C**********************************************************************
C
C   NAME-  ADJBLK
C
C   LANGUAGE- FORTRAN 77     TYPE- SUBROUTINE      COMPUTER- CRAY    
C
C   VERSION- 1.0    DATE-  08/22/91 PROGRAMMER- JEFFREY R. JONES (SMSRC)
C   VERSION- 3.0    DATE-  05/21/96 PROGRAMMER- ALEX POZDNYAK (FDC)     
C     FOR REHOSTING TO THE CRAY, CHANGED ALL I*4 DECLARATIONS TO
C     INTEGER. 
C
C   DESCRIPTION-  ADJBLK MAKES THE ADJUSTMENT TO THE BLOCK_NUMBER,
C                 REMOVING ANY BLOCKS THAT DO NOT CONTAIN THE MAP.
C                 THIS IS DONE BY DETERMINING HOW MANY BLOCKS HAVE
C                 LOWER BLOCK NUMBERS AND DO NOT CONTAIN A PORTION
C                 OF THE MAP. THIS NUMBER IS SUBTRACTED FROM THE
C                 BLOCK_NUMBER. THIS ROUTINE IS CALLED ONLY FOR MAPS
C                 THAT HAVE MESH FACTORS OF 1/8 OR LESS. FOR SMALLER
C                 MESH SIZE GRIDS, BLOCKS THAT CAN BE DELETED, COVER
C                 AN EQUAL AREA AT EACH OF THE FOUR CORNERS. IF THE
C                 ROW_NUMBER OR THE CONSTANT MAPCST:ADJFAC HAVE INVALID
C                 VALUES, ADJBL$ IS CALLED TO WRITE A MESSAGE TO THE
C                 KIDS MESSAGE LOG AND SET THE ERROR RETURN CODE.
C
C   CALLING SEQUENCE PARAMETERS-
C
C      ARGUMENTS TYPE  I/O             DESCRIPTION
C      --------- ----  ---  -----------------------------------------
C      BLKNUM    INT   I/O  HOLDS THE BLOCK NUMBER TO BE ADJUSTED AS
C                           INPUT AND THE ADJUSTED BLOCK NUMBER AS
C                           OUTPUT.
C      ROW       INT    I   HOLDS THE ROW OF THE BLOCK TO BE ADJUSTED.
C      TOTBLK    INT    I   HOLDS THE TOTAL NUMBER OF BLOCKS IN A ROW
C                           OR COLUMN.  THIS NUMBER IS EQUAL TO THE
C                           INVERSE OF THE MESH FACTOR.
C      DELBLK    INT         HOLDS THE NUMBER OF ROWS THAT HAVE BLOCKS
C                            THAT MAY BE DELETED IN ONE GROUP. THERE ARE
C                            TWO GROUPS, ONE AT THE BOTTOM OF THE BLOCK
C                            AND THE OTHER AT THE TOP.
C      ERROR     INT   I/O  HOLDS THE ERROR RETURN CODE.
C                              0 - SUCCESSFUL COMPLETION.
C                             99 - FATAL ERROR.
C
C   COMMON AREA PARAMETERS-
C
      INCLUDE 'MAPCST'
C
C   LOCAL PARAMETERS-
C
C   ARGUMENTS TYPE  I/O             DESCRIPTION
C   --------- ----  ---  -----------------------------------------
C   INVROW    INT   N/A  USED FOR COMPUTING THE ROW NUMBERS OF
C                        THE CURRENT BLOCK IF IT IS IN THE LAST FEW
C                        ROWS OF THE GRID THAT CONTAIN DELETABLE
C                        BLOCKS.
C
C   SUBPROGRAMS CALLED- ADJBL$
C
C   EXIT STATES-
C      99 - FATAL ERROR: AN INVALID VALUE WAS FOUND FOR THE BLOCK
C                        ADJUSTMENT FACTOR IN THE INCLUDE MAPCST OR
C                        THE INPUT ROW WAS OFF THE GRID.
C
C   COMMENTS-
C      1. TOTAL BLOCKS IS GREATER THAN OR EQUAL TO ADJFAC.
C
C**********************************************************************
C
      INTEGER  BLKNUM, ROW, TOTBLK, DELBLK, ERROR
C
      INTEGER  INVROW
C
C     INITIALIZE VARIABLES
C
      INVROW = 0
C
C     MAKE SURE ADJUSTMENT FACTOR IS A VALID NUMBER.
C
      IF (ADJFAC .LE. 0) THEN
C
C         HANDLE ERROR.
C
          CALL ADJBL$(610, ADJFAC, ERROR)
          GOTO 10
C
C     MAKE SURE BLOCKS ROW IS ON GRID.
C
      ELSE IF ((ROW .LT. 1) .OR. (ROW .GT. TOTBLK)) THEN
C
C         HANDLE ERROR.
C
          CALL ADJBL$(620, ROW, ERROR)
          GOTO 10
C
      ELSE
C
C         DETERMINE WHAT ROW BLOCK IS ON GRID.
C
          IF (ROW .LE. DELBLK) THEN
C
C             IF BLOCK IS IN THE FIRST FEW ROWS THAT HAVE BLOCKS THAT
C             DO NOT CONTAIN THE MAP THEN SUBTRACT THE NUMBER OF
C             DELETABLE BLOCKS THAT ARE LOCATED BEFORE THE CURRENT
C             BLOCK.
C
              BLKNUM = BLKNUM - ((ROW + ROW - 1) * DELBLK)
C
C             BLOCK IN LOWER ROWS.
C
          ELSE
C
C             SUBTRACT THE NUMBER OF DELETABLE BLOCKS CONTAINED IN
C             THE FIRST FEW ROWS.
C
              BLKNUM = BLKNUM - (2 * (DELBLK ** 2))
C
C             DETERMINE IF BLOCK IS IN THE LAST FEW ROWS THAT CONTAIN
C             DELETABLE BLOCKS.
C
              IF (ROW .GT. (TOTBLK - DELBLK)) THEN
C
C                 BLOCK IS IN THE LAST FEW ROWS.  CALCULATE WHAT ROW
C                 OF THE LAST GROUP OF ROWS THAT CONTAIN DELETABLE
C                 BLOCKS THE CURRENT BLOCK IS IN.
C
                  INVROW = ROW - (TOTBLK - DELBLK)
C
C                 SUBTRACT THE NUMBER OF DELETABLE BLOCKS CONTAINED IN
C                 THE LAST FEW ROWS.
C
                  BLKNUM = BLKNUM-((INVROW+INVROW-1) * DELBLK)
C
              END IF
C
          END IF
      END IF
   10 RETURN
C
      END
C**********************************************************************
      SUBROUTINE ADJBL$(MSGCOD,ARG,STAT)
C**********************************************************************
C   NAME- ADJBL$
C
C   LANGUAGE- FORTRAN 77     TYPE- SUBROUTINE      COMPUTER- CRAY     
C
C   VERSION- 1.0    DATE- 05/07/91  PROGRAMMER- JEFFREY R. JONES (SMSRC)
C   VERSION- 3.0    DATE- 10/10/97  PROGRAMMER- LEAH WILSON (HSTX)
C
C   FUNCTION- THIS SUBROUTINE IS THE ERROR HANDLING ROUTINE FOR
C             ROUTINE ADJBLK.
C   VERSION- 3.0 WRITE ERROR MESSAGES TO THE KIDS FILE.  INCLUDE /SPGUNT/.
C
C   FILES-
C     DSN                  I/O   UNIT    FUNCTIONAL DESCRIPTION
C     ---                  ---  ------   -----------------------
C     ...KIDS               O    KUNIT   KRAY INTERACTIVE DOCUMENTATION
C
C   CALLING SEQUENCE PARAMETERS-
C
C     VARIABLE               TYPE  I/O  FUNCTION
C     --------               ----  ---  --------
C     MSGCOD                  INT   I   MESSAGE CODE USED TO
C                                       IDENTITIFY THE ERROR
C
C     ARG                     REAL  I   DEPENDING ON THE ERROR, THIS
C                                       VARIABLE COULD HOLD THE BLOCK
C                                       ADJUSTMENT FACTOR OR THE
C                                       BLOCKS ROW.
C
C     STAT                    INT   O   STATUS CODE IF AN ERROR
C                                       OCCURS DURING I/O
C
C   COMMON AREA PARAMETERS-
C
      INCLUDE 'SPGUNT'
      INCLUDE 'ERPARM'
      INCLUDE 'ERINFO'
C
C   LOCAL PARAMETERS-
C
C     VARIABLE                TYPE    FUNCTION
C     --------                ----    --------
C     KMSG                   CH*100   KIDS MESSAGE BUFFER
C     C4TEMP                  CH*4    HOLDING BUFFER FOR WRITING TO KIDS
C
C   SUBROUTINES CALLED- KIDS
C
C**********************************************************************
C
      INTEGER       MSGCOD,STAT, ARG
      CHARACTER*4   C4TEMP
      CHARACTER*100 KMSG
C
C  SET ERINFO:SUBNAM
C
      SUBNAM = 'SPGDVR'
C
C  CHECK MESSAGE CODE AND WRITE ERROR MESSAGE
C
      IF (MSGCOD .EQ. 610) THEN
        KMSG(1:50)=' * FATAL ERROR * Block adj. factor of      should '
        KMSG(51:100)='not be less than or equal to zero.        '
        WRITE(C4TEMP,'(I4)') ARG
        KMSG(39:42) = C4TEMP
        STAT = 99
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
C
      ELSE IF (MSGCOD .EQ. 620) THEN
        KMSG(1:50)=' * FATAL ERROR * Computed row number:      for the'
        KMSG(51:100)='block is outside of the grid.             '
        WRITE(C4TEMP,'(I4)') ARG
        KMSG(39:42) = C4TEMP
        STAT = 99
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
C
      ELSE
C
C NOT A VALID MSGCOD
C
        STAT=0
        KMSG = ' Invalid error message code = '
        WRITE(C4TEMP,'(I4)') MSGCOD
        KMSG(31:34) = C4TEMP
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
      ENDIF
      RETURN
      END
