Télécharger fx2lx.eso

Retour à la liste

Numérotation des lignes :

  1. C FX2LX SOURCE BP208322 13/12/20 21:15:07 7890
  2.  
  3. SUBROUTINE FX2LX(IPRIG1,ILMOT1,IPRIGI)
  4. C========================================================================
  5. C MODIF DE RIGIDITE POUR TRANSFORMER LES INCONNUEs PRIMALEs FX EN LX
  6. C 27/07/2012
  7. c IPRIG1 : MRIGID initial (avec composantes ILMOT1 = FX ...)
  8. c actif en entree
  9. c IPRIGI : MRIGID final (avec composante FLX)
  10. c actif en sortie
  11. C========================================================================
  12.  
  13. IMPLICIT INTEGER(I-N)
  14. IMPLICIT REAL*8 (A-H,O-Z)
  15.  
  16. -INC CCREEL
  17. -INC CCOPTIO
  18. -INC SMCOORD
  19. -INC SMELEME
  20. -INC SMRIGID
  21. -INC SMLMOTS
  22.  
  23.  
  24. SEGMENT MTRAV
  25. INTEGER INC2LX(3,NBLX)
  26. ENDSEGMENT
  27. LOGICAL FLELIM
  28. CHARACTER*4 MOINC1,MOINC,MODUA1,MODUA
  29. * rem : dimension de itoto et jtoto en dur pour l'instant ...
  30. c INTEGER itoto(100),jtoto(100)
  31. INTEGER itoto(100)
  32.  
  33.  
  34. c-----------------------------------------------------
  35. c RECUPERATION DES ENTREES
  36. c-----------------------------------------------------
  37. MLMOT1 = ILMOT1
  38. nmot1 = MLMOT1.MOTS(/2)
  39. RI1 = IPRIG1
  40. NRIGE1 = RI1.IRIGEL(/2)
  41.  
  42. NBPTS = XCOOR(/1)/(IDIM+1)
  43.  
  44. NBLX = 1000
  45. segini,MTRAV
  46. nlx=0
  47.  
  48. c-----------------------------------------------------
  49. c PREPARATION DE LA RIGIDITE DE SORTIE
  50. c-----------------------------------------------------
  51. NRIGEL = 0
  52. segini,MRIGID
  53. IPRIGI=MRIGID
  54. MTYMAT = RI1.MTYMAT
  55.  
  56.  
  57. c==== Boucle sur les sous rigidites ==============================
  58. DO 1000 ityty=1,NRIGE1
  59.  
  60. c call ZERO(INC2LX,3,NBLX)
  61. cbp -> routine ZERO seulement pour les reels
  62. DO 100 Izero=1,3
  63. DO 100 Jzero=1,NBLX
  64. INC2LX(Izero,Jzero)=0
  65. 100 CONTINUE
  66.  
  67. c------ Recup -------------------------
  68. XCOE1 = RI1.COERIG(ityty)
  69. IPT1 = RI1.IRIGEL(1,ityty)
  70. DES1 = RI1.IRIGEL(3,ityty)
  71. XMATR1 = RI1.IRIGEL(4,ityty)
  72. NIFOU1 = RI1.IRIGEL(5,ityty)
  73.  
  74. c------ combien d'inconnues sont a séparer ? --------------------
  75. segact,DES1
  76. NLIGP1 = DES1.LISINC(/2)
  77. nbinc1=0
  78. FLELIM=.true.
  79. do 1010 iinc1=1,NLIGP1
  80. c va t'on trouvé cette inconnue ?
  81. do imot1=1,nmot1
  82. if(MLMOT1.MOTS(imot1).eq.DES1.LISINC(iinc1))then
  83. if(FLELIM)then
  84. nbinc1 = nbinc1 + 1
  85. if(iimpi.ge.3)
  86. & write(ioimp,*) iinc1,'ieme inconnue ',MLMOT1.MOTS(imot1)
  87. & ,'detectee comme étant a remplacer par un LX ',nbinc1
  88. goto 1010
  89. else
  90. write(ioimp,*) iinc1,'ieme inconnue ',MLMOT1.MOTS(imot1)
  91. & ,'detectee comme étant a remplacer par un LX mal positionnée !'
  92. call ERREUR(21)
  93. endif
  94. endif
  95. enddo
  96. c on s arrete car on suppose toutes celles a trouvées sont au debut
  97. c goto 1011
  98. c on va vérifier cette affirmation en continuant la boucle
  99. FLELIM=.false.
  100. 1010 continue
  101. 1011 continue
  102. if(FLELIM)then
  103. write(ioimp,*) 'On ne peut pas eliminer toutes les inconnues'
  104. call ERREUR(21)
  105. endif
  106. if(nbinc1.eq.0) goto 1000
  107.  
  108. c------ boucle sur les elements --------------------------------------
  109. segact,IPT1
  110. segact,XMATR1*mod
  111. NBNN1 = IPT1.NUM(/1)
  112. NBEL1 = IPT1.NUM(/2)
  113. do 1020 iel1=1,NBEL1
  114.  
  115. c-------- boucle sur les inconnues a remplacer --------------------
  116. do 1021 iinc1=1,nbinc1
  117.  
  118. c -LX existe-il deja? (<=> a t'on deja vu cet noeud+inconnue?)
  119. ino1 = IPT1.NUM(iinc1,iel1)
  120. IBPTS=0
  121. if(nlx.gt.0) then
  122. do ilx=1,nlx
  123. if (INC2LX(2,ilx).eq.ino1) then
  124. if (INC2LX(3,ilx).eq.imot1) then
  125. IBPTS = INC2LX(1,ilx)
  126. if(iimpi.ge.3)
  127. & write(ioimp,*) iinc1,'ieme inconnue ',DES1.LISINC(iinc1)
  128. & ,'detectee comme étant a remplacer par un LX ',nbinc1
  129. goto 1022
  130. endif
  131. endif
  132. enddo
  133. endif
  134.  
  135. c -si ce LX n'existe pas il faut le créer et ajouter le irigel
  136.  
  137. c on ajoute ce LX au tableau des inconnues a transformer
  138. NBPTS=NBPTS+1
  139. nlx=nlx+1
  140. if(nlx.gt.NBLX) then
  141. NBLX = NBLX + 1000
  142. segadj,MTRAV
  143. endif
  144. INC2LX(1,nlx)=NBPTS
  145. INC2LX(2,nlx)=ino1
  146. INC2LX(3,nlx)=imot1
  147.  
  148. c ajustement de irigel
  149. NRIGEL=NRIGEL+1
  150. segadj,MRIGID
  151. COERIG(NRIGEL) = XCOE1
  152.  
  153. c remplissage du maillage (les noeuds)
  154. NBSOUS=0
  155. NBREF=0
  156. NBNN = NBNN1+1
  157. NBELEM=1
  158. segini,MELEME
  159. ITYPEL=22
  160. NUM(1,1)=NBPTS
  161. inono=1
  162. do inode=1,NBNN1
  163. inono=inono+1
  164. NUM(inono,1)=IPT1.NUM(inode,iel1)
  165. enddo
  166. IRIGEL(1,NRIGEL) = MELEME
  167. c segdes,MELEME
  168.  
  169. c remplissage du DESCR + XMATRI
  170. c nbre d'inconnues = nbre initial + LX - celles qu'il faut enlever
  171. NLIGRP = NLIGP1+1-nbinc1
  172. NLIGRD = NLIGRP
  173. NELRIG = 1
  174. segini,DESCR,XMATRI
  175. LISINC(1)='LX '
  176. LISDUA(1)='FLX '
  177. NOELEP(1)= 1
  178. NOELED(1)= 1
  179. inono=1
  180. c on remplit le terme Ktt relatif au LX
  181. RE(1,1,1) = XMATR1.RE(iinc1,iinc1,iel1)
  182.  
  183. do iinc=(nbinc1+1),NLIGP1
  184. inono=inono+1
  185. LISINC(inono)=DES1.LISINC(iinc)
  186. LISDUA(inono)=DES1.LISDUA(iinc)
  187. c rem : on suppose qu'on a en entrée NOELEP = 1 2 1 2 3 4 5 6
  188. c et qu'on tranforme en LX les deux premieres inconnues.
  189. c Pour etre + général il faudrait faire une boucle
  190. c et identifier avec meleme
  191. NOELEP(inono)=1+DES1.NOELEP(iinc)
  192. NOELED(inono)=1+DES1.NOELED(iinc)
  193. jnono=1
  194. RE(inono,jnono,1)=XMATR1.RE(iinc,iinc1,iel1)
  195. RE(jnono,inono,1)=XMATR1.RE(iinc1,iinc,iel1)
  196. jnono=inono-1
  197. do jinc=iinc,NLIGP1
  198. jnono=jnono+1
  199. RE(inono,jnono,1)=XMATR1.RE(iinc,jinc,iel1)
  200. RE(jnono,inono,1)=XMATR1.RE(jinc,iinc,iel1)
  201. cbp : on met a 0, meme si ces termes ne sont que des 0
  202. c ou des 1 sur la diago pour eviter indeterminations....
  203. XMATR1.RE(iinc,jinc,iel1)=0.d0
  204. XMATR1.RE(jinc,iinc,iel1)=0.d0
  205. enddo
  206. enddo
  207. IRIGEL(3,NRIGEL) = DESCR
  208. IRIGEL(4,NRIGEL) = XMATRI
  209. IRIGEL(5,NRIGEL) = NIFOU1
  210.  
  211. GOTO 1021
  212.  
  213.  
  214. 1022 continue
  215. c -si ce LX existe , il est ajoute au irigel ilx (=nrigel)
  216. MELEME = IRIGEL(1,ilx)
  217. DESCR = IRIGEL(3,ilx)
  218. XMATRI = IRIGEL(4,ilx)
  219. c - y a t-il de nouveau noeud dans le melem ? -> au moins 1 WX de plus !
  220.  
  221. c somme pour le Ktt du LX qui est obligatoirement en commun
  222. RE(1,1,1) = RE(1,1,1) + XMATR1.RE(iinc1,iinc1,iel1)
  223.  
  224. c etape 1 : on remplit les tableaux de correspondance primal itoto
  225. c et dual jtoto (matrice RE d'entree -> de sortie)
  226.  
  227. c boucle sur les inconnues primales de la matrice en entrée
  228. do 1023 iinc=(nbinc1+1),NLIGP1
  229. itoto(iinc)=0
  230. inoe1 = DES1.NOELEP(iinc)
  231. inum1 = IPT1.NUM(inoe1,iel1)
  232. MOINC1 = DES1.LISINC(iinc)
  233. c on cherche inono = inconnue du nouveau mrigid
  234. c qui a le meme noeud et meme nom d'inconnue
  235. do 1024 inono = 1,NOELEP(/1)
  236. MOINC = LISINC(inono)
  237. if(MOINC.ne.MOINC1) goto 1024
  238. inoe = NOELEP(inono)
  239. inum = NUM(inoe,1)
  240. if(inum.ne.inum1) goto 1024
  241. c cas 1 : cette inconnue primale est partagée
  242. c => on remplit le tableau de correspondance
  243. itoto(iinc)=inono
  244. goto 1023
  245. 1024 continue
  246. c cas 2 : il s'agit d'une nouvelle inconnue primale
  247. c => il faut la créer + on crée aussi la duale
  248. c (en espérant qu'on commence toujours dans le coin en haut a gauche
  249. c et qu'on ne décrit pas des "bouts" de matrice
  250. c = correspondance implicite primale-duale)
  251. NBNN = NUM(/1)+1
  252. segadj,MELEME
  253. NUM(NBNN,1)=inum1
  254. NLIGRP = NOELEP(/1)+1
  255. NLIGRD = NLIGRP
  256. segadj,DESCR,XMATRI
  257. NOELEP(NLIGRP)=NBNN
  258. NOELED(NLIGRD)=NBNN
  259. LISINC(NLIGRP)=MOINC1
  260. LISDUA(NLIGRD)=DES1.LISDUA(iinc)
  261. itoto(iinc)=NLIGRP
  262. 1023 continue
  263.  
  264. c etape 2 : on fait la somme sur le triangle superieur et on symétrise
  265.  
  266. c boucle sur les inconnues primales de la matrice en entrée
  267. do 1025 iinc=(nbinc1+1),NLIGP1
  268. inono = itoto(iinc)
  269. c boucle sur les inconnues duales de la matrice en entrée
  270. do 1025 jinc=(nbinc1+1),iinc
  271. jnono = itoto(jinc)
  272. RE(jnono,inono,1) = RE(jnono,inono,1)
  273. & + XMATR1.RE(jinc,iinc,iel1)
  274. RE(inono,jnono,1) = RE(jnono,inono,1)
  275. 1025 continue
  276.  
  277.  
  278. 1021 continue
  279. c-------- fin de boucle sur les inconnues a remplacer -----------------
  280.  
  281. 1020 continue
  282. c------ fin de boucle sur les elements --------------------------------
  283.  
  284.  
  285. 1000 CONTINUE
  286. c==== fin de Boucle sur les sous rigidites ========================
  287.  
  288. segadj,MCOORD
  289.  
  290. c-------------------------------
  291. c MENAGE AVANT DE QUITTER
  292. c-------------------------------
  293.  
  294. segsup,MTRAV
  295.  
  296. C on desactive la sortie
  297. do iri=1,IRIGEL(/2)
  298. XMATRI = IRIGEL(4,iri)
  299. DESCR = IRIGEL(3,iri)
  300. MELEME = IRIGEL(1,iri)
  301. segdes,XMATRI,DESCR,MELEME
  302. enddo
  303. c on laisse MRIGID actif
  304.  
  305. C on supprime l entree
  306. do iri=1,RI1.IRIGEL(/2)
  307. XMATRI = RI1.IRIGEL(4,iri)
  308. DESCR = RI1.IRIGEL(3,iri)
  309. MELEME = RI1.IRIGEL(1,iri)
  310. if(XMATRI.ne.0) segsup,XMATRI
  311. if(DESCR.ne.0) segsup,DESCR
  312. if(MELEME.ne.0) segsup,MELEME
  313. enddo
  314. segsup,RI1
  315.  
  316. RETURN
  317.  
  318. END
  319.  
  320.  
  321.  
  322.  
  323.  
  324.  
  325.  
  326.  
  327.  

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