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

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