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.
1012 lines
38 KiB
1012 lines
38 KiB
2 years ago
|
C Copyright(C) 1999-2021 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 MESH (A, IA, MP, ML, MS, MR, MSC, MA, MCOM, ICOM, JCOM,
|
||
|
|
& CIN, RIN, IIN, KIN, IDUMP, N, IPOINT, COOR, IPBOUN, ILINE,
|
||
|
|
& LTYPE, NINT, FACTOR, LCON, ILBOUN, ISBOUN, ISIDE, NLPS, IFLINE,
|
||
|
|
& ILLIST, IBARST, JMAT, JCENT, NLPB, JFLINE, JLLIST, IREGN, IMAT,
|
||
|
|
& NSPR, IFSIDE, ISLIST, IRPB, IPBF, NPPF, IFPB, LISTPB, ILBF,
|
||
|
|
& NLPF, IFLB, LISTLB, ISBF, NSPF, IFSB, LISTSB, LINKP, LINKL,
|
||
|
|
& LINKS, LINKB, LINKR, LINKM, LINKSC, LINKPB, LINKLB, LINKSB,
|
||
|
|
& IWTPBF, IWTLBF, IWTSBF, RSIZE, IFHOLE, NHPR, IHLIST, IRGFLG,
|
||
|
|
& ISCHM, SCHEME, NUMBER, DEFSCH, DEFSIZ, TITLE, OPTIM, IDEV,
|
||
|
|
& ALPHA, DEV1, THREE, EIGHT, NINE, BATCH, VAXVMS, VERSN, AXIS,
|
||
|
|
& AREACG, LABN, LABE, LABO, LABNB, LABSB, LABM, LABW, WROTE,
|
||
|
|
& TIME1, HARDPL, EXODUSII)
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE MESH = PROCESSES THE MESH AND THEN GRAPHICALLY DISPLAYS
|
||
|
|
C THE MESH
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE CALLED BY:
|
||
|
|
C FASTQ = A PROGRAM TO QUICKLY PREPARE QMESH INPUT
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINES CALLED:
|
||
|
|
C QMESH = GENERATES THE MESH
|
||
|
|
C RENUM = ASSIGNS NODAL AND ELEMENT NUMBERS TO THE MESH
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C VARIABLES USED:
|
||
|
|
C IANS = LOGICAL RESPONSE FROM YES-NO QUESTION
|
||
|
|
C TITLE = MESH TITLE
|
||
|
|
C TALL = CHARACTER HEIGHT SETTING PARAMETER
|
||
|
|
C STEP = .TRUE. IF GENERATION TO BE STEPPED THROUGH INTERACTIVELY
|
||
|
|
C DONE = .TRUE. IF MESH HAS BEEN PROCESSED
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
PARAMETER (MAXNAM = 40, MLINK = 55)
|
||
|
|
|
||
|
|
include 'exodusII.inc'
|
||
|
|
|
||
|
|
C DIMENSIONS FOR MESH DEFINING ENTITIES (I.E. POINTS, LINES, ETC.)
|
||
|
|
|
||
|
|
DIMENSION A(1), IA(1)
|
||
|
|
DIMENSION IPOINT(MP), COOR(2, MP), IPBOUN(MP)
|
||
|
|
DIMENSION ILINE(ML), LTYPE(ML), NINT(ML), FACTOR(ML)
|
||
|
|
DIMENSION LCON(3, ML)
|
||
|
|
DIMENSION ILBOUN(ML), ISBOUN(ML)
|
||
|
|
DIMENSION ISIDE(MS), NLPS(MS), IFLINE(MS), ILLIST(MS*3)
|
||
|
|
DIMENSION IREGN(MR), IMAT(MR)
|
||
|
|
DIMENSION NSPR(MR), IFSIDE(MR), ISLIST(MR*4), IRGFLG(MR)
|
||
|
|
DIMENSION RSIZE(MR), IFHOLE(MR), NHPR(MR), IHLIST(MR*2)
|
||
|
|
DIMENSION IBARST(MS), JMAT(MS), JCENT(MS)
|
||
|
|
DIMENSION NLPB(MS), JFLINE(MS), JLLIST(MS*3)
|
||
|
|
DIMENSION IRPB(MR), ISCHM(MSC), SCHEME(MSC)
|
||
|
|
DIMENSION IPBF(MP), NPPF(MP), IFPB(MP)
|
||
|
|
DIMENSION LISTPB(2, MP), IWTPBF(3, MP)
|
||
|
|
DIMENSION ILBF(ML), NLPF(ML), IFLB(ML)
|
||
|
|
DIMENSION LISTLB(2, ML), IWTLBF(3, ML)
|
||
|
|
DIMENSION ISBF(ML), NSPF(ML), IFSB(ML)
|
||
|
|
DIMENSION LISTSB(2, ML), IWTSBF(3, ML)
|
||
|
|
DIMENSION LINKP(2, MP), LINKL(2, ML), LINKS(2, MS)
|
||
|
|
DIMENSION LINKB(2, MS)
|
||
|
|
DIMENSION LINKR(2, MR), LINKM(2, (MS + MR)), LINKSC(2, MR)
|
||
|
|
DIMENSION LINKPB(2, MP), LINKLB(2, ML), LINKSB(2, ML)
|
||
|
|
DIMENSION NUMBER(MSC)
|
||
|
|
DIMENSION N(29), K(41), IDEV(2), III(1)
|
||
|
|
DIMENSION KIN(MCOM), IIN(MCOM), RIN(MCOM)
|
||
|
|
|
||
|
|
CHARACTER*72 SCHEME, DEFSCH, TITLE, DEV1*3, CIN(MCOM)
|
||
|
|
CHARACTER*2048 FNAME
|
||
|
|
CHARACTER*80 NUMBER, HOLD, VERSN*10
|
||
|
|
|
||
|
|
LOGICAL OPTIM, STEP, ERR, ALPHA, THREE, EIGHT, NINE
|
||
|
|
LOGICAL AXIS, AREACG, LABE, LABO, LABN, LABNB, LABSB, LABM, LABW
|
||
|
|
LOGICAL ADDLNK, BATCH, VAXVMS, WROTE, HARDPL, LGROUP
|
||
|
|
LOGICAL REMESH, LONG
|
||
|
|
LOGICAL EXODUSII, ISBARS
|
||
|
|
|
||
|
|
CHARACTER*8 CDUMH, CDUMS
|
||
|
|
INTEGER CMPSIZ
|
||
|
|
|
||
|
|
NPREGN = 0
|
||
|
|
IZ = 0
|
||
|
|
ADDLNK = .FALSE.
|
||
|
|
REMESH = .FALSE.
|
||
|
|
|
||
|
|
C ENTER THE MESH OPTION
|
||
|
|
|
||
|
|
100 CONTINUE
|
||
|
|
IF (ICOM.GT.JCOM) THEN
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL FREFLD (IZ, IZ, 'ENTER MESH OPTION: ', MCOM, IOSTAT, JCOM,
|
||
|
|
& KIN, CIN, IIN, RIN)
|
||
|
|
ICOM = 1
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C RETURN FROM MESHING AFTER DELETING THE MESH
|
||
|
|
|
||
|
|
IF (CIN(ICOM)(1:1) .EQ. ' ') THEN
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
IF (NPREGN.GT.0) THEN
|
||
|
|
CALL MDDEL ('IPART')
|
||
|
|
CALL MDDEL ('LSTNBC')
|
||
|
|
CALL MDDEL ('LSTSBC')
|
||
|
|
CALL MDDEL ('NNFLG')
|
||
|
|
CALL MDDEL ('NNPTR')
|
||
|
|
CALL MDDEL ('NNLEN')
|
||
|
|
CALL MDDEL ('NSFLG')
|
||
|
|
CALL MDDEL ('NSPTR')
|
||
|
|
CALL MDDEL ('NSLEN')
|
||
|
|
CALL MDDEL ('NVPTR')
|
||
|
|
CALL MDDEL ('NVLEN')
|
||
|
|
CALL MDDEL ('NSIDEN')
|
||
|
|
CALL MDDEL ('NUID')
|
||
|
|
CALL MDDEL ('XN')
|
||
|
|
CALL MDDEL ('YN')
|
||
|
|
CALL MDDEL ('NXK')
|
||
|
|
CALL MDDEL ('MAT')
|
||
|
|
CALL MDDEL ('KXN')
|
||
|
|
CALL MDDEL ('LIST')
|
||
|
|
CALL MDDEL ('LA')
|
||
|
|
CALL MDDEL ('LB')
|
||
|
|
CALL MDDEL ('CENTK')
|
||
|
|
CALL MDDEL ('MATMAP')
|
||
|
|
CALL MDDEL ('LISTN')
|
||
|
|
CALL MDDEL ('WTNODE')
|
||
|
|
CALL MDDEL ('WTSIDE')
|
||
|
|
CALL MDDEL ('WTHOLD')
|
||
|
|
CALL MDDEL ('IHERE')
|
||
|
|
CALL MDDEL ('ILIST')
|
||
|
|
CALL MDDEL ('XLIST')
|
||
|
|
CALL MDDEL ('AMESUR')
|
||
|
|
CALL MDDEL ('XNOLD')
|
||
|
|
CALL MDDEL ('YNOLD')
|
||
|
|
CALL MDDEL ('NXKOLD')
|
||
|
|
CALL MDDEL ('MMPOLD')
|
||
|
|
CALL MDDEL ('LINKEG')
|
||
|
|
CALL MDDEL ('LISTEG')
|
||
|
|
CALL MDDEL ('BMESUR')
|
||
|
|
CALL MDDEL ('CMESUR')
|
||
|
|
CALL MDDEL ('DMESUR')
|
||
|
|
CALL MDSTAT (NERR, MUSED)
|
||
|
|
IF (NERR.GT.0) THEN
|
||
|
|
CALL MDEROR (6)
|
||
|
|
STOP ' '
|
||
|
|
END IF
|
||
|
|
KKK = 0
|
||
|
|
END IF
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
C SPECIFY ExodusI (X1) or ExodusII (X2) database format
|
||
|
|
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'X') .OR.
|
||
|
|
& (CIN(ICOM)(1:1) .EQ. 'x')) THEN
|
||
|
|
if (cin(icom)(2:2) .eq. '2') then
|
||
|
|
exodusII = .TRUE.
|
||
|
|
call message ('Writing EXODUSII Format')
|
||
|
|
else if (cin(icom)(2:2) .eq. '1') then
|
||
|
|
exodusII = .FALSE.
|
||
|
|
call message ('Writing EXODUSI/GENESIS Format')
|
||
|
|
end if
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
|
||
|
|
C ENTER THE MESH GRAPHICS OPTION
|
||
|
|
|
||
|
|
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'G') .OR.
|
||
|
|
& (CIN(ICOM)(1:1) .EQ. 'g')) THEN
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
IF (KKK.LE.0) THEN
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL MESSAGE('****************************************')
|
||
|
|
CALL MESSAGE('* NO MESH HAS BEEN PROCESSED *')
|
||
|
|
CALL MESSAGE('* NO PLOTTING POSSIBLE *')
|
||
|
|
CALL MESSAGE('****************************************')
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
ELSE
|
||
|
|
CALL GMESH (NPNODE, NPELEM, MXNFLG, MXSFLG, NPNBC, NPSBC,
|
||
|
|
& MAXKXN, MR, NPREGN, MCOM, ICOM, JCOM, CIN, RIN, IIN, KIN,
|
||
|
|
& NNN, KKK, NUMMAT, NNXK, IA(K(1)), IA(K(2)), IA(K(4)),
|
||
|
|
& IA(K(5)), IA(K(7)), IA(K(10)), IA(K(11)), IA(K(12)),
|
||
|
|
& IA(K(13)), A(K(14)), A(K(15)), IA(K(16)),
|
||
|
|
& IA(K(17)), IA(K(18)), IA(K(19)), A(K(22)),
|
||
|
|
& IA(K(23)), A(K(25)), A(K(26)), NBCNOD, NNLIST,
|
||
|
|
& NBCSID, NVLIST, TITLE, IDUMP, AXIS, AREACG, LABE, LABO,
|
||
|
|
& LABN, LABNB, LABSB, LABM, LABW, IDEV, ALPHA, DEV1, EIGHT,
|
||
|
|
& NINE, VAXVMS, VERSN, WROTE, TIME1, HARDPL, BATCH)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C TOGGLE OPTIMIZATION
|
||
|
|
|
||
|
|
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'O') .OR.
|
||
|
|
& (CIN(ICOM)(1:1) .EQ. 'o')) THEN
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
IF (OPTIM) THEN
|
||
|
|
OPTIM = .FALSE.
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL MESSAGE('BANDWIDTH OPTIMIZATION - DISABLED')
|
||
|
|
ELSE
|
||
|
|
OPTIM = .TRUE.
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL MESSAGE('BANDWIDTH OPTIMIZATION - ENABLED')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C TOGGLE THREE NODE BAR ELEMENTS
|
||
|
|
|
||
|
|
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'T') .OR.
|
||
|
|
& (CIN(ICOM)(1:1) .EQ. 't')) THEN
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
IF (THREE) THEN
|
||
|
|
THREE = .FALSE.
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL MESSAGE('THREE NODE BAR GENERATION - DISABLED')
|
||
|
|
ELSE
|
||
|
|
THREE = .TRUE.
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL MESSAGE('THREE NODE BAR GENERATION - ENABLED')
|
||
|
|
END IF
|
||
|
|
KKK = 0
|
||
|
|
|
||
|
|
C TOGGLE EIGHT NODE ELEMENTS
|
||
|
|
|
||
|
|
ELSE IF ((CIN(ICOM)(1:2) .EQ. 'EI') .OR.
|
||
|
|
& (CIN(ICOM)(1:2) .EQ. 'ei')) THEN
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
IF (EIGHT) THEN
|
||
|
|
EIGHT = .FALSE.
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL MESSAGE('EIGHT NODE QUAD GENERATION - DISABLED')
|
||
|
|
ELSE
|
||
|
|
EIGHT = .TRUE.
|
||
|
|
NINE = .FALSE.
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL MESSAGE('EIGHT NODE QUAD GENERATION - ENABLED')
|
||
|
|
END IF
|
||
|
|
KKK = 0
|
||
|
|
|
||
|
|
C TOGGLE NINE NODE ELEMENT GENERATION
|
||
|
|
|
||
|
|
ELSE IF ((CIN(ICOM)(1:2) .EQ. 'NI') .OR.
|
||
|
|
& (CIN(ICOM)(1:2) .EQ. 'ni')) THEN
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
IF (NINE) THEN
|
||
|
|
NINE = .FALSE.
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL MESSAGE('NINE NODE QUAD GENERATION - DISABLED')
|
||
|
|
ELSE
|
||
|
|
NINE = .TRUE.
|
||
|
|
EIGHT = .FALSE.
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL MESSAGE('NINE NODE QUAD GENERATION - ENABLED')
|
||
|
|
END IF
|
||
|
|
KKK = 0
|
||
|
|
|
||
|
|
C EXIT OPTION - EXITS FASTQ
|
||
|
|
|
||
|
|
ELSE IF ((CIN(ICOM)(1:2) .EQ. 'EX') .OR.
|
||
|
|
& (CIN(ICOM)(1:2) .EQ. 'ex')) THEN
|
||
|
|
CALL STRLNG (CIN(ICOM), LEN)
|
||
|
|
IF (LEN .GT. 1) THEN
|
||
|
|
IF ( (CIN(ICOM)(2:2) .EQ. 'X') .OR.
|
||
|
|
& (CIN(ICOM)(2:2) .EQ. 'x')) THEN
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
CALL FEXIT (WROTE, MCOM, ICOM, JCOM, CIN, IIN, RIN, KIN,
|
||
|
|
& TIME1, BATCH, VERSN)
|
||
|
|
ELSE
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
CALL HELP_FQ(12)
|
||
|
|
ENDIF
|
||
|
|
ELSE
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
CALL FEXIT (WROTE, MCOM, ICOM, JCOM, CIN, IIN, RIN, KIN,
|
||
|
|
& TIME1, BATCH, VERSN)
|
||
|
|
ENDIF
|
||
|
|
GOTO 100
|
||
|
|
|
||
|
|
C ENTER LINE INTERVALS
|
||
|
|
|
||
|
|
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'I') .OR.
|
||
|
|
& (CIN(ICOM)(1:1) .EQ. 'i')) THEN
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
IF (ICOM.GT.JCOM) THEN
|
||
|
|
CALL MESSAGE('ENTER LINE INTERVALS IN THE FOLLOWING '//
|
||
|
|
& 'FORMAT:')
|
||
|
|
CALL MESSAGE('[ LINE NO. (OR NEG SIDE NO.), INTERVALS ]')
|
||
|
|
CALL MESSAGE('HIT RETURN TO END INPUT')
|
||
|
|
END IF
|
||
|
|
110 CONTINUE
|
||
|
|
IF (ICOM.GT.JCOM) THEN
|
||
|
|
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, JCOM, KIN, CIN, IIN,
|
||
|
|
& RIN)
|
||
|
|
ICOM = 1
|
||
|
|
END IF
|
||
|
|
CALL GETI12 (MCOM, ICOM, JCOM, CIN, IIN, KIN, I1, I2, IFOUND)
|
||
|
|
IF (IFOUND.GT.0) THEN
|
||
|
|
III(1) = I1
|
||
|
|
CALL ININTR (ML, MS, 1, I2, III(1), N(19), N(20), NINT,
|
||
|
|
& NLPS, IFLINE, ILLIST, LINKL, LINKS, ADDLNK)
|
||
|
|
GOTO 110
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C SPAWN A PROCESS
|
||
|
|
|
||
|
|
ELSE IF ((CIN(ICOM)(1:2) .EQ. 'SP') .OR.
|
||
|
|
& (CIN(ICOM)(1:2) .EQ. 'sp')) THEN
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
CALL SPAWN (VAXVMS)
|
||
|
|
|
||
|
|
C ENTER A NEW SIZE FOR A REGION
|
||
|
|
|
||
|
|
ELSE IF ((CIN(ICOM)(1:2) .EQ. 'SI') .OR.
|
||
|
|
& (CIN(ICOM)(1:2) .EQ. 'si')) THEN
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
CALL MESSAGE('NOTE: ENTER A DEFAULT SIZE BY SPECIFYING')
|
||
|
|
CALL MESSAGE(' A SIZE WITH NO REGIONS.')
|
||
|
|
CALL MESSAGE('ENTER REGION SIZE DATA IN THE FOLLOWING FORMAT:')
|
||
|
|
CALL MESSAGE('[ SIZE, REGION 1, REGION 2, ..., REGION N ]')
|
||
|
|
CALL MESSAGE('HIT RETURN TO END INPUT')
|
||
|
|
ICOM = JCOM + 1
|
||
|
|
120 CONTINUE
|
||
|
|
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, IFOUND, KIN, CIN, IIN,
|
||
|
|
& RIN)
|
||
|
|
IF (IFOUND .GT. 0) THEN
|
||
|
|
IF (IFOUND .LT. 2) THEN
|
||
|
|
DEFSIZ = RIN(1)
|
||
|
|
ELSE
|
||
|
|
ADDLNK = .FALSE.
|
||
|
|
DO 130 IRSZ = 2, IFOUND
|
||
|
|
CALL LTSORT(MR, LINKR, IIN(IRSZ), JJ, ADDLNK)
|
||
|
|
IF (JJ .GE. 0) THEN
|
||
|
|
RSIZE(JJ) = AMAX1(RIN(1), 0.)
|
||
|
|
ELSE
|
||
|
|
WRITE(*, 10000)IIN(IRSZ)
|
||
|
|
END IF
|
||
|
|
130 CONTINUE
|
||
|
|
END IF
|
||
|
|
GO TO 120
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C GENERATE THE MESH
|
||
|
|
|
||
|
|
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'P') .OR.
|
||
|
|
& (CIN(ICOM)(1:1) .EQ. 'p') .OR.
|
||
|
|
& (CIN(ICOM)(1:1) .EQ. 'S') .OR.
|
||
|
|
& (CIN(ICOM)(1:1) .EQ. 's')) THEN
|
||
|
|
DO 140 I = 1, 2
|
||
|
|
IF (N(I).LE.0) THEN
|
||
|
|
CALL MESSAGE('***************************************')
|
||
|
|
IF (I .EQ. 1) THEN
|
||
|
|
CALL MESSAGE
|
||
|
|
& ('* NO POINT CARDS IN DATABASE *')
|
||
|
|
ELSE
|
||
|
|
CALL MESSAGE
|
||
|
|
& ('* NO LINE CARDS IN DATABASE *')
|
||
|
|
END IF
|
||
|
|
CALL MESSAGE('* NO MESH GENERATION POSSIBLE *')
|
||
|
|
CALL MESSAGE('***************************************')
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
GOTO 100
|
||
|
|
END IF
|
||
|
|
140 CONTINUE
|
||
|
|
IF ((CIN(ICOM)(1:1) .EQ. 'S') .OR.
|
||
|
|
& (CIN(ICOM)(1:1) .EQ. 's')) THEN
|
||
|
|
STEP = .TRUE.
|
||
|
|
ELSE
|
||
|
|
STEP = .FALSE.
|
||
|
|
END IF
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
|
||
|
|
C OPEN THE TEMPORARY FILE
|
||
|
|
|
||
|
|
IUNIT = 99
|
||
|
|
OPEN (UNIT = IUNIT, STATUS = 'scratch', FORM = 'unformatted',
|
||
|
|
& ACCESS = 'sequential')
|
||
|
|
REWIND IUNIT
|
||
|
|
|
||
|
|
C GENERATE THE MESH
|
||
|
|
|
||
|
|
IF (NPREGN.GT.0) THEN
|
||
|
|
CALL MDDEL ('IPART')
|
||
|
|
CALL MDDEL ('LSTNBC')
|
||
|
|
CALL MDDEL ('LSTSBC')
|
||
|
|
CALL MDDEL ('NNFLG')
|
||
|
|
CALL MDDEL ('NNPTR')
|
||
|
|
CALL MDDEL ('NNLEN')
|
||
|
|
CALL MDDEL ('NSFLG')
|
||
|
|
CALL MDDEL ('NSPTR')
|
||
|
|
CALL MDDEL ('NSLEN')
|
||
|
|
CALL MDDEL ('NVPTR')
|
||
|
|
CALL MDDEL ('NVLEN')
|
||
|
|
CALL MDDEL ('NSIDEN')
|
||
|
|
CALL MDDEL ('NUID')
|
||
|
|
CALL MDDEL ('XN')
|
||
|
|
CALL MDDEL ('YN')
|
||
|
|
CALL MDDEL ('NXK')
|
||
|
|
CALL MDDEL ('MAT')
|
||
|
|
CALL MDDEL ('KXN')
|
||
|
|
CALL MDDEL ('LIST')
|
||
|
|
CALL MDDEL ('LA')
|
||
|
|
CALL MDDEL ('LB')
|
||
|
|
CALL MDDEL ('CENTK')
|
||
|
|
CALL MDDEL ('MATMAP')
|
||
|
|
CALL MDDEL ('LISTN')
|
||
|
|
CALL MDDEL ('WTNODE')
|
||
|
|
CALL MDDEL ('WTSIDE')
|
||
|
|
CALL MDDEL ('WTHOLD')
|
||
|
|
CALL MDDEL ('IHERE')
|
||
|
|
CALL MDDEL ('ILIST')
|
||
|
|
CALL MDDEL ('XLIST')
|
||
|
|
IF (.NOT. REMESH) THEN
|
||
|
|
CALL MDDEL ('AMESUR')
|
||
|
|
CALL MDDEL ('XNOLD')
|
||
|
|
CALL MDDEL ('YNOLD')
|
||
|
|
CALL MDDEL ('NXKOLD')
|
||
|
|
CALL MDDEL ('MMPOLD')
|
||
|
|
CALL MDDEL ('LINKEG')
|
||
|
|
CALL MDDEL ('LISTEG')
|
||
|
|
CALL MDDEL ('BMESUR')
|
||
|
|
CALL MDDEL ('CMESUR')
|
||
|
|
CALL MDDEL ('DMESUR')
|
||
|
|
END IF
|
||
|
|
CALL MDSTAT (NERR, MUSED)
|
||
|
|
IF (NERR.GT.0) THEN
|
||
|
|
CALL MDEROR (6)
|
||
|
|
STOP ' '
|
||
|
|
END IF
|
||
|
|
NPREGN = 0
|
||
|
|
|
||
|
|
C SET UP THE ARRAYS FOR ADAPTIVE REMESHING
|
||
|
|
|
||
|
|
END IF
|
||
|
|
IF (.NOT. REMESH) THEN
|
||
|
|
CALL MDRSRV ('AMESUR', K(31), 1)
|
||
|
|
CALL MDRSRV ('XNOLD', K(32), 1)
|
||
|
|
CALL MDRSRV ('YNOLD', K(33), 1)
|
||
|
|
CALL MDRSRV ('NXKOLD', K(34), 4)
|
||
|
|
CALL MDRSRV ('MMPOLD', K(35), 3)
|
||
|
|
CALL MDRSRV ('LINKEG', K(36), 2)
|
||
|
|
CALL MDRSRV ('LISTEG', K(37), 2)
|
||
|
|
CALL MDRSRV ('BMESUR', K(38), 1)
|
||
|
|
CALL MDRSRV ('CMESUR', K(39), 1)
|
||
|
|
CALL MDRSRV ('DMESUR', K(40), 1)
|
||
|
|
NPROLD = 1
|
||
|
|
NPNOLD = 1
|
||
|
|
NPEOLD = 1
|
||
|
|
NNXK = 1
|
||
|
|
CALL MDSTAT (NERR, MUSED)
|
||
|
|
IF (NERR.GT.0) THEN
|
||
|
|
CALL MDEROR (6)
|
||
|
|
STOP ' '
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
LGROUP = .FALSE.
|
||
|
|
DO 150 I = 1, N(7)
|
||
|
|
IF (IRGFLG(I) .GE. 1) THEN
|
||
|
|
LGROUP = .TRUE.
|
||
|
|
GO TO 160
|
||
|
|
END IF
|
||
|
|
150 CONTINUE
|
||
|
|
160 CONTINUE
|
||
|
|
CALL QMESH (A, IA, MP, ML, MS, MR, MSC, MCOM, ICOM, JCOM, CIN,
|
||
|
|
& RIN, IIN, KIN, IUNIT, IDUMP, N, IPOINT, COOR, IPBOUN,
|
||
|
|
& ILINE, LTYPE, NINT, FACTOR, LCON, ILBOUN, ISBOUN, ISIDE,
|
||
|
|
& NLPS, IFLINE, ILLIST, IBARST, JMAT, JCENT, NLPB, JFLINE,
|
||
|
|
& JLLIST, IREGN, IMAT, NSPR, IFSIDE, ISLIST, IRPB, IPBF,
|
||
|
|
& NPPF, IFPB, LISTPB, ILBF, NLPF, IFLB, LISTLB, ISBF, NSPF,
|
||
|
|
& IFSB, LISTSB, LINKP, LINKL, LINKS, LINKB, LINKR, LINKSC,
|
||
|
|
& LINKPB, LINKLB, LINKSB, RSIZE, IFHOLE, NHPR, IHLIST,
|
||
|
|
& IRGFLG, ISCHM, SCHEME, DEFSCH, DEFSIZ, NPREGN, NPNBC, NPSBC,
|
||
|
|
& NPNODE, NPELEM, MAXKXN, STEP, DEV1, THREE, EIGHT, NINE,
|
||
|
|
& LGROUP, BATCH, A(K(31)), A(K(32)), A(K(33)), A(K(34)),
|
||
|
|
& A(K(35)), A(K(36)), A(K(37)), A(K(38)), MLINK, NPROLD,
|
||
|
|
& NPNOLD, NPEOLD, NNXK, REMESH, REXMIN, REXMAX, REYMIN,
|
||
|
|
& REYMAX, IDIVIS, SIZMIN, EMAX, EMIN)
|
||
|
|
|
||
|
|
IF (REMESH) REMESH = .FALSE.
|
||
|
|
IF (NPREGN.GT.0) THEN
|
||
|
|
|
||
|
|
C SET UP THE NECESSARY DIMENSIONING FOR NUMBERING
|
||
|
|
|
||
|
|
C A(K(1)) = IPART = ARRAY OF BEGINNING/ENDING ELEMENT NUMBERS/REGION
|
||
|
|
C A(K(2)) = LSTNBC = LIST OF NODAL BOUNDARY CONDITIONS
|
||
|
|
C (REORDERED TO NODES)
|
||
|
|
C A(K(3)) = LSTSBC = LIST OF SIDE BOUNDARY CONDITIONS
|
||
|
|
C (REORDERED TO NELEMS)
|
||
|
|
C A(K(4)) = NNFLG = LIST OF NODAL FLAGS
|
||
|
|
C A(K(5)) = NNPTR = POINTERS INTO THE NODES LIST FOR EACH NODE FLAG
|
||
|
|
C A(K(6)) = NNLEN = NUMBER OF NODES IN THE LIST FOR EACH NODE FLAG
|
||
|
|
C A(K(7)) = NSFLG = LIST OF SIDE FLAGS
|
||
|
|
C A(K(8)) = NSPTR = POINTERS INTO THE SIDES LIST FOR EACH SIDE FLAG
|
||
|
|
C A(K(9)) = NSLEN = NUMBER OF SIDES IN THE LIST FOR EACH SIDE FLAG
|
||
|
|
C A(K(10)) = NVPTR = POINTERS INTO THE NSIDEN LIST FOR EACH SIDE FLAG
|
||
|
|
C A(K(11)) = NVLEN = NUMBER OF NODES IN THE NSIDEN LIST FOR EACH
|
||
|
|
C SIDE FLAG
|
||
|
|
C A(K(12)) = NSIDEN = LIST OF SIDE NODES ASSOCIATED WITH THE SIDE LIST
|
||
|
|
C A(K(13)) = NUID = NODE UNIQUE IDENTIFIER ARRAY
|
||
|
|
C (LATER - MAPDXG ARRAY)
|
||
|
|
C A(K(14)) = XN = X COORDINATE OF THE NODES
|
||
|
|
C A(K(15)) = YN = Y COORDINATE OF THE NODES
|
||
|
|
C A(K(16)) = NXK = NODES PER ELEMENT (CONNECTIVITY) ARRAY
|
||
|
|
C A(K(17)) = MAT = MATERIAL NUMBER FOR EACH ELEMENT
|
||
|
|
C A(K(18)) = KXN = ELEMENTS ATTACHED TO EACH NODE
|
||
|
|
C (LATER - LOOKUP TABLE)
|
||
|
|
C A(K(19)) = LIST = WORKING ARRAY FOR NODE NUMBERING
|
||
|
|
C (LATER - MAPGXD ARRAY)
|
||
|
|
C A(K(20)) = LA = WORKING ARRAY FOR NODE NUMBERING
|
||
|
|
C A(K(21)) = LB = WORKING ARRAY FOR NODE NUMBERING
|
||
|
|
C A(K(22)) = CENTK = ARRAY CONTAINING X, Y LOCATION OF
|
||
|
|
C ELEMENT CENTER
|
||
|
|
C A(K(23)) = MATMAP = ARRAY OF BEGIN/END ELEMENT NUMBERS/REGION IN
|
||
|
|
C MAPGXD
|
||
|
|
C A(K(24)) = LISTN = LIST FOR RENUMBERING THE NODES FOR
|
||
|
|
C BANDWIDTH OPTIMIZATION
|
||
|
|
C A(K(25)) = WTNODE = NODAL BOUNDARY FLAG WEIGHTING FACTOR ARRAY
|
||
|
|
C A(K(26)) = WTSIDE = ELEMENT SIDE BOUNDARY FLAG WEIGHTING
|
||
|
|
C FACTOR ARRAY
|
||
|
|
C A(K(27)) = WTHOLD = TEMPORARY ARRAY USED FOR MIDSIDE NODE
|
||
|
|
C PROCESSING
|
||
|
|
C A(K(28)) = IHERE = A WORK ARRAY FOR SORTING BOUNDARY FLAGS
|
||
|
|
C A(K(29)) = ILIST = LINE LIST FOR WEIGHTED BOUNDARIES
|
||
|
|
C A(K(30)) = XLIST = WORKING LIST FOR WEIGHTED BOUNDARIES
|
||
|
|
C A(K(31)) = AMESUR = FIRST ADAPTIVE MESHING VARIABLE
|
||
|
|
C A(K(32)) = XNOLD = OLD XN ARRAY USED DURING ADAPTIVE MESHING
|
||
|
|
C A(K(33)) = YNOLD = OLD YN ARRAY USED DURING ADAPTIVE MESHING
|
||
|
|
C A(K(34)) = NXKOLD = OLD NXK ARRAY USED DURING ADAPTIVE MESHING
|
||
|
|
C A(K(35)) = MMPOLD = OLD MATMAP ARRAY USED DURING ADAPTIVE MESHING
|
||
|
|
C A(K(36)) = LINKEG = ELEMENT GRID LINK FOR ADAPTIVE MESHING
|
||
|
|
C A(K(37)) = LISTEG = ELEMENT GRID LIST FOR ADAPTIVE MESHING
|
||
|
|
C A(K(38)) = BMESUR = AMESUR VALUES AVERAGED AT THE NODES
|
||
|
|
C A(K(31)) = CMESUR = SECOND ADAPTIVE MESHING VARIABLE
|
||
|
|
C A(K(40)) = DMESUR = CMESUR VALUES AVERAGED AT THE NODES
|
||
|
|
|
||
|
|
IF (EIGHT) THEN
|
||
|
|
NPNBC = NPNBC*2
|
||
|
|
NPSBC = NPSBC*2
|
||
|
|
NNXK = 8
|
||
|
|
ELSE IF (NINE) THEN
|
||
|
|
NPNBC = NPNBC*2
|
||
|
|
NPSBC = NPSBC*2
|
||
|
|
NNXK = 9
|
||
|
|
ELSE
|
||
|
|
NNXK = 4
|
||
|
|
END IF
|
||
|
|
NPWTS = MAX0 (NPNBC, NPSBC)
|
||
|
|
MXNFLG = N(11) + N(13) + 1
|
||
|
|
MXSFLG = N(15) + 1
|
||
|
|
NNUID = MAX0 (NPNODE, NPNBC, NPSBC, NPELEM)
|
||
|
|
MXLPS = 2
|
||
|
|
DO 170 I = 1, N(3)
|
||
|
|
MXLPS = MAX0(NLPS(I) + 1, MXLPS)
|
||
|
|
170 CONTINUE
|
||
|
|
CALL MDRSRV ('IPART', K(1), 3*NPREGN)
|
||
|
|
CALL MDRSRV ('LSTNBC', K(2), NPNBC)
|
||
|
|
CALL MDRSRV ('LSTSBC', K(3), NPSBC)
|
||
|
|
CALL MDRSRV ('NNFLG', K(4), MXNFLG)
|
||
|
|
CALL MDRSRV ('NNPTR', K(5), MXNFLG)
|
||
|
|
CALL MDRSRV ('NNLEN', K(6), MXNFLG)
|
||
|
|
CALL MDRSRV ('NSFLG', K(7), MXSFLG)
|
||
|
|
CALL MDRSRV ('NSPTR', K(8), MXSFLG)
|
||
|
|
CALL MDRSRV ('NSLEN', K(9), MXSFLG)
|
||
|
|
CALL MDRSRV ('NVPTR', K(10), MXSFLG)
|
||
|
|
CALL MDRSRV ('NVLEN', K(11), MXSFLG)
|
||
|
|
CALL MDRSRV ('NSIDEN', K(12), NPSBC)
|
||
|
|
CALL MDRSRV ('NUID', K(13), NNUID)
|
||
|
|
CALL MDRSRV ('XN', K(14), NPNODE)
|
||
|
|
CALL MDRSRV ('YN', K(15), NPNODE)
|
||
|
|
CALL MDRSRV ('NXK', K(16), NPELEM*NNXK)
|
||
|
|
CALL MDRSRV ('MAT', K(17), NPELEM)
|
||
|
|
C ... The kxn array is used for a work array in renum and needs to hold npsbc items.
|
||
|
|
if (npsbc .gt. maxkxn) maxkxn = npsbc
|
||
|
|
CALL MDRSRV ('KXN', K(18), MAXKXN*NNXK)
|
||
|
|
CALL MDRSRV ('LIST', K(19), NNUID)
|
||
|
|
CALL MDRSRV ('LA', K(20), NPNODE)
|
||
|
|
CALL MDRSRV ('LB', K(21), NPNODE)
|
||
|
|
CALL MDRSRV ('CENTK', K(22), NPELEM*2)
|
||
|
|
CALL MDRSRV ('MATMAP', K(23), NPREGN*3)
|
||
|
|
CALL MDRSRV ('LISTN', K(24), NNUID)
|
||
|
|
CALL MDRSRV ('WTNODE', K(25), NPNBC)
|
||
|
|
CALL MDRSRV ('WTSIDE', K(26), NPSBC)
|
||
|
|
CALL MDRSRV ('WTHOLD', K(27), NPWTS)
|
||
|
|
CALL MDRSRV ('IHERE', K(28), NNUID)
|
||
|
|
CALL MDRSRV ('ILIST', K(29), MXLPS)
|
||
|
|
CALL MDRSRV ('XLIST', K(30), MXLPS)
|
||
|
|
CALL MDSTAT (NERR, MUSED)
|
||
|
|
IF (NERR.GT.0) THEN
|
||
|
|
CALL MDEROR (6)
|
||
|
|
STOP ' '
|
||
|
|
END IF
|
||
|
|
|
||
|
|
if (n(5) .gt. 0) then
|
||
|
|
isbars = .true.
|
||
|
|
else
|
||
|
|
isbars = .false.
|
||
|
|
end if
|
||
|
|
|
||
|
|
CALL RENUM (NPNODE, NPELEM, MXNFLG, MXSFLG, NPNBC, NPSBC,
|
||
|
|
& NPWTS, NPREGN, MP, ML, MS, MR, MSC, MAXKXN, NNUID, NNXK,
|
||
|
|
& MXLPS, IUNIT, NNN, KKK, N(28), N(2), N(11), N(13),
|
||
|
|
& N(15), IA(K(1)), IA(K(2)), IA(K(3)), IA(K(4)),
|
||
|
|
& IA(K(5)), IA(K(6)), IA(K(7)), IA(K(8)), IA(K(9)),
|
||
|
|
& IA(K(10)), IA(K(11)), IA(K(12)), IA(K(13)),
|
||
|
|
& A(K(14)), A(K(15)), IA(K(16)), IA(K(17)),
|
||
|
|
& IA(K(18)), IA(K(19)), IA(K(20)), IA(K(21)),
|
||
|
|
& IA(K(23)), IA(K(24)), A(K(25)), A(K(26)),
|
||
|
|
& A(K(27)), IA(K(28)), IA(K(29)), A(K(30)), NUMMAT,
|
||
|
|
& NBCNOD, NNLIST, NBCSID, NSLIST, NVLIST, COOR, ILINE,
|
||
|
|
& LTYPE, LCON, ISIDE, NLPS, IFLINE, ILLIST, LINKP, LINKL,
|
||
|
|
& LINKS, LINKR, IMAT, LINKB, JMAT, IPBF, NPPF, IFPB,
|
||
|
|
& LISTPB, IWTPBF, ILBF, NLPF, IFLB, LISTLB, IWTLBF, ISBF,
|
||
|
|
& NSPF, IFSB, LISTSB, IWTSBF, LINKPB, LINKLB, LINKSB,
|
||
|
|
& NUMBER, THREE, EIGHT, NINE, OPTIM, ISBARS)
|
||
|
|
|
||
|
|
C AN ERROR HAS OCCURRED AND THUS THE DUMMY REMESH ARRAYS MUST BE
|
||
|
|
C DELETED IF NOT REMESHING
|
||
|
|
|
||
|
|
ELSEIF (.NOT. REMESH) THEN
|
||
|
|
CALL MDDEL ('AMESUR')
|
||
|
|
CALL MDDEL ('XNOLD')
|
||
|
|
CALL MDDEL ('YNOLD')
|
||
|
|
CALL MDDEL ('NXKOLD')
|
||
|
|
CALL MDDEL ('MMPOLD')
|
||
|
|
CALL MDDEL ('LINKEG')
|
||
|
|
CALL MDDEL ('LISTEG')
|
||
|
|
CALL MDDEL ('BMESUR')
|
||
|
|
CALL MDDEL ('CMESUR')
|
||
|
|
CALL MDDEL ('DMESUR')
|
||
|
|
CALL MDSTAT (NERR, MUSED)
|
||
|
|
IF (NERR.GT.0) THEN
|
||
|
|
CALL MDEROR (6)
|
||
|
|
STOP ' '
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
CLOSE (IUNIT)
|
||
|
|
|
||
|
|
C ENTER LINE FACTORS
|
||
|
|
|
||
|
|
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'F') .OR.
|
||
|
|
& (CIN(ICOM)(1:1) .EQ. 'f')) THEN
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
IF (ICOM.GT.JCOM) THEN
|
||
|
|
CALL MESSAGE('ENTER LINE FACTORS IN THE FOLLOWING FORMAT:')
|
||
|
|
CALL MESSAGE('[ LINE NO. (OR NEG. SIDE NO.), FACTOR ]')
|
||
|
|
CALL MESSAGE('HIT RETURN TO END INPUT')
|
||
|
|
END IF
|
||
|
|
180 CONTINUE
|
||
|
|
IF (ICOM.GT.JCOM) THEN
|
||
|
|
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, JCOM, KIN, CIN, IIN,
|
||
|
|
& RIN)
|
||
|
|
ICOM = 1
|
||
|
|
END IF
|
||
|
|
CALL GETI1R (MCOM, ICOM, JCOM, CIN, IIN, RIN, KIN, I1, R1,
|
||
|
|
& IFOUND)
|
||
|
|
IF (IFOUND.GT.0) THEN
|
||
|
|
III(1) = I1
|
||
|
|
CALL INFACT (ML, MS, 1, R1, III(1), N(19), N(20), FACTOR,
|
||
|
|
& NLPS, IFLINE, ILLIST, LINKL, LINKS, ADDLNK)
|
||
|
|
GOTO 180
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C CLEAR OUT ALL THE INTERVALS ASSIGNED TO LINES BY REGION
|
||
|
|
|
||
|
|
ELSE IF ((CIN(ICOM)(1:2) .EQ. 'CI') .OR.
|
||
|
|
& (CIN(ICOM)(1:2) .EQ. 'ci')) THEN
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
CALL MESSAGE('CLEAR INTERVALS FROM REGIONS FROM <I1> TO <I2>')
|
||
|
|
CALL MESSAGE('HIT RETURN TO END INPUT')
|
||
|
|
200 CONTINUE
|
||
|
|
IF (ICOM.GT.JCOM)THEN
|
||
|
|
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, JCOM, KIN, CIN,
|
||
|
|
& IIN, RIN)
|
||
|
|
ICOM = 1
|
||
|
|
ENDIF
|
||
|
|
CALL GETI12 (MCOM, ICOM, JCOM, CIN, IIN, KIN, I1, I2, IFOUND)
|
||
|
|
|
||
|
|
IF (IFOUND .GT. 0) THEN
|
||
|
|
IF (I1 .GT. 0) THEN
|
||
|
|
CALL CHECK (I1, I2, N (22))
|
||
|
|
|
||
|
|
C REMOVE INTERVALS ON LINES ASSOCIATED WITH THE REGIONS
|
||
|
|
|
||
|
|
DO 230 I = I1, I2
|
||
|
|
CALL LTSORT (MR, LINKR, I, II, ADDLNK)
|
||
|
|
IF (II .GT. 0) THEN
|
||
|
|
DO 220 J = IFSIDE (II), IFSIDE (II) + NSPR (II)-1
|
||
|
|
|
||
|
|
C FIRST REMOVE INTERVALS OF LINES ON SIDE DATA
|
||
|
|
|
||
|
|
CALL LTSORT (MS, LINKS, ISLIST (J), JJ, ADDLNK)
|
||
|
|
IF ((ISLIST (J) .GT. 0) .AND. (JJ .GT. 0)) THEN
|
||
|
|
DO 210 KKK = IFLINE (JJ), IFLINE (JJ) +
|
||
|
|
& NLPS (JJ)-1
|
||
|
|
CALL LTSORT (ML, LINKL, ILLIST (KKK), KK,
|
||
|
|
& ADDLNK)
|
||
|
|
IF (KK .GT. 0) NINT (KK) = 0
|
||
|
|
210 CONTINUE
|
||
|
|
|
||
|
|
C NEXT REMOVE INTERVALS ON LINES ALONE
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
JJ = IABS (ISLIST (J))
|
||
|
|
CALL LTSORT (ML, LINKL, JJ, KK, ADDLNK)
|
||
|
|
IF (KK.GT.0) NINT (KK) = 0
|
||
|
|
ENDIF
|
||
|
|
220 CONTINUE
|
||
|
|
ENDIF
|
||
|
|
230 CONTINUE
|
||
|
|
GOTO 200
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C ADJUST THE MESH
|
||
|
|
|
||
|
|
ELSE IF ((CIN(ICOM)(1:2) .EQ. 'AD') .OR.
|
||
|
|
& (CIN(ICOM)(1:2) .EQ. 'ad')) THEN
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
IF (KKK.LE.0) THEN
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL MESSAGE('****************************************')
|
||
|
|
CALL MESSAGE('* NO ELEMENTS IN DATABASE *')
|
||
|
|
CALL MESSAGE('* NO MESH ADJUSTMENT POSSIBLE *')
|
||
|
|
CALL MESSAGE('****************************************')
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
GOTO 100
|
||
|
|
END IF
|
||
|
|
CALL ADJMSH (MS, MR, NPNODE, NPELEM, MXNFLG, MXSFLG, NPREGN,
|
||
|
|
& NPNBC, NPSBC, MCOM, ICOM, JCOM, CIN, RIN, IIN, KIN, NNN,
|
||
|
|
& KKK, NNXK, IA(K(2)), IA(K(3)), IA(K(4)), IA(K(5)), IA(K(6)),
|
||
|
|
& IA(K(7)), IA(K(8)), IA(K(9)), IA(K(10)), IA(K(11)),
|
||
|
|
& IA(K(12)), IA(K(13)), A(K(14)), A(K(15)), IA(K(16)),
|
||
|
|
& IA(K(17)), IA(K(19)), IA(K(23)), A(K(25)), A(K(26)), NBCNOD,
|
||
|
|
& NNLIST, NBCSID, NSLIST, NVLIST, NUMMAT, LINKM, TITLE, ERR,
|
||
|
|
& EIGHT, NINE, VERSN)
|
||
|
|
IF (ERR) THEN
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL MESSAGE('******************************************')
|
||
|
|
CALL MESSAGE('* ERROR ADJUSTING MESH *')
|
||
|
|
CALL MESSAGE('******************************************')
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C CALCULATE A DISTORTION INDEX FOR THE REGIONS
|
||
|
|
|
||
|
|
ELSE IF (((CIN(ICOM)(1:1) .EQ. 'D') .OR.
|
||
|
|
& (CIN(ICOM)(1:1) .EQ. 'd')) .AND.
|
||
|
|
& (CIN(ICOM)(2:2) .NE. 'N') .AND.
|
||
|
|
& (CIN(ICOM)(2:2) .NE. 'n')) THEN
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
IF (KKK.LE.0) THEN
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL MESSAGE('****************************************')
|
||
|
|
CALL MESSAGE('* NO ELEMENTS IN DATABASE *')
|
||
|
|
CALL MESSAGE('* NO DISTORTION INDEX CALCULATED *')
|
||
|
|
CALL MESSAGE('****************************************')
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
GOTO 100
|
||
|
|
END IF
|
||
|
|
CALL RGDSTR (NPNODE, NPELEM, KKK, NNXK, IA(K(14)),
|
||
|
|
& A(K(15)), A(K(16)) )
|
||
|
|
|
||
|
|
C Write out the mesh data into the genesis or exodusII data base
|
||
|
|
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'W') .OR.
|
||
|
|
& (CIN(ICOM)(1:1) .EQ. 'w')) THEN
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
IF (KKK.LE.0) THEN
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL MESSAGE('****************************************')
|
||
|
|
CALL MESSAGE('* NO ELEMENTS IN DATABASE *')
|
||
|
|
CALL MESSAGE('* NO EXODUSII FILE WRITING POSSIBLE *')
|
||
|
|
CALL MESSAGE('****************************************')
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
GOTO 100
|
||
|
|
END IF
|
||
|
|
IUNIT = 9
|
||
|
|
240 CONTINUE
|
||
|
|
IF (BATCH) THEN
|
||
|
|
CALL EXNAME (IUNIT, FNAME, LN)
|
||
|
|
ELSE
|
||
|
|
IF (ICOM.LE.JCOM) THEN
|
||
|
|
FNAME = CIN(ICOM)
|
||
|
|
LN = lenstr(FNAME)
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
ELSE
|
||
|
|
CALL INQSTR ('OUTPUT DATABASE FILE NAME: ',
|
||
|
|
& FNAME)
|
||
|
|
LN = lenstr(FNAME)
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
C ... Create the exodusII file
|
||
|
|
if (EXODUSII) THEN
|
||
|
|
CMPSIZ = 0
|
||
|
|
IOWS = 0
|
||
|
|
|
||
|
|
C ... See if user-specified output word size EXT05
|
||
|
|
call exname (-5, hold, llen)
|
||
|
|
if (llen .lt. 1) goto 25
|
||
|
|
read(hold,'(i1)',ERR=25)iows
|
||
|
|
goto 26
|
||
|
|
25 continue
|
||
|
|
|
||
|
|
call exparm (cdumh, cdums, idum, iows, idum, idum)
|
||
|
|
26 continue
|
||
|
|
|
||
|
|
C ... One final check to make sure we have a valid iows.
|
||
|
|
if (iows .ne. 4 .and. iows .ne. 8) then
|
||
|
|
iows = 4
|
||
|
|
endif
|
||
|
|
|
||
|
|
iunit = excre(FNAME(:LN), EXCLOB, CMPSIZ, IOWS, IERR)
|
||
|
|
if (ierr .lt. 0) then
|
||
|
|
call exopts (EXVRBS, ierr)
|
||
|
|
call exerr('fastq', 'Error from excre', ierr)
|
||
|
|
if (batch) then
|
||
|
|
stop 'Exodus Error'
|
||
|
|
else
|
||
|
|
go to 240
|
||
|
|
endif
|
||
|
|
endif
|
||
|
|
CALL WREX2 (MS, MR, NPNODE, NPELEM, MXNFLG, MXSFLG, NPREGN,
|
||
|
|
& NPNBC, NPSBC, IUNIT, NNN, KKK, NNXK, IA(K(2)),
|
||
|
|
& IA(K(3)), IA(K(4)), IA(K(5)), IA(K(6)), IA(K(7)),
|
||
|
|
& IA(K(8)), IA(K(9)), IA(K(10)), IA(K(11)), IA(K(12)),
|
||
|
|
& IA(K(13)), A(K(14)), A(K(15)), IA(K(16)), IA(K(17)),
|
||
|
|
& IA(K(19)), IA(K(23)), A(K(25)), A(K(26)),
|
||
|
|
& NBCNOD, NNLIST, NBCSID, NSLIST, NVLIST, NUMMAT, LINKM,
|
||
|
|
& TITLE, ERR, EIGHT, NINE, VERSN, A, IA, FNAME(:LN))
|
||
|
|
IF (ERR) THEN
|
||
|
|
IF (BATCH) THEN
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL MESSAGE
|
||
|
|
& ('******************************************')
|
||
|
|
CALL MESSAGE
|
||
|
|
& ('* ERROR WRITING GENESIS DATABASE FILE *')
|
||
|
|
CALL MESSAGE
|
||
|
|
& ('* NO OUTPUT FILE SAVED *')
|
||
|
|
CALL MESSAGE
|
||
|
|
& ('******************************************')
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
STOP
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
call exclos(iunit, ierr)
|
||
|
|
else
|
||
|
|
OPEN (UNIT = IUNIT, FILE = FNAME(:LN), STATUS = 'UNKNOWN',
|
||
|
|
& FORM = 'UNFORMATTED', ACCESS = 'SEQUENTIAL', ERR = 240)
|
||
|
|
REWIND IUNIT
|
||
|
|
CALL WRGENS (MS, MR, NPNODE, NPELEM, MXNFLG, MXSFLG, NPREGN,
|
||
|
|
& NPNBC, NPSBC, IUNIT, NNN, KKK, NNXK, IA(K(2)),
|
||
|
|
& IA(K(3)), IA(K(4)), IA(K(5)), IA(K(6)), IA(K(7)),
|
||
|
|
& IA(K(8)), IA(K(9)), IA(K(10)), IA(K(11)), IA(K(12)),
|
||
|
|
& IA(K(13)), A(K(14)), A(K(15)), IA(K(16)), IA(K(17)),
|
||
|
|
& IA(K(19)), IA(K(23)), A(K(25)), A(K(26)),
|
||
|
|
& NBCNOD, NNLIST, NBCSID, NSLIST, NVLIST, NUMMAT, LINKM,
|
||
|
|
& TITLE, ERR, EIGHT, NINE, VERSN)
|
||
|
|
IF (ERR) THEN
|
||
|
|
CLOSE (UNIT = IUNIT, STATUS = 'DELETE')
|
||
|
|
IF (BATCH) THEN
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL MESSAGE
|
||
|
|
& ('******************************************')
|
||
|
|
CALL MESSAGE
|
||
|
|
& ('* ERROR WRITING GENESIS DATABASE FILE *')
|
||
|
|
CALL MESSAGE
|
||
|
|
& ('* NO OUTPUT FILE SAVED *')
|
||
|
|
CALL MESSAGE
|
||
|
|
& ('******************************************')
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
STOP
|
||
|
|
END IF
|
||
|
|
ELSE
|
||
|
|
CLOSE (UNIT = IUNIT, STATUS = 'KEEP')
|
||
|
|
end if
|
||
|
|
end if
|
||
|
|
|
||
|
|
C WRITE OUT THE MESH DATA INTO THE ERROR CODE DATA FORMAT
|
||
|
|
|
||
|
|
ELSE IF ((CIN (ICOM) (1:1) .EQ. 'J') .OR.
|
||
|
|
& (CIN (ICOM) (1:1) .EQ. 'j')) THEN
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
IF (KKK.LE.0) THEN
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL MESSAGE('****************************************')
|
||
|
|
CALL MESSAGE('* NO ELEMENTS IN DATABASE *')
|
||
|
|
CALL MESSAGE('* NO FILE WRITING POSSIBLE *')
|
||
|
|
CALL MESSAGE('****************************************')
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
GOTO 100
|
||
|
|
END IF
|
||
|
|
IUNIT = 99
|
||
|
|
250 CONTINUE
|
||
|
|
IF (ICOM.LE.JCOM) THEN
|
||
|
|
FNAME = CIN (ICOM)
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
ELSE
|
||
|
|
CALL INQSTR ('JOE''S ERROR OUTPUT FILE NAME: ', FNAME)
|
||
|
|
END IF
|
||
|
|
OPEN (UNIT = IUNIT, FILE = FNAME, STATUS = 'NEW', ERR = 250)
|
||
|
|
REWIND IUNIT
|
||
|
|
CALL WRJERR (MS, MR, NPNODE, NPELEM, MXNFLG, MXSFLG, NPREGN,
|
||
|
|
& NPNBC, NPSBC, IUNIT, NNN, KKK, NNXK, IA(K(2)), IA(K(3)),
|
||
|
|
& IA(K(4)), IA(K(5)), IA(K(6)), IA(K(7)), IA(K(8)),
|
||
|
|
& IA(K(9)), IA(K(10)), IA(K(11)), IA(K(12)), IA(K(13)),
|
||
|
|
& A(K(14)), A(K(15)), IA(K(16)), IA(K(17)), IA(K(19)),
|
||
|
|
& IA(K(23)), NBCNOD, NNLIST, NBCSID, NSLIST, NVLIST, NUMMAT,
|
||
|
|
& LINKM, TITLE, ERR, EIGHT, NINE)
|
||
|
|
IF(ERR) THEN
|
||
|
|
CLOSE (UNIT = IUNIT, STATUS = 'DELETE')
|
||
|
|
ELSE
|
||
|
|
CLOSE (UNIT = IUNIT, STATUS = 'KEEP')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C WRITE OUT THE MESH DATA INTO THE ABAQUS DATA FORMAT
|
||
|
|
|
||
|
|
ELSE IF ((CIN (ICOM) (1:1) .EQ. 'A') .OR.
|
||
|
|
& (CIN (ICOM) (1:1) .EQ. 'a')) THEN
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
IF (KKK.LE.0) THEN
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL MESSAGE('****************************************')
|
||
|
|
CALL MESSAGE('* NO ELEMENTS IN DATABASE *')
|
||
|
|
CALL MESSAGE('* NO FILE WRITING POSSIBLE *')
|
||
|
|
CALL MESSAGE('****************************************')
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
GOTO 100
|
||
|
|
END IF
|
||
|
|
IUNIT = 99
|
||
|
|
260 CONTINUE
|
||
|
|
IF (ICOM.LE.JCOM) THEN
|
||
|
|
FNAME = CIN (ICOM)
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
ELSE
|
||
|
|
CALL INQSTR ('ABAQUS OUTPUT FILE NAME: ', FNAME)
|
||
|
|
END IF
|
||
|
|
OPEN (UNIT = IUNIT, FILE = FNAME, STATUS = 'UNKNOWN',
|
||
|
|
& ERR = 260)
|
||
|
|
REWIND IUNIT
|
||
|
|
CALL WRABQS (MS, MR, NPNODE, NPELEM, MXNFLG, MXSFLG, NPREGN,
|
||
|
|
& NPNBC, NPSBC, IUNIT, NNN, KKK, NNXK, IA(K(2)), IA(K(3)),
|
||
|
|
& IA(K(4)), IA(K(5)), IA(K(6)), IA(K(7)), IA(K(8)),
|
||
|
|
& IA(K(9)), IA(K(10)), IA(K(11)), IA(K(12)), IA(K(13)),
|
||
|
|
& A(K(14)), A(K(15)), IA(K(16)), IA(K(17)), IA(K(19)),
|
||
|
|
& IA(K(23)), NBCNOD, NNLIST, NBCSID, NSLIST, NVLIST, NUMMAT,
|
||
|
|
& LINKM, TITLE, ERR, EIGHT, NINE)
|
||
|
|
IF(ERR) THEN
|
||
|
|
CLOSE (UNIT = IUNIT, STATUS = 'DELETE')
|
||
|
|
ELSE
|
||
|
|
CLOSE (UNIT = IUNIT, STATUS = 'KEEP')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C WRITE OUT THE MESH DATA INTO THE NASTRAN DATA FORMAT
|
||
|
|
|
||
|
|
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'N') .OR.
|
||
|
|
& (CIN(ICOM)(1:1) .EQ. 'n') .OR. (CIN(ICOM)(1:2) .EQ. 'DN') .OR.
|
||
|
|
& (CIN(ICOM)(1:1) .EQ. 'DN')) THEN
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
IF ((CIN(ICOM)(1:1) .EQ. 'N') .OR.
|
||
|
|
& (CIN(ICOM)(1:1) .EQ. 'n')) THEN
|
||
|
|
LONG = .TRUE.
|
||
|
|
ELSE
|
||
|
|
LONG = .FALSE.
|
||
|
|
ENDIF
|
||
|
|
IF (KKK.LE.0) THEN
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
CALL MESSAGE('****************************************')
|
||
|
|
CALL MESSAGE('* NO ELEMENTS IN DATABASE *')
|
||
|
|
CALL MESSAGE('* NO FILE WRITING POSSIBLE *')
|
||
|
|
CALL MESSAGE('****************************************')
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
GOTO 100
|
||
|
|
END IF
|
||
|
|
IUNIT = 99
|
||
|
|
270 CONTINUE
|
||
|
|
IF (ICOM.LE.JCOM) THEN
|
||
|
|
FNAME = CIN(ICOM)
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
ELSE
|
||
|
|
CALL INQSTR ('NASTRAN OUTPUT FILE NAME: ', FNAME)
|
||
|
|
END IF
|
||
|
|
OPEN (UNIT = IUNIT, FILE = FNAME, STATUS = 'UNKNOWN',
|
||
|
|
& ERR = 270)
|
||
|
|
REWIND IUNIT
|
||
|
|
CALL WRNAST (MS, MR, NPNODE, NPELEM, MXNFLG, MXSFLG, NPREGN,
|
||
|
|
& NPNBC, NPSBC, IUNIT, NNN, KKK, NNXK, IA(K(2)), IA(K(3)),
|
||
|
|
& IA(K(4)), IA(K(5)), IA(K(6)), IA(K(7)), IA(K(8)),
|
||
|
|
& IA(K(9)), IA(K(10)), IA(K(11)), IA(K(12)), IA(K(13)),
|
||
|
|
& A(K(14)), A(K(15)), IA(K(16)), IA(K(17)), IA(K(19)),
|
||
|
|
& IA(K(23)), NBCNOD, NNLIST, NBCSID, NSLIST, NVLIST, NUMMAT,
|
||
|
|
& LINKM, TITLE, ERR, EIGHT, NINE, LONG)
|
||
|
|
IF (ERR) THEN
|
||
|
|
CLOSE (UNIT = IUNIT, STATUS = 'DELETE')
|
||
|
|
ELSE
|
||
|
|
CLOSE (UNIT = IUNIT, STATUS = 'KEEP')
|
||
|
|
END IF
|
||
|
|
ELSE
|
||
|
|
ICOM = ICOM + 1
|
||
|
|
CALL HELP_FQ (12)
|
||
|
|
END IF
|
||
|
|
GOTO 100
|
||
|
|
|
||
|
|
10000 FORMAT (' REGION NO:', I5, ' IS NOT IN THE DATABASE', /,
|
||
|
|
& ' THUS NO SIZE CAN BE ENTERED')
|
||
|
|
|
||
|
|
END
|