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    PV090527  26/04/30    21:15:51     12529          
  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 = INFMOD(3)
  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.           rigrel=0
  816.           SEGINI,xMATRI
  817.           IPMATR=xMATRI
  818.  
  819. C------------------------------------------------------*
  820. C  TRAITEMENT DU CHAPEAU DES RIGIDITES, SEGMENT MRIGID *
  821. C------------------------------------------------------*
  822.           COERIG(isouss)=1.D0
  823.           IRIGEL(1,isouss)=IPMADG
  824.           IRIGEL(2,isouss)=0
  825.           IRIGEL(3,isouss)=IPDSCR
  826.           IRIGEL(4,isouss)=IPMATR
  827.           IRIGEL(5,isouss)=NHRM
  828.           IRIGEL(6,isouss)=0
  829.           IRIGEL(7,isouss)=0
  830.           IRIGEL(8,isouss)=0
  831.           xMATRI.SYMRE = 0
  832.  
  833.  1999     CONTINUE
  834.           IVAMAT = 0
  835.           IF (MOMATR.NE.0) THEN
  836.  
  837. *    verification du support des composantes recherchees
  838. *
  839.             CALL QUESUQ(IMODEL,IPCHE1,4,0,MOMATR,isupo,ISUP,IRET1)
  840.             IF (ISUP.GT.1)THEN
  841.               GO TO 9990
  842.             ENDIF
  843.  
  844.           CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYMA,1,INFOS,3,IVAMAT)
  845.           IF (IERR.NE.0) GOTO 9990
  846.           IF (ISUP.EQ.1)THEN
  847.             CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  848.             IF(IERR.NE.0)THEN
  849.               ISUP=0
  850.               GOTO 9990
  851.             ENDIF
  852.           ENDIF
  853.           if (cmate.eq.'STATIQUE'.or.cmate.eq.'MODAL') then
  854.             mptval = ivamat
  855.             if (ival(/1).lt.3) call erreur(5)
  856.             if (cmate.eq.'STATIQUE') then
  857.               kstat = kstat + 1
  858.               if (kstat.eq.nstat) then
  859.                 nstat = nstat + 100
  860.                 segadj modsta
  861.               endif
  862.               ivstat(kstat) = ivamat
  863.               pistat(kstat) = imodel
  864.             endif
  865.             if (cmate.eq.'MODAL') then
  866.               kmoda = kmoda + 1
  867.               if (kmoda.eq.nmoda) then
  868.                 nmoda = nmoda + 100
  869.                 segadj modsta
  870.               endif
  871.               ivmoda(kmoda) = ivamat
  872.               pimoda(kmoda) = imodel
  873.             endif
  874.           endif
  875.  
  876.           ENDIF
  877.  
  878. C____________________________________________________________________
  879. C
  880. C TRAITEMENT DES CHAMPS DE CARACTERISTIQUES
  881. C____________________________________________________________________
  882.         IVACAR = 0
  883.         IF (MOCARA.NE.0)  THEN
  884. *
  885. *    verification du support des composantes recherchees
  886. *
  887.             CALL QUESUQ(IMODEL,IPCHE1,4,0,MOCARA,isupo,ISUP,IRET2)
  888.             IF (ISUP.GT.1)THEN
  889.               GO TO 9990
  890.             ENDIF
  891. *
  892.           CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYCA,1,INFOS,3,IVACAR)
  893.           IF (IERR.NE.0) GOTO 9990
  894.           IF (ISUP.EQ.1)THEN
  895.               CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  896.               IF(IERR.NE.0)THEN
  897.                   ISUP=0
  898.                   GOTO 9990
  899.               ENDIF
  900.           ENDIF
  901.       ENDIF
  902. C
  903. C NAVIER_STOKES NLIN
  904.           if (cmate.eq.'NLIN') then
  905.            segact mmode1*mod
  906.            mmode1.kmodel(1) = imodel
  907.            mchel1.conche(1) = conm
  908.            mchel1.imache(1) = ipmail
  909.            mptval = ivamat
  910.            nomid = momatr
  911. *           do jj = 1,n2
  912.              mcham1.nomche(1) = lesobl(1)
  913.              mcham1.typche(1) = tyval(1)
  914.              mcham1.ielval(1) = ival(1)
  915. *           enddo
  916.  
  917.            ipmons = mmode1
  918.            ipchns = mchel1
  919.              if (ilump.eq.2) then
  920.                call go2nli(ipmons,ipchns,iprins,7)
  921.              else
  922.                call go2nli(ipmons,ipchns,iprins,2)
  923.              endif
  924.            if (ierr.ne.0) return
  925.  
  926.            RI3 = iprins
  927.            segact ri3
  928.            if (ri3.coerig(/1).ne.nrnlin) then
  929.              write(6,*) 'mari3',ri3.coerig(/1),nrnlin
  930.              call erreur(5)
  931.              return
  932.            endif
  933.            isouss = isouss - 1
  934.            do kige = 1,nrnlin
  935.              ipdesc = ri3.IRIGEL(3,kige)
  936.              ipmatr = ri3.IRIGEL(4,kige)
  937.              isymm = ri3.irigel(7,kige)
  938.  
  939.           isouss = isouss + 1
  940.           jrige = isouss
  941.           COERIG(jrige)   = ri3.coerig(kige)
  942.           IRIGEL(1,jrige) = ipmail
  943.           IRIGEL(2,jrige) = 0
  944.           IRIGEL(3,jrige) = ipdesc
  945.           IRIGEL(4,jrige) = ipmatr
  946.           IRIGEL(5,jrige) = NIFOUR
  947.           IRIGEL(6,jrige) = 0
  948.           IRIGEL(7,jrige) = ri3.irigel(7,kige)
  949.           IRIGEL(8,jrige) = 0
  950.            enddo
  951.  
  952.           endif
  953.  
  954. C_______________________________________________________________________
  955. C
  956. C     NUMERO DES ETIQUETTES      :
  957. C     ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  958. C     LES ELEMENTS SONT GROUPES COMME SUIT :
  959. C      - MASSIF,LIQUIDE 'SURFACE LIBRE' ----------------------> MASSE2
  960. C      - COQ3/POUTRE,DKT,COQ4,COQ8,COQ2,DST ------------------> MASSE3
  961. C        ET POUTRE DE TIMOSCHENKO
  962. C      - RACCORDS LIQUIDE/MASSIFS,RACCORDS LIQUIDE/COQUES,
  963. C          BARRE,HOMOGENEISE,JOINTS --------------------------> MASSE4
  964. C_______________________________________________________________________
  965.             IF (MELE.LE.100)
  966. *                 CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9
  967.      &      GOTO (  99,  27,  99,   4,  99,   4,  99,   4,  99,   4,  99
  968. *                 RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT
  969.      &           ,  12,  99,   4,   4,   4,   4,  12,  12,  99,  99,  99
  970. *                 TET4 TE10 PYR5 PY13 COQ3  DKT POUT LISP FAC3 FAC4 FAC6
  971.      &           ,   4,   4,   4,   4,  27,  27,  27,  30,  99,  99,  99
  972. *                 FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2
  973.      &           ,  99,   4,   4,   4,   4,   4,   4,  27,  27,  43,  27
  974. *                 POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO
  975.      &           ,  12,  12,  12,   4,  27,  99,  99,  99,   4,   4,  12
  976. *                 COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15
  977.      &           ,  27,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  978. *                 THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10
  979.      &           ,  99,  99,   4,   4,   4,   4,   4,   4,   4,   4,   4
  980. *                 IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4
  981.      &           ,   4,  99,  99,  99,  99,  99,  27,  12,  99,  12,  12
  982. *                 JOI6 JOI8 LISC TRIH  DST LIC4 CERC TUYO LSE2 LITU HYT3
  983.      &           ,  99,  99,  99,  12,  27,  12,  12,  27,  27,  12,  99
  984. *                 HYQ4
  985.      &           ,  99),MELE
  986.             IF (MELE.LE.200)
  987. *                 HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8
  988.      &      GOTO (  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  989. *                 POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13
  990.      &           ,   4,   4,   4,   4,   4,   4,   4,   4,   4,   4,   4
  991. *                 PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8
  992.      &           ,   4,  12,  12,  50,  12,  12,  99,  99,  99,  99,  99
  993. *                 PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3
  994.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  995. *                 TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126
  996.      &           , 510, 510,  99,  99,  99,  99,  99,  99,  99,  99,  99
  997. *                 TE56 PY91 TRH6 ???? ???? ???? ???? ???? ???? ???? ????
  998.      &           ,  99,  99,  12,  51,  51,  51,  51,  51,  51,  51,  51
  999. *                 ???? ???? JCT3 JCI4 JGI2 JGT3 JGI4 ???? ???? ???? ????
  1000.      &           ,  51,  51,  12,  12,  12,  12,  12,  51,  51,  51,  51
  1001. *                 ???? ???? ???? ???? ???? ???? E183 E184 ???? ???? ????
  1002.      &           ,  51,  51,  51,  51,  51,  51,   4,   4,  51,  51,  51
  1003. *                 ???? ???? ???? ???? ???? M1D2 M1D3 ???? ???? ???? ????
  1004.      &           ,  51,  51,  51,  51,  51,   4,   4,  51,  51,  51,  51
  1005. *                 ???? ????
  1006.      &           ,  51,  51),MELE-100
  1007.             IF (MELE.LE.300)
  1008. C                  LC19 LS03 LS07 LS09 LS27 LS21 LS15 LS19 BS03 BS07
  1009.      &      GOTO (   99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  1010. C                  BS09 BS27 BS21 BS15 BS19 MC03 MC07 MC09 MC27 MC21
  1011.      1            ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  1012. C                  MC15 MC19 M103 M107 M109 M127 M121 M115 M119 MS03
  1013.      2            ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  1014. C                  MS07 MS09 MS27 MS21 MS15 MS19 QC03 QC07 QC09 QC27
  1015.      3            ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  1016. C                  QC21 QC15 QC19 Q103 Q107 Q109 Q127 Q121 Q115 Q119
  1017.      4            ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  1018. C                  QS03 QS07 QS09 QS27 QS21 QS15 QS19 CIFL SURE SHB8
  1019.      5            ,  99,  99,  99,  99,  99,  99,  99,  99,  99,   4
  1020. C                  CAF2 CAF3 XQ4R XC8R JOI1 ZCO2 ZCO3 ZCO4 TUY2 TUY3
  1021.      6            ,  99,  99,  63,  63,  12,  99,  99,  99,  99,  99
  1022. C                  COS2 COA2 ICY5 IC13 CU27 PR21 TE15 PY19 C20R P15R
  1023.      7            ,  99,  99,   4,   4,  99,  99,  99,  99,  99,  99)
  1024. c cccccc
  1025.      .      ,MELE-200
  1026. C
  1027.  51   CONTINUE
  1028.  99   CONTINUE
  1029.       SEGSUP xMATRI
  1030.       IRIGEL(4,isouss)=0
  1031.       MOTERR(1:4)=NOMTP(MELE)
  1032.       MOTERR(5:12)='MASSE'
  1033.       CALL ERREUR(86)
  1034.       GOTO 9990
  1035. C_______________________________________________________________________
  1036. C
  1037. C     MASSIF, LIQUIDE, 'SURFACE LIBRE'
  1038. C_______________________________________________________________________
  1039. C
  1040.    4  CONTINUE
  1041.       IF (BDPGE) NDDL=NDDL+NDDLGE
  1042.       CALL MASSE2(IPMAIL,NDDL,LRE,NBPGAU,IPMINT,MELE,MFR,IVAMAT,
  1043.      &            IVACAR,NMATT,IPMATR,ILUMP,IIPDPG)
  1044.       GOTO 510
  1045. C_______________________________________________________________________
  1046. C
  1047. C  RACCORDS LIQUIDE/MASSIF,RACCORD LIQUIDE/COQUE,BARRE,HOMOGENEISE,JOT3
  1048. C  JOI4,JOI2,JOI1
  1049. C_______________________________________________________________________
  1050. C
  1051.   12  CONTINUE
  1052.       CALL MASSE4(IPMAIL,LW,LRE,IVAMAT,NMATT,IVACAR,NCARR,NBPGAU,
  1053.      &         IPMINT,NDDL,MELE,MFR,IPMATR,ILUMP,isouss,IIPDPG,imodel)
  1054.        GOTO 510
  1055. C_______________________________________________________________________
  1056. C
  1057. C     COQ3/POUTRE,DKT,COQ4,COQ8,COQ2 ,DST, POUTRE DE TIMOSCHENKO
  1058. C_______________________________________________________________________
  1059. C
  1060.   27  CONTINUE
  1061.       CALL MASSE3(IPMAIL,LRE,LW,MELE,IVAMAT,NMATT,IVACAR,NCARR,
  1062.      &            isouss,NBPGAU,IPMINT,IPMIN1,NDDL,MATE,
  1063.      &            CMATE,LHOTRA,IPMATR,ILUMP,IIPDPG,imodel)
  1064.       GOTO 510
  1065. C_______________________________________________________________________
  1066. C
  1067. C     ELEMENT LINESPRING   CA NE PESE RIEN
  1068. C_______________________________________________________________________
  1069. C
  1070.    30 CONTINUE
  1071.       GOTO 510
  1072. CC______________________________________________________________________
  1073. C
  1074. C     ELEMENT TUYAU FISSURE CA NE PESE RIEN
  1075. C_______________________________________________________________________
  1076. C
  1077.    43 CONTINUE
  1078.       GOTO 510
  1079. C_______________________________________________________________________
  1080. C
  1081. C     ELEMENT LIA2 (LIAISON A 2 NOEUDS) CA NE PESE RIEN
  1082. C_______________________________________________________________________
  1083. C
  1084.    50 CONTINUE
  1085.       GOTO 510
  1086. C_______________________________________________________________________
  1087. C
  1088. C     ELEMENT XFEM (MFR = 63)
  1089. C_______________________________________________________________________
  1090. C Le sous-programme MASSXR gere les appels aux elements de type XFEM
  1091. C (imoxfem est le modele complet ou partitionne si necessaire)
  1092.  63   CONTINUE
  1093.       CALL MASSXR (isouss,imoxfem,
  1094.      $             IVAMAT,IVACAR,NMATT,CMATE, IIPDPG,IPMASS,IRETER)
  1095.       IF (IRETER.NE.0) RETURN
  1096.       if (nblprt.GT.1) THEN
  1097.         imode1 = imoxfem
  1098.         segsup,imode1
  1099.       endif
  1100. C il n'y aura plus que les desactivations a faire
  1101.       GOTO 510
  1102. C_______________________________________________________________________
  1103. C
  1104. C     DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
  1105. C_______________________________________________________________________
  1106. C
  1107.   510 CONTINUE
  1108. C
  1109.       IF (ISUP.EQ.1) THEN
  1110.         MPTVAL=IVACAR
  1111.         SEGSUP,MPTVAL
  1112.       ENDIF
  1113.  
  1114.       if (cmate.eq.'MODAL'.or.cmate.eq.'STATIQUE') goto 519
  1115.       IF (ISUP.EQ.1) THEN
  1116.         MPTVAL=IVAMAT
  1117.         SEGSUP,MPTVAL
  1118.       ENDIF
  1119.  519  CONTINUE
  1120.       IF (xMATRI.NE.0) SEGDES,xMATRI
  1121. C
  1122. C     ERREUR  DANS LES S-P MASSE2 ,MASSE3 ,MASSE4
  1123. C
  1124.       IF (IERR.NE.0) GOTO 888
  1125. *
  1126. *  Fin de la boucle (5000) de PARTITIONNEMENT du segment xMATRI
  1127.  5000 CONTINUE
  1128. *
  1129.       NOMID=MOCARA
  1130.       IF (MOCARA.NE.0) SEGSUP NOMID
  1131.       notype = MOTYCA
  1132.       IF (MOTYCA.NE.MOTYR8) SEGSUP,notype
  1133.       NOMID=MOMATR
  1134.       IF (MOMATR.NE.0) SEGSUP NOMID
  1135.       notype = MOTYMA
  1136.       IF (MOTYMA.NE.MOTYR8) SEGSUP,notype
  1137. *
  1138. *-----------------------------------------------------------------------
  1139. * Fin de la boucle sur les sous-zones du modele
  1140. *-----------------------------------------------------------------------
  1141.  500  CONTINUE
  1142.  
  1143.       IF (isouss.NE.IRIGEL(/2)) THEN
  1144.         NRIGEL = isouss
  1145.         SEGADJ,MRIGID
  1146.       ENDIF
  1147.  
  1148. *termes croises  'STATIQUE'/'MODAL'
  1149.       ir2 = 0
  1150.       nstat = kstat
  1151.       nmoda = kmoda
  1152.       segadj modsta
  1153.       if (nstat.ne.0) then
  1154.         if (nstat.gt.0) then
  1155.           call ricroi(modsta, ir2,1)
  1156.           IF (ISUP.EQ.1) THEN
  1157.             do kstat=1,nstat
  1158.               mptval = ivstat(kstat)
  1159.               SEGSUP,MPTVAL
  1160.             enddo
  1161.           ENDIF
  1162.         endif
  1163.         if (nmoda.gt.0) then
  1164.           IF (ISUP.EQ.1) THEN
  1165.             do kmoda=1,nmoda
  1166.               mptval = ivmoda(kmoda)
  1167.               SEGSUP,MPTVAL
  1168.             enddo
  1169.           ENDIF
  1170.         endif
  1171.       endif
  1172.       IRET = 1
  1173.  
  1174.  888  CONTINUE
  1175.       if (ierr.eq.0.and.ir2.gt.0) then
  1176.         ir1 = mrigid
  1177.         call fusrig(ir1,ir2,ir3)
  1178.         mrigid = ir3
  1179.         ipmass = mrigid
  1180.       endif
  1181.       SEGDES MRIGID
  1182.       GOTO 666
  1183. C
  1184. C     ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  1185. C
  1186.  9990 CONTINUE
  1187.       IRET=0
  1188. C
  1189.  9995 CONTINUE
  1190.  9996 CONTINUE
  1191.       SEGSUP MRIGID
  1192. C
  1193.   666 CONTINUE
  1194.       mmodel = IPMODL
  1195.       SEGDES,mmodel
  1196.       meleme = MAILDG
  1197.       IF (meleme.NE.0) SEGDES,meleme
  1198.       SEGSUP,modsta
  1199.  
  1200. c      RETURN
  1201.       END
  1202.  
  1203.  
  1204.  
  1205.  
  1206.  
  1207.  

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