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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
SUBROUTINE SUBP (I,L,LS,J,SGR,CGR,YREC,ZREC,SUM,XIC,DELX,EE,XLAM,
1 SG,CG,YS,ZS)
C
C COMPUTES ELEMENTS OF THE SUBMATRICES DPP, DPZ AND DPY
C USING SUBROUTINES SNPDF, INCRO AND SUBI
C
REAL KR,M
COMPLEX DPUR,DPUL,DPLR,DPLL,DP,SUM
DIMENSION XIC(1),DELX(1),EE(1),XLAM(1),SG(1),CG(1),YS(1),
1 ZS(1)
COMMON /AMGMN/ MCB(7),NROW,ND,NE,REFC,FMACH,KR
COMMON /DLCOM/ DUM(3),F
C
EPS = 0.00001
M = FMACH
BETA = SQRT(1.0-M*M)
FL = REFC
FLND = FLOAT(ND)
FLNE = FLOAT(NE)
SGS = SG(LS)
CGS = CG(LS)
DPUR = (0.0,0.0)
DPUL = (0.0,0.0)
DPLR = (0.0,0.0)
DPLL = (0.0,0.0)
DIJ = 0.0
DELR = 0.0
DELI = 0.0
DIJI = 0.0
DELRI= 0.0
DELII= 0.0
C
C UPPER RIGHT SENDING POINT
C
IGO = 1
TL = XLAM(J)
SQTL = SQRT(1.0+TL**2)
SL = TL/SQTL
CL = 1.0/SQTL
X = XIC(I) + F*DELX(I)
X0 = X - XIC(J)
Y0 = YREC - YS(LS)
Z0 = ZREC - ZS(LS)
ES = EE(LS)
DXS = DELX(J)
AX = X0
AY = Y0
AZ = Z0
CV = DXS
C
30 NOBI = 1
CALL SNPDF (SL,CL,TL,SGS,CGS,SGR,CGR,X0,Y0,Z0,ES,DIJ,BETA,CV)
IF (KR .LE. EPS) GO TO 40
SDELX= DXS
DELY = 2.0*ES
AX1 = AX + ES*TL
AY1 = AY + ES*CGS
AZ1 = AZ + ES*SGS
AX2 = AX - ES*TL
AY2 = AY - ES*CGS
AZ2 = AZ - ES*SGS
CALL INCRO (AX,AY,AZ,AX1,AY1,AZ1,AX2,AY2,AZ2,SGR,CGR,SGS,CGS,
1 KR,FL,BETA,SDELX,DELY,DELR,DELI)
40 CONTINUE
DP = CMPLX(((DIJ+DIJI)-(DELR +DELRI)),(-DELI-DELII))
GO TO (140,150,170,180), IGO
140 CONTINUE
DPUR = DP
C
C TEST FOR ABS(YS(LS)) .LE..001 TAKEN OUT
C
IF (ND .EQ. 0) GO TO 160
C
C UPPER LEFT SENDING POINT
C
IGO = 2
SGS =-SGS
TL =-TL
SL =-SL
Y0 = YREC + YS(LS)
AY = Y0
GO TO 30
150 CONTINUE
DPUL = DP
160 CONTINUE
IF (NE .EQ. 0) GO TO 190
C
C LOWER RIGHT SENDING POINT
C
IGO = 3
TL = XLAM(J)
SL = TL/(SQRT(1.0+TL*TL))
Y0 = YREC - YS(LS)
Z0 = ZREC + ZS(LS)
AY = Y0
AZ = Z0
SGS =-SG(LS)
GO TO 30
170 CONTINUE
DPLR = DP
IF (ND .EQ. 0) GO TO 190
C
C LOWER LEFT SENDING POINT
C
IGO = 4
SGS = SG(LS)
TL =-XLAM(J)
SL = TL/(SQRT(1.0+TL*TL))
Y0 = YREC + YS(LS)
AY = Y0
GO TO 30
180 CONTINUE
DPLL = DP
190 CONTINUE
SUM = DPUR + FLND*DPUL + FLNE*DPLR + FLND*FLNE*DPLL
RETURN
END
|
