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    OF166741  25/02/21    21:19:04     12166          
  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.8) then
  117.           write(ioimp,*) 'VECTE2 : infmod(/1) < 8'
  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.         IPMINT = INFMOD(7)
  127. c*        MINTE1 = INFELE(12)
  128.         MINTE1 = INFMOD(8)
  129.  
  130.         MINTE = IPMINT
  131.         NBPGAU = minte.POIGAU(/1)
  132.  
  133. *       Cas des coques epaisses : epaisseur (excentrement)
  134.         IF (MFR.EQ.5) THEN
  135.           IF (MCHA2.EQ.0) THEN
  136.             MOTERR(1:16) = 'CARACTERISTIQUES'
  137.             CALL ERREUR(565)
  138.             GOTO 900
  139.           ENDIF
  140.           IF (ISUP.EQ.5) THEN
  141.             NBROBL = 1
  142.             NBRFAC = 0
  143.             SEGINI NOMID
  144.             LESOBL(1) = 'EPAI'
  145.             MOEP = NOMID
  146.             CALL KOMCHA(MCHA2,IPMAIL,CONM,MOEP,
  147.      &                  MOTYR8,1,INFOS,3,IVAEP)
  148.             SEGSUP,NOMID
  149.             IF (IERR.NE.0) GOTO 900
  150.             MPTVAL = IVAEP
  151.             MELVEP = IVAL(1)
  152.           ENDIF
  153.         ENDIF
  154.  
  155.         IF (ISUP.EQ.1) NIPO = NBN1
  156.         IF (ISUP.EQ.5) NIPO = NBPGAU
  157.         NPPO = NIPO * NBELE1
  158.  
  159.         SEGINI MWRK1
  160.         IF (ISUP.EQ.5) THEN
  161.           SEGINI IPPO
  162.           NBPTS5 = NBPTS
  163.           NBPTS  = NBPTS + NPPO
  164.           SEGADJ,MCOORD
  165.           IF (MFR.EQ.5) SEGINI MWRK2
  166.         ENDIF
  167.  
  168. *       Listes de composantes attendues
  169.         CALL IDVEC2(IMODEL,1,IDIM,0,CMOT,MOCOMP,NCOMP,
  170.      &              NLIST,IER1)
  171.         IF (IER1.NE.0) GOTO 900
  172. c*        IF (IERR.NE.0) GOTO 900
  173.  
  174.         IF (NMO.NE.0) THEN
  175.           IF ((CMOT.EQ.'    '.AND.LMOT1.NE.0.AND.NLIST.NE.NMO).OR.
  176.      &        (CMOT.NE.'    '.AND.NMO.NE.1)) GOTO 900
  177.         ENDIF
  178.  
  179.         IF (CMOT.EQ.'    ') THEN
  180.           NVEC = NLIST * 2
  181.         ELSE
  182.           NVEC = 2
  183.         ENDIF
  184.         ID = 1
  185.         SEGINI MVECTE
  186.  
  187.         DO i = 1, NVEC
  188.           IGEOV(i) = 0
  189.           AMPF(i)  = AMP
  190.         ENDDO
  191.  
  192. *     Boucle sur les composantes
  193.         DO 150 IC = 1, NLIST
  194.  
  195.           NOMID = MOCOMP(IC)
  196.           IF (CMOT.NE.'    '.AND.LESOBL(1).NE.CMOT) GOTO 151
  197.           IC2 = IC
  198.           IF (CMOT.EQ.LESOBL(1)) IC2 = 1
  199.           NOCOVE(IC2,1) = LESOBL(1)
  200.           IF (LMOT1.EQ.0) THEN
  201.             NOCOUL(IC2) = IC2+1
  202.           ELSE
  203.             ICOUL=IDCOUL+1
  204.             CALL PLACE(NCOUL,NBCOUL,ICOUL,MOTS(IC2))
  205.             NOCOUL(IC2) = ICOUL-1
  206.           ENDIF
  207.  
  208. *       Creation du MCHPOI puis du MSOUPO et du MPOVAL
  209.           NAT = 2
  210.           NSOUPO = 1
  211.           SEGINI MCHPOI
  212.           ICHPO(IC2) = MCHPOI
  213.           MTYPOI = 'VECTEUR '
  214.           MOCHDE = 'CONTRAINTES PRINCIPALES'
  215.           IFOPOI = IFOUR
  216.           JATTRI(1) = 2
  217.           JATTRI(2) = 0
  218.           NC = IDIMP1
  219.           SEGINI MSOUPO
  220.           IPCHP(1) = MSOUPO
  221.           NOCOMP(1) = 'SIPX'
  222.           NOCOMP(2) = 'SIPY'
  223.           IF (IDIM.EQ.3) NOCOMP(3) = 'SIPZ'
  224.           NOCOMP(IDIMP1) = 'SIGN'
  225.  
  226.           N = NIPO * NBELE1
  227.           SEGINI MPOVAL
  228.           IPOVAL = MPOVAL
  229.  
  230.           NBNN   = 1
  231.           NBELEM = N
  232.           NBSOUS = 0
  233.           NBREF = 0
  234.           SEGINI IPT1
  235.           IGEOC = IPT1
  236.           IPT1.ITYPEL = 1
  237.  
  238.           CALL KOMCHA(MCHA1,IPMAIL,CONM,MOCOMP(IC),
  239.      &                MOTYR8,1,INFOS,3,IVACOM)
  240.           IF (IERR.NE.0) GOTO 900
  241.  
  242.           IPO = 0
  243.  
  244. *       Boucle sur les elements
  245.           DO 200 IEL = 1, NBELE1
  246.  
  247.             CALL DOXE(XCOOR,IDIM,NBN1,NUM,IEL,XEL)
  248.  
  249. c*            IF (ISUP.EQ.5.AND.MFR.EQ.5) THEN
  250.             IF (MELVEP.NE.0) THEN
  251.               MELVAL = MELVEP
  252.               DO IP = 1,NBN1
  253.                 IPMN=MIN(IP ,VELCHE(/1))
  254.                 IEMN=MIN(IEL,VELCHE(/2))
  255.                 TH(IP)=VELCHE(IPMN,IEMN)
  256.               ENDDO
  257.               CALL CQ8LOC(XEL,NBN1,MINTE1.SHPTOT,TXR,IRR)
  258.             ENDIF
  259.  
  260.             MPTVAL = IVACOM
  261. *         Boucle sur les points supports
  262.             DO 300 IPSU = 1,NIPO
  263.               IPO = IPO + 1
  264.  
  265.               MELVAL = IVAL(1)
  266.               IPMN = MIN(IPSU,VELCHE(/1))
  267.               IEMN = MIN(IEL ,VELCHE(/2))
  268.               SMWW = VELCHE(IPMN,IEMN)
  269.               IF (SMWW.GE.0.D0) VPOCHA(IPO,IDIMP1) = 0.D0
  270.               IF (SMWW.LT.0.D0) VPOCHA(IPO,IDIMP1) = 1.D0
  271.               SMAX = MAX(SMAX, ABS(SMWW))
  272.  
  273.               DO I1 = 1, IDIM
  274.                 MELVAL = IVAL(1+I1)
  275.                 IPMN = MIN(IPSU,VELCHE(/1))
  276.                 IEMN = MIN(IEL ,VELCHE(/2))
  277.                 VPOCHA(IPO,I1) = SMWW * VELCHE(IPMN,IEMN)
  278.               ENDDO
  279.  
  280.               IF (ISUP.EQ.5) THEN
  281.                 IF (IC2.EQ.1) THEN
  282.                   IF (MFR.EQ.5) THEN
  283.                     Z = 0.5D0*DZEGAU(IPSU)
  284.                     DO I2 = 1,IDIM
  285.                       r_z = 0.D0
  286.                       DO IL = 1,NBN1
  287.                         r_z = r_z +(SHPTOT(1,IL,IPSU)*
  288.      &                       XEL(I2,IL)+Z*TXR(I2,3,IL)*TH(IL))
  289.                       ENDDO
  290.                       XIGAU(I2) = r_z
  291.                     ENDDO
  292.                   ELSE
  293.                     DO I2 = 1,IDIM
  294.                       r_z = 0.D0
  295.                       DO IL = 1,NBN1
  296.                         r_z = r_z + (SHPTOT(1,IL,IPSU)*XEL(I2,IL))
  297.                       ENDDO
  298.                       XIGAU(I2) = r_z
  299.                     ENDDO
  300.                   ENDIF
  301. *               Le pdi est reference dans MCOORD (PROVISOIRE)
  302.                   IREF = NBPTS5 + IPO
  303.                   IPPO(IPO) = IREF
  304.                   IPT1.NUM(1,IPO) = IREF
  305.                   IREF = (IREF-1)*IDIMP1
  306.                   XCOOR(IREF+1) = XIGAU(1)
  307.                   XCOOR(IREF+2) = XIGAU(2)
  308.                   IF (IDIM.EQ.3) XCOOR(IREF+3) = XIGAU(3)
  309.                   XCOOR(IREF+IDIMP1) = 0.D0
  310.                 ELSE
  311.                   IPT1.NUM(1,IPO) = IPPO(IPO)
  312.                 ENDIF
  313.               ELSE
  314.                 IPT1.NUM(1,IPO) = NUM(IPSU,IEL)
  315.               ENDIF
  316.  300        CONTINUE
  317.  200      CONTINUE
  318.           SEGDES MPOVAL,MSOUPO,MCHPOI,IPT1
  319.  151      CONTINUE
  320.  
  321.  150    CONTINUE
  322.  
  323.         IC1 = 0
  324.         DO 500 IC2 = NLIST+1,NLIST*2
  325.           IC1 = IC1 + 1
  326.           NOMID = MOCOMP(IC1)
  327.           IF (CMOT.NE.'    '.AND.CMOT.NE.LESOBL(1)) GOTO 501
  328.           IF (CMOT.EQ.LESOBL(1)) THEN
  329.             IC3 = 2
  330.             IC1 = 1
  331.             MCHPOI = ICHPO(1)
  332.           ELSE
  333.             IC3 = IC2
  334.             MCHPOI = ICHPO(IC1)
  335.           ENDIF
  336.           NOCOVE(IC3,1) = LESOBL(1)
  337.           IF (LMOT1.EQ.0) THEN
  338.             NOCOUL(IC3) = IC1 + 1
  339.           ELSE
  340.             ICOUL=IDCOUL+1
  341.             CALL PLACE(NCOUL,NBCOUL,ICOUL,MOTS(IC1))
  342.             NOCOUL(IC3) = ICOUL-1
  343.           ENDIF
  344.           CALL MUCHPO(MCHPOI,-1.D0,ICHP2,1)
  345.           ICHPO(IC3) = ICHP2
  346.  501      CONTINUE
  347.  500    CONTINUE
  348.  
  349. *        Desactivation des segments de la zone ISOU
  350.         MPTVAL = IVACOM
  351.         SEGSUP MPTVAL,MWRK1
  352.         IF (ISUP.EQ.5) SEGSUP IPPO
  353.         IF (ISUP.EQ.5.AND.MFR.EQ.5) SEGSUP MWRK2
  354.         DO i = 1, 3
  355.           nomid = MOCOMP(i)
  356.           IF (nomid.NE.0) SEGSUP,nomid
  357.         ENDDO
  358.  
  359.         IF (MVECT0.EQ.0) THEN
  360.           MVECT0 = MVECTE
  361.         ELSE
  362.           CALL FUSVEC(MVECT0,MVECTE,MVECT1)
  363.           MVECT0 = MVECT1
  364.         ENDIF
  365.  
  366.  100  CONTINUE
  367.  
  368.  900  CONTINUE
  369.       IF (LMOT1.NE.0) SEGDES,MLMOTS
  370.       notype = MOTYR8
  371.       SEGSUP,notype
  372.  
  373.       SEGACT,mcoord*NOMOD
  374.  
  375. C      RETURN
  376.       END
  377.  
  378.  
  379.  

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