Télécharger la plaquette Cast3M


fr en

Télécharger rglili.eso

Retour à la liste

Numérotation des lignes : 

rglili

  1. C RGLILI    SOURCE    FANDEUR   22/01/03    21:15:42     11237          
  2.       SUBROUTINE RGLILI(ISOLS,ISTRU,IRIG,IRET)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C CE SUBROUTINE CALCULE POUR LES SOLUTIONS STATIQUES ISOLS DE TYPE :
  7. C  1-MECA OU FLUI
  8. C LES RIGIDITES DE COUPLAGE DES LIAISONS ENTRE ELLES (FORMALISME GIBERT)
  9. C DE SOUS TYPE MASSE SI IRIG=1, DE SOUS TYPE RIGIDITE SI IRIG=2
  10. C ECRIT PAR FARVACQUE
  11. C  2-DEPI
  12. C UNE MATRICE DE RIGIDITE NULLE ET UNE MATRICE DE MASSE IDENTITE
  13. C (FORMALISME DEPLACEMENTS IMPOSES SUR MODES BLOQUES POUR DEVO)
  14. C ECRIT PAR GUILBAUD
  15. C
  16. C ELLES S'APPUIENT SUR L ELEMENT QUI CONTIENT TOUS LES POINTS ASSOCIES
  17. C AUX LIAISONS MJONCT.
  18. C
  19. C APPELE PAR RIGI,RGBASE
  20. C APPELLE : ETALPR,MUCPRI,ETALCH,YTMX,ERREUR(235,108)
  21. C=======================================================================
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMSOLUT
  26. -INC SMRIGID
  27. -INC SMATTAC
  28. -INC SMELEME
  29. -INC SMSTRUC
  30. -INC CCHAMP
  31.       SEGMENT ICPR(nbpts)
  32.  
  33.       SEGMENT IINC
  34.        CHARACTER*(LOCOMP) CIINC(0)
  35.       ENDSEGMENT
  36.       SEGMENT IIDU
  37.        CHARACTER*(LOCOMP) CIIDU(NNI1)
  38.       ENDSEGMENT
  39.  
  40.       SEGMENT ITRMEC(NJONC)
  41.       SEGMENT ITRDEP(NJONC)
  42.       SEGMENT ITRAV(6)
  43.       SEGMENT/MVA/(VA(NNI1,IPR1)*D),MVA1.MVA
  44.       SEGMENT/ICONTR/(MCONTR(NNI1,IPR1))
  45.       SEGMENT IPB(IPR1)
  46.       DATA KZERO/0/
  47.  
  48.       CHARACTER*(LOCOMP) IDDL
  49. C
  50.       IRET=0
  51.       IF(IRIG.NE.1.AND.IRIG.NE.2) GOTO 8000
  52.       MSOSTU=ISTRU
  53.       MSOLUT=ISOLS
  54.       SEGACT MSOLUT
  55.       NIPO=MSOLIS(/1)
  56.       KJONC=MSOLIS(10)
  57.       KDEPL=MSOLIS(5)
  58.       IF(KDEPL.NE.0) GO TO 12
  59.       MOTERR(1:8)='SOLUTION'
  60.       MOTERR(9:26)='SOLUTION'
  61.       MOTERR(30:38)='DEPL'
  62.       SEGDES MSOLUT
  63.       CALL ERREUR(235)
  64. C     ON NE TROUVE PAS LES DEPL
  65.       GO TO 8000
  66.  12   CONTINUE
  67.       SEGDES MSOLUT
  68.       MSOLE1=KJONC
  69.       SEGACT MSOLE1
  70.       NJONC=MSOLE1.ISOLEN(/1)
  71.       SEGDES MSOLE1
  72.       IF(NJONC.EQ.0) GO TO 8000
  73. C
  74.       SEGINI ITRMEC,ITRDEP
  75.       SEGACT MSOLE1
  76.       NJOMEC=0
  77.       NJODEP=0
  78.       DO 20 I=1,NJONC
  79.       MJONCT=MSOLE1.ISOLEN(I)
  80.       SEGACT MJONCT
  81.       IF(MJOTYP.EQ.'MECA'.OR.MJOTYP.EQ.'FLUI') THEN
  82.         NJOMEC=NJOMEC+1
  83.         ITRMEC(NJOMEC)=I
  84.       ELSEIF(MJOTYP.EQ.'DEPI'.AND.IRIG.EQ.1) THEN
  85.         NJODEP=NJODEP+1
  86.         ITRDEP(NJODEP)=I
  87.       ENDIF
  88.       SEGDES MJONCT
  89.  20   CONTINUE
  90.       SEGDES MSOLE1
  91.       IF(NJOMEC.EQ.0.AND.NJODEP.EQ.0) GOTO 7000
  92.       IF(NJOMEC.EQ.0) GO TO 5000
  93. C
  94. C  **** INITIALISATION DE LA GEOMETRIE(1 ELEMENT QUI CONTIENT TOUS LES
  95. C  **** POINT-LIAISONS) ET DE LA MATRICE ASSOCIEE XMATRI
  96. C  **** INITIALISATION DE IMATRI ET DE DESCR
  97. C
  98.       NJONC=NJOMEC
  99.       LVAL=NJONC*(NJONC+1)/2
  100.       NLIGRP=NJONC
  101.       NLIGRD=NJONC
  102.       nelrig=1
  103.       SEGINI XMATRI
  104. *      NLIGRE=NJONC
  105.       SEGINI DESCR
  106.       NELRIG=1
  107. *      SEGINI IMATRI
  108. *      IMATTT(1)=XMATRI
  109. *      SEGDES IMATRI
  110.       SEGACT MSOLUT
  111.       IPT1=MSOLIS(3)
  112.       SEGACT IPT1
  113.       NBSOUS=0
  114.       NBREF=0
  115.       NBNN=NJONC
  116.       NBELEM=1
  117.       SEGINI MELEME
  118.       ITYPEL=27
  119.       MSOLEN=KDEPL
  120. C
  121. C  **** PREPARATION DES OPERATIONS : A IPM ON DONNE LA FORME RECTANGLE
  122. C
  123.       SEGACT MSOLEN
  124.       IPM=ISOLEN(1)
  125.       CALL ETALPR(IPM,KIINC,KICPR,KCONTR)
  126.       ICONTR=KCONTR
  127.       SEGACT ICONTR
  128.       IPR1=MCONTR(/2)
  129.       NNI1=MCONTR(/1)
  130.       SEGINI MVA
  131.       KMVA=MVA
  132.       SEGINI MVA
  133.       KMVB=MVA
  134.       SEGINI IPB
  135.       KIPB=IPB
  136.       IINC=KIINC
  137.       SEGACT IINC
  138.       SEGINI IIDU
  139.       DO 50 I=1,NNI1
  140.       IDDL=CIINC(I)
  141.       DO 51 J=1,LNOMDD
  142.       IF(IDDL.NE.NOMDD(J)) GOTO 51
  143.       CIIDU(I)=NOMDU(J)
  144.       GOTO 50
  145.  51   CONTINUE
  146.       MOTERR=IDDL
  147.       CALL ERREUR(108)
  148. C     ON NE TROUVE PAS IDDL DANS CCHAMP
  149.       GOTO 7000
  150.  50   CONTINUE
  151.       KINCDU=IIDU
  152.       IF(IIMPI.NE.0)WRITE(6,8883)(CIINC(I),CIIDU(I),I=1,NNI1)
  153.  8883 FORMAT(20(1X,A4))
  154. C
  155. C  **** CAS IRIG=1 : TERMES DANS LA MATRICE MASSE : UT.M.U
  156. C
  157.       IF(IRIG.NE.1) GO TO 100
  158.       SEGACT MSOSTU
  159.       MATMAS=ISMASS
  160.       SEGDES MSOSTU
  161.       SEGACT MSOLE1,MSOLEN
  162.       LTAB=ISOLEN(/1)
  163.       DO 9 I=1,NJONC
  164.       MJONCT=MSOLE1.ISOLEN(ITRMEC(I))
  165.       SEGACT MJONCT
  166.       NOELEP(I)=I
  167.       NOELED(I)=I
  168.       IF(MJODDL.EQ.'LX  ') GO TO 16
  169.       LISINC(I)='FBET'
  170.       LISDUA(I)='BETA'
  171.       GO TO 17
  172.  16   LISINC(I)='BETA'
  173.       LISDUA(I)='FBET'
  174.  17   CONTINUE
  175.       SEGDES MJONCT
  176.       NUM(I,1)=IPT1.NUM(1,ITRMEC(I))
  177.  9    CONTINUE
  178. C
  179.       KZERO=0
  180.       DO 10 I=1,NJONC
  181.       IP1=ISOLEN(I)
  182.       CALL MUCPRI(IP1,MATMAS,MUI)
  183.       IF(IERR.NE.0) GOTO 8000
  184.       CALL ETALCH(MUI,KINCDU,KICPR,KCONTR,KMVB,KIPB,NPR2,1)
  185.       IF(IERR.NE.0) GO TO 8000
  186. C
  187.       IF(IIMPI.EQ.0) GOTO 804
  188.       MVA=KMVB
  189.       IPB=KIPB
  190.       SEGACT MVA,IPB
  191.       WRITE(IOIMP,7878)I
  192.  7878 FORMAT('  ************* DANS RGLILI CALCUL DE UJ.M.UI ****',
  193.      1 /,' ========== I=',I4,' ECRITURE DE M.UI SOUS LA FORME VA
  194.      1 PUIS IPB')
  195.       WRITE(IOIMP,8880)((VA(KJ1,KJ2),KJ1=1,NNI1),KJ2=1,IPR1)
  196.       WRITE(IOIMP,8882)(IPB(KJ2),KJ2=1,IPR1)
  197.  804  CONTINUE
  198. C
  199.       DO 11 J=I,NJONC
  200.       IP2=ISOLEN(J)
  201.       CALL ETALCH(IP2,KIINC,KICPR,KCONTR,KMVA,KZERO,IBID,1)
  202.       IF(IERR.NE.0) GOTO 8000
  203. C
  204.       IF(IIMPI.EQ.0) GO TO 803
  205.       MVA=KMVA
  206.       SEGACT MVA
  207.       WRITE(IOIMP,7879)J
  208.  7879 FORMAT(' ========== J=',I4,' ECRITURE DE UJ SOUS LA FORME VA')
  209.       WRITE(IOIMP,8880)((VA(KJ1,KJ2),KJ1=1,NNI1),KJ2=1,IPR1)
  210.  803  CONTINUE
  211. C
  212. C  **** OPERATION UT . ( M.U )
  213. C
  214.       MVA=KMVA
  215.       MVA1=KMVB
  216.       IPB=KIPB
  217. C      SEGACT MVA,MVA1,IPB
  218.       XRET=0.
  219.       DO 81 J1=1,NPR2
  220.       JJ1=IPB(J1)
  221.       DO 81 I1=1,NNI1
  222.       XRET=XRET+VA(I1,JJ1)*MVA1.VA(I1,JJ1)
  223.  81   CONTINUE
  224. C
  225.       IF(IIMPI.EQ.0) GOTO 805
  226.       CALL YTMX(IP1,IP2,MATMAS,WW)
  227.       WRITE(IOIMP,7877)XRET,WW
  228.  7877 FORMAT(' UI.M.UJ = ',E12.5,'   PAR L''OPERATEUR YTMX ON TROUVE '
  229.      1 ,E12.5)
  230.   805 CONTINUE
  231. C
  232. *      K=(J*(J-1)/2)+I
  233.       RE(J,I,1)=XRET
  234.       RE(I,J,1)=XRET
  235.  11   CONTINUE
  236.  10   CONTINUE
  237.       GO TO 6
  238. C
  239. C  ****  CAS IRIG=2 : MATRICE RAIDEUR : LIGNE J COLONNE I: UI ET PJ
  240. C
  241.  100  CONTINUE
  242. C
  243. C  **** PREMIERE BOUCLE SUR LESMJONCT. ON EN SORT MCHPOI QU ON ETALE
  244. C  **** DANS MVA . C EST UI
  245. C
  246.       SEGACT MSOLEN,MSOLE1
  247.       LTAB=ISOLEN(/1)
  248.       DO 30 IJO1=1,NJONC
  249.       MJONCT=MSOLE1.ISOLEN(ITRMEC(IJO1))
  250.       SEGACT MJONCT
  251.       RLIBRE=1.
  252.       IF(MJODDL.EQ.'FLX ') RLIBRE=-1.
  253.       NOELEP(IJO1)=IJO1
  254.       NOELED(IJO1)=IJO1
  255.       IF(MJODDL.EQ.'LX  ') GO TO 18
  256.       LISINC(IJO1)='FBET'
  257.       LISDUA(IJO1)='BETA'
  258.       GO TO 19
  259.  18   LISINC(IJO1)='BETA'
  260.       LISDUA(IJO1)='FBET'
  261.  19   CONTINUE
  262.       NUM(IJO1,1)=IPT1.NUM(1,ITRMEC(IJO1))
  263.       SEGDES MJONCT
  264.       IP1=ISOLEN(ITRMEC(IJO1))
  265.       KZERO=0
  266.       CALL ETALCH(IP1,KIINC,KICPR,KCONTR,KMVA,KZERO,IBID,1)
  267.       IF(IERR.NE.0) GO TO 8000
  268.       IF(IIMPI.EQ.0) GO TO 800
  269.       MVA=KMVA
  270.       SEGACT MVA
  271.       WRITE(IOIMP,8880)((VA(KJ1,KJ2),KJ1=1,NNI1),KJ2=1,IPR1)
  272.  8880 FORMAT(8(2X,E12.5))
  273.  800  CONTINUE
  274. C
  275. C  **** 2IEME BOUCLE SUR LES MJONCT: ON EN TIRE PJ QU ON ETALE DANS MVB
  276. C
  277.       DO 31 IJO2=IJO1,NJONC
  278.       MJONCT=MSOLE1.ISOLEN(ITRMEC(IJO2))
  279.       SEGACT MJONCT
  280.       NST=ISTRJO(/1)
  281.       DO 32 IS=1,NST
  282.       IF(ISTRJO(IS).NE.MSOSTU) GO TO 32
  283.       IPP2=IPCHJO(IS)
  284.       CALL ETALCH(IPP2,KIINC,KICPR,KCONTR,KMVB,KIPB,NPR2,1)
  285.       IF(IERR.NE.0) GO TO 8000
  286.       IF(IIMPI.EQ.0) GO TO 801
  287.       MVA=KMVB
  288.       IPB=KIPB
  289.       SEGACT MVA,IPB
  290.       WRITE(IOIMP,8880)((VA(KJ1,KJ2),KJ1=1,NNI1),KJ2=1,IPR1)
  291.       WRITE(IOIMP,8882)(IPB(KJ2),KJ2=1,IPR1)
  292.  8882 FORMAT( 10I6)
  293.  801  CONTINUE
  294. C
  295. C  **** OPERATION VA*VB
  296. C
  297.       MVA=KMVA
  298.       MVA1=KMVB
  299.       IPB=KIPB
  300. C      SEGACT MVA,MVA1,IPB
  301. C
  302.       XRET=0.
  303.       DO 80 J1=1,NPR2
  304.       JJ1=IPB(J1)
  305.       DO 80 I1=1,NNI1
  306.       XRET=XRET+VA(I1,JJ1)*MVA1.VA(I1,JJ1)
  307.  80   CONTINUE
  308. C
  309. *      K=(IJO2*(IJO2-1)/2)+IJO1
  310.       RE(IJO2,IJO1,1)=RE(IJO2,IJO1,1)+XRET*RLIBRE
  311.       RE(IJO1,IJO2,1)=RE(IJO2,IJO1,1)
  312.  32   CONTINUE
  313.       SEGDES MJONCT
  314.  31   CONTINUE
  315.  30   CONTINUE
  316.       SEGDES MSOLE1
  317. C
  318.  6    CONTINUE
  319.       IINC=KIINC
  320.       SEGSUP IINC
  321.       IIDU=KINCDU
  322.       SEGSUP IIDU
  323.       ICPR=KICPR
  324.       SEGSUP ICPR
  325.       SEGSUP ICONTR
  326.       SEGSUP MVA,MVA1,IPB
  327.       SEGDES DESCR,MELEME,XMATRI,IPT1,MSOLUT
  328.       SEGINI ITRAV
  329.       ITRAV(1)=MELEME
  330.       ITRAV(2)=0
  331.       ITRAV(3)=DESCR
  332.       ITRAV(4)=xMATRI
  333.       ITRAV(5)=NIFOUR
  334.       ITRAV(6)=0
  335.  5000 CONTINUE
  336. C
  337. C   LIAISON POUR DEPLACEMENT IMPOSE
  338. C
  339.       IF(NJODEP.EQ.0) GO TO 6000
  340. C
  341. C  **** INITIALISATION DE LA GEOMETRIE(1 ELEMENT QUI CONTIENT TOUS LES
  342. C  **** POINT-LIAISONS) ET DE LA MATRICE ASSOCIEE XMATRI
  343. C  **** INITIALISATION DE IMATRI ET DE DESCR
  344. C
  345.       NJONC=NJODEP
  346. *      LVAL=NJONC*(NJONC+1)/2
  347.       NLIGRP=NJONC
  348.       NLIGRD=NJONC
  349.       nelrig=1
  350.       SEGINI XMATRI
  351. *      DO 40 K=1,LVAL
  352. *      RE(K)=0.D0
  353. *  40  CONTINUE
  354.       SEGINI DESCR
  355.       NELRIG=1
  356. *      SEGINI IMATRI
  357. *      IMATTT(1)=XMATRI
  358. *      SEGDES IMATRI
  359.       SEGACT MSOLUT
  360.       IPT1=MSOLIS(3)
  361.       SEGACT IPT1
  362.       NBSOUS=0
  363.       NBREF=0
  364.       NBNN=NJONC
  365.       NBELEM=1
  366.       SEGINI MELEME
  367.       ITYPEL=27
  368.       DO 41 I=1,NJONC
  369.       NOELEP(I)=I
  370.       NOELED(I)=I
  371.       LISINC(I)='FBET'
  372.       LISDUA(I)='BETA'
  373.       NUM(I,1)=IPT1.NUM(1,ITRDEP(I))
  374.       RE(I,I,1)=1.D0
  375.    41 CONTINUE
  376.       SEGSUP ITRDEP
  377.       SEGDES DESCR,MELEME,XMATRI,MSOLUT,IPT1
  378. C
  379. C   CREATION DE MRIGID
  380. C
  381.  6000 CONTINUE
  382.       NRIGEL=1
  383.       IF(NJOMEC.NE.0.AND.NJODEP.NE.0) NRIGEL=2
  384.       NRIGE=6
  385.       SEGINI MRIGID
  386.       ICHOLE=0
  387.       IMGEO1=0
  388.       IMGEO2=0
  389.       IFORIG=IFOUR
  390.       IF(IRIG.EQ.1) THEN
  391.            MTYMAT='MASSE   '
  392.       ELSE
  393.            MTYMAT='RIGIDITE'
  394.       ENDIF
  395.         I=0
  396.       IF(NJOMEC.NE.0) THEN
  397.         I=I+1
  398.         COERIG(I)=1.D0
  399.         IRIGEL(1,I)=ITRAV(1)
  400.         IRIGEL(2,I)=ITRAV(2)
  401.         IRIGEL(3,I)=ITRAV(3)
  402.         IRIGEL(4,I)=ITRAV(4)
  403.         IRIGEL(5,I)=ITRAV(5)
  404.         IRIGEL(6,I)=ITRAV(6)
  405.         xmatr1=itrav(4)
  406.         segdes xmatr1
  407.         SEGSUP ITRAV
  408.  
  409.       ENDIF
  410.       IF(NJODEP.NE.0) THEN
  411.         I=I+1
  412.         COERIG(I)=1.D0
  413.         IRIGEL(1,I)=MELEME
  414.         IRIGEL(2,I)=0
  415.         IRIGEL(3,I)=DESCR
  416.         IRIGEL(4,I)=xMATRI
  417.         IRIGEL(5,I)=NIFOUR
  418.         IRIGEL(6,I)=0
  419.         segdes xmatri
  420.       ENDIF
  421.  
  422.       SEGDES MRIGID
  423.       IRET=MRIGID
  424.  7000 CONTINUE
  425.       SEGSUP ITRMEC,ITRDEP
  426.  8000 CONTINUE
  427.       RETURN
  428.       END
  429.  
  430.  
  431.  
  432.  
  433.  
  434.  
  435.  
  436.  
  437.  
  438.  
  439.  
  440.  
  441.  
  442.  
  443.  
  444.  
  445.  

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