Programma's toegepast bij de simulatie van het muntproces

Programma's toegepast bij de simulatie van het muntproces

Citation for published version (APA):

Mulders, L. H. G. (1987). Programma's toegepast bij de simulatie van het muntproces. (DCT rapporten; Vol. 1987.054). Technische Universiteit Eindhoven.

Document status and date: Gepubliceerd: 01/01/1987

Document Version:

Uitgevers PDF, ook bekend als Version of Record

Please check the document version of this publication:

• A submitted manuscript is the version of the article upon submission and before peer-review. There can be important differences between the submitted version and the official published version of record. People interested in the research are advised to contact the author for the final version of the publication, or visit the DOI to the publisher's website.

• The final author version and the galley proof are versions of the publication after peer review.

• The final published version features the final layout of the paper including the volume, issue and page numbers.

Link to publication

General rights

Copyright and moral rights for the publications made accessible in the public portal are retained by the authors and/or other copyright owners and it is a condition of accessing publications that users recognise and abide by the legal requirements associated with these rights. • Users may download and print one copy of any publication from the public portal for the purpose of private study or research. • You may not further distribute the material or use it for any profit-making activity or commercial gain

• You may freely distribute the URL identifying the publication in the public portal.

If the publication is distributed under the terms of Article 25fa of the Dutch Copyright Act, indicated by the “Taverne” license above, please follow below link for the End User Agreement:

www.tue.nl/taverne

Take down policy

If you believe that this document breaches copyright please contact us at: openaccess@tue.nl

providing details and we will investigate your claim.

Afstudeerhoogleraar

Afstudeerbegeleider

(bijlage bij rapport WFW 87.053)

Lambert Mulders

Rapportnr. WFW 87.054

Prof. dr. ir. J.D. Janssen

Jr. W.A.M. Brekelmans

Vakgroep Fundamentele Werktuigbouwkunde

Technische Universiteit Eindhoven.

REZDAT.FOR - 1

-Programma's.

C

PROGRAM REZDAT

Doe1:

In1ezen van de file <naam>.UNV luitvoer van IDEASl met hierin se1ecteren de waarden van:

de coordinaten, connectivity en boundary conditions. In1ezen van de file <BLRlnr.l .DAT de voorgaande invoer voor MARC, welke gecopieerd wordt tot aan END OPTION, met daarin wijzigen het restartnr. dat moet worden opgegeven.

Toevoegen van het rezoneb10k waarin een complete nieuwe 1ijst met coordinaten en connectivity wordt gep1aatst met daarbij de gegevens van de vereiste gape1ementen.

Hierna p1aatsen van een complete nieuwe lijst met boundary conditions en boundary change.

Afhange1ijk van het aanta1 incrementen dat moet worden doorgerekend, plaatsen van b10kken met rezone, auto

load en proportional increment, waarbij in het rezoneb10k een 1ijst wordt gegeven van knooppuntnr. 's die onder het het stempel liggen en dus na elk increment moeten worden terug gep1aatst.

Uitvoeren van een complete nieuwe file BLREST voor MARC invoer.

Kanaal UNUIT

Komp1ete nieuwe invoer voor Marc voor dit specifieke muntprobleem. Kanaal UNIN

Universal file gemaakt met IDEAS Kanaal UNIN2

Voorgaande invoer voor MARC Het restartnummer.

Stempel verplaatsing na de "nul" slag Aanta1 incrementen dat moet worden doorgerekend.

Unit nr. voor de invoerfi1e <naam>.UNV. Unit nr. voor de invoer van de voorgaande invoerfi1e voor MARC.

Unit nr. voor de uitvoerfile BLRlnr.l.DAT. Unit nr. voor schrijven naar de terminal Unit nr. voor inlezen vanaf terminal Straa1 van de gravure aan de bodem E modulus Dwarscontractie coeficient Vloeispanning BLRlnr.l.DAT RESTNR VERPLAL NAUTO UNUIT SYSOUT KEYIN R1 EMOO NU SIGMVL Parameters: UNIN UNIN2 C C

C=================================================================

C C C C C C C C C C C C C C C C C C C C C C

C Invoer: <naam>. UNV

C C C C C C C C C Uitvoer: BLREST.DAT C C C C C C C C C C C C C C

behoren tot de stem-rand.

Totale aantal knopen in de mesh inclusief de knopen welke behoren tot de gapelementen.

Startwaarde vanaf waar in COORKN coordinaten! sluit- en tangentiaalrichtingen worden toegevoegd. Type gapelementnr ( =12)

Op einde van de do loop gelijk aan het totale aantal elementen inclusief de gebruikte gapelementen.

Teller die op het einde van de 00 loop het totaal aantal uitgeschreven boundary changes cards bevat, in het blok waarin een complete nieuwe lijst wordt uitschreven.

Aantal property cards

Geeft aan dat er een totale nieuwe lijst bounda-change komt.

Verplaatsing in boundary change blok ! O.O)! stempelverplaatsing na de "nul" slag.

aantal keren dat het rezone blok met daarachter het blok met AUTO LOAD geplaatst wordt.

het volgende restartnr.

teller voor de loop die NAUTO maal uitgevoerd wordt. variabelen:

Naan van de invoerfile Teller voor de gapelementen

knopen welke VERPLAL TOTKN NAUTO NPROC NEWBL STARTKN RESTNR JITEL TYPGAP ICO NTEL Locale FILEN NGAP NSTEMKN C C C C C C C C C C C C C C C C C C C C C C C C C C C Array's:

C KNOSTEM(MAXB) Knooppuntnummers welke de plaats aangeven

C waar het stempel rust.

C KNOGAP(MAXB) Knooppuntnummers welke de plaats aangeven

C waar gapelementen worden geplaatst.

C BOUNDPL(MAXB) Plaats waar de r.v.w. in BOUND staat

C die door het stempel wordt opgelegd

C GAPPL(MAXELEM,MNCRD): Plaats waar de r.v.w. van de gapknoop

C verbonden met het stempel staat

uit-C geschreven in het blok BOUNDARY CHANGE

C=================================================================

C

INTEGER*4 SYSOUT, KEYIN

PARAMETER( SYSOUT=6, KEYIN=5) C

INTEGER*4 UNIN, UNUIT, UNIN2

PARAMETER (UNIN= 14, UNUIT=15, UNIN2=16)

C

INTEGER*4 RANDKN, STEMKN, GAPKN,TYPGAP

PARAMETER (RANOKN=1, STEMKN=2, GAPKN=3, TYPGAP=12)

C

REAL*8 R1, EMOD, NU, SIGMVL

PARAMETER! R1 = 1.5, EMOO= 0.14E+05, NU = 0.3, SIGMVL=0.15E+021

C

INTEGER*4 MAXKN, MNCRD, MAXELEM, KNPT,MAXB

PARAMETER! MAXKN= 650, MNCRO=2, KNPT=4, MAXB=200, MAXELEM=6001

C

REZDAT.FOR 3

-C lie voor de betekenis van de variabelen subroutine RECOCO

C

REAL*8 COORKN(MAXKN,MNCRDl,VERPL(MAXBl C

INTEGER*4 NKNW, NELEMW, NBPG, NBPS, PL(MAXBl,NBP, *CONN(MAXELEM,KNPT+l1,BOUND(MAXB,41, BOUNDPL(MAXB) C C INTEGER*4 MNGAP PARAMETER( MNGAP= 301 C

C Opm.: Testen van deze parameters gebeurt o.a. in subroutine GAPBL. C lie voor de betekenis van de variabelen subroutine GAPBL. C

REAL*8 COORGB(MNGAP,MNCRDl, Xl, Yl, X2, Y2, NO(MNCRDl, TA(MNCRDl, * COORGS(MNGAP,MNCRDl, DISTAN(MNGAPl,NO, VERPLAL

C

INTEGER*4 NSTEMKN, NGAP, KNOSTEM(MAXBl,KNOGAP(MAXBl, * TOTKN, STARTKN, STARTEL, NPROC, Nl, NEWBL, NAUTO,

*

RESTNR, JITEL, NTEL, GAPPL(MAXELEM,MNCRDI CHARACTER*72 FILEN, CARD

C

C Naam vragen v/d invoerfile en openen. C

WRITE(SYSOUT,*) . Geef filenaam "<naam>.UNV.' READ(KEYIN,8001 FILEN

800 FORMAT(A721 C

OPEN(UNIT=UNIN,FILE=FILEN,STATUS='OLD'I C

C Vullen van COORKN, BOUND, VERPL, CONN enz. met subroutine RECOCO. C lie voor de omschrijving van de variabelen in de routine RECOCO. C

CALL RECOCO( COORKN,UNIN, CONN, BOUND, NKNW, NELEMW,VERPL, *NBP, NBPS, NBPG, PLI

C

C Selecteren van de coord ina ten behorende tot de rand waar gapele-C menten worden geplaatst en plaats deze in COORGB

C

NGAP = 1 NSTEMKN = C

00 100 1=1, NBP

IF (PL(Il.EQ. GAPKNI THEN 00 75 J=l, MNCRD COORGB(NGAP,Jl= COORKN(BOUND(I,11,Jl 75 CONTINUE C KNOGAP(NGAPl= BOUND(I,11 NGAP= NGAP + 1

ELSEIF( PL(II .EQ. STEMKN) THEN KNOSTEM(NSTEMKNl= BOUND(I,11 NSTEMKN= NSTEMKN + 1

ENOIF 100 CONTINUE

C

C Terug zetten op het werkelijke aantal i.v.m. gebruik bij C definieren van een lijst.

NSTEMKN= NSTEMKN-l

C

C Bereken de waarden Xl, Yl, XZ en Y2 om de gravure te beschrijven.

C Xl= COORKN(KNOSTEM(l),l) Y1= R1 XZ= Xl + SQRT(3.)* R1 Y2= 0.0 C

CALL GAPBL(COORGB,NBPG. NO, TA, Xl. Y1, XZ, YZ, *COORGS. OISTAN)

C

C Testen of de parameters MAXKN en MAXELEM groot genoeg z1Jn i.v.m. C de toevoegingen met gapelementen en knopen op de stempelrand

C

IF (MAXKN.LT.(NKNW + 3 * NBPG)) CALL ERROR(Z) IF (MAXELEM.LT.(NELEMW + NBPG)) CALL ERROR(l)

C

C Aanvullen van de array's COORKN en CONN met de waarden die C afkomstig zijn van de gapelementen.

C

NGAP = 1

STARTKN

=

NKNW + 1 TOTKN = NKNW + 3* NBPG

C

DO ZOO I = STARTKN, lTOTKN-l), 3 DO 175 J

=

1, MNCRO

COORKN(I,J)= NO(J) COORKN(I+l,J)

=

TA(J)

COORKN«I+Z).J) = COORGS(NGAP,J) 175 CONTINUE

ICO = NELEMW + NGAP CONN(ICO,1)

=

TYPGAP CONN(ICO,2) = KNOGAP(NGAP) CONN(ICO.3)

=

I CONN(ICO,4) = 1+1 CONN(ICO,5) = 1+2 NGAP = NGAP + 1 ZOO CONTINUE C

WRITE(SYSOUT,*) . Geef filenaam voorgaande berekening * BLR(nr.) .OAT:'

REAO(KEYIN,800) FILEN

C

WRITE (SYSOUT, *) , Geef het restartnr.' REAO(KEYIN,*) RESTNR

C

OPEN(UNINZ,FILE=FILEN,STATUS='OLO' )

REZDAT.FOR S

-OPEN (UN IT =UNU IT, FILE= ' BLREST' ,STATUS ='NEW' )

C

C Copieer van unit UNIN2, de voorgaande invoer voor HARC C Wijzig het restart nr. en schrijf dit wag in unit UNUIT.

C

CALL COP(UNIN2, UNUIT, RESTNR)

C

C Uitschrijven van rezoneblok dus de nieuwe lijst met coordinaten, C connectivity en boundary conditions met het in orde maken van het C property blok. C C CARD='REZONE' WRITE(UNUIT,810) CARD 810 FORHAT(A72) C CARD='COORDINATE CHANGE' WRITE(UNUIT,810) CARD C WRITE(UNUIT,820) HNCRD, TOTKN 820 FORMAT(2IS) C DO 300 1=1, TOTKN WRITE(UNUIT,830) I, (COORKN(I,J), J=1,HNCRD) 830 FORHAT(IS,<MNCRO>F10.4) 300 CONTINUE C CARD='CONNECTIVITY CHANGE' WRITE(UNUIT,810) CARD WRITE(UNUIT,840) ICO 840 FORMAT(I5) C DO 400 1=1, ICO WRITE(UNUIT,8S0) I, (CONN(I,J), J=1,KNPT+1) 850 FORMAT(615) 400 CONTINUE C CARD= 'NEW' WRITE(UNUIT,810) CARO C NPROC = NBPG + 1 C C NO=O.OOOE+OO N1=0

CARD= 'PROPERTY CHANGE' WRITE(UNUIT,.810) CARO WRITE(UNUIT,840) NPROC

WRITE(UNUIT,860) EMOD, NU, NO,NO,NO,SIGMVL,NO,N1 860 FORHAT(7E10.3,IS)

WRITE(UNUIT,870) NELEMW 870 FORHAT('1 TO',I4)

C

C

DO 500 NGAP=1, NBPG

WRITElUNUIT,860) DISTANlNGAP),NO,NO,NO,NO,NO,NO,N1 ICO = NELEMW+NGAP

WRlTE(UNUIT,880) ICO, ICO

880 FORMATlI4,' TO', 14) 500 CONTINUE C CARD =' CONTINUE' WRITElUNUIT,810) CARD C

CARD= 'END REZONE' WRITElUNUIT,810) CARD

C

C Uitschrijven van een lijst met BOUNDARY CONDITIONS en lijst met C BOUNDARY CHANGE C C CARD='OLD' WRITE(UNUIT,810) CARD CARD='BOUNDARY CHANGE' WRITE(UNUIT,810) CARD NEWBL = 0 VERPLAL = 0,0 WRITE(UNUIT,890) NEWBL 890 FORMAT(15) C

C Totale aantal boundary change cards is NBP + NBPG

C

WRITElUNUIT,890) NBP+NBPG

C

NTEL = 0

00 600 1=1, NBP

IF llPL(I) .EQ. RANDKN) .OR. lPL(I) .EQ. STEMKN» THEN

WRITE(UNUIT,8911 lBOUNDlI,J), J=1,4),VERPLAL

891 FORMATl415,E15.6)

NTEL = NTEL + 1

IF lPL(I) .EQ. STEMKN) THEN BOUNDPL(I) = NTEL

ENDIF ENDIF 600 CONTINUE

C

C Toevoegen van een lijst met boundary conditions die behoren tot C de knopen van de gap verbonden met het stempel. Deze call moet C direct achter de loop met label 600 komen i.v.m. gebruikte C variabele NTEL.

C

CALL BOUNGAP(UNUIT, NBPG, NELEMW, CONN, NTEL, GAPPL,

*

MAXELEM,KNPT, MNCRD)

C

CARD= 'CONTINUE' WRITElUNUIT,810) CARD CARD = 'NEW'

REZDAT.FOR 7

-WRITEIUNUIT,810) CARD

C

C Zorg dat de knopen na de "nul' slag weer onder het stempel staan

C met een REZONE blok.

C CARD='REZONE' WRITEIUNUIT,810) CARD CARD='COORDINATE CHANGE' WRITEIUNUIT,810) CARD CARD='3,O' WRITEIUNUIT,810) CARD C

IF INSTEMKN .LE. 16) THEN CARD='UFRORD'

WRITEIUNUIT,810) CARD

WRITEIUNUIT,879) IKNOSTEMII), I=1,NSTEMKN)

ELSEIF IINSTEMKN .GT.16) .AND.INSTEMKN .LE. 32» THEN CARD ='UFRORD' WRITEIUNUIT,810) CARD WRITEIUNUIT,894) IKNOSTEMII) ,1=1,16) CARD ='UFRORD' WRITEIUNUIT,810) CARD NFORM= NSTEMKN-16 WRITEIUNUIT,878) IKNOSTEMII),I=17,NSTEMKNI ELSE CALL ERROR(12) ENDIF C CARD=' CONTINUE' WRITEIUNUIT,810) CARD CARD='END REZONE' WRITEIUNUIT,810) CARD C

