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

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