Télécharger nloca1.eso

Retour à la liste

Numérotation des lignes :

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

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