Télécharger fx2lx.eso

Retour à la liste

Numérotation des lignes :

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

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