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    CB215821  25/04/23    21:15:41     12247          
  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.       SEGINI xMATRI
  118.       IMATLI=xMATRI
  119. *      SEGDES IMATRI
  120.       LISINC(1)='ALFA'
  121.       LISINC(2)='BETA'
  122.       LISDUA(1)='FALF'
  123.       LISDUA(2)='FBET'
  124.       SEGDES DESCR
  125.       NRIGEL=NRIGEL+1
  126.       ITRAV(NRIGEL)=IPT1
  127.       NRIGEL=NRIGEL+1
  128.       ITRAV(NRIGEL)=DESCR
  129.       NRIGEL=NRIGEL+1
  130.       ITRAV(NRIGEL)=IMATLI
  131. C
  132.  29   IF(NZRIBL.EQ.0) GO TO 290
  133.       NBELEM=NMOD*NZRIBL
  134.       SEGINI IPT2
  135.       IPT2.ITYPEL=27
  136.       NLIGRP=2
  137.       NLIGRD=2
  138.       SEGINI DESCR
  139.           NELRIG=NBELEM
  140.       SEGINI xMATRI
  141.       IMATBL=xMATRI
  142. *      SEGDES IMATRI
  143.       NOELEP(1)=1
  144.       NOELEP(2)=2
  145.       NOELED(1)=1
  146.       NOELED(2)=2
  147.       LISINC(1)='ALFA'
  148.       LISINC(2)='FBET'
  149.       LISDUA(1)='FALF'
  150.       LISDUA(2)='BETA'
  151.       SEGDES DESCR
  152.       NRIGEL=NRIGEL+1
  153.       ITRAV(NRIGEL)=IPT2
  154.       NRIGEL=NRIGEL+1
  155.       ITRAV(NRIGEL)=DESCR
  156.       NRIGEL=NRIGEL+1
  157.       ITRAV(NRIGEL)=IMATBL
  158.  290  CONTINUE
  159. C
  160. C  **** PREPARATION DE KMVA,KMVB,IPB POUR ETALER LES CHPOINTS
  161. C
  162.       IPM=MSOLE1.ISOLEN(1)
  163.       CALL ACTOBJ('CHPOINT ',IPM,1)
  164.       CALL ETALPR(IPM,KIINC,KICPR,KCONTR)
  165.       ICONTR=KCONTR
  166.       SEGACT ICONTR
  167.       IPR1=MCONTR(/2)
  168.       NNI1=MCONTR(/1)
  169.       SEGINI MVA
  170.       KMVA=MVA
  171.       SEGINI MVA
  172.       KMVB=MVA
  173.       SEGINI IPB
  174.       KIPB=IPB
  175. C
  176. C  **** BOUCLE SUR LES MODES .IPO1 EST LE POINT QUI CORRESPOND AU MODE
  177. C  **** IP2 LE CHPOINT QU ON ETALE DANS KMVA
  178. C
  179.       NZRILI=0
  180.       NZRIBL=0
  181.       MELEME=MELMOD
  182.       SEGACT MELEME
  183.       MELEME=MELSOL
  184.       SEGACT MELEME
  185.       DO 2 IM=1,ISOLEN(/1)
  186.       MELEME=MELMOD
  187.       IPO1=NUM(1,IM)
  188.       MMODE=ISOLEN(IM)
  189.       SEGACT MMODE
  190.       OMEG=2.*XPI*FMMODD(1)
  191.       OMEG=OMEG*OMEG
  192.       SEGDES MMODE
  193.       IP2=MSOLE1.ISOLEN(IM)
  194.       IF(IP2.NE.0) GO TO 8
  195.       MSOLUT=IMODE
  196.       SEGACT MSOLUT
  197.       MOTERR(1:8)=ITYSOL
  198.       SEGDES MSOLUT
  199.       MOTERR(9:12)='DEPL'
  200.       INTERR(1)=IM
  201.       CALL ERREUR(234)
  202.       GO TO 5000
  203.  8    CONTINUE
  204.       KZERO=0
  205.       CALL ETALCH(IP2,KIINC,KICPR,KCONTR,KMVA,KZERO,IBID,1)
  206. C
  207. C  **** BOUCLE SUR LES MJONCT . IPO2 EST LE POINT QUI CORRESPOND
  208. C
  209.       DO 30 IJ=1,NJONC
  210.       MJONCT=MSOLE2.ISOLEN(IJ)
  211.       SEGACT MJONCT
  212.       RLIBRE=-1.
  213.       IF(MJODDL.EQ.'FLX ') RLIBRE=1.
  214.       MELEME=MELSOL
  215.       IPO2=NUM(1,IJ)
  216. C
  217. C  **** FABRICATION DE L ELEMENT. INITIALISATION DE XMATRI
  218. C
  219. *      SEGINI XMATRI
  220.       IF(RLIBRE.EQ.1.) GO TO 16
  221.       NZRILI=NZRILI+1
  222.       IPT1.NUM(1,NZRILI)=IPO1
  223.       IPT1.NUM(2,NZRILI)=IPO2
  224.       xMATRI=IMATLI
  225.           segact xmatri*mod
  226.           izpos=nzrili
  227. *      SEGACT IMATRI*MOD
  228. *      IMATTT(NZRILI)=XMATRI
  229. *      SEGDES IMATRI
  230.       GO TO 17
  231.  16   CONTINUE
  232.       NZRIBL=NZRIBL+1
  233.       IPT2.NUM(1,NZRIBL)=IPO1
  234.       IPT2.NUM(2,NZRIBL)=IPO2
  235.       xMATRI=IMATBL
  236.           segact xmatri*mod
  237.           izpos=NZRIBL
  238. *      SEGACT IMATRI*MOD
  239. *      IMATTT(NZRIBL)=XMATRI
  240. *      SEGDES IMATRI
  241.  17   CONTINUE
  242. C
  243. C  **** DANS MJONCT ON CHERCHE LA STRUCTURE MSOSTU
  244. C  **** IPP2 EST LE CHPOINT DE P QU ON ETALE DANS KMVB.ON REMPLIT IPB.
  245. C
  246.       NST=ISTRJO(/1)
  247.       DO 31 IS=1,NST
  248.       IF(ISTRJO(IS).NE. ISTRU) GO TO 31
  249.       IPP2=IPCHJO(IS)
  250.       CALL ETALCH(IPP2,KIINC,KICPR,KCONTR,KMVB,KIPB,NPR2,1)
  251. C
  252. C  ****  OPERATION KMVA*KMVB
  253. C
  254.       MVA=KMVA
  255.       MVA1=KMVB
  256.       IPB=KIPB
  257. C      SEGACT MVA,MVA1,IPB
  258.       XRET=0.
  259.       DO 80 J1=1,NPR2
  260.       JJ1=IPB(J1)
  261.       DO 80 I1=1,NNI1
  262.       XRET=XRET+VA(I1,JJ1)*MVA1.VA(I1,JJ1)
  263.  80   CONTINUE
  264.       RE(1,2,izpos)=RE(1,2,izpos)+RLIBRE*XRET/OMEG
  265.       RE(2,1,izpos)=RE(1,2,izpos)
  266. C
  267.  31   CONTINUE
  268.       SEGDES MJONCT,xmatri
  269.  30   CONTINUE
  270.  
  271. C
  272.  2    CONTINUE
  273.       MELEME=MELSOL
  274.       MELEME=MELMOD
  275.       SEGDES MSOLE1,MSOLE2,MSOLEN
  276.       xMATRI=IMATLI
  277.       IF(NZRILI.NE.0)SEGDES xMATRI,IPT1
  278.       xMATRI=IMATBL
  279.       IF(NZRIBL.NE.0)SEGDES xMATRI,IPT2
  280.       IINC=KIINC
  281.       SEGSUP IINC
  282.       ICPR=KICPR
  283.       SEGSUP ICPR
  284.       SEGSUP MVA,MVA1,IPB,ICONTR
  285. C
  286. C
  287. C  **** FABRICATION DU SEGMENT MRIGID
  288. C
  289.       NRIGEL=NRIGEL/3
  290.       IF(NRIGEL.EQ.0) GO TO 5000
  291.       NRIGE=6
  292.       SEGINI MRIGID
  293.       DO 40 I=1,NRIGEL
  294.       IRIGEL(1,I)=ITRAV(3*I-2)
  295.       IRIGEL(2,I)=0
  296.       IRIGEL(3,I)=ITRAV(3*I-1)
  297.       IRIGEL(4,I)=ITRAV(3*I)
  298.       IRIGEL(5,I)=NIFOUR
  299.       IRIGEL(6,I)=0
  300.       COERIG(I)=1.D0
  301.  40   CONTINUE
  302.       SEGSUP ITRAV
  303.       MTYMAT='MASSE'
  304.       ICHOLE=0
  305.       IMGEO1=0
  306.       IMGEO2=0
  307.       IFORIG=IFOUR
  308.       SEGDES MRIGID
  309.       IRET=MRIGID
  310.  5000 CONTINUE
  311.       END
  312.  
  313.  
  314.  
  315.  
  316.  
  317.  
  318.  

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