Télécharger bloque.eso

Retour à la liste

Numérotation des lignes :

bloque
  1. C BLOQUE SOURCE CB215821 20/11/25 13:18:40 10792
  2.  
  3. C-----------------------------------------------------------------------
  4. C Cet operateur impose les BLOCAGES
  5. C
  6. C Syntaxe :
  7. C
  8. C ENC1 = BLOQUER ( DEPL ) ( ROTA ) POI1
  9. C
  10. C ou ENC1 = BLOQUER RADIAL P1 (P2) MELEME
  11. C ORTHOR P1 (P2) MELEME
  12. C
  13. C ou ENC1 = BLOQUER (DEPL) (ROTA) DIRECTION V1 MELEME
  14. C
  15. C DIM = 1 ( UX UY UZ ) ou ( UR UZ ) |
  16. C DIM = 2 OU 3 ( UX UY UZ RX RY RZ ) | MELEME
  17. C AXISYM ( RX RZ RT UT ) |
  18. Clist t
  19. C POI1 = OBJET DE TYPE POINT (entree)
  20. C MELEME = OBJET DE TYPE MELEME (entree)
  21. C ENC1 = OBJET DE TYPE RIGIDITE (sortie)
  22. C
  23. C 1) On peut imposer des BLOQUAGES UNILATERAUX en specifiant les
  24. C mots-cles MINIMUM ou MAXIMUM.
  25. C 2) On peut imposer des BLOQUAGES de type FROTTEMENT en specifiant
  26. C le mot-cle FROTTEMENT.
  27. C-----------------------------------------------------------------------
  28. C Juillet 2003 : passage a un seul multiplicateur
  29. C-----------------------------------------------------------------------
  30.  
  31. SUBROUTINE BLOQUE
  32.  
  33. IMPLICIT INTEGER(I-N)
  34. IMPLICIT REAL*8 (A-H,O-Z)
  35.  
  36.  
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. -INC CCGEOME
  40. -INC CCREEL
  41. -INC CCHAMP
  42.  
  43. -INC SMCHPOI
  44. -INC SMCOORD
  45. -INC SMELEME
  46. -INC SMLMOTS
  47. POINTEUR LMDEPL.MLMOTS
  48. -INC SMMODEL
  49. -INC SMRIGID
  50. -INC SMTABLE
  51. -INC TMTRAV
  52.  
  53. SEGMENT MSWBLO
  54. CHARACTER*4 MOTDDL(0)
  55. ENDSEGMENT
  56.  
  57. segment lispoi
  58. INTEGER pilpoi(mpoin),pilmul(mpoin)
  59. endsegment
  60.  
  61. DIMENSION XNOR(3),U1(3),U2(3)
  62.  
  63. CHARACTER*4 CHADDL
  64. CHARACTER*8 MOTRIG
  65. CHARACTER*4 MOTPV(3), MOTBLO(5)
  66. CHARACTER*4 MODEPL(6),MODEDU(6), MOROTA(5),MORODU(5)
  67. CHARACTER*4 MODE1D(2),MOFO1D(2)
  68.  
  69. DATA EPSI / 1.D-12 /
  70. DATA MOTRIG / 'RIGIDITE' /
  71. DATA MOTPV / 'MINI','MAXI','FROT' /
  72. DATA MOTBLO / 'DEPL','ROTA','RADI','ORTH','DIRE' /
  73. DATA MODEPL / 'UX ','UY ','UZ ','UR ','UZ ','UT ' /
  74. DATA MODEDU / 'FX ','FY ','FZ ','FR ','FZ ','FT ' /
  75. DATA MOROTA / 'RX ','RY ','RZ ','RT ','RS ' /
  76. DATA MORODU / 'MX ','MY ','MZ ','MT ','MS ' /
  77. C Tableaux MODE1D et MOFO1D sont utilises pour certains modes 1D
  78. DATA MODE1D / 'UX ','UZ ' /
  79. DATA MOFO1D / 'FX ','FZ ' /
  80.  
  81. C Pour ne pas avoir de verrouillage sur MCOORD en //
  82. SEGDES,MCOORD
  83. SEGACT,MCOORD*MOD
  84.  
  85. c lecture table liaisons statiques
  86. CALL LIRTAB('LIAISONS_STATIQUES',ipt,0,iretou)
  87. c traitement table liaisons statiques
  88. IF (iretou.NE.0) THEN
  89. CALL BLOQU2(ipt)
  90. RETURN
  91. ENDIF
  92.  
  93. C Est-ce une condition unilaterale ?
  94. NILATE=0
  95. CALL LIRMOT(MOTPV,3,IPO,0)
  96. IF (IPO.EQ.1) NILATE=-1
  97. IF (IPO.EQ.2) NILATE=1
  98. IF (IPO.EQ.3) NILATE=2
  99. C Pas de frottement en 1D
  100. IF (IPO.EQ.3.AND.IDIM.EQ.1) THEN
  101. INTERR(1)=IDIM
  102. MOTERR(1:4)=MOTPV(3)
  103. CALL ERREUR(971)
  104. RETURN
  105. ENDIF
  106.  
  107. idimp1=IDIM+1
  108. C Quelques initialisations selon le type de probleme
  109. C Cas IDIM = 1 :
  110. C ISPE1D = 1 si IDIM=1 et IFOUR=9 ou 10, car les noms de DDL primaux et
  111. C variables duales ne sont pas dans l'ordre "classique" (un traitement
  112. C specifique est alors necessaire).
  113. ISPE1D=0
  114. C Deformations planes ou contraintes planes ou defo. plane gene :
  115. IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-3) THEN
  116. LDEPL=2
  117. IADEPL=0
  118. LROTA=1
  119. IAROTA=2
  120. C Axisymetrique :
  121. ELSE IF (IFOUR.EQ.0) THEN
  122. LDEPL=2
  123. IADEPL=3
  124. LROTA=1
  125. IAROTA=3
  126. C Fourier :
  127. ELSE IF (IFOUR.EQ.1) THEN
  128. LDEPL=3
  129. IADEPL=3
  130. LROTA=1
  131. IAROTA=3
  132. C Tridimensionnel :
  133. ELSE IF (IFOUR.EQ.2) THEN
  134. LDEPL=3
  135. IADEPL=0
  136. LROTA=3
  137. IAROTA=0
  138. C Massif 1D (IDIM=1) :
  139. ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN
  140. IF (IFOUR.LE.6) THEN
  141. LDEPL=1
  142. IADEPL=0
  143. ELSE IF (IFOUR.GE.7.AND.IFOUR.LE.10) THEN
  144. LDEPL=2
  145. IADEPL=0
  146. IF (IFOUR.EQ.9.OR.IFOUR.EQ.10) ISPE1D=1
  147. ELSE IF (IFOUR.EQ.11) THEN
  148. LDEPL=3
  149. IADEPL=0
  150. ELSE IF (IFOUR.EQ.15) THEN
  151. LDEPL=2
  152. IADEPL=3
  153. ELSE
  154. LDEPL=1
  155. IADEPL=3
  156. ENDIF
  157. LROTA=0
  158. IAROTA=0
  159. C Autres cas :
  160. ELSE
  161. LDEPL=0
  162. IADEPL=0
  163. LROTA=0
  164. IAROTA=0
  165. ENDIF
  166.  
  167. C Initialisation de la liste des ddls MOTDDL (segment MSWBLO)
  168. SEGINI,MSWBLO
  169.  
  170. C-----------------------------------------------------------------------
  171. C Lecture eventuelle des MOTS autres que des DDLS
  172. C-----------------------------------------------------------------------
  173. C Lecture eventuelle de 'DEPL' et/ou 'ROTA'
  174. C --------------------
  175. IDEPL=0
  176. IROTA=0
  177. 481 CALL LIRMOT(MOTBLO,2,IMOT,0)
  178. IF (IMOT.EQ.1) IDEPL=1
  179. IF (IMOT.EQ.2) IROTA=1
  180. IF (IMOT.NE.0) GOTO 481
  181. C Lecture eventuelle de 'RADI','ORTH' ou 'DIRE'
  182. C --------------------
  183. IRADIA=0
  184. IDIREC=0
  185. IDICHP=0
  186. 4480 CALL LIRMOT(MOTBLO(3),3,IMOT,0)
  187. IF (IMOT.EQ.0) THEN
  188. IF (IDEPL.EQ.1) GOTO 44801
  189. IF (IROTA.EQ.1) GOTO 44802
  190. IBDDL=MOTDDL(/2)
  191. IF (IBDDL.NE.0) GOTO 449
  192. IF (IBDDL.EQ.0) GOTO 445
  193. ENDIF
  194. C En DIMENSION 1, les mots-cles 'RADI,'ORTH' et 'DIRE' sont interdits.
  195. IF (IDIM.EQ.1) THEN
  196. INTERR(1)=IDIM
  197. MOTERR(1:4)=MOTBLO(2+IMOT)
  198. CALL ERREUR(971)
  199. GOTO 1000
  200. ENDIF
  201. GO TO (44803,44803,44804),IMOT
  202. C Traitement des mots-cles : Mise a jour de MOTDDL
  203. C ----------------------------
  204. C On a trouve le mot DEPLAcement
  205. 44801 IDEPL=0
  206. C Cas particulier pour certains modes de IDIM=1
  207. IF (ISPE1D.EQ.1) THEN
  208. DO i=1,LDEPL
  209. MOTDDL(**)=MODE1D(IADEPL+i)
  210. MOTDDL(**)=MOFO1D(IADEPL+i)
  211. ENDDO
  212. C Cas general
  213. ELSE
  214. DO i=1,LDEPL
  215. MOTDDL(**)=MODEPL(IADEPL+i)
  216. MOTDDL(**)=MODEDU(IADEPL+i)
  217. ENDDO
  218. ENDIF
  219. GOTO 4480
  220. C On a trouve le mot ROTAtion
  221. 44802 IROTA=0
  222. DO i=1,LROTA
  223. MOTDDL(**)=MOROTA(IAROTA+i)
  224. MOTDDL(**)=MORODU(IAROTA+i)
  225. ENDDO
  226. GOTO 4480
  227. C On a trouve le mot RADial ou le mot ORTHoradial
  228. 44803 IRADIA=IMOT
  229. CALL LIROBJ('POINT',KPOINT,1,IRETOU)
  230. IF (IRETOU.EQ.0) GOTO 1000
  231. j=(KPOINT-1)*idimp1
  232. DO i=1,IDIM
  233. U1(i)=XCOOR(j+i)
  234. ENDDO
  235. IF (IDIM.EQ.3) THEN
  236. C Lecture du 2nd point de l'axe (en 3D)
  237. CALL LIROBJ('POINT',KPOINT,1,IRETOU)
  238. IF (IRETOU.EQ.0) GOTO 1000
  239. j=(KPOINT-1)*idimp1
  240. YL=0.D0
  241. DO i=1,IDIM
  242. U2(i)=XCOOR(j+i)-U1(i)
  243. YL=YL+U2(i)*U2(i)
  244. ENDDO
  245. C Calcul du vecteur directeur unitaire de l'axe (U2)
  246. IF (YL.LT.EPSI) THEN
  247. CALL ERREUR(237)
  248. GOTO 1000
  249. ENDIF
  250. YL=1.D0/SQRT(YL)
  251. DO i=1,IDIM
  252. U2(i)=U2(i)*YL
  253. ENDDO
  254. ENDIF
  255. GOTO 449
  256. C On a trouve le mot DIREction
  257. 44804 IDIREC=1
  258. CALL LIROBJ('POINT',KPOINT,0,IRETOU)
  259. IF (IRETOU.EQ.0) THEN
  260. * WRITE(IOIMP,*) 'Lecture dun chpoint'
  261. CALL LIROBJ('CHPOINT ',MCHPOI,1,IRETOU)
  262. CALL ACTOBJ('CHPOINT ',MCHPOI,1)
  263. IF (IERR.NE.0) GOTO 1000
  264. IDICHP=1
  265. ELSE
  266. j=(KPOINT-1)*idimp1
  267. YL=0.D0
  268. DO i=1,IDIM
  269. XNOR(i)=XCOOR(j+i)
  270. YL=YL+XNOR(i)*XNOR(i)
  271. ENDDO
  272. IF (YL.LT.EPSI) THEN
  273. CALL ERREUR(239)
  274. GOTO 1000
  275. ENDIF
  276. YL=1.D0/SQRT(YL)
  277. DO i=1,IDIM
  278. XNOR(i)=XNOR(i)*YL
  279. ENDDO
  280. ENDIF
  281. GOTO 449
  282.  
  283. C Lecture eventuelle de DDLs :
  284. C ------------------------------
  285.  
  286. 445 CONTINUE
  287. C La liste des grandeurs PRIMALEs/DDLs est un LISTMOTS.
  288. cbp,2020-11-12 : possibilite non documentee => ajout a la notice
  289. c + ajout de qq lignes pour rendre listmot dual facultatif
  290. CALL LIROBJ('LISTMOTS',MLMOT1,0,IRETOU)
  291. IF (IERR.NE.0) GOTO 1000
  292. IF (IRETOU.EQ.0) GOTO 446
  293. CALL LIROBJ('LISTMOTS',MLMOT2,0,IRETO2)
  294. IF (IERR.NE.0) GOTO 1000
  295. C -cas ou la liste des grandeurs DUALEs n'est pas fournie.
  296. IF(IRETO2.EQ.0) THEN
  297. SEGACT,MLMOT1
  298. IMOT1 = MLMOT1.MOTS(/2)
  299. IF (IMOT1.LE.0) THEN
  300. CALL ERREUR(643)
  301. SEGDES,MLMOT1
  302. GOTO 1000
  303. ENDIF
  304. DO IMOT = 1, IMOT1
  305. MOTDDL(**)=MLMOT1.MOTS(IMOT)
  306. CALL PLACE(NOMDD,LNOMDD,idd,MLMOT1.MOTS(IMOT))
  307. IF (IERR.NE.0.or.idd.LE.0) THEN
  308. GOTO 1000
  309. ENDIF
  310. MOTDDL(**)=NOMDU(idd)
  311. ENDDO
  312. SEGDES,MLMOT1
  313. C -cas ou la liste des grandeurs DUALEs est un LISTMOTS fourni.
  314. cbp,2020-11-12 : on ne documente pas cette possibilite car pas le temps
  315. ELSE
  316. SEGACT,MLMOT1,MLMOT2
  317. IMOT1 = MLMOT1.MOTS(/2)
  318. IF (IMOT1.LE.0) THEN
  319. CALL ERREUR(643)
  320. SEGDES,MLMOT1,MLMOT2
  321. GOTO 1000
  322. ELSE IF (IMOT1.NE.MLMOT2.MOTS(/2)) THEN
  323. CALL ERREUR(854)
  324. SEGDES,MLMOT1,MLMOT2
  325. GOTO 1000
  326. ENDIF
  327. DO IMOT = 1, IMOT1
  328. MOTDDL(**)=MLMOT1.MOTS(IMOT)
  329. MOTDDL(**)=MLMOT2.MOTS(IMOT)
  330. ENDDO
  331. SEGDES,MLMOT1,MLMOT2
  332. ENDIF
  333. GOTO 449
  334.  
  335. 446 CONTINUE
  336. C La liste des grandeurs PRIMALEs/DDLs sont des MOTs.
  337. C La liste des ddls autorises = NOMDD defini dans BDATA.ESO
  338. C On doit lire au moins 1 ddl (car sinon MOTDDL est vide !)
  339. CALL LIRMOT(NOMDD,LNOMDD,IMOT,0)
  340. IF (IERR.NE.0) GOTO 1000
  341. IF (IMOT.NE.0) THEN
  342. MOTDDL(**)=NOMDD(IMOT)
  343. MOTDDL(**)=NOMDU(IMOT)
  344. ELSE
  345. CALL LIRCHA(CHADDL,0,IMOT)
  346. IF (IERR.NE.0) GOTO 1000
  347. IF (IMOT.EQ.0) GOTO 447
  348. MOTDDL(**)=CHADDL
  349. MOTDDL(**)=' '
  350. ENDIF
  351. GOTO 446
  352.  
  353. C Conditions aux limites via un MODELE --> non documente, non plus !
  354. 447 CONTINUE
  355. IBDDL=MOTDDL(/2)
  356. IPMODL = 0
  357. CALL LIROBJ('MMODEL ',IPMODL,0,IRETOU)
  358. IF (IERR.NE.0) GOTO 1000
  359. IF (IPMODL.EQ.0) THEN
  360. DO i = 2, IBDDL, 2
  361. IF (MOTDDL(i).EQ.' ') THEN
  362. MOTERR(1:4)=MOTDDL(i-1)
  363. CALL ERREUR(108)
  364. ENDIF
  365. ENDDO
  366. ELSE
  367. CALL ACTOBJ('MMODEL ',IPMODL,1)
  368. CALL NOVARD(IPMODL,'DEPL')
  369. CALL LIROBJ('LISTMOTS',MLMOT1,1,IRETOU)
  370. IF (IERR.NE.0) GOTO 1000
  371. CALL NOVARD(IPMODL,'FORC')
  372. CALL LIROBJ('LISTMOTS',MLMOT2,1,IRETOU)
  373. IF (IERR.NE.0) GOTO 1000
  374. SEGACT,MLMOT1,MLMOT2
  375. IMOT1 = MLMOT1.MOTS(/2)
  376. DO i = 2, IBDDL, 2
  377. IF (MOTDDL(i).EQ.' ') THEN
  378. CALL PLACE(MLMOT1.MOTS(1),IMOT1,iplac,MOTDDL(i-1))
  379. IF (iplac.EQ.0) THEN
  380. MOTERR(1:4)=MOTDDL(i-1)
  381. CALL ERREUR(197)
  382. ELSE
  383. MOTDDL(i)=MLMOT2.MOTS(iplac)
  384. ENDIF
  385. ENDIF
  386. ENDDO
  387. SEGSUP,MLMOT1,MLMOT2
  388. ENDIF
  389. IF (IERR.NE.0) GOTO 1000
  390.  
  391. 449 IBDDL=MOTDDL(/2)
  392. C Verification que le nombre de DDLs a bloquer n'est pas nul
  393. C IF (IBDDL.EQ.0) GOTO 1000
  394. C-----------------------------------------------------------------------
  395. C Fin de la lecture des mots (DEPL,ROTA...) ou des DDLs
  396. C-----------------------------------------------------------------------
  397.  
  398. C Recherche du maillage MELEME de type POINT :
  399. C ----------------------------------------------
  400. KOBJET=0
  401. MELEME=0
  402. C On cherche d'abord si on a un POINT que l'on transformera en POI1
  403. C sinon on cherche un maillage que l'on transforme en POI1 si besoin
  404. CALL LIROBJ('POINT',KPOINT,0,IRETOU)
  405. IF (IERR.NE.0) GOTO 1000
  406. IF (IRETOU.EQ.0) THEN
  407. CALL LIROBJ('MAILLAGE',KOBJET,1,IRETOU)
  408. IF (IERR.NE.0) GOTO 1000
  409. MELEME=KOBJET
  410. SEGACT,MELEME
  411. IF (ITYPEL.NE.1) CALL CHANGE(MELEME,1)
  412. NBPOIN=NUM(/2)
  413. ELSE
  414. MELEME=KPOINT
  415. CALL CRELEM(MELEME)
  416. NBPOIN=1
  417. ENDIF
  418. *
  419. IF (IDICHP.EQ.1) THEN
  420. * Cas ou la direction est donnee par un chpoint
  421. * On construit un segment MTRAV contenant les directions normees
  422. * WRITE(IOIMP,*) 'Transfo du chpoint en MTRA'
  423. * 1) Recopie des composantes et valeurs pertinentes du chpoint
  424. * dans le TMTRAV
  425. * Composantes recherchees (LMDEPL.MLMOTS)
  426. * sur les points du maillage MELEME
  427. JGN=4
  428. JGM=IDIM
  429. SEGINI,LMDEPL
  430. DO I=1,IDIM
  431. LMDEPL.MOTS(I)=MODEPL(IADEPL+I)
  432. ENDDO
  433. CALL CP2TR2(LMDEPL,MELEME,MCHPOI,MTRAV,IRET)
  434. SEGSUP LMDEPL
  435. SEGACT MELEME
  436. IF (IRET.NE.0) THEN
  437. CALL ERREUR(5)
  438. GOTO 1000
  439. ENDIF
  440. * 2) Calcul des normes
  441. * WRITE(IOIMP,*) 'Calcul des normes '
  442. SEGACT MTRAV*MOD
  443. DO IBPOIN=1,NBPOIN
  444. YL=0.D0
  445. DO I=1,IDIM
  446. XNOR(I)=BB(I,IBPOIN)
  447. YL=YL+XNOR(I)*XNOR(I)
  448. ENDDO
  449. IF (YL.LT.XPETIT) THEN
  450. CALL ERREUR(239)
  451. GOTO 1000
  452. ENDIF
  453. YL=1.D0/SQRT(YL)
  454. DO I=1,IDIM
  455. BB(I,IBPOIN)=XNOR(I)*YL
  456. ENDDO
  457. ENDDO
  458. * WRITE(IOIMP,*) 'Fin du calcul des normes '
  459. * SEGPRT,MTRAV
  460. ENDIF
  461. C Determination du nombre de multiplicateurs NNMAT par noeud de MELEME
  462. C NNMAT correspond au nombre de DDLs a bloquer par noeud = nombre de
  463. C multiplicateurs a creer par noeud (1 multiplicateur) = NRIGEL
  464. C Dans les cas RADIal et DIREction, on a une seule matrice par noeud.
  465. C Dans les autres cas, autant de matrices que MOTDDL(/2)/2.
  466. NNMAT=1
  467. IF (IDIREC+IRADIA.EQ.0) NNMAT=IBDDL/2
  468.  
  469. C Initialisation de l'objet RIGIDITE associe aux BLOCAGES
  470. NRIGE=8
  471. NRIGEL=NNMAT
  472. SEGINI,MRIGID
  473. MTYMAT=MOTRIG
  474. C* IFORIG=IFOMOD
  475. IFORIG=IFOUR
  476. ICHOLE=0
  477. IMGEO1=0
  478. IMGEO2=0
  479. KRIGI=MRIGID
  480.  
  481. C A chaque multplicateur est associe un nouveau noeud
  482. C NBPOIN : nombre de points du maillage MELEME a bloquer
  483. NBNO=nbpts
  484. NBNOI=NBNO
  485. NBPTS=NBNO+NNMAT*NBPOIN
  486. SEGADJ,MCOORD
  487.  
  488. C Boucle sur le nombre de DDLs a bloquer
  489. DO IAA=1,NNMAT
  490. C Pour chaque noeud du maillage, creation d'un noeud associe (place
  491. C initialement a l'origine) au IAA-eme DDL
  492. DO i=1,NBPOIN
  493. DO j=1,idimp1
  494. XCOOR(NBNOI*idimp1+j)=0.D0
  495. ENDDO
  496. NBNOI=NBNOI+1
  497. ENDDO
  498. C Creation du maillage MELEME de MULTiplicateurs associe aux BLOCAGES
  499. NBSOUS=0
  500. NBREF=0
  501. NBNN=2
  502. NBELEM=NBPOIN
  503. SEGINI,IPT1
  504. KIPT1=IPT1
  505. IPT1.ITYPEL=22
  506. DO i=1,NBPOIN
  507. j=(IAA-1)*NBPOIN+i
  508. IPT1.NUM(1,i)=NBNO+j
  509. IPT1.NUM(2,i)=NUM(1,i)
  510. IPT1.ICOLOR(i)=IDCOUL
  511. C Correction : Les pts mult sont a la meme position que les noeuds
  512. IREF3=(NUM(1,i)-1)*idimp1
  513. IREF1=(NBNO+j-1)*idimp1
  514. DO j=1,IDIM
  515. XCOOR(IREF1+j)=XCOOR(IREF3+j)
  516. ENDDO
  517. ENDDO
  518. C Creation des RAIDEURS associees au IAA-eme multplicateur (DDL)
  519. IRIGEL(1,IAA)=KIPT1
  520. IRIGEL(2,IAA)=0
  521. IRIGEL(5,IAA)=NIFOUR
  522. IRIGEL(6,IAA)=NILATE
  523. NLIGRP=2
  524. IF (IDIREC+IRADIA.NE.0) NLIGRP=1+LDEPL
  525. NLIGRD=NLIGRP
  526. C Remplissage du tableau des DESCripteurs de RIG
  527. SEGINI,DESCR
  528. IRIGEL(3,IAA)=DESCR
  529. NOELEP(1)=1
  530. NOELEP(2)=2
  531. NOELED(1)=1
  532. NOELED(2)=2
  533. IF (IDIREC+IRADIA.EQ.0) THEN
  534. j=2*(IAA-1)
  535. LISINC(1)='LX '
  536. LISINC(2)=MOTDDL(j+1)
  537. LISDUA(1)='FLX '
  538. LISDUA(2)=MOTDDL(j+2)
  539. ELSE
  540. DO i=1,LDEPL
  541. NOELEP(1+i)=2
  542. NOELED(1+i)=2
  543. IF (IROTA.NE.1) THEN
  544. LISINC(1+i)=MODEPL(IADEPL+i)
  545. LISDUA(1+i)=MODEDU(IADEPL+i)
  546. ELSE
  547. LISINC(1+i)=MOROTA(IADEPL+i)
  548. LISDUA(1+i)=MORODU(IADEPL+i)
  549. ENDIF
  550. ENDDO
  551. LISINC(1)='LX '
  552. LISDUA(1)='FLX '
  553. ENDIF
  554. SEGDES DESCR
  555.  
  556. C** NLIGRP=3
  557. C** IF (IDIREC+IRADIA.NE.0) NLIGRP=IDIM+2
  558. C** NLIGRD=NLIGRP
  559. NELRIG=NBPOIN
  560. SEGINI,XMATRI
  561. IRIGEL(4,IAA)=XMATRI
  562. COERIG(IAA)=1.D0
  563. C Remplissage de la matrice de rigidite RE :
  564. C Il faut distinguer les cas IRADIA, IDIREC et les autres
  565. C IRADIA : Il faut calculer la DIREction puis identique a IDIREC
  566. C IDIREC : La DIRECTION est stockee dans le vecteur norme XNOR
  567. C AUTRES : La matrice est predefinie dans RIG
  568. C Option RADIAL : Calcul prealable de la direction pour chaque noeud
  569. IF (IRADIA.NE.0) THEN
  570. DO IB=1,NBPOIN
  571. j=(NUM(1,IB)-1)*idimp1
  572. DO i=1,IDIM
  573. XNOR(i)=XCOOR(j+i)-U1(i)
  574. ENDDO
  575. IF (IDIM.EQ.2) THEN
  576. YL=XNOR(1)*XNOR(1)+XNOR(2)*XNOR(2)
  577. IF (YL.LT.EPSI) THEN
  578. CALL ERREUR(238)
  579. RETURN
  580. ENDIF
  581. YL=1.D0/SQRT(YL)
  582. IF (IRADIA.EQ.1) THEN
  583. XNOR(1)=XNOR(1)*YL
  584. XNOR(2)=XNOR(2)*YL
  585. ELSE IF (IRADIA.EQ.2) THEN
  586. XX=XNOR(1)
  587. XNOR(1)=-XNOR(2)*YL
  588. XNOR(2)=XX*YL
  589. ENDIF
  590. ELSE
  591. YL=XNOR(1)*U2(1)+XNOR(2)*U2(2)+XNOR(3)*U2(3)
  592. XL=0.D0
  593. DO i=1,3
  594. XNOR(i)=XNOR(i)-YL*U2(i)
  595. XL=XL+XNOR(i)*XNOR(i)
  596. ENDDO
  597. IF (XL.LT.EPSI) THEN
  598. CALL ERREUR(238)
  599. RETURN
  600. ENDIF
  601. IF (IRADIA.EQ.1) THEN
  602. XL=1.D0/SQRT(XL)
  603. XNOR(1)=XNOR(1)*XL
  604. XNOR(2)=XNOR(2)*XL
  605. XNOR(3)=XNOR(3)*XL
  606. ELSE IF (IRADIA.EQ.2) THEN
  607. XX=XNOR(1)
  608. YY=XNOR(2)
  609. ZZ=XNOR(3)
  610. XNOR(1)=YY*U2(3)-ZZ*U2(2)
  611. XNOR(2)=ZZ*U2(1)-XX*U2(3)
  612. XNOR(3)=XX*U2(2)-YY*U2(1)
  613. ENDIF
  614. ENDIF
  615. C XNOR contient la direction normee
  616. RE(1,1,IB)=0.D0
  617. RE(2,1,IB)=XNOR(1)
  618. RE(3,1,IB)=XNOR(2)
  619. RE(1,2,IB)=RE(2,1,IB)
  620. RE(1,3,IB)=RE(3,1,IB)
  621. IF (IDIM.EQ.3) THEN
  622. RE(4,1,IB)=XNOR(3)
  623. RE(1,4,IB)=RE(4,1,IB)
  624. ENDIF
  625. ENDDO
  626. C Option DIRECTION
  627. ELSE IF (IDIREC.EQ.1) THEN
  628. IF (IDICHP.EQ.1) THEN
  629. DO I=1,NBPOIN
  630. RE(1,1,i)=0.D0
  631. RE(2,1,i)=BB(1,I)
  632. RE(3,1,i)=BB(2,I)
  633. RE(1,2,i)=RE(2,1,i)
  634. RE(1,3,i)=RE(3,1,i)
  635. RE(2,3,i)=RE(3,2,i)
  636. IF (IDIM.EQ.3) THEN
  637. RE(4,1,i)=BB(3,I)
  638. RE(1,4,i)=RE(4,1,i)
  639. ENDIF
  640. ENDDO
  641. ELSE
  642. DO i=1,NBPOIN
  643. RE(1,1,i)=0.D0
  644. RE(2,1,i)=XNOR(1)
  645. RE(3,1,i)=XNOR(2)
  646. RE(1,2,i)=RE(2,1,i)
  647. RE(1,3,i)=RE(3,1,i)
  648. RE(2,3,i)=RE(3,2,i)
  649. IF (IDIM.EQ.3) THEN
  650. RE(4,1,i)=XNOR(3)
  651. RE(1,4,i)=RE(4,1,i)
  652. ENDIF
  653. * DO i=1,NBPOIN
  654. ENDDO
  655. SEGDES,xMATRI
  656. ENDIF
  657. C Autres options :
  658. ELSE
  659. DO i=1,NBPOIN
  660. RE(1,1,i)=0.D0
  661. RE(2,1,i)=1.D0
  662. RE(2,2,i)=0.D0
  663. RE(1,2,i)=RE(2,1,i)
  664. * DO i=1,NBPOIN
  665. ENDDO
  666. SEGDES,xMATRI
  667. SEGDES,IPT1
  668. ENDIF
  669. SEGDES,xMATRI
  670. ENDDO
  671. C Fin de la boucle sur les IAA DDLs a bloquer
  672. IF (IDICHP.EQ.1) THEN
  673. * WRITE(IOIMP,*) 'Destruction du segment de travail'
  674. SEGSUP,MTRAV
  675. ENDIF
  676. C Fin normale du traitement
  677. call relasi(mrigid)
  678. krigi=mrigid
  679. SEGDES,MRIGID
  680. CALL ECROBJ('RIGIDITE',KRIGI)
  681. IF (MELEME.GT.0) THEN
  682. IF (KOBJET.EQ.0) THEN
  683. SEGSUP,MELEME
  684. ELSE
  685. IF (MELEME.EQ.KOBJET) THEN
  686. SEGDES,MELEME
  687. ELSE
  688. ** SEGSUP,MELEME
  689. SEGDES,MELEME
  690. ENDIF
  691. ENDIF
  692. ENDIF
  693. C Il peut rester des maillages actifs
  694. MRIGID=KRIGI
  695. SEGACT,MRIGID
  696. DO i=1,IRIGEL(/2)
  697. MELEME=IRIGEL(1,i)
  698. IF (MELEME.GT.0) SEGDES,MELEME
  699. ENDDO
  700. SEGDES,MRIGID
  701.  
  702. C Sortie du sousprogramme (normale ou en cas d'erreur)
  703. 1000 SEGSUP,MSWBLO
  704. SEGDES,MCOORD
  705.  
  706. END
  707.  
  708.  
  709.  
  710.  
  711.  
  712.  
  713.  

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