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  26/06/04    21:15:42     12563          
  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.       XIGAU(1) = 0.D0
  59.       XIGAU(2) = 0.D0
  60.       XIGAU(3) = 0.D0
  61.  
  62.       IDIMP1 = IDIM + 1
  63.  
  64.       MCHELM = MCHA1
  65.  
  66.       NSC = INFCHE(/1)
  67.       IF (NSC.EQ.0) THEN
  68.         write(ioimp,*) 'MCHELM (MCHA1) VIDE'
  69.         call erreur(21)
  70.         return
  71.       ENDIF
  72. *     Verification du support : noeuds ou pdi ?
  73.       ISUP = INFCHE(1,6)
  74.       DO ISC=2,NSC
  75.         ISUP1 = INFCHE(ISC,6)
  76.         IF (ISUP1.NE.ISUP) ISUP = 0
  77.       ENDDO
  78. *     si ISUP = 1 : MCHAML aux noeuds
  79. *     si ISUP = 5 : MCHAML aux pdi
  80.       IF (ISUP.NE.1.AND.ISUP.NE.5) THEN
  81.         call erreur(609)
  82.         RETURN
  83.       ENDIF
  84.  
  85.       NMO = 0
  86.       IF (LMOT1.NE.0) THEN
  87.         MLMOTS = LMOT1
  88.         SEGACT MLMOTS
  89.         NMO = MOTS(/2)
  90.       ENDIF
  91.  
  92.       SEGACT,mcoord*MOD
  93.  
  94.       nbtype = 1
  95.       SEGINI,notype
  96.       notype.TYPE(1) = 'REAL*8'
  97.       MOTYR8 = notype
  98.  
  99.       MMODEL = MOD1
  100.       NSOUS = KMODEL(/1)
  101.  
  102. *     Boucle sur les zones du MCHAML
  103.  
  104.       DO 100 ISOU = 1,NSOUS
  105.  
  106.         IVACOM = 0
  107.         MELVEP = 0
  108.  
  109.         IMODEL = KMODEL(ISOU)
  110.  
  111.         CONM = imodel.CONMOD
  112.         MELE = imodel.NEFMOD
  113.  
  114.         IPMAIL = imodel.IMAMOD
  115.         MELEME = imodel.IMAMOD
  116.         NBN1   = meleme.NUM(/1)
  117.         NBELE1 = meleme.NUM(/2)
  118.  
  119.         if (infmod(/1).lt.7) then
  120.           write(ioimp,*) 'VECTE2 : infmod(/1) < 7'
  121.           call erreur(5)
  122.         ENDIF
  123.  
  124.         CALL IDENT(IPMAIL,CONM,MCHA1,0,INFOS,IRET)
  125.         IF (IRET.EQ.0) GOTO 900
  126.  
  127.         NBGS   = INFELE(4)
  128.         MFR    = INFELE(13)
  129.         MINTE1 = INFMOD(3)
  130.         MINTE  = INFMOD(7)
  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(1,IDIM,MFR,CMOT,if3,MOCOMP,NCOMP,NLIST,IER1)
  170.         IF (IER1.NE.0) GOTO 900
  171. c*        IF (IERR.NE.0) GOTO 900
  172.  
  173.         IF (NMO.NE.0) THEN
  174.           IF ((CMOT.EQ.'    '.AND.LMOT1.NE.0.AND.NLIST.NE.NMO).OR.
  175.      &        (CMOT.NE.'    '.AND.NMO.NE.1)) GOTO 900
  176.         ENDIF
  177.  
  178.         IF (CMOT.EQ.'    ') THEN
  179.           NVEC = NLIST * 2
  180.         ELSE
  181.           NVEC = 2
  182.         ENDIF
  183.         ID = 1
  184.         SEGINI MVECTE
  185.  
  186.         DO i = 1, NVEC
  187.           IGEOV(i) = 0
  188.           AMPF(i)  = AMP
  189.         ENDDO
  190.  
  191. *     Boucle sur les composantes
  192.         DO 150 IC = 1, NLIST
  193.  
  194.           NOMID = MOCOMP(IC)
  195.           IF (CMOT.NE.'    '.AND.LESOBL(1).NE.CMOT) GOTO 151
  196.           IC2 = IC
  197.           IF (CMOT.EQ.LESOBL(1)) IC2 = 1
  198.           NOCOVE(IC2,1) = LESOBL(1)
  199.           IF (LMOT1.EQ.0) THEN
  200.             NOCOUL(IC2) = IC2+1
  201.           ELSE
  202.             ICOUL=IDCOUL+1
  203.             CALL PLACE(NCOUL,NBCOUL,ICOUL,MOTS(IC2))
  204.             NOCOUL(IC2) = ICOUL-1
  205.           ENDIF
  206.  
  207. *       Creation du MCHPOI puis du MSOUPO et du MPOVAL
  208.           NAT = 2
  209.           NSOUPO = 1
  210.           SEGINI MCHPOI
  211.           ICHPO(IC2) = MCHPOI
  212.           MTYPOI = 'VECTEUR '
  213.           MOCHDE = 'CONTRAINTES PRINCIPALES'
  214.           IFOPOI = IFOUR
  215.           JATTRI(1) = 2
  216.           JATTRI(2) = 0
  217.           NC = IDIMP1
  218.           SEGINI MSOUPO
  219.           IPCHP(1) = MSOUPO
  220.           NOCOMP(1) = 'SIPX'
  221.           NOCOMP(2) = 'SIPY'
  222.           IF (IDIM.EQ.3) NOCOMP(3) = 'SIPZ'
  223.           NOCOMP(IDIMP1) = 'SIGN'
  224.  
  225.           N = NIPO * NBELE1
  226.           SEGINI MPOVAL
  227.           IPOVAL = MPOVAL
  228.  
  229.           NBNN   = 1
  230.           NBELEM = N
  231.           NBSOUS = 0
  232.           NBREF = 0
  233.           SEGINI IPT1
  234.           IGEOC = IPT1
  235.           IPT1.ITYPEL = 1
  236.  
  237.           CALL KOMCHA(MCHA1,IPMAIL,CONM,MOCOMP(IC),
  238.      &                MOTYR8,1,INFOS,3,IVACOM)
  239.           IF (IERR.NE.0) GOTO 900
  240.  
  241.           IPO = 0
  242.  
  243. *       Boucle sur les elements
  244.           DO 200 IEL = 1, NBELE1
  245.  
  246.             CALL DOXE(XCOOR,IDIM,NBN1,NUM,IEL,XEL)
  247.  
  248. c*            IF (ISUP.EQ.5.AND.MFR.EQ.5) THEN
  249.             IF (MELVEP.NE.0) THEN
  250.               MELVAL = MELVEP
  251.               DO IP = 1,NBN1
  252.                 IPMN=MIN(IP ,VELCHE(/1))
  253.                 IEMN=MIN(IEL,VELCHE(/2))
  254.                 TH(IP)=VELCHE(IPMN,IEMN)
  255.               ENDDO
  256.               CALL CQ8LOC(XEL,NBN1,MINTE1.SHPTOT,TXR,IRR)
  257.             ENDIF
  258.  
  259.             MPTVAL = IVACOM
  260. *         Boucle sur les points supports
  261.             DO 300 IPSU = 1,NIPO
  262.               IPO = IPO + 1
  263.  
  264.               MELVAL = IVAL(1)
  265.               IPMN = MIN(IPSU,VELCHE(/1))
  266.               IEMN = MIN(IEL ,VELCHE(/2))
  267.               SMWW = VELCHE(IPMN,IEMN)
  268.               IF (SMWW.GE.0.D0) VPOCHA(IPO,IDIMP1) = 0.D0
  269.               IF (SMWW.LT.0.D0) VPOCHA(IPO,IDIMP1) = 1.D0
  270.               SMAX = MAX(SMAX, ABS(SMWW))
  271.  
  272.               DO I1 = 1, IDIM
  273.                 MELVAL = IVAL(1+I1)
  274.                 IPMN = MIN(IPSU,VELCHE(/1))
  275.                 IEMN = MIN(IEL ,VELCHE(/2))
  276.                 VPOCHA(IPO,I1) = SMWW * VELCHE(IPMN,IEMN)
  277.               ENDDO
  278.  
  279.               IF (ISUP.EQ.5) THEN
  280.                 IF (IC2.EQ.1) THEN
  281.                   IF (MFR.EQ.5) THEN
  282.                     Z = 0.5D0*DZEGAU(IPSU)
  283.                     DO I2 = 1,IDIM
  284.                       r_z = 0.D0
  285.                       DO IL = 1,NBN1
  286.                         r_z = r_z +(SHPTOT(1,IL,IPSU)*
  287.      &                       XEL(I2,IL)+Z*TXR(I2,3,IL)*TH(IL))
  288.                       ENDDO
  289.                       XIGAU(I2) = r_z
  290.                     ENDDO
  291.                   ELSE
  292.                     DO I2 = 1,IDIM
  293.                       r_z = 0.D0
  294.                       DO IL = 1,NBN1
  295.                         r_z = r_z + (SHPTOT(1,IL,IPSU)*XEL(I2,IL))
  296.                       ENDDO
  297.                       XIGAU(I2) = r_z
  298.                     ENDDO
  299.                   ENDIF
  300. *               Le pdi est reference dans MCOORD (PROVISOIRE)
  301.                   IREF = NBPTS5 + IPO
  302.                   IPPO(IPO) = IREF
  303.                   IPT1.NUM(1,IPO) = IREF
  304.                   IREF = (IREF-1)*IDIMP1
  305.                   XCOOR(IREF+1) = XIGAU(1)
  306.                   XCOOR(IREF+2) = XIGAU(2)
  307.                   XCOOR(IREF+3) = XIGAU(3)
  308.                   XCOOR(IREF+IDIMP1) = 0.D0
  309.                 ELSE
  310.                   IPT1.NUM(1,IPO) = IPPO(IPO)
  311.                 ENDIF
  312.               ELSE
  313.                 IPT1.NUM(1,IPO) = NUM(IPSU,IEL)
  314.               ENDIF
  315.  300        CONTINUE
  316.  200      CONTINUE
  317.           SEGDES MPOVAL,MSOUPO,MCHPOI,IPT1
  318.  151      CONTINUE
  319.  
  320.  150    CONTINUE
  321.  
  322.         IC1 = 0
  323.         DO 500 IC2 = NLIST+1,NLIST*2
  324.           IC1 = IC1 + 1
  325.           NOMID = MOCOMP(IC1)
  326.           IF (CMOT.NE.'    '.AND.CMOT.NE.LESOBL(1)) GOTO 501
  327.           IF (CMOT.EQ.LESOBL(1)) THEN
  328.             IC3 = 2
  329.             IC1 = 1
  330.             MCHPOI = ICHPO(1)
  331.           ELSE
  332.             IC3 = IC2
  333.             MCHPOI = ICHPO(IC1)
  334.           ENDIF
  335.           NOCOVE(IC3,1) = LESOBL(1)
  336.           IF (LMOT1.EQ.0) THEN
  337.             NOCOUL(IC3) = IC1 + 1
  338.           ELSE
  339.             ICOUL=IDCOUL+1
  340.             CALL PLACE(NCOUL,NBCOUL,ICOUL,MOTS(IC1))
  341.             NOCOUL(IC3) = ICOUL-1
  342.           ENDIF
  343.           CALL MUCHPO(MCHPOI,-1.D0,ICHP2,1)
  344.           ICHPO(IC3) = ICHP2
  345.  501      CONTINUE
  346.  500    CONTINUE
  347.  
  348. *        Desactivation des segments de la zone ISOU
  349.         MPTVAL = IVACOM
  350.         SEGSUP MPTVAL,MWRK1
  351.         IF (ISUP.EQ.5) SEGSUP IPPO
  352.         IF (ISUP.EQ.5.AND.MFR.EQ.5) SEGSUP MWRK2
  353.         DO i = 1, 3
  354.           nomid = MOCOMP(i)
  355.           IF (nomid.NE.0) SEGSUP,nomid
  356.         ENDDO
  357.  
  358.         IF (MVECT0.EQ.0) THEN
  359.           MVECT0 = MVECTE
  360.         ELSE
  361.           CALL FUSVEC(MVECT0,MVECTE,MVECT1)
  362.           MVECT0 = MVECT1
  363.         ENDIF
  364.  
  365.  100  CONTINUE
  366.  
  367.  900  CONTINUE
  368.       IF (LMOT1.NE.0) SEGDES,MLMOTS
  369.       notype = MOTYR8
  370.       SEGSUP,notype
  371.  
  372.       SEGACT,mcoord*NOMOD
  373.  
  374. C      RETURN
  375.       END
  376.  
  377.  
  378.  

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