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

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