C Schrijf het nieuwe blok met boundary change na de "nul" slag

C lincl. de waarden die horen bij de knopen van de gap elementen

C verbonden met hat stempel)

C

CARD='BOUNDARY CHANGE' WRITEIUNUIT,810) CARD

C

WRITEISYSOUT,*)' Geef de stempelverplaatsing na de "nul" * slag ,

READ IKEYIN,*) VERPLAL

C

WRITEIUNUIT,892) NBPS+NBPG 892 FORMATII5,',')

C

00 610 1=1, NBP

IF IPL(ll .EQ. STEMKN) THEN

WRITEIUNUIT,893) BOUNDPLII),IBOUNDII,J),J=2,3),VERPLAL

893 FORMATI3II4,',' ),F10.4,',' I

END IF 610 CONTINUE

C Uitschrijven van de waarden die behoren bij de gaps verbonden C met het stempel.

C

CALL BOGAPCUNUIT, NBPG, NELEHW, CONN, GAPPL,VERPLAL, * HAXELEH.KNPT, HNCRD)

C

CARD='CONTINUE'

WRITECUNUIT,810) CARD

C

C Doe NAUTO maal

C - Geef een lijst met knooppuntnr. 's welke behoren tot de plaats

C waar het stempel op ligt en plaats deze in het rezone blok.

C - Geef daarna een blok met AUTO LOAD.

C

WRITECSYSOUT,*) , Geef het aantal rezone blokken.' READCKEYIN , *) NAUTO C 00 620 JITEL=1, NAUTO CARD='REZONE' WRITECUNUIT,810) CARD CARD='COORDINATE CHANGE' WRITECUNUIT,810) CARD CARD='3,O' WRITECUNUIT,810) CARD C

IF CNSTEHKN .LE. 16) THEN CARD='UFRORD'

WRITECUNUIT,810) CARD

WR ITEC UNUITI879) (KNOSTEHC I). 1= 1, NSTEHKN)

879 FORHATC<NSTEHKN>CI3,' I ' ) )

ELSEIF CCNSTEHKN .GT.16) .AND.CNSTEHKN .LE. 32)) THEN CARD ='UFRORD' WRITECUNUIT,810) CARD WRITECUNUIT,894) CKNOSTEHCI) ,1=1,16) 894 FORHATC16CI3 , 'I ' ) ) CARD ='UFRORD' WRITE(UNUIT , 810) CARD NFORH= NSTEHKN-16

WRITECUNUIT,878) CKNOSTEHCI), I=17,NSTEHKN)

878 FORHAT«NFORH>CI3,',')) ELSE CALL ERROR C12) ENDIF C CARD= 'CONTINUE' WRITE(UNUIT.810) CARD CARD='END REZONE' WRITECUNUIT.810) CARD CARD='AUTO LOAD' WRITE(UNUIT,810) CARD CARD='1, ' WRITE(UNUIT.810) CARD CARD='PROPORTIONAL INCREHENT' WRITE(UNUIT,810) CARD

REZDAT.FOR 9 -CARD='O,1,' WRITE(UNUIT,610) CARD CARD=' CONTINUE' WRITE(UNUIT,610) CARD 620 CONTINUE END C C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

van het eerste punt tweede Afstand tussen de twee punten Locale variabelen:

X1, Y1 Coordinaten X2, Y2

LEN Doel:

Bepalen van de afstand tussen twee punten met cartesische coordinaten. C C C================================================================= C C SUBROUTINE AFSTAN C C C C C C C C C C C================================================================= C C

SUBROUTINE AFSTAN(X1, Y1, X2, Y2, LEN) REAL*6 X1,Y1, X2, Y2, LEN

C

LEN =DSQRT((X2-X1)*(X2-X1)+ (Y2-Y1)*(Y2-Y1)) RETURN

END

Max. aantal knooppunten in de mesh Doel:

Lezen van de coordinaten ,connectivity blok en de boundary conditions in de file <naam>.IN die met IDEAS is gecreeerd. Uit het blok met boundary conditions worden

de knopen van de rand waar het stempel op rust en van de plaats waar de gapelementen moeten aansluiten geselecteerd. Deze moeten resp. zijn aangegeven met verplaatsingen tussen de 5 en 6 mm en tussen de 10 en 11 mm. in dit blok.

Bepalen van het werkelijk aantal elementen en knooppunten in de mesh en op de diverse randen.

C C C C C C SUBROUTINE RECOCO C C=================================================================== C C C C C C C C C C C C C Parameters: C MAXKN

wordt de rand de plaats waar drukt de plaats waar geplaatst. r.v.w. geldt in x-richting

y-

z-Begin coordinaten van de knopen/sluit-richting en tangentiaal knopen/sluit-richting i.v.m. gapelementen

Connectivity van de elementen incl. de gapelementen.

Knooppuntnr en richting van de VERPL Opgelegde verplaatsing

RANDKN: Knoop behorende tot STEMKN: Knoop behorende tot het bovenstempel op Knoop behorende tot gapelementen worden GAPKN:

Werkelijk aantal elementen in de mesh zonder gapel. knooppunten .. ..

Aantal randpunten die met gap elementen worden verbonden.

Aantal randpunten onder het stempel Aantal randvoorwaarden.

1 of 0 afh. of een richting onderdrukt of niet.

Knooppuntsnr. waarvoor Opgelegde verplaatsing

Max. aantal coord ina ten per knoop Max. aantal elementen in de mesh Aantal knopen per element.

Max. aantal boundary conditions Knoop ligt op de rand (=1)

Knoop ligt op de rand waar het stempel op drukt. 1=2)

Knoop ligt op de rand waar gapelementen worden geplaatst 1=3)

Boven en ondergrens waarmee getoest wordt of een knoop tot de rand behoort waar het stempel op drukt.

Boven en ondergrens waarmee getoest wordt of een knoop tot de rand behoort waar gapelementen worden geplaatst. Type element lnr. 10) NBPS NBP BOVGA ONDGA BOVST ONDST MNCRO MAXELEM KNPT MAXB RANDKN STEMKN GAPKN CONNIMAXELEM,KNPT+1) NB XWAARO YWAARD ZWAARD TYPEL BOUNDIMAXB,4) VERPL( MAXB) PL(MAX8 ) Globale variabelen: NELEMW NKNW NBPG C C C C C C C C C C C C C C C C C C C C C C C C C C Locale variabelen: C X,Y,Z C C C C C C C Array's C COORKNlMAXKN,MNCRD) C C C C C C C C C C C C C======================================================================= C C

SUBROUTINE RECOCOI COORKN,IN, CONN, BOUND, NKNW, NELEMW,VERPL, *NBP, NBPS. NBPG, PL)

C

REZDAT.FOR 11

-PARAMETER (KEYIN=5, SYSOUT=6)

C

INTEGER*4 MAXKN, MNCRD, MAXELEM, KNPT,MAXB

PARAMETER( MAXKN= 650, MNCRO=2, KNPT=4, MAXB=200, MAXELEM=600)

C

REAL*8 BOVST, ONOST, BOVGA, ONOGA

PARAMETER IBOVST=6.0. ONDST=5.0. BOVGA=11. ONDGA=10)

C

INTEGER*4 RANOKN, STEMKN. GAPKN. TYPEL

PARAMETER IRANDKN=1, STEMKN=2. GAPKN=3, TYPEL=10)

C

REAL*8 COORKNIMAXKN,MNCRO),VERPLIMAXB), XWAARD, YWAARD, * ZWAARD

C

INTEGER*4 NKNW, NELEMW. NBPG. NBPS, PLIMAXB),NBP. *CONN(MAXELEM,KNPT+1), BOUND(MAXB,4)

C

INTEGER*4 X. Y. Z. NB

C

CHARACTER*72 CARD. CARON. CARDN1 LOGICAL CFOUND

C

C Zoek blok met COORDINATES I data blok nr. =15)

. C

CFOUND = .FALSE. CARON = 'BEGIN'

C

DO WHILE ( CFOUND . EQ. . FALSE. )

REAOIIN,900,ENO=1200) CARDN1

900 FORMATIA72)

IF (CARDN1(1:6) .EQ.' -1') THEN

CARON = CARDN1 REAOIIN.900) CARON1

IF (I CARON 11 : 6) . EQ,' -1 ') . AND.

* ICARDN111:6) .EQ. 15')) THEN

CFOUND = .TRUE. ELSE

CARON = CARDN1

READIIN.900,ENO=1200) CARDN1

IF (ICARDNI1:6).EQ. -1') .AND.

* ICARDN111:6) .EQ.' 15')) THEN

CFOUND = .TRUE. ENDIF ENDIF ENOIF END DO C

C Lees de coordinaten en bepaal het aantal knopen NKNW.

C Test hiermee de parameters MAXKN

C

CFOUND = .FALSE. NKNW = 0

DO WHILE (CFOUND . EQ. . FALSE. ) READIIN,900) CARO

