Télécharger la plaquette Cast3M


fr en

Télécharger rglimo.eso

Retour à la liste

Numérotation des lignes : 

rglimo

  1. C RGLIMO    SOURCE    PV090527  26/04/30    21:16:15     12529          
  2.       SUBROUTINE RGLIMO(IMODE,ISOLS,ISTRU,IRIG,IRET)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. C
  6. C=======================================================================
  7. C  CE SUBROUTINE CALCULE LOBJET RIGIDITE QUI COUPLE LES LIAISONS ET
  8. C  LES MODES . (FORMALISME GIBERT).
  9. C  CETTE RIGIDITE EST DE TYPE MASSE.
  10. C  ELLE EST ASSOCIEE A L ELEMENT QUI CONTIENT :
  11. C    . LE POINT QUI EST L INDICE DU MODE
  12. C    . LE POINT QUI EST ASSOCIE A LA LIAISON.
  13. C  ELEMENT DE TYPE 27. LE RESULTAT EST MIS DANS IRET .
  14. C
  15. C  APPELE PAR RIGI, RGBASE
  16. C  APPELLE ETALPR,ETALCH,ECCHPO,ERREUR(234,235)
  17. C  ECRIT PAR FARVACQUE
  18. C=======================================================================
  19. C
  20.  
  21. -INC PPARAM
  22. -INC CCOPTIO
  23. -INC SMRIGID
  24. -INC SMCOORD
  25. -INC CCREEL
  26. *-
  27. -INC SMSOLUT
  28. -INC SMATTAC
  29. -INC SMELEME
  30.       SEGMENT ICPR(nbpts)
  31.  
  32.       SEGMENT IINC
  33.        CHARACTER*(LOCOMP) CIINC(0)
  34.       ENDSEGMENT
  35.  
  36.       INTEGER IMATBL
  37.       SEGMENT/ICONTR/(MCONTR(NNI1,IPR1))
  38.       SEGMENT/MVA/(VA(NNI1,IPR1)*D),MVA1.MVA
  39.       SEGMENT IPB(IPR1)
  40.       SEGMENT ITRAV(6)
  41.  
  42.       IMATBL=0
  43.       NBSOUS=0
  44.       NBREF=0
  45.       NBNN=2
  46. *      LVAL=3
  47.       NLIGRP=2
  48.       NLIGRD=2
  49.       IRET=0
  50. C
  51.       IF(ISOLS.EQ.0.OR.IMODE.EQ.0) GO TO 5000
  52.       IF(IRIG.NE.1) GO TO 5000
  53.       MSOLUT=ISOLS
  54.       SEGACT MSOLUT
  55.       KJONC=MSOLIS(10)
  56.       MELSOL=MSOLIS(3)
  57.       MELEME=MELSOL
  58.       MSOLE2=KJONC
  59.       SEGDES MSOLUT
  60. C
  61.       MSOLUT=IMODE
  62.       SEGACT MSOLUT
  63.       KVALM=MSOLIS(4)
  64.       KDEPL=MSOLIS(5)
  65.       MELMOD=MSOLIS(3)
  66.       MELEME=MELMOD
  67.       SEGDES MSOLUT
  68.       MSOLEN=KVALM
  69.       MSOLE1=KDEPL
  70.       IF(MSOLE1.NE.0) GO TO 9
  71.       MOTERR(1:8)='SOLUTION'
  72.       MOTERR(9:26)=ITYSOL
  73.       MOTERR(30:38)='DEPL'
  74.       CALL ERREUR(235)
  75. C     ON NE TROUVE PAS LA TABLE QUI CONTIENT LES DEPLACEMENTS
  76.       GO TO 5000
  77.  9    CONTINUE
  78.       SEGACT MSOLE2
  79. C
  80. C  **** ON COMPTE LES LIAISONS LIBRES(NZRILI) ET BLOQUEES(NZRIBL)
  81. C  **** ON INITIALISE UN MELEME POUR CHAQUE CAS : IPT1(LIBRE),IPT2(BLOQU
  82. C
  83.       NZRILI=0
  84.       NZRIBL=0
  85.       NRIGEL=0
  86.       NJONC=MSOLE2.ISOLEN(/1)
  87.       IF(NJONC.NE.0) THEN
  88.         DO 20 I=1,NJONC
  89.         MJONCT=MSOLE2.ISOLEN(I)
  90.         SEGACT MJONCT
  91.         IF(MJOTYP.EQ.'MECA'.OR.MJOTYP.EQ.'FLUI') THEN
  92.           IF(MJODDL.EQ.'LX  ') NZRILI=NZRILI+1
  93.           IF(MJODDL.EQ.'FLX ') NZRIBL=NZRIBL+1
  94.         ENDIF
  95.         SEGDES MJONCT
  96.  20     CONTINUE
  97.       ENDIF
  98.       SEGDES MSOLE2
  99.       IF(NZRILI.EQ.0.AND.NZRIBL.EQ.0) GO TO 5000
  100. C
  101.       SEGINI ITRAV
  102.       SEGACT MSOLEN,MSOLE1,MSOLE2
  103.       NMOD=ISOLEN(/1)
  104. C
  105.       IF(NZRILI.EQ.0) GO TO 29
  106.       NBELEM=NMOD*NZRILI
  107.       SEGINI IPT1
  108.       IPT1.ITYPEL=27
  109.       NLIGRP=2
  110.       NLIGRD=2
  111.       SEGINI DESCR
  112.       NOELEP(1)=1
  113.       NOELEP(2)=2
  114.       NOELED(1)=1
  115.       NOELED(2)=2
  116.           NELRIG=NBELEM
  117.       rigrel=0
  118.       SEGINI xMATRI
  119.       IMATLI=xMATRI
  120. *      SEGDES IMATRI
  121.       LISINC(1)='ALFA'
  122.       LISINC(2)='BETA'
  123.       LISDUA(1)='FALF'
  124.       LISDUA(2)='FBET'
  125.       SEGDES DESCR
  126.       NRIGEL=NRIGEL+1
  127.       ITRAV(NRIGEL)=IPT1
  128.       NRIGEL=NRIGEL+1
  129.       ITRAV(NRIGEL)=DESCR
  130.       NRIGEL=NRIGEL+1
  131.       ITRAV(NRIGEL)=IMATLI
  132. C
  133.  29   IF(NZRIBL.EQ.0) GO TO 290
  134.       NBELEM=NMOD*NZRIBL
  135.       SEGINI IPT2
  136.       IPT2.ITYPEL=27
  137.       NLIGRP=2
  138.       NLIGRD=2
  139.       SEGINI DESCR
  140.           NELRIG=NBELEM
  141.       rigrel=0
  142.       SEGINI xMATRI
  143.       IMATBL=xMATRI
  144. *      SEGDES IMATRI
  145.       NOELEP(1)=1
  146.       NOELEP(2)=2
  147.       NOELED(1)=1
  148.       NOELED(2)=2
  149.       LISINC(1)='ALFA'
  150.       LISINC(2)='FBET'
  151.       LISDUA(1)='FALF'
  152.       LISDUA(2)='BETA'
  153.       SEGDES DESCR
  154.       NRIGEL=NRIGEL+1
  155.       ITRAV(NRIGEL)=IPT2
  156.       NRIGEL=NRIGEL+1
  157.       ITRAV(NRIGEL)=DESCR
  158.       NRIGEL=NRIGEL+1
  159.       ITRAV(NRIGEL)=IMATBL
  160.  290  CONTINUE
  161. C
  162. C  **** PREPARATION DE KMVA,KMVB,IPB POUR ETALER LES CHPOINTS
  163. C
  164.       IPM=MSOLE1.ISOLEN(1)
  165.       CALL ACTOBJ('CHPOINT ',IPM,1)
  166.       CALL ETALPR(IPM,KIINC,KICPR,KCONTR)
  167.       ICONTR=KCONTR
  168.       SEGACT ICONTR
  169.       IPR1=MCONTR(/2)
  170.       NNI1=MCONTR(/1)
  171.       SEGINI MVA
  172.       KMVA=MVA
  173.       SEGINI MVA
  174.       KMVB=MVA
  175.       SEGINI IPB
  176.       KIPB=IPB
  177. C
  178. C  **** BOUCLE SUR LES MODES .IPO1 EST LE POINT QUI CORRESPOND AU MODE
  179. C  **** IP2 LE CHPOINT QU ON ETALE DANS KMVA
  180. C
  181.       NZRILI=0
  182.       NZRIBL=0
  183.       MELEME=MELMOD
  184.       SEGACT MELEME
  185.       MELEME=MELSOL
  186.       SEGACT MELEME
  187.       DO 2 IM=1,ISOLEN(/1)
  188.       MELEME=MELMOD
  189.       IPO1=NUM(1,IM)
  190.       MMODE=ISOLEN(IM)
  191.       SEGACT MMODE
  192.       OMEG=2.*XPI*FMMODD(1)
  193.       OMEG=OMEG*OMEG
  194.       SEGDES MMODE
  195.       IP2=MSOLE1.ISOLEN(IM)
  196.       IF(IP2.NE.0) GO TO 8
  197.       MSOLUT=IMODE
  198.       SEGACT MSOLUT
  199.       MOTERR(1:8)=ITYSOL
  200.       SEGDES MSOLUT
  201.       MOTERR(9:12)='DEPL'
  202.       INTERR(1)=IM
  203.       CALL ERREUR(234)
  204.       GO TO 5000
  205.  8    CONTINUE
  206.       KZERO=0
  207.       CALL ETALCH(IP2,KIINC,KICPR,KCONTR,KMVA,KZERO,IBID,1)
  208. C
  209. C  **** BOUCLE SUR LES MJONCT . IPO2 EST LE POINT QUI CORRESPOND
  210. C
  211.       DO 30 IJ=1,NJONC
  212.       MJONCT=MSOLE2.ISOLEN(IJ)
  213.       SEGACT MJONCT
  214.       RLIBRE=-1.
  215.       IF(MJODDL.EQ.'FLX ') RLIBRE=1.
  216.       MELEME=MELSOL
  217.       IPO2=NUM(1,IJ)
  218. C
  219. C  **** FABRICATION DE L ELEMENT. INITIALISATION DE XMATRI
  220. C
  221. *      SEGINI XMATRI
  222.       IF(RLIBRE.EQ.1.) GO TO 16
  223.       NZRILI=NZRILI+1
  224.       IPT1.NUM(1,NZRILI)=IPO1
  225.       IPT1.NUM(2,NZRILI)=IPO2
  226.       xMATRI=IMATLI
  227.           segact xmatri*mod
  228.           izpos=nzrili
  229. *      SEGACT IMATRI*MOD
  230. *      IMATTT(NZRILI)=XMATRI
  231. *      SEGDES IMATRI
  232.       GO TO 17
  233.  16   CONTINUE
  234.       NZRIBL=NZRIBL+1
  235.       IPT2.NUM(1,NZRIBL)=IPO1
  236.       IPT2.NUM(2,NZRIBL)=IPO2
  237.       xMATRI=IMATBL
  238.           segact xmatri*mod
  239.           izpos=NZRIBL
  240. *      SEGACT IMATRI*MOD
  241. *      IMATTT(NZRIBL)=XMATRI
  242. *      SEGDES IMATRI
  243.  17   CONTINUE
  244. C
  245. C  **** DANS MJONCT ON CHERCHE LA STRUCTURE MSOSTU
  246. C  **** IPP2 EST LE CHPOINT DE P QU ON ETALE DANS KMVB.ON REMPLIT IPB.
  247. C
  248.       NST=ISTRJO(/1)
  249.       DO 31 IS=1,NST
  250.       IF(ISTRJO(IS).NE. ISTRU) GO TO 31
  251.       IPP2=IPCHJO(IS)
  252.       CALL ETALCH(IPP2,KIINC,KICPR,KCONTR,KMVB,KIPB,NPR2,1)
  253. C
  254. C  ****  OPERATION KMVA*KMVB
  255. C
  256.       MVA=KMVA
  257.       MVA1=KMVB
  258.       IPB=KIPB
  259. C      SEGACT MVA,MVA1,IPB
  260.       XRET=0.
  261.       DO    J1=1,NPR2
  262.       JJ1=IPB(J1)
  263.       DO    I1=1,NNI1
  264.       XRET=XRET+VA(I1,JJ1)*MVA1.VA(I1,JJ1)
  265.       enddo    
  266.       enddo    
  267.       RE(1,2,izpos)=RE(1,2,izpos)+RLIBRE*XRET/OMEG
  268.       RE(2,1,izpos)=RE(1,2,izpos)
  269. C
  270.  31   CONTINUE
  271.       SEGDES MJONCT,xmatri
  272.  30   CONTINUE
  273.  
  274. C
  275.  2    CONTINUE
  276.       MELEME=MELSOL
  277.       MELEME=MELMOD
  278.       SEGDES MSOLE1,MSOLE2,MSOLEN
  279.       xMATRI=IMATLI
  280.       IF(NZRILI.NE.0)SEGDES xMATRI,IPT1
  281.       xMATRI=IMATBL
  282.       IF(NZRIBL.NE.0)SEGDES xMATRI,IPT2
  283.       IINC=KIINC
  284.       SEGSUP IINC
  285.       ICPR=KICPR
  286.       SEGSUP ICPR
  287.       SEGSUP MVA,MVA1,IPB,ICONTR
  288. C
  289. C
  290. C  **** FABRICATION DU SEGMENT MRIGID
  291. C
  292.       NRIGEL=NRIGEL/3
  293.       IF(NRIGEL.EQ.0) GO TO 5000
  294.       NRIGE=6
  295.       SEGINI MRIGID
  296.       DO 40 I=1,NRIGEL
  297.       IRIGEL(1,I)=ITRAV(3*I-2)
  298.       IRIGEL(2,I)=0
  299.       IRIGEL(3,I)=ITRAV(3*I-1)
  300.       IRIGEL(4,I)=ITRAV(3*I)
  301.       IRIGEL(5,I)=NIFOUR
  302.       IRIGEL(6,I)=0
  303.       COERIG(I)=1.D0
  304.  40   CONTINUE
  305.       SEGSUP ITRAV
  306.       MTYMAT='MASSE'
  307.       ICHOLE=0
  308.       IMGEO1=0
  309.       IMGEO2=0
  310.       IFORIG=IFOUR
  311.       SEGDES MRIGID
  312.       IRET=MRIGID
  313.  5000 CONTINUE
  314.       END
  315.  
  316.  
  317.  
  318.  
  319.  
  320.  
  321.  
  322.  
  323.  

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