forked from tvrusso/SPICE-2
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathunix.f
More file actions
81 lines (81 loc) · 1.96 KB
/
unix.f
File metadata and controls
81 lines (81 loc) · 1.96 KB
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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
SUBROUTINE ZERO4(ARRAY,LENGTH)
C 8 byte integer used, no real*4 used
DOUBLE PRECISION ARRAY(LENGTH)
IF(LENGTH.EQ.0) RETURN
DO 10 I=1,LENGTH
ARRAY(I)=0.0
10 CONTINUE
RETURN
END
SUBROUTINE ZERO8(ARRAY,LENGTH)
DOUBLE PRECISION ARRAY(LENGTH)
IF(LENGTH.EQ.0) RETURN
DO 10 I=1,LENGTH
ARRAY(I)=0.D0
10 CONTINUE
RETURN
END
SUBROUTINE ZERO16(ARRAY,LENGTH)
COMPLEX ARRAY(LENGTH)
IF(LENGTH.EQ.0) RETURN
DO 10 I=1,LENGTH
ARRAY(I)=(0.0,0.0)
10 CONTINUE
RETURN
END
SUBROUTINE COPY4(FROM,TO,NWORDS)
C 8 byte double used, no real*4 used
DOUBLE PRECISION FROM(1),TO(1)
IF(NWORDS.EQ.0) RETURN
IF(LOCF(FROM(1)).LT.LOCF(TO(1))) GOTO 20
DO 10 I=1,NWORDS
TO(I)=FROM(I)
10 CONTINUE
RETURN
20 I=NWORDS
30 TO(I)=FROM(I)
I=I-1
IF(I.NE.0) GOTO 30
RETURN
END
SUBROUTINE COPY8(FROM,TO,NWORDS)
DOUBLE PRECISION FROM(1),TO(1)
IF(NWORDS.EQ.0) RETURN
IF(LOCF(FROM(1)).LT.LOCF(TO(1))) GOTO 20
DO 10 I=1,NWORDS
TO(I)=FROM(I)
10 CONTINUE
RETURN
20 I=NWORDS
30 TO(I)=FROM(I)
I=I-1
IF(I.NE.0) GOTO 30
RETURN
END
SUBROUTINE COPY16(FROM,TO,NWORDS)
COMPLEX FROM(1),TO(1)
IF(NWORDS.EQ.0) RETURN
IF(LOCF(FROM(1)).LT.LOCF(TO(1))) GOTO 20
DO 10 I=1,NWORDS
TO(I)=FROM(I)
10 CONTINUE
RETURN
20 I=NWORDS
30 TO(I)=FROM(I)
I=I-1
IF(I.NE.0) GOTO 30
RETURN
END
SUBROUTINE MOVE (A,I,B,J,N)
CHARACTER*1 A(1),B(1)
C
C THIS ROUTINE MOVES N CHARACTERS FROM CHARACTER ARRAY B
C TO CHARACTER ARRAY A, BEGINNING WITH THE J*TH AND I*TH
C CHARACTER POSITIONS, RESPECTIVELY.
C
IF (N.EQ.0) RETURN
DO 10 K=1,N
A(I+K-1)=B(J+K-1)
10 CONTINUE
RETURN
END