IF lCARDl1:6) .EQ.' -1') THEN CFOUND = .TRUE. GO TO 666 ENDIF NKNW = NKNW + 1 READlCARD,910) NCOORO,NDM1,NDM2,NDM3,

*

lCOORKNlNCOORD,J),J=1,MNCRD) 910 FORMATl4I10,2E13.5) 666 ENO 00 C

IF lMAXKN .LT. NKNW) CALL ERROR(2)

C

C Zoek het connectivity blok ldata blok nr. 71)

C Indien gevonden dan lees werkelijk aantal elementen NELEMW.

C Test de parameter MAXELEM

C

CFOUNO = .FALSE. CARON = 'BEGIN'

C

00 WHILE l CFOUND . EQ. . FALSE. )

READlIN,900,ENO=1200) CARDN1

IF lCARDN1l1:6) .EQ.' -1') THEN

CARON = CARON1 REAOlIN,900) CARON1

IF llCARDNl1:6).EQ. -1') .AND.

*

lCARON1l1:6) .EQ.' 71')) THEN

CFOUND = .TRUE. ELSE

CARON = CARDN1

REAOlIN,900,END=1200) CARON1

IF llCARDNl1:6).EQ.' -1') .AND.

*

lCARON1l1:6) .EQ. 71')) THEN

CFOUND = .TRUE. ENOIF ENDIF ENOIF END DO C CFOUND = .FALSE. NELEMW = 0 C

00 WHILE l CFOUNO . EQ. . FALSE. ) READlIN,900) CARO

IF lCARDl1:6) .EQ.' -1') THEN

CFOUND = .TRUE. GOTO 777 ENOIF NELEMW = NELEMW + 1 READlIN,900) CARD READlCARO,911) lCONNlNELEMW,J), J=2,KNPT+1) 911 FORMATl4I10) CONNlNELEMW,1) = TYPEL 777 END 00 C

REZDAT.FOR 13

-C

IF (MAXELEM .LT. NELEMW) CALL ERROR(1)

C

C Zoek het boundary blok (nr. = 89)

C

CFOUND = .FALSE. CARON = 'BEGIN'

C

00 WHILE ( CFOUND . EQ. . FALSE. )

READ(IN.900,END=1200) CARDN1

IF (CARON 1( 1: 6) . EQ.' -1 ') THEN

CARON = CARDN1 READ(IN,900) CARDN1

IF « CARON ( 1: 6) . EQ. -1 ') . AND.

*

ICARDN1f1:6) .EQ.' 89'» THEN

CFOUND = .TRUE. ELSE

CARON = CARDN1

READ(IN,900.END=1200) CARDN1

IF « CARON ( 1: 6 ) . EQ.' -1 ') . AND.

*

(CARDN1f1:6) .EQ.' 89'» THEN

CFOUND = .TRUE. ENDIF ENDIF ENDIF END 00 C

C Twee regels skippen.

C READ(IN.900) CARD READ(IN,900) CARD C CFOUND = .FALSE. NBP = 0 C

00 WHILE (CFOUND . EQ. . FALSE. ) READ(IN.900) CARD

IF (CARDI1:6) .EQ. -1') THEN

CFOUND = .TRUE. GOTO 888

ENDIF

READICARD.912) NB.NDM1.X. Y. Z

912 FORMAT(2I10,3I2)

READ(IN,913) XWAARD. YWAARD

913 FORMAT(2E13.6)

C

C Afh. van welke coordinaat onderdrukt wordt deze r.v.w. in de

C array's BOUND met VERPL plaatsen.

C IF (X .EQ. 1) THEN NBP = NBP + 1 BOUND(NBP.1) = NB BOUNDINBP,2) = NB BOUND(NBP.3) = 1

BOUNO(NBP,4) : 1 VERPL(NBP) = XWAARO ENOIF IF (Y .EQ.1) THEN NBP : NBP + 1 BOUNO(NBP,1) = NB BOUNO(NBP,2) : NB BOUNO(NBP,3) : 2 BOUNO(NBP,4) : 2 VERPL(NBP) : YWAARO ENOIF 888 ENO DO C

C Test parameter MAXB

C

IF (MAXB .LT. NBP) CALL ERROR(11)

C

C Doe voor aIle boundary conditions

C - Test of de verplaatsing een verplaatsing is behorende tot C de stempel rand of gap gedeelte, zo ja

C

C * onthoudt de plaats door in PL(BOUND(I,1)) de waarde RANDKN, C STEMKN of GAPKN te plaatsen.

C * onthoudt het aantal (NBPG, NBPS)

C NBPS = 0 NBPG :

a

DO 170 1=1, MAXB PL ( I) : 0 170 CONTINUE C DO 200 I=1,NBP

IF (( VERPL(I) .GT. ONDST) . AND. (VERPL( I) . LT. BOVST) THEN PL(I): STEMKN

NBPS = NBPS + 1

ELSEI F (( VERPL (I) . GT. ONDGA) . AND. (VERPL( I). LT . BOVGA)) THEN PL( I ): GAPKN NBPG = NBPG + ELSE PL(I)= RANDKN ENDIF 200 CONTINUE C

C Indien er geen stempelknopen of gapknopen gevonden zijn schrijf dit C naar het scherm.

C

IF (NBPS .EQ. 0) THEN

WRITE(SYSOUT,*) 'Er zijn geen stempelknopen gevonden' ENDIF

IF (NBPS .EQ. 0) THEN

WRITE(SYSOUT,*) 'Er zijn geen gapknopen gevonden' ENDIF

GO TO 10000 1000 CALL ERROR(8)

REZOAT.FOR 15 -1100 CALL ERROR(91 1200 CALL ERROR(101 10000 RETURN END C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Ooel:

Het vullen van de array's COORGS en OISTAN

Coord ina ten van de knopen van de blanc die met een gapelement worden verbonden. Coordinaten van de knopen v/d gapelementen verbonden met het stempel.

Normaal richting Tangentiaal richting

Afstand waarover de elementen sluiten. Max. aantal coordinaat richtingen

Max. aantal gapelementen

van het eerste punt op stempelrand tweede

Hoogste elementnr. in de mesh Hoogste knooppuntnr • •

Aantal randpunten dat verbonden wordt met een gapelement. COORGS(MNGAP,MNCROI NO(MNCRO) TA(MNCROI OISTAN(MNGAPI Locale varabelen: X1, Y1 Coordinaten X2, Y2 HELEM HKNK NBPG Parameter: MNCRO MNGAP C C C C SUBROUTINE GAPBL C C ================================================================= C C C C C C C C C C C C C C C C C Array's: C COORGB(NBPG,MNCROI C C C C C C C C==================================================================== C C

SUBROUTINE GAPBL(COORGB,NBPG, NO, TA, X1, Y1, X2, Y2, *COORGS, OISTANI

C

INTEGER*4 MNGAP, MNCRO,KNPT

PARAMETER( MNGAP= 30, MNCRO=2,KNPT=41 C

REAL*8 COORGB(MNGAP,MNCROI,X1, Y1, X2, Y2, NOIMNCROI, TA(MNCROI, * COORGS(MNGAP,MNCROI, OISTAN(MNGAPI

C

INTEGER*4 HELEM, HKNK, NBPG

REAL*8 WOR, XO, YO, A1, B1, A2, B2

C

C Als parameter MNGAP of MNCRO wordt overschreden dan call error en C programma afbreken.

Deze subroutine schrijft in een file genaamd 'ERRO' welke fout er in de loop van het programma is ontstaan.

C

IF (MNGAP .LT. NBPG ) CALL ERROR(6) IF (MNCRD .GT. 2 ) CALL ERROR(1)

C

C- Bepaal a.d.v. de twee gegeven punten Xl, Yl. X2, Y2 de vergelijking C van de lijn die de vorm v/d conische gravure bepaalt.

C (Al.Bl)

C

Al = (Yl-Y2)/(Xl-X2) Bl = Yl - Al*Xl

C

C - Bepaal normaal en tangentiaal richting NO, TA

C WOR= DSQRT«Yl-Y2)*(Yl-Y2)+(Xl-X2)*(Xl-X2» NO(l) = (Yl-Y2)/WOR NO(2) = (X2-Xl)/WOR TA( 1) = NO ( 2 ) TA(2) = -1.*NO(l) C

C Doe voor alle knooppunten van de rand:

C - Bepaal vergelijking van de lijn loodrecht op de conische rand

C (A2. B2)

C - Bepaal snijpunt van de twee lijnen (XO, YO)

C - Bepaal afstand tussen de knopen op de rand en dit snijpunt C - Vul DISTAN(I). COORGS(I,MNCRD)

C DO 100 1=1, NBPG A2 = -1.0/Al B2 = COORGB(I,2) - A2 * COORGB(I,l) XO = (B2-Bl)/ (Al-A2) YO = Al*XO + Bl CALL AFSTAN(COORGB(I,1),COORGB(I.2),XO,YO.DISTAN(I» COORGS (1.1) = XO COORGS(I.2) = YO 100 CONTINUE C RETURN END C C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C C C C C C================================================================== C C C SUBROUTINE ERROR C C C C

max. aantal foutnummers

foutnummer geeft aan naar welk label in het GOTO statement wordt gesprongen.

REZDAT.FOR 17 -C================================================================== C C Parameters: C MAXERN C C Locale variabelen: C NR C C C================================================================= C C SUBROUTINE ERRORlNR) INTEGER*4 NR MAX ERN

C PARAMETER lMAXERN=12) C INTEGER*4 !TEL DATA ITEL/OI ITEL=ITEL+1 C

C Eenmalig openen van de file

C

IF (!TEL .EQ. 1 ) THEN

OPEN lUNIT=66,FILE='ERROREZ' ,STATUS='NEW') END IF

C

C Testen of NR in de range ligt.

C

IF llNR .LT. 1) .OR. lNR .GT. MAXERN)) THEN

WRITE 166,*) , Het opgeven foutnr. in de CALL komt nlet voor * in de reeks.'

GOTO 400 ELSE

GOTO 110,20,30,40,50,60,70,80,90,100,110,120) NR

10 WRITEI66,*)' Parameter MAXELEM te klein: REZBL, subroutines l' GOTO 400

20 WRITEI66,*)' Parameter MAXKN te klein: REZBL, subroutines ?'

GOTO 400

30 WRITE(66,*)' Parameter MAXNDEG te klein: REZBL, subroutines ?'

GOTO 400

40 WR!TEI66,*)' Programma aanpassen is nl alleen geschikt' WRITE(66,*) , voor twee dimensionale problemen.'

GOTO 400

50 WRITEI66,*)' Vervorming dusdanig dat de verhouding' WRITE(66,*) , tussen de lijnstukken groter is dan 5.' GOTO 400

60 WRITEI66,*)' Parameter MNGAP wordt overschreden in' WRITEI66,*) , subroutine GAPBLj Aanpassen!!'

GOTO 400

70 WRITE(66,*) Parameter MNCRD wordt overschreden in' WRITE(66,*) , subroutine GAPBL of RECOCO Aanpassen!!' GOTO 400

WRITE(66,*) GOTO 400 90 WRITE(66.*) WRITE(66.*) GOTO 400 100 WRITE(66.*) WRITE(66.*) GOTO 400 110 WRITE(66.*) WRITE(66,*) GOTO 400 120 WRITE(66,*) WRITE(66,*) WRITE(66,*) GOTO 400 ENDIF 400 CALL EXIT C 500 RETURN END , RECOCO'

, Blok met connectivity niet gevonden met' , subroutine RECOCO'

, Blok met restrains niet gevonden met subroutine' , RECOCO'

, Parameter MAXB te klein. aanpassen in subroutine' , RECOCO'

Aantal knopen onder het stempel groter dan 32' , pas program REZBL.FOR aan voor definieren van'

meerdere NODE SETS.'

Variabelen

Zie voor de betekenis het hoofdprogramma Doel:

Copieren van de voorgaande invoerfile voor Marc. Wijzigen van het restartnr.

C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C C SUBROUTINE COP C C C C C C C C C C======================================================================== C C

SUBROUTINE COP(UNIN2. UNUIT, RESTNR)

C

INTEGER*4 UNIN2, UNUIT, RESTNR

C

CHARACTER*72 CARD

C

LOGICAL CFOUND

C

C Lees en copieer tot en met RESTART

C

CFOUND = .FALSE.

DO WHILE (CFOUND .EQ . . FALSE.) READ(UNIN2.800) CARD

800 FORMAT(A72)

WRITE(UNUIT.800) CARD

CFOUND= (CARD(1:6) .EQ. 'RESTAR') END DO

Doel:

Uitschrijven van de boudary conditions die horen bij de gebruikte gap elementen in het BOUNDARY CHANGE blok.

Locale variabelen: Zie het hoofdprogramma

