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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
SUBROUTINE OPT2D (IPR,PR)
C-----
C COPY OPTP1 TO OPTP2 DATA FILE.
C CHANGE RECORD 3 WORD 1 = IABS (PID).
C WORD 4 = PLST
C WORD 5 = ALPH
C-----
REAL PR(1)
INTEGER ZCOR ,EOR ,IPR(1) ,OPTP1 ,OPTP2 ,IZ(1)
C
COMMON /BLANK/ SKP1(9),NWDSP,OPTP1,SKP3(2),OPTP2,SKP4(2),NPRW
COMMON /NAMES / NRD,NRREW,NWRT,NWREW,NEXT
COMMON /OPTPW2/ ZCOR,Z(1)
EQUIVALENCE (IZ(1),Z(1))
C
C . RECORD ZERO - COPY NAME AND 6 PARAMETERS...
C
CALL FREAD (OPTP1,Z(1),8,NEXT)
CALL FNAME(OPTP2,Z(1))
CALL WRITE (OPTP2,Z(1),8,NEXT)
C
C . RECORD ONE (POINTERS) AND TWO (ELEMENT DATA)...
C
DO 30 I = 1,2
N = ZCOR
10 EOR = NEXT
CALL READ(*20,*20,OPTP1,Z,ZCOR,0,N)
EOR = 0
20 CALL WRITE (OPTP2,Z(1),N,EOR)
IF (EOR.EQ.0) GO TO 10
30 CONTINUE
C
C . RECORD THREE - PROPERTY DATA...
C
EOR = 0
DO 40 I = 1,NPRW,NWDSP
IPR(I) = IABS(IPR(I) )
PR(I+4) = -1.0
CALL WRITE (OPTP2,IPR(I),NWDSP,EOR)
40 CONTINUE
CALL WRITE (OPTP2,0,0,NEXT)
C
C . RECORD FOUR - PLIMIT DATA...
C
CALL FREAD (OPTP1,0,0,NEXT)
N = ZCOR
50 EOR = NEXT
CALL READ(*60,*60,OPTP1,Z,ZCOR,0,N)
EOR = 0
60 CALL WRITE (OPTP2,Z(1),N,EOR)
IF (EOR.EQ.0) GO TO 50
C
CALL EOF (OPTP2)
IZ(1) = OPTP1
CALL RDTRL(IZ(1))
IZ(1) = OPTP2
CALL WRTTRL (IZ(1))
RETURN
END
|
