Télécharger la plaquette Cast3M


fr en

Télécharger rigi1.eso

Retour à la liste

Numérotation des lignes : 

rigi1

  1. C RIGI1     SOURCE    MB234859  25/09/08    21:16:07     12358          
  2.  
  3. C---------------------------------------------------------------------*
  4. C                                                                     *
  5. C                      OPERATEUR RIGIDITE                             *
  6. C                                                                     *
  7. C---------------------------------------------------------------------*
  8. C                                                                     *
  9. C       CE SOUS-PROGRAMME SERT A TRAITER ET A METTRE EN FORME         *
  10. C         LES INFORMATIONS NECESSAIRES POUR LES CALCULS               *
  11. C                                                                     *
  12. C---------------------------------------------------------------------*
  13. C                                                                     *
  14. C   ENTREES :                                                         *
  15. C   ________                                                          *
  16. C                                                                     *
  17. C        MODORI   Pointeur sur le modele                              *
  18. C        IPCHE1   Pointeur sur le chamelem de carateristiques         *
  19. C        IPCHE2   Pointeur sur le chamelem de matrice de HOOKE        *
  20. C        IMAT     (2 il y a une matrice de HOOKE,1 non  )             *
  21. C                                                                     *
  22. C   SORTIES :                                                         *
  23. C   ________                                                          *
  24. C                                                                     *
  25. C        IPOI6    pointeur sur la rigidite construite                 *
  26. C        IRET     (1 OK , 0 erreur  )                                 *
  27. C                                                                     *
  28. C---------------------------------------------------------------------*
  29.       SUBROUTINE RIGI1(MODORI,IPCHE1,IPCHE2,IMAT, IPOI6,IRET,noer)
  30.  
  31.       IMPLICIT INTEGER(I-N)
  32.       IMPLICIT REAL*8(A-H,O-Z)
  33.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC CCHAMP
  37. -INC CCGEOME
  38. -INC CCREEL
  39. C==DEB= FORMULATION HHO == Include specifique ==========================
  40. -INC CCHHOPA
  41. C==FIN= FORMULATION HHO ================================================
  42.  
  43. -INC SMCOORD
  44. -INC SMCHAML
  45. -INC SMINTE
  46. -INC SMELEME
  47. -INC SMRIGID
  48. -INC SMMODEL
  49.       POINTEUR IMOREF.IMODEL
  50.       POINTEUR NOMID1.NOMID
  51. -INC SMLREEL
  52. -INC SMLENTI
  53.       POINTEUR MLPHAS.MLENTI
  54.  
  55.  
  56. -INC TMPTVAL
  57.  
  58.       integer oooval
  59.  
  60.       SEGMENT NOTYPE
  61.         CHARACTER*16 TYPE(NBTYPE)
  62.       ENDSEGMENT
  63.  
  64.       segment modsta
  65.         integer pimoda(nmoda),pistat(nstat)
  66.         integer ivmoda(nmoda),ivstat(nstat)
  67.       endsegment
  68.  
  69.       CHARACTER*8 CMATE
  70.       CHARACTER*(NCONCH) CONM
  71.  
  72.       PARAMETER ( INTTYP=3 )
  73. C                 INTTYP DEFINIT LE TYPE DE POINTS D'INTEGRATION
  74. C                                UTILISE PAR RIGI
  75.       PARAMETER ( NINF=3 )
  76.       INTEGER INFOS(NINF),nrnlin
  77.       LOGICAL LDPGE,lsupma,dcmate,dcmat2
  78.  
  79. C Petit tableau des "couleurs" des relations de conformite (goto 31)
  80.       DIMENSION LCOLOR(6)
  81.       DATA LCOLOR / 1, 3, 6, 10, 16, 24 /
  82.       DATA NRNLIN / 4 /
  83.  
  84.       IRET = 0
  85.       IPOI6 = 0
  86.  
  87. C    VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  88. C    ZZZZZZZZ  PEUT ETRE A FAIRE PLUTOT SUR LES SOUS-ZONES
  89.  
  90.       ISUP=0
  91.       IF (IPCHE1.NE.0) THEN
  92.         call reduaf(ipche1,MODORI,ipche10,0,iretca,kerr)
  93.         if (iretca.ne.1) call erreur(kerr)
  94.         if (ierr.ne.0) goto 889
  95.         ipche1=ipche10
  96.         CALL QUESUP(MODORI,IPCHE1,INTTYP,0,ISUP,IRETCA)
  97.         IF (ISUP.GT.1) GOTO 889
  98.       ENDIF
  99. C
  100. C    VERIFICATION DU LIEU SUPPORT DU MCHAML DE HOOKE
  101. C
  102.       ISUP1 = 0
  103.       IPCHOO = 0
  104.       IF (IMAT.EQ.2) THEN
  105.         IPCHOO = IPCHE1
  106.         IF (IPCHE2.NE.0) THEN
  107.           IPCHOO = IPCHE2
  108.           call reduaf(IPCHOO,MODORI,IPCHE2,0,iretca,kerr)
  109.           if (iretca.ne.1) call erreur(kerr)
  110.           if (ierr  .ne.0) goto 889
  111.           IPCHOO = IPCHE2
  112.           CALL QUESUP(MODORI,IPCHE2,INTTYP,1,ISUP1,IRETHO)
  113.           IF (ISUP1.NE.0) GOTO 889
  114.         ENDIF
  115.       ENDIF
  116. **      call zpchel(ipche1,0)
  117.  
  118. C               ACTIVATION DU MODELE
  119. C               --------------------
  120. C  MODORI = Modele initial complet
  121. C  IPMODL = Modele "deroule" (uniquement "MECANIQUE", "LIQUIDE" ou "POREUX")
  122. C et "MELANGE PARALLELE".
  123.       CALL PIMODL(MODORI,IPMODL,MAILDG,1)
  124.       if (ierr.ne.0) return
  125.       IF (IPMODL.EQ.0) then
  126.         call erreur(21)
  127.         goto 889
  128.       ENDIF
  129.  
  130. C  IPMODL est ACTIF en retour :
  131.       MMODEL = IPMODL
  132.       NSOUS  = mmodel.KMODEL(/1)
  133.  
  134. C      INITIALISATION DU CHAPEAU DE L'OBJET RIGIDITE
  135. C      ---------------------------------------------
  136.       NRIGEL=0
  137.       SEGINI,MRIGID
  138.       mrigid.MTYMAT = 'RIGIDITE'
  139.       mrigid.IFORIG = IFOUR
  140.       mrigid.ICHOLE = 0
  141.       mrigid.IMGEO1 = 0
  142.       mrigid.IMGEO2 = 0
  143.       mrigid.ISUPEQ = 0
  144.  
  145.       mlphas = 0
  146. c jk148537 en cas de besoin / NLIN
  147.       L1 = 8
  148.       n1 = 1
  149.       segini mmode1
  150.  
  151.       noerjk = noer
  152.       if (noer.gt.1) noer = 0
  153.  
  154.       mchel1 = 0
  155.       mchelm = ipche1
  156.       if (mchelm.ne.0) then
  157.         n3 = infche(/2)
  158.         segini mchel1
  159.         mchel1.ifoche = ifoche
  160.         n2 = 2
  161.         segini mcham1
  162.         mchel1.ichaml(1) = mcham1
  163.       endif
  164. C
  165. C termes croises STATIQUE et/ou MODAL
  166.       nstat = 100
  167.       kstat = 0
  168.       nmoda = 100
  169.       kmoda = 0
  170.       segini modsta
  171.  
  172. C Un petit segment toujours utile
  173.       nbtype = 1
  174.       SEGINI,notype
  175.       notype.TYPE(1) = 'REAL*8'
  176.       MOTYR8 = notype
  177.  
  178. C--------------------------------------------------------------------*
  179. C
  180. C       BOUCLE SUR LES ZONES ELEMENTAIRES ( MEME TYPE D'EF )
  181. C
  182. C--------------------------------------------------------------------*
  183. C
  184.       ISOU=0
  185.       DO 500 ISOUS=1,NSOUS
  186.  
  187.         IMODEL = mmodel.KMODEL(ISOUS)
  188.  
  189. C    INITIALISATIONS
  190.  
  191.         MELE   = imodel.NEFMOD
  192.         IPMAIL = imodel.IMAMOD
  193.         CONM   = imodel.CONMOD
  194.  
  195.         CMATE = CMATEE
  196.         MATE  = IMATEE
  197.         INAT  = INATUU
  198.  
  199. c**        write(ioimp,*) 'RIGI1 : IMODEL = ',imodel,isous,formod(1)
  200. c**        write(ioimp,*) '                 ',mele,ipmail,cmate, noer
  201.         IF (MELE.EQ.259) GOTO 500
  202.         if (noerjk.eq.2 .and. cmate.ne.'NLIN') goto 500
  203.  
  204.         IPT1   = IPMAIL
  205.         NBNOE1 = IPT1.NUM(/1)
  206.         NBELE1 = IPT1.NUM(/2)
  207.  
  208.         NMATR = 0
  209.         NMATF = 0
  210.         MOMATR = 0
  211.         MOTYMA = MOTYR8
  212.         IVAMAT = 0
  213.         lsupma = .true.
  214.  
  215.         NCARA = 0
  216.         NCARF = 0
  217.         MOCARA = 0
  218.         MOTYCA = MOTYR8
  219.         IVACAR = 0
  220.  
  221.         IVAPHA = 0
  222.         MELPHA = 0
  223.  
  224.         DESCR  = 0
  225.         xMATRI = 0
  226.         IPMINT = 0
  227. C
  228. C   CREATION DU TABLEAU INFOS
  229. C
  230.         irtd = 1
  231.         CALL IDENT(IPMAIL,CONM,IPCHE2,IPCHE1,INFOS,irtd)
  232.         IF (irtd.EQ.0) GOTO 518
  233.  
  234.         dcmate = .false.
  235.         dcmat2 = .false.
  236.         DO im = 1, matmod(/2)
  237.           if (matmod(im).eq.'IMPEDANCE') then
  238.             dcmate =.true.
  239.             if (tymode(/2).gt.0) then
  240.               if (tymode(1).eq.'LISTMOTS') dcmat2 = .true.
  241.             endif
  242.           endif
  243.         enddo
  244.  
  245.         MELE = imodel.NEFMOD
  246. C Cas particulier : POI1/SEG2 et IMPEDANCE
  247.         IF (dcmate) THEN
  248.           meleme = IPMAIL
  249.           if (meleme.itypel.eq.1) MELE = 45
  250.           if (meleme.itypel.eq.2) MELE = 2
  251.         ENDIF
  252.  
  253.         IF (MELE.EQ.22) GOTO 310
  254. C
  255. C-----------------------------------------------------------------------
  256. C                        P H A S E   1
  257. C
  258. C         INFOS. ELEMENT FINI ET COMPOSANTES NECESSAIRES
  259. C    DANS LES CHAMPS EN ENTREE ET EVENTUELLEMENT EN SORTIE
  260. C
  261. C    ON POURRAIT REGROUPER LA PLUS GROSSE PARTIE DE CETTE PHASE DANS
  262. C           UN SOUS-PROGRAMME COMMUN A BEAUCOUP D'OPERATEURS
  263. C
  264. C-----------------------------------------------------------------------
  265.         if (infmod(/1).lt.2+inttyp) then
  266.           write(ioimp,*) 'RIGI1 : ERREUR 5 - INFMOD(/1) ?',infmod(/1)
  267.           call erreur(5)
  268.         endif
  269.  
  270.         NSTRS = INFELE(16)
  271.         MFR   = INFELE(13)
  272.         LW    = INFELE( 7)
  273.         NDDL  = INFELE(15)
  274.         IELE  = INFELE(14)
  275.         LRE   = INFELE( 9)
  276.         IPORE = INFELE( 8)
  277.         LHOOK = INFELE(10)
  278.         NBPGAU= INFELE( 6)
  279. C   COQUE INTEGREE OU PAS ?
  280.         NPINT = INFMOD(1)
  281.         IPMINT = INFMOD(2+INTTYP)
  282.         IPMIN1 = infmod(3)
  283.  
  284.  310    continue
  285.         if (mele.EQ.22) write(ioimp,*) 'RIGI1 : MELE = 22 - MFR = ',MFR
  286.  
  287.         IIPDPG = imodel.IPDPGE
  288.         IIPDPG = IPTPOI(IIPDPG)
  289.  
  290. C- Cas particulier en DEFO PLAN GENE
  291.         CALL INFDPG(MFR,IFOUR,LDPGE,NDPGE)
  292.         IF (LDPGE) THEN
  293.           IF (IIPDPG.LE.0) THEN
  294.             CALL ERREUR(925)
  295.             CALL ERREUR(5)
  296.             RETURN
  297.           ENDIF
  298.           if (maildg.eq.0) then
  299.             CALL ERREUR(925)
  300.             CALL ERREUR(5)
  301.           ENDIF
  302.           ipt2 = MAILDG
  303.           IPMAIG = ipt2.lisous(isous)
  304.           meleme = IPMAIG
  305.           NBNOEG = meleme.num(/1)
  306.           NBELEG = meleme.num(/2)
  307.         ELSE
  308.           IPMAIG = IPMAIL
  309.         ENDIF
  310.  
  311. C        RECHERCHE DES NOMS D'INCONNUES ET DES DUAUX
  312. C
  313.         MODEPL = imodel.lnomid(1)
  314.         IF (MODEPL.EQ.0) THEN
  315.           write(ioimp,*) 'RIGI1 : MODELE sans LNOMID(1) ?'
  316.           call erreur(5)
  317.         ENDIF
  318.         nomid = MODEPL
  319.         NDEPL = nomid.lesobl(/2)
  320.         MOFORC = imodel.lnomid(2)
  321.         IF (MOFORC.EQ.0) THEN
  322.           write(ioimp,*) 'RIGI1 : MODELE sans LNOMID(2) ?'
  323.           call erreur(5)
  324.         ENDIF
  325.         nomid = MOFORC
  326.         NFORC = nomid.lesobl(/2)
  327.         if (ndepl.eq.0 .or. nforc.eq.0 .or. ndepl.ne.nforc) then
  328.           moterr = 'pas d inconnue duale ou primale '
  329.           call erreur(-385)
  330.           interr(1) = imodel
  331.           moterr(1:16) = conmod
  332.           moterr(17:24) = '        '
  333.           call erreur(-386)
  334.           call erreur(5)
  335.         endif
  336.  
  337.         if (formod(1).eq.'MELANGE'.and.CMATE.EQ.'PARALLEL') then
  338.           mophas = lnomid(12)
  339.           nomid = mophas
  340.           nmpha = lesobl(/2)
  341.           nmphf = lesfac(/2)
  342.           NPHAT = nmpha + nmphf
  343.           JG = NPHAT
  344.           if (mlphas.gt.0) then
  345. * verifie que le precedent melange a ete totalement traite
  346.             do iph = 1,mlphas.lect(/1)
  347.               if (mlphas.lect(iph).gt.0) then
  348.                 moterr(1:50) = 'melange incompletement traite'
  349.                 call erreur(-385)
  350.                 interr(1) = imodel
  351.                 moterr(1:16) = conm
  352.                 moterr(17:24) = '        '
  353.                 call erreur(-386)
  354.                 call erreur(5)
  355.                 return
  356.               endif
  357.             enddo
  358.             segadj mlphas
  359.           else if (mlphas.eq.0) then
  360.             segini mlphas
  361.           endif
  362.           IVAPHA = 0
  363.           imoref = 0
  364.           imosou = imodel
  365. * associe phase et coefficient de phase
  366.           IF (IVAMOD(/1).LT.1) THEN
  367.             call erreur(21)
  368.             return
  369.           ENDIF
  370.           DO j = 1, IVAMOD(/1)
  371.             IF (TYMODE(j).EQ.'IMODEL  ') THEN
  372.               IMODE1 = IVAMOD(j)
  373.               IF (IMODE1.FORMOD(1)(1:10).EQ.'MECANIQUE ' .OR.
  374.      &            IMODE1.FORMOD(1)(1:10).EQ.'POREUX    ' .OR.
  375.      &            IMODE1.FORMOD(1)(1:16).EQ.'ELECTROSTATIQUE ' .OR.
  376.      &            IMODE1.FORMOD(1)(1:10).EQ.'LIQUIDE   ' ) THEN
  377.                 do iph = 1,nmpha
  378.                   if (imode1.conmod(17:24).eq.lesobl(iph)) then
  379.                     mlphas.lect(iph) = imode1
  380.                     if (iph.eq.1) imoref = imode1
  381.                   endif
  382.                 enddo
  383.               ENDIF
  384.             ENDIF
  385.           ENDDO
  386.           CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOPHAS,MOTYR8,0,INFOS,3,IVAPHA)
  387.           IF (IERR.NE.0) GOTO 888
  388.           mptval = IVAPHA
  389.           if (IVAPHA.gt.0) then
  390.             if (ival(/1).eq.0) then
  391. * massif / pas de proportions phases / imite imoref / conserve CONM
  392.               imodel = imoref
  393.               MELE = nefmod
  394.             elseif (ival(/1).ge.nmpha) then
  395.               goto 500
  396.             else
  397.               call erreur(21)
  398.               return
  399.             endif
  400.           else
  401. * massif / pas de proportions phases / imite imoref / conserve CONM
  402.             imodel = imoref
  403.             MELE = nefmod
  404.           endif
  405.  
  406.           IF (ISUP.EQ.1) THEN
  407.             CALL VALCHE(IVAPHA,NPHAT,IPMINT,IPPORE,MOPHAS,MELE)
  408.             IF (IERR.NE.0) THEN
  409.               ISUP=0
  410.               GOTO 888
  411.             ENDIF
  412.           ENDIF
  413.           IF (IERR.NE.0) GOTO 888
  414.  
  415.           if (mlphas.gt.0.and.ivapha.gt.0) then
  416.             do iph = 1, NPHAT
  417.               if (imodel.eq.mlphas.lect(iph)) MELPHA = ival(iph)
  418.             enddo
  419.           endif
  420.  
  421.         endif
  422.  
  423. C     RECHERCHE DES COMPOSANTES UTILES DES CHAMPS EN ENTREE
  424. C     -----------------------------------------------------
  425.         NBROBL = 0
  426.         NBRFAC = 0
  427.         NOMID  = 0
  428. C Sauf cas particuliers, toutes les composantes de type REAL*8
  429.         NBTYPE = 0
  430.         NOTYPE = MOTYR8
  431.  
  432. C  >>>     CHAMP DE MATRICES DE HOOKE
  433.         IF (IMAT.EQ.2) THEN
  434. C
  435.           IF (MELE.EQ.93 .AND. CMATE.NE.'ISOTROPE') THEN
  436.             NBROBL = 3
  437.             SEGINI,NOMID
  438.             LESOBL(1)='MAHO'
  439.             LESOBL(2)='V1X '
  440.             LESOBL(3)='V1Y '
  441.             NBTYPE=3
  442.             SEGINI NOTYPE
  443.             TYPE(1)='POINTEURLISTREEL'
  444.             TYPE(2)='REAL*8'
  445.             TYPE(3)='REAL*8'
  446.           ELSE
  447.             NBROBL = 1
  448.             SEGINI NOMID
  449.             LESOBL(1)='MAHO'
  450.             NBTYPE = 1
  451.             SEGINI NOTYPE
  452.             TYPE(1)  ='POINTEURLISTREEL'
  453.           ENDIF
  454.  
  455.           NMATR  = NBROBL
  456.           NMATF  = NBRFAC
  457.           NMATT  = NMATR+NMATF
  458.  
  459.           MOMATR = NOMID
  460.  
  461.           MOTYMA = NOTYPE
  462.  
  463. C   >>>  CHAMP DE MATERIAU
  464.         ELSE
  465. C
  466.           IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE') THEN
  467.             IF (MFR.EQ.35.or.mfr.eq.78) THEN
  468.               NBROBL = 2
  469.               SEGINI NOMID
  470.               LESOBL(1)='KS  '
  471.               LESOBL(2)='KN  '
  472.             ELSE IF(MFR.EQ.53) THEN
  473.               NBROBL = 1
  474.               SEGINI,NOMID
  475.               LESOBL(1)='KS  '
  476.             ELSE
  477.               NBROBL = 2
  478.               SEGINI NOMID
  479.               LESOBL(1)='YOUN'
  480.               LESOBL(2)='NU  '
  481. C=DEB==== FORMULATION HHO ==== Traitement particulier du modele ========
  482.               CALL HHOIDC(imodel,nomid)
  483.               NBROBL=nomid.lesobl(/2)
  484. **              NBRFAC=nomid.lesfac(/2)
  485. C=FIN==== FORMULATION HHO ==============================================
  486.             ENDIF
  487.           ELSE IF
  488.      &      (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'UNIDIREC') THEN
  489.             IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN
  490.               NBROBL=7
  491.               SEGINI NOMID
  492.               LESOBL(1)='YOUN'
  493.               LESOBL(2)='V1X '
  494.               LESOBL(3)='V1Y '
  495.               LESOBL(4)='V1Z '
  496.               LESOBL(5)='V2X '
  497.               LESOBL(6)='V2Y '
  498.               LESOBL(7)='V2Z '
  499.             ELSE
  500.               NBROBL=3
  501.               SEGINI NOMID
  502.               LESOBL(1)='YOUN'
  503.               LESOBL(2)='V1X '
  504.               LESOBL(3)='V1Y '
  505.             ENDIF
  506.           ELSE IF
  507.      &      (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ZONE_COHESIVE') THEN
  508.             IF (MFR.EQ.77) THEN
  509.               NBROBL=2
  510.               SEGINI NOMID
  511.               LESOBL(1)='KS  '
  512.               LESOBL(2)='KN  '
  513.             ENDIF
  514.           ELSE IF
  515.      &      (FORMOD(1).EQ.'POREUX   '.AND.CMATE.EQ.'ISOTROPE') THEN
  516.             IF (MELE.GE.79.AND.MELE.LE.83) THEN
  517.               NBROBL=4
  518.               SEGINI NOMID
  519.               LESOBL(1)='YOUN'
  520.               LESOBL(2)='NU  '
  521.               LESOBL(3)='COB '
  522.               LESOBL(4)='MOB '
  523.             ELSE IF (MELE.GE.108.AND.MELE.LE.110) THEN
  524.               NBROBL=4
  525.               SEGINI NOMID
  526.               LESOBL(1)='KS  '
  527.               LESOBL(2)='KN  '
  528.               LESOBL(3)='COB '
  529.               LESOBL(4)='MOB '
  530.             ELSE IF (MELE.GE.173.AND.MELE.LE.177) THEN
  531.               NBROBL=10
  532.               SEGINI NOMID
  533.               LESOBL( 1)='YOUN'
  534.               LESOBL( 2)='NU  '
  535.               LESOBL( 3)='COP1'
  536.               LESOBL( 4)='COP2'
  537.               LESOBL( 5)='CPP1'
  538.               LESOBL( 6)='CPP2'
  539.               LESOBL( 7)='KK11'
  540.               LESOBL( 8)='KK12'
  541.               LESOBL( 9)='KK21'
  542.               LESOBL(10)='KK22'
  543.             ELSE IF (MELE.GE.178.AND.MELE.LE.182) THEN
  544.               NBROBL=17
  545.               SEGINI NOMID
  546.               LESOBL( 1)='YOUN'
  547.               LESOBL( 2)='NU  '
  548.               LESOBL( 3)='COP1'
  549.               LESOBL( 4)='COP2'
  550.               LESOBL( 5)='COP3'
  551.               LESOBL( 6)='CPP1'
  552.               LESOBL( 7)='CPP2'
  553.               LESOBL( 8)='CPP3'
  554.               LESOBL( 9)='KK11'
  555.               LESOBL(10)='KK12'
  556.               LESOBL(11)='KK13'
  557.               LESOBL(12)='KK21'
  558.               LESOBL(13)='KK22'
  559.               LESOBL(14)='KK23'
  560.               LESOBL(15)='KK31'
  561.               LESOBL(16)='KK32'
  562.               LESOBL(17)='KK33'
  563.             ELSE IF (MELE.GE.185.AND.MELE.LE.187) THEN
  564.               NBROBL=10
  565.               SEGINI NOMID
  566.               LESOBL( 1)='KS  '
  567.               LESOBL( 2)='KN  '
  568.               LESOBL( 3)='COP1'
  569.               LESOBL( 4)='COP2'
  570.               LESOBL( 5)='CPP1'
  571.               LESOBL( 6)='CPP2'
  572.               LESOBL( 7)='KK11'
  573.               LESOBL( 8)='KK12'
  574.               LESOBL( 9)='KK21'
  575.               LESOBL(10)='KK22'
  576.             ELSE IF (MELE.GE.188.AND.MELE.LE.190) THEN
  577.               NBROBL=17
  578.               SEGINI NOMID
  579.               LESOBL( 1)='KS  '
  580.               LESOBL( 2)='KN  '
  581.               LESOBL( 3)='COP1'
  582.               LESOBL( 4)='COP2'
  583.               LESOBL( 5)='COP3'
  584.               LESOBL( 6)='CPP1'
  585.               LESOBL( 7)='CPP2'
  586.               LESOBL( 8)='CPP3'
  587.               LESOBL( 9)='KK11'
  588.               LESOBL(10)='KK12'
  589.               LESOBL(11)='KK13'
  590.               LESOBL(12)='KK21'
  591.               LESOBL(13)='KK22'
  592.               LESOBL(14)='KK23'
  593.               LESOBL(15)='KK31'
  594.               LESOBL(16)='KK32'
  595.               LESOBL(17)='KK33'
  596.             ENDIF
  597.  
  598.           ELSE IF (INAT.EQ.67.AND.CMATE.EQ.'ORTHOTRO') THEN
  599.             NBROBL=6
  600.             SEGINI NOMID
  601.             LESOBL(1)='YG1 '
  602.             LESOBL(2)='YG2 '
  603.             LESOBL(3)='NU12'
  604.             LESOBL(4)='G12 '
  605.             LESOBL(5)='V1X '
  606.             LESOBL(6)='V1Y '
  607.  
  608. C          ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN
  609. C             Pour l'instant, lnomid(6) ou appel a IDMATR suffisent.
  610. C
  611.           ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN
  612. C             CB215821 : Desormais il faut utiliser COND
  613.             MOTERR(1:8)='DIFFUSIO'
  614.             CALL ERREUR(193)
  615.             RETURN
  616. C            CALL IDDILI(MATE,1,nomid,nbrobl,nbrfac)
  617.  
  618. C poi1 -- MODAL
  619.           ELSE IF (CMATE.EQ.'MODAL') THEN
  620.             NBROBL=3
  621.             SEGINI NOMID
  622.             LESOBL(1)='FREQ'
  623.             LESOBL(2)='MASS'
  624.             LESOBL(3)='DEFO'
  625. C poi1 -- STATIQUE
  626.           ELSE IF (CMATE.EQ.'STATIQUE') THEN
  627.             NBROBL=3
  628.             SEGINI NOMID
  629.             LESOBL(1)='DEFO'
  630.             LESOBL(2)='RIDE'
  631.             LESOBL(3)='MADE'
  632. C IMPEDANCE COMPLEXE
  633.           ELSE IF (CMATE.EQ.'IMPCOMPL') THEN
  634.             NBROBL=1
  635.             SEGINI NOMID
  636.             LESOBL(1)='RAID'
  637. C
  638. C Autres cas :
  639.           ELSE
  640.             nomid = lnomid(6)
  641.             IF (nomid.ne.0) then
  642.               lsupma = .false.
  643.               nbrobl = lesobl(/2)
  644.               nbrfac = lesfac(/2)
  645.             else
  646.       write(ioimp,*) 'RIGI1 : lnomid(6) non defini !'
  647.               CALL IDMATR(MFR,IMODEL,nomid,nbrobl,nbrfac)
  648.             endif
  649.           ENDIF
  650.  
  651.           NMATR = NBROBL
  652.           NMATF = NBRFAC
  653.           NMATT = NMATR+NMATF
  654.  
  655.           MOMATR = NOMID
  656.  
  657.           IF (CMATE.EQ.'SECTION') THEN
  658.             NBTYPE=3
  659.             SEGINI NOTYPE
  660.             TYPE(1)='POINTEURMMODEL'
  661.             TYPE(2)='POINTEURMCHAML'
  662.             TYPE(3)='POINTEURLISTREEL'
  663. c mistral :
  664.           ELSE IF (INAT.EQ.94) THEN
  665.             NBTYPE=NMATT
  666.             SEGINI NOTYPE
  667.             DO ITYP = 1, NBTYPE
  668.               TYPE(ITYP)='REAL*8'
  669.             ENDDO
  670. C=DEB==== FORMULATION HHO ==== Traitement particulier du modele ========
  671.             IDECAL = 0
  672.             IF (MFR.EQ.HHO_MFR_ELEMENT) IDECAL = 4
  673. C=FIN==== FORMULATION HHO ==============================================
  674. C pour le modele mistral il y a 10 composantes non lineaires qui sont des listes de reels
  675.             NLDEB=NMATR-9-IDECAL
  676.             NLFIN=NMATR-IDECAL
  677.             DO ITYP = NLDEB, NLFIN
  678.               TYPE(ITYP)='POINTEURLISTREEL'
  679.             ENDDO
  680. C mistral.
  681. C poi1 -- MODAL
  682.           ELSE IF (CMATE.EQ.'MODAL') THEN
  683.             NBTYPE=3
  684.             SEGINI NOTYPE
  685.             TYPE(1)='REAL*8  '
  686.             TYPE(2)='REAL*8  '
  687.             TYPE(3)='POINTEURCHPOINT'
  688. C poi1 -- STATIQUE
  689.           ELSE IF (CMATE.EQ.'STATIQUE') THEN
  690.             NBTYPE=1
  691.             SEGINI NOTYPE
  692.             TYPE(1)='POINTEURCHPOINT'
  693.           ENDIF
  694. C=DEB==== FORMULATION HHO ==== Traitement particulier du modele ========
  695.           IF (MFR .EQ. HHO_MFR_ELEMENT) THEN
  696.             IF (NBTYPE.EQ.1) THEN
  697.               IF (NOTYPE .EQ. MOTYR8) THEN
  698.                 SEGINI,NOTYPE
  699.                 TYPE(1)='REAL*8  '
  700.               ENDIF
  701.               NBTYPE = NMATT
  702.               SEGADJ,NOTYPE
  703.               DO ITYP = 2, NBTYPE
  704.                 TYPE(ITYP) = TYPE(1)
  705.               END DO
  706.             END IF
  707.             TYPE(NMATR-1) = 'POINTEURLISTREEL'
  708.             TYPE(NMATR  ) = 'POINTEURLISTREEL'
  709.           END IF
  710. C=FIN==== FORMULATION HHO ==============================================
  711.  
  712.           MOTYMA = NOTYPE
  713.  
  714.         ENDIF
  715. C
  716. C   >>>     COMPOSANTES DE CARACTERISTIQUES UTILES
  717. C
  718.         NBROBL = 0
  719.         NBRFAC = 0
  720.         NOMID  = 0
  721. C Sauf cas particuliers, toutes les composantes de type REAL*8
  722.         NBTYPE = 0
  723.         NOTYPE = MOTYR8
  724. C
  725. C EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES
  726. C
  727.         IF ( (MFR.EQ.1 .OR. MFR.EQ.31 .OR.
  728. C=DEB==== FORMULATION HHO ==============================================
  729.      &        (MFR.EQ.HHO_MFR_ELEMENT).OR.
  730. C=FIN==== FORMULATION HHO ==============================================
  731.      &       ((MELE.GE.79.AND.MELE.LE.83).OR.
  732.      &        (MELE.GE.173.AND.MELE.LE.182)) )
  733.      &      .AND. IFOUR.EQ.-2) THEN
  734.           NBRFAC=1
  735.           SEGINI NOMID
  736.           LESFAC(1)='DIM3'
  737. C
  738. C EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  739. C
  740.         ELSE IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  741.           NBROBL=1
  742.           IF (MFR.EQ.3.AND.IFOUR.EQ.-2) THEN
  743.             NBRFAC=2
  744.           ELSE
  745.             NBRFAC=1
  746.           ENDIF
  747.           SEGINI,NOMID
  748.           LESOBL(1)='EPAI'
  749.           LESFAC(1)='EXCE'
  750.           IF (MFR.EQ.3.AND.IFOUR.EQ.-2)  LESFAC(2)='DIM3'
  751. C
  752. C SECTION POUR LES BARRES ET LES CERCES
  753. C
  754.         ELSE IF (MFR.EQ.27.OR.MFR.EQ.78) THEN
  755.           IF (.NOT.dcmate) THEN
  756.             NBROBL=1
  757.             SEGINI,NOMID
  758.             LESOBL(1)='SECT'
  759.           ENDIF
  760. C
  761. C section, excentrements et orientation pour les barres excentrees
  762. C
  763.         ELSE IF (MFR.EQ.49) THEN
  764.           NBROBL=6
  765.           SEGINI NOMID
  766.           LESOBL(1)='SECT'
  767.           LESOBL(2)='EXCZ'
  768.           LESOBL(3)='EXCY'
  769.           LESOBL(4)='VX  '
  770.           LESOBL(5)='VY  '
  771.           LESOBL(6)='VZ  '
  772. C
  773. C raideurs locales et orientation pour l'element LIA2
  774. C              de liaison a 2 noeuds
  775. C
  776.         ELSE IF (MFR.EQ.51) THEN
  777.           NBROBL=9
  778.           SEGINI,NOMID
  779.           LESOBL(1)='RLUX'
  780.           LESOBL(2)='RLUY'
  781.           LESOBL(3)='RLUZ'
  782.           LESOBL(4)='RLRX'
  783.           LESOBL(5)='RLRY'
  784.           LESOBL(6)='RLRZ'
  785.           LESOBL(7)='VX  '
  786.           LESOBL(8)='VY  '
  787.           LESOBL(9)='VZ  '
  788. C
  789. C CARACTERISTIQUES POUR LES POUTRES
  790. C
  791.         ELSE IF (MFR.EQ.7 ) THEN
  792.           if (dcmate) then
  793.             NBRFAC=6
  794.             SEGINI NOMID
  795.             LESFAC(1)='TORS'
  796.             LESFAC(2)='INRY'
  797.             LESFAC(3)='INRZ'
  798.             LESFAC(4)='VX  '
  799.             LESFAC(5)='VY  '
  800.             LESFAC(6)='VZ  '
  801.             IVECT=1
  802.           else
  803.             IF (CMATE.EQ.'SECTION') THEN
  804.               NBRFAC=3
  805.               SEGINI NOMID
  806.               LESFAC(1)='VX  '
  807.               LESFAC(2)='VY  '
  808.               LESFAC(3)='VZ  '
  809.               IVECT=1
  810. C CAS 2D
  811.             ELSE IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  812.               NBRFAC=1
  813.               NBROBL=2
  814.               SEGINI NOMID
  815.               LESOBL(1)= 'SECT'
  816.               LESOBL(2)= 'INRZ'
  817.               LESFAC(1)= 'SECY'
  818.             ELSE
  819.               NBROBL=4
  820.               NBRFAC=5
  821.               SEGINI NOMID
  822.               LESOBL(1)='TORS'
  823.               LESOBL(2)='INRY'
  824.               LESOBL(3)='INRZ'
  825.               LESOBL(4)='SECT'
  826.               LESFAC(1)='SECY'
  827.               LESFAC(2)='SECZ'
  828.               LESFAC(3)='VX  '
  829.               LESFAC(4)='VY  '
  830.               LESFAC(5)='VZ  '
  831.               IVECT=1
  832.             ENDIF
  833.           endif
  834. C
  835. C CARACTERISTIQUES POUR LES TUYAUX
  836. C
  837.         ELSE IF (MFR.EQ.13) THEN
  838.           NBROBL=2
  839.           NBRFAC=6
  840.           SEGINI NOMID
  841.           LESOBL(1)='EPAI'
  842.           LESOBL(2)='RAYO'
  843.           LESFAC(1)='RACO'
  844.           LESFAC(2)='PRES'
  845.           LESFAC(3)='CISA'
  846.           LESFAC(4)='VX  '
  847.           LESFAC(5)='VY  '
  848.           LESFAC(6)='VZ  '
  849.           IVECT=1
  850. C
  851.         ELSE IF (MFR.EQ.39) THEN
  852.           NBROBL=2
  853.           NBRFAC=5
  854.           SEGINI NOMID
  855.           LESOBL(1)='EPAI'
  856.           LESOBL(2)='RAYO'
  857.           LESFAC(1)='RACO'
  858.           LESFAC(2)='PRES'
  859.           LESFAC(3)='VX  '
  860.           LESFAC(4)='VY  '
  861.           LESFAC(5)='VZ  '
  862.           IVECT=1
  863. C
  864. C CARACTERISTIQUES POUR LES LINESPRING
  865. C
  866.         ELSE IF (MFR.EQ.15) THEN
  867.           NBROBL=5
  868.           SEGINI NOMID
  869.           LESOBL(1)='EPAI'
  870.           LESOBL(2)='FISS'
  871.           LESOBL(3)='VX  '
  872.           LESOBL(4)='VY  '
  873.           LESOBL(5)='VZ  '
  874. C
  875. C CARACTERISTIQUES POUR LES TUYAUX FISSURES
  876. C
  877.         ELSE IF (MFR.EQ.17) THEN
  878.           NBROBL=9
  879.           SEGINI NOMID
  880.           LESOBL(1)='RAYO'
  881.           LESOBL(2)='EPAI'
  882.           LESOBL(3)='VX  '
  883.           LESOBL(4)='VY  '
  884.           LESOBL(5)='VZ  '
  885.           LESOBL(6)='VXF '
  886.           LESOBL(7)='VYF '
  887.           LESOBL(8)='VZF '
  888.           LESOBL(9)='ANGL'
  889. C
  890. C CARACTERISTIQUES DES ELEMENTS HOMOGENEISES
  891. C
  892.         ELSE IF (MFR.EQ.37) THEN
  893.           IF (IFOUR.EQ.1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.2) THEN
  894.             NBROBL=5
  895.             SEGINI NOMID
  896.             LESOBL(1)='SCEL'
  897.             LESOBL(2)='SFLU'
  898.             LESOBL(3)='EPS '
  899.             LESOBL(4)='SECT'
  900.             LESOBL(5)='INRZ '
  901.           ELSE
  902.             NBROBL=3
  903.             SEGINI NOMID
  904.             LESOBL(1)='SCEL'
  905.             LESOBL(2)='SFLU'
  906.             LESOBL(3)='EPS '
  907.           ENDIF
  908. C
  909. C CARACTERISTIQUES DE L'ELEMENT TUYAU ACOUSTIQUE
  910. C
  911.         ELSE IF (MFR.EQ.41) THEN
  912.            NBROBL=1
  913.            NBRFAC=1
  914.            SEGINI NOMID
  915.            LESOBL(1)='RAYO'
  916.            LESFAC(1)='RACO'
  917. C
  918. C     CARACTERISTIQUE POUR LES JOINTS GENE
  919. C
  920.         ELSE IF (MFR.EQ.55) THEN
  921.           NBRFAC=1
  922.           SEGINI NOMID
  923.           LESFAC(1)='EPAI'
  924. C
  925. C CARACTERISTIQUE MACRO_EL (element CIFL)
  926. C
  927.         ELSE IF (MFR.EQ.61)THEN
  928.           NBROBL=2
  929.           SEGINI NOMID
  930.           LESOBL(1)= 'SECT'
  931.           LESOBL(2)= 'INRZ'
  932. C
  933. C  CARACTERISTIQUES POUR LE JOI1 SI IMAT = 2
  934. C
  935.         ELSE IF (MFR.EQ.75.AND.IMAT.EQ.2) THEN
  936.           IF (IDIM.EQ.2) THEN
  937.             NBROBL=2
  938.             SEGINI NOMID
  939.             LESOBL(1)='V1X '
  940.             LESOBL(2)='V1Y '
  941.           ELSE IF(IDIM.EQ.3) THEN
  942.             NBROBL=6
  943.             SEGINI NOMID
  944.             LESOBL(1)='V1X '
  945.             LESOBL(2)='V1Y '
  946.             LESOBL(3)='V1Z '
  947.             LESOBL(4)='V2X '
  948.             LESOBL(5)='V2Y '
  949.             LESOBL(6)='V2Z '
  950.           ENDIF
  951.  
  952.         ENDIF
  953.  
  954.         NCARA = NBROBL
  955.         NCARF = NBRFAC
  956.         NCARR = NCARA+NCARF
  957.         MOCARA = NOMID
  958.  
  959. C rendement kich 09/01
  960.         NCAR1 = NCARR + 1
  961.         ifac = NBRFAC
  962.         NBRFAC = NBRFAC + 10
  963.         if (mocara.le.0) then
  964.           segini,nomid
  965.           mocara = nomid
  966.         else
  967.           segadj,nomid
  968.         endif
  969.         lesfac(ifac + 1) = 'REND'
  970.         lesfac(ifac + 2) = 'W1X '
  971.         lesfac(ifac + 3) = 'W1Y '
  972.         lesfac(ifac + 4) = 'W1Z '
  973.         lesfac(ifac + 5) = 'W2X '
  974.         lesfac(ifac + 6) = 'W2Y '
  975.         lesfac(ifac + 7) = 'W2Z '
  976.         lesfac(ifac + 8) = 'REN1'
  977.         lesfac(ifac + 9) = 'REN2'
  978.         lesfac(ifac +10) = 'REN3'
  979.  
  980.         motype = notype
  981.         if (motype.ne.motyr8) then
  982.           nbtype = notype.type(/2) + 1
  983.           segadj,notype
  984.           notype.type(nbtype) = 'REAL*8'
  985.         endif
  986.  
  987.         MOTYCA = notype
  988.  
  989. c-------------------------------------------------------------------------------
  990.  
  991.         nbnn1  = NBNOE1
  992.  
  993. c lre : nb de noeuds par mult
  994.         if (nefmod.eq. 22) lre=nbnn1
  995. c lre : nb de noeuds par sure
  996.         if (nefmod.eq.259) lre=nbnn1
  997. C
  998. C   traitement particulier pour milieu poreux
  999.         IPPORE=0
  1000.         IF (MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59)  THEN
  1001.           IPPORE=NBNNE(NUMGEO(MELE))
  1002.         ENDIF
  1003.  
  1004.         IDECAP=0
  1005.         IF (MELE.GE.79.AND.MELE.LE.83) THEN
  1006.           IDECAP=1
  1007.           LRE = LRE + 2*NBNN1 - IPORE
  1008.         ELSE IF (MELE.GE.108.AND.MELE.LE.110) THEN
  1009.           IDECAP=1
  1010.           LRE = LRE + (3*NBNN1 - IPORE)/2 - NBSOM(IELE)
  1011.         ELSE IF (MELE.GE.173.AND.MELE.LE.177) THEN
  1012.           IDECAP=2
  1013.           LRE = LRE + (2*NBNN1 - IPORE)*IDECAP
  1014.           LHOOK=4
  1015.           IF(IFOUR.EQ.1) LHOOK=6
  1016.         ELSE IF (MELE.GE.185.AND.MELE.LE.187) THEN
  1017.           IDECAP=2
  1018.           LRE = LRE + ((3*NBNN1 - IPORE)/2 - NBSOM(IELE))*IDECAP
  1019.           LHOOK=2
  1020.           IF(IFOUR.EQ.1) LHOOK=3
  1021.         ELSE IF (MELE.GE.178.AND.MELE.LE.182) THEN
  1022.           IDECAP=3
  1023.           LRE = LRE + (2*NBNN1 - IPORE)*IDECAP
  1024.           LHOOK=4
  1025.           IF(IFOUR.EQ.1) LHOOK=6
  1026.         ELSE IF (MELE.GE.188.AND.MELE.LE.190) THEN
  1027.           IDECAP=3
  1028.           LRE = LRE + ((3*NBNN1 - IPORE)/2 - NBSOM(IELE))*IDECAP
  1029.           LHOOK=2
  1030.           IF(IFOUR.EQ.1) LHOOK=3
  1031.         ENDIF
  1032. C
  1033. C          REMPLISSAGE DU SEGMENT DESCRIPTEUR
  1034. C
  1035.         NCOMP = NDEPL
  1036.         NBNNS = NBNOE1
  1037.         NBNN  = NBNOE1
  1038.         IF (MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59) THEN
  1039.           NCOMP=NDEPL-IDECAP
  1040.         ENDIF
  1041.         IF (LDPGE) THEN
  1042.           NCOMP = NDEPL - NDPGE
  1043.           NBNN = NBNOE1 + 1
  1044.         ENDIF
  1045.         IF (MFR.EQ.19.OR.MFR.EQ.21) NBNNS=NBNN/2
  1046.         if (dcmat2) NCOMP = NDEPL/2
  1047.  
  1048.         NLIGRP = LRE
  1049.         NLIGRD = LRE
  1050.         IF ((MFR.NE.61) .AND. (NBNNS*NCOMP .GT. NLIGRD)) THEN
  1051. C          erreur dans les dimensions de DESCR
  1052. C          le mode de calcul n'est pas correct
  1053.           CALL ERREUR(717)
  1054.           RETURN
  1055.         ENDIF
  1056.  
  1057.         SEGINI,DESCR
  1058.         IPDSCR = DESCR
  1059.  
  1060.         IDDL = 1
  1061.  
  1062.         IF (MFR.EQ.61) THEN
  1063.           NOELEP(1)=1
  1064.           NOELEP(2)=1
  1065.           NOELEP(3)=1
  1066.           NOELEP(4)=3
  1067.           NOELEP(5)=3
  1068.           NOELEP(6)=3
  1069.           NOELEP(7)=2
  1070.           NOELEP(8)=2
  1071.  
  1072.           DO IE1=1,LRE
  1073.             NOELED(IE1)=NOELEP(IE1)
  1074.           ENDDO
  1075.  
  1076.           NOMID=MODEPL
  1077.           DO IE1=1,3
  1078.             LISINC(IE1)=LESOBL(IE1)
  1079.             LISINC(IE1+3)=LESOBL(IE1)
  1080.           ENDDO
  1081.           LISINC(7)=LESOBL(4)
  1082.           LISINC(8)=LESOBL(5)
  1083.  
  1084.           NOMID=MOFORC
  1085.           DO IE1=1,3
  1086.             LISDUA(IE1)=LESOBL(IE1)
  1087.             LISDUA(IE1+3)=LESOBL(IE1)
  1088.           ENDDO
  1089.           LISDUA(7)=LESOBL(4)
  1090.           LISDUA(8)=LESOBL(5)
  1091.  
  1092.           IDDL = 9
  1093.  
  1094.         ELSE
  1095.           NFAC=(3*NBNN-IPORE)/2
  1096.  
  1097.           DO INOEUD = 1, NBNNS
  1098.             IF ((MELE.GE.108.AND.MELE.LE.110.AND.INOEUD.GT.NFAC)
  1099.      &       .OR.(MELE.GE.185.AND.MELE.LE.187.AND.INOEUD.GT.NFAC)
  1100.      &       .OR.(MELE.GE.188.AND.MELE.LE.190.AND.INOEUD.GT.NFAC))
  1101.      &           GO TO 1004
  1102.             DO ICOMP=1,NCOMP
  1103.               NOMID=MODEPL
  1104.               LISINC(IDDL)=LESOBL(ICOMP)
  1105.               if (dcmat2) LISINC(IDDL)=LESOBL(IDDL)
  1106.               NOMID=MOFORC
  1107.               LISDUA(IDDL)=LESOBL(ICOMP)
  1108.               if (dcmat2) LISDUA(IDDL)=LESOBL(IDDL)
  1109.               NOELEP(IDDL)=INOEUD
  1110.               NOELED(IDDL)=INOEUD
  1111.               IDDL=IDDL+1
  1112.             ENDDO
  1113.  1004       CONTINUE
  1114.           ENDDO
  1115.  
  1116.         ENDIF
  1117.  
  1118. C   CAS DE LA DEFORMATION PLANE GENERALISEE
  1119.         IF (LDPGE) THEN
  1120.           DO ICOMP=(NDPGE-1),0,-1
  1121.             NOMID=MODEPL
  1122.             LISINC(IDDL)=LESOBL(NDEPL-ICOMP)
  1123.             NOMID=MOFORC
  1124.             LISDUA(IDDL)=LESOBL(NFORC-ICOMP)
  1125.             NOELEP(IDDL)=NBNN
  1126.             NOELED(IDDL)=NBNN
  1127.             IDDL=IDDL+1
  1128.           ENDDO
  1129.         ENDIF
  1130.  
  1131. C   CAS DES MILIEUX POREUX
  1132. C   POUR LA PRESSION ON MET D'ABORD LES SOMMETS
  1133.         IF (MFR.EQ.33) THEN
  1134.           DO INOEUD=1,NBSOM(IELE)
  1135.             NOMID=MODEPL
  1136.             LISINC(IDDL)=LESOBL(NDEPL)
  1137.             NOMID=MOFORC
  1138.             LISDUA(IDDL)=LESOBL(NDEPL)
  1139.             NOELEP(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1)
  1140.             NOELED(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1)
  1141.             IDDL=IDDL+1
  1142.           ENDDO
  1143.  
  1144.           IF (MELE.GE.79.AND.MELE.LE.83) THEN
  1145.  
  1146.             DO INOEUD=1,NBNN
  1147.               DO INSOM=1,NBSOM(IELE)
  1148.                 IF(INOEUD.EQ.IBSOM(NSPOS(IELE)+INSOM-1)) GO TO 1105
  1149.               ENDDO
  1150.               NOMID=MODEPL
  1151.               LISINC(IDDL)=LESOBL(NDEPL)
  1152.               NOMID=MOFORC
  1153.               LISDUA(IDDL)=LESOBL(NDEPL)
  1154.               NOELEP(IDDL)=INOEUD
  1155.               NOELED(IDDL)=INOEUD
  1156.               IDDL=IDDL+1
  1157.  1105         CONTINUE
  1158.             ENDDO
  1159.  
  1160.           ELSE IF (MELE.GE.108.AND.MELE.LE.110) THEN
  1161.  
  1162.             DO INOEUD=NFAC+1,NBNN
  1163.               NOMID=MODEPL
  1164.               LISINC(IDDL)=LESOBL(NDEPL)
  1165.               NOMID=MOFORC
  1166.               LISDUA(IDDL)=LESOBL(NDEPL)
  1167.               NOELEP(IDDL)=INOEUD
  1168.               NOELED(IDDL)=INOEUD
  1169.               IDDL=IDDL+1
  1170.             ENDDO
  1171.  
  1172.             DO INOEUD=1,NFAC
  1173.               DO INSOM=1,NBSOM(IELE)
  1174.                 IF(INOEUD.EQ.IBSOM(NSPOS(IELE)+INSOM-1)) GO TO 1110
  1175.               ENDDO
  1176.               NOMID=MODEPL
  1177.               LISINC(IDDL)=LESOBL(NDEPL)
  1178.               NOMID=MOFORC
  1179.               LISDUA(IDDL)=LESOBL(NDEPL)
  1180.               NOELEP(IDDL)=INOEUD
  1181.               NOELED(IDDL)=INOEUD
  1182.               IDDL=IDDL+1
  1183.  1110         CONTINUE
  1184.             ENDDO
  1185.  
  1186.           ENDIF
  1187.  
  1188.         ELSE IF (MFR.EQ.57.OR.MFR.EQ.59) THEN
  1189.  
  1190.           DO IPR=1,IDECAP
  1191.             NDECAP = NDEPL-IDECAP+IPR
  1192.  
  1193.             DO INOEUD=1,NBSOM(IELE)
  1194.               NOMID=MODEPL
  1195.               LISINC(IDDL)=LESOBL(NDECAP)
  1196.               NOMID=MOFORC
  1197.               LISDUA(IDDL)=LESOBL(NDECAP)
  1198.               NOELEP(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1)
  1199.               NOELED(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1)
  1200.               IDDL=IDDL+1
  1201.             ENDDO
  1202.  
  1203.             IF (MELE.GE.173.AND.MELE.LE.182) THEN
  1204.  
  1205.               DO INOEUD=1,NBNN
  1206.                 DO INSOM=1,NBSOM(IELE)
  1207.                   IF(INOEUD.EQ.IBSOM(NSPOS(IELE)+INSOM-1)) GO TO 1205
  1208.                 ENDDO
  1209.                 NOMID=MODEPL
  1210.                 LISINC(IDDL)=LESOBL(NDECAP)
  1211.                 NOMID=MOFORC
  1212.                 LISDUA(IDDL)=LESOBL(NDECAP)
  1213.                 NOELEP(IDDL)=INOEUD
  1214.                 NOELED(IDDL)=INOEUD
  1215.                 IDDL=IDDL+1
  1216.  1205           CONTINUE
  1217.               ENDDO
  1218.  
  1219.             ELSE IF (MELE.GE.185.AND.MELE.LE.190) THEN
  1220.  
  1221.               DO INOEUD=NFAC+1,NBNN
  1222.                 NOMID=MODEPL
  1223.                 LISINC(IDDL)=LESOBL(NDECAP)
  1224.                 NOMID=MOFORC
  1225.                 LISDUA(IDDL)=LESOBL(NDECAP)
  1226.                 NOELEP(IDDL)=INOEUD
  1227.                 NOELED(IDDL)=INOEUD
  1228.                 IDDL=IDDL+1
  1229.               ENDDO
  1230.  
  1231.               DO INOEUD=1,NFAC
  1232.                 DO INSOM=1,NBSOM(IELE)
  1233.                   IF(INOEUD.EQ.IBSOM(NSPOS(IELE)+INSOM-1)) GO TO 1710
  1234.                 ENDDO
  1235.                 NOMID=MODEPL
  1236.                 LISINC(IDDL)=LESOBL(NDECAP)
  1237.                 NOMID=MOFORC
  1238.                 LISDUA(IDDL)=LESOBL(NDECAP)
  1239.                 NOELEP(IDDL)=INOEUD
  1240.                 NOELED(IDDL)=INOEUD
  1241.                 IDDL=IDDL+1
  1242.  1710           CONTINUE
  1243.               ENDDO
  1244. C
  1245.             ENDIF
  1246.  
  1247.           ENDDO
  1248.  
  1249. C    CAS DES ELEMENT RACCORD
  1250.         ELSE IF (MFR.EQ.19.OR.MFR.EQ.21) THEN
  1251.           CALL IDPRIM(IMODEL,MFR+1000,MODPL,NDEPL,NDUM)
  1252.           CALL IDDUAL(IMODEL,MFR+1000,MOFRC,NFORC,NDUM)
  1253.           DO INOEUD=NBNNS+1,NBNN
  1254.             DO ICOMP=1,NDEPL
  1255.               NOMID=MODPL
  1256.               LISINC(IDDL)=LESOBL(ICOMP)
  1257.               NOMID=MOFRC
  1258.               LISDUA(IDDL)=LESOBL(ICOMP)
  1259.               NOELEP(IDDL)=INOEUD
  1260.               NOELED(IDDL)=INOEUD
  1261.               IDDL=IDDL+1
  1262.             ENDDO
  1263.           ENDDO
  1264.           NOMID=MODPL
  1265.           SEGSUP,NOMID
  1266.           NOMID=MOFRC
  1267.           SEGSUP,NOMID
  1268.  
  1269.         ENDIF
  1270.  
  1271.         SEGDES,DESCR
  1272.  
  1273. C Si necessaire partitionnement du xmatri
  1274.         LTRK = oooval(1,4)
  1275.         if (LTRK.eq.0) LTRK = oooval(1,1)
  1276.         LTRK = MAX(LTRK,2**24)
  1277.  
  1278. C Ajout a la taille en mots de la matrice des infos du segment
  1279.         lseg   =  lre*lre*nbele1 + 16
  1280.         nblprt = (lseg-1)/ltrk+1
  1281. **      if (nblprt.eq.1 .and. nbele1.gt.20) nblprt = 2
  1282.         nblmax = (nbele1-1)/nblprt+1
  1283.         nblprt = (nbele1-1)/nblmax+1
  1284.  
  1285. c**        if (nblprt.gt.1) then
  1286. c**          write(ioimp,*) 'RIGI1 : IMODEL = ',imodel,isous
  1287. c**          write(ioimp,*) 'RIGI1 : nblprt nblmax = ',nblprt,nblmax,nbele1
  1288. c**        endif
  1289.  
  1290.         NRIGE0 = mrigid.IRIGEL(/2)
  1291.         nrigel = NRIGE0 + NBLPRT
  1292.         if (cmate.eq.'NLIN') nrigel = nrige0 + nrnlin*nblprt
  1293.         SEGADJ,MRIGID
  1294.         IPOI6 = MRIGID
  1295.  
  1296.         meleme = IPT1
  1297.         ipt3   = IPMAIG
  1298.         nbnn   = NBNOE1
  1299.         nbelem = NBELE1
  1300.         nbsous = 0
  1301.         nbref  = 0
  1302.  
  1303.         DO 505 iprt = 1, nblprt
  1304.  
  1305.           isou = isou+1
  1306.  
  1307.           if (nblprt.gt.1) then
  1308.             inelem = (iprt-1) * nblmax
  1309.             nbnn   = NBNOE1
  1310.             nbelem = MIN(nblmax,nbele1-inelem)
  1311. C            write(ioimp,*) ' creation segment ',nbnn,nbelem
  1312.             SEGINI,meleme
  1313.             meleme.itypel = ipt1.itypel
  1314.             do ielt = 1, nbelem
  1315.               jelt = ielt + inelem
  1316.               do inoe = 1, nbnn
  1317.                 num(inoe,ielt) = ipt1.num(inoe,jelt)
  1318.               enddo
  1319.               icolor(ielt) = ipt1.icolor(jelt)
  1320.             enddo
  1321.             IF (LDPGE) THEN
  1322.               ipt2   = IPMAIG
  1323.               nbnn   = NBNOEG
  1324. cc              nbelem = MIN(NBLMAX,NBELEG-inelem)
  1325.               SEGINI,ipt3
  1326.               ipt3.itypel = 28
  1327.               DO ielt = 1, nbelem
  1328.                 jelt = ielt + inelem
  1329.                 DO inoe = 1, nbnn
  1330.                   ipt3.num(inoe,ielt) = IPT2.NUM(inoe,jelt)
  1331.                 ENDDO
  1332.                 ipt3.icolor(ielt) = IPT2.ICOLOR(jelt)
  1333.               ENDDO
  1334.               SEGDES,IPT3
  1335.             ELSE
  1336.               ipt3 = meleme
  1337.             ENDIF
  1338.           endif
  1339.  
  1340.           nbnn   = NBNOE1
  1341.           ipmail = meleme
  1342.           ipdscr = DESCR
  1343.           ipmadg = ipt3
  1344.  
  1345. C* Tests faits avant normalement :
  1346.           IF (MELE.EQ.22)  GOTO 9991
  1347.           IF (MELE.EQ.259) GOTO 9991
  1348. C* Cas particulier des elements XFEM en cas de partition :
  1349. C* Il faut aussi partitionner le modele (nomme imoxfem)
  1350.           IF (MFR.EQ.63) THEN
  1351.             IF (nblprt.GT.1) THEN
  1352.               imoxfem = 0
  1353.               CALL PARTXR(IMODEL,ipmail,imoxfem)
  1354.             ELSE
  1355.               imoxfem = IMODEL
  1356.             ENDIF
  1357.           ENDIF
  1358. C=DEB==== FORMULATION HHO ==== Traitement particulier du modele ========
  1359.           IF (MFR.EQ.HHO_MFR_ELEMENT) THEN
  1360.             IF (nblprt.GT.1) THEN
  1361.               SEGINI,imode1=imodel
  1362.               imode1.imamod=ipmail
  1363.               imohho = imode1
  1364.               CALL HHOPAR(imohho,iret)
  1365.               if (iret.ne.0) return
  1366.             ELSE
  1367.               imohho = IMODEL
  1368.             ENDIF
  1369.           ENDIF
  1370. C=FIN==== FORMULATION HHO ==============================================
  1371.  
  1372. C       TRAITEMENT DES CHAMPS EN ENTREE
  1373. C       -------------------------------
  1374. C  >>>     CHAMP DE MATRICES DE HOOKE
  1375. C
  1376.         IF (IMAT.EQ.2) THEN
  1377.  
  1378.           CALL KOMCHA(IPCHOO,IPMAIL,CONM,MOMATR,MOTYMA,1,INFOS,3,IVAMAT)
  1379.           IF (IERR.NE.0) GOTO 9991
  1380.  
  1381.           MPTVAL=IVAMAT
  1382.           MELVAL=IVAL(1)
  1383.           NBGMAT=IELCHE(/1)
  1384.           NELMAT=IELCHE(/2)
  1385.  
  1386.           IF(IPCHE2.EQ.0.AND.ISUP.EQ.1)THEN
  1387.             CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  1388.             IF(IERR.NE.0)THEN
  1389.               ISUP=0
  1390.               GOTO 9991
  1391.             ENDIF
  1392.           ENDIF
  1393. C
  1394. C   >>>  CHAMP DE MATERIAU
  1395. C
  1396.         ELSE
  1397.  
  1398.           CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYMA,1,INFOS,3,IVAMAT)
  1399.           IF (IERR.NE.0) GOTO 9991
  1400.  
  1401.           IF (ISUP.EQ.1)THEN
  1402.             CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  1403.             IF(IERR.NE.0)THEN
  1404.               ISUP=0
  1405.               GOTO 9991
  1406.             ENDIF
  1407.           ENDIF
  1408. C
  1409.           MPTVAL=IVAMAT
  1410. C
  1411.           if (cmate.eq.'STATIQUE'.or.cmate.eq.'MODAL') then
  1412. c*NU        Test inutile car KOMCHA sort en erreur s'il ne trouve pas les composantes demandees
  1413.             if (ival(/1).lt.3) then
  1414.               moterr(1:50) = ' erreur modal ou statique '
  1415.               call erreur(-385)
  1416.               call erreur(5)
  1417.               return
  1418.             endif
  1419.             if (cmate.eq.'STATIQUE') then
  1420.               kstat = kstat + 1
  1421.               ivstat(kstat) = ivamat
  1422.               pistat(kstat) = imodel
  1423.               if (kstat.eq.nstat) then
  1424.                 nstat = nstat + 100
  1425.                 segadj modsta
  1426.               endif
  1427.             else if (cmate.eq.'MODAL') then
  1428.               kmoda = kmoda + 1
  1429.               ivmoda(kmoda) = ivamat
  1430.               pimoda(kmoda) = imodel
  1431.               if (kmoda.eq.nmoda) then
  1432.                 nmoda = nmoda + 100
  1433.                 segadj modsta
  1434.               endif
  1435.             endif
  1436.           endif
  1437.  
  1438.           NBGMAT = 0
  1439.           NELMAT = 0
  1440.           IF (CMATE.EQ.'SECTION') THEN
  1441.             DO IM = 1,ival(/1)
  1442.               MELVAL = IVAL(IM)
  1443.               IF (MELVAL.NE.0) THEN
  1444.                 NBGMAT=MAX(NBGMAT,IELCHE(/1))
  1445.                 NELMAT=MAX(NELMAT,IELCHE(/2))
  1446.               ENDIF
  1447.             ENDDO
  1448.           ELSE
  1449.             DO IM=1,ival(/1)
  1450.               MELVAL = IVAL(IM)
  1451.               IF (MELVAL.NE.0) THEN
  1452.                 NBGMAT=MAX(NBGMAT,VELCHE(/1))
  1453.                 NELMAT=MAX(NELMAT,VELCHE(/2))
  1454.               ENDIF
  1455.             ENDDO
  1456.           ENDIF
  1457.         ENDIF
  1458. C
  1459. C   >>>     CHAMPS DE CARACTERISTIQUES
  1460. C
  1461.         IF (IPCHE1.NE.0.AND.MOCARA.NE.0)  THEN
  1462.           CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYCA,1,INFOS,3,IVACAR)
  1463.           IF (IERR.NE.0) GOTO 9991
  1464. C
  1465.           IF (ISUP.EQ.1) THEN
  1466.             CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  1467.             IF(IERR.NE.0)THEN
  1468.               ISUP=0
  1469.               GOTO 9991
  1470.             ENDIF
  1471.           ENDIF
  1472.         ENDIF
  1473.  
  1474.         IF (IVACAR.EQ.0) THEN
  1475. *
  1476. *  AM  11/06/16  VERIFICATION DE LA PRESENCE DES CARACTERTISTIQUES
  1477. *                POUR LES ELEMENTS TYPE POUTRE ET ASSIMILES
  1478. *                NECESSAIRE AUSSI EN CAS DE MATRICE DE HOOKE
  1479.  
  1480.            IF(MELE.EQ.29.OR.MELE.EQ.42.OR.MELE.EQ.84
  1481.      &       .OR.MELE.EQ.97) THEN
  1482.                 CALL ERREUR (404)
  1483.                 GO TO 9991
  1484.            ENDIF
  1485.  
  1486.            IF(MFR.EQ.75.AND.IMAT.EQ.2) THEN
  1487.               CALL ERREUR (404)
  1488.               GO TO 9991
  1489.            ENDIF
  1490.         ENDIF
  1491.         MPTVAL = IVACAR
  1492.  
  1493. C cas particuliers des XFEM
  1494.         IF (MFR.EQ.63) GOTO 63
  1495.  
  1496. C=DEB==== FORMULATION HHO ==== Cas particulier de la formulation =======
  1497.         IF (MFR.EQ.HHO_MFR_ELEMENT) GOTO 89
  1498. C=FIN==== FORMULATION HHO ==============================================
  1499.  
  1500. C NAVIER_STOKES NLIN
  1501.         if (cmate.eq.'NLIN') then
  1502.           segact mmode1*mod
  1503.           mmode1.kmodel(1) = imodel
  1504.           mchel1.conche(1) = conm
  1505.           mchel1.imache(1) = ipmail
  1506.           mptval = ivamat
  1507.           nomid = momatr
  1508.           do jj = 1,n2
  1509.             mcham1.nomche(jj) = lesobl(jj)
  1510.             mcham1.typche(jj) = tyval(jj)
  1511.             mcham1.ielval(jj) = ival(jj)
  1512.           enddo
  1513.  
  1514.           ipmons = mmode1
  1515.           ipchns = mchel1
  1516.           if (noerjk.eq.2) then
  1517.             call go2nli(ipmons,ipchns,iprins,3)
  1518.           else
  1519.             call go2nli(ipmons,ipchns,iprins,1)
  1520.           endif
  1521.           if (ierr.ne.0) return
  1522.  
  1523.           goto 2999
  1524.         endif
  1525.  
  1526. C-----------------------------------------------------------------------
  1527. C                          P H A S E   2
  1528. C
  1529. C                 PREPARATION DES OBJETS RESULTATS
  1530. C
  1531. C-----------------------------------------------------------------------
  1532. C
  1533.  2999  if (cmate.eq.'NLIN') then
  1534.            RI3 = iprins
  1535.            segact ri3
  1536.            if (ri3.coerig(/1).ne.nrnlin) then
  1537. c             write(6,*) 'ri3',ri3.coerig(/1),nrnlin
  1538.              call erreur(5)
  1539.              return
  1540.            endif
  1541.            isou = isou - 1
  1542.            do kige = 1,nrnlin
  1543.              ipdesc = ri3.IRIGEL(3,kige)
  1544.              ipmatr = ri3.IRIGEL(4,kige)
  1545.              isymm = ri3.irigel(7,kige)
  1546.  
  1547.           isou = isou + 1
  1548.           jrige = isou
  1549.           COERIG(jrige)   = ri3.coerig(kige)
  1550.           IRIGEL(1,jrige) = ipmail
  1551.           IRIGEL(2,jrige) = 0
  1552.           IRIGEL(3,jrige) = ipdesc
  1553.           IRIGEL(4,jrige) = ipmatr
  1554.           IRIGEL(5,jrige) = NIFOUR
  1555.           IRIGEL(6,jrige) = 0
  1556.           IRIGEL(7,jrige) = ri3.irigel(7,kige)
  1557.           IRIGEL(8,jrige) = 0
  1558.            enddo
  1559.          else
  1560. C
  1561. C    INITIALISATION DU SEGMENT  XMATRI
  1562. C
  1563.          NELRIG = NBELEM
  1564.          SEGINI XMATRI
  1565.          IPMATR=XMATRI
  1566.  
  1567.          IRIGEL(1,ISOU)=IPMADG
  1568.          IRIGEL(2,ISOU)=0
  1569.          IRIGEL(3,ISOU)=IPDSCR
  1570.          IRIGEL(4,ISOU)=IPMATR
  1571.          IRIGEL(5,ISOU)=NIFOUR
  1572.          IRIGEL(6,ISOU)=0
  1573.          IRIGEL(7,ISOU)=0
  1574.          xmatri.symre=0
  1575.          IF(MFR.EQ.57.OR.MFR.EQ.59) THEN
  1576.            IRIGEL(7,ISOU)=2
  1577.          ENDIF
  1578.          COERIG(ISOU)=1.D0
  1579. C         SEGDES XMATRI
  1580.        endif
  1581. C
  1582. C rendement anisotrope kich
  1583.          if(ivacar.ne.0) then
  1584.          mptval = ivacar
  1585.          if(ival(/1).ge.NCAR1+9) then
  1586.          if (ival(NCAR1+7).gt.0.or.ival(NCAR1+8).gt.0.or.
  1587.      & ival(NCAR1+9).gt.0) then
  1588.             irigel(7,isou)=2
  1589.             xmatri.symre=2
  1590.          endif
  1591.          endif
  1592.          endif
  1593.  
  1594.          if (dcmate) goto 29
  1595. C
  1596. C-----------------------------------------------------------------------
  1597. C                        P H A S E   3
  1598. C
  1599. C              CALCUL DES RIGIDITES ELEMENTAIRES
  1600. C
  1601. C-----------------------------------------------------------------------
  1602. C
  1603. C     NUMERO DES ETIQUETTES      :
  1604. C     Les elements sont groupes comme suit :
  1605. C      - massif,liquide 'surface libre' poreux ----------------------> r
  1606. C      - coq3,dkt,coq4,coq8,coq2,dst --------------------------------> r
  1607. C      - poutre,tuyau,linespring,tuyau fissure,barre,homogeneise,jot3> r
  1608. C      - joi4,joi2,poutre de timoschenko,joi3
  1609. C
  1610.       IF(MELE.GE.1.AND.MELE.LE.100) THEN
  1611. C            CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8
  1612.       GOTO (   99,  99,  99,   4,  99,   4,  99,   4,  99,   4
  1613. C            QUA9 RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6
  1614.      .      ,  99,  12,  99,   4,   4,   4,   4,  12,  12,  99
  1615. C            LIA8 MULT TET4 TE10 PYR5 PY13 COQ3  DKT POUT LISP
  1616.      .      ,  99,  99,   4,   4,   4,   4,  27,  27,  29,  29
  1617. C            FAC3 FAC4 FAC6 FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5
  1618.      .      ,  99,  99,  99,  99,   4,   4,   4,   4,   4,   4
  1619. C            COQ8 TUYA TUFI COQ2 POI1 BARR RACO LSU2 COQ4 LISM
  1620.      .      ,  27,  29,  29,  27,  29,  29,  12,   4,  27,  29
  1621. C            COF3 RES2 LSU3 LSU4 LICO COQ6 CVS2 CVS3 CVT3 CVT6
  1622.      .      ,  99,  99,   4,   4,  12,  27,  99,  99,  99,  99
  1623. C            CVQ4 CVQ8 THP5 TH13 THP6 TH15 THC8 TH20 ICT3 ICQ4
  1624.      .      ,  99,  99,  99,  99,  99,  99,  99,  99,   4,   4
  1625. C            ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10 IC15 TRIP QUAP
  1626.      .      ,   4,   4,   4,   4,   4,   4,   4,   4,   4,   4
  1627. C            CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4 JOI6 JOI8
  1628.      .      ,   4,   4,   4,  29,  29,  29,  29,  29,  99,  99
  1629. C            LISC TRIH  DST LIC4 CERC TUYO LSE2 LITU HYT3 HYQ4
  1630.      .      ,  99,  29,  27,  12,  29,  29,  29,  29,  99,  99)
  1631. c cccccc
  1632.      .      ,MELE
  1633.       ELSEIF(MELE.GE.101.AND.MELE.LE.200) THEN
  1634. C           HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8
  1635.       GOTO (   99,  99,  99,  99,  99,  99,  99,   4,   4,   4
  1636. C            POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12
  1637.      .      ,   4,   4,   4,   4,   4,   4,   4,   4,   4,   4
  1638. C            PO13 PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3
  1639.      .      ,   4,   4,  29,  29,  29,  29,  29,  99,  99,  99
  1640. C            QUF4 CUF8 PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18
  1641.      .      ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  1642. C            MT10 MP14 SEF3 TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6
  1643.      .      ,  99,  99,  99, 505, 505,  99,  99,  99,  99,  99
  1644. C            TR21 QU36 C216 P126 TE56 PY91 TRH6 BSE2 BTR4 BQU5
  1645.      .      ,  99,  99,  99,  99,  99,  99,  29,  51,  51,  51
  1646. C            BCU9 BPR7 BTE5 BPY6 FRO4 SEGS POJS JCT3 JCI4 JGI2
  1647.      .      ,  51,  51,  51,  51,  51,  51,  51,  29,  29,  29
  1648. C            JGT3 JGI4 TRIQ QUAQ CUBQ TETQ PRIQ TRIR QUAR CUBR
  1649.      .      ,  29,  29,   4,   4,   4,   4,   4,   4,   4,   4
  1650. C            TETR PRIR Q4RI Q8RI JOQ3 JOQ6 JOQ8 JOR3 JOR6 JOR8
  1651.      .      ,   4,   4,   4,   4,   4,   4,   4,   4,   4,   4
  1652. C            T1D2 T1D3 M1D2 M1D3 LC03 LC07 LC09 LC27 LC21 LC15
  1653.      .      ,  51,  51,   4,   4,  51,  51,  51,  51,  51,  51)
  1654. c cccccc
  1655.      .      ,MELE-100
  1656.       ELSEIF(MELE.GE.201.AND.MELE.LE.300) THEN
  1657. C            LC19 LS03 LS07 LS09 LS27 LS21 LS15 LS19 BS03 BS07
  1658.       GOTO (   51,  51,  51,  51,  51,  51,  51,  51,  51,  51
  1659. C            BS09 BS27 BS21 BS15 BS19 MC03 MC07 MC09 MC27 MC21
  1660.      .      ,  51,  51,  51,  51,  51,  51,  51,  51,  51,  51
  1661. C            MC15 MC19 M103 M107 M109 M127 M121 M115 M119 MS03
  1662.      .      ,  51,  51,  51,  51,  51,  51,  51,  51,  51,  51
  1663. C            MS07 MS09 MS27 MS21 MS15 MS19 QC03 QC07 QC09 QC27
  1664.      .      ,  51,  51,  51,  51,  51,  51,  51,  51,  51,  51
  1665. C            QC21 QC15 QC19 Q103 Q107 Q109 Q127 Q121 Q115 Q119
  1666.      .      ,  51,  51,  51,  51,  51,  51,  51,  51,  51,  51
  1667. C            QS03 QS07 QS09 QS27 QS21 QS15 QS19 CIFL SURE SHB8
  1668.      .      ,  51,  51,  51,  51,  51,  51,  51,  29,  51,  29
  1669. C            CAF2 CAF3 XQ4R XC8R JOI1 ZCO2 ZCO3 ZCO4 TUY2 TUY3
  1670.      .      ,  51,  51,  63,  63,  29,  29,  29,  29,  51,  51
  1671. C            COS2 COA2           CU27 PR21 TE15 PY19 C20R P15R
  1672.      .      ,  29,  29,   4,   4,   4,   4,   4,   4,   4,   4)
  1673. c cccccc
  1674.      .      ,MELE-200
  1675.       ENDIF
  1676. C cccccc
  1677. C
  1678.  51   CONTINUE
  1679.  99   CONTINUE
  1680.       MOTERR(1:4)=NOMTP(MELE)
  1681.       MOTERR(9:12)='RIGI1'
  1682.       CALL ERREUR(86)
  1683.       GOTO 9990
  1684. C_______________________________________________________________________
  1685. C
  1686. C     massif, liquide, 'surface libre', poreux
  1687. C_______________________________________________________________________
  1688. C
  1689.    4  CONTINUE
  1690.       IF (MFR .EQ. 71) THEN
  1691.         CALL RIGELE (MATE,MELE,NBPGAU,NSTRS,LRE,IPMAIL,IPMINT,IVAMAT,
  1692.      &               NMATT, IPMATR)
  1693.       ELSE IF (MFR .EQ. 73) THEN
  1694.         CALL RIGDIF (MATE,MELE,NBPGAU,NSTRS,LRE,IPMAIL,IPMINT,IVAMAT,
  1695.      &               NMATT, IPMATR)
  1696.       ELSE
  1697.         CALL RIGI2 (MATE,MELE,IPMAIL,IPMINT,NBPGAU,LRE,NSTRS,IVAMAT,
  1698.      &              IVACAR,CMATE,MFR,NBGMAT,NELMAT,IMAT,LHOOK,NMATT,
  1699.      &              IPORE,NDDL,IPMATR,IIPDPG,NCAR1,MELPHA,noer)
  1700.       ENDIF
  1701.       GOTO 9990
  1702. C_______________________________________________________________________
  1703. C
  1704. C     ELTS DE RACCORD LIQUIDE SOLIDE  RAC2 RACO LIA3 LIA4 LICO LIC4
  1705. C          PAS DE RIGIDITE
  1706. C_______________________________________________________________________
  1707. C
  1708.   12  CONTINUE
  1709. C
  1710.       GOTO 9990
  1711. C_______________________________________________________________________
  1712. C
  1713. C     coq2,coq3,coq4,coq6,coq8,dst,dkt
  1714. C_______________________________________________________________________
  1715. C
  1716.   27  CONTINUE
  1717.       CALL RIGI3(MATE,MELE,IPMAIL,IPMINT,IPMIN1,NBPGAU,LRE,NSTRS,
  1718.      &          IVAMAT,IVACAR,CMATE,MFR,NBGMAT,NELMAT,IMAT,LHOOK,
  1719.      &           NMATT,LW,NPINT,IPMATR,IIPDPG)
  1720.       GOTO 9990
  1721. C_______________________________________________________________________
  1722. C
  1723. C poutre,tuyau,linespring,tuyau fissure,barre,homogeneise,joints 2-3D
  1724. C poutre de Timoschenko,point,joi1,zco2,zco3,zco4
  1725. C_______________________________________________________________________
  1726. C
  1727.   29  CONTINUE
  1728.       CALL RIGI4(MATE,MELE,IPMAIL,IPMINT,NBPGAU,LRE,NSTRS,
  1729.      &       IVAMAT,IVACAR,IVECT,CMATE,MFR,NBGMAT,NELMAT,IMAT,
  1730.      &       LHOOK,NMATT,(NCAR1 - 1),ISOUS,LW,IPORE,IPMATR,IIPDPG)
  1731.       GOTO 9990
  1732. C
  1733. C_______________________________________________________________________
  1734. C
  1735. C     Elements de type XFEM (MFR=63)
  1736. C_______________________________________________________________________
  1737. C Le sous programme RIGIXR gere les appels aux elements de type XFEM
  1738. C (imoxfem est le modele complet ou partitionne si necessaire)
  1739. C as 2009/11/30 : ajout de IMAT,NBGMAT,NELMAT en entree de RIGIXR
  1740. C Attention : ISOU peut etre modifie suite a appel a RIGIXR, ainsi que
  1741. C             la dimension de MRIGID en parallele !
  1742. C
  1743.  63   CONTINUE
  1744.       CALL RIGIXR (ISOU ,IPOI6,imoxfem,IPINF,
  1745.      $       IVAMAT,IVACAR,NMATT,CMATE,NCAR1,NBGMAT,NELMAT,IMAT,IRETER)
  1746.       IF (IRETER.NE.0) RETURN
  1747.       GO TO 9991
  1748.  
  1749. C=DEB==== FORMULATION HHO ==== Calcul des matrices de RIGIDITE =========
  1750.  89   CONTINUE
  1751.       CALL HHORIG (imohho, IPOI6, ISOU,
  1752.      $       MATE,IVAMAT,NMATR, IVACAR,NCAR1, iret)
  1753.       IF (iret.NE.0) THEN
  1754.         CALL ERREUR(iret)
  1755.         RETURN
  1756.       END IF
  1757.       GOTO 9991
  1758. C=FIN==== FORMULATION HHO ==============================================
  1759. C
  1760. C-----------------------------------------------------------------------
  1761. C                        P H A S E   4
  1762. C
  1763. C     DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
  1764. C
  1765. C-----------------------------------------------------------------------
  1766. C
  1767.  9990 CONTINUE
  1768.       if (noer.eq.195) return
  1769.       if (ierr.ne.0) return
  1770. C
  1771. C     Forcer la symetrie lorsque les matrices sont symetriques
  1772.       ID1=RE(/1)
  1773.       ID2=RE(/2)
  1774.       ID3=RE(/3)
  1775.       ISY=SYMRE
  1776.       CALL VERSYM(RE,ID1,ID2,ID3,ISY)
  1777. C
  1778.       SEGDES XMATRI
  1779.  
  1780.  9991 CONTINUE
  1781.       IF (IERR.NE.0) GOTO 518
  1782.  505    CONTINUE
  1783. C
  1784.  518  CONTINUE
  1785.        IF(ISUP.EQ.1)THEN
  1786.          CALL DTMVAL(IVACAR,3)
  1787.        ELSE
  1788.          CALL DTMVAL(IVACAR,1)
  1789.        ENDIF
  1790. C
  1791.        if (cmate.eq.'MODAL'.or.cmate.eq.'STATIQUE') goto 519
  1792.        IF(ISUP.EQ.1.AND.IMAT.NE.2)THEN
  1793.          CALL DTMVAL(IVAMAT,3)
  1794.        ELSE
  1795.          CALL DTMVAL(IVAMAT,1)
  1796.        ENDIF
  1797.  519   continue
  1798.  
  1799.         IF (MOCARA.NE.0) THEN
  1800.           nomid=MOCARA
  1801.           SEGSUP,nomid
  1802.         ENDIF
  1803.         notype = MOTYCA
  1804.         IF (notype .NE. MOTYR8) SEGSUP,notype
  1805. C
  1806.         IF (MOMATR.NE.0)THEN
  1807.           nomid = MOMATR
  1808.           IF (lsupma) SEGSUP,nomid
  1809.         ENDIF
  1810.         notype = MOTYMA
  1811.         IF (notype .NE. MOTYR8) SEGSUP,notype
  1812. C
  1813. C     DANS LE CAS D'ERREUR
  1814. C
  1815.         IF (IERR.NE.0) THEN
  1816.           IF (DESCR.NE.0)  SEGSUP DESCR
  1817.           IF (xMATRI.NE.0) SEGSUP xMATRI
  1818.           GOTO 888
  1819.         ENDIF
  1820.  
  1821.   500 CONTINUE
  1822.  
  1823.       if (isou.NE.irigel(/2)) then
  1824.         nrigel=isou
  1825.         segadj,MRIGID
  1826.       endif
  1827.  
  1828. Ctermes croises  'STATIQUE'/'MODAL'
  1829.       nstat = kstat
  1830.       nmoda = kmoda
  1831.       segadj modsta
  1832.       if (kstat.ne.0) then
  1833.        if (nstat.gt.0.and.nstat+nmoda.gt.0) call ricroi(modsta, ir2,2)
  1834.        if (nstat.gt.0) then
  1835.         do kstat=1,nstat
  1836.           mptval = ivstat(kstat)
  1837.           IF(ISUP.EQ.1)THEN
  1838.             CALL DTMVAL(mptval,3)
  1839.           ELSE
  1840.             CALL DTMVAL(mptval,1)
  1841.           ENDIF
  1842.         enddo
  1843.        endif
  1844.        if (nmoda.gt.0) then
  1845.         do kmoda=1,nmoda
  1846.           mptval = ivmoda(kmoda)
  1847.           IF(ISUP.EQ.1)THEN
  1848.             CALL DTMVAL(mptval,3)
  1849.           ELSE
  1850.             CALL DTMVAL(mptval,1)
  1851.           ENDIF
  1852.         enddo
  1853.        endif
  1854.       endif
  1855.       if (nstat.gt.0.and.nstat+nmoda.gt.1) then
  1856.         ir1 = mrigid
  1857.         call fusrig(ir1,ir2,ir3)
  1858.         if (ierr.ne.0) goto 888
  1859.         mrigid = ir3
  1860.         ipoi6 = mrigid
  1861.       endif
  1862.  
  1863.   888 CONTINUE
  1864.       MRIGID = IPOI6
  1865.       IF (IERR.NE.0) THEN
  1866.         SEGSUP,MRIGID
  1867.         IPOI6 = 0
  1868.         IRET = 0
  1869.       ELSE
  1870.         SEGDES,MRIGID
  1871.         IRET = 1
  1872.       ENDIF
  1873.       segsup modsta
  1874.       segsup mmode1
  1875.       if (mchel1.ne.0) then
  1876.         mcham1 = mchel1.ichaml(1)
  1877.         segsup mcham1
  1878.         segsup mchel1
  1879.       endif
  1880.  
  1881.       notype = MOTYR8
  1882.       SEGSUP,notype
  1883.  
  1884.  889  CONTINUE
  1885.  
  1886. c      return
  1887.       END
  1888.  
  1889.  
  1890.  
  1891.  
  1892.  
  1893.  

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