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

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