NDIM1 Eerste coordinaatrichting

NDIM2 Tweede coordinaatrichting

VERPLAL Grootte van de randvoorwaarde.

REZDAT.FOR 19

-C Plaats regel met juiste restartnr.

C

READCUNIN2,800) CARD WRITECUNUIT,810) RESTNR 810 FORMATC'3,1,' ,15,',')

C

C Lees en copieer tot en met END OPTION.

C

CFOUND = .FALSE.

C

DO WHILE C CFOUND . EQ. . FALSE. ) READCUNIN2,800) CARD

WRITECUNUIT,800) CARD

CFOUND= CCARDC1:6) .EQ. 'END OP') END DO C RETURN END C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C C C Subroutine BOUNGAP C C C C C C C C C C C C C===================================================================== C

SUBROUTINE BOUNGAPCUNUIT, NBPG, NELEMW, CONN, NTEL, GAPPL, * MAXELEM,KNPT, MNCRD)

INTEGER*4 UNUIT

INTEGER*4 NBPG, NELEMW, CONNCMAXELEM,KNPT+1), * GAPPLCMAXELEM,MNCRO), NTEl

C

INTEGER*4 NOIM1, NDIM2

C REAL*8 VERPLAl NDIM1 = 1 NDIM2 = 2 VERPLAL = 0.0 C DO 100 NGAP=NELEMW+1, NELEMW+NBPG

WRITECUNUIT,891) CONNCNGAP,5), CONNCNGAP,5), NOIM1, NDIM1,

* VERPLAL

891 FORMAT(415,E15.6)

Subroutine BOGAP Doel:

Uitschrijven van de waarden behorende bij de gapelementen ver-bonden met het stempel, in het blok BOUNDARY CHANGE

GAPPLINGAP, NDIM1)= NTEL

WRITEIUNUIT,891) CONNINGAP,5), CONNINGAP,5), NDIM2, NDIM2,

* VERPLAL

NTEL = NTEL+ 1

GAPPLINGAP, NDIM2)= NTEL 100 CONTINUE C C C RETURN END C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C C C C C C C C C C C==================================================================== C C C

SUBROUTINE BOGAPIUNUIT, NBPG, NELEMW, CONN, GAPPL,VERPLAL, * MAXELEM,KNPT.MNCRD)

INTEGER*4 UNUIT

INTEGER*4 NBPG, NELEMW. CONNIMAXELEM,KNPT+l), * GAPPLIMAXELEM,MNCRD) C REAL*8 VERPLAL C C INTEGER*4 NDIMl NDIM1= 1 C 00 100 NGAP=NELEMW+1, NELEMW+NBPG

WRITEIUNUIT,893) GAPPLINGAP,NDIM1), CONNINGAP,5),

* NDIM1, VERPLAL 893 FORMATI3114,',' ),Fl0.4,·,·) 100 CONTI NUE C C RETURN END

T19.FOR 1

-kanaal INT19 Versie: 2.5

Doel:

Creeren van <naam>T19 REZ<nr.> files uit de <naam>.T19 file die door MARC K2 versie gegenereerd wordt. Hierbij wordt een file LOG_INCOV. gemaakt waarin wordt vermeld welk incrementnr. je in welke <naam>_REZ<nr.> terug kunt vinden. Bij het over-nemen van de waarden worden de gapelementen met de bijbehorende grootheden geelimineerd. Daarnaast heeft dit programma een optie waarin de mogelijkheid wordt geboden data te selecteren uit de

.T19 file. Deze data wordt gebruikt voor het bepalen van de totale stempelkracht en de diameter tot waar de gravure gevuld is. Deze waarden worden gebruikt voor het berekenen van de verhouding tussen de gemiddelde stempeldruk en de vloeispanning van lood (15 N/mm*mml na elk increment met daarnaast de

logarithme van de verhouding tussen de diameter aan de voet van de gravure en de diameter tot waar de gravure gevuld is. Deze verhoudingen worden weggeschreven in een file genaamd SPLNDD.DAT. C C C Programma T19 C C C C C C C C C C C C C C C C C C C C C Invoer: C <naam>.t19 C Uitvoer:

C <naam>T19.REZ<nr.> kanaal UIT=<nr.> nr. afhankelijk van het

C aantal keren REZONING

C SPLNDD.DAT kanaal OUT Afh. of er gekozen wordt

C voor het selecteren van

C data voor het tekenen

C van een grafiek.

C===================================================================== C C PROGRAM T19 gapelementen toegestaan in de array grootte

vrijheidsgraden per knoop elementen dat in de mesh mag integratie punten per element komponenten (rek/spanningsl knooppunt dat in de mesh mag Terminal input kanaal

Terminal output kanaal .T19 file input kanaal SPLNDD output kanaal Max. aantal Max. aantal Max. aantal voorkomen Max. aantal voorkomen Max. aantal mesh i.v.m. Max. aantal MAXGAP MAXELEM MAXNSTR MAXAANT MAXKN MAXNDEG Parameters: KEYIN SYSOUT INT19 OUT C C===================================================================== C C C C C C C C C C C C C C C C

SP(MAXELEM*MAXNSTR,MAXAANT)

c

c

c

c

c

c

c

c

c

c

c

c

c

C

c

C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C MAXINC ELTYP GROOTHE KNPT CON2 VLLOOD Variabelen:

un

NREZ AANTC NKN NELEM NELEMW NGAP NKNW INCR INC NOEG NSTRES GRAFSEL Array RESKRA(MAXKN,MAXNDEG) COORKN(MAXKN,MAXNDEG) DISP(MAXKN,MAXNDEG) TDISP(MAXKN,MAXNDEG) CONNEC(MAXELEM,CON2) BUCARD(GROOTHE) COMCARD(MAXAANT) KNAR(MAXKN) KNPR(MAXGAP) KNNKR(MAXGAP) DIA(MAXINC) TOTKR(MAXINC) INCRE(MAXINC)

Max. aantal incrementen dat kan worden ver-verwerkt

Type element

Aantal regels in de heading v/d POST-file. Aantal knopen per element.

Tweede dimensi van het array CONNEC. Vloeispanning van lood. (15 N/mm*mml

Nr. van het uitvoer kanaal

Aantal keren dat gerezoned wordt Aantal componenten (rek/spanningen)

Aantal knooppunten in de mesh gegeven door invoer van MARK

Aantal elementen in de mesh gegeven door invoer van MARK

Aantal elementen (type ELTYP) werkelijk in de mesh

Aantal gapelementen (type GAPTYP) werkelijk in de mesh

Aantal knopen werkelijk in de mesh Incrementnr. in <prob.>.T19 file Incrementnr. in T19_REZ<nr.> file Aantal vrijheidsgraden per knoop Aantal integratiepunten per element Geeft aan of er waarden geselecteerd moeten worden.

Krachten in de knooppunten Coord ina ten van de knooppunten in de uitgangstoestand

Verplaatsingen van de knooppunten direct na rezonen

Totale verplaatsing van de knoop-punten uitgaande van COORKN

Rekken/spanningen in elk inte-gratie punt

Connectivity blok Buffer voor de heading

Opslag rek/spannings componenten Array dat gevuld wordt met 0 of 1 afh. of knoopnr. tot de mesh behoort. knooppuntnr.'s die op de rand liggen waar gapelementen aansluiten.

knooppuntnr. 's waar de normaalkracht in staat van het gapelement verbonden met de knoop in KNPR

Straal tot waar de gravure gevuld is in het betreffende increment.

Totale stempelkracht in het betreffede increment.

T19.FOR 3

-C staat

C====================================================================

C C

INTEGER*4 KEYIN, SYSOUT, INT19,MAXKN, MAXELEM,MAXNDEG,MAXAANT,

* MAXNSTR,GROOTHE,KNPT, ELTYP, CON2, OUT,MAXINC,

* MAXGAP

PARAMETER(KEYIN = 5, SYSOUT = 6, OUT=99, MAXINC =2501 PARAMETER(INT19 = 7, MAXKN=650, MAXELEM=600, MAXNOEG=2.

* MAXAANT=24. MAXNSTR=4, GROOTHE=5, KNPT :4,ELTYP=10,

* CON2=6, MAXGAP=1501 C REAL*8 VLLOOD PARAMETER(VLLOOD=151 C CHARACTER*72 FILEN,NAFI

CHARACTER*80 CARD, HUCARD,KOCARO,BUCARD(GROOTHEI, * COMCARD(MAXAANTI

C

INTEGER*4 AANTC, NKN, NELEM, NOEG, NSTRES

INTEGER*4 UIT, NREZ, NKNW, NELEMW, CONNEC(MAXELEM,CON21, * KNAR(MAXKNI,INCRE(MAXINCI

C

INTEGER*4 KNPR(MAXGAPI, KNNKR(MAXGAPI, NGAP

C

REAL*8 COORKN(MAXKN,MAXNOEGI, DISP(MAXKN,MAXNOEGI,

* TOISP(MAXKN,MAXNOEGI, RESKRA(MAXKN.MAXNOEGI, * SP(MAXELEM*MAXNSTR,MAXAANTI, HSP(MAXAANTI, * TOTKR(MAXINCI, DIA(MAXINCI C REAL*8 RD1.R02 INTEGER*4 NO, 01. 02, 03, 04, 05, N01, * NBL,NAT, I, NVR C

COMMON INAMEI FILEN

C

WRITE(SYSOUT,*I ' Geef de <naam>.T19 file:'

READ(KEYIN,8001 FILEN

OPEN(UNIT=INT19,FILE=FILEN,STATUS='OLO'1

C

c****

C Vraag of er waarden voor de grafiek geselecteerd moeten worden.

C

CALL VRAGRA(GRAFSELI

C Zo ja selecteer de kracten op het onderstempel en bepaal de totaal-C kracht met daarbij de diameter tot waar de gravure is gevuld in het C betreffende increment. C C NREZ=O INC=O UIT=20 C C Openen <naam>T19_REZ<nr.>

C Inlezen kop en het bepalen van AANTC ,NKN, NELEM, NoEG, NSTRES

C

5 CALL CRFILNlNAFI, NREZ)

OPENlUNIT=UIT,FILE=NAFI,STATUS='NEW' )

C

IFlNREZ.EQ. 0) THEN REAolINT19,820) KOCARo REAolINT19,820) BUCARD(1) CALL NAAMlKOCARo, NREZ) WRITElUIT,820)KOCARo HUCARo=BUCARD(1) ELSE CALL NAAMlKOCARD,NREZ) WRITElUIT,820)KOCARo ENoIF C

C Overnemen van de varia belen en testen of deze niet te groot zijn

C

REAolBUCARD(1),825) AANTC, NKN, NELEM, NDEG, NSTRES IF lAANTC.GT.MAXAANT) CALL ERROR(1)

IF lNKN.GT.MAXKN) CALL ERROR(2) IF lNELEM.GT.MAXELEM) CALL ERROR(3) IF lNoEG.GT. MAXNoEG) CALL ERROR(4) IF lNSTRES.GT.MAXNSTR) CALL ERROR(8)

C

C In orde maken van de eerste card na de kopcard afh. van het aantal C knopen en elementen in de mesh zonder de gapelementen daarbij in C rekening te brengen. C 8 BUCARo(1)l78:78)='4' DO 50 1=2, GROOTHE REAolINT19,820) BUCARolI) 50 CONTINUE BUCARo(3)l26:26)='l' BUCARo(3)l39:39)='O' C C - Rek/spanningscomponenten inlezen. C DO 80 1=1, AANTC REAolINT19,820) COMCARolI) 80 CONTINUE C C - Connectivity lezen

C - Bepalen van werkelijk aantal elementen in de mesh zonder C de gapelementen.

C - Elementen van KNAR op nul zetten.

C DO 90 I = 1, MAXKN KNAR l I) = 0 90 CONTINUE C NELEMW = 0 DO 100 I=l,NELEM REAolINT19,822) lCONNEClI,J) ,J=l,KNPT+2)

T19. FOR 5

-822 FORMATI6I13)

