C PROGRAM 'LINACD' TO CONVERT THE MODEL WIREFRAME GENERATED BY THE 'SEC' C PROGRAM TO THE INPUT FORMAT FOR THE 'ACROSPIN' DISPLAY PROGRAM. C C MAIN INPUT DATA FILE READ FROM THE * EXTERNAL UNIT: C (1) 'SEC','ACD',/ C 'SEC'...NAME OF THE INPUT DATA FILE CONTAINING A MODEL WIREFRAME C GENERATED BY THE 'SEC' PROGRAM. C 'ACD'...NAME OF THE OUTPUT ASCII FILE TO BE DISPLAYED BY ACROSPIN. C /... OBLIGATORY SLASH TO ENABLE FUTURE COMPATIBLE EXTENSIONS. C C INPUT FILE 'SEC' IS DESCRIBED WITHIN THE FORTRAN77 SOURCE CODE FILE C 'MODSEC.FOR'. C C OUTPUT FILE 'DXF' SHOULD CONFORM THE REQUIREMENTS OF THE 'ACROSPIN' C PROGRAM. C C DATE: 1994, JANUARY 12 C CODED BY LUDEK KLIMES C C----------------------------------------------------------------------- C CHARACTER*80 SEC,ACD,TEXT INTEGER LINE,LAYER,ICOL,NAME,IPOINT,LPOINT,NPOINT,I * INTEGER IV REAL CART1,CART2,CART3 * REAL VALUE C C SEC,ACD... NAMES OF INPUT AND OUTPUT FILES. C TEXT...DUMMY TEXT STRING. C LINE...INDEX OF THE ISOSURFACE CORRESPONDING TO THE ISOLINE IN THE C MODEL WIREFRAME. C IV... INDEX OF THE VELOCITY ISOSURFACE CORRESPONDING TO THE C ISOLINE. C LAYER..INDEX OF THE ACROSPIN LAYER CORRESPONDING TO AN ISOSURFACE. C ICOL...INDEX OF THE ACROSPIN COLOUR OF AN ISOSURFACE. C NAME...INTEGER REPRESENTING THE NAME OF A POINT TO BE DISPLAYED. C IPOINT... LOOP VARIABLE. C LPOINT,NPOINT... RANGE OF POINTS FORMING THE ISOLINE SEGMENT C CURRENTLY BEING PROCESSED. C I... TEMPORARY STORAGE LOCATION. C CART1,CART2,CART3... CARTESIAN COORDINATES. C VALUE... VELOCITY ISOSURFACE VALUE. C C....................................................................... C C INPUT AND OUTPUT FILES: WRITE(*,'(A)') ' ENTER NAMES OF INPUT AND OUTPUT FILES: ' SEC='SEC.OUT' ACD='SEC.ACD' READ(*,*) SEC,ACD OPEN(1,FILE=SEC,STATUS='OLD') OPEN(2,FILE=ACD) WRITE(*,'(2A)') * '+CREATING: ',ACD(1:MAX0(MIN0(INDEX(ACD,' '),69),30)) C READ(1,*) (TEXT,I=1,20) NPOINT=0 C C LOOP FOR LINES: 10 CONTINUE LINE=0 TEXT='$$$$' READ(1,*,END=90) TEXT,CART1,CART2,CART3 IF(TEXT(01:04).EQ.'$$$$') THEN GO TO 90 END IF IF(TEXT(11:14).EQ.'SURF') THEN C STRUCTURAL INTERFACE: READ(TEXT(15:18),'(I4)') LINE ICOL=IABS(LINE)+9 LAYER=IABS(LINE) ELSE IF(TEXT(21:24).EQ.'ISOL') THEN C VELOCITY ISOLINE: * READ(TEXT(15:18),'(I4)') LINE * READ(TEXT(25:28),'(I4)') IV * READ(TEXT(35:40),'(F6.3)') VALUE ICOL=15 LAYER=0 ELSE IF(TEXT(01:04).EQ.'WAVE'.AND.TEXT(11:13).EQ.'RAY') THEN C RAY: READ(TEXT(05:08),'(I4)') LINE ICOL=IABS(LINE)+9 LAYER=IABS(LINE) ELSE C NOT RECOGNISED: ICOL=15 LAYER=0 END IF WRITE(2,'(''SET COLOR'',I6,'' LAYER'',I6)') ICOL,LAYER WRITE(2,'(''ENDPOINTLIST NAME X Y Z'')') LPOINT=NPOINT+1 C LOOP FOR POINTS OF THE LINE: 20 CONTINUE C CARTESIAN COORDINATES CART1=-999999. CART2=0. CART3=0. READ(1,*) CART1,CART2,CART3 IF(CART1.EQ.-999999.) THEN GO TO 31 END IF NPOINT=NPOINT+1 NAME=100000+NPOINT WRITE(TEXT,'(A,I6,3F12.6)') ' P',NAME,CART1,CART2,CART3 21 CONTINUE I=INDEX(TEXT,' .') IF(I.GT.0) THEN TEXT(I:I+1)='0.' GO TO 21 END IF 22 CONTINUE I=INDEX(TEXT,' -.') IF(I.GT.0) THEN TEXT(I:I+1)='-0.' GO TO 22 END IF WRITE(2,'(A)') TEXT(1:45) GO TO 20 31 CONTINUE WRITE(2,'(''LINELIST FROM TO'')') DO 32 IPOINT=LPOINT+1,NPOINT NAME=100000+IPOINT WRITE(2,'(2(A,I6))') ' P',NAME-1,' P',NAME 32 CONTINUE GO TO 10 C 90 CONTINUE WRITE(*,'(A)') '+CREATED: ' STOP END C C======================================================================= C