Télécharger vloc2.eso

Retour à la liste

Numérotation des lignes :

  1. C VLOC2 SOURCE BP208322 17/03/01 21:18:50 9325
  2. C
  3. SUBROUTINE VLOC2(IPMODL,IPMATE,IPCHE,IRET)
  4. C=======================================================================
  5. C
  6. C Fonction : CALCULE LES VECTEURS DE BASE DU REPERE D'ORTHOTROPIE
  7. C
  8. C Input : MODL : MODELE de calcul , type MMODEL
  9. C CHAML : CHAMELEM materiau (contenant les V1X V1Y ...)
  10. C
  11. C Output : CHAML : CHAMELEM aux POINTS DE GAUSS
  12. c contenant les vecteurs de base du repere local
  13. C de sous type VECTEURS LOCAUX
  14. c de composantes :
  15. c (UX UY UZ) (VX VY VZ) (WX WY WZ) en 3D
  16. c (UX UY) (VX VY) en 2D
  17. C
  18. C Creation : BP, 2017-01-17 (inspiré de VLOC1)
  19. C
  20. C=====================================================================
  21. C
  22. IMPLICIT INTEGER(I-N)
  23. IMPLICIT REAL*8(A-H,O-Z)
  24. PARAMETER(UN=1.D0,XZER=0.D0)
  25.  
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC CCHAMP
  30. -INC SMCHAML
  31. -INC SMMODEL
  32. -INC SMELEME
  33. -INC SMCOORD
  34. -INC SMINTE
  35. C
  36. c SEGMENT TRA
  37. c REAL*8 XEL(3,NBNN) ,SHP(6,NBNN) ,XE(3,NBNN)
  38. c ENDSEGMENT
  39. c C
  40. c SEGMENT TR1
  41. c REAL*8 TH(NBN1) ,BPSS(3,3,NBN1) ,XJ(3,3)
  42. c ENDSEGMENT
  43. SEGMENT WRK1
  44. REAL*8 XE(3,NBBB),XEL(3,NBBB)
  45. ENDSEGMENT
  46.  
  47. SEGMENT WRK2
  48. REAL*8 XE2(3,NBBB), BPSS2(3,3,NBBB)
  49. ENDSEGMENT
  50. C
  51. SEGMENT INFO
  52. INTEGER INFELL(JG)
  53. ENDSEGMENT
  54.  
  55. SEGMENT NOTYPE
  56. CHARACTER*16 TYPE(NBTYPE)
  57. ENDSEGMENT
  58. C
  59. SEGMENT MPTVAL
  60. INTEGER IPOS(NS) , NSOF(NS)
  61. INTEGER IVAL(NCOSOU)
  62. CHARACTER*16 TYVAL(NCOSOU)
  63. ENDSEGMENT
  64. POINTEUR MPTVA1.MPTVAL
  65. C
  66. DIMENSION BPSS(3,3),VV1(3),VV2(3),VV3(3)
  67. DIMENSION BPSS3(IDIM,IDIM)
  68.  
  69. PARAMETER (NINF=3)
  70. INTEGER INFOS(NINF)
  71. CHARACTER*(NCONCH) CONM
  72.  
  73. C=====================================================================
  74.  
  75.  
  76. NHRM = NIFOUR
  77. IRET = IDIM
  78. C
  79. C ACTIVATION DU MODELE
  80. C
  81. MMODEL= IPMODL
  82. SEGACT MMODEL
  83. NSOUS =KMODEL(/1)
  84. C
  85. C CREATION DU CHAMELEM
  86. C
  87. N1=NSOUS
  88. L1=15
  89. N3=6
  90. SEGINI MCHELM
  91. IPCHE=MCHELM
  92. TITCHE(1:15)='VECTEURS LOCAUX'
  93. IFOCHE=IFOUR
  94.  
  95. C____________________________________________________________________
  96. C
  97. C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  98. C____________________________________________________________________
  99. C
  100. ISORTH=0
  101. DO 500 ISOUS=1,NSOUS
  102. C
  103. C ON RECUPERE L INFORMATION GENERALE
  104. C
  105. IMODEL=KMODEL(ISOUS)
  106. SEGACT IMODEL
  107. IPMAIL=IMAMOD
  108. IMACHE(ISOUS)=IPMAIL
  109. CONCHE(ISOUS)=CONMOD
  110. CONM = CONMOD
  111. C
  112. C TRAITEMENT DU MODELE
  113. C
  114. MELE=NEFMOD
  115. MELEME=IMAMOD
  116. NFOR=FORMOD(/2)
  117. NMAT=MATMOD(/2)
  118. c si le modele n'est pas orthotrope : on saute !
  119. CALL PLACE(MATMOD,NMAT,KORTHO,'ORTHOTROPE')
  120. IF (KORTHO.EQ.0) GOTO 499
  121.  
  122. C____________________________________________________________________
  123. C
  124. C INFORMATION SUR L'ELEMENT FINI
  125. C____________________________________________________________________
  126. C
  127. IF(INFMOD(/1).LT.7) THEN
  128. CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  129. IF (IERR.NE.0) THEN
  130. SEGDES IMODEL,MMODEL
  131. SEGSUP MCHELM
  132. IRET=0
  133. RETURN
  134. ENDIF
  135. INFO=IPINF
  136. MELE =INFELL(1)
  137. MFR =INFELL(13)
  138. c MINTE=segment MINTE aux points de Gauss
  139. MINTE=INFELL(11)
  140. c MINTE1=segment MINTE aux noeuds (pour les coques epaisses)
  141. MINTE1=INFELL(12)
  142. segsup info
  143. ELSE
  144. MELE =INFELE(1)
  145. MFR =INFELE(13)
  146. c MINTE=segment MINTE aux points de Gauss
  147. MINTE=INFMOD(7)
  148. c MINTE1=segment MINTE aux noeuds (pour les coques epaisses)
  149. MINTE1=INFMOD(8)
  150. ENDIF
  151.  
  152. c si formulation non prévue : on saute !
  153. IF(MFR.NE.3.AND.MFR.NE.5.AND.MFR.NE.9
  154. & .AND.MFR.NE.1.AND.MFR.NE.33) GOTO 499
  155. c TODO : MFR = 7 35 31 45 (77) ...
  156.  
  157. ISORTH=ISORTH+1
  158. c write(*,*) ISOUS,' MFR=',MFR,' ok -> ',ISORTH,' zones ok',IFOUR
  159. C
  160. INFCHE(ISORTH,1)=0
  161. INFCHE(ISORTH,2)=0
  162. INFCHE(ISORTH,3)=NHRM
  163. INFCHE(ISORTH,4)=MINTE
  164. INFCHE(ISORTH,5)=0
  165. * par defaut aux stresses
  166. INFCHE(ISORTH,6)=5
  167. C
  168. C INITIALISATION DE MINTE
  169. C
  170. SEGACT MINTE
  171. NBPGAU=POIGAU(/1)
  172. C
  173. C ACTIVATION DU MELEME
  174. C
  175. SEGACT MELEME
  176. NBNN =NUM(/1)
  177. NBELEM=NUM(/2)
  178. C
  179. C RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER
  180. N1PTEL=NBPGAU
  181. N1EL=NBELEM
  182. N2PTEL = 0
  183. N2EL = 0
  184. C
  185. C CREATION DU MCHAML DE LA SOUS ZONE
  186. c
  187. C N2 = NOMBRE DE COMPOSANTES
  188. c cas massif et poreux
  189. IF(MFR.EQ.1.OR.MFR.EQ.33) THEN
  190. N2=IDIM*IDIM
  191. IF(IFOUR.eq.1) N2=9
  192. c cas coques et zones cohesives
  193. ELSEIF(MFR.eq.3.or.MFR.eq.5.or.MFR.eq.9.or.MFR.eq.77) THEN
  194. c IF (IFOUR.EQ.-2) THEN
  195. c IF (IFOUR.EQ.0) THEN
  196. c N2=4
  197. c ELSE
  198. N2=9
  199. c ENDIF
  200. ELSE
  201. N2=0
  202. call erreur(5)
  203. return
  204. ENDIF
  205.  
  206. SEGINI MCHAML
  207. ICHAML(ISORTH)=MCHAML
  208. NS=1
  209. NCOSOU=N2
  210. SEGINI MPTVAL
  211. IVAVLO=MPTVAL
  212. C
  213. C COMPOSANTES
  214. C
  215. C 3D + 2D DEF PLANES ET CONTRAINTES PLANES
  216. IF (IFOUR.EQ.2 .OR. IFOUR.EQ.-1 .OR. IFOUR.EQ.-2
  217. & .OR. IFOUR.EQ.-3) THEN
  218. IF(N2.EQ.9) THEN
  219. NOMCHE(1)='V1X'
  220. NOMCHE(2)='V1Y'
  221. NOMCHE(3)='V1Z'
  222. NOMCHE(4)='V2X'
  223. NOMCHE(5)='V2Y'
  224. NOMCHE(6)='V2Z'
  225. NOMCHE(7)='V3X'
  226. NOMCHE(8)='V3Y'
  227. NOMCHE(9)='V3Z'
  228. ELSE
  229. NOMCHE(1)='V1X'
  230. NOMCHE(2)='V1Y'
  231. NOMCHE(3)='V2X'
  232. NOMCHE(4)='V2Y'
  233. ENDIF
  234. c AXI + 2D FOURIER
  235. ELSEIF(IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN
  236. IF(N2.EQ.9) THEN
  237. NOMCHE(1)='V1R'
  238. NOMCHE(2)='V1Z'
  239. NOMCHE(3)='V1T'
  240. NOMCHE(4)='V2R'
  241. NOMCHE(5)='V2Z'
  242. NOMCHE(6)='V2T'
  243. NOMCHE(7)='V3R'
  244. NOMCHE(8)='V3Z'
  245. NOMCHE(9)='V3T'
  246. ELSE
  247. NOMCHE(1)='V1R'
  248. NOMCHE(2)='V1Z'
  249. NOMCHE(3)='V2R'
  250. NOMCHE(4)='V2Z'
  251. ENDIF
  252. ELSE
  253. CALL ERREUR(717)
  254. ENDIF
  255.  
  256. DO ICOMP=1,N2
  257. TYPCHE(ICOMP)='REAL*8'
  258. SEGINI,MELVAL
  259. IELVAL(ICOMP)=MELVAL
  260. IVAL(ICOMP)=MELVAL
  261. ENDDO
  262.  
  263. c write(*,*) ' MCHAML=',MCHAML,' N2=',N2
  264. c write(*,*) ' NOMCHE=',(NOMCHE(iou),iou=1,N2)
  265.  
  266. C____________________________________________________________________
  267. c
  268. C RECHERCHE DES MELVAL DE MATERIAUX QUI NOUS INTERESSENT
  269. C____________________________________________________________________
  270.  
  271. c COQUES + ZONES COHESIVES
  272. IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9 .OR. MFR.EQ.77) THEN
  273. NBROBL=2
  274. NBRFAC=0
  275. SEGINI,NOMID
  276. MOCARA=NOMID
  277. LESOBL(1)='V1X'
  278. LESOBL(2)='V1Y'
  279. c MASSIFS
  280. ELSEIF(MFR.EQ.1.OR.MFR.EQ.33) THEN
  281. IF(IDIM.EQ.3.OR.IFOUR.EQ.1) THEN
  282. NBROBL=6
  283. NBRFAC=0
  284. SEGINI,NOMID
  285. MOCARA=NOMID
  286. LESOBL(1)='V1X'
  287. LESOBL(2)='V1Y'
  288. LESOBL(3)='V1Z'
  289. LESOBL(4)='V2X'
  290. LESOBL(5)='V2Y'
  291. LESOBL(6)='V2Z'
  292. ELSE
  293. NBROBL=2
  294. NBRFAC=0
  295. SEGINI,NOMID
  296. MOCARA=NOMID
  297. LESOBL(1)='V1X'
  298. LESOBL(2)='V1Y'
  299. ENDIF
  300. ENDIF
  301. NBTYPE=NBROBL+NBRFAC
  302. SEGINI NOTYPE
  303. MOTYPE=NOTYPE
  304. DO I=1,NBTYPE
  305. TYPE(I)='REAL*8'
  306. ENDDO
  307. c write(*,*) ' MATERIAU =',(LESOBL(iou),iou=1,NBROBL)
  308.  
  309. * CREATION DU TABLEAU INFOS
  310. IRTD=1
  311. CALL IDENT(IPMAIL,CONM,0,IPMATE,INFOS,IRTD)
  312. IF (IRTD.EQ.0) GOTO 499
  313. c write(*,*) ' INFOS=',(INFOS(iou),iou=1,NINF)
  314.  
  315. * RECHERCHE DES MELVAL
  316. CALL KOMCHA(IPMATE,IPMAIL,CONM,MOCARA,MOTYPE,1,
  317. & INFOS,NINF,IVAMAT)
  318. SEGSUP,NOTYPE
  319. IF (IERR.NE.0) RETURN
  320.  
  321.  
  322. C MISE A ZERO INITIALE
  323. DO I=1,3
  324. VV1(I)=0.D0
  325. VV2(I)=0.D0
  326. VV3(I)=0.D0
  327. ENDDO
  328. C
  329. C____________________________________________________________________
  330. C
  331. C AIGUILLAGE SELON FORMULATION et TYPE D ELEMENT
  332. C____________________________________________________________________
  333. C
  334. c FORMULATION MASSIVE : ON CREE LE REPERE GLOBAL
  335. IF(MFR.EQ.1.OR.MFR.EQ.33) GOTO 1
  336. c FORMULATION COQUE MINCE : OK
  337. IF(MFR.EQ.3.OR.MFR.EQ.9) GOTO 100
  338. C TODO FORMULATION ZONES COHESIVES
  339. c IF(MFR.EQ.77) : BRANCHER LES ELEMENTS
  340. c FORMULATION COQUE EPAISSE : OK
  341. IF(MFR.EQ.5) GOTO 100
  342. C TODO FORMULATION POUTRE ET TUYAU
  343. c IF(MFR.EQ.7.OR.MFR.EQ.13) GOTO 100
  344.  
  345. 100 CONTINUE
  346. c 1 2 3 ...
  347. GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  348. c ... 27,28
  349. 1 99,99,99,99,99,99,28,28,99,99,99,99,99,99,99,99,99,99,99,99,
  350. c 41 44 45 49 56
  351. 2 41,99,99,44,99,99,99,99,49,99,99,99,99,99,99,41,99,99,99,99,
  352. 3 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  353. c 93
  354. 4 99,99,99,99,99,99,99,99,99,99,99,99,28,99,99,99,99),MELE
  355. GOTO 99
  356. c MELE = 27 -> COQ3
  357. c MELE = 28 -> DKT
  358. c MELE = 41 -> COQ8
  359. c MELE = 44 -> COQ2
  360. c MELE = 45 -> POI1 ???
  361. c MELE = 49 -> COQ4
  362. c MELE = 56 -> COQ6
  363. c MELE = 93 -> DST
  364.  
  365. C_______________________________________________________________________
  366. C
  367. C ELEMENTS MASSIFS
  368. C_______________________________________________________________________
  369. C
  370. 1 CONTINUE
  371.  
  372. NBBB=NBNN
  373. SEGINI WRK1
  374.  
  375. * RECUPERATION DES FONCTIONS DE FORME ET LEURS DERIVEES AU CENTRE DE
  376. * L'ELEMENT POUR LE CALCUL DES AXES LOCAUX
  377. IPMIN2 = 0
  378. NLG=NUMGEO(MELE)
  379. CALL RESHPT(1,NBNN,NLG,MELE,0,IPMIN2,IRT1)
  380. MINTE2=IPMIN2
  381. SEGACT MINTE2
  382.  
  383. C---- BOUCLE SUR LES ELEMENTS
  384. DO 3001 IB=1,NBELEM
  385. C
  386. C XE = COORDONNEES DES NOEUDS DE L ELEMENT IB
  387. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  388.  
  389. c BPSS = MATRICE DE PASSAGE = [ (u) (v) (w) ]
  390. NBSH=MINTE2.SHPTOT(/2)
  391. CALL RLOCAL(XE,MINTE2.SHPTOT,NBSH,NBNN,BPSS3)
  392. IF (NBSH.EQ.-1) THEN
  393. CALL ERREUR(525)
  394. GOTO 99
  395. ENDIF
  396.  
  397. C------ BOUCLE SUR LES POINTS DE GAUSS
  398. DO 4001 IGAU=1,NBPGAU
  399.  
  400. c RECUP DES VALEURS MATERIAUX
  401. MPTVAL=IVAMAT
  402. MELVAL=IVAL(1)
  403. IGMN=MIN(IGAU,VELCHE(/1))
  404. IBMN=MIN(IB,VELCHE(/2))
  405. V1X=VELCHE(IGMN,IBMN)
  406. MELVAL=IVAL(2)
  407. IGMN=MIN(IGAU,VELCHE(/1))
  408. IBMN=MIN(IB,VELCHE(/2))
  409. V1Y=VELCHE(IGMN,IBMN)
  410. IF(IDIM.EQ.3.OR.IFOUR.EQ.1) THEN
  411. MELVAL=IVAL(3)
  412. IGMN=MIN(IGAU,VELCHE(/1))
  413. IBMN=MIN(IB,VELCHE(/2))
  414. V1Z=VELCHE(IGMN,IBMN)
  415. MELVAL=IVAL(4)
  416. IGMN=MIN(IGAU,VELCHE(/1))
  417. IBMN=MIN(IB,VELCHE(/2))
  418. V2X=VELCHE(IGMN,IBMN)
  419. MELVAL=IVAL(5)
  420. IGMN=MIN(IGAU,VELCHE(/1))
  421. IBMN=MIN(IB,VELCHE(/2))
  422. V2Y=VELCHE(IGMN,IBMN)
  423. MELVAL=IVAL(6)
  424. IGMN=MIN(IGAU,VELCHE(/1))
  425. IBMN=MIN(IB,VELCHE(/2))
  426. V2Z=VELCHE(IGMN,IBMN)
  427. ENDIF
  428.  
  429. c CALCUL DE V1 V2 (et V3 en 3D)
  430. IF(IDIM.EQ.3) THEN
  431. DO I=1,3
  432. VV1(I) = V1X*BPSS3(I,1)+V1Y*BPSS3(I,2)+V1Z*BPSS3(I,3)
  433. VV2(I) = V2X*BPSS3(I,1)+V2Y*BPSS3(I,2)+V2Z*BPSS3(I,3)
  434. ENDDO
  435. c CALCUL DE V3
  436. CALL CROSS2(VV1,VV2,VV3,IRET)
  437. ELSEIF(IFOUR.EQ.1) THEN
  438. DO I=1,2
  439. VV1(I) = V1X*BPSS3(I,1)+V1Y*BPSS3(I,2)
  440. VV2(I) = V2X*BPSS3(I,1)+V2Y*BPSS3(I,2)
  441. ENDDO
  442. VV1(3) = V1Z
  443. VV2(3) = V2Z
  444. CALL CROSS2(VV1,VV2,VV3,IRET)
  445. ELSE
  446. DO I=1,2
  447. VV1(I) = V1X*BPSS3(I,1)+V1Y*BPSS3(I,2)
  448. ENDDO
  449. c en 2d calcul de v2 deduit de v1
  450. VV2(1)=-1.D0*VV1(2)
  451. VV2(2)=VV1(1)
  452. ENDIF
  453.  
  454. c ECRITURE DANS LES MELVAL
  455. MPTVAL=IVAVLO
  456. * boucle sur les composantes
  457. IF(N2.EQ.9) THEN
  458. DO I=1,3
  459. MELVAL=IVAL(I)
  460. MELVAL.VELCHE(IGAU,IB)=VV1(I)
  461. MELVAL=IVAL(3+I)
  462. MELVAL.VELCHE(IGAU,IB)=VV2(I)
  463. MELVAL=IVAL(6+I)
  464. MELVAL.VELCHE(IGAU,IB)=VV3(I)
  465. ENDDO
  466. ELSE
  467. DO I=1,2
  468. MELVAL=IVAL(I)
  469. MELVAL.VELCHE(IGAU,IB)=VV1(I)
  470. MELVAL=IVAL(2+I)
  471. MELVAL.VELCHE(IGAU,IB)=VV2(I)
  472. ENDDO
  473. ENDIF
  474.  
  475. 4001 CONTINUE
  476. C------ FIN DE BOUCLE SUR LES POINTS DE GAUSS
  477.  
  478. 3001 CONTINUE
  479.  
  480. SEGDES MINTE2
  481. SEGSUP,WRK1
  482. GOTO 99
  483.  
  484. C_______________________________________________________________________
  485. C
  486. C ELEMENTS COQ3, DKT et DST
  487. C_______________________________________________________________________
  488. C
  489. 28 CONTINUE
  490. NBBB=NBNN
  491. SEGINI WRK1
  492.  
  493. C---- BOUCLE SUR LES ELEMENTS
  494. DO 3028 IB=1,NBELEM
  495. C
  496. C XE = COORDONNEES DES NOEUDS DE L ELEMENT IB
  497. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  498.  
  499. c BPSS = MATRICE DE PASSAGE = [ (u) (v) (w) ]
  500. CALL VPAST(XE,BPSS)
  501.  
  502. C------ BOUCLE SUR LES POINTS DE GAUSS
  503. DO 4028 IGAU=1,NBPGAU
  504.  
  505. c RECUP DES VALEURS MATERIAUX
  506. MPTVAL=IVAMAT
  507. MELVAL=IVAL(1)
  508. IGMN=MIN(IGAU,VELCHE(/1))
  509. IBMN=MIN(IB,VELCHE(/2))
  510. V1X=VELCHE(IGMN,IBMN)
  511. MELVAL=IVAL(2)
  512. V1Y=VELCHE(IGMN,IBMN)
  513.  
  514. c CALCUL DE V1 ET V3
  515. DO I=1,3
  516. VV1(I) = V1X*BPSS(1,I)+V1Y*BPSS(2,I)
  517. VV3(I) = BPSS(3,I)
  518. ENDDO
  519. c CALCUL DE V2
  520. CALL CROSS2(VV3,VV1,VV2,IRET)
  521. c IF(IRET)
  522.  
  523. c ECRITURE DANS LES MELVAL
  524. MPTVAL=IVAVLO
  525. * boucle sur la dimension
  526. DO I=1,3
  527. MELVAL=IVAL(I)
  528. MELVAL.VELCHE(IGAU,IB)=VV1(I)
  529. MELVAL=IVAL(3+I)
  530. MELVAL.VELCHE(IGAU,IB)=VV2(I)
  531. MELVAL=IVAL(6+I)
  532. MELVAL.VELCHE(IGAU,IB)=VV3(I)
  533. ENDDO
  534.  
  535. 4028 CONTINUE
  536. C------ FIN DE BOUCLE SUR LES POINTS DE GAUSS
  537.  
  538. 3028 CONTINUE
  539. C---- FIN DE BOUCLE SUR LES ELEMENTS
  540.  
  541. SEGSUP,WRK1
  542. GOTO 99
  543.  
  544.  
  545. C_______________________________________________________________________
  546. C
  547. C ELEMENT COQ8 et COQ6
  548. C_______________________________________________________________________
  549. C
  550. 41 CONTINUE
  551. NBBB=NBNN
  552. SEGINI WRK2
  553. SEGACT MINTE1
  554.  
  555. C---- BOUCLE SUR LES ELEMENTS
  556. DO 3041 IB=1,NBELEM
  557. C
  558. C XE = COORDONNEES DES NOEUDS DE L ELEMENT IB
  559. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE2)
  560.  
  561. C DETERMINATION DES AXES LOCAUX AUX NOEUDS
  562. CALL CQ8LOC(XE2,NBNN,MINTE1.SHPTOT,BPSS2,IRR)
  563. C GESTION D'ERREUR:IRR=0 CORRESPOND A UN VECTEUR NUL (CF. CROSS2)
  564. C IRR=-1 CORRESPOND A UN JACOBIEN NUL(CF. SHLJAC)
  565. IF(IRR.EQ.0) THEN
  566. CALL ERREUR(241)
  567. GOTO 3041
  568. ELSE IF(IRR.EQ.-1)THEN
  569. CALL ERREUR(240)
  570. GOTO 3041
  571. ENDIF
  572.  
  573. C------ BOUCLE SUR LES POINTS DE GAUSS
  574. DO 4041 IGAU=1,NBPGAU
  575.  
  576. c CALCUL DES AXES LOCAUX AUX POINTS DE GAUSS
  577. c BPSS(J1,J2) = vecteurs locaux au point de Gauss
  578. c avec J1 = indice du vecteur local (u,v,w)
  579. c J2 = indice du repere global (X,Y,Z)
  580. DO 5041 J1=1,3
  581. DO 5041 J2=1,3
  582. BPSS(J1,J2)=0.D0
  583. DO I=1,NBNN
  584. c BPSS(J1,J2)=BPSS(J1,J2)+SHPTOT(1,I,IGAU)*BPSS2(J1,J2,I)
  585. BPSS(J1,J2)=BPSS(J1,J2)+SHPTOT(1,I,IGAU)*BPSS2(J2,J1,I)
  586. ENDDO
  587. 5041 CONTINUE
  588.  
  589. c RECUP DES VALEURS MATERIAUX
  590. MPTVAL=IVAMAT
  591. MELVAL=IVAL(1)
  592. IGMN=MIN(IGAU,VELCHE(/1))
  593. IBMN=MIN(IB,VELCHE(/2))
  594. V1X=VELCHE(IGMN,IBMN)
  595. MELVAL=IVAL(2)
  596. V1Y=VELCHE(IGMN,IBMN)
  597.  
  598. c CALCUL DE V1 ET V3
  599. DO I=1,3
  600. VV1(I) = V1X*BPSS(1,I)+V1Y*BPSS(2,I)
  601. VV3(I) = BPSS(3,I)
  602. ENDDO
  603. c CALCUL DE V2
  604. CALL CROSS2(VV3,VV1,VV2,IRET)
  605. c IF(IRET)
  606.  
  607. c ECRITURE DANS LES MELVAL
  608. MPTVAL=IVAVLO
  609. * boucle sur la dimension
  610. DO I=1,3
  611. MELVAL=IVAL(I)
  612. MELVAL.VELCHE(IGAU,IB)=VV1(I)
  613. MELVAL=IVAL(3+I)
  614. MELVAL.VELCHE(IGAU,IB)=VV2(I)
  615. MELVAL=IVAL(6+I)
  616. MELVAL.VELCHE(IGAU,IB)=VV3(I)
  617. ENDDO
  618.  
  619. 4041 CONTINUE
  620. C------ FIN DE BOUCLE SUR LES POINTS DE GAUSS
  621.  
  622. 3041 CONTINUE
  623. C---- FIN DE BOUCLE SUR LES ELEMENTS
  624.  
  625. SEGSUP,WRK2
  626. GOTO 99
  627.  
  628.  
  629. C_______________________________________________________________________
  630. C
  631. C SECTEUR DE CALCUL POUR LE COQ2
  632. C_______________________________________________________________________
  633. C
  634. 44 CONTINUE
  635. NBBB=NBNN
  636. SEGINI WRK1
  637.  
  638. C---- BOUCLE SUR LES ELEMENTS
  639. DO 3044 IB=1,NBELEM
  640. C
  641. C XE = COORDONNEES DES NOEUDS DE L ELEMENT IB
  642. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  643.  
  644. c BPSS = MATRICE DE PASSAGE
  645. CALL VPAST2(XE,BPSS)
  646.  
  647. C------ BOUCLE SUR LES POINTS DE GAUSS
  648. DO 4044 IGAU=1,NBPGAU
  649.  
  650. c RECUP DES VALEURS MATERIAUX
  651. MPTVAL=IVAMAT
  652. MELVAL=IVAL(1)
  653. IGMN=MIN(IGAU,VELCHE(/1))
  654. IBMN=MIN(IB,VELCHE(/2))
  655. V1X=VELCHE(IGMN,IBMN)
  656. MELVAL=IVAL(2)
  657. V1Y=VELCHE(IGMN,IBMN)
  658.  
  659. c IF(IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN
  660. c c CALCUL DE V1 ET V3
  661. c DO I=1,3
  662. c VV1(I) = V1X*BPSS(I,1)+V1Y*BPSS(I,2)
  663. c VV2(I) = BPSS(I,3)
  664. c ENDDO
  665. c c CALCUL DE V2
  666. c CALL CROSS2(VV2,VV1,VV3,IRET)
  667. c ELSE
  668. c CALCUL DE V1 ET V3
  669. DO I=1,3
  670. VV1(I) = V1X*BPSS(1,I)+V1Y*BPSS(2,I)
  671. VV3(I) = BPSS(3,I)
  672. ENDDO
  673. c CALCUL DE V2
  674. CALL CROSS2(VV3,VV1,VV2,IRET)
  675. c ENDIF
  676. c IF(IRET)
  677.  
  678. c ECRITURE DANS LES MELVAL
  679. MPTVAL=IVAVLO
  680. * boucle sur la dimension
  681. DO I=1,3
  682. MELVAL=IVAL(I)
  683. MELVAL.VELCHE(IGAU,IB)=VV1(I)
  684. MELVAL=IVAL(3+I)
  685. MELVAL.VELCHE(IGAU,IB)=VV2(I)
  686. MELVAL=IVAL(6+I)
  687. MELVAL.VELCHE(IGAU,IB)=VV3(I)
  688. ENDDO
  689.  
  690. 4044 CONTINUE
  691. C------ FIN DE BOUCLE SUR LES POINTS DE GAUSS
  692.  
  693.  
  694. 3044 CONTINUE
  695. C---- FIN DE BOUCLE SUR LES ELEMENTS
  696.  
  697. SEGSUP,WRK1
  698. GOTO 99
  699.  
  700.  
  701. C_______________________________________________________________________
  702. C
  703. C SECTEUR DE CALCUL POUR LE COQ4
  704. C_______________________________________________________________________
  705. C
  706. 49 CONTINUE
  707. NBBB=NBNN
  708. SEGINI WRK1
  709.  
  710. C---- BOUCLE SUR LES ELEMENTS
  711. DO 3049 IB=1,NBELEM
  712. C
  713. C XE = COORDONNEES DES NOEUDS DE L ELEMENT IB
  714. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  715.  
  716. c BPSS = MATRICE DE PASSAGE = [ (u) (v) (w) ]T
  717. CALL CQ4LOC(XE,XEL,BPSS,IRRT,1)
  718. do i=1,3
  719. c write(*,*) 'BPSS(',i,',:)=',(BPSS(i,jou),jou=1,3)
  720. enddo
  721.  
  722. C------ BOUCLE SUR LES POINTS DE GAUSS
  723. DO 4049 IGAU=1,NBPGAU
  724.  
  725. c RECUP DES VALEURS MATERIAUX
  726. MPTVAL=IVAMAT
  727. MELVAL=IVAL(1)
  728. IGMN=MIN(IGAU,VELCHE(/1))
  729. IBMN=MIN(IB,VELCHE(/2))
  730. V1X=VELCHE(IGMN,IBMN)
  731. MELVAL=IVAL(2)
  732. V1Y=VELCHE(IGMN,IBMN)
  733. c write(*,*) 'V1X,V1Y=',V1X,V1Y
  734.  
  735. c CALCUL DE V1 ET V3
  736. DO I=1,3
  737. VV1(I) = V1X*BPSS(1,I)+V1Y*BPSS(2,I)
  738. VV3(I) = BPSS(3,I)
  739. ENDDO
  740. c CALCUL DE V2
  741. CALL CROSS2(VV3,VV1,VV2,IRET)
  742. c IF(IRET)
  743.  
  744. c ECRITURE DANS LES MELVAL
  745. MPTVAL=IVAVLO
  746. * boucle sur la dimension
  747. DO I=1,3
  748. MELVAL=IVAL(I)
  749. MELVAL.VELCHE(IGAU,IB)=VV1(I)
  750. MELVAL=IVAL(3+I)
  751. MELVAL.VELCHE(IGAU,IB)=VV2(I)
  752. MELVAL=IVAL(6+I)
  753. MELVAL.VELCHE(IGAU,IB)=VV3(I)
  754. ENDDO
  755.  
  756. 4049 CONTINUE
  757. C------ FIN DE BOUCLE SUR LES POINTS DE GAUSS
  758.  
  759.  
  760. 3049 CONTINUE
  761. C---- FIN DE BOUCLE SUR LES ELEMENTS
  762.  
  763. SEGSUP,WRK1
  764. GOTO 99
  765.  
  766.  
  767.  
  768.  
  769. C---------------------------------------------------------------------
  770. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  771. C---------------------------------------------------------------------
  772. C
  773. 99 CONTINUE
  774. MPTVAL=IVAVLO
  775. DO I2=1,N2
  776. IF(IVAL(I2).NE.0) THEN
  777. MELVAL=IVAL(I2)
  778. SEGDES MELVAL
  779. ENDIF
  780. ENDDO
  781. SEGSUP MPTVAL
  782. C
  783. SEGDES MINTE
  784. * SEGSUP INFO
  785. C
  786. SEGDES MELEME
  787. SEGDES MCHAML
  788. C
  789. IF (MFR.EQ.5) THEN
  790. SEGDES MINTE1
  791. ENDIF
  792.  
  793. 499 SEGDES IMODEL
  794.  
  795.  
  796. 500 CONTINUE
  797. C____________________________________________________________________
  798. C
  799. C FIN DE LA BOUCLE SUR LES DIFFERENTES ZONES
  800. C____________________________________________________________________
  801.  
  802. N1=ISORTH
  803. L1=15
  804. N3=6
  805. SEGADJ,MCHELM
  806. SEGDES MCHELM
  807. SEGDES MMODEL
  808. RETURN
  809. C
  810. END
  811.  
  812.  
  813.  
  814.  
  815.  

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