Télécharger la plaquette Cast3M


fr en

Télécharger ytmxmu.eso

Retour à la liste

Numérotation des lignes : 

ytmxmu

  1. C YTMXMU    SOURCE    CB215821  20/11/25    13:44:37     10792          
  2.       SUBROUTINE YTMXMU(IRE1,JSE2,JVAL,IRE3,JVSE)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. C
  6. C  ****  ON PART DU PRINCIPE QUE TOUS LES CHPOINTS SONT IDENTIQUES
  7. C        ET QUE LA MATRICE EST SYMETRIQUE. CE SUBROUTINE N'EST
  8. C        APPELE QUE PAR SUPMAS.
  9. C
  10. C  ****  MULTIPLICATION D'UNE MATRICE(IRE3) PAR UN CHAMPPOINT (IRE1) A
  11. C  ****  GAUCHE ET PAR DES CHAMPPOINTS ISE2(JVAL) A DROITE.
  12. C  ****  VSE(J)=    IRE1 *IRE3 *ISE2(J)
  13. C
  14. C  ****  ON PART DU PRINCIPE QUE TOUS LES CHPOINTS SONT IDENTIQUES
  15. C
  16. C  ****  POUR EFFECTUER L'OPERATION ON ELIMINE LES COMPOSANTES LX
  17. C  ****  DU CHPOINT ET DE LA RIGIDITE. ON TESTE QUE LES AUTRES INCONNUES
  18. C  ****  DU CHPOINT SONT INCLUSES DANS CELLES DE L OBJET RIGIDITE
  19. C
  20.  
  21. -INC PPARAM
  22. -INC CCOPTIO
  23. -INC SMELEME
  24. -INC SMCHPOI
  25. -INC SMRIGID
  26. -INC SMCOORD
  27.       CHARACTER*(LOCOMP) NI,INCOM
  28.       SEGMENT,ISE2(LL)
  29.       SEGMENT,VSE(LL)*D
  30.       SEGMENT,MPO(LL)
  31.       SEGMENT,IHAR(0)
  32.       SEGMENT,SIINC
  33.        CHARACTER*(LOCOMP) IINC(0)
  34.       ENDSEGMENT
  35.       SEGMENT ICPR(nbpts)
  36.       SEGMENT/ITRAV/(CC(NLIGMA)*D,DD(KSIM,NLIGMA)*D,
  37.      *VAA(KSIM,NNIN,ITES)*D,VBB(NNIN,ITES)*D)
  38.       SEGMENT IPOS(NLIGMA)
  39.       SEGMENT SIINCO
  40.        CHARACTER*(LOCOMP) IINCO(NNIN)
  41.       ENDSEGMENT
  42. C ITES EST LE NONBRE DE NOEUD DU CHAMPPOINT. NLIGMA EST LA TAILLE
  43. C MAX D'UNE LIGNE DE MATRICE DE RIGIDITE ELEMENTAIRE.
  44. *     WRITE(6,9001)
  45. *9001 FORMAT(' IMPRESSION NUMERO  1')
  46.       KSIM=JVAL
  47.       VSE=JVSE
  48.       ISE2=JSE2
  49.       SEGACT VSE*MOD,ISE2
  50.       LL=JVAL
  51.       SEGINI MPO
  52.       DO 4597 KN=1,JVAL
  53.       VSE(KN)=0.D0
  54.  4597 CONTINUE
  55. *     WRITE(6,9002)
  56. *9002 FORMAT(' IMPRESSION NUMERO  2')
  57. C
  58. C  ****ON RETIRE DES CHPOINTS LES MULT. DE LAGRANGE S'IL Y EN A.
  59. C
  60. C
  61. C  ****  ON CREE LES TABLEAUX :
  62. C  ****  ICPR(I)=J VEUT DIRE QUE LE NOEUD I A LE NUMERO LOCAL J.
  63. C  ****  ON COMMENCE PAR RECENSER LES NOEUDS DU CHAMPPOINT.
  64. C
  65.       SEGINI ICPR
  66.       KMAX=nbpts
  67.       DO 6 K=1,KMAX
  68.       ICPR(K)=0
  69.     6 CONTINUE
  70.       IK=0
  71.       MCHPOI=IRE1
  72.       SEGACT,MCHPOI
  73.       NSOUPO=IPCHP(/1)
  74.       DO 1 ISOU=1,NSOUPO
  75.       MSOUPO=IPCHP(ISOU)
  76.       SEGACT,MSOUPO
  77.       MELEME=IGEOC
  78.       SEGACT,MELEME
  79.       N2=NUM(/2)
  80.       DO 2 I2=1,N2
  81.       K=NUM(1,I2)
  82.       IF(ICPR(K).NE.0)  GO TO 2
  83.       IK=IK+1
  84.       ICPR(K)=IK
  85.    2  CONTINUE
  86.       SEGDES,MELEME
  87.       SEGDES,MSOUPO
  88.    1  CONTINUE
  89.       SEGDES,MCHPOI
  90.       ITES=IK
  91. *     WRITE(6,9003)
  92. *9003 FORMAT(' IMPRESSION NUMERO  3')
  93. C
  94. C ****   ON INITIALISE LES INCONNUES A PRTIR DE LA MATRICE
  95. C
  96.       NLIGMA=0
  97.       SEGINI,SIINC
  98.       SEGINI,IHAR
  99.       MRIGID=IRE3
  100.       SEGACT,MRIGID
  101.       NRIGEL=IRIGEL(/2)
  102.       DESCR=IRIGEL(3,1)
  103.       SEGACT,DESCR
  104.       IINC(**)=LISINC(1)
  105.       IHAR(**)=IRIGEL(5,1)
  106.       ININC=1
  107.       DO 3 IRI=1,NRIGEL
  108.       MELEME=IRIGEL(1,IRI)
  109.       SEGACT,MELEME
  110.       DESCR=IRIGEL(3,IRI)
  111.       NOHA=IRIGEL(5,IRI)
  112.       SEGACT,DESCR
  113.       NLIGRE=LISINC(/2)
  114.       IF(NLIGRE.GT.NLIGMA) NLIGMA=NLIGRE
  115.       DO 7 I2=1,NLIGRE
  116.       DO 8 I1=1,ININC
  117.       IF(LISINC(I2).NE.IINC(I1)) GO TO 8
  118.       IF(NOHA.EQ.IHAR(I1)) GO TO 7
  119.    8  CONTINUE
  120.       IINC(**)=LISINC(I2)
  121.       IHAR(**)=NOHA
  122.       ININC=ININC+1
  123.    7  CONTINUE
  124.       SEGDES,DESCR
  125.       SEGDES MELEME
  126.    3  CONTINUE
  127.       SEGDES,MRIGID
  128. *     WRITE(6,9004)
  129. *9004 FORMAT(' IMPRESSION NUMERO  4')
  130. C
  131. C  ****  ON INITIALISE LE SEGMENT MTRAV
  132. C
  133.       NNIN=ININC
  134.       SEGINI SIINCO,IPOS
  135.       DO 10 I=1,NNIN
  136.    10 IINCO(I)=IINC(I)
  137.       SEGINI ITRAV
  138.       CALL ZERO(CC,NLIGMA,1)
  139.       CALL ZERO(DD,NLIGMA,KSIM)
  140.       CALL ZERO(VAA,KSIM*NNIN,ITES)
  141.       CALL ZERO(VBB,NNIN,ITES)
  142. C
  143. C  ****  ON INITIALISE IVECT QUI DIRA TOUTES LES INCONNUES EXISTANTES DA
  144. C  ****  LE CHAMPOINT. ON SUPPOSE QUE PAREIL POUR TOUS LES CHPOINTS
  145. C
  146.       MCHPOI=IRE1
  147.       DO 1543 KJI = 1, JVAL
  148.       MCHPO1=ISE2(KJI)
  149.       SEGACT MCHPO1
  150.  1543 CONTINUE
  151.       SEGACT,MCHPOI
  152.       NSOUPO=IPCHP(/1)
  153. *     WRITE(6,9005)
  154. *9005 FORMAT(' IMPRESSION NUMERO  5')
  155.       DO 15 ISOU=1,NSOUPO
  156.       MSOUPO=IPCHP(ISOU)
  157.       SEGACT,MSOUPO
  158.       MELEME=IGEOC
  159.       SEGACT,MELEME
  160.       MPOVAL=IPOVAL
  161.       SEGACT,MPOVAL
  162.       DO 1544 KJI=1,JVAL
  163.       MCHPO1=ISE2(KJI)
  164.       MSOUP1=MCHPO1.IPCHP(ISOU)
  165.       SEGACT MSOUP1
  166.       MPOVA1=MSOUP1.IPOVAL
  167.       SEGACT MPOVA1
  168.       MPO(KJI)=MPOVA1
  169.       SEGDES MSOUP1
  170.  1544 CONTINUE
  171.       SEGACT,MSOUPO
  172.       N2=VPOCHA(/1)
  173.       NC=VPOCHA(/2)
  174.       DO 16 INC=1,NC
  175.       INCOM=NOCOMP(INC)
  176.       NOHA=NOHARM(INC)
  177.       DO 17 IH=1,NNIN
  178.       IF(INCOM.NE.IINCO(IH)) GO TO 17
  179.       IF(NOHA.EQ.IHAR(IH)) GO TO 18
  180.    17 CONTINUE
  181.       GO TO 16
  182.    18 CONTINUE
  183.       DO 191 I2=1,N2
  184.       IK=ICPR(NUM(1,I2))
  185.       VBB(IH,IK)=VPOCHA(I2,INC)
  186.   191 CONTINUE
  187.       DO 190 KJI=1,JVAL
  188.       MPOVA1=MPO(KJI)
  189.       DO 19 I2=1,N2
  190.       IK=ICPR(NUM(1,I2))
  191.       VAA(KJI,IH,IK)=MPOVA1.VPOCHA(I2,INC)
  192.    19 CONTINUE
  193.   190 CONTINUE
  194.    16 CONTINUE
  195.       DO 1545 KJI=1,JVAL
  196.       MPOVA1=MPO(KJI)
  197.       SEGDES MPOVA1
  198.  1545 CONTINUE
  199.       SEGDES,MSOUPO
  200.       SEGDES,MPOVAL
  201.       SEGDES,MELEME
  202.    15 CONTINUE
  203. *     WRITE(6,9006)
  204. *9006 FORMAT(' IMPRESSION NUMERO  6')
  205.       SEGDES,MCHPOI
  206.       DO 1546 KJI=1,JVAL
  207.       MCHPO1=ISE2(KJI)
  208.       SEGDES MCHPO1
  209.  1546 CONTINUE
  210. C
  211. C  ****  BOUCLE 20 SUR LES OBJETS RIGIDITES ELEMENTAIRES
  212. C
  213.       SEGACT,MRIGID
  214.       DO 20 IRI=1,NRIGEL
  215.       MELEME=IRIGEL(1,IRI)
  216.       SEGACT,MELEME
  217.       DESCR=IRIGEL(3,IRI)
  218.       SEGACT,DESCR
  219.       LISI=LISINC(/2)
  220. C
  221. C  ****  ON REMPLIT IPOS(I)=J QUI DIT QUE LA IEME INCONNUES
  222. C  ****  DE LA MATRICE ELEMENTAIRE EST LA JEME DE IINC
  223. C
  224.       NOHA=IRIGEL(5,IRI)
  225.       DO 21 IN=1,LISI
  226.       NI=LISINC(IN)
  227.       DO 22 IJ=1,ININC
  228.       IF(NI.NE.IINC(IJ))  GO TO 22
  229.       IF(NOHA.EQ.IHAR(IJ))  GO TO 23
  230.    22 CONTINUE
  231.    23 CONTINUE
  232.       IPOS(IN)=IJ
  233.    21 CONTINUE
  234. C
  235. C  ****  BOUCLE 30 SUR TOUTES LES PETITES MATRICES D'UN OBJET
  236. C  ****  RIGIDITE ELEMENTAIRE.
  237. C
  238.       N1=NUM(/1)
  239.       N2=NUM(/2)
  240.       xMATRI=IRIGEL(4,IRI)
  241.       SEGACT,xMATRI
  242.       COER=COERIG(IRI)
  243.       DO 30 I2=1,N2
  244. C
  245. C  ****  AVANT D'EFFECTUER LE PRODUIT ON VERIFIE QU'IL EST A FAIRE
  246. C
  247.       DO 31 I1=1,N1
  248.       IF(ICPR(NUM(I1,I2)).NE.0) GO TO 32
  249.    31 CONTINUE
  250.       GO TO 30
  251.    32 CONTINUE
  252. C
  253. C  ****  FABRICATION D'UN VECTEUR ISSU DU CHAMPPOINT DE DIMENSION NLIGRE
  254. C
  255.       DO 33 IN=1,LISI
  256.       CC(IN)=0.D0
  257.       J2=ICPR(NUM(NOELEP(IN),I2))
  258.       IF(J2.EQ.0) GO TO 33
  259.       J1=IPOS(IN)
  260.       CC(IN)=VBB(J1,J2)
  261.    33 CONTINUE
  262.       DO 331 KN=1,JVAL
  263.       DO 330 IN=1,LISI
  264.       DD(KN,IN)=0.D0
  265.       J2=ICPR(NUM(NOELEP(IN),I2))
  266.       IF(J2.EQ.0)  GO TO 330
  267.       J1=IPOS(IN)
  268.       DD(KN,IN)=VAA(KN,J1,J2)
  269.   330 CONTINUE
  270.   331 CONTINUE
  271. C
  272. C  **** BOUCLE 35 SUR LES LIGNES D'UNE MATRICE ELEMENTAIRE
  273. C
  274. *      XMATRI=IMATTT(I2)
  275. *      SEGACT,XMATRI
  276.       DO 35 IN=1,LISI
  277.       VB=0.D0
  278.       DO 38 JN=1,LISI
  279. *      IF(JN.GT.IN)  GO TO 36
  280. *      IKO=(IN-1)*IN/2+JN
  281. *      GO TO 37
  282. *   36 CONTINUE
  283. *      IKO=(JN-1)*JN/2+IN
  284. *   37 VB=VB+CC(JN)*RE(JN,IN,i2)
  285.       VB=VB+CC(JN)*RE(JN,IN,i2)
  286.   38  CONTINUE
  287.       VB=VB*COER
  288.       DO 350 KN=1,JVAL
  289.       VSE(KN)=VSE(KN)+VB*DD(KN,IN)
  290.   350 CONTINUE
  291.    35 CONTINUE
  292. *      SEGDES,XMATRI
  293.    30 CONTINUE
  294.       SEGDES,xMATRI
  295.       SEGDES,DESCR
  296.  24   SEGDES MELEME
  297.    20 CONTINUE
  298.       SEGDES,MRIGID,ISE2,VSE
  299.       SEGSUP,ITRAV
  300.       SEGSUP,SIINC
  301.       SEGSUP,IHAR
  302.       SEGSUP ICPR,SIINCO,IPOS,MPO
  303.  5000 CONTINUE
  304.       RETURN
  305.       END
  306.  
  307.  
  308.  
  309.  
  310.  

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