Télécharger la plaquette Cast3M


fr en

Télécharger vecte2.eso

Retour à la liste

Numérotation des lignes : 

vecte2

  1. C VECTE2    SOURCE    MB234859  25/09/08    21:16:14     12358          
  2.  
  3. *---------------------------------------------------------------*
  4. *     Creation d'un MVECTE a partir d'un MCHAML en vue          *
  5. *     d'un trace avec des petites fleches                       *
  6. *                                                               *
  7. *     MCHA1    MCHAML de CONTRAINTES PRINCIPALES                *
  8. *     MCHA2    MCHAML de CARACTERISTIQUES (coques epaisses)     *
  9. *     MOD1     MMODEL                                           *
  10. *     AMP      coefficient d'amplification (FLOTTANT)           *
  11. *     CMOT     composante a visualiser (MOT)                    *
  12. *     LMOT1    liste des couleurs affectees aux composantes     *
  13. *     MVECT0   pointeur sur MVECTE resultat                     *
  14. *                                                               *
  15. *     D. R.-M. mai & juin 1994                                  *
  16. *---------------------------------------------------------------*
  17.  
  18.       SUBROUTINE VECTE2(MCHA1,MCHA2,MOD1,AMP,CMOT,LMOT1,MVECT0)
  19.  
  20.       IMPLICIT INTEGER(I-N)
  21.       IMPLICIT REAL*8(A-H,O-Z)
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC CCGEOME
  26.  
  27. -INC SMCHPOI
  28. -INC SMCHAML
  29. -INC SMMODEL
  30. -INC SMVECTE
  31. -INC SMELEME
  32. -INC SMINTE
  33. -INC SMCOORD
  34. -INC SMLMOTS
  35.  
  36. -INC TMPTVAL
  37.  
  38.       SEGMENT NOTYPE
  39.         CHARACTER*16 TYPE(NBTYPE)
  40.       ENDSEGMENT
  41.       SEGMENT IPPO(NPPO)
  42.       SEGMENT MWRK1
  43.         REAL*8 XEL(3,NBN1)
  44.       ENDSEGMENT
  45.       SEGMENT MWRK2
  46.         REAL*8 TXR(3,3,NBN1),TH(NBN1)
  47.       ENDSEGMENT
  48.  
  49.       CHARACTER*(*) CMOT
  50.  
  51.       PARAMETER (NINF = 3)
  52.       INTEGER INFOS(NINF)
  53.       DIMENSION XIGAU(3),MOCOMP(3)
  54.       CHARACTER*(NCONCH) CONM
  55.  
  56.       MVECT0 = 0
  57.       SMAX = 0.D0
  58.  
  59.       IDIMP1 = IDIM + 1
  60.  
  61.       MCHELM = MCHA1
  62.  
  63.       NSC = INFCHE(/1)
  64.       IF (NSC.EQ.0) THEN
  65.         write(ioimp,*) 'MCHELM (MCHA1) VIDE'
  66.         call erreur(21)
  67.         return
  68.       ENDIF
  69. *     Verification du support : noeuds ou pdi ?
  70.       ISUP = INFCHE(1,6)
  71.       DO ISC=2,NSC
  72.         ISUP1 = INFCHE(ISC,6)
  73.         IF (ISUP1.NE.ISUP) ISUP = 0
  74.       ENDDO
  75. *     si ISUP = 1 : MCHAML aux noeuds
  76. *     si ISUP = 5 : MCHAML aux pdi
  77.       IF (ISUP.NE.1.AND.ISUP.NE.5) THEN
  78.         call erreur(609)
  79.         RETURN
  80.       ENDIF
  81.  
  82.       NMO = 0
  83.       IF (LMOT1.NE.0) THEN
  84.         MLMOTS = LMOT1
  85.         SEGACT MLMOTS
  86.         NMO = MOTS(/2)
  87.       ENDIF
  88.  
  89.       SEGACT,mcoord*MOD
  90.  
  91.       nbtype = 1
  92.       SEGINI,notype
  93.       notype.TYPE(1) = 'REAL*8'
  94.       MOTYR8 = notype
  95.  
  96.       MMODEL = MOD1
  97.       NSOUS = KMODEL(/1)
  98.  
  99. *     Boucle sur les zones du MCHAML
  100.  
  101.       DO 100 ISOU = 1,NSOUS
  102.  
  103.         IVACOM = 0
  104.         MELVEP = 0
  105.  
  106.         IMODEL = KMODEL(ISOU)
  107.  
  108.         CONM = CONMOD
  109.         MELE = NEFMOD
  110.  
  111.         IPMAIL = IMAMOD
  112.         MELEME = IMAMOD
  113.         NBN1   = meleme.NUM(/1)
  114.         NBELE1 = meleme.NUM(/2)
  115.  
  116.         if (infmod(/1).lt.7) then
  117.           write(ioimp,*) 'VECTE2 : infmod(/1) < 7'
  118.           call erreur(5)
  119.         ENDIF
  120.  
  121.         CALL IDENT(IPMAIL,CONM,MCHA1,0,INFOS,IRET)
  122.         IF (IRET.EQ.0) GOTO 900
  123.  
  124.         NBGS   = INFELE(4)
  125.         MFR    = INFELE(13)
  126.         MINTE1 = INFMOD(3)
  127.         MINTE  = INFMOD(7)
  128.         NBPGAU = MINTE.POIGAU(/1)
  129.  
  130. *       Cas des coques epaisses : epaisseur (excentrement)
  131.         IF (MFR.EQ.5) THEN
  132.           IF (MCHA2.EQ.0) THEN
  133.             MOTERR(1:16) = 'CARACTERISTIQUES'
  134.             CALL ERREUR(565)
  135.             GOTO 900
  136.           ENDIF
  137.           IF (ISUP.EQ.5) THEN
  138.             NBROBL = 1
  139.             NBRFAC = 0
  140.             SEGINI NOMID
  141.             LESOBL(1) = 'EPAI'
  142.             MOEP = NOMID
  143.             CALL KOMCHA(MCHA2,IPMAIL,CONM,MOEP,
  144.      &                  MOTYR8,1,INFOS,3,IVAEP)
  145.             SEGSUP,NOMID
  146.             IF (IERR.NE.0) GOTO 900
  147.             MPTVAL = IVAEP
  148.             MELVEP = IVAL(1)
  149.           ENDIF
  150.         ENDIF
  151.  
  152.         IF (ISUP.EQ.1) NIPO = NBN1
  153.         IF (ISUP.EQ.5) NIPO = NBPGAU
  154.         NPPO = NIPO * NBELE1
  155.  
  156.         SEGINI MWRK1
  157.         IF (ISUP.EQ.5) THEN
  158.           SEGINI IPPO
  159.           NBPTS5 = NBPTS
  160.           NBPTS  = NBPTS + NPPO
  161.           SEGADJ,MCOORD
  162.           IF (MFR.EQ.5) SEGINI MWRK2
  163.         ENDIF
  164.  
  165. *       Listes de composantes attendues
  166.         CALL IDVEC2(IMODEL,1,IDIM,0,CMOT,MOCOMP,NCOMP,
  167.      &              NLIST,IER1)
  168.         IF (IER1.NE.0) GOTO 900
  169. c*        IF (IERR.NE.0) GOTO 900
  170.  
  171.         IF (NMO.NE.0) THEN
  172.           IF ((CMOT.EQ.'    '.AND.LMOT1.NE.0.AND.NLIST.NE.NMO).OR.
  173.      &        (CMOT.NE.'    '.AND.NMO.NE.1)) GOTO 900
  174.         ENDIF
  175.  
  176.         IF (CMOT.EQ.'    ') THEN
  177.           NVEC = NLIST * 2
  178.         ELSE
  179.           NVEC = 2
  180.         ENDIF
  181.         ID = 1
  182.         SEGINI MVECTE
  183.  
  184.         DO i = 1, NVEC
  185.           IGEOV(i) = 0
  186.           AMPF(i)  = AMP
  187.         ENDDO
  188.  
  189. *     Boucle sur les composantes
  190.         DO 150 IC = 1, NLIST
  191.  
  192.           NOMID = MOCOMP(IC)
  193.           IF (CMOT.NE.'    '.AND.LESOBL(1).NE.CMOT) GOTO 151
  194.           IC2 = IC
  195.           IF (CMOT.EQ.LESOBL(1)) IC2 = 1
  196.           NOCOVE(IC2,1) = LESOBL(1)
  197.           IF (LMOT1.EQ.0) THEN
  198.             NOCOUL(IC2) = IC2+1
  199.           ELSE
  200.             ICOUL=IDCOUL+1
  201.             CALL PLACE(NCOUL,NBCOUL,ICOUL,MOTS(IC2))
  202.             NOCOUL(IC2) = ICOUL-1
  203.           ENDIF
  204.  
  205. *       Creation du MCHPOI puis du MSOUPO et du MPOVAL
  206.           NAT = 2
  207.           NSOUPO = 1
  208.           SEGINI MCHPOI
  209.           ICHPO(IC2) = MCHPOI
  210.           MTYPOI = 'VECTEUR '
  211.           MOCHDE = 'CONTRAINTES PRINCIPALES'
  212.           IFOPOI = IFOUR
  213.           JATTRI(1) = 2
  214.           JATTRI(2) = 0
  215.           NC = IDIMP1
  216.           SEGINI MSOUPO
  217.           IPCHP(1) = MSOUPO
  218.           NOCOMP(1) = 'SIPX'
  219.           NOCOMP(2) = 'SIPY'
  220.           IF (IDIM.EQ.3) NOCOMP(3) = 'SIPZ'
  221.           NOCOMP(IDIMP1) = 'SIGN'
  222.  
  223.           N = NIPO * NBELE1
  224.           SEGINI MPOVAL
  225.           IPOVAL = MPOVAL
  226.  
  227.           NBNN   = 1
  228.           NBELEM = N
  229.           NBSOUS = 0
  230.           NBREF = 0
  231.           SEGINI IPT1
  232.           IGEOC = IPT1
  233.           IPT1.ITYPEL = 1
  234.  
  235.           CALL KOMCHA(MCHA1,IPMAIL,CONM,MOCOMP(IC),
  236.      &                MOTYR8,1,INFOS,3,IVACOM)
  237.           IF (IERR.NE.0) GOTO 900
  238.  
  239.           IPO = 0
  240.  
  241. *       Boucle sur les elements
  242.           DO 200 IEL = 1, NBELE1
  243.  
  244.             CALL DOXE(XCOOR,IDIM,NBN1,NUM,IEL,XEL)
  245.  
  246. c*            IF (ISUP.EQ.5.AND.MFR.EQ.5) THEN
  247.             IF (MELVEP.NE.0) THEN
  248.               MELVAL = MELVEP
  249.               DO IP = 1,NBN1
  250.                 IPMN=MIN(IP ,VELCHE(/1))
  251.                 IEMN=MIN(IEL,VELCHE(/2))
  252.                 TH(IP)=VELCHE(IPMN,IEMN)
  253.               ENDDO
  254.               CALL CQ8LOC(XEL,NBN1,MINTE1.SHPTOT,TXR,IRR)
  255.             ENDIF
  256.  
  257.             MPTVAL = IVACOM
  258. *         Boucle sur les points supports
  259.             DO 300 IPSU = 1,NIPO
  260.               IPO = IPO + 1
  261.  
  262.               MELVAL = IVAL(1)
  263.               IPMN = MIN(IPSU,VELCHE(/1))
  264.               IEMN = MIN(IEL ,VELCHE(/2))
  265.               SMWW = VELCHE(IPMN,IEMN)
  266.               IF (SMWW.GE.0.D0) VPOCHA(IPO,IDIMP1) = 0.D0
  267.               IF (SMWW.LT.0.D0) VPOCHA(IPO,IDIMP1) = 1.D0
  268.               SMAX = MAX(SMAX, ABS(SMWW))
  269.  
  270.               DO I1 = 1, IDIM
  271.                 MELVAL = IVAL(1+I1)
  272.                 IPMN = MIN(IPSU,VELCHE(/1))
  273.                 IEMN = MIN(IEL ,VELCHE(/2))
  274.                 VPOCHA(IPO,I1) = SMWW * VELCHE(IPMN,IEMN)
  275.               ENDDO
  276.  
  277.               IF (ISUP.EQ.5) THEN
  278.                 IF (IC2.EQ.1) THEN
  279.                   IF (MFR.EQ.5) THEN
  280.                     Z = 0.5D0*DZEGAU(IPSU)
  281.                     DO I2 = 1,IDIM
  282.                       r_z = 0.D0
  283.                       DO IL = 1,NBN1
  284.                         r_z = r_z +(SHPTOT(1,IL,IPSU)*
  285.      &                       XEL(I2,IL)+Z*TXR(I2,3,IL)*TH(IL))
  286.                       ENDDO
  287.                       XIGAU(I2) = r_z
  288.                     ENDDO
  289.                   ELSE
  290.                     DO I2 = 1,IDIM
  291.                       r_z = 0.D0
  292.                       DO IL = 1,NBN1
  293.                         r_z = r_z + (SHPTOT(1,IL,IPSU)*XEL(I2,IL))
  294.                       ENDDO
  295.                       XIGAU(I2) = r_z
  296.                     ENDDO
  297.                   ENDIF
  298. *               Le pdi est reference dans MCOORD (PROVISOIRE)
  299.                   IREF = NBPTS5 + IPO
  300.                   IPPO(IPO) = IREF
  301.                   IPT1.NUM(1,IPO) = IREF
  302.                   IREF = (IREF-1)*IDIMP1
  303.                   XCOOR(IREF+1) = XIGAU(1)
  304.                   XCOOR(IREF+2) = XIGAU(2)
  305.                   IF (IDIM.EQ.3) XCOOR(IREF+3) = XIGAU(3)
  306.                   XCOOR(IREF+IDIMP1) = 0.D0
  307.                 ELSE
  308.                   IPT1.NUM(1,IPO) = IPPO(IPO)
  309.                 ENDIF
  310.               ELSE
  311.                 IPT1.NUM(1,IPO) = NUM(IPSU,IEL)
  312.               ENDIF
  313.  300        CONTINUE
  314.  200      CONTINUE
  315.           SEGDES MPOVAL,MSOUPO,MCHPOI,IPT1
  316.  151      CONTINUE
  317.  
  318.  150    CONTINUE
  319.  
  320.         IC1 = 0
  321.         DO 500 IC2 = NLIST+1,NLIST*2
  322.           IC1 = IC1 + 1
  323.           NOMID = MOCOMP(IC1)
  324.           IF (CMOT.NE.'    '.AND.CMOT.NE.LESOBL(1)) GOTO 501
  325.           IF (CMOT.EQ.LESOBL(1)) THEN
  326.             IC3 = 2
  327.             IC1 = 1
  328.             MCHPOI = ICHPO(1)
  329.           ELSE
  330.             IC3 = IC2
  331.             MCHPOI = ICHPO(IC1)
  332.           ENDIF
  333.           NOCOVE(IC3,1) = LESOBL(1)
  334.           IF (LMOT1.EQ.0) THEN
  335.             NOCOUL(IC3) = IC1 + 1
  336.           ELSE
  337.             ICOUL=IDCOUL+1
  338.             CALL PLACE(NCOUL,NBCOUL,ICOUL,MOTS(IC1))
  339.             NOCOUL(IC3) = ICOUL-1
  340.           ENDIF
  341.           CALL MUCHPO(MCHPOI,-1.D0,ICHP2,1)
  342.           ICHPO(IC3) = ICHP2
  343.  501      CONTINUE
  344.  500    CONTINUE
  345.  
  346. *        Desactivation des segments de la zone ISOU
  347.         MPTVAL = IVACOM
  348.         SEGSUP MPTVAL,MWRK1
  349.         IF (ISUP.EQ.5) SEGSUP IPPO
  350.         IF (ISUP.EQ.5.AND.MFR.EQ.5) SEGSUP MWRK2
  351.         DO i = 1, 3
  352.           nomid = MOCOMP(i)
  353.           IF (nomid.NE.0) SEGSUP,nomid
  354.         ENDDO
  355.  
  356.         IF (MVECT0.EQ.0) THEN
  357.           MVECT0 = MVECTE
  358.         ELSE
  359.           CALL FUSVEC(MVECT0,MVECTE,MVECT1)
  360.           MVECT0 = MVECT1
  361.         ENDIF
  362.  
  363.  100  CONTINUE
  364.  
  365.  900  CONTINUE
  366.       IF (LMOT1.NE.0) SEGDES,MLMOTS
  367.       notype = MOTYR8
  368.       SEGSUP,notype
  369.  
  370.       SEGACT,mcoord*NOMOD
  371.  
  372. C      RETURN
  373.       END
  374.  
  375.  
  376.  
  377.  

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