File: idf2.f

package info (click to toggle)
nastran 0.1.95-2
  • links: PTS, VCS
  • area: non-free
  • in suites: bookworm, bullseye
  • size: 122,540 kB
  • sloc: fortran: 284,409; sh: 771; makefile: 324
file content (83 lines) | stat: -rw-r--r-- 2,766 bytes parent folder | download | duplicates (2)
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