Télécharger la plaquette Cast3M


fr en

Télécharger relaba.eso

Retour à la liste

Numérotation des lignes : 

relaba

  1. C RELABA    SOURCE    FANDEUR   22/01/03    21:15:40     11237          
  2.       SUBROUTINE RELABA
  3. *
  4. * relation barycentrique pour les ddl d'un noeud vis-à-vis
  5. * d'un maillage
  6. *  rig1 = rela bary lmot1 (ou 'DEPL' ou 'ROTA') p1 geo1
  7. *
  8. *
  9.       IMPLICIT INTEGER(I-N)
  10.       IMPLICIT REAL*8 (A-H,O-Z)
  11.  
  12. -INC PPARAM
  13. -INC CCOPTIO
  14. -INC CCGEOME
  15. -INC SMELEME
  16. -INC SMCOORD
  17. -INC SMRIGID
  18. -INC CCHAMP
  19. -INC SMLREEL
  20. -INC SMLMOTS
  21. c
  22.       CHARACTER*4 ITCORI(2),LEMOT,LESDDL(6),LESDUA(6)
  23.       CHARACTER*4 MODEPL(5),MODEDU(5),MOROTA(5),MORODU(5)
  24.       DATA ITCORI(1)/'DEPL'/
  25.       DATA ITCORI(2)/'ROTA'/
  26.       DATA MODEPL / 'UX  ','UY  ','UZ  ','UR  ','UT  ' /
  27.       DATA MODEDU / 'FX  ','FY  ','FZ  ','FR  ','FT  ' /
  28.       DATA MOROTA / 'RX  ','RY  ','RZ  ','RT  ','RS  ' /
  29.       DATA MORODU / 'MX  ','MY  ','MZ  ','MT  ','MS  ' /
  30.  
  31.       CALL LIROBJ('LISTMOTS',IP0,0,IRETOU)
  32.  
  33.       if (IP0.eq.0) then
  34.          CALL LIRMOT(ITCORI,2,IMOT,0)
  35.          if (imot.eq.0) then
  36.           call erreur(5)
  37.           return
  38.          else if (imot.eq.1) then
  39.           if (ifour.eq.2) then
  40.            nosddl = 3
  41.            lesddl(1) = modepl(1)
  42.            lesddl(2) = modepl(2)
  43.            lesddl(3) = modepl(3)
  44.           else
  45.           endif
  46.            CALL LIRMOT(ITCORI,2,IMOT,0)
  47.            if (imot.eq.2) then
  48.             if (ifour.eq.2) then
  49.              nosddl = 6
  50.              lesddl(4) = morota(1)
  51.              lesddl(5) = morota(2)
  52.              lesddl(6) = morota(3)
  53.             else
  54.             endif
  55.            endif
  56.          else
  57.            CALL LIRMOT(ITCORI,2,IMOT,0)
  58.            if (imot.eq.1) then
  59.             if (ifour.eq.2) then
  60.              nosddl = 6
  61.              iddl = 3
  62.             else
  63.             endif
  64.            else
  65.             if (ifour.eq.2) then
  66.              nosddl = 3
  67.              iddl = 0
  68.             else
  69.             endif
  70.  
  71.            endif
  72.            if (ifour.eq.2) then
  73.             lesddl(iddl + 1) = morota(1)
  74.             lesddl(iddl + 2) = morota(2)
  75.             lesddl(iddl + 3) = morota(3)
  76.           else
  77.           endif
  78.         endif
  79.       else
  80.        mlmots = ip0
  81.        segact mlmots
  82.        jgn = mots(/2)
  83.        do 11 imo = 1,jgn
  84.         do jde =1,5
  85.          if (mots(imo).eq.modepl(jde)) then
  86.            lesddl(imo) = modepl(jde)
  87.            lesdua(imo) = modedu(jde)
  88.            goto 11
  89.          endif
  90.         enddo
  91.         do jde = 1,5
  92.          if (mots(imo).eq.morota(jde)) then
  93.            lesddl(imo) = morota(jde)
  94.            lesdua(imo) = morodu(jde)
  95.            goto 11
  96.          endif
  97.         enddo
  98. c le mot  n est pas un ddl
  99.         call erreur(5)
  100.         return
  101.  11    continue
  102.        nosddl = jgn
  103.       endif
  104.  
  105.  
  106.       CALL LIROBJ('POINT',IP1,1,IRETOU)
  107.       CALL LIROBJ('MAILLAGE',IP2,1,IRETOU)
  108.       meleme = ip2
  109.       segact meleme
  110.       if (itypel.ne.1) call change(ip2,1)
  111.       meleme = ip2
  112.       segact meleme
  113.       nbele1 = num(/2)
  114.       ipt1 = ip2
  115.       CALL LIROBJ('LISTREEL',IP3,0,IRETOU)
  116.       if (iretou.eq.1) then
  117.        mlreel = ip3
  118.        segact mlreel
  119.        jg = prog(/1)
  120.        if (jg.ne.nbele1) then
  121. c autant de coef que de points
  122.          call erreur(5)
  123.          return
  124.        endif
  125.        som1 = prog(1)
  126.        do j = 2,jg
  127.          som1 = som1 + prog(j)
  128.        enddo
  129.        if (som1.eq.0.D0) then
  130. c somme des coefs nulle
  131.          call erreur(5)
  132.          return
  133.        endif
  134.       else
  135.        jg = 1
  136.       endif
  137.  
  138.  
  139. * cree multiplicateur(s)
  140.       segact mcoord*mod
  141.       NBPTI=nbpts
  142.       NBPTS = NBPTI + nosddl
  143.       segadj mcoord
  144.       do j = 1,nosddl
  145.        xcoor((nbpti - 1 + j)*(idim + 1) + 1) = 0.d0
  146.        xcoor((nbpti - 1 + j)*(idim + 1) + 2) = 0.d0
  147.        if (idim.eq.3) xcoor((nbpti - 1 + j)*(idim + 1) + 3) = 0.d0
  148.        xcoor((nbpti + j)*(idim + 1)) = 0.d0
  149.       enddo
  150.  
  151. * cree rigidite
  152.       NRIGE = 6
  153.       NRIGEL = nosddl
  154.       segini mrigid
  155.       ICHOLE=0
  156.       IMGEO1=0
  157.       IMGEO2=0
  158.       ISUPEQ=0
  159.       IFORIG=IFOUR
  160.       MTYMAT='RIGIDITE'
  161.  
  162.        NLIGRP=nbele1 + 2
  163.        NLIGRD=nbele1 + 2
  164.            nelrig=1
  165.        segini xmatri
  166. *       nelrig = 1
  167. *       segini imatri
  168. *       imattt(1) = xmatri
  169.        re(1,1,1) = 0.d0
  170.        if (jg.eq.1) then
  171.          re(1,2,1) = 1.D0/nbele1
  172.          re(2,1,1) = re(1,2,1)
  173.          do l = 1, nbele1
  174.           re(1,2 + l,1) = -1.D0
  175.           re(2+l,1,1) = -1.D0
  176.          enddo
  177.        else
  178.          re(1,2,1) = 1.D0/som1
  179.          re(2,1,1) = re(1,2,1)
  180.          do l = 1, nbele1
  181.           re(1,2 + l,1) = -1.D0*prog(l)
  182.           re(2+l,1,1) = re(1,2+l,1)
  183.          enddo
  184.        endif
  185.        segdes xmatri
  186.  
  187.       do ir = 1,nosddl
  188.         ipmu = NBPTI + ir
  189.         nbnn = nbele1 + 2
  190.         nbelem = 1
  191.         nbsous = 0
  192.         nbref = 0
  193.         segini meleme
  194.         itypel = 22
  195.         num(1,1) = ipmu
  196.         num(2,1) = ip1
  197.         segact ipt1
  198.         do in = 1,nbele1
  199.           num(2+in,1) = ipt1.num(1,in)
  200.         enddo
  201.         icolor(1) = idcoul
  202.         segdes meleme
  203.  
  204.        SEGINI DESCR
  205.        NOELEP(1)= 1
  206.        NOELED(1)= 1
  207.        LISINC(1)='LX'
  208.        LISDUA(1)='FLX'
  209.        do l = 1,nbele1+1
  210.          LISINC(1 + l)=lesddl(ir)
  211.          LISDUA(1 + l)=lesdua(ir)
  212.          NOELEP(1+l)= 1 + l
  213.          NOELED(1+l)= 1 + l
  214.        enddo
  215.        SEGDES DESCR
  216.  
  217.         coerig(ir) = 1.d0
  218.         IRIGEL(2,ir) = 0
  219.         IRIGEL(5,ir) = NIFOUR
  220.         IRIGEL(6,ir) = 0
  221.         IRIGEL(1,ir) = meleme
  222.         IRIGEL(3,ir) = descr
  223.         IRIGEL(4,ir) = xmatri
  224.  
  225.  
  226.       enddo
  227.       segdes mrigid
  228.  
  229.       CALL ECROBJ('RIGIDITE',mrigid)
  230.       RETURN
  231.       END
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  

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