IF ICONNECII,1) .EQ. ELTYP) THEN NELEMW = NELEMW + 1 DO 110 NL=1, KNPT KNAR(CONNEC(I,2+NL» = 110 CONTINUE END IF 100 CONTINUE C C

****

C Indien waarden voor grafiek geselecteerd moeten worden (GRAFSEL.EQ .. TRUE) C dan bepaal uit CONNEC:

C - De knopen waarin de normaalkracht staat in het betrefde gapelement C - De knopen waaraan het betrefde gapelement vast zit voor het kunnen C bepalen van de diameter tot waar de gravure gevuld is.

C

IF (GRAFSEL . EQ. . TRUE.) THEN

CALL KNOSEL(CONNEC,KNPR, KNNKR,NELEM, NGAP) ENOIF

C

C Bepalen van het werkelijk aantal knopen NKNW in de mesh .. C a.d.v. het array KNAR.

C

NKNW = 0

00 120 1=1, NKN

IF (KNAR ( I) . EQ. 1) THEN NKNW = NKNW + 1

ENDIF 120 CONTINUE

C

C Uitschrijven van de heading, rek/spanningscomponenten. C connectivity van de knopen werkelijk in de in mesh.

C

INOO = 4

WRITE(UIT.822) AANTC, NKNW, NELEMW,NOEG. NSTRES.INOO 00 130 J=2.3 WRITE(UIT.820) BUCARO(J) 130 CONTINUE C 00 140 1=1, AANTC WRITE(UIT.820) COMCARO(I) 140 CONTINUE C 00 145 1=1, NELEMW

WRITE(UIT,822) (CONNEC(I,J), J=1,CON2) 145 CONTINUE

C

C Indien nog niet gerezoned is dan inlezen en uitschrijven van C het werkelijk aantal coord ina ten in de mesh zonder de knopen C van de gapelementen.

C

IF (NREZ.EQ. 0) THEN 00 150 I=1,NKN

150 CONTINUE

C

DO 160 I=l,NKNW

WRITEIUIT.8351 ICOORKNII.JI. J=l.NOEGI 160 CONTI NUE

C

C Skip AANTAL regels tot dat '****' is gevonden

C

CFOUNO=.FALSE. AANTAL=O

DO 200 WHILE ICFOUNO.EQ .. FALSE.1 REAOIINT19,8201 CARD

IF ICARD.EQ. '****' I CFOUNO=.TRUE. AANTAL=AANTAL+1

200 CONTINUE

C

C Start met inlezen v/h 0 de en volgende incrementen tot C er gerezoned,of tot end of file bereikt wordt,met eerst: C - bepalen INCR

C - wegschrijven in LOG_INCOV welk INCR hoort bij welk INC C in file T19REZ<nr.>

C

10 READIINT19.8251 NO,INCR, 01, 02, 03. 04

C

C Skip twee regels of indien de tweede CARD overeen komt met C HUCARD, dan is er gerezoned, waarna variabelen worden aange-C past en de procedure opnieuw wordt doorlopen.

C REAOIINT19.8201 CARD READIINT19.8201 CARD IF ICARD.EQ.HUCARDI THEN BUCARO 11 I = CARD NREZ=NREZ+1 INC=O UIT=UIT+ 1 GOTO 5 ENDIF C

CALL INCOVINREZ, INCR,INCI

WRITEIUIT,8301 ND.INC, 01. 02. 03. 04

C

C Rek/spanningsblok inlezen en wegschrijven, daarbij rekening houdend C met het werkelijk aantal knopen en elementen.

C

C

DO 250 NBL=l. NELEM* NSTRES

CALL REAOSP(IiSP, INT19, AANTCI DO 165 NAT=l,AANTC SP(NBL,NATI= HSP(NATI 165 CONTINUE 250 CONTINUE C DO 255 NBL=l, NELEMW* NSTRES DO 191 NAT=l, AANTC

T19.FOR 7

-HSPINATI=SPINBL, NATI 191 CONTINUE

CALL WRITESPIHSP. UIT, AANTCI 255 CONTINUE

C

C Yerplaatsingenl krachten inlezen en wegschrijven .... Rekening houdend C met werkelijk aantal elementen en knopen.

C C DO 300 I=l,NI<N READIINT19.840) (TDISPII,JI,J=l,NDEG),XD,YD, * IRESI<RAII,I<I,I<=l,NDEGI 300 CONTINUE C DO 302 1=1, NI<NW

WRlTEIUIT,8451 (TDISPII,JI ,J=l,NDEG), * IRESI<RAII,I<) ,K=1 ,NDEG) 302 CONTINUE

C

C****

C Indien waarden geselecteerd moeten worden IGRAFSEL .EQ . . TRUE.) C bepaal m.b.v. TDISP, COORI<N en RESI<RA:

C - De uiteindelijke coord ina ten van de knoop tot waar de C gapelementen gesloten zijn en bereken hiermee de diam. tot C waar de gravure dan in het betreffende increment is gevuld. C - De totale stempelkracht in het betreffende increment.

C

IF IGRAFSEL .EQ . . TRUE.) THEN

CALL DIAMTOTITDISP, COORI<N,RESI<RA,INCR, DIA. * TOTI<R ,I<NPR, I<NNI<R, NGAP,NI<NW.INCREI

ENDIF

C

READIINT19,820,END=1100) CARD

IFICARDll:41.NE.'****'1 CALL ERRORl51

C

INC= INC+1 GOTO 10 ELSE

C

C Inlezen en opslaan v/d coordinaten, rek/spanningsblok en

C verplaatsingen/krachten i.v.m. rezoning. Bepalen v/d coordinaten C direkt na rezoning. Yerplaatsingen aanpassen.

C

DO 175 I=l.NKN

READIINT19,8351 ICOORI<NII,J) ,J=l,NDEGI 175 CONTINUE

C

C Skip AANTAL regels

C

DO 180 I=l,AANTAL

READIINT19,8201 CARD 180 CONTI NUE

C

C

DO 185 NBL=1, NELEM*NSTRES

CALL READSP(HSP. INT19, AANTC) DO 182 NAT=1,AANTC

SP(NBL,NAT)= HSP(NAT) 182 CONTINUE

185 CONTINUE

C

C Verplaatsingen/krachten in array's TDISP,DISP en RESKRA C opslaan. Bepalen van de coordinaten direct na rezoning C en uitschrijven van deze .... Rekening houdend met werkelijk C aantal knopen en elementen.

C C DO 1B7 I=1.NKN READ(INT19.840)(DISP(I,J),J=1,NDEG),RD1, RD2, * (RESKRA(I,K) ,K=1.NDEG) DO 186 NVR=1.NDEG

COORKN(I.NVR)= COORKN(I,NVR)+ DISP(I,NVR) TDISP(I,NVR)= DISP(I,NVR)

186 CONTINUE 187 CONTINUE

C

DO 188 1=1, NKNW

WR I TE (U IT, 835) (COOR KN ( I , NP ) , NP =1 •NDEG) 188 CONTINUE

C C

C Schrijf incrementnr en rek/spanningsblok ... Rekening houdend met C werkelijk aantal elementen en knopen.

C C

ND1=0

CALL INCOV(NREZ, INCR, INC)

WRITE(UIT,825) ND1,INC, ND1,ND1, ND1, ND1 C DO 195 NBL=1, NELEMW * NSTRES DO 190 NAT=1, AANTC HSP(NAT)=SP(NBL, NAT) 190 CONTINUE

CALL WRITESP(HSP, UIT, AANTC) 195 CONTINUE

C

C Uitschrijven v/d verplaatsingen t.o.v. de coordinaten na rezoning .... C Rekening houden met werkelijk aantal knopen en elementen.

C

C

DO 197 I=1,NKN

DO 196 NVR=1, NDEG

TDISP(I,NVR)= TDISP(I,NVR) -DISP(I,NVR) 196 CONTINUE

197 CONTINUE

C

T19.FOR 9

-WR ITE I UIT ,845) I TO I SPI I , J ) , J =1 , NOEG) , I RES KRA I I , K) , K=1 , NOEG) 198 CONTI NUE

C

C****

C Indien waarden geselecteerd moeten worden IGRAFSEL .EQ . . TRUE.) C bepaal m.b.v. TOISP, COORKN en RESKRA:

C - De uiteindelijke coordinaten van de knoop tot waar de C gapelementen gesloten zijn en bereken hiermee de diam. tot C waar de gravure dan in het betreffende increment is gevuld. C - De totale stempelkracht in het betreffende increment.

C

I F IGRAFSEL . EQ. . TRUE.) THEN

CALL OIAMTOTITOISP, COORKN,RESKRA,INCR, OIA, * TOTKR ,KNPR, KNNKR, NGAP, NKNW,INCRE)

ENOIF

C

INC=INC+1

C

C Inlezen van volgende incrementen tot aan volgende rezone blok C of tot end of file is bereikt

C

205 REAOIINT19,820,ENO=1100) CARD

IF ICAROI1:4),NE.'****') CALL ERROR(5) REAOIINT19,825)N01, INCR, 02, 03, 04, 05

c

C Skip 2 regels of start met het volgende rezone increment C READ(INT19,820) CARD REAOIINT19,820) CARD IFICARD.EQ.HUCARO) THEN INC=O NREZ=NREZ+1 UIT=UIT+1 GOTO 5 ENOIF

CALL INCOV I NREZ, INCR, INC)

C

C Rek/spanningsblok in array SP plaatsen

C

DO 400 NBL=l, NELEM*NSTRES

CALL REAOSPIHSP, INT19, AANTC) DO 390 NAT=l, AANTC

SPINBL, NAT) = HSPINAT) 390 CONTINUE

400 CONTINUE

C

C Verplaatsingen en krachten inlezen. TDISP bepalen

C DO 450 1=1, NKN READIINT19,840)(TDISPII,J) ,J=l, NDEG), RD2, RD3, * IRESKRAII,K),K=l, NOEG) DO 430 NVR=l, NDEG TDISPII,NVR)=TDISPII,NVR) - DISPII,NVR) 430 CONTINUE

450 CONTINUE

C

c****

