Télécharger la plaquette Cast3M


fr en

Télécharger masse1.eso

Retour à la liste

Numérotation des lignes : 

masse1

  1. C MASSE1    SOURCE    OF166741  25/02/21    21:17:55     12166          
  2.  
  3.       SUBROUTINE MASSE1 (MODORI,IPCHE1,IPMASS,IRET,ILUMP)
  4.  
  5. *_______________________________________________________________________
  6. *
  7. *             appele par masse ( opérateur masse et lump )
  8. *
  9. *  entrees :
  10. *  ========
  11. *
  12. *                  modori pointeur sur un mmodel
  13. *                  ipche1 pointeur sur un mchaml de caracteristique
  14. *                  ilump si il s'agit de l'opérateur lump
  15. *
  16. *  sorties :
  17. *  =========
  18. *
  19. *                  ipmass pointeur sur la masse construite
  20. *                  iret   1 si ok, 0 sinon
  21. *
  22. *_______________________________________________________________________
  23.  
  24.       IMPLICIT INTEGER(I-N)
  25.       IMPLICIT REAL*8(A-H,O-Z)
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC CCHAMP
  30. -INC CCGEOME
  31. -INC CCREEL
  32.  
  33. -INC SMCOORD
  34. -INC SMRIGID
  35. -INC SMCHAML
  36. -INC SMELEME
  37. -INC SMINTE
  38. -INC SMMODEL
  39.  
  40. -INC TMPTVAL
  41.  
  42.       INTEGER oooval
  43.  
  44.       SEGMENT NOTYPE
  45.         CHARACTER*16 TYPE(NBTYPE)
  46.       ENDSEGMENT
  47.  
  48.       segment modsta
  49.         integer pimoda(nmoda),pistat(nstat)
  50.         integer ivmoda(nmoda),ivstat(nstat)
  51.       endsegment
  52.  
  53.       CHARACTER*8 CMATE
  54.       CHARACTER*(NCONCH) CONM
  55.       PARAMETER (NINF=3)
  56.       INTEGER INFOS(NINF),nrnlin
  57.       LOGICAL BDPGE,dcmate,dcmat2
  58.  
  59.       NHRM=NIFOUR
  60.  
  61.       IRET = 0
  62.  
  63. C     ACTIVATION DU MODELE
  64. C
  65. *  MODORI = Modele initial complet
  66. *  IPMODL = Modele "deroule" (uniquement "MECANIQUE", "LIQUIDE" ou "POREUX")
  67.       CALL PIMODL(MODORI,IPMODL,MAILDG,0)
  68.       IF (IPMODL.EQ.0) RETURN
  69. *  IPMODL est ACTIF en retour
  70.       MMODEL = IPMODL
  71.       NSOUS  = mmodel.KMODEL(/1)
  72. C
  73. C     CREATION DE L'OBJET MATRICE DE MASSE
  74. C
  75.       NRIGEL=0
  76.       SEGINI,MRIGID
  77.       IPMASS=MRIGID
  78.       MTYMAT='MASSE'
  79.       IFORIG=IFOUR
  80.       ICHOLE=0
  81.       IMGEO1=0
  82.       IMGEO2=0
  83.       ISUPEQ=0
  84.  
  85.       mchelm = ipche1
  86.       n3 = mchelm.infche(/2)
  87.  
  88. c en cas de besoin
  89.       n1 = 1
  90.       SEGINI,mmode1
  91.       L1 = 8
  92.       SEGINI,mchel1
  93.       mchel1.ifoche = mchelm.ifoche
  94.       n2 = 2
  95.       SEGINI,mcham1
  96.       mchel1.ichaml(1) = mcham1
  97.  
  98. * termes croises STATIQUE et/ou MODAL
  99.       nstat = 100
  100.       kstat = 0
  101.       nmoda = 100
  102.       kmoda = 0
  103.       segini modsta
  104.  
  105.       nbtype = 1
  106.       SEGINI,notype
  107.       notype.type(1) = 'REAL*8'
  108.       MOTYR8 = notype
  109. C_______________________________________________________________________
  110. C
  111. C     DEBUT DE LA BOUCLE SUR LES DIFFERENTES SOUS ZONES
  112. C_______________________________________________________________________
  113. C
  114.       isouss=0
  115.  
  116.       DO 500 ISOUS=1,NSOUS
  117.  
  118. C     ON RECUPERE LINFORMATION GENERALES
  119. C
  120.         IMODEL = mmodel.KMODEL(ISOUS)
  121.  
  122.         IPMAIL = imodel.IMAMOD
  123.         CONM   = imodel.CONMOD
  124. C
  125. C     TRAITEMENT DU MODELE
  126. C
  127.         MELE = imodel.NEFMOD
  128. *  Cas particulier des relations de conformites : pas de masse
  129.         IF (MELE.EQ.22) GOTO 500
  130.         IF (MELE.EQ.259) GOTO 500
  131.  
  132. C     NATURE DU MATERIAU
  133. C
  134.         CMATE = CMATEE
  135.         MATE = IMATEE
  136.         INAT = INATUU
  137.  
  138.         dcmate = .false.
  139.         dcmat2 = .false.
  140.         DO im = 1,matmod(/2)
  141.           if (matmod(im).eq.'IMPEDANCE') then
  142.             dcmate =.true.
  143.             if (tymode(/2).gt.0)then
  144. * detecte impedance seg2 hybride ddl
  145.               if(tymode(1).eq.'LISTMOTS') dcmat2 = .true.
  146.             endif
  147.           endif
  148.         ENDDO
  149. C
  150. C     CREATION DU TABLEAU INFOS
  151. C
  152.         irtd=1
  153.         CALL IDENT(IPMAIL,CONM,IPCHE1,0,INFOS,irtd)
  154.         IF (irtd.EQ.0) GOTO 9996
  155.  
  156. C_______________________________________________________________________
  157. C
  158. C     INFORMATION SUR L ELEMENT FINI
  159. C_______________________________________________________________________
  160. C
  161.         IPT1   = IPMAIL
  162.         NBNOE1 = IPT1.NUM(/1)
  163.         NBELE1 = IPT1.NUM(/2)
  164.  
  165.         mele = nefmod
  166. C Cas particulier : POI1/SEG2 et IMPEDANCE
  167.         IF (dcmate) THEN
  168.           if (ipt1.itypel.eq.1) mele = 45
  169.           if (ipt1.itypel.eq.2) mele = 2
  170.         ENDIF
  171.  
  172.         npint = MAX(infmod(1),1)
  173.  
  174.         isupo=4
  175.         if (npint.eq.12345) isupo=1
  176. * integration aux noeuds
  177.  
  178.         if (infmod(/1).lt.2+isupo) then
  179.           write(ioimp,*) 'MASSE1 : INFMOD(/1) <',2+isupo
  180.           call erreur(5)
  181.         endif
  182.         IPMINT = INFMOD(2+isupo)
  183.         IPMIN1 = INFELE(12)
  184.         MFR    = INFELE(13)
  185.         LRE    = INFELE(9)
  186.         LW     = INFELE(7)
  187.         LHOOK  = INFELE(10)
  188.         NDDL   = INFELE(15)
  189.         IELE   = INFELE(14)
  190.         ICARA  = INFELE(5)
  191.  
  192.         NLIGRP = INFELE(9)
  193.         NLIGRD = INFELE(9)
  194.  
  195.         MINTE1 = IPMIN1
  196. *          write(6,*) 'poigau',(poigau(iou),iou=1,poigau(/1))
  197. *          write(6,*) ((shptot(ir,it,1),ir=1,shptot(/1)),it=1,shptot(/2))
  198.         MINTE = IPMINT
  199.         if(mele.ne.260) then
  200.           NBPGAU = minte.POIGAU(/1)
  201.         else
  202.           NBPGAU=5
  203.         endif
  204.  
  205.         IPPORE=0
  206.         IF (MFR.EQ.33) IPPORE = NBNOE1
  207.  
  208. C- Cas particulier en DEFO PLAN GENE
  209.         IIPDPG = imodel.IPDPGE
  210.         IIPDPG = IPTPOI(IIPDPG)
  211.  
  212.         CALL INFDPG(MFR,IFOUR, BDPGE,NDPGE)
  213.         NDDLGE = NDPGE
  214.         IF (BDPGE) THEN
  215.           IF (IIPDPG.LE.0) THEN
  216.             CALL ERREUR(925)
  217.             GOTO 9995
  218.           ENDIF
  219.           if (maildg.eq.0) then
  220.             CALL ERREUR(925)
  221.             CALL ERREUR(5)
  222.           ENDIF
  223.           ipt2 = MAILDG
  224.           IPMAIG = ipt2.lisous(isous)
  225.           meleme = IPMAIG
  226.           NBNOEG = meleme.num(/1)
  227.           NBELEG = meleme.num(/2)
  228. C* Cas particulier (pourquoi ?)
  229.           IF (IFOUR.EQ.-3) NDDLGE = 1
  230.         ELSE
  231.           IPMAIG = IPMAIL
  232.         ENDIF
  233.  
  234. C ---------------------------------------------------------*
  235. C INITIALISATION DU SEGMENT DESCR, SEGMENT DESCRIPTEUR DES *
  236. C DES INCONNUES RELATIVES A LA MATRICE DE RIGIDITE         *
  237. C ---------------------------------------------------------*
  238.         MODEPL = imodel.lnomid(1)
  239.         IF (MODEPL.EQ.0) THEN
  240.           write(ioimp,*) 'MASSE1 : MODEPL = lnomid(1) non defini'
  241.           write(ioimp,*) '        ',IMODEL,FORMOD(1),MFR
  242.           call erreur(5)
  243.         ENDIF
  244.         nomid = MODEPL
  245.         NDEPL = nomid.lesobl(/2)
  246. c*        ndum  = nomid.lesfac(/2)
  247.  
  248.         MOFORC = imodel.lnomid(2)
  249.         if (MOFORC.eq.0) then
  250.           write(ioimp,*) 'MASSE1 : MODEPL = lnomid(2) non defini'
  251.           write(ioimp,*) '        ',IMODEL,FORMOD(1),MFR
  252.           call erreur(5)
  253.         endif
  254.         nomid = MOFORC
  255.         NFORC = nomid.lesobl(/2)
  256. c*        ndum  = nomid.lesfac(/2)
  257.  
  258.         IF (NDEPL.EQ.0 .OR. NFORC.EQ.0 .OR. NDEPL.NE.NFORC) THEN
  259.           moterr = 'pas d inconnue duale ou primale '
  260.           call erreur(-385)
  261.           interr(1) = imodel
  262.           moterr(1:16) = conmod
  263.           moterr(17:24) = '        '
  264.           call erreur(-386)
  265.           call erreur(5)
  266.           return
  267.         ENDIF
  268.  
  269. C        REMPLISSAGE DU SEGMENT DESCRIPTEUR
  270. C
  271.         SEGINI,DESCR
  272.  
  273.         NCOMP = NDEPL
  274.         NBNN  = NBNOE1
  275.         NBNNS = NBNOE1
  276.         IF (MFR.EQ.33) NCOMP = NDEPL-1
  277.         IF (BDPGE) THEN
  278.           NCOMP = NDEPL-NDPGE
  279.           NBNN  = NBNOE1 + 1
  280.         ENDIF
  281.         IF (MFR.EQ.19.OR.MFR.EQ.21) NBNNS=NBNN/2
  282.  
  283.         IDDL=1
  284.         DO INOEUD=1,NBNNS
  285.           DO ICOMP=1,NCOMP
  286.             NOMID=MODEPL
  287.             LISINC(IDDL)=LESOBL(ICOMP)
  288.             if (dcmat2) then
  289.               if (inoeud.eq.2) then
  290.                 LISINC(IDDL)=LESFAC(ICOMP)
  291.               endif
  292.             endif
  293.             NOMID=MOFORC
  294.             LISDUA(IDDL)=LESOBL(ICOMP)
  295.             if (dcmat2) then
  296.               if (inoeud.eq.2) then
  297.                 LISDUA(IDDL)=LESFAC(ICOMP)
  298.               endif
  299.             endif
  300.             NOELEP(IDDL)=INOEUD
  301.             NOELED(IDDL)=INOEUD
  302.             IDDL=IDDL+1
  303.           ENDDO
  304.         ENDDO
  305.  
  306. *   cas de la deformation plane generalisee
  307.         IF (BDPGE) THEN
  308.           DO ICOMP=(NDPGE-1),0,-1
  309.             NOMID=MODEPL
  310.             LISINC(IDDL)=LESOBL(NDEPL-ICOMP)
  311.             NOMID=MOFORC
  312.             LISDUA(IDDL)=LESOBL(NFORC-ICOMP)
  313.             NOELEP(IDDL)=NBNN
  314.             NOELED(IDDL)=NBNN
  315.             IDDL=IDDL+1
  316.           ENDDO
  317.         ENDIF
  318. C
  319. C        CAS DES MILIEUX POREUX
  320. C
  321.         IF (MFR.EQ.33) THEN
  322.           DO INOEUD=1,NBSOM(IELE)
  323.             NOMID=MODEPL
  324.             LISINC(IDDL)=LESOBL(NDEPL)
  325.             NOMID=MOFORC
  326.             LISDUA(IDDL)=LESOBL(NDEPL)
  327.             NOELEP(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1)
  328.             NOELED(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1)
  329.             IDDL=IDDL+1
  330.           ENDDO
  331.         ENDIF
  332. *
  333. *          cas des element raccord
  334. *
  335.         IF (MFR.EQ.19.OR.MFR.EQ.21) THEN
  336.           CALL IDPRIM(IMODEL,MFR+1000,MODPL,NDEPL,ndum)
  337.           CALL IDDUAL(IMODEL,MFR+1000,MOFRC,NFORC,ndum)
  338.           DO INOEUD=NBNNS+1,NBNN
  339.             DO ICOMP=1,NDEPL
  340.               NOMID=MODPL
  341.               LISINC(IDDL)=LESOBL(ICOMP)
  342.               NOMID=MOFRC
  343.               LISDUA(IDDL)=LESOBL(ICOMP)
  344.               NOELEP(IDDL)=INOEUD
  345.               NOELED(IDDL)=INOEUD
  346.               IDDL=IDDL+1
  347.             ENDDO
  348.           ENDDO
  349.           NOMID=MODPL
  350.           SEGSUP,NOMID
  351.           NOMID=MOFRC
  352.           SEGSUP,NOMID
  353.         ENDIF
  354.  
  355.         SEGDES DESCR
  356.         IPDSCR=DESCR
  357.  
  358. C_______________________________________________________________________
  359. C
  360. C     TRAITEMENT DES CHAMP MATERIAUX
  361. C_______________________________________________________________________
  362. C
  363.         NBROBL=0
  364.         NBRFAC=0
  365.         LHOTRA=0
  366.         NOMID  = 0
  367.         NOTYPE = MOTYR8
  368. *
  369. * JOINT UNIDIMENSIONNEL JOI1
  370. *
  371.         IF (MFR.EQ.75) THEN
  372.           IF (IDIM.EQ.3) THEN
  373.             NBROBL=10
  374.             SEGINI NOMID
  375.             LESOBL(1)='V1X'
  376.             LESOBL(2)='V1Y'
  377.             LESOBL(3)='V1Z'
  378.             LESOBL(4)='V2X'
  379.             LESOBL(5)='V2Y'
  380.             LESOBL(6)='V2Z'
  381.             LESOBL(7)='MASS'
  382.             LESOBL(8)='JX'
  383.             LESOBL(9)='JY'
  384.             LESOBL(10)='JZ'
  385.           ELSE IF (IDIM.EQ.2) THEN
  386.             NBROBL=4
  387.             SEGINI NOMID
  388.             LESOBL(1)='V1X'
  389.             LESOBL(2)='V1Y'
  390.             LESOBL(3)='MASS'
  391.             LESOBL(4)='JZ'
  392.           ENDIF
  393. *
  394. * rho dans les cas,massif,coq3,poutre,tuyau,coq8,coq2,barre,jot3,joi4,joi2,xfem
  395. *
  396.         ELSE IF (MFR.EQ.1.OR.MFR.EQ.7.OR.MFR.EQ.13.OR.MFR.EQ.3.
  397.      1    OR.MFR.EQ.27.OR.MFR.EQ.9.OR.MFR.EQ.35.OR.MFR.EQ.31.
  398.      2    OR.MFR.EQ.49.OR.MFR.EQ.53.OR.MFR.EQ.63.OR.MFR.EQ.5) THEN
  399. *
  400.           IF (CMATE.NE.'SECTION') THEN
  401.             NBROBL=1
  402.             SEGINI NOMID
  403.             LESOBL(1)='RHO '
  404.           ELSE
  405.             LHOTRA=LHOOK
  406.             NBROBL=2
  407.             SEGINI NOMID
  408.             LESOBL(1)='MODS'
  409.             LESOBL(2)='MATS'
  410.             NBTYPE=2
  411.             SEGINI NOTYPE
  412.             TYPE(1)='POINTEURMMODEL'
  413.             TYPE(2)='POINTEURMCHAML'
  414.           ENDIF
  415. *
  416. * rhoref rlcar dans le cas des elements de raccord et surface libre
  417. *
  418.         ELSE IF (MFR.EQ.19.OR.MFR.EQ.21.OR.MFR.EQ.23) THEN
  419.           NBROBL=2
  420.           SEGINI NOMID
  421.           LESOBL(1)='RORF'
  422.           LESOBL(2)='LCAR'
  423. *
  424. * caracteristiques pour les elements liquides
  425. *
  426.         ELSE IF (MFR.EQ.11) THEN
  427.           NBROBL=5
  428.           SEGINI NOMID
  429.           LESOBL(1)='RHO '
  430.           LESOBL(2)='CSON'
  431.           LESOBL(3)='RORF'
  432.           LESOBL(4)='CREF'
  433.           LESOBL(5)='LCAR'
  434. *
  435. * caracteristiques pour les elements homogeneises
  436. *
  437.         ELSE IF (MFR.EQ.37) THEN
  438.           IF (MELE.EQ.157) THEN
  439.             NBROBL=15
  440.             SEGINI NOMID
  441.             LESOBL( 1)='B11 '
  442.             LESOBL( 2)='B22 '
  443.             LESOBL( 3)='B12 '
  444.             LESOBL( 4)='ROF '
  445.             LESOBL( 5)='ROS '
  446.             LESOBL( 6)='CSON'
  447.             LESOBL( 7)='RORF'
  448.             LESOBL( 8)='CREF'
  449.             LESOBL( 9)='LCAR'
  450.             LESOBL(10)='E111'
  451.             LESOBL(11)='E112'
  452.             LESOBL(12)='E121'
  453.             LESOBL(13)='E122'
  454.             LESOBL(14)='E221'
  455.             LESOBL(15)='E222'
  456.           ELSE
  457.             NBROBL=9
  458.             SEGINI NOMID
  459.             LESOBL(1)='B11 '
  460.             LESOBL(2)='B22 '
  461.             LESOBL(3)='B12 '
  462.             LESOBL(4)='ROF '
  463.             LESOBL(5)='ROS '
  464.             LESOBL(6)='CSON'
  465.             LESOBL(7)='RORF'
  466.             LESOBL(8)='CREF'
  467.             LESOBL(9)='LCAR'
  468.           ENDIF
  469. *
  470. * caracteristiques pour l'element acoustique pure
  471. *
  472.         ELSE IF (MFR.EQ.41) THEN
  473.           NBROBL=5
  474.           SEGINI NOMID
  475.           LESOBL(1)='RHO '
  476.           LESOBL(2)='CSON'
  477.           LESOBL(3)='RORF'
  478.           LESOBL(4)='CREF'
  479.           LESOBL(5)='LCAR'
  480. *
  481. * caracteristiques pour l'element raccord liquide tuyau
  482. *
  483.         ELSE IF (MFR.EQ.43) THEN
  484.           NBROBL=3
  485.           SEGINI NOMID
  486.           LESOBL(1)='RHO '
  487.           LESOBL(3)='RORF'
  488.           LESOBL(2)='LCAR'
  489. *
  490. * caracteristiques pour les joints generalises
  491. *
  492.         ELSE IF (MFR.EQ.55) THEN
  493.           NBROBL=1
  494.           NBRFAC=1
  495.           SEGINI NOMID
  496.           LESOBL(1)='RHO '
  497.           LESFAC(1)='EPAI'
  498. *
  499. * poi1 -- MODAL
  500. *
  501.         ELSE IF (CMATE.EQ.'MODAL') THEN
  502.           NBROBL=3
  503.           SEGINI NOMID
  504.           LESOBL(1)='FREQ'
  505.           LESOBL(2)='MASS'
  506.           LESOBL(3)='DEFO'
  507.  
  508.           NBTYPE=3
  509.           SEGINI NOTYPE
  510.           TYPE(1)='REAL*8'
  511.           TYPE(2)='REAL*8'
  512.           TYPE(3)='POINTEURCHPOINT'
  513. *
  514. * poi1 -- STATIQUE
  515.         ELSE IF (CMATE.EQ.'STATIQUE') THEN
  516.           NBROBL=3
  517.           SEGINI NOMID
  518.           LESOBL(1)='DEFO'
  519.           LESOBL(2)='RIDE'
  520.           LESOBL(3)='MADE'
  521.  
  522.           NBTYPE=1
  523.           SEGINI NOTYPE
  524.           TYPE(1)='POINTEURCHPOINT'
  525.         ELSE IF (CMATE.EQ.'NLIN') THEN
  526.           NBROBL=1
  527.           SEGINI NOMID
  528.           LESOBL(1)='FREQ'
  529.         ENDIF
  530.         DO imat = 1 , matmod(/2)
  531.           IF (matmod(imat).eq.'IMPEDANCE') THEN
  532.             NBROBL=0
  533.             NBRFAC=2
  534.             SEGINI NOMID
  535.             LESFAC(1)='MASS'
  536.             LESFAC(2)='INER'
  537.             NOTYPE = MOTYR8
  538.           ENDIF
  539.         ENDDO
  540.  
  541.         NMATR=NBROBL
  542.         NMATF=NBRFAC
  543.         NMATT=NMATR+NMATF
  544.  
  545.         MOMATR = NOMID
  546.         MOTYMA = NOTYPE
  547. C____________________________________________________________________
  548. C
  549. C TRAITEMENT DES CHAMPS DE CARACTERISTIQUES
  550. C____________________________________________________________________
  551.  
  552.         NBROBL=0
  553.         NBRFAC=0
  554.         NOMID  = 0
  555. C* Sauf cas particuier, composantes de type REAL*8
  556.         NOTYPE = MOTYR8
  557. *
  558. * epaisseur dans le cas massif en contraintes planes
  559. *
  560.         IF ((MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.63.OR.MELE.EQ.35.OR.
  561.      &       MELE.EQ.36.OR.MELE.EQ.63).AND.IFOUR.EQ.-2)THEN
  562.           NBRFAC=1
  563.           SEGINI NOMID
  564.           LESFAC(1)='DIM3'
  565. *
  566. * epaisseur et excentrement dans le cas des coques
  567. *
  568.         ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  569.           NBROBL=1
  570.           IF (MFR.EQ.3.AND.IFOUR.EQ.-2) THEN
  571.             NBRFAC=2
  572.           ELSE
  573.             NBRFAC=1
  574.           ENDIF
  575.           SEGINI NOMID
  576.           LESOBL(1)='EPAI'
  577.           LESFAC(1)='EXCE'
  578.           IF (MFR.EQ.3.AND.IFOUR.EQ.-2) LESFAC(2)='DIM3'
  579. *
  580. * section pour les barres et les cerces
  581. *
  582.         ELSE IF (MFR.EQ.27) THEN
  583.           IF (.NOT.dcmate)  THEN
  584.             NBROBL=1
  585.             SEGINI NOMID
  586.             LESOBL(1)='SECT'
  587.           ENDIF
  588. *
  589. * section, excentrements et orientation pour les barres excentrees
  590. *
  591.         ELSE IF (MFR.EQ.49) THEN
  592.           NBROBL=6
  593.           SEGINI NOMID
  594.           LESOBL(1)='SECT'
  595.           LESOBL(2)='EXCZ'
  596.           LESOBL(3)='EXCY'
  597.           LESOBL(4)='VX  '
  598.           LESOBL(5)='VY  '
  599.           LESOBL(6)='VZ  '
  600. *
  601. * caracteristiques pour les poutres
  602. *
  603.         ELSE IF (MFR.EQ.7 ) THEN
  604.           if (dcmate) then
  605.             NBRFAC=3
  606.             SEGINI NOMID
  607.             LESFAC(1)='VX'
  608.             LESFAC(2)='VY'
  609.             LESFAC(3)='VZ'
  610.           else
  611.             IF (CMATE.EQ.'SECTION') THEN
  612.               NBRFAC=3
  613.               SEGINI NOMID
  614.               LESFAC(1)='VX'
  615.               LESFAC(2)='VY'
  616.               LESFAC(3)='VZ'
  617. * CAS 2D
  618.             ELSE IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  619.               NBRFAC=1
  620.               NBROBL=2
  621.               SEGINI NOMID
  622.               LESOBL(1)= 'SECT'
  623.               LESOBL(2)= 'INRZ'
  624.               LESFAC(1)= 'SECY'
  625.             ELSE
  626.               NBROBL=4
  627.               NBRFAC=5
  628.               SEGINI NOMID
  629.               LESOBL(1)='TORS'
  630.               LESOBL(2)='INRY'
  631.               LESOBL(3)='INRZ'
  632.               LESOBL(4)='SECT'
  633.               LESFAC(1)='SECY'
  634.               LESFAC(2)='SECZ'
  635.               LESFAC(3)='VX'
  636.               LESFAC(4)='VY'
  637.               LESFAC(5)='VZ'
  638.             ENDIF
  639.           endif
  640. *
  641. * caracteristiques pour les tuyaux
  642. *
  643.         ELSE IF (MFR.EQ.13) THEN
  644.           NBROBL=2
  645.           NBRFAC=5
  646.           SEGINI NOMID
  647.           LESOBL(1)='EPAI'
  648.           LESOBL(2)='RAYO'
  649.           LESFAC(1)='RACO'
  650.           LESFAC(2)='CISA'
  651.           LESFAC(3)='VX'
  652.           LESFAC(4)='VY'
  653.           LESFAC(5)='VZ'
  654. *
  655. * caracteristique pour les elements de raccord
  656. *
  657.         ELSE IF (MFR.EQ.19.OR.MFR.EQ.21) THEN
  658.           IF (IDIM.EQ.2)THEN
  659.             NBROBL=2
  660.             SEGINI NOMID
  661.             LESOBL(1)='VX  '
  662.             LESOBL(2)='VY  '
  663.           ELSEIF(IDIM.EQ.3)THEN
  664.             NBROBL=3
  665.             SEGINI NOMID
  666.             LESOBL(1)='VX  '
  667.             LESOBL(2)='VY  '
  668.             LESOBL(3)='VZ  '
  669.           ENDIF
  670. *
  671. * caracteristiques des elements homogeneises
  672. *
  673.         ELSE IF (MFR.EQ.37) THEN
  674.           IF (IFOUR.EQ.1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.2) THEN
  675.             NBROBL=5
  676.             SEGINI NOMID
  677.             LESOBL(1)='SCEL'
  678.             LESOBL(2)='SFLU'
  679.             LESOBL(3)='EPS '
  680.             LESOBL(4)='SECT'
  681.             LESOBL(5)='INRZ '
  682.           ELSE
  683.             NBROBL=5
  684.             SEGINI NOMID
  685.             LESOBL(1)='SCEL'
  686.             LESOBL(2)='SFLU'
  687.             LESOBL(3)='EPS '
  688.             LESOBL(4)='NOF1'
  689.             LESOBL(5)='NOF2'
  690.           ENDIF
  691. *
  692. * caracteristiques de l'element tuyau acoustique
  693. *
  694.         ELSE IF (MFR.EQ.41) THEN
  695.           NBROBL=1
  696.           NBRFAC=1
  697.           SEGINI NOMID
  698.           LESOBL(1)='RAYO'
  699.           LESFAC(1)='RACO'
  700. *
  701. * caracteristiques de l'element de raccord liquide tuyau
  702. *
  703.         ELSE IF (MFR.EQ.43) THEN
  704.           NBROBL=1
  705.           NBRFAC=4
  706.           SEGINI NOMID
  707.           LESOBL(1)='RAYO'
  708.           LESFAC(1)='RACO'
  709.           LESFAC(2)='VX'
  710.           LESFAC(3)='VY'
  711.           LESFAC(4)='VZ'
  712.         ENDIF
  713.  
  714.         NCARA = NBROBL
  715.         NCARF = NBRFAC
  716.         NCARR = NCARA+NCARF
  717.         MOCARA = NOMID
  718.         MOTYCA = NOTYPE
  719.  
  720. *  Preparation du PARTITIONNEMENT du segment xMATRI
  721.         LTRK=OOOVAL(1,4)
  722.         IF (LTRK.EQ.0) LTRK=OOOVAL(1,1)
  723.         LTRK=MAX(LTRK,2**24)
  724.  
  725. * Ajout a la taille en mots de la matrice des infos du segment
  726.         LSEG=LRE*LRE*NBELE1 + 16
  727.         NBLPRT=(LSEG-1)/LTRK+1
  728.         NBLMAX=(NBELE1-1)/NBLPRT+1
  729.         NBLPRT=(NBELE1-1)/NBLMAX+1
  730.  
  731.         NRIGE0 = mrigid.IRIGEL(/2)
  732.         NRIGEL = IRIGEL(/2) + NBLPRT
  733.         if (cmate.eq.'NLIN') then
  734.           if (ilump.eq.0) nrnlin = 2
  735.           if (ilump.eq.2) nrnlin = 1
  736.           nrigel = nrige0 + nrnlin*nblprt
  737.         endif
  738.         SEGADJ,MRIGID
  739.         IPMASS=MRIGID
  740.  
  741.         MELEME = IPT1
  742.         ipt3   = IPMAIG
  743.         nbnn   = NBNOE1
  744.         nbelem = NBELE1
  745.         nbsous = 0
  746.         nbref  = 0
  747.  
  748. *  Boucle (5000) de PARTITIONNEMENT du segment xMATRI
  749.         DO 5000 IPRT = 1,NBLPRT
  750.           isouss=isouss+1
  751.  
  752.           IF (NBLPRT.GT.1) THEN
  753.             JPRT=(IPRT-1)*NBLMAX
  754.             NBNN   = NBNOE1
  755.             NBELEM = MIN(NBLMAX,NBELE1-JPRT)
  756.             SEGINI,MELEME
  757.             ITYPEL=IPT1.ITYPEL
  758.             DO ielt = 1, NBELEM
  759.               jelt = ielt + JPRT
  760.               DO inoe = 1, NBNN
  761.                 NUM(inoe,ielt)=IPT1.NUM(inoe,jelt)
  762.               ENDDO
  763.               ICOLOR(ielt) = IPT1.ICOLOR(jelt)
  764.             ENDDO
  765.             IF (BDPGE) THEN
  766.               ipt2   = IPMAIG
  767.               nbnn   = NBNOEG
  768. cc              nbelem = MIN(NBLMAX,NBELEG-JPRT)
  769.               SEGINI,ipt3
  770.               ipt3.itypel = 28
  771.               DO ielt = 1, nbelem
  772.                 jelt = ielt + JPRT
  773.                 DO inoe = 1, nbnn
  774.                   ipt3.num(inoe,ielt) = IPT2.NUM(inoe,jelt)
  775.                 ENDDO
  776.                 ipt3.icolor(ielt) = IPT2.ICOLOR(jelt)
  777.               ENDDO
  778.               SEGDES,IPT3
  779.             ELSE
  780.               IPT3 = meleme
  781.             ENDIF
  782.           ENDIF
  783.  
  784.           nbnn   = NBNOE1
  785.           IPMAIL = MELEME
  786.           ipdscr = DESCR
  787.           ipmadg = ipt3
  788.  
  789. C ------------------------------------------------------------*
  790. C INITIALISATION DU SEGMENT xMATRI, CHAPEAU SUR LES SEGMENTS  *
  791. C CONTENANT LES MATRICES DE RIGIDITE ELEMENTAIRES             *
  792. C ------------------------------------------------------------*
  793.           xMATRI = 0
  794.  
  795. C* cas XFEM : DESCR et xMATRI crees par massxr.eso
  796. C* Cas particulier des elements XFEM en cas de partition :
  797. C* Il faut aussi partitionner le modele (nomme imoxfem)
  798.           IF (MFR.EQ.63) THEN
  799.             IF (nblprt.GT.1) THEN
  800.               imoxfem = 0
  801.               CALL PARTXR(IMODEL,ipmail,imoxfem)
  802.               IF (IERR.NE.0) RETURN
  803.             ELSE
  804.               imoxfem = IMODEL
  805.             ENDIF
  806.             GOTO 1999
  807.           ENDIF
  808.           if (cmate.eq.'NLIN') goto 1999
  809.  
  810. C NBELEM: NB D'ELEMENTS DANS LA SOUS ZONE
  811.           NLIGRP=LRE
  812.           NLIGRD=LRE
  813.  
  814.           NELRIG=NBELEM
  815.           SEGINI,xMATRI
  816.           IPMATR=xMATRI
  817.  
  818. C------------------------------------------------------*
  819. C  TRAITEMENT DU CHAPEAU DES RIGIDITES, SEGMENT MRIGID *
  820. C------------------------------------------------------*
  821.           COERIG(isouss)=1.D0
  822.           IRIGEL(1,isouss)=IPMADG
  823.           IRIGEL(2,isouss)=0
  824.           IRIGEL(3,isouss)=IPDSCR
  825.           IRIGEL(4,isouss)=IPMATR
  826.           IRIGEL(5,isouss)=NHRM
  827.           IRIGEL(6,isouss)=0
  828.           IRIGEL(7,isouss)=0
  829.           IRIGEL(8,isouss)=0
  830.           xMATRI.SYMRE = 0
  831.  
  832.  1999     CONTINUE
  833.           IVAMAT = 0
  834.           IF (MOMATR.NE.0) THEN
  835.  
  836. *    verification du support des composantes recherchees
  837. *
  838.             CALL QUESUQ(IMODEL,IPCHE1,4,0,MOMATR,isupo,ISUP,IRET1)
  839.             IF (ISUP.GT.1)THEN
  840.               GO TO 9990
  841.             ENDIF
  842.  
  843.           CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYMA,1,INFOS,3,IVAMAT)
  844.           IF (IERR.NE.0) GOTO 9990
  845.           IF (ISUP.EQ.1)THEN
  846.             CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  847.             IF(IERR.NE.0)THEN
  848.               ISUP=0
  849.               GOTO 9990
  850.             ENDIF
  851.           ENDIF
  852.           if (cmate.eq.'STATIQUE'.or.cmate.eq.'MODAL') then
  853.             mptval = ivamat
  854.             if (ival(/1).lt.3) call erreur(5)
  855.             if (cmate.eq.'STATIQUE') then
  856.               kstat = kstat + 1
  857.               if (kstat.eq.nstat) then
  858.                 nstat = nstat + 100
  859.                 segadj modsta
  860.               endif
  861.               ivstat(kstat) = ivamat
  862.               pistat(kstat) = imodel
  863.             endif
  864.             if (cmate.eq.'MODAL') then
  865.               kmoda = kmoda + 1
  866.               if (kmoda.eq.nmoda) then
  867.                 nmoda = nmoda + 100
  868.                 segadj modsta
  869.               endif
  870.               ivmoda(kmoda) = ivamat
  871.               pimoda(kmoda) = imodel
  872.             endif
  873.           endif
  874.  
  875.           ENDIF
  876.  
  877. C____________________________________________________________________
  878. C
  879. C TRAITEMENT DES CHAMPS DE CARACTERISTIQUES
  880. C____________________________________________________________________
  881.         IVACAR = 0
  882.         IF (MOCARA.NE.0)  THEN
  883. *
  884. *    verification du support des composantes recherchees
  885. *
  886.             CALL QUESUQ(IMODEL,IPCHE1,4,0,MOCARA,isupo,ISUP,IRET2)
  887.             IF (ISUP.GT.1)THEN
  888.               GO TO 9990
  889.             ENDIF
  890. *
  891.           CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYCA,1,INFOS,3,IVACAR)
  892.           IF (IERR.NE.0) GOTO 9990
  893.           IF (ISUP.EQ.1)THEN
  894.               CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  895.               IF(IERR.NE.0)THEN
  896.                   ISUP=0
  897.                   GOTO 9990
  898.               ENDIF
  899.           ENDIF
  900.       ENDIF
  901. C
  902. C NAVIER_STOKES NLIN
  903.           if (cmate.eq.'NLIN') then
  904.            segact mmode1*mod
  905.            mmode1.kmodel(1) = imodel
  906.            mchel1.conche(1) = conm
  907.            mchel1.imache(1) = ipmail
  908.            mptval = ivamat
  909.            nomid = momatr
  910. *           do jj = 1,n2
  911.              mcham1.nomche(1) = lesobl(1)
  912.              mcham1.typche(1) = tyval(1)
  913.              mcham1.ielval(1) = ival(1)
  914. *           enddo
  915.  
  916.            ipmons = mmode1
  917.            ipchns = mchel1
  918.              if (ilump.eq.2) then
  919.                call go2nli(ipmons,ipchns,iprins,7)
  920.              else
  921.                call go2nli(ipmons,ipchns,iprins,2)
  922.              endif
  923.            if (ierr.ne.0) return
  924.  
  925.            RI3 = iprins
  926.            segact ri3
  927.            if (ri3.coerig(/1).ne.nrnlin) then
  928.              write(6,*) 'mari3',ri3.coerig(/1),nrnlin
  929.              call erreur(5)
  930.              return
  931.            endif
  932.            isouss = isouss - 1
  933.            do kige = 1,nrnlin
  934.              ipdesc = ri3.IRIGEL(3,kige)
  935.              ipmatr = ri3.IRIGEL(4,kige)
  936.              isymm = ri3.irigel(7,kige)
  937.  
  938.           isouss = isouss + 1
  939.           jrige = isouss
  940.           COERIG(jrige)   = ri3.coerig(kige)
  941.           IRIGEL(1,jrige) = ipmail
  942.           IRIGEL(2,jrige) = 0
  943.           IRIGEL(3,jrige) = ipdesc
  944.           IRIGEL(4,jrige) = ipmatr
  945.           IRIGEL(5,jrige) = NIFOUR
  946.           IRIGEL(6,jrige) = 0
  947.           IRIGEL(7,jrige) = ri3.irigel(7,kige)
  948.           IRIGEL(8,jrige) = 0
  949.            enddo
  950.  
  951.           endif
  952.  
  953. C_______________________________________________________________________
  954. C
  955. C     NUMERO DES ETIQUETTES      :
  956. C     ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  957. C     LES ELEMENTS SONT GROUPES COMME SUIT :
  958. C      - MASSIF,LIQUIDE 'SURFACE LIBRE' ----------------------> MASSE2
  959. C      - COQ3/POUTRE,DKT,COQ4,COQ8,COQ2,DST ------------------> MASSE3
  960. C        ET POUTRE DE TIMOSCHENKO
  961. C      - RACCORDS LIQUIDE/MASSIFS,RACCORDS LIQUIDE/COQUES,
  962. C          BARRE,HOMOGENEISE,JOINTS --------------------------> MASSE4
  963. C_______________________________________________________________________
  964.             IF (MELE.LE.100)
  965. *                 CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9
  966.      &      GOTO (  99,  27,  99,   4,  99,   4,  99,   4,  99,   4,  99
  967. *                 RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT
  968.      &           ,  12,  99,   4,   4,   4,   4,  12,  12,  99,  99,  99
  969. *                 TET4 TE10 PYR5 PY13 COQ3  DKT POUT LISP FAC3 FAC4 FAC6
  970.      &           ,   4,   4,   4,   4,  27,  27,  27,  30,  99,  99,  99
  971. *                 FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2
  972.      &           ,  99,   4,   4,   4,   4,   4,   4,  27,  27,  43,  27
  973. *                 POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO
  974.      &           ,  12,  12,  12,   4,  27,  99,  99,  99,   4,   4,  12
  975. *                 COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15
  976.      &           ,  27,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  977. *                 THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10
  978.      &           ,  99,  99,   4,   4,   4,   4,   4,   4,   4,   4,   4
  979. *                 IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4
  980.      &           ,   4,  99,  99,  99,  99,  99,  27,  12,  99,  12,  12
  981. *                 JOI6 JOI8 LISC TRIH  DST LIC4 CERC TUYO LSE2 LITU HYT3
  982.      &           ,  99,  99,  99,  12,  27,  12,  12,  27,  27,  12,  99
  983. *                 HYQ4
  984.      &           ,  99),MELE
  985.             IF (MELE.LE.200)
  986. *                 HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8
  987.      &      GOTO (  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  988. *                 POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13
  989.      &           ,   4,   4,   4,   4,   4,   4,   4,   4,   4,   4,   4
  990. *                 PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8
  991.      &           ,   4,  12,  12,  50,  12,  12,  99,  99,  99,  99,  99
  992. *                 PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3
  993.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  994. *                 TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126
  995.      &           , 510, 510,  99,  99,  99,  99,  99,  99,  99,  99,  99
  996. *                 TE56 PY91 TRH6 ???? ???? ???? ???? ???? ???? ???? ????
  997.      &           ,  99,  99,  12,  51,  51,  51,  51,  51,  51,  51,  51
  998. *                 ???? ???? JCT3 JCI4 JGI2 JGT3 JGI4 ???? ???? ???? ????
  999.      &           ,  51,  51,  12,  12,  12,  12,  12,  51,  51,  51,  51
  1000. *                 ???? ???? ???? ???? ???? ???? E183 E184 ???? ???? ????
  1001.      &           ,  51,  51,  51,  51,  51,  51,   4,   4,  51,  51,  51
  1002. *                 ???? ???? ???? ???? ???? M1D2 M1D3 ???? ???? ???? ????
  1003.      &           ,  51,  51,  51,  51,  51,   4,   4,  51,  51,  51,  51
  1004. *                 ???? ????
  1005.      &           ,  51,  51),MELE-100
  1006.             IF (MELE.LE.300)
  1007. C                  LC19 LS03 LS07 LS09 LS27 LS21 LS15 LS19 BS03 BS07
  1008.      &      GOTO (   99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  1009. C                  BS09 BS27 BS21 BS15 BS19 MC03 MC07 MC09 MC27 MC21
  1010.      1            ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  1011. C                  MC15 MC19 M103 M107 M109 M127 M121 M115 M119 MS03
  1012.      2            ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  1013. C                  MS07 MS09 MS27 MS21 MS15 MS19 QC03 QC07 QC09 QC27
  1014.      3            ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  1015. C                  QC21 QC15 QC19 Q103 Q107 Q109 Q127 Q121 Q115 Q119
  1016.      4            ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  1017. C                  QS03 QS07 QS09 QS27 QS21 QS15 QS19 CIFL SURE SHB8
  1018.      5            ,  99,  99,  99,  99,  99,  99,  99,  99,  99,   4
  1019. C                  CAF2 CAF3 XQ4R XC8R JOI1 ZCO2 ZCO3 ZCO4 TUY2 TUY3
  1020.      6            ,  99,  99,  63,  63,  12,  99,  99,  99,  99,  99
  1021. C                  COS2 COA2 ICY5 IC13 CU27 PR21 TE15 PY19 C20R P15R
  1022.      7            ,  99,  99,   4,   4,  99,  99,  99,  99,  99,  99)
  1023. c cccccc
  1024.      .      ,MELE-200
  1025. C
  1026.  51   CONTINUE
  1027.  99   CONTINUE
  1028.       SEGSUP xMATRI
  1029.       IRIGEL(4,isouss)=0
  1030.       MOTERR(1:4)=NOMTP(MELE)
  1031.       MOTERR(5:12)='MASSE'
  1032.       CALL ERREUR(86)
  1033.       GOTO 9990
  1034. C_______________________________________________________________________
  1035. C
  1036. C     MASSIF, LIQUIDE, 'SURFACE LIBRE'
  1037. C_______________________________________________________________________
  1038. C
  1039.    4  CONTINUE
  1040.       IF (BDPGE) NDDL=NDDL+NDDLGE
  1041.       CALL MASSE2(IPMAIL,NDDL,LRE,NBPGAU,IPMINT,MELE,MFR,IVAMAT,
  1042.      &            IVACAR,NMATT,IPMATR,ILUMP,IIPDPG)
  1043.       GOTO 510
  1044. C_______________________________________________________________________
  1045. C
  1046. C  RACCORDS LIQUIDE/MASSIF,RACCORD LIQUIDE/COQUE,BARRE,HOMOGENEISE,JOT3
  1047. C  JOI4,JOI2,JOI1
  1048. C_______________________________________________________________________
  1049. C
  1050.   12  CONTINUE
  1051.       CALL MASSE4(IPMAIL,LW,LRE,IVAMAT,NMATT,IVACAR,NCARR,NBPGAU,
  1052.      &         IPMINT,NDDL,MELE,MFR,IPMATR,ILUMP,isouss,IIPDPG,imodel)
  1053.        GOTO 510
  1054. C_______________________________________________________________________
  1055. C
  1056. C     COQ3/POUTRE,DKT,COQ4,COQ8,COQ2 ,DST, POUTRE DE TIMOSCHENKO
  1057. C_______________________________________________________________________
  1058. C
  1059.   27  CONTINUE
  1060.       CALL MASSE3(IPMAIL,LRE,LW,MELE,IVAMAT,NMATT,IVACAR,NCARR,
  1061.      &            isouss,NBPGAU,IPMINT,IPMIN1,NDDL,MATE,
  1062.      &            CMATE,LHOTRA,IPMATR,ILUMP,IIPDPG,imodel)
  1063.       GOTO 510
  1064. C_______________________________________________________________________
  1065. C
  1066. C     ELEMENT LINESPRING   CA NE PESE RIEN
  1067. C_______________________________________________________________________
  1068. C
  1069.    30 CONTINUE
  1070.       GOTO 510
  1071. CC______________________________________________________________________
  1072. C
  1073. C     ELEMENT TUYAU FISSURE CA NE PESE RIEN
  1074. C_______________________________________________________________________
  1075. C
  1076.    43 CONTINUE
  1077.       GOTO 510
  1078. C_______________________________________________________________________
  1079. C
  1080. C     ELEMENT LIA2 (LIAISON A 2 NOEUDS) CA NE PESE RIEN
  1081. C_______________________________________________________________________
  1082. C
  1083.    50 CONTINUE
  1084.       GOTO 510
  1085. C_______________________________________________________________________
  1086. C
  1087. C     ELEMENT XFEM (MFR = 63)
  1088. C_______________________________________________________________________
  1089. C Le sous-programme MASSXR gere les appels aux elements de type XFEM
  1090. C (imoxfem est le modele complet ou partitionne si necessaire)
  1091.  63   CONTINUE
  1092.       CALL MASSXR (isouss,imoxfem,
  1093.      $             IVAMAT,IVACAR,NMATT,CMATE, IIPDPG,IPMASS,IRETER)
  1094.       IF (IRETER.NE.0) RETURN
  1095.       if (nblprt.GT.1) THEN
  1096.         imode1 = imoxfem
  1097.         segsup,imode1
  1098.       endif
  1099. C il n'y aura plus que les desactivations a faire
  1100.       GOTO 510
  1101. C_______________________________________________________________________
  1102. C
  1103. C     DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
  1104. C_______________________________________________________________________
  1105. C
  1106.   510 CONTINUE
  1107. C
  1108.       IF (ISUP.EQ.1) THEN
  1109.         MPTVAL=IVACAR
  1110.         SEGSUP,MPTVAL
  1111.       ENDIF
  1112.  
  1113.       if (cmate.eq.'MODAL'.or.cmate.eq.'STATIQUE') goto 519
  1114.       IF (ISUP.EQ.1) THEN
  1115.         MPTVAL=IVAMAT
  1116.         SEGSUP,MPTVAL
  1117.       ENDIF
  1118.  519  CONTINUE
  1119.       IF (xMATRI.NE.0) SEGDES,xMATRI
  1120. C
  1121. C     ERREUR  DANS LES S-P MASSE2 ,MASSE3 ,MASSE4
  1122. C
  1123.       IF (IERR.NE.0) GOTO 888
  1124. *
  1125. *  Fin de la boucle (5000) de PARTITIONNEMENT du segment xMATRI
  1126.  5000 CONTINUE
  1127. *
  1128.       NOMID=MOCARA
  1129.       IF (MOCARA.NE.0) SEGSUP NOMID
  1130.       notype = MOTYCA
  1131.       IF (MOTYCA.NE.MOTYR8) SEGSUP,notype
  1132.       NOMID=MOMATR
  1133.       IF (MOMATR.NE.0) SEGSUP NOMID
  1134.       notype = MOTYMA
  1135.       IF (MOTYMA.NE.MOTYR8) SEGSUP,notype
  1136. *
  1137. *-----------------------------------------------------------------------
  1138. * Fin de la boucle sur les sous-zones du modele
  1139. *-----------------------------------------------------------------------
  1140.  500  CONTINUE
  1141.  
  1142.       IF (isouss.NE.IRIGEL(/2)) THEN
  1143.         NRIGEL = isouss
  1144.         SEGADJ,MRIGID
  1145.       ENDIF
  1146.  
  1147. *termes croises  'STATIQUE'/'MODAL'
  1148.       ir2 = 0
  1149.       nstat = kstat
  1150.       nmoda = kmoda
  1151.       segadj modsta
  1152.       if (nstat.ne.0) then
  1153.         if (nstat.gt.0) then
  1154.           call ricroi(modsta, ir2,1)
  1155.           IF (ISUP.EQ.1) THEN
  1156.             do kstat=1,nstat
  1157.               mptval = ivstat(kstat)
  1158.               SEGSUP,MPTVAL
  1159.             enddo
  1160.           ENDIF
  1161.         endif
  1162.         if (nmoda.gt.0) then
  1163.           IF (ISUP.EQ.1) THEN
  1164.             do kmoda=1,nmoda
  1165.               mptval = ivmoda(kmoda)
  1166.               SEGSUP,MPTVAL
  1167.             enddo
  1168.           ENDIF
  1169.         endif
  1170.       endif
  1171.       IRET = 1
  1172.  
  1173.  888  CONTINUE
  1174.       if (ierr.eq.0.and.ir2.gt.0) then
  1175.         ir1 = mrigid
  1176.         call fusrig(ir1,ir2,ir3)
  1177.         mrigid = ir3
  1178.         ipmass = mrigid
  1179.       endif
  1180.       SEGDES MRIGID
  1181.       GOTO 666
  1182. C
  1183. C     ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  1184. C
  1185.  9990 CONTINUE
  1186.       IRET=0
  1187. C
  1188.  9995 CONTINUE
  1189.  9996 CONTINUE
  1190.       SEGSUP MRIGID
  1191. C
  1192.   666 CONTINUE
  1193.       mmodel = IPMODL
  1194.       SEGDES,mmodel
  1195.       meleme = MAILDG
  1196.       IF (meleme.NE.0) SEGDES,meleme
  1197.       SEGSUP,modsta
  1198.  
  1199. c      RETURN
  1200.       END
  1201.  
  1202.  
  1203.  

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