Télécharger la plaquette Cast3M


fr en

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