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

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