C Indien waarden geselecteerd moeten worden (GRAFSEL .EQ . . TRUE.l C bepaal m.b.v. TOISP, COORKN en RESKRA:

C - Oe uiteindelijke coordinaten van de knoop tot waar de C gapelementen gesloten zijn en bereken hiermee de diam. tot C waar de gravure dan in het betreffende increment is gevuld. C - Oe totale stempelkracht in het betreffende increment.

C

IF (GRAFSEL . EQ. . TRUE. 1 THEN

CALL OIAMTOT(TOISP, COORKN,RESKRA,INCR, OIA, * TOTKR ,KNPR, KNNKR, NGAP, NKNW, INCREl

ENOIF

C

C Uitschrijven rek/spanningsblok ... Rekening houden met werkelijk C aantal knopen en elementen.

C C WRITE(UIT,825l N01, INC, N01, N01, N01, N01 00 475 N8L=1,NELEMW*NSTRES 00 470 NAT =1,AANTC HSP(NATl= SP(NBL,NATl 470 CONTINUE

CALL WRITESP(HSP, UIT,AANTCl 475 CONTINUE

C

C Uitschrijven v/d verplaatsingen en krachten ... Rekening houdend C met werkelijk aan knopen en elementen.

C C DO 500 I=1,NKNW WRITE(UIT,845l (TOISP(I,Jl,J=1,NOEGl,(RESKRA(I,Kl,K=1,NDEGl 500 CONTINUE C INC= INC+1 GO TO 205 ENDIF

Indien GRAFSEL . EQ . . TRUE. dan:

- Bereken verhouding gem. stempeldruk/vloeispanning - Bereken de logarithme van Old

- Schrijf de getallen in de file SPLNOO.OAT

C C C C C C C 1100 C C C C C C

IF (GRAFSEL . EQ. . TRUE. 1 THEN CALL WRVERH(INCR,VLLOOO,TOTKR,

I

OIA, MAXINC,INCREl

Het INCR moet hier de hoogste waarde hebben.

Oeze call kan dus pas uitge-voerd worden indien aIle

incrementen zijn doorgerekend. ELSE

T19. FOR 11 -GOTO 1110 ENDIF C C C FORMAT(A72) FORMAT(A80) FORMAT(6I13) FORMAT(6I13) FORMAT(2E13.6) FORMAT(6E13.61 FORMAT(4E13.61 GOTO 1200 CALL ERROR(61 END Globale variabelen:

NREZ Aantal keren dat gerezoned wordt CARD Hulpvariabele die de kop bevat 800 820 825 830 835 840 845 1110 1200 C C C C SUBROUTINE NAAM C

C Doel: het inlezen van een naam en hier de juiste kop voor de rez. file C voor maken C========================================================================= C C C C C C Locale variabelen:

C IND Plaats in CARD waar 'REZ' staat.

C========================================================================= C C SUBROUTINE NAAM(CARD,NREZI INTEGER*4 NREZ CHARACTER*80 CARD C INTEGER*4 IND C

C Testen of NREZ buiten de range valt

c

IF((NREZ.GT.401.0R.(NREZ.LT.O)) CALL ERROR(7)

C

C Indien de routine NAAM eenmaal doorlopen is dan CARD eerst C uittesten op het label REZ.

C IF(NREZ.GE.1) THEN IND=INDEX(CARD, '_REZ') IND=IND-1 ELSE IND=INDEX(CARD,' . I IND=IND-1 ENDIF

c

GOlO ( 1000 . 1 • 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10, 11 , 12 . 13 , 14 , 15 , 16 • 17 • 18 . 19 • 20, *21.22,23,24,25.26.27,28,29,30.31,32,33.34.35,36.37,38,39, *40l NREZ+1 C 1000 CARD=CARD(1:INDl//' REZO' GOlO 500 CARD=CARD(1:INDl//'_REZ1' GOlO 500 2 CARD=CARD(1:INDl//'_REZ2' GOlO 500 3 CARD=CARD(1:INDl//'_REZ3' GOlO 500 4 CARD=CARD(1:INDl//'_REZ4' GOlO 500 5 CARD=CARD(1:INDl//'_REZ5' GOlO 500 6 CARD=CARD(1:INDl//'_REZ6' GOlO 500 7 CARD=CARD(1:INDl//'_REZ7' GOlO 500 8 CARD=CARD(1:INDl//'_REZ8' GOlO 500 9 CARD=CARD(1:INDl/!' REZ9' GOlO 500 10 CARD=CARDI1:INDl//'_REZ10' GOlO 500 11 CARD=CARD(1:INDl//'_REZ11' GOlO 500 12 CARD=CARDI1:INDl//'_REZ12' GOlO 500 13 CARD=CARDI1:INDl//'_REZ13' GOlO 500 14 CARD=CARD(1:INDl/!'_REZ14' GOlO 500 15 CARD=CARDI1:IND)//'_REZ15' GOlO 500 16 CARD=CARDI1:INDl//'_REZ16' GOlO 500 17 CARD=CARD(1:INDl//'_REZ17' GOlO 500 18 CARD=CARD(1:INDl//'_REZ18' GOlO 500 19 CARD=CARDI1:INDl//'_REZ19' GOlO 500 20 CARD=CARDI1:INDl//'_REZ20' GOlO 500 21 CARD=CARD(1:INDl//'_REZ21' GOlO 500 22 CARD=CARDI1:INDl//'_REZ22' GOlO 500 23 CARD=CARDI1:INDl//'_REZ23' GOlO 500 24 CARD=CARD(1:INDl//'_REZ24'

T19.FOR 13 -GOTO 500 25 CARD=CARD(1:INDl//'

_-

REZ25' GOTO 500 26 CARD=CARD(1:INDl//'_REZ26' GO TO 500 27 CARD=CARD(1:INDl//'_REZ27' GOTO 500 28 CARD=CARD(1:INDl//'_REZ28' GOTO 500 29 CARD=CARD(1:INDl//'_REZ29' GOTO 500 30 CARD=CARD(1:INDl//'_REZ30' GOTO 500 31 CARD=CARD(1:INDl//'_REZ31 ' GOTO 500 32 CARD=CARD(1:INDl//'_REZ32' GOTO 500 33 CARD=CARD(1:INDl//' REZ33' GOTO 500 34 CARD=CARD(1:INDl//'_REZ34' GOTO 500 35 CARD=CARD(1:INDl//'_REZ35' GOTO 500 36 CARD=CARD(1:INDl//'_REZ36' GOTO 500 37 CARD=CARD(1:INDl//'_REZ37' GO TO 500 36 CARD=CARD(1:INDl//'_REZ38' GOTO 500 39 CARD=CARD(1:INDl//'_REZ39' GOTO 500 40 CARD=CARD(1:INDl//'_REZ40' GOTO 500 C 500 RETURN END Doel:

Haken van een file naarn waarin data wordt geplaatst nadat NREZ keer gerezoned is

Aantal keren dat er geredzoned is Naarn v/d uitvoerfile Globale variabelen: NREZ NAFI C C C C C SUBROUTINE CRFILN C C================================================================== C C C C C C================================================================== C C C C C

Geeft de plaats in FILEN waar T19 begint Gedeeltelijke invoer file naam

Locale variabelen: IND HUNAAM C C C C C================================================================== C C

SUBROUTINE CRFILN(NAFI, NREZl INTEGER*4 NREZ

CHARACTER*72 NAFI,FILEN

C

COMMON /NAME/ FILEN

C CHARACTER*80 HUNAAM INTEGER*4 IND C INTEGER*4 ITEL DATA ITEl/O/ ITEL= ITEL+ 1 C

C Eenmalig overnemen van de file naam

C

IF (ITEL .EQ.1l THEN IND= INDEX(FILEN, 'T19' 1 IND= IND-2

HUNAAM(l:INDl = FILEN(l:INOI ENDIF

C

IF(NREZ.GT.40l CALL ERROR(7l

C GOTO ( 1000, 1 , 2, 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10, 11 , 12 , 13 , 14 , 15 , 16 , 17 , 18 , 19 , 20 , *21,22,23,24,25,26,27.28,29.30,31,32,33,34,35,36,37,38,39. *40l NREZ+1 C 1000 NAFI=HUNAAM(1:INDl//'T19_REZO' GOTO 500 NAFI=HUNAAM(1:INDl//'T19_REZ1' GOTO 500 2 NAFI=HUNAAM(1:INDl//'T19_REZ2' GOTO 500 3 NAFI=HUNAAM(1:INDl//'T19_REZ3' GOTO 500 4 NAFI=HUNAAM(1:INDl//'T19_REZ4' GOTO 500 5 NAFI=HUNAAM(1:INOl//'T19_REZ5' GOTO 500 6 NAFI=HUNAAM(1:INDl//'T19_REZ6' GOTO 500 7 NAFI=HUNAAM(1:INOl//'T19_REZ7' GOTO 500 8 NAFI=HUNAAM(1:INOl//'T19_REZ8' GOTO 500 9 NAFI=HUNAAM(1:INDI//'T19_REZ9' GOTO 500

T19.FOR 15

-10 NAFI=HUNAAM(1:INOI//'T19_REZ-10' GOTO 500

11 NAFI=HUNAAM( 1: INOI II' T19_REZ11' GOTO 500

12 NAFI=HUNAAM(1:INOI//'T19_REZ12' GOTO 500

13 NAFI=HUNAAM( 1: INOI II' T19_REZ"I3' GOTO 500

14 NAF 1= HUNAAM ( 1 : I NO 1// ' T19_REZ 14 ' GOTO 500 15 NAFI=HUNAAM(1:INOI//'T19_REZ15' GOTO 500 16 NAFI=HUNAAM(1:INOI//'T19_REZ16' GOTO 500 17 NAFI=HUNAAM(1:INOI//'T19_REZ17' GOTO 500 18 NAFI=HUNAAM(1:INOI//'T19_REZ18' GOTO 500 19 NAFI=HUNAAM(1:INOI//'T19_REZ19' GOTO 500

20 NAF I =HUNAAM ( 1 : INO 1// ' T19_R EZ 20 ' GOTO 500

21 NAFI=HUNAAM( 1: INOI II' T19_REZ21' GOTO 500 22 NAFI=HUNAAM(1:INOI//'T19_REZ22' GOTO 500 23 NAFI=HUNAAM(1:INOI//'T19_REZ23' GOTO 500 24 NAFI=HUNAAM(1:INOI//'T19_REZ24' GOTO 500 25 NAFI=HUNAAM(1:INOI//'T19_REZ25' GOTO 500 26 NAFI=HUNAAM(1:INOI//'T19_REZ26' GOTO 500 27 NAFI=HUNAAM(1:INOI//'T19_REZ27' GOTO 500 28 NAFI=HUNAAM(1:INOI//'T19_REZ20' GOTO 500 29 NAFI=HUNAAM(1:INOI//'T19_REZ29' GOTO 500 30 NAFI=HUNAAM(1:INOI//'T19_REZ30' GOTO 500

31 NAF I =HUNAAM ( 1 : I NO 1// ' T19_REZ31 ' GOTO 500 32 NAFI=HUNAAM(1:INOI//'T19_REZ32' GOTO 500 33 NAFI=HUNAAM(1:INOI//'T19_REZ33' GOTO 500 34 NAFI=HUNAAM(1:INOI//'T19_REZ34' GOTO 500 35 NAFI=HUNAAM(1:INOI//'T19_REZ35' GOTO 500 36 NAFI=HUNAAM(1:INOI//'T19_REZ36' GOTO 500

Doel:

Wegschrijven in een file genaamd LOG_INCOV welk incrementnr.

IINCR) in <naam>.T19 overeen komt met het incrementnr. IINC)

in de file T19_REZ<nr.> 37 NAFI=HUNAAMI1:IND)//'T19_REZ37' GOTO 500 38 NAFI=HUNAAMl1:IND)//'T19_REZ38' GOTO 500 39 NAFI=HUNAAMI1:IND)//'T19_REZ39' GOTO 500 40 NAFI=HUNAAMI1:IND)//'T19_REZ40' GOTO 500

c

500 RETURN END C C C C C C SUBROUTINE INCOV C c====================================================================

c

c

c

C C C C C==================================================================== C C

SUBROUTINE INCOVINREZ, INCR. INC) INTEGER* 4 NREZ. INCR, INC

C

C Eenmalig open LOG_INCOV

C

INTEGER*4 ITEL DATA ITELIO/ ITEL= ITEL+ 1

C

IFI ITEL.EQ.1) THEN

OPENIUNIT=12,FILE='LOG_INCOV' .STATUS='NEW')

WRITEI12,*) , Lijst met overeenkomstige incrementnr.s in' WRITEI12,*1 ' de betreffende T19_REZ<nr.> file'

WRITEI12,*)

WRITEI12,*) , NREZ INCR INC'

ENDIF

C

WRITE 112.800) NREZ, INCR. INC 800 FORMATI3I10) RETURN END C C C C

Het max. foutnr. Doel:

Routine die in een file LOG_ERROR aangeeft welke fout gemaakt is en/of welke parameter in het hoofdprogramma gewijzeigd moet worden. T19.FOR 17 -C C C SUBROUTINE ERROR C C====================================================================== C C C C C C C C Locale variabelen: C NR Het foutnr. C C Parameter C MAXNR C C======================================================================== C C SUBROUTINE ERRORINR1 INTEGER*4 MAXNR PARAMETER IMAXNR=91 C INTEGER*4 NR,ITEL DATA HEL/O/ ITEL= ITEL+ 1 C C Eenmalig openen C IFIITEL.EQ,11 THEN OPENIUNIT=13,FILE='LOG_ERROR' ,STATUS='NEW' 1 ENDIF C IF IINR.LT.11.0R.INR.GT.MAXNR11 THEN

WRITEI13.*1 ' Het aangeroepen fourtnr. in CALL ERRORlNR1' WRITEI13.*1 ' va It buiten de range'

WRITE113.8101 NR 810 FORMATI' Opgegeven NR is n1.', 151 GOTO 900 ENDIF C C GOTOI1.2,3,4,5.6,7,8,9.101 NR WR ITE 113 , * J WR ITE 113. * 1 GO TO 900 2 WRITEI13.*1 WRITEI13,*1 GOTO 900 3 WRITEI13,*J WRITEI13,*1 GOTO 900

Overschrijding max. aantal spannings en rek componenten parameter MAXAANT'

, Overschrijding max. aantal knoopp parameter' , MAXKN'

, Overschrijding max. aantal elementen' , parameter MAXELEM'

4 WRITE(13,*1 WRITEI13,*1 GO TO 900 5 WRITEI13,*1 GOTO 900 6 WRITEI 13, *) GO TO 900 7 WRITEI13,*) WR ITE 113, * I WRITEI13,*) GOTO 900 8 WR ITE 113, * I WRITEI13,*) GOTO 900 9 WRITEI13,*) WR ITE ( 13 , * I GOTO 900 10 WRITEI13,*) GOTO 900 900 CALL EXIT RETURN END

, Overschrijding max. aantal vrijheidsgraden' parameter MAXNDEG'

, De string "****" staat niet op de juiste plaats' , Eind v/d file <naam>.T19 bereikt.'

, Het aantal keren dat gerezoned wordt past' , niet in de range 1:40. Pas dit aan in' , subroutine CRFILN en in de routine NAAM.' , Overschrijding max. aantal integratie punten' , parameter MAXNSTR'

, Overschrijding max. aantal gapelementen toe-' gestaan in routine KNOSEL en DIAMTOT'

, DIAII) in routine WRVERH nadert tot nul'

van een regel in het rek/spanningsblok afhankelijk aantal componenten opgegeven met de POST CARD in Doel: Inlezen van het MARC. C C C C C C C SUBROUTINE READSP C C C C C C C Locale variabelen:

C SPINSP) Rek/spannings componenten C CHAN kanaal waarin gelezen wordt

C NSP Aantal componenten

C==================================================================

C C

C

SUBROUTINE READSPISP, CHAN, NSP) INTEGER*4 CHAN, NSP REAL*8 SP(NSP) C INTEGER*4 START, SPBL, NSPBL, I C START = 1 NSPBL

=

NSP I 6 DO 100 SPBL = 1, NSPBL

READ(CHAN, 150) (SPII), I = START, START + 51 150 FORMAT(6E13.6)

uitvoer kanaal aantal componenten

componenten per integratiepunt

T19.FOR 19

-START

=

START + 6

100 CONTINUE

C

IF (START .LE. NSP) THEN

NUMSP

=

NSP - START + 1

READ(CHAN. 250) (SP(I). I = START. NSP)

250 FORMAT«NUMSP>E13.6) ENDIF

c

RETURN END C C C

C===+=============+===============================================

C SUBROUTINE WRITESP C C C Doel:

C Wegschrijven van componenten in rek/spanningsblok

C C Invoer: C CHAN C NSP C SP(i) C Uitvoer: C Locaal: C Parameters C Aangeroepen routines: C Bijzonderheden: .

C=================================================================

C C

SUBROUTINE WRITESP(SP. CHAN. NSP) INTEGER*4 CHAN. NSP REAL*8 SP(NSP) C INTEGER*4 START. SPBL. NSPBL. I

c

START

=

1 NSPBL = NSP / 6 DO 100 SPBL

=

1, NSPBL

WRITE(CHAN. 150) (SP(I). I = START. START + 5)

150 FORMAT(6E13.6)

START

=

START + 6

100 CONTINUE

C

IF (START .LE. NSP) THEN

NUMSP

=

NSP - START + 1

WRITE(CHAN. 250) (SP(I). I = START, NSP)

250 FORMAT«NUMSP>E13.6)

ENDIF

C

END

Stelt een vraag via het scherm of dat er gekozen wordt voor het selecteren van data waarmee het mogelijk wordt om een file te creeren met waarden voor het tekenen van de grafiek. Indien hiervoor gekozen wordt krijgt GRAFSEL de waarde TRUE.

Terminal input kanaal Terminal output kanaal Parameters: KEYIN SYSOUT C C C C

C========================================================================

C C SUBROUTINE VRAGRA(GRAFSEL) C C Ooel: C C C C C C C C C C Variablen: C

C GRAFSEL Logical true dan data te selecteren in

hoofd-C programma.

C========================================================================

C

SUBROUTINE VRAGRA(GRAFSEL)

C

INTEGER*4 KEYIN, SYSOUT

PARAMETER(KEYIN

=

5, SYSOUT

=

6)

C

CHARACTER*72 CARD

C

5 WRITE(SYSOUT,*) 'Data selecteren (J/N)'

REAO(KEYIN,800) CARD 800 FORMAT(A72)

IF (CARO(1:1).EQ. ' J ' ) THEN

GRAFSEL = .TRUE.

ELSEIF (CARO(1:1).EQ. 'N') THEN GRAFSEL

=

.FALSE. ELSE GOTO 5 ENOIF C C RETURN END C C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C C SUBROUTINE KNOSEL C

C Ooel: Selecteren van de knopen welke verbonden zijn met gapelementen C en knopen waarin de normaalkracht staat van dezelfde

T19.FOR 21

-C gapelementen.

C

C Variabelen:

C Zie voor gebruikte variabelen het hoofdprogramma. C GAPTYP Type elementnr 12 (gapelement)

C NGAP Aantal gapelementen.

C=======================================================================

C

C

SUBROUTINE KNOSEL(CONNEC, KNPR, KNNKR, NELEM. NGAP)

C

INTEGER*4 MAXGAP. MAXELEM. MAXNDEG. KNPT. ELTYP. CON2, * GAPTYP

PARAMETER(MAXGAP=150, MAXELEM=600, MAXNDEG=2. * KNPT =4,ELTYP=10, CON2=6. GAPTYP=12)

C

INTEGER*4 NELEM, CONNEC(MAXELEM,CON2), KNPR(MAXGAP). * KNNKR(MAXGAP), NGAP

C C

NGAP=O

DO 100 1=1, NELEM

IF (CONNEC (1,1) . EQ. GAPTYP) THEN NGAP= NGAP + 1

IF (NGAP .GT. MAXGAP) CALL ERROR(9) KNPR(NGAP)= CONNEC(I,3) KNNKR(NGAP) = CONNEC(I,4) ENDIF 100 CONTINUE C RETURN END C C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ SUBROUTINE DIAMTOT Doel :

Bepalen van de totale stempelkracht en de diameter tot waar de gravure gevuld is in het betreffende increment (INCR). Deze worden resp. weggeschreven in array TOTKR en DIA

C C C C C C C C C C C C C C C C C C C C Parameters: STRBOV STROND STRSYM RVOET DBLANC Variabelen:

Grenzen waar tussen de y-coordinaat moet liggen om vast te stellen of de knoop op de buitenrand ligt.

Grens om vast te stellen of een knoop op de sym-metr ie as ligt.

Straal aan de voet van de gravure. De diameter van de blanc.

C zie hoofdprogramma

C YCOOR Hulp variabelen voor het resp. vast houden

C XCOOR van de y coordinaat en x coordinaat.

C BLDIK Dikte van de blanc ter plaatse waar het

C stempel het eerst aan ligt.

C TOTDIK Dikte van de blanc op de plaats van het

C topje van de konische uitstulping

C=======================================================================

C C

SUBROUTINE DIAMTOT(TDISP, COORKN,RESKRA,INCR, DIA, * TOTKR ,KNPR, KNNKR, NGAP, NKNW,INCREI

C

REAL*8 DBLANC, RVOET, STRBOV, STROND, STRSYM

PARAMETER(DBLANC=50. ,STRBOV= 25.05, STROND =24.95, * STRSYM = 0.01, RVOET= 1.5)

C

INTEGER*4 KEYIN, SYSOUT, INT19,MAXKN, MAXELEM,MAXNDEG,MAXAANT,

* MAXNSTR,GROOTHE,KNPT, ELTYP, CON2, OUT,MAXGAP,

* MAXINC, INCR, NGAP

PARAMETER(KEYIN = 5, SYSOUT = 6, OUT=99,MAXGAP=1501 PARAMETER(INT19 = 7, MAXKN=650, MAXELEM=600, MAXNDEG=2,

* MAXAANT=24 , MAXNSTR=4, GROOTHE=5, KNPT =4,ELTYP=10,

* CON2=6, MAXINC=250)

C

CHARACTER*72 FILEN,NAFI

CHARACTER*80 CARD, HUCARD,KOCARD,BUCARD(GROOTHEI, * COMCARD(MAXAANT)

C

INTEGER*4 AANTC, NKN, NELEM, NDEG, NSTRES

INTEGER*4 UIT, NREZ, NKNW, NELEMW, CONNEC(MAXELEM,CON2), * KNAR(MAXKN). KNPR(MAXGAP), KNNKR(MAXGAP), KNDIAM,

* INCRE(MAXINC) C REAL*8 * * * * C C COORKN(MAXKN,MAXNDEGI, DISP(MAXKN,MAXNDEG), TDISP(MAXKN,MAXNDEGI, RESKRA(MAXKN,MAXNDEGI, SP(MAXELEM*MAXNSTR,MAXAANT). HSP(MAXAANT),

DIA(MAXINC), TOTKR(MAXINCI, YCOOR,

XCOOR, BLDIK, TOTDIK

INTEGER*4 TEL DATA TELlO! TEL = TEL+1

C

C Doe voor aIle coordinaten

C - Bepaal m.b.v. COORKN en TDISP de blanc dikte BLDIK C - Bepaal de tot ale dikte ter plaatse van de aangebrachte

C konus.(TOTDIK) C BLDIK = 0.0 TOTDIK = 0.0 C DO 100 1=1, NKNW

T19.FOR 23

-XCOOR = COORKNII,l) + TDISPII,l) YCOOR = COORKNII,2) + TDISPII,2)

IF IIYCOOR.GT.STROND).AND.IYCOOR.LT.STRBOV) )THEN IF IBLDIK .LT. XCOOR) THEN

BLDIK = XCOOR ENDIF

ELSEIF IYCOOR .LT. STRSYM) THEN IF (TOTDIK .LT. XCOOR) THEN

TOTDIK= XCOOR ENDIF

ENDIF 100 CONTINUE

C

C - Bepaal m.b.v. BLDIK en TOTDIK de straal tot waar de C gravure ongeveer gevuld is.

C C

DIAIINCR+l) = RVOET -ITOTDIK-BLDIK)*SQRTI3.)/3. INCRE(INCR+l) = 1

C

C Controle stuk 1.

C

WRITEISYSOUT,839) DIA(INCR+1), BLDIK, TOTDIK,INCR+1 839 FORMATI' De waarden uitgeprint door subr. DIAMTOT' ,I,

*' DIA(INCR+1)= ',E15.7,I,

t ' BLDIK= ·,E15.7,1,

*'

TOTDIK= ',E15.7,1,

*' INCR+1= ',15)

Doe voor het werkelijk aantal knopen lzonder de knopen gekoppeld aan de gaps)

- Indien de x-waarde 0.0 dan onthoudt bijbehorend knoopnr. - Bepaal hiermee in RESKRA de reactiekracht

Bepaal de totale stempelkracht en plaats deze in TOTKRIINCR+1). c

C eind controle stuk 1.

C C C C C C C C C TOTKRIINCR+1) = 0.0 C DO 200 I=1,NKNW IF ICOORKNII,1) .LT. 0.01) THEN

TOTKRIINCR+1) = TOTKR(INCR+1) + RESKRA(I,l) ENDIF

200 CONTINUE

C C

IFlTOTKRIINCR+1) .LT. 0.05) THEN

WRITE(SYSOUT,850) INCR+l, TOTKRIINCR+1)

850 FORMAT(' De totale stempelkracht in incr.+1 . 15, * ' is gelijk aan' ,E15.7)

ELSE

ENDIF

C

C Controle stuk voor bekijken van de actuele coordinaten in elk incr. C Deze worden weggeschreven in file genaamd ACCOOR.DAT

C

IF (TEL .EQ. 1) THEN

OPENIUNIT=22,FILE='ACCOOR' ,STATUS='NEW')

WRITEI22,*) , Lijst met actuele coordinaten zoals deze zijn' WR ITE I 22, *) , na elk increment.'

WRITE(22,*) ENDIF

C

WRITE(22,860) INCR

860 FORMATI' Het incr is ',15,1,

*

I " knr. xcoor ycoor' )

C

00 250 I=1,NKNW

XCOORD = COORKN(I,1) + TDISP(I,1)

YCOORD = COORKN(I,2) + TDISP(I,2)

WRITE(22,870) I, XCOORD, YCOORD 870 FORMAT(I5.2E15.6) 250 CONTINUE C RETURN END C=========================================================================== = Doel:

Bereken van: 1) de verhouding gem. stempeldruk/vloeispanning 2) ln I Old) waarin:

o

de diameter aan de voet van de gravure d de diameter tot waar de gravure gevuld is. Opbergen van deze waarden in een file SPLNDD.DAT met in de eerste kolom de waarde (2) en de tweede kolom de waarde (1).

Straal aan de voet van de gravure (1.5 mm) Diameter van de blanc ( 50 mm)

= 3.141592654

Verhouding gem. stempeldruk/vloeispanning Gebruikte vloeispanning In ID/d) Variabelen: STEMKR VLSP LNDGED Parameters: RVOET DBLANC PI C C C SUBROUTINE WRVERH C C C C C C C C C C C C C C C C C C C C C C===========================================================================

