Télécharger la plaquette Cast3M


fr en

Télécharger imped.eso

Retour à la liste

Numérotation des lignes : 

imped

  1. C IMPED     SOURCE    PV        20/03/24    21:17:48     10554          
  2.       SUBROUTINE IMPED
  3. *---------------------------------------------------------------------*
  4. *        __________________________                                   *
  5. *        |                        |                                   *
  6. *        |   OPERATEUR IMPEDANCE  |                                   *
  7. *        |________________________|                                   *
  8. *                                                                     *
  9. *---------------------------------------------------------------------*
  10. *                                                                     *
  11. * SYNTAXE :                                                           *
  12. *                                                                     *
  13. *                                                                     *
  14. *     RIG1 = IMPE RIG2 (RIG3) (REEL1)(| 'MASSE'         | )  (FLAM);  *
  15. *                                     | 'RAIDEUR'       |             *
  16. *                                     | 'AMORTISSEMENT' |             *
  17. *                                     | 'QUELCONQUE' LISREEL1   |     *
  18. *
  19. * CREATION :  DC 2004
  20. * MODIFS : #6131 BP 2008 : correction dans le cas 'AMOR' en Fourier
  21. *          #6644 et #6653 BP 2010 : reecriture pour etre conforme au
  22. *                                   partionnement des matrices
  23. *          #6838 BP 2011 : reecriture car erreur lors de l assemblage si
  24. *                          non correspondance primale - duale
  25. *          #7774 BP 05/2013 : extension au cas Fourier sur les ddls
  26. *                             symetriques seuls ( IMPE 'AMOR' C^n )
  27. *                             + large choix d'inconnues
  28. *                             + prise en compte des MULTiplicateurs LX
  29. *
  30. *---------------------------------------------------------------------*
  31.       IMPLICIT INTEGER(I-N)
  32.       IMPLICIT REAL*8(A-H,O-Z)
  33. *
  34. -INC SMRIGID
  35.  
  36. -INC PPARAM
  37. -INC CCOPTIO
  38. -INC SMLREEL
  39. -INC SMLENTI
  40. -INC SMELEME
  41. -INC SMCOORD
  42. *
  43.       EXTERNAL    LONG
  44.       PARAMETER(NBMO=24)
  45.       CHARACTER*4 MOPRIM(NBMO),MODUAL(NBMO)
  46.       CHARACTER*4 MOPRII(NBMO),MODUAI(NBMO)
  47.       CHARACTER*4 LISMOT(4),LISMO2(1)
  48.       CHARACTER*4 MOTEMP
  49.       CHARACTER*8 LISMO3(3)
  50.       REAL*8      XOME,COEFA,COEFB,COEFC,COEFD,XCOEF2
  51.       LOGICAL     FLAGFO,FLUT,FLRI23
  52.       CHARACTER*4 MOP1,MOD1,MOP2,MOD2,MOP3,MOD3
  53. *
  54. *     on utilise les noms reels NOMDD et NOMDU de CCHAMP (cf bdata)
  55.       DATA MOPRIM / 'UX  ','UY  ','UZ  ','UR  ','UZ  ','UT  ',
  56.      .              'RX  ','RY  ','RZ  ','RT  ','RS  ','ALFA',
  57.      .              'P   ','PI  ','BETA','FBET','T   ','RR  ',
  58.      .              'TINF','TSUP','TH  ','FC  ','PQ  ','TP  '/
  59.       DATA MODUAL / 'FX  ','FY  ','FZ  ','FR  ','FZ  ','FT  ',
  60.      .              'MX  ','MY  ','MZ  ','MT  ','MS  ','FALF',
  61.      .              'FP  ','FPI ','FBET','BETA','Q   ','MR  ',
  62.      .              'QINF','QSUP','FLUX','ED  ','FPQ ','FTP '/
  63. *     on definit les noms imaginaires correspondants
  64.       DATA MOPRII / 'IUX ','IUY ','IUZ ','IUR ','IUZ ','IUT ',
  65.      .              'IRX ','IRY ','IRZ ','IRT ','IRS ','IALF',
  66.      .              'IP  ','IPI ','IBET','IFBE','IT  ','IRR ',
  67.      .              'ITIN','ITSU','ITH ','IFC ','IPQ ','ITP '/
  68.       DATA MODUAI / 'IFX ','IFY ','IFZ ','IFR ','IFZ ','IFT ',
  69.      .              'IMX ','IMY ','IMZ ','IMT ','IMS ','IFAL',
  70.      .              'IFP ','IFPI','IFBE','IBET','IQ  ','IMR ',
  71.      .              'IQIN','IQSU','IFLU','IED ','IFPQ','IFTP'/
  72.       DATA LISMOT/  'MASS','RAID','AMOR','QUEL'/
  73.       DATA LISMO2/  'FLAM'/
  74.       DATA LISMO3/  'MASSE   ','RIGIDITE','AMOR    '/
  75. *
  76. *
  77. *---- Initialisations et lectures des objets -------------------------*
  78. *
  79.       IRET = 1
  80.       idimp1=IDIM+1
  81. *
  82. *     Matrices
  83. *
  84.       CALL LIROBJ('RIGIDITE',IPOIR2,1,IRETOU)
  85.       IF(IRETOU.EQ.0) RETURN
  86. *
  87.       CALL LIROBJ('RIGIDITE',IPOIR3,0,IRETOU)
  88.       IF (IRETOU.NE.0) THEN
  89.         FLAGFO = .true.
  90.       ELSE
  91.         FLAGFO = .false.
  92.       ENDIF
  93. *
  94. *     Coef multiplicatif (Vitesse de Rotation par ex.)
  95.       XOME=1.D0
  96.       CALL LIRREE(XOME,0,IRETOX)
  97. *
  98. *     Quel Cas ? 'MASS','RAID','AMOR','QUEL'?
  99.       NUMLIS = 0
  100.       CALL LIRMOT(LISMOT,4,NUMLIS,0)
  101. *
  102. *     Quel type de matrice en sortie ?
  103.       NUMLI2 = 0
  104.       CALL LIRMOT(LISMO2,1,NUMLI2,0)
  105.       IFLAM=0
  106.       IF(NUMLI2.EQ.1)    IFLAM = 1
  107. *
  108. *     Dans le cas quelconque, on a besoin d une listreel
  109.       IF (NUMLIS.EQ.4) THEN
  110.            if (FLAGFO) then
  111.              write(6,*) 'Le cas QUELconque ne fonctionne qu avec'
  112.      &       ,' 1 matrice en entrée actuellement (et pas 2) !!!'
  113.              call erreur (19)
  114.              return
  115.            endif
  116.            CALL LIROBJ('LISTREEL',ICOEF,1,IRETOU)
  117.            MLREEL =ICOEF
  118.            SEGACT MLREEL
  119.              NCOEF = PROG(/1)
  120.              if (NCOEF.lt.4) then
  121.                write(6,*) 'Le cas QUELconque ne fonctionne qu avec'
  122.      &         ,' 1 listreel d au moins 4 valeurs !!!'
  123.               call erreur (21)
  124.               return
  125.              endif
  126.              COEFA = PROG(1)
  127.              COEFB = PROG(2)
  128.              COEFC = PROG(3)
  129.              COEFD = PROG(4)
  130.            SEGDES MLREEL
  131.       ENDIF
  132. *
  133. *
  134. *---- Activation de(s) matrice(s) d'entree -------------------------*
  135. *
  136.       RI2 = IPOIR2
  137.       SEGACT RI2
  138.       NRIGE2 = RI2.IRIGEL(/1)
  139.       NRIGEL2= RI2.IRIGEL(/2)
  140.  
  141.       IF (FLAGFO) THEN
  142.           RI3 = IPOIR3
  143.           SEGACT RI3
  144.           NRIGE3 = RI3.IRIGEL(/1)
  145.           NRIGEL3= RI3.IRIGEL(/2)
  146. *         Tests de Compatibilité avec RI2
  147. *         BP: on decide de n'en garder que tres peu
  148.           IF ( ((RI2.MTYMAT).NE.(RI3.MTYMAT)) .or.
  149.      &         ((RI2.IFORIG).NE.(RI3.IFORIG)) ) THEN
  150.             WRITE(6,*) 'Plantage: RIGIDITES non compatibles !!!'
  151.             WRITE(6,*) 'MTYMAT,IFORIG'
  152.             WRITE(6,*) (RI2.MTYMAT),(RI2.IFORIG)
  153.             WRITE(6,*) (RI3.MTYMAT),(RI3.IFORIG)
  154.             call erreur (21)
  155.             RETURN
  156.           ENDIF
  157. *         FLRI23 = meme support entre RI2 et RI3 ?
  158.           FLRI23=.false.
  159.           if(NRIGEL2.ne.NRIGEL3) goto 23
  160.           do k=1,NRIGEL2
  161.              if((RI2.irigel(1,k)).ne.(RI3.irigel(1,k))) goto 23
  162.              if((RI2.irigel(2,k)).ne.(RI3.irigel(2,k))) goto 23
  163.              if((RI2.coerig(k)).ne.(RI3.coerig(k))) goto 23
  164.           enddo
  165.           FLRI23=.true.
  166.   23      continue
  167.       ELSE
  168. *         on n a pas lu de 2eme matrice RI3 : on utilise RI2
  169.           RI3=RI2
  170.           FLRI23=.true.
  171.           NRIGE3 = NRIGE2
  172.           NRIGEL3= NRIGEL2
  173.       ENDIF
  174. *
  175. *
  176. *---- Quel Cas ? 1='MASS',2='RAID',3='AMOR',4='QUEL'? --------------*
  177. *
  178. *     si on lu un mot clé, on lutilise
  179.       IF (NUMLIS.NE.0) THEN
  180.          ICAS = NUMLIS
  181.       ELSE
  182. *     sinon par defaut on va faire une IMPEDANCE 'RAIDEUR' [K 0 ; 0 K]
  183.          ICAS = 2
  184. *        sauf si on a reconnu le type de la matrice d entree,
  185. *        auquel cas on choisit le cas le + vraisemblable
  186.          IF ((RI2.MTYMAT).EQ.LISMO3(3)) THEN
  187.             ICAS = 3
  188.          ELSEIF ((RI2.MTYMAT).EQ.LISMO3(1)) THEN
  189.             ICAS = 1
  190.          ELSEIF ((RI2.MTYMAT).EQ.LISMO3(2)) THEN
  191.             ICAS = 2
  192.          ENDIF
  193.       ENDIF
  194. *
  195.       if(IRETOX.ne.0.and.ICAS.eq.2)  write(6,*) 'Cas Raideur:'
  196.      &  ,' Le coefficient multiplicatif n est pas pris en compte !!!'
  197. *
  198. *
  199. *---- on verifie que l'on n'a pas de multiplicateur
  200. *     dans les cas autres que RAIDEUR ------------------------------*
  201. *
  202.       IF (ICAS.NE.2) THEN
  203.       DO 24 k=1,NRIGEL2
  204.          ipt2 = RI2.IRIGEL(1,k)
  205.          segact,ipt2
  206. c        detection des elements de type MULTiplicateur de Lagrange
  207.          if (ipt2.itypel.eq.22) then
  208.            write(ioimp,*) 'Les liaisons avec MULTiplicateur ne sont'
  209.      &     ,' compatibles qu avec l option RAIDEUR de IMPE'
  210.            call ERREUR(19)
  211.            RETURN
  212.          endif
  213.          segdes,ipt2
  214.   24  CONTINUE
  215.       ENDIF
  216.  
  217. *
  218. *
  219. *---- Creation de la matrice de sortie  ----------------------------*
  220. *
  221.       NRIGE = NRIGE2
  222.       if (ICAS.eq.1.or.ICAS.eq.2) then
  223.            NRIGEL = NRIGEL2 + NRIGEL3
  224.       elseif (ICAS.eq.4) then
  225.            NRIGEL = NRIGEL2
  226.       else
  227.         if (FLRI23) then
  228.            NRIGEL = NRIGEL2
  229.         else
  230.            if(iimpi.ge.1) write(ioimp,*) 'supports incompatibles !'
  231.            NRIGEL = NRIGEL2 + NRIGEL3
  232.         endif
  233.       endif
  234. *
  235.       SEGINI,RI1
  236. *     Pour les besoins d une analyse de 'FLAM'bage on ecrit matrice de type masse
  237.       IF (IFLAM.EQ.1) THEN
  238.         RI1.MTYMAT = LISMO3(1)
  239.       ELSE
  240.         RI1.MTYMAT = RI2.MTYMAT
  241.       ENDIF
  242.       RI1.IFORIG = RI2.IFORIG
  243. *
  244. *
  245. *---- Aiguillage selon le cas ----------------------------------------*
  246. *
  247. *           MASS,RAID,AMOR,QUEL
  248.       GOTO ( 100, 200, 300, 400),ICAS
  249. *
  250. *
  251. *---- Cas MASS  [-M 0 ; 0 -M] ----------------------------------------*
  252.  100  CONTINUE
  253.  
  254. *---- 1er quadrant ----
  255. *-----Boucle sur les matrices de rigidite elementaires de RI2
  256.       DO 101 IMA=1,NRIGEL2
  257.  
  258.          IMA1 = IMA
  259. *        COERIG
  260.          XCOEF2 =  (XOME**2) * RI2.COERIG(IMA)
  261.          RI1.COERIG(IMA1) = -1.D0 * XCOEF2
  262. *        IRIGEL(1,:)= meleme
  263.          RI1.IRIGEL(1,IMA1) = RI2.IRIGEL(1,IMA)
  264.          RI1.IRIGEL(2,IMA1) = RI2.IRIGEL(2,IMA)
  265. *        IRIGEL(3,:) = descr
  266.          DES2 = RI2.IRIGEL(3,IMA)
  267.          RI1.IRIGEL(3,IMA1) = DES2
  268. *        IRIGEL(4,:) = XMATRI
  269.          RI1.IRIGEL(4,IMA1) = RI2.IRIGEL(4,IMA)
  270. *        IRIGEL(5,:) = nhar
  271.          RI1.IRIGEL(5,IMA1) = RI2.IRIGEL(5,IMA)
  272. *        IRIGEL(6,:) =  < = >
  273.          RI1.IRIGEL(6,IMA1) = RI2.IRIGEL(6,IMA)
  274. *        IRIGEL(7,:) = symetrie
  275.          RI1.IRIGEL(7,IMA1) = RI2.IRIGEL(7,IMA)
  276.  
  277.  101  CONTINUE
  278. *-----fin de Boucle sur les matrices de rigidite elementaires de RI2
  279.  
  280.  
  281. *---- 4eme quadrant ----
  282. *-----Boucle sur les matrices de rigidite elementaires de RI3
  283.       DO 102 IMA=1,NRIGEL3
  284.  
  285.          IMA1 = NRIGEL2 + IMA
  286. *        COERIG
  287.          XCOEF3 =  (XOME**2) * RI3.COERIG(IMA)
  288.          RI1.COERIG(IMA1) = -1.D0 * XCOEF3
  289. *        IRIGEL(1,:)= meleme
  290.          RI1.IRIGEL(1,IMA1) = RI3.IRIGEL(1,IMA)
  291.          RI1.IRIGEL(2,IMA1) = RI3.IRIGEL(2,IMA)
  292. *        IRIGEL(3,:) = descr
  293.          DES3 = RI3.IRIGEL(3,IMA)
  294.          segact,DES3
  295.          NLIGRP= DES3.LISINC(/2)
  296.          NLIGRD= DES3.LISDUA(/2)
  297.          segini,DES1=DES3
  298. *        on change le nom des Primal
  299.          do 112 ILIGRP = 1,NLIGRP
  300.             MOP3=DES3.LISINC(ILIGRP)
  301.             do IBMO = 1,NBMO
  302.                 if (MOP3.eq.(MOPRIM(IBMO))) then
  303.                      DES1.LISINC(ILIGRP)  =   MOPRII(IBMO)
  304.                 goto 112
  305.                 endif
  306.              enddo
  307.              LMOP3=LONG(MOP3)
  308.              if(LMOP3.ge.4) then
  309.                write(ioimp,*) 'Pas de composante imaginaire connue ',
  310.      &         'associée à ',MOP3
  311.                write(ioimp,*) 'Veuillez choisir un nom d inconnue ',
  312.      &         'primale standard ou de moins de 4 caracteres'
  313.                MOTERR(1:4)=MOP3
  314.                call erreur(108)
  315.                RETURN
  316.              endif
  317. c            on construit un nom imaginaire a partir du nom fourni
  318.              write(MOP1,FMT='(A,A)') 'I',MOP3(1:3)
  319.              write(ioimp,*) '!!! On définit par défaut ',MOP1,
  320.      &       ' comme inconnue imaginaire de ',MOP3
  321.              DES1.LISINC(ILIGRP)  =   MOP1
  322.  112     continue
  323. *        on change le nom des Dual
  324.          do 121 ILIGRD = 1,NLIGRD
  325.             MOD3=DES3.LISDUA(ILIGRD)
  326.             if(MOD3.eq.'FLX ') goto 121
  327.             do IBMO = 1,NBMO
  328.                 if (MOD3.eq.(MODUAL(IBMO))) then
  329.                      DES1.LISDUA(ILIGRD)  =   MODUAI(IBMO)
  330.                 goto 121
  331.                 endif
  332.              enddo
  333.              LMOD3=LONG(MOD3)
  334.              if(LMOD3.ge.4) then
  335.                write(ioimp,*) 'Pas de composante imaginaire connue ',
  336.      &         'associée à ',MOD3
  337.                write(ioimp,*) 'Veuillez choisir un nom d inconnue ',
  338.      &         'duale standard ou de moins de 4 caracteres'
  339.                MOTERR(1:4)=MOD3
  340.                call erreur(108)
  341.                RETURN
  342.              endif
  343. c            on construit un nom imaginaire a partir du nom fourni
  344.              write(MOD1,FMT='(A,A)') 'I',MOD3(1:3)
  345.              write(ioimp,*) '!!! On définit par défaut ',MOD1,
  346.      &       ' comme inconnue imaginaire de ',MOD3
  347.              DES1.LISDUA(ILIGRD)  =   MOD1
  348.  121     continue
  349.          segdes,DES3,DES1
  350.          RI1.IRIGEL(3,IMA1) = DES1
  351. *        IRIGEL(4,:) = XMATRI
  352.          RI1.IRIGEL(4,IMA1) = RI3.IRIGEL(4,IMA)
  353. *        IRIGEL(5,:) = +nhar
  354.          RI1.IRIGEL(5,IMA1) = abs(RI3.IRIGEL(5,IMA))
  355. *        IRIGEL(6,:) =  < = >
  356.          RI1.IRIGEL(6,IMA1) = RI3.IRIGEL(6,IMA)
  357. *        IRIGEL(7,:) = symetrie
  358.          RI1.IRIGEL(7,IMA1) = RI3.IRIGEL(7,IMA)
  359.  
  360.  102  CONTINUE
  361. *-----fin de Boucle sur les matrices de rigidite elementaires de RI2
  362.  
  363.       GOTO 900
  364. *
  365. *
  366. *---- Cas RAID  [K 0 ; 0 K] ----------------------------------------*
  367.  200  CONTINUE
  368.  
  369. *---- 1er quadrant ----
  370. *-----Boucle sur les matrices de rigidite elementaires de RI2
  371.       DO 201 IMA=1,NRIGEL2
  372.  
  373.          IMA1 = IMA
  374. *        COERIG
  375.          XCOEF2 =  RI2.COERIG(IMA)
  376.          RI1.COERIG(IMA1) = XCOEF2
  377. *        IRIGEL(1,:)= meleme
  378.          RI1.IRIGEL(1,IMA1) = RI2.IRIGEL(1,IMA)
  379.          RI1.IRIGEL(2,IMA1) = RI2.IRIGEL(2,IMA)
  380. *        IRIGEL(3,:) = descr
  381.          DES2 = RI2.IRIGEL(3,IMA)
  382.          RI1.IRIGEL(3,IMA1) = DES2
  383. *        IRIGEL(4,:) = XMATRI
  384.          RI1.IRIGEL(4,IMA1) = RI2.IRIGEL(4,IMA)
  385. *        IRIGEL(5,:) = nhar
  386.          RI1.IRIGEL(5,IMA1) = RI2.IRIGEL(5,IMA)
  387. *        IRIGEL(6,:) =  < = >
  388.          RI1.IRIGEL(6,IMA1) = RI2.IRIGEL(6,IMA)
  389. *        IRIGEL(7,:) = symetrie
  390.          RI1.IRIGEL(7,IMA1) = RI2.IRIGEL(7,IMA)
  391.  
  392.  201  CONTINUE
  393. *-----fin de Boucle sur les matrices de rigidite elementaires de RI2
  394.  
  395.  
  396. *---- 4eme quadrant ----
  397. *-----Boucle sur les matrices de rigidite elementaires de RI3
  398.       DO 202 IMA=1,NRIGEL3
  399.  
  400.          IMA1 = NRIGEL2 + IMA
  401. *        COERIG
  402.          XCOEF3 =  RI3.COERIG(IMA)
  403.          RI1.COERIG(IMA1) = XCOEF3
  404. *        IRIGEL(1,:)= meleme
  405.          RI1.IRIGEL(1,IMA1) = RI3.IRIGEL(1,IMA)
  406. cbp          RI1.IRIGEL(2,IMA1) = RI3.IRIGEL(2,IMA)
  407. cbp .....debut modif du meleme .........................................
  408. cbp : s'il s'agit d'une relation avec multiplicateur, il est peut etre
  409. c    deja utilise (en tout cas comme on a changé les noms dinconnue,
  410. c    il y a un risque de le retrouver dans une autre matrice)
  411. c    => par securite, on duplique le noeud associe au LX
  412.          IPT3 = RI3.IRIGEL(1,IMA)
  413.          segact,IPT3
  414.          IF(IPT3.ITYPEL.eq.22) THEN
  415.            segact,MCOORD*mod
  416.            segini,IPT1=IPT3
  417. c          on suppose le LX en 1ere position (comme toujours a priori)
  418.            nmult = IPT3.NUM(/2)
  419.            IP1   = nbpts
  420.            NBPTS = IP1 + nmult
  421.            segadj,MCOORD
  422.            DO jmult=1,nmult
  423. c           creation d'un nouveau point associé au LX
  424.             IP3 = IPT3.NUM(1,jmult)
  425.             iref3 = (IP3-1)*idimp1
  426.             iref1 =  IP1   *idimp1
  427.             XCOOR(iref1 +1) = XCOOR(iref3 +1)
  428.             XCOOR(iref1 +2) = XCOOR(iref3 +2)
  429.             if(idim.eq.3) XCOOR(iref1 +3) = XCOOR(iref3 +3)
  430.             XCOOR(iref1 + idimp1) = XCOOR(iref3 + idimp1)
  431.             IP1 = IP1 + 1
  432.             IPT1.NUM(1,jmult) = IP1
  433.            ENDDO
  434.            segdes,IPT1,IPT3
  435.            RI1.IRIGEL(1,IMA1) = IPT1
  436.          ELSE
  437.            segdes,IPT3
  438.            RI1.IRIGEL(1,IMA1) = IPT3
  439.          ENDIF
  440. cbp .....fin modif  du meleme ..........................................
  441. *        IRIGEL(3,:) = descr
  442.          DES3 = RI3.IRIGEL(3,IMA)
  443.          segact,DES3
  444.          NLIGRP= DES3.LISINC(/2)
  445.          NLIGRD= DES3.LISDUA(/2)
  446.          segini,DES1=DES3
  447. *        on change le nom des Primal
  448.          do 212 ILIGRP = 1,NLIGRP
  449.             MOP3=DES3.LISINC(ILIGRP)
  450. c           on ne change pas le nom des inconnues LX, mais leur noeud
  451.             if(MOP3.eq.'LX  ') goto 212
  452.             do IBMO = 1,NBMO
  453.                 if (MOP3.eq.(MOPRIM(IBMO))) then
  454.                      DES1.LISINC(ILIGRP)  =   MOPRII(IBMO)
  455.                 goto 212
  456.                 endif
  457.              enddo
  458.              LMOP3=LONG(MOP3)
  459.              if(LMOP3.ge.4) then
  460.                write(ioimp,*) 'Pas de composante imaginaire connue ',
  461.      &         'associée à ',MOP3
  462.                write(ioimp,*) 'Veuillez choisir un nom d inconnue ',
  463.      &         'primale standard ou de moins de 4 caracteres'
  464.                MOTERR(1:4)=MOP3
  465.                call erreur(108)
  466.                RETURN
  467.              endif
  468. c            on construit un nom imaginaire a partir du nom fourni
  469.              write(MOP1,FMT='(A,A)') 'I',MOP3(1:3)
  470.              write(ioimp,*) '!!! On définit par défaut ',MOP1,
  471.      &       ' comme inconnue imaginaire de ',MOP3
  472.              DES1.LISINC(ILIGRP)  =   MOP1
  473.  212     continue
  474. *        on change le nom des Dual
  475.          do 221 ILIGRD = 1,NLIGRD
  476.             MOD3=DES3.LISDUA(ILIGRD)
  477.             if(MOD3.eq.'FLX ') goto 221
  478.             do IBMO = 1,NBMO
  479.                 if (MOD3.eq.(MODUAL(IBMO))) then
  480.                      DES1.LISDUA(ILIGRD)  =   MODUAI(IBMO)
  481.                 goto 221
  482.                 endif
  483.              enddo
  484.              LMOD3=LONG(MOD3)
  485.              if(LMOD3.ge.4) then
  486.                write(ioimp,*) 'Pas de composante imaginaire connue ',
  487.      &         'associée à ',MOD3
  488.                write(ioimp,*) 'Veuillez choisir un nom d inconnue ',
  489.      &         'duale standard ou de moins de 4 caracteres'
  490.                MOTERR(1:4)=MOD3
  491.                call erreur(108)
  492.                RETURN
  493.              endif
  494. c            on construit un nom imaginaire a partir du nom fourni
  495.              write(MOD1,FMT='(A,A)') 'I',MOD3(1:3)
  496.              write(ioimp,*) '!!! On définit par défaut ',MOD1,
  497.      &       ' comme inconnue imaginaire de ',MOD3
  498.              DES1.LISDUA(ILIGRD)  =   MOD1
  499.  221     continue
  500.          segdes,DES3,DES1
  501.          RI1.IRIGEL(3,IMA1) = DES1
  502. *        IRIGEL(4,:) = XMATRI
  503.          RI1.IRIGEL(4,IMA1) = RI3.IRIGEL(4,IMA)
  504. *        IRIGEL(5,:) = +nhar
  505.          RI1.IRIGEL(5,IMA1) = abs(RI3.IRIGEL(5,IMA))
  506. *        IRIGEL(6,:) =  < = >
  507.          RI1.IRIGEL(6,IMA1) = RI3.IRIGEL(6,IMA)
  508. *        IRIGEL(7,:) = symetrie
  509.          RI1.IRIGEL(7,IMA1) = RI3.IRIGEL(7,IMA)
  510.  
  511.  202  CONTINUE
  512. *-----fin de Boucle sur les matrices de rigidite elementaires de RI2
  513.  
  514.       GOTO 900
  515.  
  516. *
  517. *---- Cas AMOR  [0 -C ; C 0] ----------------------------------------*
  518.  300  CONTINUE
  519. *
  520. *---- 2eme quadrant = -\bar{C} ----
  521.  
  522. *-----Boucle sur les matrices de rigidite elementaires de RI2
  523.       DO 301 IMA=1,NRIGEL2
  524.  
  525.          IMA1 = IMA
  526. *        COERIG
  527.          XCOEF2 =  XOME * RI2.COERIG(IMA)
  528.          RI1.COERIG(IMA1) = XCOEF2
  529. *        IRIGEL(1,:)= meleme
  530.          RI1.IRIGEL(1,IMA1) = RI2.IRIGEL(1,IMA)
  531.          RI1.IRIGEL(2,IMA1) = RI2.IRIGEL(2,IMA)
  532.  
  533. *        IRIGEL(3,:) = descr
  534.          DES2 = RI2.IRIGEL(3,IMA)
  535.          segact,DES2
  536.          NLIGRP= DES2.LISINC(/2)
  537.          NLIGRD= DES2.LISDUA(/2)
  538.          if (NLIGRP.ne.NLIGRD) then
  539.            call ERREUR(756)
  540.            return
  541.          endif
  542. *        on crée un nouveau DESCR 2 fois plus long
  543.          segini,DES1=DES2
  544.          NLIG = NLIGRP
  545.          NLIGRP = 2 * NLIG
  546.          NLIGRD = 2 * NLIG
  547.          segadj,DES1
  548. *        on ajoute les noeuds + les noms de la partie imaginaire
  549.          do 311 ILIG = 1,NLIG
  550.             DES1.NOELEP(NLIG+ILIG) =  DES1.NOELEP(ILIG)
  551.             DES1.NOELED(NLIG+ILIG) =  DES1.NOELED(ILIG)
  552.             MOP2 = DES2.LISINC(ILIG)
  553.             do IBMO = 1,NBMO
  554.                 if (MOP2.eq.(MOPRIM(IBMO))) then
  555.                   if ((DES2.LISDUA(ILIG)).ne.(MODUAL(IBMO))) then
  556.         write(6,*) 'non concordance entre l inconnue primale '
  557.         write(6,*) MOP2,' et duale ',DES2.LISDUA(ILIG)
  558.         call erreur(717)
  559.         return
  560.                   endif
  561.                   if ((DES2.NOELEP(ILIG)).ne.(DES2.NOELED(ILIG))) then
  562.         write(6,*) 'non concordance entre le noeud primal '
  563.         write(6,*) DES2.NOELEP(ILIG),' et dual ',DES2.NOELED(ILIG)
  564.         call erreur(717)
  565.         return
  566.                   endif
  567. *        on ajoutes les inconnues imaginaires + les noeuds associés
  568.                   DES1.LISINC(NLIG+ILIG) =  MOPRII(IBMO)
  569.                   DES1.LISDUA(NLIG+ILIG) =  MODUAI(IBMO)
  570.                   goto 311
  571.                 endif
  572.              enddo
  573. c            on n'a pas trouve le primal dans la liste,
  574. c            on fabrique les noms primal et dual maginaire depuis reel
  575. c            la concordance n'est plus assuree
  576.              LMOP2=LONG(MOP2)
  577.              if(LMOP2.ge.4) then
  578.                write(ioimp,*) 'Pas de composante imaginaire connue ',
  579.      &         'associée à ',MOP2
  580.                write(ioimp,*) 'Veuillez choisir un nom d inconnue ',
  581.      &         'primale standard ou de moins de 4 caracteres'
  582.                MOTERR(1:4)=MOP2
  583.                call erreur(108)
  584.                RETURN
  585.              endif
  586. c            on construit un nom imaginaire a partir du nom fourni
  587.              write(MOP1,FMT='(A,A)') 'I',MOP2(1:3)
  588.              write(ioimp,*) '!!! On définit par défaut ',MOP1,
  589.      &       ' comme inconnue imaginaire de ',MOP2
  590.              DES1.LISINC(NLIG+ILIG)  =   MOP1
  591. c            idem pour le dual
  592.              MOD2=DES2.LISDUA(ILIG)
  593.              LMOD2=LONG(MOD2)
  594.              if(LMOD2.ge.4) then
  595.                write(ioimp,*) 'Pas de composante imaginaire connue ',
  596.      &         'associée à ',MOD2
  597.                write(ioimp,*) 'Veuillez choisir un nom d inconnue ',
  598.      &         'duale standard ou de moins de 4 caracteres'
  599.                MOTERR(1:4)=MOD2
  600.                call erreur(108)
  601.                RETURN
  602.              endif
  603. c            on construit un nom imaginaire a partir du nom fourni
  604.              write(MOD1,FMT='(A,A)') 'I',MOD2(1:3)
  605.              write(ioimp,*) '!!! On définit par défaut ',MOD1,
  606.      &       ' comme inconnue duale imaginaire de ',MOD2
  607.              DES1.LISDUA(NLIG+ILIG) =   MOD1
  608.  311     continue
  609.          segdes,DES1
  610.          RI1.IRIGEL(3,IMA1) = DES1
  611.  
  612. *        on regarde si UT existe
  613.          FLUT= .false.
  614.          JG = NLIG
  615.          segini,MLENTI
  616.          IF (FLAGFO) THEN
  617.          do ILIG = 1,NLIG
  618. cbp             if ((DES2.LISINC(ILIG)).eq.'UT  ') then
  619.             MOTEMP=DES2.LISINC(ILIG)
  620.             if (MOTEMP.eq.'UT  '.OR.MOTEMP.eq.'IUT ') then
  621.                LECT(ILIG) = 1
  622.                FLUT= .true.
  623.             endif
  624.          enddo
  625.          ENDIF
  626.          segdes,DES2
  627.  
  628. *        IRIGEL(4,:) = XMATRI
  629. *        on cree une nouvelle matrice
  630.          XMATR2 = RI2.IRIGEL(4,IMA)
  631.          segact,XMATR2
  632.          NELRIG = XMATR2.RE(/3)
  633.          segini,XMATR1
  634.          IF (FLUT) THEN
  635. *        -- 2eme quadrant = -\bar{C} --
  636.             do j=1,NLIG
  637.               j1 = NLIG+j
  638.               if (LECT(j).eq.1) then
  639. *               la colonne j pointe vers la composante UT
  640.                 do i=1,NLIG
  641.                 do k=1,NELRIG
  642.                    XMATR1.RE(i,j1,k) = XMATR2.RE(i,j,k)
  643.                 enddo
  644.                 enddo
  645.               else
  646.                 do i=1,NLIG
  647.                 do k=1,NELRIG
  648.                    XMATR1.RE(i,j1,k) = -1.D0 * XMATR2.RE(i,j,k)
  649.                 enddo
  650.                 enddo
  651.               endif
  652.             enddo
  653.          ELSE
  654. *        -- 2eme quadrant = -{C} --
  655.             do k=1,NELRIG
  656.               do j=1,NLIG
  657.               j1 = NLIG+j
  658.                 do i=1,NLIG
  659.                    XMATR1.RE(i,j1,k) = -1.D0 * XMATR2.RE(i,j,k)
  660.                 enddo
  661.               enddo
  662.             enddo
  663.          ENDIF
  664. *           si possible, tous les quadrants dans la meme sous-rigidite
  665.          if (FLRI23) then
  666.             XMATR3 = RI3.IRIGEL(4,IMA)
  667.             segact,XMATR3
  668.          IF (FLUT) THEN
  669. *        -- 3eme quadrant = +\bar{C} --
  670.             do j=1,NLIG
  671.               if (LECT(j).eq.1) then
  672. *               la colonne j pointe vers la composante UT
  673.                 do i=1,NLIG
  674.                 i1 = NLIG+i
  675.                 do k=1,NELRIG
  676.                    XMATR1.RE(i1,j,k) = -1.D0 * XMATR3.RE(i,j,k)
  677.                 enddo
  678.                 enddo
  679.               else
  680.                 do i=1,NLIG
  681.                 i1 = NLIG+i
  682.                 do k=1,NELRIG
  683.                    XMATR1.RE(i1,j,k) = XMATR3.RE(i,j,k)
  684.                 enddo
  685.                 enddo
  686.               endif
  687.             enddo
  688.          ELSE
  689. *        -- 3eme quadrant = +{C} --
  690.             do k=1,NELRIG
  691.               do j=1,NLIG
  692.                 do i=1,NLIG
  693.                    i1 = NLIG+i
  694.                    XMATR1.RE(i1,j,k) = XMATR3.RE(i,j,k)
  695.                 enddo
  696.               enddo
  697.             enddo
  698.          ENDIF
  699.             segdes,XMATR3
  700.          endif
  701.          segdes,XMATR2
  702.          RI1.IRIGEL(4,IMA1) = XMATR1
  703.  
  704.          segsup,MLENTI
  705.  
  706. *        IRIGEL(5,:) = nhar
  707.          RI1.IRIGEL(5,IMA1) = RI2.IRIGEL(5,IMA)
  708. *        IRIGEL(6,:) =  < = >
  709.          RI1.IRIGEL(6,IMA1) = RI2.IRIGEL(6,IMA)
  710. *        IRIGEL(7,:) = symetrie
  711.          IF (FLAGFO.or.FLUT) THEN
  712.             RI1.IRIGEL(7,IMA1) = 2
  713.          ELSEIF((RI2.IRIGEL(7,IMA)).eq.0) THEN
  714.             RI1.IRIGEL(7,IMA1) = 1
  715.          ELSE
  716.             RI1.IRIGEL(7,IMA1) = 2
  717.          ENDIF
  718.          xmatr1.symre=ri1.irigel(7,ima1)
  719.          segdes xmatr1
  720.  301  CONTINUE
  721. *-----fin de Boucle sur les matrices de rigidite elementaires de RI2
  722.  
  723. *---- 3eme quadrant (s'il n'pas pu etre rempli dans la boucle 301) ----
  724.       if(FLRI23) goto 309
  725.  
  726. *-----Boucle sur les matrices de rigidite elementaires de RI3
  727.       DO 302 IMA=1,NRIGEL3
  728.  
  729.          IMA1 = NRIGEL2 + IMA
  730. *        COERIG
  731.          XCOEF3 =  XOME * RI3.COERIG(IMA)
  732.          RI1.COERIG(IMA1) = XCOEF3
  733. *        IRIGEL(1,:)= meleme
  734.          RI1.IRIGEL(1,IMA1) = RI3.IRIGEL(1,IMA)
  735.          RI1.IRIGEL(2,IMA1) = RI3.IRIGEL(2,IMA)
  736.  
  737. *        IRIGEL(3,:) = descr
  738.          DES3 = RI3.IRIGEL(3,IMA)
  739.          segact,DES3
  740.          NLIGRP= DES3.LISINC(/2)
  741.          NLIGRD= DES3.LISDUA(/2)
  742.          if (NLIGRP.ne.NLIGRD) then
  743.            call ERREUR(756)
  744.            return
  745.          endif
  746. *        on crée un nouveau DESCR 2 fois plus long
  747.          segini,DES1=DES3
  748.          NLIG = NLIGRP
  749.          NLIGRP = 2 * NLIG
  750.          NLIGRD = 2 * NLIG
  751.          segadj,DES1
  752. *        on ajoute les noeuds + les noms de la partie imaginaire
  753.          do 312 ILIG = 1,NLIG
  754.             DES1.NOELEP(NLIG+ILIG) =  DES1.NOELEP(ILIG)
  755.             DES1.NOELED(NLIG+ILIG) =  DES1.NOELED(ILIG)
  756.             MOP3 = DES3.LISINC(ILIG)
  757.             do IBMO = 1,NBMO
  758.                 if (MOP3.eq.(MOPRIM(IBMO))) then
  759.                   if ((DES3.LISDUA(ILIG)).ne.(MODUAL(IBMO))) then
  760.         write(6,*) 'non concordance entre l inconnue primale '
  761.         write(6,*) DES3.LISINC(ILIG),' et duale ',DES3.LISDUA(ILIG)
  762.         call erreur(717)
  763.         return
  764.                   endif
  765.                   if ((DES3.NOELEP(ILIG)).ne.(DES3.NOELED(ILIG))) then
  766.         write(6,*) 'non concordance entre le noeud primal '
  767.         write(6,*) DES3.NOELEP(ILIG),' et dual ',DES3.NOELED(ILIG)
  768.         call erreur(717)
  769.         return
  770.                   endif
  771. *        on ajoutes les inconnues imaginaires + les noeuds associés
  772.                   DES1.LISINC(NLIG+ILIG) =  MOPRII(IBMO)
  773.                   DES1.LISDUA(NLIG+ILIG) =  MODUAI(IBMO)
  774.                   goto 312
  775.                 endif
  776.              enddo
  777. c            on n'a pas trouve le primal dans la liste,
  778. c            on fabrique les noms primal et dual maginaire depuis reel
  779. c            la concordance n'est plus assuree
  780.              LMOP3=LONG(MOP3)
  781.              if(LMOP3.ge.4) then
  782.                write(ioimp,*) 'Pas de composante imaginaire connue ',
  783.      &         'associée à ',MOP3
  784.                write(ioimp,*) 'Veuillez choisir un nom d inconnue ',
  785.      &         'primale standard ou de moins de 4 caracteres'
  786.                MOTERR(1:4)=MOP3
  787.                call erreur(108)
  788.                RETURN
  789.              endif
  790. c            on construit un nom imaginaire a partir du nom fourni
  791.              write(MOP1,FMT='(A,A)') 'I',MOP3(1:3)
  792.              write(ioimp,*) '!!! On définit par défaut ',MOP1,
  793.      &       ' comme inconnue imaginaire de ',MOP3
  794.              DES1.LISINC(NLIG+ILIG)  =   MOP1
  795. c            idem pour le dual
  796.              MOD3=DES3.LISDUA(ILIG)
  797.              LMOD3=LONG(MOD3)
  798.              if(LMOD3.ge.4) then
  799.                write(ioimp,*) 'Pas de composante imaginaire connue ',
  800.      &         'associée à ',MOD3
  801.                write(ioimp,*) 'Veuillez choisir un nom d inconnue ',
  802.      &         'duale standard ou de moins de 4 caracteres'
  803.                MOTERR(1:4)=MOD3
  804.                call erreur(108)
  805.                RETURN
  806.              endif
  807. c            on construit un nom imaginaire a partir du nom fourni
  808.              write(MOD1,FMT='(A,A)') 'I',MOD3(1:3)
  809.              write(ioimp,*) '!!! On définit par défaut ',MOD1,
  810.      &       ' comme inconnue duale imaginaire de ',MOD3
  811.              DES1.LISDUA(NLIG+ILIG) =   MOD1
  812.  312     continue
  813.          segdes,DES1
  814.          RI1.IRIGEL(3,IMA1) = DES1
  815.  
  816. *        on regarde si UT existe
  817.          FLUT= .false.
  818.          JG = NLIG
  819.          segini,MLENTI
  820.          IF (FLAGFO) THEN
  821.          do ILIG = 1,NLIG
  822. cbp             if ((DES3.LISINC(ILIG)).eq.'UT  ') then
  823.             MOTEMP=DES3.LISINC(ILIG)
  824.             if (MOTEMP.eq.'UT  '.OR.MOTEMP.eq.'IUT ') then
  825.                LECT(ILIG) = 1
  826.                FLUT= .true.
  827.             endif
  828.          enddo
  829.          ENDIF
  830.          segdes,DES3
  831.  
  832. *        IRIGEL(4,:) = XMATRI
  833. *        on cree une nouvelle matrice
  834.          XMATR3 = RI3.IRIGEL(4,IMA)
  835.          segact,XMATR3
  836.          NELRIG = XMATR3.RE(/3)
  837.          segini,XMATR1
  838.          IF (FLUT) THEN
  839. *        -- 3eme quadrant = +\bar{C} --
  840.             do j=1,NLIG
  841.               if (LECT(j).eq.1) then
  842. *               la colonne j pointe vers la composante UT
  843.                 do i=1,NLIG
  844.                 i1 = NLIG+i
  845.                 do k=1,NELRIG
  846.                    XMATR1.RE(i1,j,k) = -1.D0 * XMATR3.RE(i,j,k)
  847.                 enddo
  848.                 enddo
  849.               else
  850.                 do i=1,NLIG
  851.                 i1 = NLIG+i
  852.                 do k=1,NELRIG
  853.                    XMATR1.RE(i1,j,k) = XMATR3.RE(i,j,k)
  854.                 enddo
  855.                 enddo
  856.               endif
  857.             enddo
  858.          ELSE
  859. *        -- 3eme quadrant = +{C} --
  860.             do k=1,NELRIG
  861.               do j=1,NLIG
  862.                 do i=1,NLIG
  863.                    i1 = NLIG+i
  864.                    XMATR1.RE(i1,j,k) = XMATR3.RE(i,j,k)
  865.                 enddo
  866.               enddo
  867.             enddo
  868.          ENDIF
  869.          segdes,XMATR3
  870.          RI1.IRIGEL(4,IMA1) = XMATR1
  871.  
  872.          segsup,MLENTI
  873.  
  874. *        IRIGEL(5,:) = +nhar
  875.          RI1.IRIGEL(5,IMA1) = abs(RI3.IRIGEL(5,IMA))
  876. *        IRIGEL(6,:) =  < = >
  877.          RI1.IRIGEL(6,IMA1) = RI3.IRIGEL(6,IMA)
  878. *        IRIGEL(7,:) = symetrie (2: quelconque)
  879.          RI1.IRIGEL(7,IMA1) = 2
  880.          xmatr1.symre=2
  881.          segdes,XMATR1
  882.  
  883.  302  CONTINUE
  884. *-----fin de Boucle sur les matrices de rigidite elementaires de RI2
  885.  
  886.  309  CONTINUE
  887.  
  888.       GOTO 900
  889.  
  890.  
  891. *
  892. *---- Cas QUELconque  [a*K b*K ; c*K d*K] ----------------------------------------*
  893.  400  CONTINUE
  894.  
  895. *-----Boucle sur les matrices de rigidite elementaires de RI2
  896.       DO 401 IMA=1,NRIGEL2
  897.  
  898.          IMA1 = IMA
  899. *        COERIG
  900.          XCOEF2 =  RI2.COERIG(IMA)
  901.          RI1.COERIG(IMA1) = XCOEF2
  902. *        IRIGEL(1,:)= meleme
  903.          RI1.IRIGEL(1,IMA1) = RI2.IRIGEL(1,IMA)
  904.          RI1.IRIGEL(2,IMA1) = RI2.IRIGEL(2,IMA)
  905.  
  906. *        IRIGEL(3,:) = descr
  907.          DES2 = RI2.IRIGEL(3,IMA)
  908.          segact,DES2
  909.          NLIGRP= DES2.LISINC(/2)
  910.          NLIGRD= DES2.LISDUA(/2)
  911.          if (NLIGRP.ne.NLIGRD) then
  912.            call ERREUR(756)
  913.            return
  914.          endif
  915. *        on crée un nouveau descr 2 fois plus long
  916.          segini,DES1=DES2
  917.          NLIG = NLIGRP
  918.          NLIGRP = 2 * NLIG
  919.          NLIGRD = 2 * NLIG
  920.          segadj,DES1
  921.          do ILIG = 1,NLIG
  922.             do IBMO = 1,NBMO
  923.                 if ((DES2.LISINC(ILIG)).eq.(MOPRIM(IBMO))) then
  924.                   if ((DES2.LISDUA(ILIG)).ne.(MODUAL(IBMO))) then
  925.         write(6,*) 'non concordance entre l inconnue primale '
  926.         write(6,*) DES2.LISINC(ILIG),' et duale ',DES2.LISDUA(ILIG)
  927.         call erreur(717)
  928.         return
  929.                   endif
  930. *        on ajoutes les inconnues imaginaires + les noeuds associés
  931.                   DES1.LISINC(NLIG+ILIG) =  MOPRII(IBMO)
  932.                   DES1.NOELEP(NLIG+ILIG) =  DES1.NOELEP(ILIG)
  933.                   DES1.LISDUA(NLIG+ILIG) =  MODUAI(IBMO)
  934.                   DES1.NOELED(NLIG+ILIG) =  DES1.NOELED(ILIG)
  935.                 endif
  936.              enddo
  937.          enddo
  938.          segdes,DES1
  939.          RI1.IRIGEL(3,IMA1) = DES1
  940.  
  941. *        IRIGEL(4,:) = XMATRI
  942. *        on cree une nouvelle matrice
  943.          XMATR2 = RI2.IRIGEL(4,IMA)
  944.          segact,XMATR2
  945.          NELRIG = XMATR2.RE(/3)
  946.          segini,XMATR1
  947.          if(COEFA.eq.0.D0) goto 411
  948. *        -- 1er quadrant --
  949.             do j=1,NLIG
  950.             do i=1,NLIG
  951.             do k=1,NELRIG
  952.                XMATR1.RE(i,j,k) = COEFA * XMATR2.RE(i,j,k)
  953.             enddo
  954.             enddo
  955.             enddo
  956.  411     continue
  957.          if(COEFB.eq.0.D0) goto 412
  958. *        -- 2nd quadrant --
  959.             do j=1,NLIG
  960.               j1=NLIG+j
  961.               do i=1,NLIG
  962.               do k=1,NELRIG
  963.                  XMATR1.RE(i,j1,k) = COEFB * XMATR2.RE(i,j,k)
  964.               enddo
  965.               enddo
  966.             enddo
  967.  412     continue
  968.          if(COEFC.eq.0.D0) goto 413
  969. *        -- 3eme quadrant --
  970.             do i=1,NLIG
  971.               i1 = NLIG+i
  972.               do j=1,NLIG
  973.               do k=1,NELRIG
  974.                  XMATR1.RE(i1,j,k) = COEFC * XMATR2.RE(i,j,k)
  975.               enddo
  976.               enddo
  977.             enddo
  978.  413     continue
  979.          if(COEFD.eq.0.D0) goto 414
  980. *        -- 2nd quadrant --
  981.             do i=1,NLIG
  982.               i1 = NLIG+i
  983.               do j=1,NLIG
  984.                 j1=NLIG+j
  985.                 do k=1,NELRIG
  986.                    XMATR1.RE(i1,j1,k) = COEFD * XMATR2.RE(i,j,k)
  987.                 enddo
  988.               enddo
  989.             enddo
  990.  414     continue
  991.  
  992.          segdes,XMATR2
  993.          RI1.IRIGEL(4,IMA1) = XMATR1
  994.  
  995. *        IRIGEL(5,:) = nhar
  996.          RI1.IRIGEL(5,IMA1) = RI2.IRIGEL(5,IMA)
  997. *        IRIGEL(6,:) =  < = >
  998.          RI1.IRIGEL(6,IMA1) = RI2.IRIGEL(6,IMA)
  999. *        IRIGEL(7,:) = symetrie
  1000.          RI1.IRIGEL(7,IMA1) = 2
  1001.          xmatr1.symre=2
  1002.          segdes,XMATR1
  1003.  
  1004.  401  CONTINUE
  1005. *-----fin de Boucle sur les matrices de rigidite elementaires de RI2
  1006.  
  1007.       GOTO 900
  1008.  
  1009.  
  1010. *---- Desactivations des objets -------------------------------------*
  1011.  900  CONTINUE
  1012. *
  1013.       SEGDES,RI1,RI2
  1014.       IF(FLAGFO) SEGDES,RI3
  1015.  
  1016. *---- Verification de l'unicite de la relation supportée par un
  1017. *     multiplicateur de lagrange s'il existe            -------------*
  1018.  
  1019.  
  1020.  
  1021. *
  1022. *---- Ecriture de la rigidite de sortie -----------------------------*
  1023.       IPOIRF = RI1
  1024.       IF(IRET.EQ.1) CALL ECROBJ('RIGIDITE',IPOIRF)
  1025. *
  1026.       RETURN
  1027. *
  1028.       END
  1029.  
  1030.  
  1031.  
  1032.  
  1033.  
  1034.  
  1035.  
  1036.  
  1037.  

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