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.
295 lines
8.9 KiB
295 lines
8.9 KiB
2 years ago
|
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
|
||
|
|
|
||
|
|
C=======================================================================
|
||
|
|
*DECK,RDA1
|
||
|
|
SUBROUTINE RDA1(XA,YA,ZA,DISXA,DISYA,DISZA)
|
||
|
|
|
||
|
|
C ******************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE TO EXTRACTREAD THE CRITICAL INPUT AND SIZING PARAMETERS
|
||
|
|
C FROM THE GENESIS FILE FOR MESH-A
|
||
|
|
|
||
|
|
C READS MESH A, WRITES MESH C DATA AS APPROPRIATE
|
||
|
|
|
||
|
|
C Calls function LENSTR
|
||
|
|
C Calls subroutine ERROR
|
||
|
|
|
||
|
|
C Called by MAPVAR
|
||
|
|
|
||
|
|
C ******************************************************************
|
||
|
|
|
||
|
|
C XA,etc REAL Coordinates of mesh-A nodes (1:nodesa)
|
||
|
|
C DISXA,etc REAL Displacements of mesh-A nodes (1:nodesa)
|
||
|
|
|
||
|
|
C ******************************************************************
|
||
|
|
|
||
|
|
include 'aexds1.blk'
|
||
|
|
include 'aexds2.blk'
|
||
|
|
include 'amesh.blk'
|
||
|
|
include 'contrl.blk'
|
||
|
|
include 'ex2tp.blk'
|
||
|
|
include 'rundat.blk'
|
||
|
|
include 'steps.blk'
|
||
|
|
include 'varnpt.blk'
|
||
|
|
include 'varept.blk'
|
||
|
|
|
||
|
|
DIMENSION xa(*),ya(*),za(*)
|
||
|
|
DIMENSION DISXA(*),DISYA(*),DISZA(*)
|
||
|
|
|
||
|
|
PARAMETER (MAXQA=240)
|
||
|
|
|
||
|
|
C ******************************************************************
|
||
|
|
|
||
|
|
C nodal point coordinates and names
|
||
|
|
|
||
|
|
CALL EXGCON (NTP2EX,NAMECO,IERR)
|
||
|
|
|
||
|
|
C Convert to upper case
|
||
|
|
|
||
|
|
DO 10 I = 1, NDIMA
|
||
|
|
CALL EXUPCS(NAMECO(I))
|
||
|
|
10 CONTINUE
|
||
|
|
|
||
|
|
CALL EXPCON (NTP4EX,NAMECO,IERR)
|
||
|
|
CALL EXGCOR (NTP2EX,XA,YA,ZA,IERR)
|
||
|
|
|
||
|
|
C QA
|
||
|
|
|
||
|
|
NQAREC = EXINQI(NTP2EX,EXQA)
|
||
|
|
|
||
|
|
IF (NQAREC.GT.MAXQA) THEN
|
||
|
|
CALL ERROR ('RDA1','TOO MANY QA RECORDS IN
|
||
|
|
1MESH-A FILE','NO. RECORDS',NQAREC,'NO. RECORDS ALLOWED',240,
|
||
|
|
2'ONLY LAST 239 QA RECORDS RETAINED',
|
||
|
|
3'IF NOT ACCEPTABLE SEE CODE SPONSOR TO INCREASE ARRAY QALINE',0)
|
||
|
|
NQAREC = MAXQA
|
||
|
|
END IF
|
||
|
|
|
||
|
|
CALL EXGQA (NTP2EX,QALINE,IERR)
|
||
|
|
IF (NQAREC .EQ. MAXQA)THEN
|
||
|
|
DO IQ = 1,4
|
||
|
|
DO NQ = 2,MAXQA
|
||
|
|
QALINE(IQ,NQ) = QALINE(IQ,NQ-1)
|
||
|
|
end do
|
||
|
|
end do
|
||
|
|
ELSE
|
||
|
|
NQAREC = NQAREC + 1
|
||
|
|
END IF
|
||
|
|
|
||
|
|
QALINE(1,NQAREC) = QAINFO(1)
|
||
|
|
QALINE(2,NQAREC) = QAINFO(3)
|
||
|
|
QALINE(3,NQAREC) = QAINFO(5)
|
||
|
|
QALINE(4,NQAREC) = QAINFO(6)
|
||
|
|
CALL EXPQA (NTP4EX,NQAREC,QALINE,IERR)
|
||
|
|
|
||
|
|
C VARIABLE NAMES
|
||
|
|
|
||
|
|
CALL EXGVP (NTP2EX,"G",NVARGP,IERR)
|
||
|
|
|
||
|
|
C Do some error checking on number of variables - got me once
|
||
|
|
|
||
|
|
NUMNAM = NVARGP
|
||
|
|
IF (NUMNAM .GT. MXVAR)CALL ERROR('RDA1','TOO MANY VARIABLE NAMES
|
||
|
|
1IN MESH-A DATA BASE','NUMBER OF VARIABLE NAMES ENCOUNTERED SO
|
||
|
|
2FAR',NUMNAM,'NUMBER ALLOWED - FIXED DIMENSION',MXVAR,'SEE CODE
|
||
|
|
3SPONSOR FOR INCREASE IN --NAMVAR--',' ',1)
|
||
|
|
|
||
|
|
if (nvargp .gt. 0) then
|
||
|
|
CALL EXGVAN (NTP2EX,"G",NVARGP,NAMVAR,IERR)
|
||
|
|
|
||
|
|
C Convert to upper case
|
||
|
|
|
||
|
|
DO I = 1, NVARGP
|
||
|
|
CALL EXUPCS(NAMVAR(I))
|
||
|
|
end do
|
||
|
|
|
||
|
|
CALL EXPVP (NTP4EX,"G",NVARGP,IERR)
|
||
|
|
CALL EXPVAN (NTP4EX,"G",NVARGP,NAMVAR,IERR)
|
||
|
|
end if
|
||
|
|
|
||
|
|
CALL EXGVP (NTP2EX,"E",NVAREL,IERR)
|
||
|
|
|
||
|
|
NUMNAM = NUMNAM + NVAREL
|
||
|
|
IF (NUMNAM .GT. MXVAR)CALL ERROR('RDA1','TOO MANY VARIABLE NAMES
|
||
|
|
1IN MESH-A DATA BASE','NUMBER OF VARIABLE NAMES ENCOUNTERED SO
|
||
|
|
2FAR',NUMNAM,'NUMBER ALLOWED - FIXED DIMENSION',MXVAR,'SEE CODE
|
||
|
|
3SPONSOR FOR INCREASE IN --NAMVAR--',' ',1)
|
||
|
|
|
||
|
|
if (nvarel .gt. 0) then
|
||
|
|
CALL EXGVAN (NTP2EX,"E",NVAREL,NAMVAR(NVARGP+1),IERR)
|
||
|
|
|
||
|
|
C Convert to upper case
|
||
|
|
|
||
|
|
DO I = 1, NVAREL
|
||
|
|
CALL EXUPCS(NAMVAR(NVARGP+I))
|
||
|
|
end do
|
||
|
|
|
||
|
|
CALL EXPVP (NTP4EX,"E",NVAREL,IERR)
|
||
|
|
CALL EXPVAN (NTP4EX,"E",NVAREL,NAMVAR(NVARGP+1),IERR)
|
||
|
|
end if
|
||
|
|
|
||
|
|
CALL EXGVP (NTP2EX,"N",NVARNP,IERR)
|
||
|
|
|
||
|
|
NUMNAM = NUMNAM + NVARNP
|
||
|
|
IF (NUMNAM .GT. MXVAR)CALL ERROR('RDA1','TOO MANY VARIABLE NAMES
|
||
|
|
1IN MESH-A DATA BASE','NUMBER OF VARIABLE NAMES ENCOUNTERED SO
|
||
|
|
2FAR',NUMNAM,'NUMBER ALLOWED - FIXED DIMENSION',MXVAR,'SEE CODE
|
||
|
|
3SPONSOR FOR INCREASE IN --NAMVAR--',' ',1)
|
||
|
|
|
||
|
|
if (nvarnp .gt. 0) then
|
||
|
|
CALL EXGVAN (NTP2EX,"N",NVARNP,NAMVAR(NVARGP+NVAREL+1),IERR)
|
||
|
|
|
||
|
|
C Convert to upper case
|
||
|
|
|
||
|
|
DO I = 1, NVARNP
|
||
|
|
CALL EXUPCS(NAMVAR(NVARGP+NVAREL+I))
|
||
|
|
end do
|
||
|
|
|
||
|
|
CALL EXPVP (NTP4EX,"N",NVARNP,IERR)
|
||
|
|
CALL EXPVAN (NTP4EX,"N",NVARNP,NAMVAR(NVARGP+NVAREL+1),IERR)
|
||
|
|
end if
|
||
|
|
|
||
|
|
LC1 = LENSTR (NAMECO(1))
|
||
|
|
LC2 = LENSTR (NAMECO(2))
|
||
|
|
LC3 = 2
|
||
|
|
IF (NDIMA .EQ. 3) LC3 = LENSTR (NAMECO(3))
|
||
|
|
ISTART = 1+NVARGP+NVAREL
|
||
|
|
DO I = ISTART, NUMNAM
|
||
|
|
LN = LENSTR (NAMVAR(I))
|
||
|
|
IF (NAMVAR(I)(1:1) .EQ. 'D')THEN
|
||
|
|
IF(NAMVAR(I)(LN:LN) .EQ. NAMECO(1)(LC1:LC1))
|
||
|
|
& IXDIS=I-ISTART+1
|
||
|
|
IF(NAMVAR(I)(LN:LN) .EQ. NAMECO(2)(LC2:LC2))
|
||
|
|
& IYDIS=I-ISTART+1
|
||
|
|
IF (NDIMA .GE. 3)THEN
|
||
|
|
IF(NAMVAR(I)(LN:LN) .EQ. NAMECO(3)(LC3:LC3))
|
||
|
|
& IZDIS=I-ISTART+1
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
end do
|
||
|
|
|
||
|
|
IF (IDEF .NE. 0 .AND. IXDIS .NE. 0 .AND. IYDIS .NE. 0)THEN
|
||
|
|
|
||
|
|
C Work in deformed coordinates
|
||
|
|
|
||
|
|
CALL EXGNV (NTP2EX,ISTEP,IXDIS,NODESA,DISXA,IERR)
|
||
|
|
CALL EXGNV (NTP2EX,ISTEP,IYDIS,NODESA,DISYA,IERR)
|
||
|
|
IF (NDIMA .GE. 3) THEN
|
||
|
|
CALL EXGNV (NTP2EX,ISTEP,IZDIS,NODESA,DISZA,IERR)
|
||
|
|
END IF
|
||
|
|
DO I = 1, NODESA
|
||
|
|
XA(I) = XA(I) + DISXA(I)
|
||
|
|
YA(I) = YA(I) + DISYA(I)
|
||
|
|
IF (NDIMA .GE. 3) ZA(I) = ZA(I) + DISZA(I)
|
||
|
|
end do
|
||
|
|
ELSE
|
||
|
|
|
||
|
|
C No displacements in Mesh-A data, can't do deformed processing
|
||
|
|
|
||
|
|
IDEF = 0
|
||
|
|
END IF
|
||
|
|
IF (IACCU .EQ. 1)THEN
|
||
|
|
|
||
|
|
C ********************************************************************
|
||
|
|
C accuracy checK
|
||
|
|
C ********************************************************************
|
||
|
|
|
||
|
|
C find needed variables
|
||
|
|
C 1st velocities
|
||
|
|
C coordinate names - velocity will start with "v"
|
||
|
|
C and end with last character
|
||
|
|
C of coordinate name
|
||
|
|
|
||
|
|
LC1 = LENSTR(NAMECO(1))
|
||
|
|
LC2 = LENSTR(NAMECO(2))
|
||
|
|
LC3 = 2
|
||
|
|
IF (NDIMA .EQ. 3)LC3 = LENSTR(NAMECO(3))
|
||
|
|
|
||
|
|
C search nodal variables, get ptrs to vel's and elmass if available
|
||
|
|
|
||
|
|
IXVEL = 0
|
||
|
|
IYVEL = 0
|
||
|
|
IZVEL = 0
|
||
|
|
IELMS = 0
|
||
|
|
IDENS = 0
|
||
|
|
ISTART = 1+NVARGP+NVAREL
|
||
|
|
DO 90 INAM = ISTART, NUMNAM
|
||
|
|
IF (NAMVAR(INAM)(1:1) .EQ. 'V')THEN
|
||
|
|
LN = LENSTR(NAMVAR(INAM))
|
||
|
|
IF (NAMVAR(INAM)(LN:LN) .EQ. NAMECO(1)(LC1:LC1))THEN
|
||
|
|
IXVEL = INAM - ISTART + 1
|
||
|
|
GO TO 90
|
||
|
|
END IF
|
||
|
|
IF (NAMVAR(INAM)(LN:LN) .EQ. NAMECO(2)(LC2:LC2))THEN
|
||
|
|
IYVEL = INAM - ISTART + 1
|
||
|
|
GO TO 90
|
||
|
|
END IF
|
||
|
|
IF (NDIMA .EQ. 3)THEN
|
||
|
|
IF (NAMVAR(INAM)(LN:LN) .EQ. NAMECO(3)(LC3:LC3))THEN
|
||
|
|
IZVEL = INAM - ISTART + 1
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
90 CONTINUE
|
||
|
|
ISTART = 1+NVARGP
|
||
|
|
IEND = NVARGP+NVAREL
|
||
|
|
DO 100 INAM = ISTART, IEND
|
||
|
|
IF (NAMVAR(INAM)(1:6) .EQ. 'ELMASS')THEN
|
||
|
|
IELMS = INAM - ISTART + 1
|
||
|
|
GO TO 100
|
||
|
|
ELSE IF (NAMVAR(INAM)(1:4) .EQ. 'DENS')THEN
|
||
|
|
IDENS = INAM - ISTART + 1
|
||
|
|
GO TO 100
|
||
|
|
ELSE IF (NAMVAR(INAM)(1:3) .EQ. 'SIG')THEN
|
||
|
|
LN = LENSTR(NAMVAR(INAM))
|
||
|
|
IF (NAMVAR(INAM)(LN-1:LN) .EQ. 'XX')THEN
|
||
|
|
ISXX = INAM - ISTART +1
|
||
|
|
GO TO 100
|
||
|
|
ELSE IF (NAMVAR(INAM)(LN-1:LN) .EQ. 'YY')THEN
|
||
|
|
ISYY = INAM - ISTART +1
|
||
|
|
GO TO 100
|
||
|
|
ELSE IF (NAMVAR(INAM)(LN-1:LN) .EQ. 'ZZ')THEN
|
||
|
|
ISZZ = INAM - ISTART +1
|
||
|
|
GO TO 100
|
||
|
|
ELSE IF (NAMVAR(INAM)(LN-1:LN) .EQ. 'XY')THEN
|
||
|
|
ISXY = INAM - ISTART +1
|
||
|
|
GO TO 100
|
||
|
|
ELSE IF (NAMVAR(INAM)(LN-1:LN) .EQ. 'YZ')THEN
|
||
|
|
ISYZ = INAM - ISTART +1
|
||
|
|
GO TO 100
|
||
|
|
ELSE IF (NAMVAR(INAM)(LN-1:LN) .EQ. 'ZX')THEN
|
||
|
|
ISZX = INAM - ISTART +1
|
||
|
|
GO TO 100
|
||
|
|
END IF
|
||
|
|
ELSE IF (NAMVAR(INAM)(1:4) .EQ. 'USIG')THEN
|
||
|
|
LN = LENSTR(NAMVAR(INAM))
|
||
|
|
IF (NAMVAR(INAM)(LN-1:LN) .EQ. 'XX')THEN
|
||
|
|
ISXX = INAM - ISTART +1
|
||
|
|
GO TO 100
|
||
|
|
ELSE IF (NAMVAR(INAM)(LN-1:LN) .EQ. 'YY')THEN
|
||
|
|
ISYY = INAM - ISTART +1
|
||
|
|
GO TO 100
|
||
|
|
ELSE IF (NAMVAR(INAM)(LN-1:LN) .EQ. 'ZZ')THEN
|
||
|
|
ISZZ = INAM - ISTART +1
|
||
|
|
GO TO 100
|
||
|
|
ELSE IF (NAMVAR(INAM)(LN-1:LN) .EQ. 'XY')THEN
|
||
|
|
ISXY = INAM - ISTART +1
|
||
|
|
GO TO 100
|
||
|
|
ELSE IF (NAMVAR(INAM)(LN-1:LN) .EQ. 'YZ')THEN
|
||
|
|
ISYZ = INAM - ISTART +1
|
||
|
|
GO TO 100
|
||
|
|
ELSE IF (NAMVAR(INAM)(LN-1:LN) .EQ. 'ZX')THEN
|
||
|
|
ISZX = INAM - ISTART +1
|
||
|
|
GO TO 100
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
100 CONTINUE
|
||
|
|
END IF
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|