************************************************************************ ************************************************************************ PROGRAM CATMOD2 ************************************************************************ * * * TRANSFER : CONVERTIEREN VON MODELLEN VON/NACH CATIA * * * * VORBEREITUNG EINES MODELLS FÜR IGES-TRANSFER. DURCH SCHLÜSSELWÖRTER * * PARAMETRISIERTES MANIPULIEREN EINES CATIA-MODELLS. * * * * BEARBEITET WERDEN MASTER-WSP. UND INTERNE DETAIL-WSP. * * * * USER- UND MODELL-PARAMETER AUS FT05F001 (IN DIESER REIHENFOLGE) : * * -------------------- * * *PRJ * * *GRP * * *USR * * *ACCT * * *PWD * * * * *DSN * * *MOD * * * * * BEARBEITUNGSAUFTRÄGE (OPTIONAL UND IN BELIEBIGER REIHENFOLGE) : * * -------------------- * * *ANN * * *CCV * * *COL [ [ []] * * *DET * * *DET- [FORCE] * * * *DRW * * *FIL * * *KIN * * *LAY * * *NCS * * *PUB * * *SCA * * *SET * * *SMRT * * *SOM * * *STUP * * * *VU * * * * *ANN - ALTER TEXT UND DIMENSION WERDEN IN NEUEN TEXT UND DIMENSION * * CONVERTIERT (ATTRIBUTE WERDEN MIT ÜBERNOMMEN). * * *CCV - ZERLEGEN VON COMPOSITE CURVES IN IHRE BESTANDTEILE * * *COL - FARBEN GRÖSSER ALS COLMAX IN FARBE COLNEW EINFÄRBEN * * . DEFAULT FÜR COLMAX IST 5 (GRÖSSERE FARBE -> FÄRBEN) * * . COLMAX < 0 => umfÄrben gdw akt.COL = -COLMAX * * . DEFAULT FÜR COLNEW IST 1 (WEISS) (ZIELFARBE) * * . COL0 STEUERT, WIE TRANSPARENTE ELEMENTE GEFÄRBT WERDEN * * . GÜLTIGE WERTE FÜR : 'LAYER', 'SET', 'VIEW', 'TYPE' * * 'CURRENT', 'NONE', 'COLNEW' (DEFAULT) * * .'LAYER' : EINFÄRBEN GEMÄSS STANDARD/COLOR/LAYER * * .'SET' : EINFÄRBEN GEMÄSS STANDARD/COLOR/SET * * .'VIEW' : EINFÄRBEN GEMÄSS STANDARD/COLOR/VIEW * * .'TYPE' : EINFÄRBEN GEMÄSS STANDARD/COLOR/TYPE * * .'CURRENT': EINFÄRBEN GEMÄSS STANDARD/COLOR/(LAYER..TYPE) * * .'NONE' : NICHT EINFÄRBEN * * .'COLNEW' : EINFÄRBEN IN FARBE (DEFAULT) * * *DET - LÖSCHEN LEERER DETAILS (UND IHRER DITTOS) * * *DET- - Löschen des Details DETAIL und seiner Dittos * * ! bei FORCE werden auch passende $-Details bearbeitet ! * * *DRW - Löschen aller DRW Elemente * * *FIL - LÖSCHEN ALLER FILTER, DEREN NAMEN MIT '$' BEGINNT * * *KIN - KINEMATICS SETS LÖSCHEN * * ! *KIN IST AUFGRUND FEHLENDER CATGEOS NICHT IMPLEMENTIERT ! * * *LAY - TRANSFERIEREN DER ELEMENTE EINES LAYER IN EINEN ANDEREN * * *NCS - NS-SETS LÖSCHEN * * *PUB - Solids PUBLISH setzen (nur MASTER-Workspace) * * *SCA - DAS KOMPLETTE MODELL MIT DEM FAKTOR SKALIEREN * * ! *SCA IST AUFGRUND FEHLENDER CATGEOS NICHT IMPLEMENTIERT ! * * *SET - LÖSCHEN UNBENUTZTER SETS * * *SMRT - Alle Solids SMART (SMARTPARM=1) bzw. UNSMART (=0) setzen * * *SOM - Alle SOEs in SOMs überführen * * ! *DRW wird dabei gelöscht * * *STUP - StartUp Model setzen * * *VU - LÖSCHEN UNBENUTZTER VIEWS (INCL. BACKGROUND PLANES) * * *NSH - ALLE SPACE-ELEMENTE AUSSER SOLIDS IN NOSHOW SETZEN * * * * CATMOD2 LIEFERT COND CODE 4, FALLS EIN AUFTRAG NICHT KOMPLETT AUS- * * GEFÜHRT WERDEN KONNTE. COND CODE 4 VERURSACHT KEINEN ABBRUCH VON * * CATMOD2. * * IN DIESEM ZUSAMMENHANG KÖNNEN FOLGENDE MELDUNGEN IN FT06 AUFTRETEN: * * - EXTERNES DETAIL NICHT VERÄNDERT * * * ************************************************************************ * * * * . AUTOR : DBB * * * FIRMA : MRO * * * TEL. : 069/8305-2876 * 10.07.91 * * * * * . PROGRAMMIERSPRACHE : VS-FORTRAN V2R4M0 * * * * * * . AUFNAHME VON *SCA * 23.07.91 * * . *COL UMSCHALTEN AUF ANDERE BPLANES * 01.10.91 * * . *COL GETRENNTE BEARBEITUNG VON *SPC * 01.10.91 * * . *COL -> NONE WEISS FÄRBEN * 27.11.91 * * . AUFNAHME VON *CCV * 05.02.92 * * . ABFANGEN MELDUNG LEERER STACK * 05.02.92 * * . ANPASSUNG FEHLERHANDLING * 06.04.92 * * . LÖSCHEN UNBENUTZTER SETS * 22.12.92 * * . LÖSCHEN UNBENUTZTER VIEWS / BACKGROUND PLANES * 23.12.92 * * . NACH SCANNEN ÜBER BPLS RÜCKSETZEN AUF CURRENT BPL * 23.12.92 * * . AUFNAHME VON *FIL (CATGEO GETNAME FEHLT) * 05.01.93 * * . ÜBERSETZEN DER FEHLERMELDUNG 1994 / MODEL NOT FOUND * 13.05.93 * * . VIEWS MIT TRANSPARENCIES (3D) NICHT LÖSCHEN * 02.12.94 * * . AUFNAHME VON *LAY * 28.03.95 * * . NEUES FEHLERHANDLING * 29.03.95 * * . WIRKUNG AUCH AUF (INTERNE) DETAIL-WORKSPACES * 18.04.95 * * . *FIL MIT CATGEOS FÜR IDENTIFIER REALISIERT * 18.04.95 * * . AUFNAHME VON *DET * 17.01.96 * * . ERWEITERUNG DER *COL-FUNKTIONALITÄT * 19.01.96 * * . KORREKTUR VON *DET * 07.06.96 * * . Erweiterung *COL um negative Argumente für COLMAX * 05.11.97 * * . Erweiterung *ANN um alte Texte, Dimension und Attribute* * * in neue Texte, Dimension und Attribute umzuwandeln. * 23.03.99 * * . Deklaration für ModelFile dynamisch generieren (VPM) * 26.11.99 * * . Nach jedem Auftrag Modell komprimieren (GIMTAS) * 03.05.01 * * . Nach jedem alten Text/Dim komprimieren (GIMTAS) * 07.05.01 * * . AUFNAHME VON *STUP * 08.05.01 * * . AUFNAHME VON *DET- * 08.05.01 * * . AUFNAHME VON *PUB * 09.05.01 * * . AUFNAHME VON *SMRT * 30.07.01 * * . *SMRT nur auf MASTER-Wsp * 18.04.02 * * . AUFNAHME VON *SOM * 18.04.02 * * . AUFNAHME VON *DRW * 18.04.02 * * * * ************************************************** 02.05.02 ** DBb ***** IMPLICIT NONE *----------------------------------------------------------------------- * VARIABLEN-DEKLARATIONEN *----------------------------------------------------------------------- CHARACTER*8 ACCT INTEGER ANNN INTEGER ANZELE(1) INTEGER BPLCUR INTEGER BPLELE INTEGER COLELE INTEGER COLMAX, COLNEW INTEGER COL0LEN INTEGER COLSTD CHARACTER*8 COL0 CHARACTER*8 DDN CHARACTER*16 DETAIL CHARACTER*44 DSN INTEGER DUMMY INTEGER DUMMYA, DUMMYB, DUMMYC, DUMMYD, DUMMYE, DUMMYF CHARACTER*3 DUMMY3A, DUMMY3B CHARACTER*6 DUMMY6 CHARACTER*7 DUMMY7 CHARACTER*64 DUMMY64 CHARACTER*80 DUMMY80 REAL*8 DUMMYR8A, DUMMYR8B, DUMMYR82(2), DUMMYR84(4) INTEGER ELEMEXT CHARACTER*16 ELEMID LOGICAL*4 EOF CHARACTER*16 FILTID LOGICAL FOUND LOGICAL FORCE CHARACTER*8 GRP INTEGER I, J INTEGER ICOL *----------------------------------------------------------------------- INTEGER IEXT * 0 -> KEIN EXT.DETAIL * 1 -> EXT.DETAIL * 2 -> EXT.DETAIL ÄNDERN INTEGER ITYPP, ITYPS INTEGER KOMPBASE(1) INTEGER KOMPOFFS INTEGER KOMPTAB INTEGER LAYELE INTEGER LAYFROM, LAYTO INTEGER LDATA CHARACTER*70 LIDENA INTEGER LINDEX INTEGER KEYWLEN CHARACTER*80 KEYW * INTEGER MASTW CHARACTER*80 MODELID INTEGER N INTEGER NIDENA INTEGER NBREMOD INTEGER NBRELEM, NBRELEM2 INTEGER NBR5792 CHARACTER*8 PRJ CHARACTER*8 PWD INTEGER READY INTEGER READY2 CHARACTER*80 REST INTEGER RESTLEN INTEGER RET INTEGER*4 RETI4(12) REAL*8 RETR8(12) INTEGER*4 RETLCHAR(5) CHARACTER*80 RETCHAR(5) INTEGER SET INTEGER SETCUR INTEGER SETELE INTEGER SHOW3D INTEGER SMARTPARM INTEGER STACK, STACK2 CHARACTER*16 STANDARD CHARACTER*44 STUPDSN CHARACTER*8 STUPDDN CHARACTER*80 STUPMODEL CHARACTER*80 TEST INTEGER TESTLEN INTEGER TYPELE CHARACTER*8 USR LOGICAL WARNING INTEGER WSP, WSPCUR CHARACTER*16 WSPID INTEGER WSPTYP, WSPTYPCUR REAL*8 XMAT(12) CHARACTER*80 ZEILE INTEGER BPLANE CHARACTER*4 CBPLANE EQUIVALENCE (BPLANE, CBPLANE) INTEGER DITTO CHARACTER*4 CDITTO EQUIVALENCE (DITTO, CDITTO) INTEGER ELEM CHARACTER*4 CELEM EQUIVALENCE (ELEM, CELEM) INTEGER VIEW CHARACTER*4 CVIEW EQUIVALENCE (VIEW, CVIEW) INTEGER ANND CHARACTER*4 CANND EQUIVALENCE (ANND, CANND) *----------------------------------------------------------------------- * 'KONSTANTEN'-INITIALISIERUNG *----------------------------------------------------------------------- DATA XMAT /1., 0., 0., - 0., 1., 0., - 0., 0., 1., - 0., 0., 0./ *----------------------------------------------------------------------- * PROGRAMM-RUMPF *----------------------------------------------------------------------- * EOF = .FALSE. * READY2 = 0 * MASTW = 0 RET = 0 WARNING = .FALSE. * CATGEO-ENV. AUFBAUEN CALL CATGEO * FEHLERVAR. INITIAL. CALL RETINI *----------------------------------------------------------------------- * LOGON-PARAMETER LESEN, ANMELDUNG AN CATIA *----------------------------------------------------------------------- * WRITE(6,*) 'CATMOD2 1:' * ANMELDUNG AN CATIA CALL CLOGON (5, 6, EOF, - PRJ, GRP, USR, ACCT, PWD, - RET, *998) * NÄCHSTE PARAMETERZEILE CALL GETLINE (5, 6, EOF, ZEILE, RET, *998) *----------------------------------------------------------------------- * MODELL-PARAMETER LESEN, MODELL LESEN *----------------------------------------------------------------------- * DSN LESEN CALL GETKEYW (80, ZEILE, 4, '*DSN', EOF, - DUMMY, DUMMY80, RESTLEN, REST, RET, *998) CALL GETWORD (RESTLEN, REST, - DUMMY, DSN, RET, *998) * NÄCHSTE PARAMETERZEILE CALL GETLINE (5, 6, EOF, ZEILE, RET, *998) *----------------------------------------------------------------------- * MODELFILE ALLOKIEREN * CALL GIFDDN ('MODEL ', DSN, DDN, DUMMY6, RET, *998) CALL GIFDDN ('MODEL ', DSN, DDN, DUMMY6, RET, *108) IF (.FALSE.) THEN 108 IF (RET .NE. 233) GOTO 998 RET = 0 CALL RETINI dUMMY64 = 'CATIA.MODEL' DDN = 'MVPMTMP ' CALL G7ADEC (.FALSE., DUMMY64, - DSN, DSN(:24), - .FALSE., DDN, - RET, *998) ENDIF CALL GIFALL ('MODEL ', DDN, 'XXX', DUMMY, RET, *998) *----------------------------------------------------------------------- * MODELID LESEN CALL GETKEYW (80, ZEILE, 4, '*MOD', EOF, - DUMMY, DUMMY80, RESTLEN, REST, RET, *997) * GGF. 2. ZEILE NACHHOLEN IF (REST .EQ. ' ') THEN CALL GETLINE (5, 6, EOF, ZEILE, RET, *997) RESTLEN = 80 REST = ZEILE ENDIF CALL GETCHR (RESTLEN, REST, 70, - MODELID, RET, *997) * NÄCHSTE PARAMETERZEILE CALL GETLINE (5, 6, EOF, ZEILE, RET, *997) *----------------------------------------------------------------------- * MODELL LESEN CALL GIMSIZ (DDN, MODELID, LINDEX, LDATA, RET, *102) IF (.FALSE.) THEN 102 IF (RET .NE. 1994) GOTO 997 RET = 20110 * RETLCHAR(1) = 24 RETLCHAR(1) = 44 RETCHAR(1) = DSN RETLCHAR(2) = 70 RETCHAR(2) = MODELID CALL RETSETX ('CATMOD2 ', - 0, RETI4, - 0, RETR8, - 2, RETLCHAR, RETCHAR, - RET) GOTO 997 ENDIF * CALL GIMREA (1, DDN, MODELID, LINDEX, LDATA, RET, *102) CALL GIMREA (1, DDN, MODELID, * - LINDEX+100, LDATA+1000, RET, *102) * - INT(LINDEX*1.1)+1000, INT(LDATA*1.1)+10000, - INT(LINDEX*1.2)+1000, INT(LDATA*1.2)+10000, - RET, *102) *----------------------------------------------------------------------- * CURRENT WSP, SET, BPL HOLEN / IN MASTERWSP. UMSCHALTEN *----------------------------------------------------------------------- * CURRENT WSP HOLEN CALL GIRCUR (1, - WSPCUR, WSPTYPCUR, DUMMYA, DUMMYB, - DUMMYC, DUMMYD, RET, *996) * IN WSP. MASTER WECHSELN CALL GICMAS (1, RET, *996) * CURRENT BPLANE HOLEN CALL GIRCUR (1, - DUMMYA, DUMMYB, SETCUR, BPLCUR, - DUMMYD, DUMMYE, RET, *995) *----------------------------------------------------------------------- * BEARBEITUNGSAUFTRÄGE LESEN UND AUSFÜHREN *----------------------------------------------------------------------- FOUND = .TRUE. DO WHILE ((.NOT. EOF) .AND. (FOUND)) FOUND = .FALSE. CALL GETKEYW (80, ZEILE, 0, DUMMY80, EOF, - KEYWLEN, KEYW, RESTLEN, REST, RET, *995) *----------------------------------------------------------------------- IF ((.NOT. FOUND) .AND. - (KEYW(1:KEYWLEN) .EQ. '*ANN') ) THEN * ALTER TEXT,DIMENSION * U. ATTRIBUTE UMSETZEN FOUND = .TRUE. NBRELEM = 0 NBREMOD = 0 NBR5792 = 0 * FIRST WSP CALL GISWSP (1, 0, - WSP, WSPTYP, READY, - RET, *995) * ÜBER ALLE WSP(ELEM) DO WHILE (READY .NE. 1) * WSP WECHSELN, EXTERN? IF (WSPTYP .EQ. 1) THEN CALL GICMAS (1, RET, *995) IEXT = 0 ELSE CALL GICDET (1, WSP, RET, *995) CALL GIREXT (1, WSP, - IEXT, RET, *995) ENDIF * ELEMENTE STACKEN CALL STCKMSL (1, 22, '*DIM-*DIMN+*TXTD-*TXTN', * - 2, 0, 0, 0, - 0, 0, 0, 0, - STACK, RET, *995) CALL STCKDUP (STACK, RET, *994) CALL GUSINF (STACK, DUMMY, - NBRELEM2, RET, *994) IF (NBRELEM2 .NE. 0) THEN IF (IEXT .EQ. 1) THEN WARNING = .TRUE. * ID DES WSP HOLEN WSPID = ' ' CALL GIRIDE (1, WSP, - DUMMY, WSPID, RET, *994) WRITE (6,*) 'External Detail ', - WSPID, ' nicht modifiziert' ELSE DO J = 1,NBRELEM2 * ANND34 VOM STACK CALL GUSREA (STACK, J, - CANND, RET, *994) CALL GIRIDE (1, ANND, NIDENA, LIDENA, - RET, *994) * TEXT UND DIMENSION * KONVERTIREN CALL GYYCNV (1, ANND, ANZELE, ANNN, - RET, *109) NBREMOD = NBREMOD+1 IF (.FALSE.) THEN *109 RET = 0 109 CONTINUE IF (RET .EQ. 5792) THEN NBR5792 = NBR5792+1 ELSE CALL GILERR (RET) WARNING = .TRUE. ENDIF RET = 0 ENDIF NBRELEM = NBRELEM+1 * ATTRIBUTE ÜBERNEHMEN CALL ATTCOPY (ANND, ANNN, RET, 994) * ALTER TEXT ODER * DIMENSION LÖSCHEN CALL GIERAS (1, ANND, RET, *994) * ALTE IDENTIFIER * ÜBERNEHMEN IF (NIDENA .NE. 0) THEN CALL GICIDE (1, ANNN, NIDENA, LIDENA, - RET, *994) ENDIF * Modell komprimieren * CALL GIMTAS (1, RET, *994) CALL GIMTAS (1, RET, *111) IF (.FALSE.) THEN 111 IF (RET .NE. 202) GOTO 994 RET = 0 CALL RETINI ENDIF ENDDO ENDIF ENDIF * STACK LÖSCHEN CALL GUSEND (STACK, RET, *995) * NEXT WSP(ELEM) DUMMY = WSP CALL GISWSP (1, DUMMY, - WSP, WSPTYP, READY, - RET, *995) ENDDO IF (NBR5792 .NE. 0) - WRITE (6,*) NBR5792, ' Elemente mit RET=5792' WRITE (6,*) NBREMOD, ' von ', NBRELEM, - ' TXTD oder DIM Elementen konvertiert' * NÄCHSTE PARAMETERZEILE CALL GETLINE (5, 6, EOF, ZEILE, RET, *995) ENDIF *----------------------------------------------------------------------- IF ((.NOT. FOUND) .AND. - (KEYW(1:KEYWLEN) .EQ. '*CCV') ) THEN * CCV'S ZERLEGEN FOUND = .TRUE. * FIRST WSP CALL GISWSP (1, 0, - WSP, WSPTYP, READY, - RET, *995) DO WHILE (READY .NE. 1) * ID DES WSP HOLEN WSPID = ' ' CALL GIRIDE (1, WSP, - DUMMY, WSPID, RET, *995) * WSP WECHSELN, EXTERN? IF (WSPTYP .EQ. 1) THEN CALL GICMAS (1, RET, *995) IEXT = 0 ELSE CALL GICDET (1, WSP, RET, *995) CALL GIREXT (1, WSP, - IEXT, RET, *995) ENDIF * CCV'S STACKEN NBREMOD = 0 CALL STCKMSL(1, 4, '*CCV', - 2, 0, 0, 0, - STACK, RET, *995) CALL GUSINF (STACK, - DUMMY, NBRELEM, RET, *994) * ÜBER STACK-ELEMENTE * DO I = 1,NBRELEM I = 1 DO WHILE ((I .LE. NBRELEM) .AND. - (IEXT .NE. 2 ) ) * NEXT STACK-ELEMENT CALL GUSREA (STACK, I, CELEM, RET, *994) IF (IEXT .EQ. 1) THEN IEXT = 2 WARNING = .TRUE. ELSE NBREMOD = NBREMOD+1 * WIEVIELE KOMPONENTEN ? CALL GSNTCC (1, ELEM, N, RET, *994) * KOMP.-TAB. DYN. ALLOK. KOMPTAB = 0 CALL GIALI4 (KOMPBASE, N, - KOMPTAB, KOMPOFFS, RET, *994) * CCV AUFBRECHEN CALL GSCTCC (1, ELEM, DUMMY, - KOMPBASE(KOMPOFFS+1), RET, *993) CALL GIERAS (1, ELEM, RET, *993) * KOMP.-TAB. DEALLOK. CALL GIARES (KOMPTAB, RET, *994) ENDIF I = I+1 ENDDO * STACK LÖSCHEN CALL GUSEND (STACK, RET, *995) * PROTOKOLLIEREN IF (IEXT .EQ. 2) THEN WRITE (6,*) 'Externes Detail ', - WSPID, ' nicht modifiziert.' ELSE IF (NBREMOD .GT. 0) - WRITE (6,*) NBREMOD, - 'Composite Curves (CCV''s) in Wsp ', - WSPID, ' aufgebrochen.' ENDIF * NEXT WSP DUMMY = WSP CALL GISWSP (1, DUMMY, - WSP, WSPTYP, READY, - RET, *995) ENDDO * NÄCHSTE PARAMETERZEILE CALL GETLINE (5, 6, EOF, ZEILE, RET, *995) ENDIF *----------------------------------------------------------------------- IF ((.NOT. FOUND) .AND. - (KEYW(1:KEYWLEN) .EQ. '*COL') ) THEN * UMFÄRBEN FOUND = .TRUE. * COLMAX LESEN CALL GETINT (RESTLEN, REST, - COLMAX, RET, *103) IF (.FALSE.) THEN 103 IF (RET .NE. 20001) GOTO 995 RET = 0 CALL RETINI COLMAX = 5 ENDIF * COLNEW LESEN CALL GETINT (RESTLEN, REST, - COLNEW, RET, *104) IF (.FALSE.) THEN 104 IF (RET .NE. 20001) GOTO 995 RET = 0 CALL RETINI COLNEW = 1 ENDIF * COL0 LESEN CALL GETWORD (RESTLEN, REST, - COL0LEN, COL0, RET, *105) IF (.FALSE.) THEN 105 IF (RET .NE. 20001) GOTO 995 RET = 0 CALL RETINI COL0 = 'COLNEW' ENDIF * COL0 PRüFEN IF (COL0 .EQ. 'LAYER') THEN ELSEIF (COL0 .EQ. 'SET') THEN ELSEIF (COL0 .EQ. 'VIEW') THEN ELSEIF (COL0 .EQ. 'TYPE') THEN ELSEIF (COL0 .EQ. 'CURRENT') THEN CALL GIRMCM (1, COLSTD, RET, *995) IF (COLSTD .EQ. 1) THEN COL0 = 'SET' ELSEIF (COLSTD .EQ. 2) THEN COL0 = 'LAYER' ELSEIF (COLSTD .EQ. 3) THEN COL0 = 'TYPE' ELSEIF (COLSTD .EQ. 4) THEN COL0 = 'VIEW' ELSE RET = 20259 RETLCHAR(1) = 33 RETCHAR(1) ='STANDARD/COLOR VISUALIZATION MODE' RETLCHAR(2) = 4 WRITE (RETCHAR(2), '(I4)') COLSTD CALL RETSETX ('CATMOD2 ', - 0, RETI4, - 0, RETR8, - 2, RETLCHAR, RETCHAR, - RET) GOTO 995 ENDIF ELSEIF (COL0 .EQ. 'NONE') THEN ELSEIF (COL0 .EQ. 'COLNEW') THEN ELSE RET = 20016 RETLCHAR(1) = LEN(COL0) RETCHAR(1) = COL0 CALL RETSETX ('CATMOD2 ', - 0, RETI4, - 0, RETR8, - 1, RETLCHAR, RETCHAR, - RET) GOTO 995 ENDIF * FIRST WSP CALL GISWSP (1, 0, - WSP, WSPTYP, READY, - RET, *995) DO WHILE (READY .NE. 1) * ID DES WSP HOLEN WSPID = ' ' CALL GIRIDE (1, WSP, - DUMMY, WSPID, RET, *995) * WSP WECHSELN, EXTERN? IF (WSPTYP .EQ. 1) THEN CALL GICMAS (1, RET, *995) IEXT = 0 ELSE CALL GICDET (1, WSP, RET, *995) CALL GIREXT (1, WSP, - IEXT, RET, *995) ENDIF * ELEMENTE STACKEN NBREMOD = 0 CALL STCKMSL(1, 9, '*DRW+*SPC', - 0, 0, 0, 0, - STACK, RET, *995) CALL STCKDUP(STACK, RET, *994) CALL GUSINF (STACK, DUMMY, NBRELEM, RET, *994) * ÜBER STACK-ELEMENTE * DO I = 1,NBRELEM I = 1 DO WHILE ((I .LE. NBRELEM) .AND. - (IEXT .NE. 2) ) * NEXT STACK-ELEMENT CALL GUSREA (STACK, I, CELEM, RET, *994) * FARBE D.ELEMENTS LESEN CALL GIRVIS (1, ELEM, - DUMMYA, DUMMYB, ICOL, - DUMMYC, DUMMYD, DUMMYE, - RET, *994) * ELEM. GGF. UMFÄRBEN * IF (ICOL .GT. COLMAX) THEN IF (((COLMAX .GE. 0 ) .AND. - (ICOL .GT. COLMAX) ) .OR. - ((COLMAX .LT. 0 ) .AND. - (ICOL .EQ. -COLMAX) ) ) THEN * ELEM. HAT EIGENE FARBE IF (IEXT .EQ. 1) THEN IEXT = 2 WARNING = .TRUE. ELSE NBREMOD = NBREMOD+1 * CALL GICCOL (1, ELEM, 1, RET, *994) CALL GICCOL (1, ELEM, COLNEW, RET, *994) ENDIF ELSEIF (ICOL .EQ. 0) THEN * ELEM. IST TRANSPARENT IF (COL0 .EQ. 'LAYER') THEN * .. STANDARD: LAYER IF (IEXT .EQ. 1) THEN IEXT = 2 WARNING = .TRUE. ELSE NBREMOD = NBREMOD+1 CALL GIRLAY (1, ELEM, - LAYELE, RET, *994) IF (LAYELE .NE. 255) THEN CALL GIRMCO (1, LAYELE, 2, - COLELE, RET, *994) * IF (COLELE .GT. COLMAX) COLELE = COLNEW IF (((COLMAX .GE. 0 ) .AND. - (COLELE .GT. COLMAX) ) .OR. - ((COLMAX .LT. 0 ) .AND. - (COLELE .EQ. -COLMAX) ) ) - COLELE = COLNEW CALL GICCOL (1, ELEM, COLELE, RET, *994) ENDIF ENDIF ELSEIF (COL0 .EQ. 'SET') THEN * .. STANDARD: SET IF (IEXT .EQ. 1) THEN IEXT = 2 WARNING = .TRUE. ELSE NBREMOD = NBREMOD+1 CALL GIRSBW (1, ELEM, - DUMMYA, DUMMYB, SETELE, - DUMMYC, RET, *994) CALL GIRMCO (1, SETELE, 1, - COLELE, RET, *994) * IF (COLELE .GT. COLMAX) COLELE = COLNEW IF (((COLMAX .GE. 0 ) .AND. - (COLELE .GT. COLMAX) ) .OR. - ((COLMAX .LT. 0 ) .AND. - (COLELE .EQ. -COLMAX) ) ) - COLELE = COLNEW CALL GICCOL (1, ELEM, COLELE, RET, *994) ENDIF ELSEIF (COL0 .EQ. 'VIEW') THEN * .. STANDARD: VIEW IF (IEXT .EQ. 1) THEN IEXT = 2 WARNING = .TRUE. ELSE NBREMOD = NBREMOD+1 CALL GIRSBW (1, ELEM, - DUMMYA, DUMMYB, DUMMYC, - BPLELE, RET, *994) CALL GIRMCO (1, BPLELE, 4, - COLELE, RET, *994) * IF (COLELE .GT. COLMAX) COLELE = COLNEW IF (((COLMAX .GE. 0 ) .AND. - (COLELE .GT. COLMAX) ) .OR. - ((COLMAX .LT. 0 ) .AND. - (COLELE .EQ. -COLMAX) ) ) - COLELE = COLNEW CALL GICCOL (1, ELEM, COLELE, RET, *994) ENDIF ELSEIF (COL0 .EQ. 'TYPE') THEN * .. STANDARD: TYPE IF (IEXT .EQ. 1) THEN IEXT = 2 WARNING = .TRUE. ELSE NBREMOD = NBREMOD+1 CALL GIRTPS (1, ELEM, - TYPELE, DUMMYA, DUMMYB, - RET, *994) CALL GIRMCO (1, TYPELE, 3, - COLELE, RET, *994) * IF (COLELE .GT. COLMAX) COLELE = COLNEW IF (((COLMAX .GE. 0 ) .AND. - (COLELE .GT. COLMAX) ) .OR. - ((COLMAX .LT. 0 ) .AND. - (COLELE .EQ. -COLMAX) ) ) - COLELE = COLNEW CALL GICCOL (1, ELEM, COLELE, RET, *994) ENDIF ELSEIF (COL0 .EQ. 'NONE') THEN ELSEIF (COL0 .EQ. 'COLNEW') THEN * .. STANDARD: COLNEW IF (IEXT .EQ. 1) THEN IEXT = 2 WARNING = .TRUE. ELSE NBREMOD = NBREMOD+1 CALL GICCOL (1, ELEM, COLNEW, RET, *994) ENDIF ENDIF ENDIF I = I+1 ENDDO * STACK LÖSCHEN CALL GUSEND (STACK, RET, *995) * PROTOKOLLIEREN IF (IEXT .EQ. 2) THEN WRITE (6,*) 'Externes Detail ', - WSPID, ' nicht modifiziert.' ELSE IF (COLMAX .GE. 0) THEN WRITE (DUMMY3A, '(I3)') COLMAX WRITE (DUMMY3B, '(I3)') COLNEW IF (NBREMOD .GT. 0) - WRITE (6,*) NBREMOD, 'Elemente in Wsp ', - WSPID, ' mit Farbe grösser ', - DUMMY3A, ' in Farbe ', - DUMMY3B, ' gefärbt.' ELSE WRITE (DUMMY3A, '(I3)') -COLMAX WRITE (DUMMY3B, '(I3)') COLNEW IF (NBREMOD .GT. 0) - WRITE (6,*) NBREMOD, ' Elemente in Wsp ', - WSPID, ' mit Farbe gleich ', - DUMMY3A, ' in Farbe ', - DUMMY3B, ' gefärbt.' ENDIF ENDIF * NEXT WSP DUMMY = WSP CALL GISWSP (1, DUMMY, - WSP, WSPTYP, READY, - RET, *995) ENDDO * NÄCHSTE PARAMETERZEILE CALL GETLINE (5, 6, EOF, ZEILE, RET, *995) ENDIF *----------------------------------------------------------------------- IF ((.NOT. FOUND) .AND. - (KEYW(1:KEYWLEN) .EQ. '*DET') ) THEN * DELETE EMPTY DETAILS FOUND = .TRUE. * STACK ERZEUGEN CALL GUSINI (4, STACK, RET, *995) NBRELEM = 0 NBREMOD = 0 * FIRST WSP(ELEM) CALL GISWSP (1, 0, - ELEM, WSPTYP, READY, - RET, *994) * ÜBER ALLE WSP(ELEM) DO WHILE (READY .NE. 1) * MASTERWSP ÜBERSPR. IF (WSPTYP .NE. 1) THEN * AUF DETAIL-WSP WECHSELN CALL GICDET (1, ELEM, RET, *994) * ELEMENTE STACKEN * CALL STCKMSL (1, 9, '*DRW+*SPC', CALL STCKMSL (1, 20, '*DRW-*TRAD+*SPC-*TRA', - 0, 0, 0, 0, - STACK2, RET, *994) CALL GUSINF (STACK2, DUMMY, - NBRELEM2, RET, *992) IF (NBRELEM2 .EQ. 1) THEN * WSP(ELEM) AUF DEN STACK CALL GUSPUS (STACK, CELEM, - NBRELEM, RET, *992) ENDIF * STACK2 LÖSCHEN CALL GUSEND (STACK2, RET, *994) ENDIF * NEXT WSP(ELEM) DUMMY = ELEM CALL GISWSP (1, DUMMY, - ELEM, WSPTYP, READY, - RET, *994) ENDDO * STACK ABARBEITEN DO I = 1,NBRELEM * WSP(ELEM) VOM STACK CALL GUSREA (STACK, I, CELEM, RET, *994) * WSP(ELEM) EXTERN? CALL GIREXT (1, ELEM, - ELEMEXT, RET, *994) * ID DES WSP(ELEM) HOLEN ELEMID = ' ' CALL GIRIDE (1, ELEM, - DUMMY, ELEMID, RET, *994) * ALLE DITTOS ZU DETAIL * FIRST WORKSPACE CALL GISWSP (1, 0, - WSP, WSPTYP, READY, - RET, *994) * ÜBER ALLE WSPACES DO WHILE (READY .NE. 1) * ID DES WSP(ELEM) HOLEN WSPID = ' ' CALL GIRIDE (1, WSP, - DUMMY, WSPID, RET, *994) * AUF AKT. WSP WECHSELN, * EXTERNES DETAIL? IF (WSPTYP .EQ. 1) THEN CALL GICMAS (1, RET, *994) IEXT = 0 ELSE CALL GICDET (1, WSP, RET, *994) CALL GIREXT (1, WSP, - IEXT, RET, *994) ENDIF * DITTOS STACKEN CALL STCKOCC(1, ELEM, - STACK2, RET, *994) CALL GUSINF (STACK2, DUMMY, - NBRELEM2, RET, *992) IF (NBRELEM2 .NE. 0) THEN IF (IEXT .EQ. 1) THEN WARNING = .TRUE. WRITE (6,*) 'Externes Detail ', - WSPID, ' nicht modifiziert' ELSE * ÜBER ALLE DITTOS DO J = 1,NBRELEM2 * DITTO VOM STACK CALL GUSREA (STACK2, J, - CDITTO, RET, *992) * DITTO LÖSCHEN CALL GIERAS (1, DITTO, RET, *992) ENDDO WRITE (6,*) NBRELEM2, ' Dittos zu ', - ELEMID, ' aus Wsp ', - WSPID, ' gelöscht' ENDIF ENDIF * STACK2 LÖSCHEN CALL GUSEND (STACK2, RET, *994) * NEXT WSP DUMMY = WSP CALL GISWSP (1, DUMMY, - WSP, WSPTYP, READY, - RET, *994) ENDDO * WSP ZURÜCKSETZEN IF (WSPTYPCUR .EQ. 1) THEN CALL GICMAS (1, RET, *994) ELSE CALL GICDET (1, WSPCUR, RET, *994) ENDIF * WSP(ELEM) GGF. LÖSCHEN IF ((ELEM .NE. WSPCUR) .AND. - (ELEMEXT .NE. 1 ) ) THEN NBREMOD = NBREMOD+1 CALL GIERAS (1, ELEM, RET, *994) WRITE (6,*) 'Empty Detail ', ELEMID, ' gelöscht.' ENDIF ENDDO * STACK LÖSCHEN CALL GUSEND (STACK, RET, *994) IF (NBREMOD .GT. 0) - WRITE (6,*) NBREMOD, ' empty Details gelöscht.' * NÄCHSTE PARAMETERZEILE CALL GETLINE (5, 6, EOF, ZEILE, RET, *995) ENDIF *----------------------------------------------------------------------- IF ((.NOT. FOUND) .AND. - (KEYW(1:KEYWLEN) .EQ. '*DET-') ) THEN * Delete specific Detail FOUND = .TRUE. * FORCE? TESTLEN = RESTLEN TEST = REST CALL GETWORD (TESTLEN, TEST, - DUMMY, DUMMY80, RET, *995) IF (DUMMY80 .EQ. 'FORCE') THEN FORCE = .TRUE. RESTLEN = TESTLEN REST = TEST ELSE FORCE = .FALSE. ENDIF * DETAIL lesen CALL GETCHR (RESTLEN, REST, 16, - DETAIL, RET, *995) * Stack erzeugen CALL GUSINI (4, STACK, RET, *995) NBRELEM = 0 * First WSP(ELEM) CALL GISWSP (1, 0, - ELEM, WSPTYP, READY, - RET, *994) * Über alle WSP(ELEM) DO WHILE (READY .NE. 1) * Masterwsp überspr. IF (WSPTYP .NE. 1) THEN * Id des WSP(ELEM) holen ELEMID = ' ' CALL GIRIDE (1, ELEM, - DUMMY, ELEMID, RET, *994) IF ( (ELEMID .EQ. DETAIL) .OR. - ((FORCE) .AND. - (ELEMID(01:01) .EQ. '$' ) .AND. - (ELEMID(02:02) .GE. '1' ) .AND. - (ELEMID(02:02) .LE. '9' ) .AND. - (ELEMID(03:16) .EQ. DETAIL(1:14)) ) ) - THEN * WSP(ELEM) auf den Stack CALL GUSPUS (STACK, CELEM, - NBRELEM, RET, *994) * WRITE (6,*) ' Detail ', ELEMID, ' auf Stack gelegt.' ENDIF ENDIF * Next WSP(ELEM) DUMMY = ELEM CALL GISWSP (1, DUMMY, - ELEM, WSPTYP, READY, - RET, *994) ENDDO * Stack abarbeiten DO I = 1,NBRELEM * WSP(ELEM) vom Stack CALL GUSREA (STACK, I, CELEM, RET, *994) * Id des WSP(ELEM) holen ELEMID = ' ' CALL GIRIDE (1, ELEM, - DUMMY, ELEMID, RET, *994) * WSP(ELEM) extern? CALL GIREXT (1, ELEM, - ELEMEXT, RET, *994) IF (ELEMEXT .EQ. 1) THEN * Detail droppen CALL GICEXT (1, ELEM, - RET, *994) ENDIF * Alle Dittos zu Detail * First Workspace CALL GISWSP (1, 0, - WSP, WSPTYP, READY, - RET, *994) * Über alle Wspaces DO WHILE (READY .NE. 1) * Id des WSP(ELEM) holen WSPID = ' ' CALL GIRIDE (1, WSP, - DUMMY, WSPID, RET, *994) * Auf akt. Wsp wechseln, * Externes Detail? IF (WSPTYP .EQ. 1) THEN CALL GICMAS (1, RET, *994) IEXT = 0 ELSE CALL GICDET (1, WSP, RET, *994) CALL GIREXT (1, WSP, - IEXT, RET, *994) ENDIF * Dittos auf Stack2 CALL STCKOCC(1, ELEM, - STACK2, RET, *994) CALL GUSINF (STACK2, DUMMY, - NBRELEM2, RET, *992) IF (NBRELEM2 .NE. 0) THEN IF (IEXT .EQ. 1) THEN WARNING = .TRUE. WRITE (6,*) 'Externes Detail ', - WSPID, ' nicht modifiziert' ELSE * Über alle Dittos DO J = 1,NBRELEM2 * Ditto von Stack2 CALL GUSREA (STACK2, J, - CDITTO, RET, *992) * Ditto löschen CALL GIERAS (1, DITTO, RET, *992) ENDDO WRITE (6,*) NBRELEM2, ' Dittos zu ', - ELEMID, ' aus Wsp ', - WSPID, ' gelöscht' ENDIF ENDIF * Stack2 löschen CALL GUSEND (STACK2, RET, *994) * Next Wsp DUMMY = WSP CALL GISWSP (1, DUMMY, - WSP, WSPTYP, READY, - RET, *994) ENDDO * WSP ZURÜCKSETZEN IF (WSPTYPCUR .EQ. 1) THEN CALL GICMAS (1, RET, *994) ELSE CALL GICDET (1, WSPCUR, RET, *994) ENDIF * Detail löschen CALL GIERAS (1, ELEM, - RET, *994) ENDDO * STACK LÖSCHEN CALL GUSEND (STACK, RET, *994) IF (NBRELEM .GT. 0) - WRITE (6,*) NBRELEM, ' Details ', DETAIL, ' gelöscht.' * NÄCHSTE PARAMETERZEILE CALL GETLINE (5, 6, EOF, ZEILE, RET, *995) ENDIF *----------------------------------------------------------------------- IF ((.NOT. FOUND) .AND. - (KEYW(1:KEYWLEN) .EQ. '*DRW') ) THEN * Alle DRW-Element löschen FOUND = .TRUE. * FIRST WSP CALL GISWSP (1, 0, - WSP, WSPTYP, READY, - RET, *995) DO WHILE (READY .NE. 1) * ID DES WSP HOLEN WSPID = ' ' CALL GIRIDE (1, WSP, - DUMMY, WSPID, RET, *995) * WSP WECHSELN, EXTERN? IF (WSPTYP .EQ. 1) THEN CALL GICMAS (1, RET, *995) IEXT = 0 ELSE CALL GICDET (1, WSP, RET, *995) CALL GIREXT (1, WSP, - IEXT, RET, *995) ENDIF * DRW'S STACKEN NBREMOD = 0 * CALL STCKMSL(1, 4, '*DRW', CALL STCKMSL(1, 16, '*DRW-*AXSD-*TRAD', - 2, 0, 0, 0, - STACK, RET, *995) CALL GUSINF (STACK, - DUMMY, NBRELEM, RET, *994) * ÜBER STACK-ELEMENTE * DO I = 1,NBRELEM I = 1 DO WHILE ((I .LE. NBRELEM) .AND. - (IEXT .NE. 2 ) ) * NEXT STACK-ELEMENT CALL GUSREA (STACK, I, CELEM, RET, *994) IF (IEXT .EQ. 1) THEN IEXT = 2 WARNING = .TRUE. ELSE NBREMOD = NBREMOD+1 * Element löschen * CALL GIERAS (1, ELEM, RET, *993) CALL GIERAS (1, ELEM, RET, *116) IF (.FALSE.) THEN 116 IF (RET .NE. 417) GOTO 991 WARNING = .TRUE. * ElementType ermitteln CALL GIRTPS (1, ELEM, - ITYPP, ITYPS, DUMMY, RET, *993) WRITE (6,*) 'Protected Element ', ELEM, - ' ITYPP=', ITYPP, - ' ITYPS=', ITYPS RET = 0 CALL RETINI NBREMOD = NBREMOD-1 ENDIF ENDIF I = I+1 ENDDO * STACK LÖSCHEN CALL GUSEND (STACK, RET, *995) * PROTOKOLLIEREN IF (IEXT .EQ. 2) THEN WRITE (6,*) 'Externes Detail ', - WSPID, ' nicht modifiziert.' ELSE IF (NBREMOD .GT. 0) - WRITE (6,*) NBREMOD, - ' DRW-Elemente in Workspace ', - WSPID, ' gelöscht.' ENDIF * NEXT WSP DUMMY = WSP CALL GISWSP (1, DUMMY, - WSP, WSPTYP, READY, - RET, *995) ENDDO * NÄCHSTE PARAMETERZEILE CALL GETLINE (5, 6, EOF, ZEILE, RET, *995) ENDIF *----------------------------------------------------------------------- IF ((.NOT. FOUND) .AND. - (KEYW(1:KEYWLEN) .EQ. '*FIL') ) THEN * $-FILTER LÖSCHEN FOUND = .TRUE. * STACK ERZEUGEN CALL GUSINI (4, STACK, RET, *995) NBRELEM = 0 NBREMOD = 0 * FIRST FILTER CALL GISFIL (1, 0, - ELEM, READY, RET, *994) * ÜBER ALLE FILTER DO WHILE (READY .NE. 1) * ID DES FILTERS HOLEN FILTID = ' ' CALL GIRIDE (1, ELEM, - DUMMY, FILTID, RET, *994) * $-FILTER ? IF (FILTID(1:1) .EQ. '$') THEN * FILTER STACKEN CALL GUSPUS (STACK, CELEM, - NBRELEM, RET, *994) ENDIF * NEXT FILTER DUMMY = ELEM CALL GISFIL (1, DUMMY, - ELEM, READY, RET, *994) ENDDO * ÜBER STACK DO I = 1,NBRELEM * FILTER HOLEN CALL GUSREA (STACK, I, - CELEM, RET, *994) * FILTER LÖSCHEN NBREMOD = NBREMOD+1 CALL GIERAS (1, ELEM, RET, *994) ENDDO * PROTOKOLLIEREN IF (NBREMOD .GT. 0) - WRITE (6,*) NBREMOD, '$-Filter gelöscht.' * STACK LÖSCHEN CALL GUSEND (STACK, RET, *995) * NÄCHSTE PARAMETERZEILE CALL GETLINE (5, 6, EOF, ZEILE, RET, *995) ENDIF *----------------------------------------------------------------------- IF ((.NOT. FOUND) .AND. - (KEYW(1:KEYWLEN) .EQ. '*KIN') ) THEN * KIN-SETS LÖSCHEN FOUND = .TRUE. * ZURÜCK AUF MASTER-WSP CALL GICMAS (1, RET, *995) * STACK ERZEUGEN CALL GUSINI (4, STACK, RET, *995) NBRELEM = 0 NBREMOD = 0 * FIRST COMPLETE KIN-SET CALL GQRKUS (1, 0, - ELEM, READY, RET, *994) * ÜBER ALLE DO WHILE (READY .NE. 1) * KIN-SET STACKEN CALL GUSPUS (STACK, CELEM, - NBRELEM, RET, *994) * NEXT KIN-SET CALL GQRKUS (1, ELEM, - ELEM, READY, RET, *994) ENDDO * FIRST INCOMPLETE 2D KIN CALL GQRK2D (1, 0, - ELEM, READY, RET, *994) * ÜBER ALLE DO WHILE (READY .NE. 1) * KIN-SET STACKEN CALL GUSPUS (STACK, CELEM, - NBRELEM, RET, *994) * NEXT KIN-SET CALL GQRK2D (1, ELEM, - ELEM, READY, RET, *994) ENDDO * FIRST INCOMPLETE 3D KIN CALL GQRK3D (1, 0, - ELEM, READY, RET, *994) * ÜBER ALLE DO WHILE (READY .NE. 1) * KIN-SET STACKEN CALL GUSPUS (STACK, CELEM, - NBRELEM, RET, *994) * NEXT KIN-SET CALL GQRK3D (1, ELEM, - ELEM, READY, RET, *994) ENDDO * ÜBER STACK DO I = 1,NBRELEM * KIN-SET HOLEN CALL GUSREA (STACK, I, - CELEM, RET, *994) * KIN-SET LÖSCHEN NBREMOD = NBREMOD+1 * CALL GIERAS (1, ELEM, RET, *994) ENDDO * STACK LÖSCHEN CALL GUSEND (STACK, RET, *995) * PROTOKOLLIEREN * IF (NBREMOD .GT. 0) * - WRITE (6,*) NBREMOD, * - 'Kinematic-Sets gelöscht.' IF (NBREMOD .GT. 0) THEN WARNING = .TRUE. WRITE (6,*) 'Löschen von Kinematic-Sets nicht möglich.' ENDIF * NÄCHSTE PARAMETERZEILE CALL GETLINE (5, 6, EOF, ZEILE, RET, *995) ENDIF *----------------------------------------------------------------------- IF ((.NOT. FOUND) .AND. - (KEYW(1:KEYWLEN) .EQ. '*LAY') ) THEN * LAYERTRANSFER FOUND = .TRUE. * LAYFROM LESEN CALL GETINT (RESTLEN, REST, - LAYFROM, RET, *995) * LAYTO LESEN CALL GETINT (RESTLEN, REST, - LAYTO, RET, *995) * FIRST WSP CALL GISWSP (1, 0, - WSP, WSPTYP, READY, - RET, *995) DO WHILE (READY .NE. 1) * ID DES WSP HOLEN WSPID = ' ' CALL GIRIDE (1, WSP, - DUMMY, WSPID, RET, *995) * WSP WECHSELN, EXTERN? IF (WSPTYP .EQ. 1) THEN CALL GICMAS (1, RET, *995) IEXT = 0 ELSE CALL GICDET (1, WSP, RET, *995) CALL GIREXT (1, WSP, - IEXT, RET, *995) ENDIF * ELEMENTE STACKEN NBREMOD = 0 WRITE (DUMMY7, '(A4, I3)') '*LAY', LAYFROM CALL STCKMSL(1, 7, DUMMY7, - 0, 0, 0, 0, - STACK, RET, *995) CALL STCKDUP(STACK, RET, *994) CALL GUSINF (STACK, DUMMY, NBRELEM, RET, *994) * ÜBER STACK-ELEMENTE * DO I = 1,NBRELEM I = 1 DO WHILE ((I .LE. NBRELEM) .AND. - (IEXT .NE. 2) ) * NEXT STACK-ELEMENT CALL GUSREA (STACK, I, CELEM, RET, *994) * ELEMENT TRANSFERIEREN IF (IEXT .EQ. 1) THEN IEXT = 2 WARNING = .TRUE. ELSE NBREMOD = NBREMOD+1 CALL GICLAY (1, ELEM, - LAYTO, - RET, *100) IF (.FALSE.) THEN 100 IF (RET .NE. 27) GOTO 994 RET = 0 CALL RETINI NBREMOD = NBREMOD-1 ENDIF ENDIF I = I+1 ENDDO * STACK LÖSCHEN CALL GUSEND (STACK, RET, *995) * PROTOKOLLIEREN IF (IEXT .EQ. 2) THEN WRITE (6,*) 'Externes Detail ', - WSPID, ' nicht modifiziert.' ELSE WRITE (DUMMY3A, '(I3)') LAYFROM WRITE (DUMMY3B, '(I3)') LAYTO IF (NBREMOD .GT. 0) - WRITE (6,*) NBREMOD, 'Elemente in Wsp ', - WSPID, ' VON LAYER ', - DUMMY3A, ' AUF LAYER ', - DUMMY3B, ' TRANSFERIERT.' ENDIF * NEXT WSP DUMMY = WSP CALL GISWSP (1, DUMMY, - WSP, WSPTYP, READY, - RET, *995) ENDDO * NÄCHSTE PARAMETERZEILE CALL GETLINE (5, 6, EOF, ZEILE, RET, *995) ENDIF *----------------------------------------------------------------------- IF ((.NOT. FOUND) .AND. - (KEYW(1:KEYWLEN) .EQ. '*NCS') ) THEN * NC-SETS LÖSCHEN FOUND = .TRUE. * ZURÜCK AUF MASTER-WSP CALL GICMAS (1, RET, *995) * STACK ERZEUGEN CALL GUSINI (4, STACK, RET, *995) NBRELEM = 0 NBREMOD = 0 * FIRST NC-SET CALL GNSXST (1, 0, - ELEM, READY, RET, *994) * ÜBER ALLE NC-SETS NBREMOD = 0 DO WHILE (READY .NE. 1) * NC-SET STACKEN CALL GUSPUS (STACK, CELEM, - NBRELEM, RET, *994) * NEXT NC-SET DUMMY = ELEM CALL GNSXST (1, DUMMY, - ELEM, READY, RET, *994) ENDDO * ÜBER STACK DO I = 1,NBRELEM * NC-SET HOLEN CALL GUSREA (STACK, I, - CELEM, RET, *994) * NC-SET LÖSCHEN NBREMOD = NBREMOD+1 CALL GNERAZ (1, ELEM, RET, *994) ENDDO * PROTOKOLLIEREN IF (NBREMOD .GT. 0) - WRITE (6,*) NBREMOD, ' NC-Sets gelöscht.' * STACK LÖSCHEN CALL GUSEND (STACK, RET, *995) * NÄCHSTE PARAMETERZEILE CALL GETLINE (5, 6, EOF, ZEILE, RET, *995) ENDIF *----------------------------------------------------------------------- IF ((.NOT. FOUND) .AND. - (KEYW(1:KEYWLEN) .EQ. '*PUB') ) THEN * Solids PUBLISH setzen FOUND = .TRUE. * Wsp wechseln CALL GICMAS (1, RET, *995) * Solids stacken NBREMOD = 0 CALL STCKMSL(1, 4, '*SOL', - 2, 0, 0, 0, - STACK, RET, *995) CALL GUSINF (STACK, - DUMMY, NBRELEM, RET, *994) * Über Stack-Elemente * DO I = 1,NBRELEM I = 1 DO WHILE ((I .LE. NBRELEM) .AND. - (IEXT .NE. 2 ) ) * Next Stack-Element CALL GUSREA (STACK, I, CELEM, RET, *994) NBREMOD = NBREMOD+1 * Solid PUBLISH setzen CALL GIWPUB (1, ELEM, RET, *994) I = I+1 ENDDO * Stack löschen CALL GUSEND (STACK, RET, *995) * Protokollieren IF (NBREMOD .GT. 0) - WRITE (6,*) NBREMOD, - ' Solids in Wsp *MASTER PUBLISH gesetzt.' * Nächste Parameterzeile CALL GETLINE (5, 6, EOF, ZEILE, RET, *995) ENDIF *----------------------------------------------------------------------- IF ((.NOT. FOUND) .AND. - (KEYW(1:KEYWLEN) .EQ. '*SCA') ) THEN * MODELL SKALIEREN FOUND = .TRUE. * CATGEOS FEHLEN WARNING = .TRUE. WRITE (6,*) 'KEYWORD *SCA ignoriert.' * NÄCHSTE PARAMETERZEILE CALL GETLINE (5, 6, EOF, ZEILE, RET, *995) ENDIF *----------------------------------------------------------------------- IF ((.NOT. FOUND) .AND. - (KEYW(1:KEYWLEN) .EQ. '*SET') ) THEN * DELETE UNUSED SETS FOUND = .TRUE. * STACK ERZEUGEN CALL GUSINI (4, STACK, RET, *995) NBRELEM = 0 NBREMOD = 0 * FIRST SET CALL GISSET (1, 0, - ELEM, READY, RET, *994) * ÜBER ALLE SETS DO WHILE (READY .NE. 1) * CURRENT SET ÜBERSPR. IF (ELEM .NE. SETCUR) THEN * HAT SET EIN ELEMENT ? CALL GISELS (1, ELEM, 0, - DUMMY, READY2, RET, *994) IF (READY2 .EQ. 1) THEN * SET AUF DEN STACK CALL GUSPUS (STACK, CELEM, - NBRELEM, RET, *994) ENDIF ENDIF * NEXT SET HOLEN DUMMY = ELEM CALL GISSET (1, DUMMY, - ELEM, READY, RET, *994) ENDDO * STACK ABARBEITEN DO I = 1,NBRELEM * SET VOM STACK CALL GUSREA (STACK, I, CELEM, RET, *994) * SET LÖSCHEN NBREMOD = NBREMOD+1 * CALL GIERAS (1, ELEM, RET, *994) CALL GIERAS (1, ELEM, RET, *106) IF (.FALSE.) THEN 106 IF (RET .NE. 417) GOTO 994 RET = 0 CALL RETINI WARNING = .TRUE. WRITE (6,*) 'Set nicht gelöscht / protected Element.' NBREMOD = NBREMOD-1 ENDIF ENDDO * STACK LÖSCHEN CALL GUSEND (STACK, RET, *994) IF (NBREMOD .GT. 0) * - WRITE (6,*) NBRELEM, 'Unused Sets gelöscht.' - WRITE (6,*) NBREMOD, 'Unused Sets gelöscht.' * NÄCHSTE PARAMETERZEILE CALL GETLINE (5, 6, EOF, ZEILE, RET, *995) ENDIF *----------------------------------------------------------------------- IF ((.NOT. FOUND) .AND. - (KEYW(1:KEYWLEN) .EQ. '*SMRT') ) THEN * Solids [UN]SMART setzen FOUND = .TRUE. * SMARTPARM LESEN CALL GETINT (RESTLEN, REST, - SMARTPARM, RET, *995) * First Wsp * CALL GISWSP (1, 0, * - WSP, WSPTYP, READY, * - RET, *995) * DO WHILE (READY .NE. 1) * Id des Wsp holen * WSPID = ' ' * CALL GIRIDE (1, WSP, * - DUMMY, WSPID, RET, *995) * Wsp wechseln, extern? * IF (WSPTYP .EQ. 1) THEN CALL GICMAS (1, RET, *995) * IEXT = 0 * ELSE * CALL GICDET (1, WSP, RET, *995) * CALL GIREXT (1, WSP, * - IEXT, RET, *995) * ENDIF * Solids stacken NBREMOD = 0 CALL STCKMSL(1, 4, '*SOL', - 2, 0, 0, 0, - STACK, RET, *995) CALL GUSINF (STACK, - DUMMY, NBRELEM, RET, *994) * Über Stack-Elemente DO I = 1,NBRELEM * I = 1 * DO WHILE ((I .LE. NBRELEM) .AND. * - (IEXT .NE. 2 ) ) * Next Stack-Element CALL GUSREA (STACK, I, CELEM, RET, *994) * IF (IEXT .EQ. 1) THEN * IEXT = 2 * WARNING = .TRUE. * ELSE NBREMOD = NBREMOD+1 * IF (WSPTYP .EQ. 1) THEN * Master-Workspace * Auf Set des Solids CALL GIRSBW (1, ELEM, - DUMMYA, DUMMYB, SET, - DUMMYC, RET, *994) CALL GICSET (1, SET, RET, *994) IF (SMARTPARM .EQ. 0) THEN * Solid UNSMART setzen * CALL GBMPRB (1, ELEM, RET, *991) CALL GBMPRB (1, ELEM, RET, *112) IF (.FALSE.) THEN 112 IF (RET .NE. 3748) GOTO 991 WARNING = .TRUE. WRITE (6,*) 'Import-Solid => nicht UNSMART' RET = 0 CALL RETINI ENDIF ELSEIF (SMARTPARM .EQ. 1) THEN * Solid SMART setzen CALL GICINB (1, ELEM, RET, *991) ELSE RET = 20016 RETLCHAR(1) = 1 WRITE (RETCHAR(1), '(I1)') SMARTPARM CALL RETSETX ('CATMOD2 ', - 0, RETI4, - 0, RETR8, - 1, RETLCHAR, RETCHAR, - RET) GOTO 991 ENDIF * Set zurücksetzen CALL GICSET (1, SETCUR, RET, *994) * ELSE * Detail-Workspace * IF (SMARTPARM .EQ. 0) THEN * Solid UNSMART setzen * CALL GBMPRB (1, ELEM, RET, *991) * CALL GBMPRB (1, ELEM, RET, *113) * IF (.FALSE.) THEN * 113 IF (RET .NE. 3748) GOTO 991 * WARNING = .TRUE. * WRITE (6,*) 'Import-Solid => nicht UNSMART' * RET = 0 * CALL RETINI * ENDIF * ELSEIF (SMARTPARM .EQ. 1) THEN * Solid SMART setzen * CALL GICINB (1, ELEM, RET, *991) * ELSE * RET = 20016 * RETLCHAR(1) = 1 * WRITE (RETCHAR(1), '(I1)') SMARTPARM * CALL RETSETX ('CATMOD2 ', * - 0, RETI4, * - 0, RETR8, * - 1, RETLCHAR, RETCHAR, * - RET) * GOTO 991 * ENDIF * ENDIF * ENDIF * I = I+1 ENDDO * Stack löschen CALL GUSEND (STACK, RET, *995) * Protokollieren * IF (IEXT .EQ. 2) THEN * WRITE (6,*) 'Externes Detail ', * - WSPID, ' nicht modifiziert.' * ELSE IF (NBREMOD .GT. 0) - WRITE (6,*) NBREMOD, - ' Solids in Wsp ', - WSPID, ' [UN]SMART gesetzt.' * ENDIF * Next Wsp * DUMMY = WSP * CALL GISWSP (1, DUMMY, * - WSP, WSPTYP, READY, * - RET, *995) * ENDDO * Nächste Parameterzeile CALL GETLINE (5, 6, EOF, ZEILE, RET, *995) ENDIF *----------------------------------------------------------------------- IF ((.NOT. FOUND) .AND. - (KEYW(1:KEYWLEN) .EQ. '*SOM') ) THEN * Alle SOEs in SOMs überführen FOUND = .TRUE. * First Wsp CALL GISWSP (1, 0, - WSP, WSPTYP, READY, - RET, *995) DO WHILE (READY .NE. 1) * Id des Wsp holen WSPID = ' ' CALL GIRIDE (1, WSP, - DUMMY, WSPID, RET, *995) * Wsp wechseln, extern? IF (WSPTYP .EQ. 1) THEN CALL GICMAS (1, RET, *995) IEXT = 0 ELSE CALL GICDET (1, WSP, RET, *995) CALL GIREXT (1, WSP, - IEXT, RET, *995) ENDIF * Solids stacken NBREMOD = 0 CALL STCKMSL(1, 4, '*SOL', - 2, 0, 0, 0, - STACK, RET, *995) CALL GUSINF (STACK, - DUMMY, NBRELEM, RET, *994) * Über Stack-Elemente * DO I = 1,NBRELEM I = 1 DO WHILE ((I .LE. NBRELEM) .AND. - (IEXT .NE. 2 ) ) * Next Stack-Element CALL GUSREA (STACK, I, CELEM, RET, *994) IF (IEXT .EQ. 1) THEN IEXT = 2 WARNING = .TRUE. ELSE NBREMOD = NBREMOD+1 IF (WSPTYP .EQ. 1) THEN * Master-Workspace * Auf Set des Solids CALL GIRSBW (1, ELEM, - DUMMYA, DUMMYB, SET, - DUMMYC, RET, *994) CALL GICSET (1, SET, RET, *994) * Solid Mockup erzeugen CALL GCWSMZ (1, ELEM, XMAT, DUMMY, RET, *991) * CALL GCWSMZ (1, ELEM, XMAT, DUMMY, RET, *114) IF (.FALSE.) THEN * 114 IF (RET .NE. 3748) GOTO 991 * WARNING = .TRUE. * WRITE (6,*) 'Import-Solid => kein Mockup' * RET = 0 * CALL RETINI ELSE * Solid Exact löschen CALL GIERAS (1, ELEM, RET, *991) ENDIF * Set zurücksetzen CALL GICSET (1, SETCUR, RET, *994) ELSE * Detail-Workspace * Solid Mockup erzeugen CALL GCWSMZ (1, ELEM, XMAT, DUMMY, RET, *991) * CALL GCWSMZ (1, ELEM, XMAT, DUMMY, RET, *115) IF (.FALSE.) THEN * 115 IF (RET .NE. 3748) GOTO 991 * WARNING = .TRUE. * WRITE (6,*) 'Import-Solid => kein Mockup' * RET = 0 * CALL RETINI ELSE * Solid Exact löschen CALL GIERAS (1, ELEM, RET, *991) ENDIF ENDIF ENDIF I = I+1 ENDDO * Stack löschen CALL GUSEND (STACK, RET, *995) * Protokollieren IF (IEXT .EQ. 2) THEN WRITE (6,*) 'Externes Detail ', - WSPID, ' nicht modifiziert.' ELSE IF (NBREMOD .GT. 0) - WRITE (6,*) NBREMOD, - ' Exact Solids in Wsp ', - WSPID, ' in Mockup Solids konvertiert.' ENDIF * Next Wsp DUMMY = WSP CALL GISWSP (1, DUMMY, - WSP, WSPTYP, READY, - RET, *995) ENDDO * Nächste Parameterzeile CALL GETLINE (5, 6, EOF, ZEILE, RET, *995) ENDIF *----------------------------------------------------------------------- IF ((.NOT. FOUND) .AND. - (KEYW(1:KEYWLEN) .EQ. '*STUP') ) THEN * StartUp-Model einsetzen FOUND = .TRUE. * STANDARD lesen CALL GETWORD (RESTLEN, REST, - DUMMY, STANDARD, RET, *995) * STUPDSN lesen CALL GETWORD (RESTLEN, REST, - DUMMY, STUPDSN, RET, *995) * STUPDDN ermitteln CALL GIFDDN ('MODEL ', STUPDSN, - STUPDDN, DUMMY6, RET, *995) * STUPMODEL lesen * ggf. 2. Zeile nachholen IF (REST .EQ. ' ') THEN CALL GETLINE (5, 6, EOF, ZEILE, RET, *995) RESTLEN = 80 REST = ZEILE ENDIF CALL GETCHR (RESTLEN, REST, 70, - STUPMODEL, RET, *995) * Current Standard setzen CALL GYLINM (1, STANDARD, - RET, *995) * Startup-Model einsetzen CALL GYLSTU (1, STUPDDN, STUPMODEL, - RET, *995) WRITE (6,*) 'StartUp-Model eingesetzt.' * NÄCHSTE PARAMETERZEILE CALL GETLINE (5, 6, EOF, ZEILE, RET, *995) ENDIF *----------------------------------------------------------------------- IF ((.NOT. FOUND) .AND. - (KEYW(1:KEYWLEN) .EQ. '*VU') ) THEN * DELETE UNUSED VIEWS FOUND = .TRUE. NBREMOD = 0 * BPL-STACK ANLEGEN CALL GUSINI (4, STACK, RET, *995) NBRELEM = 0 * 1. BPLANE HOLEN CALL GISBPL (1, 0, - BPLANE, READY, RET, *994) * ÜBER ALLE BPLANES DO WHILE (READY .NE. 1) * CURRENT BPL ÜBERSPR. IF (BPLANE .NE. BPLCUR) * BPLANE STACKEN - CALL GUSPUS (STACK, CBPLANE, - NBRELEM, RET, *994) * NEXT BPLANE HOLEN DUMMY = BPLANE CALL GISBPL (1, DUMMY, - BPLANE, READY, RET, *994) ENDDO * ÜBER BPL-STACK DO I = 1,NBRELEM * BPL HOLEN CALL GUSREA (STACK, I, - CBPLANE, RET, *994) * (ACHSENKREUZ + 2.ELEM.) CALL GISELB (1, BPLANE, 0, - DUMMY, READY, RET, *994) IF (READY .NE. 1) - CALL GISELB (1, BPLANE, DUMMY, * - DUMMYA, READY, RET, *994) wg.pmr 85740 GISELB - DUMMYA, READY, RET, *994) * - DUMMYA, READY, RET, *107) * IF (.FALSE.) THEN * 107 IF (RET .NE.27) GOTO 994 * RET = 0 * CALL RETINI * WARNING = .TRUE. * WRITE (6,*) 'Bplane mit Screen-Element (pmr 85740 GISELB)' * ENDIF IF (READY .EQ. 1) THEN * VU-STACK ERZEUGEN CALL GUSINI (4, STACK2, RET, *994) NBRELEM2 = 0 * 1. VIEW ZU BPLANE CALL GISVI1 (1, BPLANE, 0, 0, - VIEW, READY, RET, *992) * ÜBER ALLE VIEWS ZU BPL. DO WHILE (READY .NE. 1) * CHARACTERISTIKA DER VU CALL GIRVIE (1, VIEW, - DUMMYA, DUMMYB, DUMMYC, - DUMMYD, DUMMYE, DUMMYR8A, - DUMMYF, DUMMYR8B, DUMMYR82, - DUMMYR84, SHOW3D, - RET, *992) * VIEW AUF DEN STACK IF (SHOW3D .EQ. 0) - CALL GUSPUS (STACK2, CVIEW, - NBRELEM2, RET, *992) * NEXT VIEW ZU BPLANE DUMMY = VIEW CALL GISVI1 (1, BPLANE, 0, DUMMY, - VIEW, READY, RET, *992) ENDDO * VU-STACK ABARBEITEN DO J = 1,NBRELEM2 * VIEW VOM STACK CALL GUSREA (STACK2, J, - CVIEW, RET, *992) * VIEW LÖSCHEN NBREMOD = NBREMOD+1 CALL GIVRAS (1, VIEW, RET, *101) IF (.FALSE.) THEN 101 IF (RET .NE. 5069) GOTO 992 WARNING = .TRUE. WRITE (6,*) 'View nicht gelöscht (RET=5069)' RET = 0 CALL RETINI ENDIF ENDDO * VU-STACK LÖSCHEN CALL GUSEND (STACK2, RET, *992) ENDIF ENDDO * BPL-STACK LÖSCHEN CALL GUSEND (STACK, RET, *994) IF (NBREMOD .GT. 0) - WRITE (6,*) NBREMOD, 'Unused Views gelöscht.' * NÄCHSTE PARAMETERZEILE CALL GETLINE (5, 6, EOF, ZEILE, RET, *995) ENDIF *----------------------------------------------------------------------- *----------------------------------------------------------------------- IF ((.NOT. FOUND) .AND. - (KEYW(1:KEYWLEN) .EQ. '*NSH') ) THEN * Elemente in NOSHOW setzen FOUND = .TRUE. * Wsp wechseln CALL GICMAS (1, RET, *995) * Space-Elemente stacken NBREMOD = 0 CALL STCKMSL(1, 9, '*SPC-*SOL', - 2, 0, 0, 0, - STACK, RET, *995) CALL GUSINF (STACK, - DUMMY, NBRELEM, RET, *994) * Über Stack-Elemente * DO I = 1,NBRELEM I = 1 DO WHILE ((I .LE. NBRELEM) .AND. - (IEXT .NE. 2 ) ) * Next Stack-Element CALL GUSREA (STACK, I, CELEM, RET, *994) NBREMOD = NBREMOD+1 * Space-Elemente in NOSHOW setzen CALL GICSHO (1, ELEM, 0, RET, *994) I = I+1 ENDDO * Stack löschen CALL GUSEND (STACK, RET, *995) * Protokollieren IF (NBREMOD .GT. 0) - WRITE (6,*) NBREMOD, - '******** Space-Elemente in NOSHOW gesetzt *********' * Nächste Parameterzeile CALL GETLINE (5, 6, EOF, ZEILE, RET, *995) ENDIF *----------------------------------------------------------------------- IF (.NOT. FOUND) THEN RET = 20017 RETLCHAR(1) = 1 RETCHAR(1) = '?' CALL RETSETX ('CATMOD2 ', - 0, RETI4, - 0, RETR8, - 1, RETLCHAR, RETCHAR, - RET) GOTO 995 ENDIF * *----------------------------------------------------------------------- * BPL UND WSP ZURÜCKSETZEN *----------------------------------------------------------------------- * IN WSP. MASTER WECHSELN CALL GICMAS (1, RET, *996) * BPL ZURÜCKSETZEN CALL GICBPL (1, BPLCUR, RET, *996) * WSP ZURÜCKSETZEN IF (WSPTYPCUR .EQ. 1) THEN CALL GICMAS (1, RET, *997) ELSE CALL GICDET (1, WSPCUR, RET, *997) ENDIF * Modell komprimieren * CALL GIMTAS (1, RET, *997) CALL GIMTAS (1, RET, *110) IF (.FALSE.) THEN 110 IF (RET .NE. 202) GOTO 997 RET = 0 CALL RETINI ENDIF ENDDO *----------------------------------------------------------------------- * MODELL SCHREIBEN, FILE DEALLOKIEREN *----------------------------------------------------------------------- * MODELL SCHREIBEN CALL GIMWRI (1, DDN, MODELID, 1, 1, RET, *997) WRITE (6,*) 'Modell ''', MODELID(1:70), '''' * WRITE (6,*) ' in File ', DSN(1:24), ' geschrieben.' WRITE (6,*) ' in File ', DSN, ' geschrieben.' * FILE FREIGEBEN CALL GIFRES (DDN, RET, *998) *----------------------------------------------------------------------- * KONTROLLAUSGABE WRITE (6,*) '*******************************' WRITE (6,*) '* CATMOD2 erfolgreich beendet *' WRITE (6,*) '*******************************' IF (WARNING) CALL STOP (4) ************************************************************************ STOP * FEHLERBEHANDLUNG * 991 CALL GICSET (1, SETCUR, DUMMY, *994) 991 IF (WSPTYP .EQ. 1) - CALL GICSET (1, SETCUR, DUMMY, *994) GOTO 994 992 CALL GUSEND (STACK2, DUMMY, *994) GOTO 994 993 CALL GIARES (KOMPTAB, DUMMY, *994) 994 CALL GUSEND (STACK, DUMMY, *995) 995 CALL GICMAS (1, DUMMY, *996) CALL GICBPL (1, BPLCUR, DUMMY, *996) 996 IF (WSPTYPCUR .EQ. 1) THEN CALL GICMAS (1, DUMMY, *997) ELSE CALL GICDET (1, WSPCUR, DUMMY, *997) ENDIF 997 CALL GIFRES (DDN, DUMMY, *998) 998 CALL RETPUSH ('CATMOD2 ', RET) CALL RETPUT ('CATMOD2 ', RET) 999 CALL STOP (8) END