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    PV090527  26/04/28    21:16:58     12529          
  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    I=1,NNIN
  136.         IINCO(I)=IINC(I)
  137.       enddo
  138.       SEGINI ITRAV
  139.       CALL ZERO(CC,NLIGMA,1)
  140.       CALL ZERO(DD,NLIGMA,KSIM)
  141.       CALL ZERO(VAA,KSIM*NNIN,ITES)
  142.       CALL ZERO(VBB,NNIN,ITES)
  143. C
  144. C  ****  ON INITIALISE IVECT QUI DIRA TOUTES LES INCONNUES EXISTANTES DA
  145. C  ****  LE CHAMPOINT. ON SUPPOSE QUE PAREIL POUR TOUS LES CHPOINTS
  146. C
  147.       MCHPOI=IRE1
  148.       DO 1543 KJI = 1, JVAL
  149.       MCHPO1=ISE2(KJI)
  150.       SEGACT MCHPO1
  151.  1543 CONTINUE
  152.       SEGACT,MCHPOI
  153.       NSOUPO=IPCHP(/1)
  154. *     WRITE(6,9005)
  155. *9005 FORMAT(' IMPRESSION NUMERO  5')
  156.       DO 15 ISOU=1,NSOUPO
  157.       MSOUPO=IPCHP(ISOU)
  158.       SEGACT,MSOUPO
  159.       MELEME=IGEOC
  160.       SEGACT,MELEME
  161.       MPOVAL=IPOVAL
  162.       SEGACT,MPOVAL
  163.       DO 1544 KJI=1,JVAL
  164.       MCHPO1=ISE2(KJI)
  165.       MSOUP1=MCHPO1.IPCHP(ISOU)
  166.       SEGACT MSOUP1
  167.       MPOVA1=MSOUP1.IPOVAL
  168.       SEGACT MPOVA1
  169.       MPO(KJI)=MPOVA1
  170.       SEGDES MSOUP1
  171.  1544 CONTINUE
  172.       SEGACT,MSOUPO
  173.       N2=VPOCHA(/1)
  174.       NC=VPOCHA(/2)
  175.       DO 16 INC=1,NC
  176.       INCOM=NOCOMP(INC)
  177.       NOHA=NOHARM(INC)
  178.       DO 17 IH=1,NNIN
  179.       IF(INCOM.NE.IINCO(IH)) GO TO 17
  180.       IF(NOHA.EQ.IHAR(IH)) GO TO 18
  181.    17 CONTINUE
  182.       GO TO 16
  183.    18 CONTINUE
  184.       DO 191 I2=1,N2
  185.       IK=ICPR(NUM(1,I2))
  186.       VBB(IH,IK)=VPOCHA(I2,INC)
  187.   191 CONTINUE
  188.       DO 190 KJI=1,JVAL
  189.       MPOVA1=MPO(KJI)
  190.       DO 19 I2=1,N2
  191.       IK=ICPR(NUM(1,I2))
  192.       VAA(KJI,IH,IK)=MPOVA1.VPOCHA(I2,INC)
  193.    19 CONTINUE
  194.   190 CONTINUE
  195.    16 CONTINUE
  196.       DO 1545 KJI=1,JVAL
  197.       MPOVA1=MPO(KJI)
  198.       SEGDES MPOVA1
  199.  1545 CONTINUE
  200.       SEGDES,MSOUPO
  201.       SEGDES,MPOVAL
  202.       SEGDES,MELEME
  203.    15 CONTINUE
  204. *     WRITE(6,9006)
  205. *9006 FORMAT(' IMPRESSION NUMERO  6')
  206.       SEGDES,MCHPOI
  207.       DO 1546 KJI=1,JVAL
  208.       MCHPO1=ISE2(KJI)
  209.       SEGDES MCHPO1
  210.  1546 CONTINUE
  211. C
  212. C  ****  BOUCLE 20 SUR LES OBJETS RIGIDITES ELEMENTAIRES
  213. C
  214.       SEGACT,MRIGID
  215.       DO 20 IRI=1,NRIGEL
  216.       MELEME=IRIGEL(1,IRI)
  217.       SEGACT,MELEME
  218.       DESCR=IRIGEL(3,IRI)
  219.       SEGACT,DESCR
  220.       LISI=LISINC(/2)
  221. C
  222. C  ****  ON REMPLIT IPOS(I)=J QUI DIT QUE LA IEME INCONNUES
  223. C  ****  DE LA MATRICE ELEMENTAIRE EST LA JEME DE IINC
  224. C
  225.       NOHA=IRIGEL(5,IRI)
  226.       DO 21 IN=1,LISI
  227.       NI=LISINC(IN)
  228.       DO 22 IJ=1,ININC
  229.       IF(NI.NE.IINC(IJ))  GO TO 22
  230.       IF(NOHA.EQ.IHAR(IJ))  GO TO 23
  231.    22 CONTINUE
  232.    23 CONTINUE
  233.       IPOS(IN)=IJ
  234.    21 CONTINUE
  235. C
  236. C  ****  BOUCLE 30 SUR TOUTES LES PETITES MATRICES D'UN OBJET
  237. C  ****  RIGIDITE ELEMENTAIRE.
  238. C
  239.       N1=NUM(/1)
  240.       N2=NUM(/2)
  241.       xMATRI=IRIGEL(4,IRI)
  242.       SEGACT,xMATRI
  243.       COER=COERIG(IRI)
  244.       DO 30 I2=1,N2
  245. C
  246. C  ****  AVANT D'EFFECTUER LE PRODUIT ON VERIFIE QU'IL EST A FAIRE
  247. C
  248.       DO 31 I1=1,N1
  249.       IF(ICPR(NUM(I1,I2)).NE.0) GO TO 32
  250.    31 CONTINUE
  251.       GO TO 30
  252.    32 CONTINUE
  253. C
  254. C  ****  FABRICATION D'UN VECTEUR ISSU DU CHAMPPOINT DE DIMENSION NLIGRE
  255. C
  256.       DO 33 IN=1,LISI
  257.       CC(IN)=0.D0
  258.       J2=ICPR(NUM(NOELEP(IN),I2))
  259.       IF(J2.EQ.0) GO TO 33
  260.       J1=IPOS(IN)
  261.       CC(IN)=VBB(J1,J2)
  262.    33 CONTINUE
  263.       DO 331 KN=1,JVAL
  264.       DO 330 IN=1,LISI
  265.       DD(KN,IN)=0.D0
  266.       J2=ICPR(NUM(NOELEP(IN),I2))
  267.       IF(J2.EQ.0)  GO TO 330
  268.       J1=IPOS(IN)
  269.       DD(KN,IN)=VAA(KN,J1,J2)
  270.   330 CONTINUE
  271.   331 CONTINUE
  272. C
  273. C  **** BOUCLE 35 SUR LES LIGNES D'UNE MATRICE ELEMENTAIRE
  274. C
  275. *      XMATRI=IMATTT(I2)
  276. *      SEGACT,XMATRI
  277.       DO 35 IN=1,LISI
  278.       VB=0.D0
  279.       DO 38 JN=1,LISI
  280. *      IF(JN.GT.IN)  GO TO 36
  281. *      IKO=(IN-1)*IN/2+JN
  282. *      GO TO 37
  283. *   36 CONTINUE
  284. *      IKO=(JN-1)*JN/2+IN
  285. *   37 VB=VB+CC(JN)*RE(JN,IN,i2)
  286.       VB=VB+CC(JN)*RE(JN,IN,i2)
  287.   38  CONTINUE
  288.       VB=VB*COER
  289.       DO 350 KN=1,JVAL
  290.       VSE(KN)=VSE(KN)+VB*DD(KN,IN)
  291.   350 CONTINUE
  292.    35 CONTINUE
  293. *      SEGDES,XMATRI
  294.    30 CONTINUE
  295.       SEGDES,xMATRI
  296.       SEGDES,DESCR
  297.  24   SEGDES MELEME
  298.    20 CONTINUE
  299.       SEGDES,MRIGID,ISE2,VSE
  300.       SEGSUP,ITRAV
  301.       SEGSUP,SIINC
  302.       SEGSUP,IHAR
  303.       SEGSUP ICPR,SIINCO,IPOS,MPO
  304.  5000 CONTINUE
  305.       RETURN
  306.       END
  307.  
  308.  
  309.  
  310.  
  311.  
  312.  

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