lib
/
EXODUS
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
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.
6 Commits
1 Branch
0 Tags
19 MiB
 
 
 
 
 
 
Tag: Branch: Tree: 6ce61ef92b
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '6ce61ef92b'
${ noResults }
EXODUS/packages/seacas/applications/fastq/keyin.f

1070 lines
40 KiB
Raw Blame History

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 KEYIN (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,
& IHOLDP, IHOLDL, IHOLDS, IHOLDB, IHOLDR, IHOLDM, IHOLD1, IHOLD2,
& IHOLD3, IWTPBF, IWTLBF, IWTSBF, RSIZE, IFHOLE, NHPR, IHLIST,
& IRGFLG, ISCHM, SCHEME, NUMBER, DEFSCH, DEFSIZ, TITLE, OPTIM,
& THREE, EIGHT, NINE, NOROOM, VAXVMS, WROTE, TIME1, VERSN, BATCH)
C***********************************************************************
C SUBROUTINE KEYIN = INPUTS MESH DEFINITIONS FROM THE KEYBOARD
C***********************************************************************
C SUBROUTINE CALLED BY:
C FASTQ = A PROGRAM TO QUICKLY GENERATE QUADRILATERAL MESHES
C***********************************************************************
PARAMETER (NIN = 80)
DIMENSION IPOINT(MP), COOR(2, MP), IPBOUN(MP)
DIMENSION ILINE(ML), LTYPE(ML), NINT(ML), FACTOR(ML), LCON(3, ML)
DIMENSION ILBOUN(ML), ISBOUN(ML)
DIMENSION ISIDE(MS), NLPS(MS), IFLINE(MS), ILLIST(MS*3)
DIMENSION IBARST(MS), JMAT(MS), JCENT(MS), NLPB(MS), JFLINE(MS)
DIMENSION JLLIST(MS*3)
DIMENSION IREGN(MR), IMAT(MR), NSPR(MR), IFSIDE(MR), ISLIST(MR*4)
DIMENSION IRPB(MR), ISCHM(MSC), SCHEME(MSC), RSIZE(MR)
DIMENSION IPBF(MP), NPPF(MP), IFPB(MP), LISTPB(2, MP)
DIMENSION ILBF(ML), NLPF(ML), IFLB(ML), LISTLB(2, ML)
DIMENSION ISBF(ML), NSPF(ML), IFSB(ML), LISTSB(2, ML)
DIMENSION IWTPBF(3, MP), IWTLBF(3, ML), IWTSBF(3, ML)
DIMENSION LINKP(2, MP), LINKL(2, ML), LINKS(2, MS), 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 IHOLDP(2, MP), IHOLDL(2, ML), IHOLDS(2, MS)
DIMENSION IHOLDR(2, MR), IHOLDB(2, MS), IHOLDM(2, (MS + MR))
DIMENSION IHOLD1(2, MP), IHOLD2(2, ML), IHOLD3(2, ML)
DIMENSION IFHOLE(MR), NHPR(MR), IHLIST(MR*2), IRGFLG(MR)
DIMENSION NUMBER(MSC)
DIMENSION N(29), NOLD(29), III(1)
DIMENSION KIN(MCOM), IIN(MCOM), RIN(MCOM), JIN(NIN)
CHARACTER*72 SCHEME, DEFSCH, CIN(MCOM), VERSN*9
CHARACTER*72 TITLE, HOLD, NUMBER*80
LOGICAL IANS, OPTIM, NOROOM, ADDOLD, MERGE, NEWNUM, DOLINK, ADDLNK
LOGICAL THREE, EIGHT, NINE, VAXVMS, WROTE, SIDEOK, BATCH
IZ = 0
MERGE = .FALSE.
DOLINK = .TRUE.
NOROOM = .FALSE.
ADDLNK = .FALSE.
DO 100 I = 1, 29
NOLD(I) = N(I)
100 CONTINUE
110 CONTINUE
IF (ICOM .GT. JCOM) THEN
CALL MESSAGE(' ')
CALL FREFLD (IZ, IZ, 'ENTER KEYIN OPTION: ', MCOM, IOSTAT,
& JCOM, KIN, CIN, IIN, RIN)
ICOM = 1
END IF
C INPUT A POINT INTO THE DATABASE
IF ((CIN(ICOM)(1:1) .EQ. 'P') .OR. (CIN(ICOM)(1:1) .EQ. 'p')) THEN
ICOM = ICOM + 1
CALL MESSAGE('ENTER POINT DATA IN THE FOLLOWING FORMAT:')
CALL MESSAGE('[ POINT NO., X, Y ]')
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
JJ = IIN(1)
IF ((JJ .LE. 0) .OR. (JJ .GE. 10000)) THEN
WRITE(*, 10000)JJ
GO TO 120
END IF
ADDLNK = .FALSE.
CALL LTSORT(MP, LINKP, JJ, IPNTR, ADDLNK)
CALL INPOIN(MP, N(1), N(18), JJ, RIN(2), RIN(3), NHOLDP,
& IHOLDP, IPOINT, COOR, IPBOUN, LINKP, MERGE, NOROOM)
IF (NOROOM) GO TO 400
C REPLACE THE FLAGS OF A REDEFINED POINT
IF (IPNTR .GT. 0) THEN
CALL LTSORT(MP, LINKP, JJ, JPNTR, ADDLNK)
IPBOUN(JPNTR) = IPBOUN(IPNTR)
END IF
GO TO 120
END IF
C ENTER A LINE INTO THE DATABASE
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'L') .OR.
& (CIN(ICOM)(1:1) .EQ. 'l')) THEN
ICOM = ICOM + 1
IF (ICOM .GT. JCOM) THEN
CALL MESSAGE(' ')
CALL MESSAGE('THE FOLLOWING LINE TYPES ARE AVAILABLE:')
CALL MESSAGE(' S*TRAIGHT = STRAIGHT LINE')
CALL MESSAGE(' CI*RCULAR = CIRCULAR CCW ARC ABOUT A '//
& 'CENTER')
CALL MESSAGE(' 3*CIRCULAR = CIRCULAR ARC WITH 3RD '//
& 'ARC POINT')
CALL MESSAGE(' R*CIRCULAR = CIRCULAR ARC WITH RADIUS')
CALL MESSAGE(' E*LIPSE = CCW ELIPSE ABOUT A CENTER')
CALL MESSAGE(' CO*RNER = 2 LINE SEGMENTS JOINED')
CALL MESSAGE(' P*ARABOLA = PARABOLIC SHAPED LINE')
CALL FREFLD (IZ, IZ, 'WHICH LINE TYPE WOULD YOU LIKE TO '//
& 'ENTER:', MCOM, IOSTAT, JCOM, KIN, CIN, IIN, RIN)
ICOM = 1
END IF
IF ((CIN(ICOM)(1:1) .EQ. 'S') .OR.
& (CIN(ICOM)(1:1) .EQ. 's')) THEN
ICOM = ICOM + 1
CALL MESSAGE('ENTER STRAIGHT LINE DATA IN THE FOLLOWING '//
& 'FORMAT:')
CALL MESSAGE('[ LINE NO., POINT 1, POINT 2, NO. '//
& 'INTERVALS, FACTOR ]')
IT = 1
ELSE IF ((CIN(ICOM)(1:2) .EQ. 'CI') .OR.
& (CIN(ICOM)(1:2) .EQ. 'ci')) THEN
ICOM = ICOM + 1
CALL MESSAGE('NOTE: IF A CW ARC IS DESIRED, ENTER')
CALL MESSAGE(' THE CENTER POINT AS NEGATIVE')
CALL MESSAGE('ENTER CIRCULAR ARC LINE DATA IN THE '//
& 'FOLLOWING FORMAT:')
CALL MESSAGE('[ LINE NO., POINT 1, POINT 2, CENTER, NO. '//
& 'INTERVALS, FACTOR ]')
IT = 3
ELSE IF (CIN(ICOM)(1:1) .EQ. '3') THEN
ICOM = ICOM + 1
CALL MESSAGE('ENTER THIRD POINT ARC DATA IN THE '//
& 'FOLLOWING FORMAT:')
CALL MESSAGE('[ LINE NO., POINT 1, POINT 2, POINT 3, NO. '//
& 'INTERVALS, FACTOR ]')
IT = 4
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'R') .OR.
& (CIN(ICOM)(1:1) .EQ. 'r')) THEN
ICOM = ICOM + 1
CALL MESSAGE('NOTE: THE RADIUS IS ASSUMED TO BE CONTAINED')
CALL MESSAGE(' IN THE X COORDINATE OF POINT 3. THE')
CALL MESSAGE(' ARC CENTER IS ASSUMED TO THE LEFT OF A')
CALL MESSAGE(' LINE FROM POINT 1 TO POINT 2 (OPPOSITE')
CALL MESSAGE(' IF POINT 3 IS ENTERED NEGATIVE).')
CALL MESSAGE('ENTER CIRCULAR ARC W/RADIUS DATA IN THE '//
& 'FOLLOWING FORMAT:')
CALL MESSAGE('[ LINE NO., POINT 1, POINT 2, CENTER, NO. '//
& 'INTERVALS, FACTOR ]')
IT = 7
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'E') .OR.
& (CIN(ICOM)(1:1) .EQ. 'e')) THEN
ICOM = ICOM + 1
CALL MESSAGE('NOTE: THE TWO POINTS ON THE ELIPSE CANNOT'//
& ' BE COLINEAR WITH THE')
CALL MESSAGE(' CENTER POINT IN THIS DEFINITION.')
CALL MESSAGE('NOTE: IF A CW ARC IS DESIRED, ENTER')
CALL MESSAGE(' THE CENTER POINT AS NEGATIVE.')
CALL MESSAGE('ENTER ELIPSE ABOUT A CENTER DATA IN THE '//
& 'FOLLOWING FORMAT:')
CALL MESSAGE('[ LINE NO., POINT 1, POINT 2, POINT 3, NO. '//
& 'INTERVALS, FACTOR ]')
IT = 7
ELSE IF ((CIN(ICOM)(1:2) .EQ. 'CO') .OR.
& (CIN(ICOM)(1:2) .EQ. 'co')) THEN
ICOM = ICOM + 1
CALL MESSAGE('NOTE: A CORNER LINE CONTAINS TO STRAIGHT '//
& 'LINE')
CALL MESSAGE(' SEGMENTS JOINED AT POINT 3')
CALL MESSAGE('ENTER CORNER LINE DATA IN THE FOLLOWING '//
& 'FORMAT:')
CALL MESSAGE('[ LINE NO., POINT 1, POINT 2, POINT 3, NO. '//
& 'INTERVALS, FACTOR ]')
IT = 2
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'P') .OR.
& (CIN(ICOM)(1:1) .EQ. 'p')) THEN
ICOM = ICOM + 1
CALL MESSAGE('NOTE: POINT 3 IS THE TIP OF THE PARABOLA, '//
& 'AND')
CALL MESSAGE(' POINT 1 AND POINT 2 MUST BE EQUAL ARC')
CALL MESSAGE(' LENGTHS AWAY (ISOCELES TRIANGLE)')
CALL MESSAGE('ENTER PARABOLIC LINE DATA IN THE FOLLOWING '//
& 'FORMAT:')
CALL MESSAGE('[ LINE NO., POINT 1, POINT 2, POINT 3, NO. '//
& 'INTERVALS, FACTOR ]')
IT = 5
ELSE
ICOM = ICOM + 1
GO TO 110
END IF
CALL MESSAGE('HIT RETURN TO END INPUT')
ICOM = JCOM + 1
130 CONTINUE
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, IFOUND, KIN, CIN, IIN,
& RIN)
IF (IFOUND .GT. 0) THEN
JJ = IIN(1)
IF ((JJ .LE. 0) .OR. (JJ .GE. 10000)) THEN
WRITE(*, 10010)JJ
GO TO 130
ELSE IF (((IT .EQ. 1).AND.(IFOUND .LT. 3)) .OR.
& ((IT.NE.1).AND.(IFOUND .LT. 4))) THEN
WRITE(*, 10020)JJ
GO TO 130
END IF
IZERO = 0
ADDLNK = .FALSE.
CALL LTSORT(ML, LINKL, JJ, IPNTR, ADDLNK)
IF (IT .EQ. 1) THEN
CALL INLINE(ML, N(2), N(19), JJ, IT, IIN(2), IIN(3),
& IZERO, IIN(4), RIN(5), NHOLDL, IHOLDL, ILINE, LTYPE,
& NINT, FACTOR, LCON, ILBOUN, ISBOUN, LINKL, MERGE,
& NOROOM)
ELSE
CALL INLINE(ML, N(2), N(19), JJ, IT, IIN(2), IIN(3),
& IIN(4), IIN(5), RIN(6), NHOLDL, IHOLDL, ILINE, LTYPE,
& NINT, FACTOR, LCON, ILBOUN, ISBOUN, LINKL, MERGE,
& NOROOM)
END IF
IF (NOROOM) GO TO 400
C LINK UP THE OLD FLAGS TO THE NEW LINE
IF (IPNTR .GT. 0) THEN
ADDLNK = .FALSE.
CALL LTSORT(ML, LINKL, JJ, JPNTR, ADDLNK)
ILBOUN(JPNTR) = ILBOUN(IPNTR)
ISBOUN(JPNTR) = ISBOUN(IPNTR)
END IF
GO TO 130
END IF
C ENTER A REGION INTERVAL SIZE INTO THE DATABASE
ELSE IF ((CIN(ICOM)(1:3) .EQ. 'SIZ') .OR.
& (CIN(ICOM)(1:3) .EQ. 'siz')) 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
140 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 150 IRSZ = 2, IFOUND
CALL LTSORT(MR, LINKR, IIN(IRSZ), JJ, ADDLNK)
IF (JJ .GE. 0) THEN
RSIZE(JJ) = AMAX1(RIN(1), 0.)
ELSE
WRITE(*, 10030)IIN(IRSZ)
END IF
150 CONTINUE
END IF
GO TO 140
END IF
C ENTER A SIDE INTO THE DATABASE
ELSE IF ((CIN(ICOM)(1:2) .EQ. 'SI') .OR.
& (CIN(ICOM)(1:2) .EQ. 'si')) THEN
ICOM = ICOM + 1
CALL MESSAGE('ENTER SIDE DATA IN THE FOLLOWING FORMAT:')
CALL MESSAGE('[ SIDE NO., LINE 1, LINE 2, ..., LINE N ]')
CALL MESSAGE('HIT RETURN TO END INPUT')
ICOM = JCOM + 1
160 CONTINUE
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, IFOUND, KIN, CIN, IIN,
& RIN)
IF (IFOUND .GT. 0) THEN
JJ = IIN(1)
IF ((JJ .LE. 0) .OR. (JJ .GE. 10000)) THEN
WRITE(*, 10040)JJ
GO TO 160
ELSE IF (IFOUND .LT. 2) THEN
WRITE(*, 10070)JJ
GO TO 160
END IF
CALL INSIDE(MS, N(3), N(4), N(20), JJ, IIN(2), IFOUND - 1,
& ISIDE, NLPS, IFLINE, ILLIST, LINKS, NHOLDS, IHOLDS,
& MERGE, NOROOM)
IF (NOROOM) GO TO 400
GO TO 160
END IF
C ENTER A HOLE INTO THE DATABASE
ELSE IF ((CIN(ICOM)(1:2) .EQ. 'HO') .OR.
& (CIN(ICOM)(1:2) .EQ. 'ho')) THEN
ICOM = ICOM + 1
CALL MESSAGE('ENTER HOLE DATA IN THE FOLLOWING FORMAT:')
CALL MESSAGE('[ REGION NO., HOLE 1, HOLE 2, ..., HOLE N ]')
CALL MESSAGE('HIT RETURN TO END INPUT')
ICOM = JCOM + 1
170 CONTINUE
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, IFOUND, KIN, CIN, IIN,
& RIN)
IF (IFOUND .GT. 0) THEN
JJ = IIN(1)
ADDLNK = .FALSE.
CALL LTSORT (MR, LINKR, JJ, JJPNTR, ADDLNK)
ADDLNK = .TRUE.
IF (JJPNTR .LE. 0) THEN
WRITE(*, 10080) JJ
GO TO 170
ELSE IF (IFOUND .LT. 1) THEN
WRITE(*, 10090) JJ
GO TO 170
END IF
CALL INHOLE (MR, N(7), N(29), JJPNTR, IIN(2), IFOUND - 1,
& IFHOLE, NHPR, IHLIST, MERGE, NOROOM)
IF (NOROOM) GO TO 400
GO TO 170
END IF
C ENTER A BARSET INTO THE DATABASE
ELSE IF ((CIN(ICOM)(1:2) .EQ. 'BA') .OR.
& (CIN(ICOM)(1:2) .EQ. 'ba')) THEN
ICOM = ICOM + 1
CALL MESSAGE('ENTER BAR SET DATA IN THE FOLLOWING FORMAT:')
CALL MESSAGE('[ BAR SET NO., MAT NO., REFR. PNT., LINE 1, '//
& 'LINE 2, ..., LINE N ]')
CALL MESSAGE('HIT RETURN TO END INPUT')
ICOM = JCOM + 1
180 CONTINUE
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, IFOUND, KIN, CIN, IIN,
& RIN)
IF (IFOUND .GT. 0) THEN
JJ = IIN(1)
IF ((JJ .LE. 0) .OR. (JJ .GE. 10000)) THEN
WRITE(*, 10050)JJ
GO TO 180
ELSE IF (IFOUND .LT. 4) THEN
WRITE(*, 10060)JJ
GO TO 180
END IF
CALL INBRST(MS, MR, N(5), N(6), N(21), N(23), JJ, IIN(2),
& IIN(3), IIN(4), IFOUND - 3, IBARST, JMAT, JCENT, NLPB,
& JFLINE, JLLIST, LINKB, LINKM, NHOLDM, IHOLDM, NHOLDB,
& IHOLDB, MERGE, NOROOM)
IF (NOROOM) GO TO 400
GO TO 180
END IF
C INPUT A BODY DEFINITION INTO THE DATABASE
ELSE IF ((CIN(ICOM)(1:3) .EQ. 'BOD') .OR.
& (CIN(ICOM)(1:3) .EQ. 'bod')) THEN
ICOM = ICOM + 1
CALL MESSAGE('NOTE: THE BODY CAN BE MADE UP OF ANY')
CALL MESSAGE(' COMBINATION OF REGIONS AND BAR SETS.')
CALL MESSAGE(' ENTER BAR SETS AS NEGATIVE REGIONS.')
CALL MESSAGE('ENTER REGIONS (& BAR SETS) IN THE BODY IN THE '//
& 'FOLLOWING FORMAT')
CALL MESSAGE('[ REGION 1, REGION 2, ..., REGION N ]')
CALL MESSAGE('HIT A RETURN TO END INPUT')
ICOM = JCOM + 1
190 CONTINUE
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, IFOUND, KIN, CIN, IIN,
& RIN)
IF ((IFOUND .GT. 0).AND.(IFOUND .LE. NIN)) THEN
IF (N(9) .GT. 0) THEN
DO 200 J = 1, IFOUND
JIN(J) = IIN(J)
200 CONTINUE
CALL INTRUP('REPLACE THE CURRENT BODY DEFINITION', IANS,
& MCOM, ICOM, JCOM, CIN, IIN, RIN, KIN)
DO 210 J = 1, IFOUND
IIN(J) = JIN(J)
210 CONTINUE
IF (IANS) THEN
ADDOLD = .FALSE.
ELSE
ADDOLD = .TRUE.
END IF
END IF
CALL INBODY(MR, N(9), IIN, IFOUND, IRPB, ADDOLD, NOROOM)
IF (NOROOM) GO TO 400
GO TO 190
ELSE IF (IFOUND .GT. NIN) THEN
CALL MESSAGE('TOO MANY BODIES BEING INPUT A ONCE - TRY '//
& 'AGAIN')
GO TO 190
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 INPUT A SCHEME INTO THE DATABASE
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'S') .OR.
& (CIN(ICOM)(1:1) .EQ. 's')) THEN
ICOM = ICOM + 1
CALL MESSAGE('NOTE: ENTER A DEFAULT SCHEME BY SPECIFYING')
CALL MESSAGE(' THE REGION NUMBER AS ZERO')
CALL MESSAGE('ENTER A SCHEME IN THE FOLLOWING FORMAT:')
CALL MESSAGE('[ REGION NO., SCHEME ]')
CALL MESSAGE('HIT RETURN TO END INPUT')
ICOM = JCOM + 1
220 CONTINUE
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, IFOUND, KIN, CIN, IIN,
& RIN)
IF (IFOUND .GT. 0) THEN
JJ = IIN(1)
IF (JJ .GE. 10000) THEN
WRITE(*, 10150)JJ
GO TO 220
ELSE IF (IFOUND .LT. 2) THEN
WRITE(*, 10160)JJ
GO TO 220
END IF
NOLD10 = N(10)
NOLD24 = N(24)
CALL INSCHM(MR, MSC, N(10), N(24), JJ, CIN(2), ISCHM,
& SCHEME, LINKSC, DEFSCH, NOROOM, DOLINK)
IF (NOROOM) THEN
N(10) = NOLD10
N(24) = NOLD24
CALL MESSAGE('************************************')
CALL MESSAGE('NOT ENOUGH ROOM FOR SCHEME CARD')
CALL MESSAGE('NO DYNAMIC DIMENSIONING INCREASES')
CALL MESSAGE('AVAILABLE FOR CHARACTER STRINGS')
CALL MESSAGE('SCHEME INPUT IS THUS IGNORED')
CALL MESSAGE('************************************')
END IF
GO TO 220
END IF
C INPUT A BOUNDARY INTO THE DATABASE
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'B') .OR.
& (CIN(ICOM)(1:1) .EQ. 'b')) THEN
ICOM = ICOM + 1
IF (ICOM .GT. JCOM) THEN
CALL MESSAGE(' ')
CALL MESSAGE('THE FOLLOWING BOUNDARY FLAGS ARE AVAILABLE:')
CALL MESSAGE(' P*OINT FLAGS - FOR NODES AT '//
& 'POINTS')
CALL MESSAGE(' N*ODE FLAGS - FOR NODES ON A '//
& 'BOUNDARY')
CALL MESSAGE(' E*LEMENT FLAGS - FOR ELEMENT '//
& 'SIDES ON A BOUNDARY')
CALL FREFLD (IZ, IZ, 'WHICH BOUNDARY FLAG WOULD YOU LIKE '//
& 'TO ENTER: ', MCOM, IOSTAT, JCOM, KIN, CIN, IIN, RIN)
ICOM = 1
END IF
C INPUT A POINT BOUNDARY INTO THE DATABASE
IF ((CIN(ICOM)(1:1) .EQ. 'P') .OR.
& (CIN(ICOM)(1:1) .EQ. 'p')) THEN
ICOM = ICOM + 1
CALL MESSAGE('INPUT POINT BOUNDARY FLAG DATA IN THE '//
& 'FOLLOWING FORMAT:')
CALL MESSAGE('[ FLAG NO., POINT 1, POINT 2, ..., POINT N ]')
CALL MESSAGE('HIT RETURN TO END INPUT')
ICOM = JCOM + 1
230 CONTINUE
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, IFOUND, KIN, CIN,
& IIN, RIN)
IF (IFOUND .GT. 0) THEN
ADDOLD = .FALSE.
CALL INBOUN(MP, IIN(1), IFOUND - 1, IIN(2), N(25), N(11),
& N(12), NOLD(11), MERGE, NOROOM, NEWNUM, NHOLD1,
& IHOLD1, IPBF, NPPF, IFPB, LISTPB, LINKPB, IWTPBF,
& JHOLD, ADDOLD)
IF (NOROOM) GO TO 400
GO TO 230
END IF
C INPUT A NODE BOUNDARY INTO THE DATABASE
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'N') .OR.
& (CIN(ICOM)(1:1) .EQ. 'n')) THEN
ICOM = ICOM + 1
CALL MESSAGE('INPUT NODE BOUNDARY FLAG DATA IN THE '//
& 'FOLLOWING FORMAT:')
CALL MESSAGE('[ FLAG NO., LINE (OR NEG. SIDE) 1, LINE '//
& '(OR NEG. SIDE) 2, ...]')
CALL MESSAGE('HIT RETURN TO END INPUT')
ICOM = JCOM + 1
240 CONTINUE
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, IFOUND, KIN, CIN,
& IIN, RIN)
IF (IFOUND .GT. 0) THEN
ADDOLD = .FALSE.
CALL INBOUN(ML, IIN(1), IFOUND - 1, IIN(2), N(26), N(13),
& N(14), NOLD(13), MERGE, NOROOM, NEWNUM, NHOLD2,
& IHOLD2, ILBF, NLPF, IFLB, LISTLB, LINKLB, IWTLBF,
& JHOLD, ADDOLD)
IF (NOROOM) GO TO 400
GO TO 240
END IF
C INPUT AN ELEMENT BOUNDARY INTO THE DATABASE
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'E') .OR.
& (CIN(ICOM)(1:1) .EQ. 'e')) THEN
ICOM = ICOM + 1
CALL MESSAGE('INPUT ELEMENT BOUNDARY FLAG DATA IN THE '//
& 'FOLLOWING FORMAT:')
CALL MESSAGE('[ FLAG NO., LINE (OR NEG. SIDE) 1, LINE '//
& '(OR NEG. SIDE) 2, ...]')
CALL MESSAGE('HIT RETURN TO END INPUT')
ICOM = JCOM + 1
250 CONTINUE
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, IFOUND, KIN, CIN,
& IIN, RIN)
IF (IFOUND .GT. 0) THEN
ADDOLD = .FALSE.
CALL INBOUN(ML, IIN(1), IFOUND - 1, IIN(2), N(27), N(15),
& N(16), NOLD(15), MERGE, NOROOM, NEWNUM, NHOLD3,
& IHOLD3, ISBF, NSPF, IFSB, LISTSB, LINKSB, IWTSBF,
& JHOLD, ADDOLD)
IF (NOROOM) GO TO 400
GO TO 250
END IF
END IF
C INPUT A BOUNDARY FLAG WEIGHTING INTO THE DATABASE
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'W') .OR.
& (CIN(ICOM)(1:1) .EQ. 'w')) THEN
ICOM = ICOM + 1
IF (ICOM .GT. JCOM) THEN
CALL MESSAGE(' ')
CALL MESSAGE('THE FOLLOWING BOUNDARY FLAGS CAN BE '//
& 'WEIGHTED:')
CALL MESSAGE(' P*OINT FLAGS - FOR NODES AT '//
& 'POINTS')
CALL MESSAGE(' N*ODE FLAGS - FOR NODES ON A '//
& 'BOUNDARY')
CALL MESSAGE(' E*LEMENT FLAGS - FOR ELEMENT '//
& 'SIDES ON A BOUNDARY')
CALL FREFLD (IZ, IZ, 'WHICH BOUNDARY FLAG WOULD YOU LIKE '//
& 'TO WEIGHT: ', MCOM, IOSTAT, JCOM, KIN, CIN, IIN, RIN)
ICOM = 1
END IF
C INPUT A POINT BOUNDARY FLAG WEIGHT INTO THE DATABASE
IF ((CIN(ICOM)(1:1) .EQ. 'P') .OR.
& (CIN(ICOM)(1:1) .EQ. 'p')) THEN
ICOM = ICOM + 1
CALL MESSAGE('INPUT POINT BOUNDARY FLAG WEIGHTS IN THE '//
& 'FOLLOWING FORMAT:')
CALL MESSAGE('[ FLAG NO., WEIGHTING POINT, BOUNDARY '//
& 'POINT ]')
CALL MESSAGE('HIT RETURN TO END INPUT')
ICOM = JCOM + 1
260 CONTINUE
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, IFOUND, KIN, CIN,
& IIN, RIN)
IF (IFOUND .GT. 0) THEN
CALL LTSORT(MP, LINKPB, IIN(1), JJ, ADDLNK)
IF (JJ .GT. 0) THEN
IWTPBF(1, JJ) = IIN(2)
IWTPBF(2, JJ) = IIN(3)
IWTPBF(3, JJ) = 0
ELSE
WRITE(*, 10100)'POINT', IIN(1)
END IF
GO TO 260
END IF
C INPUT A NODE BOUNDARY WEIGHT INTO THE DATABASE
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'N') .OR.
& (CIN(ICOM)(1:1) .EQ. 'n')) THEN
ICOM = ICOM + 1
CALL MESSAGE('INPUT NODE BOUNDARY FLAG WEIGHTS IN THE '//
& 'FOLLOWING FORMAT:')
CALL MESSAGE('[ FLAG NO., WEIGHTING SIDE (OR NEG. LINE) '//
& 'NO., BEGINNING POINT NO., ')
CALL MESSAGE(' BEGINNING LINE NO. (OPTIONAL) ]')
CALL MESSAGE('HIT RETURN TO END INPUT')
ICOM = JCOM + 1
270 CONTINUE
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, IFOUND, KIN, CIN,
& IIN, RIN)
IF (IFOUND .GT. 0) THEN
CALL LTSORT(ML, LINKLB, IIN(1), JJ, ADDLNK)
IF (JJ .GT. 0) THEN
IWTLBF(1, JJ) = IIN(2)
IWTLBF(2, JJ) = IIN(3)
IWTLBF(3, JJ) = IIN(4)
ELSE
WRITE(*, 10100)'NODE', IIN(1)
END IF
GO TO 270
END IF
C INPUT AN ELEMENT BOUNDARY WEIGHT INTO THE DATABASE
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'E') .OR.
& (CIN(ICOM)(1:1) .EQ. 'e')) THEN
ICOM = ICOM + 1
CALL MESSAGE('INPUT ELEMENT BOUNDARY FLAG WEIGHTS IN THE '//
& 'FOLLOWING FORMAT:')
CALL MESSAGE('[ FLAG NO., WEIGHTING SIDE (OR NEG. LINE) NO.,
& BEGINNING POINT NO., ')
CALL MESSAGE(' BEGINNING LINE NO. (OPTIONAL) ]')
CALL MESSAGE('HIT RETURN TO END INPUT')
ICOM = JCOM + 1
280 CONTINUE
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, IFOUND, KIN, CIN,
& IIN, RIN)
IF (IFOUND .GT. 0) THEN
CALL LTSORT(ML, LINKSB, IIN(1), JJ, ADDLNK)
IF (JJ .GT. 0) THEN
IWTSBF(1, JJ) = IIN(2)
IWTSBF(2, JJ) = IIN(3)
IWTSBF(3, JJ) = IIN(4)
ELSE
WRITE(*, 10100)'ELEMENT', IIN(1)
END IF
GO TO 280
END IF
END IF
C TOGGLE THE BANDWIDTH OPTIMIZATION FLAG
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('BANDWIDTH OPTIMIZER DISABLED')
ELSE
OPTIM = .TRUE.
CALL MESSAGE('BANDWIDTH OPTIMIZER ENABLED')
END IF
C FLAG THE BANDWIDTH OPTIMIZATION ROUTINES ON, AND READ A RENUM CARD
ELSE IF ((CIN(ICOM)(1:3) .EQ. 'REN') .OR.
& (CIN(ICOM)(1:3) .EQ. 'ren')) THEN
ICOM = ICOM + 1
OPTIM = .TRUE.
CALL MESSAGE(' ')
CALL MESSAGE('THE FOLLOWING RENUMBERING OPTIONS ARE '//
& 'AVAILABLE:')
CALL MESSAGE(' P*-L-P = POINT LINE POINT STARTING LIST')
CALL MESSAGE(' X*, Y = X, Y STARTING LOCATION')
CALL MESSAGE(' N*UID = NODE UNIQUE ID STARTING LIST')
IF (ICOM .GT. JCOM) THEN
CALL FREFLD (IZ, IZ, 'WHICH RENUMBER OPTION WOULD YOU '//
& 'LIKE TO ENTER: ', MCOM, IOSTAT, JCOM, KIN, CIN, IIN,
& RIN)
ICOM = 1
END IF
C ENTER A POINT-LINE-POINT RENUM CARD
IF ((CIN(ICOM)(1:1) .EQ. 'P') .OR.
& (CIN(ICOM)(1:1) .EQ. 'p')) THEN
ICOM = ICOM + 1
HOLD = 'P-L-P'
CALL MESSAGE('ENTER A POINT-LINE-POINT CARD IN THE '//
& 'FOLLOWING FORMAT')
CALL MESSAGE('[ ENTER POINT, LINE, POINT, LINE, ... ]')
CALL MESSAGE('HIT A RETURN TO END INPUT')
ICOM = JCOM + 1
290 CONTINUE
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, IFOUND, KIN, CIN,
& IIN, RIN)
IF (IFOUND .GE. 1) THEN
CALL INRENM(MSC, N(28), HOLD, RIN, IIN, IFOUND, NUMBER,
& NOROOM)
IF (NOROOM) GO TO 400
GO TO 290
END IF
C ENTER A X, Y LOCATION RENUM CARD
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'X') .OR.
& (CIN(ICOM)(1:1) .EQ. 'x')) THEN
ICOM = ICOM + 1
HOLD = 'X-Y '
CALL MESSAGE('ENTER X, Y PAIRS IN THE FOLLOWING FORMAT')
CALL MESSAGE('[ X , Y ]')
CALL MESSAGE('HIT A RETURN TO END INPUT')
ICOM = JCOM + 1
300 CONTINUE
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, IFOUND, KIN, CIN,
& IIN, RIN)
IF (IFOUND .GE. 1) THEN
CALL INRENM(MSC, N(28), HOLD, RIN, IIN, IFOUND, NUMBER,
& NOROOM)
IF (NOROOM) GO TO 400
GO TO 300
END IF
C ENTER A NODE UNIQUE ID RENUM CARD
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'N') .OR.
& (CIN(ICOM)(1:1) .EQ. 'n')) THEN
ICOM = ICOM + 1
HOLD = 'NODE '
CALL MESSAGE('NOTE: NODE UNIQUE ID NUMBERS (NUID) ARE')
CALL MESSAGE(' DEFINED IN THE DOCUMENTATION')
CALL MESSAGE('ENTER NUID CARDS IN THE FOLLOWING FORMAT:')
CALL MESSAGE('[ NUID 1, NUID 2, ..., NUID N ]')
CALL MESSAGE('HIT A RETURN TO END INPUT')
ICOM = JCOM + 1
310 CONTINUE
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, IFOUND, KIN, CIN,
& IIN, RIN)
IF (IFOUND .GE. 1) THEN
CALL INRENM(MSC, N(28), HOLD, RIN, IIN, IFOUND, NUMBER,
& NOROOM)
IF (NOROOM) GO TO 400
GO TO 310
END IF
END IF
C ENTER A REGION INTO THE DATABASE
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'R') .OR.
& (CIN(ICOM)(1:1) .EQ. 'r')) THEN
ICOM = ICOM + 1
CALL INTRUP('ARE YOU USING SIDES IN DEFINING REGIONS', IANS,
& MCOM, ICOM, JCOM, CIN, IIN, RIN, KIN)
IF (IANS) THEN
CALL MESSAGE('NOTE: ENTER ANY LINES NEEDED IN THE REGION '//
& 'AS')
CALL MESSAGE(' A NEGATIVE SIDE.')
CALL MESSAGE('ENTER REGION DATA IN THE FOLLOWING FORMAT:')
CALL MESSAGE('[ REGION NO., MATERIAL NO., SIDE 1, SIDE '//
& '2, ..., SIDE N ]')
ELSE
CALL MESSAGE('ENTER REGION DATA IN THE FOLLOWING FORMAT:')
CALL MESSAGE('[ REGION NO., MATERIAL NO., LINE 1, LINE '//
& '2, ..., LINE N ]')
END IF
ICOM = JCOM + 1
CALL MESSAGE('HIT RETURN TO END INPUT')
320 CONTINUE
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, IFOUND, KIN, CIN, IIN,
& RIN)
IF (IFOUND .GT. 0) THEN
JJ = IIN(1)
IF ((JJ .LE. 0) .OR. (JJ .GE. 10000)) THEN
WRITE(*, 10110)JJ
GO TO 320
ELSE IF (IFOUND .LT. 3) THEN
WRITE(*, 10120)JJ
GO TO 320
END IF
IF (.NOT.IANS) THEN
DO 330 J = 3, IFOUND
IIN(J) = -IIN(J)
330 CONTINUE
END IF
CALL INREGN(MS, MR, N(7), N(8), N(22), N(23), JJ, IIN(2),
& IIN(3), IFOUND - 2, IREGN, IMAT, NSPR, IFSIDE, ISLIST,
& LINKR, LINKM, NHOLDR, IHOLDR, NHOLDM, IHOLDM, IRGFLG,
& MERGE, NOROOM)
IF (NOROOM) GO TO 400
ADDLNK = .FALSE.
CALL LTSORT(MR, LINKR, IIN(1), JJPNTR, ADDLNK)
RSIZE(JJPNTR) = 0.
GO TO 320
END IF
C ENTER A GROUP OF REGIONS INTO THE DATABASE
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'G') .OR.
& (CIN(ICOM)(1:1) .EQ. 'g')) THEN
ICOM = ICOM + 1
CALL MESSAGE
& ('ENTER GROUP OF REGIONS IN THE FOLLOWING FORMAT:')
CALL MESSAGE
& ('[ GROUP NO., REGION 1, REGION 2, ..., REGION N ]')
ICOM = JCOM + 1
CALL MESSAGE('HIT RETURN TO END INPUT')
340 CONTINUE
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, IFOUND, KIN, CIN, IIN,
& RIN)
IF (IFOUND .GT. 0) THEN
JJ = IIN(1)
IF ((JJ .LE. 0) .OR. (JJ .GE. 10000)) THEN
WRITE(*, 10130)JJ
GO TO 340
ELSE IF (IFOUND .LT. 2) THEN
WRITE(*, 10140)JJ
GO TO 340
END IF
CALL INGRPN(MS, MR, N(7), N(8), N(22), JJ, IIN(2),
& IFOUND - 1, IREGN, NSPR, IFSIDE, ISLIST, LINKR, NHOLDR,
& IHOLDR, IRGFLG, MERGE, NOROOM)
IF (NOROOM) GO TO 400
GO TO 340
END IF
C ENTER A TITLE
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'T') .OR.
& (CIN(ICOM)(1:1) .EQ. 't')) THEN
ICOM = ICOM + 1
IF (ICOM .GT. JCOM) THEN
CALL GETINP(IUNIT, IDUMP, 'TITLE: ', TITLE, IOSTAT)
END IF
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
350 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)
III(1) = I1
IF (IFOUND .GT. 0) THEN
CALL ININTR(ML, MS, 1, I2, III, N(19), N(20), NINT, NLPS,
& IFLINE, ILLIST, LINKL, LINKS, ADDLNK)
GO TO 350
END IF
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
360 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)
III(1) = I1
IF (IFOUND .GT. 0) THEN
CALL INFACT(ML, MS, 1, R1, III(1), N(19), N(20), FACTOR,
& NLPS, IFLINE, ILLIST, LINKL, LINKS, ADDLNK)
GO TO 360
END IF
C ENTER MATERIAL NUMBERS
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'M') .OR.
& (CIN(ICOM)(1:1) .EQ. 'm')) THEN
ICOM = ICOM + 1
CALL MESSAGE('ENTER REGION MATERIALS IN THE FOLLOWING FORMAT:')
CALL MESSAGE('[ REGION NO., MATERIAL NO. ]')
CALL MESSAGE('HIT RETURN TO END INPUT')
ICOM = JCOM + 1
370 CONTINUE
CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, IFOUND, KIN, CIN, IIN,
& RIN)
IF (IFOUND .GT. 0) THEN
JJ = IIN(1)
CALL LTSORT(MR, LINKR, JJ, IPNTR, ADDLNK)
IF ((JJ .GT. N(22)) .OR. (IPNTR .LE. 0)) THEN
WRITE(*, 10170)JJ
ELSE
IMAT(IPNTR) = IIN(2)
END IF
GO TO 370
END IF
C FLAG THE THREE-NODE ELEMENT OPTION
ELSE IF ((CIN(ICOM)(1:2) .EQ. 'TH') .OR.
& (CIN(ICOM)(1:1) .EQ. 'th')) THEN
ICOM = ICOM + 1
IF (THREE) THEN
THREE = .FALSE.
CALL MESSAGE('THREE NODE ELEMENT GENERATION - OFF')
ELSE
THREE = .TRUE.
CALL MESSAGE('THREE NODE ELEMENT GENERATION - ON')
END IF
C FLAG THE EIGHT-NODE ELEMENT OPTION
ELSE IF ((CIN(ICOM)(1:2) .EQ. 'EI') .OR.
& (CIN(ICOM)(1:1) .EQ. 'ei')) THEN
ICOM = ICOM + 1
IF (EIGHT) THEN
EIGHT = .FALSE.
CALL MESSAGE('EIGHT NODE ELEMENT GENERATION - OFF')
ELSE
EIGHT = .TRUE.
NINE = .FALSE.
CALL MESSAGE('EIGHT NODE ELEMENT GENERATION - ON')
END IF
C FLAG THE NINE-NODE ELEMENT OPTION
ELSE IF ((CIN(ICOM)(1:1) .EQ. 'N') .OR.
& (CIN(ICOM)(1:1) .EQ. 'n')) THEN
ICOM = ICOM + 1
IF (NINE) THEN
NINE = .FALSE.
CALL MESSAGE('NINE NODE ELEMENT GENERATION - OFF')
ELSE
NINE = .TRUE.
EIGHT = .FALSE.
CALL MESSAGE('NINE NODE ELEMENT GENERATION - ON')
END IF
C EXIT OPTION - EXITS FASTQ
ELSE IF ((CIN(ICOM)(1:2) .EQ. 'EX') .OR.
& (CIN(ICOM)(1:2) .EQ. 'ex')) THEN
ICOM = ICOM + 1
CALL STRLNG (CIN(ICOM), LEN)
IF (((LEN .GT. 1) .AND. (CIN(ICOM)(2:2) .NE. 'X')) .OR.
& ((LEN .GT. 1) .AND. (CIN(ICOM)(2:2) .NE. 'x'))) THEN
CALL HELP_FQ(9)
ELSE
CALL FEXIT(WROTE, MCOM, ICOM, JCOM, CIN, IIN, RIN, KIN,
& TIME1, BATCH, VERSN)
ENDIF
GO TO 110
C LINK ALL NEW DATA AS NEEDED, AND RETURN FROM THE KEYIN OPTION
ELSE IF (CIN(ICOM)(1:1) .EQ. ' ') THEN
ICOM = ICOM + 1
C LINK UP THE POINTS AND LINES TO THEIR ASSOCIATED FLAGS
SIDEOK = .FALSE.
CALL LINKBC(MP, MS, NOLD(11) + 1, N(11), N(1), N(25), N(11),
& N(12), N(20), IPBF, IFPB, NPPF, LISTPB, NLPS, IFLINE,
& ILLIST, IPBOUN, LINKPB, IWTPBF, LINKP, LINKS, SIDEOK,
& NOROOM)
IF (NOROOM) GO TO 400
SIDEOK = .TRUE.
CALL LINKBC(ML, MS, NOLD(13) + 1, N(13), N(2), N(26), N(13),
& N(14), N(20), ILBF, IFLB, NLPF, LISTLB, NLPS, IFLINE,
& ILLIST, ILBOUN, LINKLB, IWTLBF, LINKL, LINKS, SIDEOK,
& NOROOM)
IF (NOROOM) GO TO 400
CALL LINKBC(ML, MS, NOLD(15) + 1, N(15), N(2), N(27), N(15),
& N(16), N(20), ISBF, IFSB, NSPF, LISTSB, NLPS, IFLINE,
& ILLIST, ISBOUN, LINKSB, IWTSBF, LINKL, LINKS, SIDEOK,
& NOROOM)
IF (NOROOM) GO TO 400
C IF NO BODY CARDS HAVE BEEN READ, ASSUME THE BODY IS ALL THE
C REGIONS AND ALL THE BAR SETS
IF (N(9) .EQ. NOLD(9)) THEN
ADDOLD = .TRUE.
IFOUND = 1
DO 380 I = NOLD(5) + 1, N(5)
CALL LTSORT(MS, LINKB, IBARST(I), IPNTR, ADDLNK)
IF (IPNTR .EQ. I) THEN
III(1) = -IBARST(I)
CALL INBODY(MR, N(9), III, IFOUND, IRPB, ADDOLD,
& NOROOM)
IF (NOROOM) GO TO 400
END IF
380 CONTINUE
DO 390 I = NOLD(7) + 1, N(7)
CALL LTSORT(MR, LINKR, IREGN(I), IPNTR, ADDLNK)
IF (IPNTR .EQ. I) THEN
CALL INBODY(MR, N(9), IREGN(I), IFOUND, IRPB, ADDOLD,
& NOROOM)
IF (NOROOM) GO TO 400
END IF
390 CONTINUE
END IF
RETURN
ELSE
ICOM = ICOM + 1
CALL HELP_FQ(9)
END IF
GO TO 110
C MORE ROOM IN DIMENSIONS NEEDED
400 CONTINUE
CALL MESSAGE(' ')
CALL MESSAGE('DIMENSIONS MUST BE INCREASED - PLEASE WAIT')
DO 410 I = 1, 29
N(I) = NOLD(I)
410 CONTINUE
NOROOM = .TRUE.
RETURN
10000 FORMAT(' A POINT NO. OF:', I7, ' IS NOT ALLOWED', /,
& ' THIS POINT WILL NOT BE INPUT INTO DATABASE')
10010 FORMAT(' A LINE NO. OF:', I7, ' IS NOT ALLOWED', /,
& ' THIS LINE WILL NOT BE INPUT INTO DATABASE')
10020 FORMAT(' FOR LINE NO.:', I5, ' NOT ENOUGH INFORMATION IS '//
& 'SUPPLIED',/, ' THIS LINE WILL NOT BE INPUT INTO DATABASE')
10030 FORMAT(' REGION NO:', I5, ' IS NOT IN THE DATABASE', /,
& ' THUS NO SIZE CAN BE ENTERED')
10040 FORMAT(' A SIDE NO. OF:', I7, ' IS NOT ALLOWED', /,
& ' THIS SIDE WILL NOT BE INPUT INTO DATABASE')
10050 FORMAT(' A BAR SET NO. OF:', I7, ' IS NOT ALLOWED', /,
& ' THIS BAR SET WILL NOT BE INPUT INTO DATABASE')
10060 FORMAT(' FOR BAR SET NO.:', I5,
& /, ' NOT ENOUGH INFORMATION IS SUPPLIED',
& /, ' THIS BAR SET WILL NOT BE INPUT INTO DATABASE')
10070 FORMAT(' FOR SIDE NO.:', I5, ' NOT ENOUGH INFORMATION IS '//
& 'SUPPLIED',/, ' THIS SIDE WILL NOT BE INPUT INTO DATABASE')
10080 FORMAT(' REGION NO:', I5, ' IS NOT IN THE DATABASE', /,
& ' THUS NO HOLE CAN BE ENTERED')
10090 FORMAT(' REGION:', I5, ' HAS LESS THAN ONE HOLE', /,
& ' THE HOLE FOR THIS REGION WILL NOT BE INPUT INTO DATABASE')
10100 FORMAT(' WEIGHTING OF ', A, ' FLAG:', I5, ' NOT POSSIBLE - '//
& 'FLAG NOT FOUND')
10110 FORMAT(' A REGION NO. OF:', I7, ' IS NOT ALLOWED', /,
& ' THIS REGION WILL NOT BE INPUT INTO DATABASE')
10120 FORMAT(' FOR REGION NO.:', I5, ' NOT ENOUGH INFORMATION IS '//
& 'SUPPLIED', /, ' THIS REGION WILL NOT BE INPUT INTO DATABASE')
10130 FORMAT(' A GROUP NO. OF:', I7, ' IS NOT ALLOWED', /,
& ' THIS GROUP WILL NOT BE INPUT INTO DATABASE')
10140 FORMAT(' FOR GROUP NO.:', I5, ' NOT ENOUGH INFORMATION IS '//
& 'SUPPLIED', /, ' THIS GROUP WILL NOT BE INPUT INTO DATABASE')
10150 FORMAT(' A REGION NO. OF:', I7, ' IS NOT ALLOWED', /,
& ' THE SCHEME FOR THIS REGION WILL NOT BE INPUT INTO DATABASE')
10160 FORMAT(' FOR THE SCHEME FOR REGION NO.:', I5,
& ' NOT ENOUGH INFORMATION IS SUPPLIED',
& /, ' THIS SCHEME WILL NOT BE INPUT INTO DATABASE')
10170 FORMAT(' REGION NO:', I5, ' IS NOT IN THE DATABASE', /,
& ' THUS NO MATERIAL NUMBER CAN BE ENTERED')
END