Cloned SEACAS for EXODUS library with extra build files for internal package management.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

80 lines
2.0 KiB

C Copyright(C) 1999-2020 National Technology & Engineering Solutions
C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
C NTESS, the U.S. Government retains certain rights in this software.
C
C See packages/seacas/LICENSE for details
SUBROUTINE SRCHI(IVEC,ILBIN,IUBIN,NUM,ICOD,LOC)
C THIS SUBROUTINE SEARCHES ROW ILB THOURGH ROW IUB OF A
C NUMERICALLY ORDERED INTEGER COLUMN VECTOR FOR THE OCCURRENCE
C THE VALUE NUM.
C IF NUM IS FOUND ICOD IS SET TO UNITY AND LOC IS THE ROW NUMBER
C WHERE NUM RESIDES. IF NUM IS NOT FOUND ICOD IS ZERO AND LOC IS
C THE ROW NUMBER WHERE NUM WOULD RESIDE IF IT WERE IN THE NUMER-
C ICALLY ORDER LIST. BOB LUST
C THIS SUBROUTINE HAS BEEN CHANGED FROM BOB LUST'S VERSION
C AND NOW ASSUMES THAT THERE IS NO MORE THAN ONE MATCH
C IN THE ORDERED LIST 'IVEC'. BILL MILLS-CURRAN JAN. 1, 1983
C IVEC ORDERED LIST
C ILBIN LOW NUMBERED ROW OF SEARCH RANGE
C IUBIN HIGH NUMBERED ROW OF SEARCH RANGE
C NUM VALUE TO BE LOCATED IN IVEC
C ICOD RETURN CODE 0 = NO MATCH 1 = MATCH
C LOC LOCATION IN IVEC FOR NUM
DIMENSION IVEC(1)
ILB = ILBIN
IUB = IUBIN
ICOD=0
IF (IUB .LT. ILB) THEN
LOC = 1
RETURN
END IF
C CHECK TO SEE IF NUM IS AT EITHER END OF LIST
IF(IVEC(ILB).GT.NUM)THEN
LOC=ILB
RETURN
ELSE IF(IVEC(IUB).LT.NUM) THEN
LOC=IUB+1
RETURN
END IF
C NUM IS INTERNAL TO IVEC
100 MID=(ILB+IUB)/2
IF(MID.LE.ILB)GO TO 110
NVAL=IVEC(MID)
IF(NVAL.LT.NUM) THEN
ILB=MID
GO TO 100
ELSE IF(NVAL.GT.NUM) THEN
IUB=MID
GO TO 100
ELSE
ICOD=1
LOC=MID
RETURN
END IF
110 IF(NUM.EQ.IVEC(ILB)) THEN
ICOD=1
LOC=ILB
RETURN
ELSE IF(NUM.EQ.IVEC(IUB)) THEN
ICOD=1
LOC=IUB
RETURN
ELSE
LOC=IUB
RETURN
END IF
END