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

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