Télécharger nlocsb.eso

Retour à la liste

Numérotation des lignes :

  1. C NLOCSB SOURCE PV 15/04/10 21:15:23 8474
  2. C_______________________________________________________________________
  3. C
  4. C CALCUL DE LA MOYENNE NONLOCALE BASEE SUR L'ETAT DE CONTRAINTE
  5. C
  6. C
  7. C Entrees:
  8. C ________
  9. C
  10. C IPCHI Pointeur sur un MCHAML de ss-type indifferent
  11. C IPLMOT Pointeur sur un LISTMOTS de noms de composante
  12. C
  13. C IPCHCO Pointeur sur un MCHAML de Connectivite
  14. C (ss-type CONNECTIVITE NON LOCAL)
  15. C
  16. C Sorties:
  17. C ________
  18. C
  19. C IPCHO Pointeur sur un MCHAML de meme ss-type que IPCHI
  20. C avec les composantes IPLMOT moyennees
  21. C les composantes non reconnues dans iplmot sont
  22. C recopiees
  23. C
  24. C IRET 1 ou 0 suivant succes ou pas
  25. C
  26. C
  27. C Appele par: NLOCAL
  28. C -----------
  29. C
  30. C Appel a:
  31. C --------
  32. C
  33. C NLOVEP verification et preparation de la moyenne
  34. C TRTRVE point translate
  35. C TRSYPT point symetrique par rapport a un point
  36. C TRSYDR point symetrique par rapport a une droite
  37. C TRSYPL point symetrique par rapport a un plan
  38. C DOXE, JACOBI
  39. C
  40. C C.GIRY F.DUFOUR VERSION PRENANT EN COMPTE L'ETAT DE CONTRAINTE
  41. C SEPTEMBRE 2010
  42. C
  43. C NONLOCAL ORIGINAL
  44. C P.PEGON OCTOBRE 92 D'APRES C. LA BORDERIE AVRIL 1992 D'APRES P. PEGON
  45. C_______________________________________________________________________
  46. C
  47. SUBROUTINE NLOCSB(IPCHI,IPLMOT,IPCHCO, IPCHO, IRET)
  48.  
  49. IMPLICIT INTEGER(I-N)
  50. IMPLICIT REAL*8(A-H,O-Z)
  51. C
  52. -INC CCOPTIO
  53. C
  54. -INC SMMODEL
  55. -INC SMELEME
  56. -INC SMCOORD
  57. -INC SMCHAML
  58. -INC SMLENTI
  59. -INC SMLREEL
  60. -INC SMLMOTS
  61. -INC SMINTE
  62. -INC CCREEL
  63.  
  64. SEGMENT,WRK1
  65. REAL*8 XE(3,NBNN)
  66. ENDSEGMENT
  67. *
  68. SEGMENT NLOC1
  69. INTEGER ILOC2 (NZONEF)
  70. END SEGMENT
  71. *
  72. SEGMENT NLOC2
  73. INTEGER MPCHAM (NDOUBL)
  74. INTEGER ILOC4 (NDOUBL)
  75. INTEGER MODLAC,MAILEF,MINTEF
  76. INTEGER MAILAC (NSZACC)
  77. INTEGER MINTAC (NSZACC)
  78. INTEGER ILOC3 (NSZACC)
  79. INTEGER ILOC3I,ILOC3O
  80. INTEGER MELCAR
  81. END SEGMENT
  82. *
  83. SEGMENT NLOC3
  84. INTEGER MELVAC (NCOMP)
  85. END SEGMENT
  86. *
  87. SEGMENT NLOC4
  88. INTEGER JCLE
  89. REAL*8 PT1(3),PT2(3),DISP
  90. INTEGER MELPNI,MELPLI
  91. END SEGMENT
  92. *
  93. SEGMENT,WRK2
  94. REAL*8 XEJ(3,NBNJ),SHP(6,NBNJ)
  95. ENDSEGMENT
  96. *
  97. SEGMENT WRK3
  98. REAL*8 SOMCOM(NCOMP,NBPGAU)
  99. REAL*8 SOMJAC( NBPGAU)
  100. END SEGMENT
  101. *
  102. POINTEUR MLCOMP.MLENTI
  103. POINTEUR MLNIMO.MLENTI
  104. C
  105. DIMENSION XXX(3),XXXJ(3),XXXV1(3),XXXV2(3),XXXV3(3),PTO(3)
  106. C
  107. DATA XMULTL/1.5/
  108. C
  109. REAL*8 N2VEC2,NVEC2
  110. REAL*8 N2VECPO2,NVECPO2
  111. C
  112. NHRM=NIFOUR
  113. IRET=1
  114. C
  115. C ON VERIFIE/PREPARE LES DONNEES
  116. C
  117. CALL NLOVEP(IPCHCO,IPCHI,IPLMOT, IPCHO,NLOC1, IRET)
  118. IF (IRET.EQ.0) RETURN
  119. C
  120. C ON TRAITE L'INFORMATION
  121. C
  122. C BOUCLE SUR LES ZONES EFFECTIVES
  123. C
  124. NZONEF=ILOC2(/1)
  125. C
  126. DO ISOUCF=1,NZONEF
  127. C
  128. C write(IOIMP,*)'ZONE EFFECTIVE',ISOUCF
  129. NLOC2=ILOC2(ISOUCF)
  130. MINTE1=MINTEF
  131. IPT1=MAILEF
  132. NDOUBL=ILOC4(/1)
  133. NLOC3=ILOC3I
  134. NCOMP=MELVAC(/1)
  135. C
  136. C NOMBRE DE POINTS DE GAUSS PAR ELEMENTS POUR LA SS ZONE A MOYENNER
  137. C
  138. NBPGAU=MINTE1.POIGAU(/1)
  139. C
  140. C NOMBRE D'ELEMENTS ET DE NOEUDS POUR LA SS ZONE A MOYENNER
  141. C
  142. NBELEM=IPT1.NUM(/2)
  143. NBNN =IPT1.NUM(/1)
  144. SEGINI WRK1
  145. SEGINI WRK3
  146. C
  147. C DEBUT DE LA BOUCLE SUR LES ELEMENTS
  148. C
  149. DO IB=1,NBELEM
  150. C write(IOIMP,*)' ELEMENT NUMERO',IB
  151. C
  152. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  153. C
  154. CALL DOXE(XCOOR,IDIM,NBNN,IPT1.NUM,IB,XE)
  155. C
  156. C INITIALISATION DES DIVERSES INTEGRATIONS
  157. C
  158. DO IGAU=1,NBPGAU
  159. SOMJAC(IGAU)=0.D0
  160. DO IE1=1,NCOMP
  161. SOMCOM(IE1,IGAU)=0.D0
  162. END DO
  163. END DO
  164. C
  165. C ON BOUCLE SUR LES DOUBLONS
  166. C
  167. DO IDOUBL=1,NDOUBL
  168. NLOC4=ILOC4(IDOUBL)
  169. ICLE=JCLE
  170. C
  171. C ON RECUPERE LE NUMERO D'ORDRE DES SOUS ZONES ACCESSIBLES
  172. C
  173. MELVAL=MELPNI
  174. MLNIMO=IELCHE(1,IB)
  175. C write(IOIMP,*)' DOUBLON ICLE MLNIMO ',IDOUBL,ICLE,MLNIMO
  176. C
  177. C CET ELEMENT EST IL EN CONNECTIVITE ?
  178. C
  179. IF (MLNIMO.NE.0)THEN
  180. SEGACT,MLNIMO
  181. C
  182. C ON RECUPERE LA LISTE DES ELEMENTS ACCESSIBLES DANS
  183. C LE CHAMELEM DE CONNECTIVITE
  184. C
  185. MELVAL=MELPLI
  186. MLENTI=IELCHE(1,IB)
  187. SEGACT,MLENTI
  188. C
  189. C ON CREE UN MLENT1 QUI PERMETTRA DE TROUVER LE DEBUT DE L'INFORMATION
  190. C CONCERNANT CHAQUE SS ZONE
  191. C
  192. JG=1
  193. SEGINI MLENT1
  194. MLENT1.LECT(1)=1
  195. NSOUSA=MLNIMO.LECT(/1)
  196. IF (NSOUSA.GT.1)THEN
  197. DO IISOUJ=2,NSOUSA
  198. JG=MLENT1.LECT(/1)+1
  199. SEGADJ MLENT1
  200. MLENT1.LECT(JG)=MLENT1.LECT(JG-1)+
  201. 1 LECT(MLENT1.LECT(JG-1))+1
  202. END DO
  203. ENDIF
  204. C
  205. C DEBUT DE LA BOUCLE SUR LES PTS D'INTEGRATION
  206. C
  207. DO IGAU=1,NBPGAU
  208. C
  209. C ON RECUPERE LA LONGUEUR CARACTERISTIQUE
  210. C
  211. MELVAL=MELCAR
  212. XLONG=VELCHE(MIN(IGAU,VELCHE(/1)),MIN(IB,VELCHE(/2)))
  213. C write(IOIMP,*)' GAUSS-P,XLONG ',IGAU,XLONG
  214. C
  215. C ON CHERCHE LA POSITION ABSOLUE DU POINT D"INTEGRATION
  216. C
  217. DO IE1=1,3
  218. r_z = 0.D0
  219. DO IE2=1,NBNN
  220. r_z=r_z+XE(IE1,IE2)*MINTE1.SHPTOT(1,IE2,IGAU)
  221. END DO
  222. XXX(IE1)=r_z
  223. END DO
  224. C write(IOIMP,*)' XXX ',XXX
  225. C
  226. C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES ACCESSIBLES
  227. C
  228. DO IISOUJ=1,NSOUSA
  229. IISOUS=MLNIMO.LECT(IISOUJ)
  230. NLOC3=ILOC3(IISOUS)
  231. IPT2=MAILAC(IISOUS)
  232. MINTE2=MINTAC(IISOUS)
  233. C
  234. NBPGAJ=MINTE2.POIGAU(/1)
  235. NBNJ =IPT2.NUM(/1)
  236. C
  237. IG1=MLENT1.LECT(IISOUJ)
  238. NBELEJ=LECT(IG1)
  239. C write(IOIMP,*)' ZONES-AC,IISOUS ',IISOUJ,IISOUS
  240. C
  241. C DEBUT DE LA BOUCLE SUR LES ELEMENTS ACCESSIBLES
  242. C
  243. SEGINI,WRK2
  244. DO IIBJ=1,NBELEJ
  245. IG1=IG1+1
  246. IBJ=LECT(IG1)
  247. C write(IOIMP,*)' ELEMENT_AC ',IBJ
  248. C
  249. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IIBJ
  250. C
  251. CALL DOXE(XCOOR,IDIM,NBNJ,IPT2.NUM,IBJ,XEJ)
  252. C
  253. C DEBUT DE LA BOUCLE SUR LES PTS D'INTEGRATION
  254. C
  255. DO IGAUJ=1,NBPGAJ
  256. C
  257. C ON CHERCHE LA POSITION ABSOLUE DU POINT D"INTEGRATION
  258. C
  259. DO IE1=1,3
  260. r_z = 0.D0
  261. DO IE2=1,NBNJ
  262. r_z = r_z + XEJ(IE1,IE2) *
  263. & MINTE2.SHPTOT(1,IE2,IGAUJ)
  264. END DO
  265. XXXJ(IE1)=r_z
  266. END DO
  267. C write(IOIMP,*)' GAUSS-AC ',IGAUJ
  268. C write(IOIMP,*)' XXXJ-AS ',XXXJ
  269. C
  270. C ON TRANSFORME CES COORDONNEES EN FONCTION DES SYMETRIE OU DE LA
  271. C TRANSLATION
  272. C
  273. C+CG
  274. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  275. C
  276. C MODIFICATIONS POUR LA SYMMETRIE
  277. C
  278. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  279. DO IE1=1,3
  280. PTO(IE1)=0.D0
  281. PTO(IE1)=0.D0
  282. PTO(IE1)=0.D0
  283. END DO
  284. DZERO=0.D0
  285. IF(ICLE.EQ.2)CALL TRTRVE(XXXJ,1,PT1 )
  286. IF(ICLE.EQ.3)CALL TRSYPT(XXXJ,1,PT1 )
  287. IF(ICLE.EQ.4)CALL TRSYDR(XXXJ,1,PT1,PT2 )
  288. IF(ICLE.EQ.5)CALL TRSYPL(XXXJ,1,PT1,DISP)
  289. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  290. C write(IOIMP,*)' XXXJ-PS ',XXXJ
  291. C
  292. C ON REMPLIT LES SHP
  293. C
  294. DO IE1=1,6
  295. DO IE2=1,NBNJ
  296. SHP(IE1,IE2)=MINTE2.SHPTOT(IE1,IE2,IGAUJ)
  297. END DO
  298. END DO
  299. C
  300. C ON CALCULE LE JACOBIEN
  301. C
  302. CALL JACOBI(XEJ,SHP,IDIM,NBNJ,DJAC)
  303. C
  304. C ON CALCULE LA VALEUR DE LA GAUSSIENNE
  305. C
  306. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  307. C
  308. C NONLOCAL BASE SUR L'ETAT DE CONTRAINTE
  309. C CG FD
  310. C
  311. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  312. C CHAMP PIC TRACTION FT
  313. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  314. MELVAL=MELVAC(14)
  315. IBMN=MIN(IBJ ,VELCHE(/2))
  316. IGMN=MIN(IGAUJ,VELCHE(/1))
  317. FT1 = VELCHE(IGMN,IBMN)
  318. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  319. C CHAMP TAILLE MINIMALE ELEMENT
  320. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  321. MELVAL=MELVAC(15)
  322. IBMN=MIN(IBJ ,VELCHE(/2))
  323. IGMN=MIN(IGAUJ,VELCHE(/1))
  324. TAL1 = VELCHE(IGMN,IBMN)
  325. TAI1 = TAL1
  326. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  327. C CONTRAINTE PRINCIPALE I
  328. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  329. MELVAL=MELVAC(2)
  330. IBMN=MIN(IBJ ,VELCHE(/2))
  331. IGMN=MIN(IGAUJ,VELCHE(/1))
  332. COEFI=VELCHE(IGMN,IBMN)
  333. COEFIB=FT1*TAI1/XLONG
  334. IF(ABS(COEFI).LE.COEFIB) THEN
  335. COEFI=COEFIB
  336. ENDIF
  337. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  338. C VECTEUR PRINCIPAL I
  339. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  340. MELVAL=MELVAC(5)
  341. IBMN=MIN(IBJ ,VELCHE(/2))
  342. IGMN=MIN(IGAUJ,VELCHE(/1))
  343. COX1=VELCHE(IGMN,IBMN)
  344. MELVAL=MELVAC(6)
  345. IBMN=MIN(IBJ ,VELCHE(/2))
  346. IGMN=MIN(IGAUJ,VELCHE(/1))
  347. COY1=VELCHE(IGMN,IBMN)
  348. MELVAL=MELVAC(7)
  349. IBMN=MIN(IBJ ,VELCHE(/2))
  350. IGMN=MIN(IGAUJ,VELCHE(/1))
  351. COZ1=VELCHE(IGMN,IBMN)
  352. IF(ICLE.EQ.4) THEN
  353. XXXV1(1)=COX1
  354. XXXV1(2)=COY1
  355. XXXV1(3)=COZ1
  356. CALL TRSYDR(XXXV1,1,PTO,PT2)
  357. COX1=XXXV1(1)
  358. COY1=XXXV1(2)
  359. COZ1=XXXV1(3)
  360. ENDIF
  361. IF(ICLE.EQ.5) THEN
  362. XXXV1(1)=COX1
  363. XXXV1(2)=COY1
  364. XXXV1(3)=COZ1
  365. CALL TRSYPL(XXXV1,1,PT1,DZERO)
  366. COX1=XXXV1(1)
  367. COY1=XXXV1(2)
  368. COZ1=XXXV1(3)
  369. ENDIF
  370. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  371. C CONTRAINTE PRINCIPALE II
  372. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  373. MELVAL=MELVAC(3)
  374. IBMN=MIN(IBJ ,VELCHE(/2))
  375. IGMN=MIN(IGAUJ,VELCHE(/1))
  376. COEFJ=VELCHE(IGMN,IBMN)
  377. COEFJB=FT1*TAI1/XLONG
  378. IF(ABS(COEFJ).LE.COEFJB) THEN
  379. COEFJ=COEFJB
  380. ENDIF
  381. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  382. C VECTEUR PRINCIPAL II
  383. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  384. MELVAL=MELVAC(8)
  385. IBMN=MIN(IBJ ,VELCHE(/2))
  386. IGMN=MIN(IGAUJ,VELCHE(/1))
  387. COX2=VELCHE(IGMN,IBMN)
  388. MELVAL=MELVAC(9)
  389. IBMN=MIN(IBJ ,VELCHE(/2))
  390. IGMN=MIN(IGAUJ,VELCHE(/1))
  391. COY2=VELCHE(IGMN,IBMN)
  392. MELVAL=MELVAC(10)
  393. IBMN=MIN(IBJ ,VELCHE(/2))
  394. IGMN=MIN(IGAUJ,VELCHE(/1))
  395. COZ2=VELCHE(IGMN,IBMN)
  396. IF(ICLE.EQ.4) THEN
  397. XXXV2(1)=COX2
  398. XXXV2(2)=COY2
  399. XXXV2(3)=COZ2
  400. CALL TRSYDR(XXXV2,1,PTO,PT2)
  401. COX2=XXXV2(1)
  402. COY2=XXXV2(2)
  403. COZ2=XXXV2(3)
  404. ENDIF
  405. IF(ICLE.EQ.5) THEN
  406. XXXV2(1)=COX2
  407. XXXV2(2)=COY2
  408. XXXV2(3)=COZ2
  409. CALL TRSYPL(XXXV2,1,PT1,DZERO)
  410. COX2=XXXV2(1)
  411. COY2=XXXV2(2)
  412. COZ2=XXXV2(3)
  413. ENDIF
  414. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  415. C CONTRAINTE PRINCIPALE III
  416. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  417. MELVAL=MELVAC(4)
  418. IBMN=MIN(IBJ ,VELCHE(/2))
  419. IGMN=MIN(IGAUJ,VELCHE(/1))
  420. COEFK=VELCHE(IGMN,IBMN)
  421. COEFKB=FT1*TAI1/XLONG
  422. IF(ABS(COEFK).LE.COEFKB) THEN
  423. COEFK=COEFKB
  424. ENDIF
  425. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  426. C VECTEUR PRINCIPAL III
  427. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  428. MELVAL=MELVAC(11)
  429. IBMN=MIN(IBJ ,VELCHE(/2))
  430. IGMN=MIN(IGAUJ,VELCHE(/1))
  431. COX3=VELCHE(IGMN,IBMN)
  432. MELVAL=MELVAC(12)
  433. IBMN=MIN(IBJ ,VELCHE(/2))
  434. IGMN=MIN(IGAUJ,VELCHE(/1))
  435. COY3=VELCHE(IGMN,IBMN)
  436. MELVAL=MELVAC(13)
  437. IBMN=MIN(IBJ ,VELCHE(/2))
  438. IGMN=MIN(IGAUJ,VELCHE(/1))
  439. COZ3=VELCHE(IGMN,IBMN)
  440. IF(ICLE.EQ.4) THEN
  441. XXXV3(1)=COX3
  442. XXXV3(2)=COY3
  443. XXXV3(3)=COZ3
  444. CALL TRSYDR(XXXV3,1,PTO,PT2)
  445. COX3=XXXV3(1)
  446. COY3=XXXV3(2)
  447. COZ3=XXXV3(3)
  448. ENDIF
  449. IF(ICLE.EQ.5) THEN
  450. XXXV3(1)=COX3
  451. XXXV3(2)=COY3
  452. XXXV3(3)=COZ3
  453. CALL TRSYPL(XXXV3,1,PT1,DZERO)
  454. COX3=XXXV3(1)
  455. COY3=XXXV3(2)
  456. COZ3=XXXV3(3)
  457. ENDIF
  458. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  459. C CALCUL DE L'ANGLE ENTRE U1 ET (X-S)u1u2
  460. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  461. VEC11=((XXX(2)-XXXJ(2))*COZ3)-
  462. 1 ((XXX(3)-XXXJ(3))*COY3)
  463. VEC12=((XXX(3)-XXXJ(3))*COX3)-
  464. 1 ((XXX(1)-XXXJ(1))*COZ3)
  465. VEC13=((XXX(1)-XXXJ(1))*COY3)-
  466. 1 ((XXX(2)-XXXJ(2))*COX3)
  467. VEC21=(COY3*VEC13)- (COZ3*VEC12)
  468. VEC22=(COZ3*VEC11)- (COX3*VEC13)
  469. VEC23=(COX3*VEC12)- (COY3*VEC11)
  470. N2VEC2=(VEC21**2)+(VEC22**2)+(VEC23**2)
  471. NVEC2=SQRT(N2VEC2)
  472. CTETA=((COX1*VEC21)+(COY1*VEC22)+(COZ1*VEC23))
  473. 1 /(NVEC2 +10.E-10)
  474. STETA=((COX2*VEC21)+(COY2*VEC22)+(COZ2*VEC23))
  475. 1 /(NVEC2 +10.E-10)
  476. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  477. C CALCUL DE L'ANGLE ENTRE U3 ET (X-S)
  478. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  479. VECPO1=(XXX(1)-XXXJ(1))
  480. VECPO2=(XXX(2)-XXXJ(2))
  481. VECPO3=(XXX(3)-XXXJ(3))
  482. N2VECPO2=(VECPO1**2)+(VECPO2**2)+(VECPO3**2)
  483. NVECPO2=SQRT(N2VECPO2)
  484. CPHI=((COX3*VECPO1)+(COY3*VECPO2)+(COZ3*VECPO3))
  485. 1 /(NVECPO2 +10.E-10)
  486. SPHI=((VECPO1*VEC21)+(VECPO2*VEC22)+
  487. 1 (VECPO3*VEC23))/((NVEC2*NVECPO2) +10.E-10)
  488. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  489. C CORRECTION POUR PRENDRE EN COMPTE LE CAS OU SEUL SIGMA1 EST NON
  490. C NUL
  491. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  492. XXLONG1=XLONG*COEFI/FT1
  493. XXLONG2=XLONG*COEFJ/FT1
  494. XXLONG3=XLONG*COEFK/FT1
  495. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  496. C CALCUL DU RAYON D'INTERACTION
  497. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  498. COEF1=((SPHI**2)*(CTETA**2))/(XXLONG1**2)
  499. COEF2=((SPHI**2)*(STETA**2))/(XXLONG2**2)
  500. COEF3=(CPHI**2)/(XXLONG3**2)
  501. PHOLC=(COEF1+COEF2+COEF3)
  502. if (abs(pholc).lt.xpetit) pholc=xpetit
  503. PHOLC=(1)/pholc
  504. IF(PHOLC.GE.XLONG)THEN
  505. PHOLC=XLONG
  506. ENDIF
  507. C write(IOIMP,*)' XXLONG,DJAC ',XXLONG,DJAC
  508. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  509. C SELECTION D'UNE ZONE AUTOUR DU POINT DE GAUSS
  510. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  511. IF(NVECPO2.LE.XMULTL*XLONG)THEN
  512. GDEX=EXP(-(2*NVECPO2)**2/PHOLC )
  513. DJAC=MINTE2.POIGAU(IGAUJ)*GDEX*ABS(DJAC)
  514. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  515. C modif NCOMP
  516. DO IE1=1,1
  517. MELVAL=MELVAC(IE1)
  518. C
  519. C ON DOIT RETROUVER LE NUMERO D'ELEMENT ATTACHE AU CHAMELEM
  520. C CORRESPONDANT A CELUI DU MELEME
  521. C
  522. IBMN=MIN(IBJ ,VELCHE(/2))
  523. IGMN=MIN(IGAUJ,VELCHE(/1))
  524. SOMCOM(IE1,IGAU)=SOMCOM(IE1,IGAU)
  525. 1 +VELCHE(IGMN,IBMN)*DJAC
  526. C write(IOIMP,*)' VELCHE,DJAC ',VELCHE(IGMN,IBMN),DJAC
  527. END DO
  528. SOMJAC(IGAU)=SOMJAC(IGAU)+DJAC
  529. ENDIF
  530. C
  531. C FIN DE LA BOUCLE SUR LES PTS D'INTEGRATION
  532. C
  533. END DO
  534. C
  535. C FIN DE LA BOUCLE SUR LES ELEMENTS ACCESSIBLES
  536. C
  537. END DO
  538. C
  539. SEGSUP,WRK2
  540. C
  541. C FIN DE LA BOUCLE SUR LES DIFFERENTES ZONES ACCESSIBLES
  542. C
  543. END DO
  544. C
  545. C FIN DE LA BOUCLE SUR LES PTS D'INTEGRATION
  546. C
  547. END DO
  548. SEGDES MLENTI
  549. SEGDES MLNIMO
  550. SEGSUP MLENT1
  551. C
  552. C FIN DU TEST D'EXISTENCE DE CONNECTIVITE SUR L'ELEMENT
  553. C
  554. ENDIF
  555. C
  556. C FIN DE LA BOUCLE SUR LES DOUBLONS
  557. C
  558. END DO
  559. C
  560. NLOC3=ILOC3O
  561. DO IE1=1,1
  562. MELVAL=MELVAC(IE1)
  563. SEGACT MELVAL*MOD
  564. DO IGAU=1,NBPGAU
  565. VELCHE(IGAU,IB)=SOMCOM(IE1,IGAU)/SOMJAC(IGAU)
  566. END DO
  567. END DO
  568. C
  569. C FIN DE LA BOUCLE SUR LES ELEMENTS
  570. C
  571. END DO
  572. C
  573. SEGSUP WRK1,WRK3
  574. C
  575. C FIN DE LA BOUCLE SUR LES SOUS ZONES EFFECTIVES
  576. C
  577. END DO
  578. C
  579. C DESACTIVATIONS/SUPRESSION
  580. C WARNING SUR LES DOUBLONS DE MODEL!
  581. C
  582. DO IZONEF=1,NZONEF
  583. NLOC2=ILOC2(IZONEF)
  584. NDOUBL=ILOC4(/1)
  585. DO IDOUBL=1,NDOUBL
  586. NLOC4=ILOC4(IDOUBL)
  587. MELVAL=MELPNI
  588. SEGDES,MELVAL
  589. MELVAL=MELPLI
  590. SEGDES,MELVAL
  591. SEGSUP,NLOC4
  592. ENDDO
  593. NSZACC=ILOC3(/1)
  594. DO ISZACC=1,NSZACC
  595. NLOC3=ILOC3(ISZACC)
  596. SEGSUP,NLOC3
  597. ENDDO
  598. NLOC3=ILOC3I
  599. NCOMP=MELVAC(/1)
  600. DO ICOMP=1,NCOMP
  601. MELVAL=MELVAC(ICOMP)
  602. SEGDES,MELVAL
  603. ENDDO
  604. SEGSUP,NLOC3
  605. NLOC3=ILOC3O
  606. NCOMP=MELVAC(/1)
  607. DO ICOMP=1,NCOMP
  608. MELVAL=MELVAC(ICOMP)
  609. SEGDES,MELVAL
  610. ENDDO
  611. SEGSUP,NLOC3
  612. MMODEL=MODLAC
  613. DO ISZACC=1,NSZACC
  614. MINTE=MINTAC(ISZACC)
  615. SEGDES,MINTE
  616. IMODEL=KMODEL(ISZACC)
  617. SEGDES,IMODEL
  618. ENDDO
  619. MELEME=MAILEF
  620. SEGDES,MELEME
  621. ENDDO
  622. DO IZONEF=1,NZONEF
  623. NLOC2=ILOC2(IZONEF)
  624. MMODEL=MODLAC
  625. SEGDES,MMODEL
  626. SEGSUP,NLOC2
  627. ENDDO
  628. SEGSUP,NLOC1
  629. C
  630. C BYE BYE
  631. C
  632. RETURN
  633. END
  634.  
  635.  
  636.  
  637.  

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