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

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