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

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