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

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