Numérotation des lignes :

1. C KPROJA SOURCE CHAT 05/01/13 01:05:08 5004
2. SUBROUTINE KPROJA(O1,XG1,XG2,X1,KF1,KC1,X2,KF2,KC2,I,SPROJA,SHC3D)
3. IMPLICIT INTEGER(I-N)
4. IMPLICIT REAL*8 (A-H,O-Z)
5. C----------------------------------------------------------------------
6. C Calcul des facteurs de forme en 3D
7. C Sp appele par Kprojf et Ksubcr
8. C
9. C PROJECTION DES ARETES
10. C ---------------------
11. C
12. C O1 : POINT SUR L'ELEMENT 1
13. C XG1: COORDONNEES GLOBALES DU SOMMET 1
14. C X1 : COORDONNEES SUR L'H.C
15. C KF1: FACE SUR L'H.C
16. C KC1: COORDONNEES ENTIERES SUR L'H.C
17. C idem point 2
18. C----------------------------------------------------------------------
19. -INC TFFOR3D
20. C
21. DIMENSION X1(3),X2(3),KC1(2),KC2(2)
22. DIMENSION IFAC(3),IGC(3,2),NCELC(3)
23. DIMENSION O1(3),X(3),XR(3),KI(2),XG1(1),XG2(1)
24. C
25. C WRITE(6,*) ' KPROJA KF ',KF1,KF2
26. C WRITE(6,*) ' KPROJA KA ',KA(KF1),KA(KF2)
27. C WRITE(6,*) ' XG1 ',XG1(1),XG1(2),XG1(3)
28. C WRITE(6,*) ' XG2 ',XG2(1),XG2(2),XG2(3)
29.
30. IF ((KA(KF1).NE.KA(KF2)).OR.(KF1.EQ.KF2)) THEN
31.
32. CALL KCALAR(NRES,X1,KF1,KC1,X2,KF2,KC2,
33. - NFAC,IFAC,IGC,NCELC,ICELC,IC,KA,IM)
34.
35. C WRITE(6,*) ' IF1 IF2 NFA ',KF(NP1),KF(NP2),NFAC KAR02020
36. C WRITE(6,*) ' X1 ',X1(1),X1(2),X1(3)
37. C WRITE(6,*) ' X2 ',X2(1),X2(2),X2(3)
38.
39. NFA(I) = NFAC
40. DO 332 J = 1,NFAC
41. IFA(J,I) = IFAC(J)
42. NCEL(J,I) = NCELC(J)
43. IG(J,1,I) = IGC(J,1)
44. IG(J,2,I) = IGC(J,2)
45. DO 334 K = 1,NCELC(J)
46. ICEL(J,1,K,I) = ICELC(J,1,K)
47. ICEL(J,2,K,I) = ICELC(J,2,K)
48. 334 CONTINUE
49. 332 CONTINUE
50.
51. ELSE
52.
53. DO 1 K=1,KES
54. X(K) = (XG1(K)+XG2(K))/2
55. 1 CONTINUE
56. C
57. II = 0
58. C WRITE(6,*) ' KA ',KA(KF1)
59. KAC = KA(KF1)
60. 10 CONTINUE
61. II = II + 1
62. C IF (II.GT.20) CALL ARRET(0)
63. C 05-90
64. IF (II.GT.20) THEN
65. RETURN
66. ENDIF
67. CALL KAPCU1(KES,X,O1,NRES,XR,KF,KI,KAC)
68. C WRITE(6,*) ' KF ',KF
69. C WRITE(6,*) ' O1 ',O1(1),O1(2),O1(3)
70.
71. IF (KF.EQ.KF1) THEN
72.
73. DO 2 K = 1,KES
74. X(K) = (X(K)+XG2(K))/2
75. 2 CONTINUE
76. GOTO 10
77. ELSE
78. IF(KF.EQ.KF2) THEN
79. DO 3 K = 1,KES
80. X(K) = (XG1(K)+X(K))/2
81. 3 CONTINUE
82. GOTO 10
83. ELSE
84.
85. C KF1 KF2 KF KFP
86. C
87. CALL KCALAR(NRES,X1,KF1,KC1,XR,KF,KI,
88. - NFAC,IFAC,IGC,NCELC,ICELC,IC,KA,IM)
89.
90. IFA(1,I) = IFAC(1)
91. NCEL(1,I) = NCELC(1)
92. IG(1,1,I) = IGC(1,1)
93. IG(1,2,I) = IGC(1,2)
94. DO 300 K = 1,NCELC(1)
95. ICEL(1,1,K,I) = ICELC(1,1,K)
96. ICEL(1,2,K,I) = ICELC(1,2,K)
97. 300 CONTINUE
98.
99. IFA(3,I) = IFAC(2)
100. NCEL(3,I) = NCELC(2)
101. IG(3,1,I) = IGC(2,1)
102. IG(3,2,I) = IGC(2,2)
103. DO 301 K = 1,NCELC(2)
104. ICEL(3,1,K,I) = ICELC(2,1,K)
105. ICEL(3,2,K,I) = ICELC(2,2,K)
106. 301 CONTINUE
107.
108. IF (NFAC.EQ.3) THEN
109. IFA(4,I) = IFAC(3)
110. NCEL(4,I) = NCELC(3)
111. IG(4,1,I) = IGC(3,1)
112. IG(4,2,I) = IGC(3,2)
113. DO 302 K = 1,NCELC(3)
114. ICEL(4,1,K,I) = ICELC(3,1,K)
115. ICEL(4,2,K,I) = ICELC(3,2,K)
116. 302 CONTINUE
117. NFA(I) = 4
118. ELSE
119. NFA(I) = 3
120. ENDIF
121.
122. ENDIF
123.
124. CALL KCALAR(NRES,X2,KF2,KC2,XR,KF,KI,
125. - NFAC,IFAC,IGC,NCELC,ICELC,IC,KA,IM)
126.
127.
128. IFA(2,I) = IFAC(1)
129. NCEL(2,I) = NCELC(1)
130. IG(2,1,I) = IGC(1,1)
131. IG(2,2,I) = IGC(1,2)
132. DO 303 K = 1,NCELC(1)
133. ICEL(2,1,K,I) = ICELC(1,1,K)
134. ICEL(2,2,K,I) = ICELC(1,2,K)
135. 303 CONTINUE
136.
137. IG(3,1,I) = (IG(3,1,I) + IGC(2,1)) /2
138. IG(3,2,I) = (IG(3,2,I) + IGC(2,2)) /2
139. C DO 304 K1 = 1,NCELC(2)-1
140.
141. DO 304 K1 = 1,NCELC(2)
142. K = K1 + NCEL(3,I)
143. ICEL(3,1,K,I) = ICELC(2,1,K1)
144. ICEL(3,2,K,I) = ICELC(2,2,K1)
145. 304 CONTINUE
146. C NCEL(3,I) = NCEL(3,I) + NCELC(2)-1
147.
148. NCEL(3,I) = NCEL(3,I) + NCELC(2)
149.
150. IF (NFAC.EQ.3) THEN
151. IF(NFA(I).EQ.3) THEN
152.
153. IFA(4,I) = IFAC(3)
154. NCEL(4,I) = NCELC(3)
155. IG(4,1,I) = IGC(3,1)
156. IG(4,2,I) = IGC(3,2)
157. DO 305 K = 1,NCELC(3)
158. ICEL(4,1,K,I) = ICELC(3,1,K)
159. ICEL(4,2,K,I) = ICELC(3,2,K)
160. 305 CONTINUE
161. NFA(I) = 4
162. ELSE
163. WRITE(6,*) ' ERREUR '
164. ENDIF
165. ENDIF
166.
167. ENDIF
168.
169. ENDIF
170.
171. C WRITE(6,*) ' VERIF ',NFA(I)
172. C NFAC = NFA(I)
173. C WRITE(6,*) ' IFA ',(IFA(I1,I),I1=1,NFAC) KAR02030
174. C WRITE(6,*) ' NCEL ',(NCEL(I1,I),I1=1,NFAC) KAR02040
175. C DO 105 I1 = 1,NFAC KAR02050
176. C WRITE(6,*) ' IG ',IG(I1,1,I),IG(I1,2,I) KAR02060
177. C WRITE(6,*) ' ICEL ',(ICEL(I1,1,K,I),K=1,NCEL(I1,I)) KAR02070
178. C WRITE(6,*) ' JCEL ',(ICEL(I1,2,K,I),K=1,NCEL(I1,I)) KAR02080
179. C105 CONTINUE
180. C WRITE(6,*) ' '
181.
182. RETURN
183. END
184.
185.
186.

© Cast3M 2003 - Tous droits réservés.
Mentions légales