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
|
SUBROUTINE IDF2(EE,E2, ETA01,ZET01,A2R,A2I,B2R,B2I,C2R,C2I,
1 R1SQX,DIIJR,DIIJI)
C *** INTEGRATES THE NONPLANAR PARTS OF THE INCREMENTAL
C OSCILLATORY KERNELS FOR UNSTEADY CASES
EPS = 0.0001
AZET = ABS(ZET01)
DENO = R1SQX-E2
PARN = ETA01**2 + ZET01**2
FACR = PARN*A2R + ETA01*B2R + C2R
FACI = PARN*A2I + ETA01*B2I + C2I
ETA02=ETA01**2
ZET02= ZET01**2
IF ((AZET/EE) . LE . 0.001) GO TO 120
TEST0= ABS((R1SQX-E2)/(2.0*EE*AZET))
IF (TEST0.GT.0.1) GO TO 120
DEN2 = (ETA01+EE)**2+ZET02
DEN3 = (ETA01-EE)**2+ZET02
FAC2A= R1SQX*ETA01+(ETA02-ZET02)*EE
FAC3A= R1SQX*ETA01-(ETA02-ZET02)*EE
FAC2B= R1SQX+ETA01*EE
FAC3B= R1SQX-ETA01*EE
TRM2R= (FAC2A*A2R+FAC2B*B2R+(ETA01+EE)*C2R)/DEN2
TRM2I= (FAC2A*A2I+FAC2B*B2I+(ETA01+EE)*C2I)/DEN2
TRM3R=-(FAC3A*A2R+FAC3B*B2R+(ETA01-EE)*C2R)/DEN3
TRM3I=-(FAC3A*A2I+FAC3B*B2I+(ETA01-EE)*C2I)/DEN3
IF (TEST0.LE.0.0001) GO TO 110
COEF = (2.0*EE)/(R1SQX-E2)
ARGA = COEF*ZET01
TEST = ABS(ARGA)
IF (TEST.GT.0.3) GO TO 90
S = ARGA**2
SER = 1./3.+S*(-1./5.+S*(1./7.+S*(-1./9.+S*(1./11.-S/13.))))
ALPHA= E2*(COEF**2)*SER
FUNCT= COEF*(1.0-ALPHA*(ZET01**2)/E2)
GO TO 100
90 CONTINUE
ARGT = COEF*AZET
ATANA= ATAN(ARGT)
FUNCT= ATANA/AZET
100 CONTINUE
TRM1R= FACR*FUNCT
TRM1I= FACI*FUNCT
DIIJR= (TRM1R + TRM2R + TRM3R)/(2.0*ZET02)
DIIJI= (TRM1I + TRM2I + TRM3I)/(2.0*ZET02)
GO TO 170
110 CONTINUE
FUNCT= 0.0
GO TO 100
120 CONTINUE
DENA = (ETA01+EE)**2 + ZET01**2
DENB = (ETA01-EE)**2 + ZET01**2
UP1R = 2.0*(E2*A2R + C2R)
UP1I = 2.0*(E2*A2I + C2I)
UP2R = 4.0*E2*ETA01*B2R
UP2I = 4.0*E2*ETA01*B2I
TRM1R= (UP1R *(R1SQX+E2) + UP2R )/(DENA*DENB)
TRM1I= (UP1I *(R1SQX+E2) + UP2I )/(DENA*DENB)
IF ((AZET/EE) . LE . 0.001) GO TO 130
COEF = (2.0*EE)/(R1SQX-E2)
ARGA = COEF*ZET01
TEST = ABS(ARGA)
IF (TEST.GT.0.3) GO TO 125
S = ARGA**2
SER = 1./3.+S*(-1./5.+S*(1./7.+S*(-1./9.+S*(1./11.-S/13.))))
ALPHA= E2*(COEF**2)*SER
FUNCT= COEF*(1.0-ALPHA*(ZET01**2)/E2)
GO TO 140
125 CONTINUE
ARGT= COEF*AZET
ATANA= ATAN(ARGT)
FUNCT= ATANA/AZET
ALPHA= (E2/ZET02)*(1.0-FUNCT*(DENO/(2.0*EE)))
GO TO 140
130 CONTINUE
ALPHA= ((2.0*E2)/(ETA02-E2))**2
140 CONTINUE
TRM2R= -ALPHA*FACR/E2
TRM2I= -ALPHA*FACI/E2
DIIJR= EE*(TRM1R + TRM2R)/DENO
DIIJI= EE*(TRM1I + TRM2I)/DENO
170 CONTINUE
RETURN
END
|