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.
169 lines
6.1 KiB
169 lines
6.1 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 SRCHT (
|
|
* NPSRF, NFSRF, LINKSRF, XYZSRF,
|
|
* NPTS, XYZPTS, TOLSRCH,
|
|
* NISR, NRSR, NISS, NRSS, ISRCHR, RSRCHR, LBLK,
|
|
* LIST, IND, IRNK, IRNK2, INDX, ILO, IUP,
|
|
* IDP, IDS, XMIN, XMAX, ISCR, RSCR, IERR)
|
|
|
|
C-----------------------------------------------------------------------
|
|
|
|
C DESCRIPTION:
|
|
|
|
C THIS SUBROUTINE CALCULATES THE CLOSEST POINT PROBLEM
|
|
C BETWEEN NPTS POINTS AND NFSRF SURFACES AND RETURNS RESULTS OF
|
|
C SEARCH IN ISRCHR,RSRCHR
|
|
|
|
C USED HERE FOR FINDING LOCATION OF EITHER NODE OR ELEMENT CENTROID
|
|
C FROM MESH-B IN TET-8 ELEMENT OF MESH-A
|
|
|
|
C-----------------------------------------------------------------------
|
|
|
|
C FORMAL PARAMETERS
|
|
|
|
C MEMORY : P=PERMANENT, S=SCRATCH
|
|
C NAME : IMPLICIT A-H,O-Z REAL, I-N INTEGER
|
|
C TYPE : INPUT_STATUS/OUTPUT_STATUS (I=INPUT,O=OUTPUT,P=PASSED,
|
|
C U=UNMODIFIED,-=UNDEFINED)
|
|
C DESCRIPTION : DESCRIPTION OF VARIABLE
|
|
|
|
C-----------------------------------------------------------------------
|
|
|
|
C CALLING ARGUMENTS:
|
|
|
|
C MEMORY NAME TYPE DESCRIPTION
|
|
C --- ---- --- -----------
|
|
C P NPSRF I/U NUMBER OF POINTS THAT DEFINE THE SURFACE
|
|
C P NFSRF I/U NUMBER OF SURFACES
|
|
C P LINKSRF I/U CONNECTIVITY OF SURFACES OF SIZE (8*NFSRF),
|
|
C NUMBERS REFER TO LOCATIONS IN XYZSRF ARRAY
|
|
C P XYZSRF I/U XYZ COORDS OF POINTS DEFINING SURFACE
|
|
C P NPTS I/U NUMBER OF POINTS TO BE SEARCHED
|
|
C P XYZPTS I/U XYZ COORDS OF POINTS TO BE SEARCHED
|
|
C P TOLSRCH I/U PROXIMITY TOLERANCE FOR POINT-TO-SURFACE SEARCH
|
|
C P NISR I/U NUMBER OF INTEGER SEARCH RESULTS (>=1)
|
|
C P NRSR I/U NUMBER OF REAL SEARCH RESULTS (>=4)
|
|
C P NISS I/U NUMBER OF INTEGER SEARCH SCRATCH (=5)
|
|
C P NRSS I/U NUMBER OF REAL SEARCH SCRATCH (=10)
|
|
C P ISRCHR -/O INTEGER SEARCH RESULTS
|
|
C P RSRCHR -/O REAL SEARCH RESULTS
|
|
C P LBLK I/U VECTOR BLOCKING PARAMETER (RECOMMEND 512 ON CRAY)
|
|
C S LIST -/- LIST OF POTENTIAL CONTACTS FOR A SURFACE
|
|
C S IND -/- INDEX ARRAY INDICATING COORD. ORDER OF EACH POINT
|
|
C S IRNK -/- RANK ARRAY
|
|
C S IRNK2 -/- RANK ARRAY (INDIRECT)
|
|
C S INDX -/P INTERMEDIATE LIST OF POTENTIAL PAIRS (CONSTRUCTED
|
|
C AFTER THE INTERSECTION OF TWO OF THREE LISTS)
|
|
C S ILO -/- SEARCH BOX MINIMUM INDEX
|
|
C S IUP -/- SEARCH BOX MAXIMUM INDEX
|
|
C S XMIN -/- SEARCH BOX MINIMUM DIMENSION
|
|
C S XMAX -/- SEARCH BOX MAXIMUM DIMENSION
|
|
C S ISCR -/- INTEGER SCRATCH MEMORY
|
|
C S RSCR -/- REAL SCRATCH MEMORY
|
|
C P IERR -/O ERROR FLAG
|
|
|
|
C-----------------------------------------------------------------------
|
|
|
|
include 'tapes.blk'
|
|
|
|
C INPUT/OUTPUT ARRAYS
|
|
|
|
DIMENSION
|
|
* LINKSRF(4,NFSRF), XYZSRF(NPSRF,3),
|
|
* XYZPTS(NPTS,3),
|
|
* ISRCHR(NISR,NPTS), RSRCHR(NRSR,NPTS)
|
|
DIMENSION
|
|
* LIST(NPTS), IND(NPTS,3), IRNK(NPTS,3),
|
|
* IRNK2(NPTS,3,2), INDX(NPTS)
|
|
DIMENSION
|
|
* ILO(LBLK,3), IUP(LBLK,3), IDP(LBLK),
|
|
* IDS(LBLK)
|
|
DIMENSION
|
|
* XMIN(LBLK,3), XMAX(LBLK,3), ISCR(NISS*LBLK),
|
|
* RSCR(NRSS*LBLK)
|
|
|
|
C ISRCHR and RSRCHR must be initialized to zero
|
|
|
|
DO 1 I = 1, NPTS
|
|
DO 2 J = 1, NISR
|
|
ISRCHR(J,I) = 0
|
|
2 CONTINUE
|
|
DO 3 K = 1, NRSR
|
|
RSRCHR(K,I) = 0.
|
|
3 CONTINUE
|
|
1 CONTINUE
|
|
|
|
IF( NISR .LT. 1 .OR. NRSR .LT. 3 .OR. NISS .LT. 5 .OR.
|
|
* NRSS .LT. 10 )THEN
|
|
IERR = 1
|
|
RETURN
|
|
ENDIF
|
|
C DIMENSION OF COORDINATES
|
|
NDIM = 3
|
|
|
|
C CALL SORTING ROUTINE TO MAKE RANK ARRAYS
|
|
CALL MKRNK( NPTS,NPTS,NDIM,XYZPTS,IND,IRNK,IRNK2 )
|
|
|
|
C LOOP OVER SURFACES AND SEARCH FOR POINTS WITHIN CAPTURE BOX
|
|
DO 100 IFSRF = 1, NFSRF, LBLK
|
|
NE = MIN(LBLK,NFSRF-IFSRF+1)
|
|
C CONSTRUCT THE BOUNDING BOX FOR NE SURFACES
|
|
DO 110 J = 1, NE
|
|
JFSRF = IFSRF + J - 1
|
|
NI = LINKSRF(1,JFSRF)
|
|
NJ = LINKSRF(2,JFSRF)
|
|
NK = LINKSRF(3,JFSRF)
|
|
NL = LINKSRF(4,JFSRF)
|
|
|
|
XMINMS = MIN(XYZSRF(NI,1),XYZSRF(NJ,1),
|
|
* XYZSRF(NK,1),XYZSRF(NL,1))
|
|
XMAXMS = MAX(XYZSRF(NI,1),XYZSRF(NJ,1),
|
|
* XYZSRF(NK,1),XYZSRF(NL,1))
|
|
YMINMS = MIN(XYZSRF(NI,2),XYZSRF(NJ,2),
|
|
* XYZSRF(NK,2),XYZSRF(NL,2))
|
|
YMAXMS = MAX(XYZSRF(NI,2),XYZSRF(NJ,2),
|
|
* XYZSRF(NK,2),XYZSRF(NL,2))
|
|
ZMINMS = MIN(XYZSRF(NI,3),XYZSRF(NJ,3),
|
|
* XYZSRF(NK,3),XYZSRF(NL,3))
|
|
ZMAXMS = MAX(XYZSRF(NI,3),XYZSRF(NJ,3),
|
|
* XYZSRF(NK,3),XYZSRF(NL,3))
|
|
TOLER = TOLSRCH * (XMAXMS - XMINMS)
|
|
XMIN(J,1) = XMINMS - TOLER
|
|
XMAX(J,1) = XMAXMS + TOLER
|
|
TOLER = TOLSRCH * (YMAXMS - YMINMS)
|
|
XMIN(J,2) = YMINMS - TOLER
|
|
XMAX(J,2) = YMAXMS + TOLER
|
|
TOLER = TOLSRCH * (ZMAXMS - ZMINMS)
|
|
XMIN(J,3) = ZMINMS - TOLER
|
|
XMAX(J,3) = ZMAXMS + TOLER
|
|
110 CONTINUE
|
|
|
|
DO 120 IDIM = 1, NDIM
|
|
CALL GETBND( LBLK, NE, XYZPTS(1,IDIM), IND(1,IDIM),
|
|
* NPTS, XMIN(1,IDIM), XMAX(1,IDIM),
|
|
* NPTS, ILO(1,IDIM), IUP(1,IDIM),
|
|
* ISCR, RSCR )
|
|
120 CONTINUE
|
|
|
|
DO 130 J = 1, NE
|
|
JFSRF = IFSRF + J - 1
|
|
CALL MKLSTV(NPTS,IND,IRNK2,IUP,ILO,INDX,J,LIST,NLIST,
|
|
* LBLK,NDIM)
|
|
|
|
DO 140 K = 1, NLIST
|
|
LVAL = LIST(K)
|
|
CALL TETSRC(
|
|
* NDIM, NPTS, NPSRF, NFSRF, NISR,
|
|
* NRSR, NRSS, XYZSRF, XYZPTS, LINKSRF,
|
|
* ISRCHR, RSRCHR, LVAL, JFSRF, IERR )
|
|
|
|
140 CONTINUE
|
|
130 CONTINUE
|
|
100 CONTINUE
|
|
RETURN
|
|
END
|
|
|