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.
122 lines
3.9 KiB
122 lines
3.9 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 GAPINI (A, COORD, IDESS, NEESS, NNESS, IPEESS, IPNESS,
|
|
* LTEESS, LTNESS, FACESS, DISP, NUMNP, NDIM, NUMESS,
|
|
* TIME, ITMSEL, TITLE, IMAS, ISLV, DMAX, GMTHD)
|
|
|
|
DIMENSION A(*), COORD(NUMNP,*), IDESS(*), NEESS(*),
|
|
* NNESS(*), IPEESS(*), IPNESS(*), LTEESS(*), LTNESS(*),
|
|
* FACESS(*), TIME(*), DISP(NUMNP,*)
|
|
LOGICAL ITMSEL(*)
|
|
CHARACTER*80 TITLE, STRA
|
|
CHARACTER*8 GMTHD
|
|
LOGICAL ERROR
|
|
|
|
IFLGM = LOCINT (IMAS, NUMESS, IDESS)
|
|
IFLGS = LOCINT (ISLV, NUMESS, IDESS)
|
|
|
|
ERROR = .FALSE.
|
|
IF (IFLGM .EQ. 0) THEN
|
|
WRITE (STRA, 10) 'Master', IMAS
|
|
CALL SQZSTR (STRA, LSTR)
|
|
CALL PRTERR ('ERROR', STRA(:LSTR))
|
|
10 FORMAT (1X,A,' Surface Flag ',I5,' not found. ')
|
|
ERROR = .TRUE.
|
|
END IF
|
|
IF (IFLGS .EQ. 0) THEN
|
|
WRITE (STRA, 10) 'Slave', ISLV
|
|
CALL SQZSTR (STRA, LSTR)
|
|
CALL PRTERR ('ERROR', STRA(:LSTR))
|
|
ERROR = .TRUE.
|
|
END IF
|
|
IF (ERROR) RETURN
|
|
|
|
NSEGM = NEESS(IFLGM)
|
|
IPTRM = IPNESS(IFLGM)
|
|
|
|
NSEGS = NEESS(IFLGS)
|
|
IPTRS = IPNESS(IFLGS)
|
|
|
|
MULT = 2 * NDIM - 2
|
|
CALL MDRSRV ('MAPMAS', IMPMS, MULT*NSEGM)
|
|
CALL MDRSRV ('MAPSLV', IMPSL, MULT*NSEGS)
|
|
CALL MDRSRV ('ITEMP', ITMP, MAX(NUMNP,3*NSEGM))
|
|
CALL MDSTAT (NERRS, NUSED)
|
|
IF (NERRS .GT. 0) THEN
|
|
CALL MEMERR
|
|
STOP
|
|
END IF
|
|
|
|
CALL UNIQUE (LTNESS(IPTRM), MULT*NSEGM, A(IMPMS), A(ITMP),
|
|
* NIQM, NUMNP)
|
|
CALL MDRSRV ('MASSLV', IMSLV, 2*NIQM)
|
|
CALL MDRSRV ('DIRCOS', IDCOS, (NDIM+2)*NIQM)
|
|
CALL MDSTAT (NERRS, NUSED)
|
|
IF (NERRS .GT. 0) THEN
|
|
CALL MEMERR
|
|
STOP
|
|
END IF
|
|
CALL TRANIQ (LTNESS(IPTRM), A(IMPMS), A(IMSLV), MULT*NSEGM, 2)
|
|
|
|
CALL UNIQUE (LTNESS(IPTRS), MULT*NSEGS, A(IMPSL), A(ITMP),
|
|
* NIQS, NUMNP)
|
|
CALL MDRSRV ('NIQSLV', INQS, NIQS)
|
|
CALL MDSTAT (NERRS, NUSED)
|
|
IF (NERRS .GT. 0) THEN
|
|
CALL MEMERR
|
|
STOP
|
|
END IF
|
|
CALL TRANIQ (LTNESS(IPTRS), A(IMPSL), A(INQS), MULT*NSEGS, 1)
|
|
|
|
DMAX = DMAX**2
|
|
IF (DMAX .EQ. 0.0) DMAX = 1.0E38
|
|
|
|
IF (MAX(NUMNP, 3*NSEGM) .LT. 4*NIQS) THEN
|
|
CALL MDLONG ('ITEMP', ITMP, 4*NIQS)
|
|
CALL MDSTAT (NERRS, NUSED)
|
|
IF (NERRS .GT. 0) THEN
|
|
CALL MEMERR
|
|
STOP
|
|
END IF
|
|
END IF
|
|
IF (NDIM .EQ. 3) THEN
|
|
CALL DONRM3 (COORD, LTNESS(IPTRM), A(IMPMS), A(IDCOS),
|
|
* A(ITMP), NSEGM, NIQM, NUMNP)
|
|
IF (GMTHD .EQ. 'DISTANCE') THEN
|
|
CALL GMDIS3 (COORD, A(IDCOS), A(IMSLV), A(INQS), A(ITMP),
|
|
* A(ITMP+3*NIQS), NIQM, NIQS, DMAX, NUMNP)
|
|
ELSE IF (GMTHD .EQ. 'NORMAL') THEN
|
|
CALL GMTCH3 (COORD, A(IDCOS), A(IMSLV), A(INQS), A(ITMP),
|
|
* A(ITMP+3*NIQS), NIQM, NIQS, DMAX, NUMNP)
|
|
END IF
|
|
ELSE
|
|
CALL DONRM2 (COORD, LTNESS(IPTRM), A(IMPMS), A(IDCOS),
|
|
* A(ITMP), NSEGM, NIQM, NUMNP)
|
|
IF (GMTHD .EQ. 'DISTANCE') THEN
|
|
CALL GMDIS2 (COORD, A(IDCOS), A(IMSLV), A(INQS), A(ITMP),
|
|
* NIQM, NIQS, DMAX, NUMNP)
|
|
ELSE IF (GMTHD .EQ. 'NORMAL') THEN
|
|
CALL GMTCH2 (COORD, A(IDCOS), A(IMSLV), A(INQS), A(ITMP),
|
|
* NIQM, NIQS, DMAX, NUMNP)
|
|
END IF
|
|
END IF
|
|
CALL GAPOUT (A(IDCOS), A(IMSLV), NIQM, NDIM, IDESS(IFLGM),
|
|
* IDESS(IFLGS), GMTHD)
|
|
|
|
CALL MDDEL ('MAPMAS')
|
|
CALL MDDEL ('MAPSLV')
|
|
CALL MDDEL ('ITEMP' )
|
|
CALL MDDEL ('MASSLV')
|
|
CALL MDDEL ('DIRCOS')
|
|
CALL MDDEL ('NIQSLV')
|
|
CALL MDSTAT (NERRS, NUSED)
|
|
IF (NERRS .GT. 0) THEN
|
|
CALL MEMERR
|
|
STOP
|
|
END IF
|
|
RETURN
|
|
END
|
|
|