c

T19.FOR 25

-C

SUBROUTINE WRVERH(INCR,VLSP,TOTKR, DIA, MAXINC, INCRE) INTEGER*4 SYSOUT

PARAMETER(SYSOUT = 6)

C

REAL*8 TOTKR(MAXINC), DIA(MAXINC) INTEGER*4 INCR, MAXINC, INCRE(MAXINC)

C

REAL*8 PI, RVOET, DBLANC

PARAMETER(PI=3.141592654, RVOET=1.5, DBLANC=50)

C

REAL*8 VLSP, LNDGED, STEMKR

C

C Bereken voor elk incr. de gevraagde waarden (zie heading routine) C en schrijf deze weg in de file.

C

OPEN(UNIT=98, FILE='SPLNDD' ,STATUS='NEW')

C

DO 100 1=1, INCR+1

IF (INCRE(I) .EQ. 1) THEN IF (DIA(I) .LT, 0.0001) THEN

WRITE(SYSOUT,*) '****************************************'

WRITE (SYSOUT, *) 'De diam. nadert tot nul nl.: '

WRITE(SYSOUT,840) OIA(I),I 840 FORMAT('DIA(I)= ',E15.7,'met 1= ',15) CALL ERROR ( 10) ENDIF C LNDGED = DLOG(RVOET/(DIA(I))) STEMKR = TOTKR(I)/(((OBLANC*DBLANC)*PI/4)*VLSP) WRITE(98,850) LNDGED, STEMKR, I

