Télécharger bloque.eso

Retour à la liste

Numérotation des lignes :

bloque
  1. C BLOQUE SOURCE FANDEUR 22/01/03 21:15:03 11237
  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. IFORIG=IFOUR
  475. ICHOLE=0
  476. IMGEO1=0
  477. IMGEO2=0
  478. KRIGI=MRIGID
  479.  
  480. C A chaque multplicateur est associe un nouveau noeud
  481. C NBPOIN : nombre de points du maillage MELEME a bloquer
  482. NBNO=nbpts
  483. NBNOI=NBNO
  484. NBPTS=NBNO+NNMAT*NBPOIN
  485. SEGADJ,MCOORD
  486.  
  487. C Boucle sur le nombre de DDLs a bloquer
  488. DO IAA=1,NNMAT
  489. C Pour chaque noeud du maillage, creation d'un noeud associe (place
  490. C initialement a l'origine) au IAA-eme DDL
  491. DO i=1,NBPOIN
  492. DO j=1,idimp1
  493. XCOOR(NBNOI*idimp1+j)=0.D0
  494. ENDDO
  495. NBNOI=NBNOI+1
  496. ENDDO
  497. C Creation du maillage MELEME de MULTiplicateurs associe aux BLOCAGES
  498. NBSOUS=0
  499. NBREF=0
  500. NBNN=2
  501. NBELEM=NBPOIN
  502. SEGINI,IPT1
  503. KIPT1=IPT1
  504. IPT1.ITYPEL=22
  505. DO i=1,NBPOIN
  506. j=(IAA-1)*NBPOIN+i
  507. IPT1.NUM(1,i)=NBNO+j
  508. IPT1.NUM(2,i)=NUM(1,i)
  509. IPT1.ICOLOR(i)=IDCOUL
  510. C Correction : Les pts mult sont a la meme position que les noeuds
  511. IREF3=(NUM(1,i)-1)*idimp1
  512. IREF1=(NBNO+j-1)*idimp1
  513. DO j=1,IDIM
  514. XCOOR(IREF1+j)=XCOOR(IREF3+j)
  515. ENDDO
  516. ENDDO
  517. C Creation des RAIDEURS associees au IAA-eme multplicateur (DDL)
  518. IRIGEL(1,IAA)=KIPT1
  519. IRIGEL(2,IAA)=0
  520. IRIGEL(5,IAA)=NIFOUR
  521. IRIGEL(6,IAA)=NILATE
  522. NLIGRP=2
  523. IF (IDIREC+IRADIA.NE.0) NLIGRP=1+LDEPL
  524. NLIGRD=NLIGRP
  525. C Remplissage du tableau des DESCripteurs de RIG
  526. SEGINI,DESCR
  527. IRIGEL(3,IAA)=DESCR
  528. NOELEP(1)=1
  529. NOELEP(2)=2
  530. NOELED(1)=1
  531. NOELED(2)=2
  532. IF (IDIREC+IRADIA.EQ.0) THEN
  533. j=2*(IAA-1)
  534. LISINC(1)='LX '
  535. LISINC(2)=MOTDDL(j+1)
  536. LISDUA(1)='FLX '
  537. LISDUA(2)=MOTDDL(j+2)
  538. ELSE
  539. DO i=1,LDEPL
  540. NOELEP(1+i)=2
  541. NOELED(1+i)=2
  542. IF (IROTA.NE.1) THEN
  543. LISINC(1+i)=MODEPL(IADEPL+i)
  544. LISDUA(1+i)=MODEDU(IADEPL+i)
  545. ELSE
  546. LISINC(1+i)=MOROTA(IADEPL+i)
  547. LISDUA(1+i)=MORODU(IADEPL+i)
  548. ENDIF
  549. ENDDO
  550. LISINC(1)='LX '
  551. LISDUA(1)='FLX '
  552. ENDIF
  553. SEGDES DESCR
  554.  
  555. C** NLIGRP=3
  556. C** IF (IDIREC+IRADIA.NE.0) NLIGRP=IDIM+2
  557. C** NLIGRD=NLIGRP
  558. NELRIG=NBPOIN
  559. SEGINI,XMATRI
  560. IRIGEL(4,IAA)=XMATRI
  561. COERIG(IAA)=1.D0
  562. C Remplissage de la matrice de rigidite RE :
  563. C Il faut distinguer les cas IRADIA, IDIREC et les autres
  564. C IRADIA : Il faut calculer la DIREction puis identique a IDIREC
  565. C IDIREC : La DIRECTION est stockee dans le vecteur norme XNOR
  566. C AUTRES : La matrice est predefinie dans RIG
  567. C Option RADIAL : Calcul prealable de la direction pour chaque noeud
  568. IF (IRADIA.NE.0) THEN
  569. DO IB=1,NBPOIN
  570. j=(NUM(1,IB)-1)*idimp1
  571. DO i=1,IDIM
  572. XNOR(i)=XCOOR(j+i)-U1(i)
  573. ENDDO
  574. IF (IDIM.EQ.2) THEN
  575. YL=XNOR(1)*XNOR(1)+XNOR(2)*XNOR(2)
  576. IF (YL.LT.EPSI) THEN
  577. CALL ERREUR(238)
  578. RETURN
  579. ENDIF
  580. YL=1.D0/SQRT(YL)
  581. IF (IRADIA.EQ.1) THEN
  582. XNOR(1)=XNOR(1)*YL
  583. XNOR(2)=XNOR(2)*YL
  584. ELSE IF (IRADIA.EQ.2) THEN
  585. XX=XNOR(1)
  586. XNOR(1)=-XNOR(2)*YL
  587. XNOR(2)=XX*YL
  588. ENDIF
  589. ELSE
  590. YL=XNOR(1)*U2(1)+XNOR(2)*U2(2)+XNOR(3)*U2(3)
  591. XL=0.D0
  592. DO i=1,3
  593. XNOR(i)=XNOR(i)-YL*U2(i)
  594. XL=XL+XNOR(i)*XNOR(i)
  595. ENDDO
  596. IF (XL.LT.EPSI) THEN
  597. CALL ERREUR(238)
  598. RETURN
  599. ENDIF
  600. IF (IRADIA.EQ.1) THEN
  601. XL=1.D0/SQRT(XL)
  602. XNOR(1)=XNOR(1)*XL
  603. XNOR(2)=XNOR(2)*XL
  604. XNOR(3)=XNOR(3)*XL
  605. ELSE IF (IRADIA.EQ.2) THEN
  606. XX=XNOR(1)
  607. YY=XNOR(2)
  608. ZZ=XNOR(3)
  609. XNOR(1)=YY*U2(3)-ZZ*U2(2)
  610. XNOR(2)=ZZ*U2(1)-XX*U2(3)
  611. XNOR(3)=XX*U2(2)-YY*U2(1)
  612. ENDIF
  613. ENDIF
  614. C XNOR contient la direction normee
  615. RE(1,1,IB)=0.D0
  616. RE(2,1,IB)=XNOR(1)
  617. RE(3,1,IB)=XNOR(2)
  618. RE(1,2,IB)=RE(2,1,IB)
  619. RE(1,3,IB)=RE(3,1,IB)
  620. IF (IDIM.EQ.3) THEN
  621. RE(4,1,IB)=XNOR(3)
  622. RE(1,4,IB)=RE(4,1,IB)
  623. ENDIF
  624. ENDDO
  625. C Option DIRECTION
  626. ELSE IF (IDIREC.EQ.1) THEN
  627. IF (IDICHP.EQ.1) THEN
  628. DO I=1,NBPOIN
  629. RE(1,1,i)=0.D0
  630. RE(2,1,i)=BB(1,I)
  631. RE(3,1,i)=BB(2,I)
  632. RE(1,2,i)=RE(2,1,i)
  633. RE(1,3,i)=RE(3,1,i)
  634. RE(2,3,i)=RE(3,2,i)
  635. IF (IDIM.EQ.3) THEN
  636. RE(4,1,i)=BB(3,I)
  637. RE(1,4,i)=RE(4,1,i)
  638. ENDIF
  639. ENDDO
  640. ELSE
  641. DO i=1,NBPOIN
  642. RE(1,1,i)=0.D0
  643. RE(2,1,i)=XNOR(1)
  644. RE(3,1,i)=XNOR(2)
  645. RE(1,2,i)=RE(2,1,i)
  646. RE(1,3,i)=RE(3,1,i)
  647. RE(2,3,i)=RE(3,2,i)
  648. IF (IDIM.EQ.3) THEN
  649. RE(4,1,i)=XNOR(3)
  650. RE(1,4,i)=RE(4,1,i)
  651. ENDIF
  652. * DO i=1,NBPOIN
  653. ENDDO
  654. SEGDES,xMATRI
  655. ENDIF
  656. C Autres options :
  657. ELSE
  658. DO i=1,NBPOIN
  659. RE(1,1,i)=0.D0
  660. RE(2,1,i)=1.D0
  661. RE(2,2,i)=0.D0
  662. RE(1,2,i)=RE(2,1,i)
  663. * DO i=1,NBPOIN
  664. ENDDO
  665. SEGDES,xMATRI
  666. SEGDES,IPT1
  667. ENDIF
  668. SEGDES,xMATRI
  669. ENDDO
  670. C Fin de la boucle sur les IAA DDLs a bloquer
  671. IF (IDICHP.EQ.1) THEN
  672. * WRITE(IOIMP,*) 'Destruction du segment de travail'
  673. SEGSUP,MTRAV
  674. ENDIF
  675. C Fin normale du traitement
  676. call relasi(mrigid)
  677. krigi=mrigid
  678. SEGDES,MRIGID
  679. CALL ECROBJ('RIGIDITE',KRIGI)
  680. IF (MELEME.GT.0) THEN
  681. IF (KOBJET.EQ.0) THEN
  682. SEGSUP,MELEME
  683. ELSE
  684. IF (MELEME.EQ.KOBJET) THEN
  685. SEGDES,MELEME
  686. ELSE
  687. ** SEGSUP,MELEME
  688. SEGDES,MELEME
  689. ENDIF
  690. ENDIF
  691. ENDIF
  692. C Il peut rester des maillages actifs
  693. MRIGID=KRIGI
  694. SEGACT,MRIGID
  695. DO i=1,IRIGEL(/2)
  696. MELEME=IRIGEL(1,i)
  697. IF (MELEME.GT.0) SEGDES,MELEME
  698. ENDDO
  699. SEGDES,MRIGID
  700.  
  701. C Sortie du sousprogramme (normale ou en cas d'erreur)
  702. 1000 SEGSUP,MSWBLO
  703. SEGDES,MCOORD
  704.  
  705. END
  706.  
  707.  
  708.  
  709.  
  710.  
  711.  
  712.  
  713.  

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