850 FORMAT(2E15.7,I10) ENDIF 100 CONTINUE C C RETURN END

Subroutine's voor gebruik in Marc.

Achtereenvolgens worden de volgende routine's, die in MARC worden gebruikt, uitgeschreven: - RZOATA - UFRORD - WKSLP - ELEVAR - IMPO - AFSTAN - ERROR C C C

C Deze routine is er bij geplaatst om te voorkomen dat de berekening C vast loopt doordat er geheugen plaatsen werden overschreven bij C gekombineerd gebruikt van gapelementen en de rezone optie. C In deze routine zijn vier statements bij geplaatst, aangegeven

C tussen: C************. Indien deze routine niet wordt gebruikt krijg C je de foutmelding dat elementen inside out draaien, doordat niet C de juiste coordinaten bij de knooppunten bekend zijn.

C C PROGRAM RZDATA OP SUBROUTINE RZOATA OS COMMON/PASRZ/ISTART,IEND C CALLEO BY OREZON C* * * * * * C

C INPUT OF REZONING OATA. C

C ISTART START ADRESS OF REZONING OATA WITHIN COMMON SPACE C IENO

=

-1 (NO REZONE INPUT THIS INCREMENT)

C = 0 (NORMAL REZONE STEP)

C

=

1 (TOTAL REZONING FINISHEO)

C COMMON/STRVAR/IESLST,IGSLST,IALFST,INFIXS,INPBS,IOSXFS,NUMBCS, * ITREST,INTRES,ITRESS,ITBOOY,ITPRES,NOISTS.IELSFS.IEKS,IEFTYS, * IEFRTT,IEFSPT,NFOUND.IETST,IXUST,ICOEST,ISIGXS,ISTYPE,IEXS,MPTPMS *,IOSXS,IOSX1S.IOSX2S,IOSXTS.ITXS,IPINCS,IPTOTS,IXLOAS, * IDYNVS,IOYNAS,NOEGS,INPIS,IONBCS,IGSIGS,ISPENS,NBCTRS,NSHTRS, * IONTYS,NCYCLS,JTYPS,IINSTS,FCTSTR COMMON/HETVAR/ICONSL,ISPSLT,IRESSL,INFIXH,INPBH,IDSXFH,NUMBCH, * IFLEST,INFLES,IFLESS,IHBOOY,IMFLES,NDISTF,IEFSF,IEKH,IEFMTY, * IFMRAT,IEFMPE,NFILM,ICONDU,ISPHT,ICONDV,ISIGXH,IHTYPE,IEXH,MPTPMH *,IOSXH,IOSX1H,IOSX2H,IOSXTH,ITXH.IPINCH,IPTOTH,IXLOAH. * IDYNVJ,IDYNAJ,NDEGH,INPIH,IONBCH,IGSIGH,ISPENH,NBCTRH,NSHTRH, * IONTYH,NCYCLH,JTYPH,IINSTH,FCTHET COMMON/ELBOW/IGEOM4,IELBOW,ARE,SF1,SF2,XMINT,XMINTI,XMINTP 1,XMINTO,OMAX.WT,XLAM,PSI,GAMMA,IGEOM5,IGEOM6 COMMON/OP1/JBAD,CARD(80),ICARD(16),FCARD(8) COMMON/PREPRO/NSZBUF,ICOBUF,IOLO,KIN,KOU,KI2,KAUX,IPSRC COMMON/FAR/FACR,INC COMMON/POATA/MESHP,MESHPT,MESHST.MESHCM.IPBUF,LPBUF

SUBROUT.FOR 2 -l,ISTPL,NOPLT,IPLo,ACHS(2I,ITERM,AICHS(2I,IENoo COMMON/SBSTRC/IBEFOR,IBORT COMMON/oIMEN/NSTRMX,NNOoMX,NN02MX,NBCTMX,IoSS,NQNP,ITIE,NUMEL, lNUMBC,NUXTR,NGANS,MAXNP,NUMNP,NoEG,MPRMAX,NCRo,NSXX,ITIEM, 2ISTYPM,LONGSM,LONGTM,MAXNPR,MAXQNP l,NELTYP,MAXSER,N14SIZ,MAXALL, NINERT,NSTRA,NSTRAM 4,NINTB

COMMON/BLNK!JEL, INSTAB, LM( 20 I, SIGTE (33 I, EPTE (33 I, F(20 I, Fl (40 I, lSUM(201 ,SUMo(201 ,FRX(201 ,OX(201

COMMON/HEAT/IHEAT,NOSCAL,IELAS,IELSTO,NELSTO,MXELS l,IEXTR,IFINTM,FINTEM,NONAHT,NCONTA,NCONTM,ICONGO COMMON/VECTOR/NVECBK,NRECS,IFULL,NoEGRo,MVECRo,NOF1(91 l,NVECRK COMMON/ARRAYS/IS,IET,IXU,IRO,ICOEo,ITRANS,IGEOM1,IGEOM2,IGEOM3, lISK,ISS ,IALPHA,Io,IB,IE,IALPHI,IAC,IAH,ISXX,IToICT,IToICO,IPR00, 2IRES,IRES1,IRES2,IPROol,IoICOS,IYIELo,IoT,IDTDL,IKGENS,IITI,INFIX, 3INPB,INUME,INPNUM,IISTYP,ILONGS,ISTIE,IITIPE,ISXS,INPS,INP1,ISXXRH 4,INNOoE,INSTRN,INDI,INSHR,IISHL,IIORT,IINTEL,IINTIN,IISNTE,IINTPR l,IJTYPE,IJCTRN,IJBXA l,IPREST,INPRES,IPRESS,IIBOoY,NoISTL l,ITHICK,IALIAS,JHERR,IXINTP,ICENTo,ICENTA,ICENTR,ISTRA 1,IDSXF.ICll,IC20,IC30,ICONST,ICOMPo,ILYCMP,ITKCMP 1,IJFIX,IJPB,IJDSXF l,IJPRST,IJNPRS,IJPRSS,IJBOoY,NJoIST,IGTLST COMMON/NZR01/NGENS,NEQST,ITOP,NSTRES,KITYPE l,NSEQST COMMON/HARDS/KINHRo,MOHRC,JOAKR,NSTATS,IVISC,MOONEY,IRPFLO l,IPELA,JOAKRM,MROZ,LINEAR,MCONL,NSTASS COMMON/MATERS/NOMATS,NOSLPS,NOWKH,NOYPT,NOWK2,NOYP2,NOESL,NOGNSL, lNALFSL,IYP,IYP2,IWKSL,IWKSL2,IESL,IGSL,IALFSL,IMATER 2.NOEPSL,IEPSL.NOSRSL,ISRSL,LATENT,NLATEN,IFOURC,NFSER,MNTER 3,NLOC,IFOURN,ISCNT,IDFSN,IFC,IFINC,NLOCM 4,IGPRIG COMMON/ARRAY3/IECRP,IECRPP,IECRPM,ISHIFT,IYIEL2,IECPR 1 ,ICRPE,ICRPR,ICRPEP,ICRPEM,IGE,IBPLAS,ISTOT,ISTEMP,IETEMP,IATEMP 1, IB1, IE1, IS1, IECRP1, IGF, IALPHT, ISINC, ISDEL T, IFCRP, IALF, ICRPET. lIEKEEP,IETOTL,IEPTO,ISPEN,IEELA,IGSIGl 4,IGSIGo,IoEVOL COMMON/oYNS/IDYN,ITET,IDYNMD,IDYNST.ICTDYN,IDYNo,IoYNV,IoYNA, lIoYNGD,IoYNGV,IoYNGA,IoYNP,INCASM 1,ITRIG,BLSO(201,INPRH,IoAMP,ICoAMP,MASSP,IMASSN,NSPRNG,ISPRNG 2,IoYSMD,IoYSW,IoYSE,IASoYN,LUMP,DEE(1I,IRENAL,IRENBE,IRENER,NDYNMD 3,ICENT,ISPZo,ISPZDG COMMON/ARRAY2/IEX,ISIGXX,IITYPE,INPI,IEPLAS,IITMAT,INTMAT,INPMAT, lINPBT,IDISP,IDISPT,IXORo,INP,IDSX,IDSX2,IDSX1,IDSXT,ITX,IPINC, 2IPTOT,IXLOAo,IMAXCO,INAP,IMPRES,IEQUIV,ISTINT,ISTVAR,IoSBUK,INAPRH 3,ICOORD,IDUMP,IETOTA,IoUMP1,LLPOS,IGSIG,IEPL l,ISWELL,ISERA,ISERN,IEELAS,IECORR,ICAUCH COMMON/LPRES/PRESS,AREA,ITYP,IBODY,IGENS.JGEN,ARoELT COMMON/LASS/N,NNODE,Nl,NNN,X12,X15,X35,NN COMMON/CREZON/IREZON,JREZON.KREZON,LREZON,NRZNOD,IRZNOD,IRZCOO 1,NRZELT,NRZTYP,NRZMAT,IRZSEC,IREBAN,ICOOR2,NRZMOV,IRZMOV 2,DELMO(3I,NRZCON,IRZCON,LRZCON,ITYCON,MREZON COMMON/SETNAM/NSET,NSETMX,IPTNAM,IPTTYP,IPTNUM,IPTLOC,

* IPTBEG,NITEMX,ISRTMP COMMON/SPACE/INTS(100000) DIMENSION VARS(1)

EQUIVALENCE(INTS(1),VARS(1»

DIMENSION OPTNA( 10,10) ,OPTNB( 10,6) ,OPTION( 10,16) EQUIVALENCE(OPTNA( 1,1), OPTION( 1,1»

EQUIVALENCE(OPTNB(1,1),OPTION(1,11» DATA OPTNAI

11HR,1HE,1HZ,1HO,1HN,1HE,1H ,1H ,1H ,1H, 21HC,1HO,1HO,1HR,1HD,1HI ,1HN,1HA,1HT ,1HE, 31HS,1HE,1HC,1HT ,1HI ,1HO,1HN,1HI ,1HN,1HG, 41HM,1HO,1HV,1HE,1H ,1H ,1H ,1H ,1H ,1H, 51HS,1HM,1HO,1HO,1HT ,1HH,1H ,1H ,1H ,1H , 61HC,1HO,1HN,1HN,1HE,1HC,1HT,1HI,1HV,1HI, 71HU,1HF,1HR,1HO,1HR,1HD,1H ,1H ,1H ,1H , 81HP,1HR,1HO,1HP,1HE,1HR,1HT,1HY,1H ,1HC, 91HG,1HE,1HO,1HM,1HE,1HT,1HR,1HY,1H ,1HC, *1HC,1HO,1HN,1HT,1HI,1HN,1HU,1HE,1H ,1H I DATA OPTNBI 11HE,1HN,1HD,1H ,1HR,1HE,1HZ,1HO,1HN,1HE, 21 HP ,1 HR, 1HI, 1HN, 1HT ,1 H ,1 HC, 1HH, 1HO, 1HI 3,1HN,1HE,1HW,1H ,1H ,1H ,1H ,1H ,1H ,1H, 4 1HO,1HL,1HD,1H ,1H ,1H ,1H ,1H ,1H ,1H, 5 1HC,1HO,1HM,1HM,1HE,1HN,1HT ,1H ,1H ,1H 6 ,1HE,1HX,1HI,1HT,1H ,1H ,1H ,1H ,1H ,1H 3 I ISRTMP=IGTLST+NSZBUF JBAD=O NOPTS=16 IEND=-1 IF(NOPLT.NE.-1) NOPLT=O C NRZNOD=O NRZELT=O NRZTYP=O NRZMAT=O NRZMOV=O NRZCON=O ICOOR2=ISTART NMAXX=NCRD IF(NDEG.GT.NCRD) NMAXX=NCRD IRZNOD=ICOOR2+NMAXX*NNODMX IRZCOO=IRZNOD+NUMNP ISTART=IRZCOO+NCRD*NUMNP IGTLST=ISTART C****************************************** ISRTMP =IGTLST + NSZBUF

C****************************************** C IF(NOPLT.EQ.-1) GO TO 102 110 CONTINUE KAUX=KIN C READ(KIN,103)CARD C IF(EOF(KIN).NE.O)GO TO 1252 CO CO