Télécharger la plaquette Cast3M


fr en

Télécharger rcdep2.eso

Retour à la liste

Numérotation des lignes : 

rcdep2

  1. C RCDEP2    SOURCE    CB215821  20/11/25    13:38:34     10792          
  2.       SUBROUTINE RCDEP2(IBAS,KTRAV,KCPR,KCHAR,XTEMP,ICHDE,ITRES,IPOS,
  3.      &                  ITLIA,ITYP)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. *                                                                    *
  8. *     Recombine le chpoint ICHPT en déplacement ou en réaction.      *
  9. *                                                                    *
  10. *     Paramètres:                                                    *
  11. *                                                                    *
  12. * e   IBAS    table représentant une base modale                     *
  13. * e   KCHAR   chargement de la structure                             *
  14. * e   XTEMP   temps de recombinaison                                 *
  15. * e   ITRES   table résultat issue de l'opérateur DYNE               *
  16. * e   IPOS    position de XTEMP dans le listreel des temps           *
  17. * e   ITLIA   table des liaisons                                     *
  18. * e   ITYP    = 0 , on recombine les déplacements nature diffuse     *              *
  19. *             = 1 , on recombine les vitesses                        *
  20. *             =-1 , on recombine les accélérations                   *
  21. *             = 2 , on recombine les réactions.   nature discrete    *               *
  22. * -   RIGIDE  Vrai si l'on a un corps rigide,faux sinon              *
  23. *                                                                    *
  24. *     Auteur, date de création:                                      *
  25. *                                                                    *
  26. *     Lionel VIVAN, le 26 avril 1990.                                *
  27. *                                                                    *
  28. *--------------------------------------------------------------------*
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC SMCOORD
  33. -INC SMCHPOI
  34. -INC SMELEME
  35.       SEGMENT ICPR(nbpts)
  36.       SEGMENT TRAV(NPOIN)*D
  37.       LOGICAL L0,L1,RIGIDE
  38.       CHARACTER*8 TYPRET,MORIGI,CMOT,CHARRE
  39.       REAL*8 XAXROT(3),XROTA(2,6)
  40. *
  41.  
  42.       TRAV = KTRAV
  43.       ICPR = KCPR
  44.       RIGIDE =.FALSE.
  45. *
  46.       CALL ACCTAB(IBAS,'MOT',I0,X0,'MODES',L0,IP0,
  47.      &               'TABLE',I1,X1,' ',L1,IBBB)
  48. *
  49. *     initialisation du CHPOINT
  50. *
  51.       N1 = 1
  52.       CALL ACCTAB(IBBB,'ENTIER',N1,X0,' ',L0,IP0,
  53.      &                  'TABLE',I1,X1,' ',L1,ITBMOD)
  54.       TYPRET = ' '
  55.       IF (ITYP.EQ.0.OR.ITYP.EQ.1.OR.ITYP.EQ.-1) THEN
  56.          CALL ACCTAB(ITBMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  57.      &                     TYPRET,I1,X1,CHARRE,L1,ICHD1)
  58.       ELSE IF (ITYP.EQ.2) THEN
  59.          CALL ACCTAB(ITBMOD,'MOT',I0,X0,'REACTION_MODALE',L0,IP0,
  60.      &                     TYPRET,I1,X1,CHARRE,L1,ICHD1)
  61.       ENDIF
  62.       IF (ICHD1.EQ.0 .OR. TYPRET.NE.'CHPOINT ') THEN
  63.          MOTERR(1:8) = 'RCDEP2  '
  64.          INTERR(1) = N1
  65.          CALL ERREUR(169)
  66.          RETURN
  67.       ENDIF
  68.       MCHPO1 = ICHD1
  69.       SEGACT MCHPO1
  70.       NSOUPO = MCHPO1.IPCHP(/1)
  71.       NAT=MAX(MCHPO1.JATTRI(/1),1)
  72.       SEGINI MCHPOI
  73.       ICHDE = MCHPOI
  74.       IFOPOI = MCHPO1.IFOPOI
  75.       MTYPOI = MCHPO1.MTYPOI
  76.       MOCHDE = '                      CHPOINT CREE PAR RCDEP2  '
  77.       IF ( ITYP .EQ. 0 .OR.ITYP.EQ.1.OR.ITYP.EQ.-1) THEN
  78.         JATTRI(1) = 1
  79.       ELSE IF ( ITYP .EQ. 2 ) THEN
  80.         JATTRI(1) = 2
  81.       ENDIF
  82.       DO 10 ISOU = 1,NSOUPO
  83.          MSOUP1 = MCHPO1.IPCHP(ISOU)
  84.          SEGACT MSOUP1
  85.          NC = MSOUP1.NOCOMP(/2)
  86.          SEGINI MSOUPO
  87.          IPCHP(ISOU) = MSOUPO
  88.          DO 12 IC = 1,NC
  89.             NOCOMP(IC) = MSOUP1.NOCOMP(IC)
  90.             NOHARM(IC) = MSOUP1.NOHARM(IC)
  91.  12      CONTINUE
  92.          IGEOC = MSOUP1.IGEOC
  93.          MELEME = IGEOC
  94.          SEGACT MELEME
  95.          N = NUM(/2)
  96.          SEGDES MELEME,MSOUP1
  97.          SEGINI MPOVAL
  98.          IPOVAL = MPOVAL
  99.          SEGDES MPOVAL
  100.          SEGDES MSOUPO
  101.  10   CONTINUE
  102.       SEGDES MCHPO1
  103. *
  104. *     boucle sur le nombre de modes
  105. *
  106.       IM = 0
  107.  20   CONTINUE
  108.       IM = IM + 1
  109.       TYPRET = ' '
  110.       CALL ACCTAB(IBBB,'ENTIER',IM,X0,' ',L0,IP0,
  111.      &                   TYPRET,I1,X1,CHARRE,L1,ITBMOD)
  112.       IF (ITBMOD.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
  113.          CALL ACCTAB(ITBMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
  114.      &                    'POINT',I1,X1,' ',L1,IPTR)
  115.          IF (ITYP.EQ.0.OR.ITYP.EQ.1.OR.ITYP.EQ.-1) THEN
  116.             CALL ACCTAB(ITBMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  117.      &                     'CHPOINT',I1,X1,' ',L1,ICHDI)
  118.             rigide = .false.
  119.             MORIGI = ' '
  120.             CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CORPS_RIGIDE',L0,IP0,
  121.      &                      MORIGI,I1,X1,CMOT,L1,IP1)
  122.             IF (IERR.NE.0) RETURN
  123.             IF (MORIGI.EQ.'MOT') THEN
  124.                 IF (CMOT(1:4).EQ.'VRAI') THEN
  125.                     RIGIDE =.TRUE.
  126.                 ENDIF
  127.             ENDIF
  128.           ELSE IF (ITYP.EQ.2) THEN
  129.             CALL ACCTAB(ITBMOD,'MOT',I0,X0,'REACTION_MODALE',L0,IP0,
  130.      &                     'CHPOINT',I1,X1,' ',L1,ICHDI)
  131.          ENDIF
  132.          IMODE = ICPR(IPTR)
  133.          IF (IMODE.EQ.0) THEN
  134. *
  135. *           on ne trouve pas la déformée modale
  136. *
  137.             MOTERR(1:8) = 'RCDEP2'
  138.             INTERR(1) = IM
  139.             CALL ERREUR(169)
  140.             RETURN
  141.          ENDIF
  142.          XVAL = TRAV(IMODE)
  143.          MCHPO1 = ICHDI
  144.          SEGACT MCHPO1
  145.          DO 22 ISOU = 1,NSOUPO
  146.             MSOUP1 = MCHPO1.IPCHP(ISOU)
  147.             MSOUPO = IPCHP(ISOU)
  148.             SEGACT MSOUP1,MSOUPO
  149.             MPOVA1 = MSOUP1.IPOVAL
  150.             MPOVAL = IPOVAL
  151.             SEGDES MSOUP1
  152.             SEGACT MPOVA1,MPOVAL*MOD
  153.             N  = MPOVA1.VPOCHA(/1)
  154.             NC = MPOVA1.VPOCHA(/2)
  155.             DO 24 IC = 1,NC
  156.                DO 26 IN = 1,N
  157.                   VPOCHA(IN,IC) = VPOCHA(IN,IC)
  158.      &                            + ( XVAL * MPOVA1.VPOCHA(IN,IC) )
  159.  26            CONTINUE
  160.  24         CONTINUE
  161.             SEGDES MPOVA1,MPOVAL
  162.             SEGDES MSOUP1,MSOUPO
  163.  22      CONTINUE
  164.          SEGDES MCHPO1
  165. *
  166. *     Prise en compte de la rotation des corps rigide
  167. *
  168.       IF ((ITYP.EQ.0.OR.ITYP.EQ.1.OR.ITYP.EQ.-1).AND.RIGIDE) THEN
  169.          CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CENTRE_DE_GRAVITE',L0,IP0,
  170.      &               'POINT',I1,X1,'  ',L1,ICDG)
  171.          IF (IERR.NE.0) RETURN
  172.          IF (ITYP.EQ.1.OR.ITYP.EQ.-1) THEN
  173. *  On récupère la valeur de la rotation
  174.              CALL RECANG(ITRES,IPOS,IPTR,XANGLE)
  175. *
  176.              IF (ITYP.EQ.-1) THEN
  177. *  On récupère la valeur de la vitesse angulaire
  178.                CALL RECVIT(ITRES,IPOS,IPTR,XVIT)
  179.              ENDIF
  180.          ENDIF
  181.          MERR =0
  182.          MCHPO1=ICHDI
  183.          SEGACT MCHPO1
  184.          IF (IDIM.EQ.3) THEN
  185.             IDIMB=6
  186.          ELSE
  187.             IDIMB=3
  188.          ENDIF
  189.          DO 30 ISOU =1,NSOUPO
  190.              MSOUPO = IPCHP(ISOU)
  191.              MSOUP1 = MCHPO1.IPCHP(ISOU)
  192.              SEGACT MSOUPO,MSOUP1
  193.              MELEME = IGEOC
  194.              SEGACT MELEME
  195.              MPOVAL = IPOVAL
  196.              MPOVA1 = MSOUP1.IPOVAL
  197.              SEGACT MPOVAL*MOD,MPOVA1
  198.              N = VPOCHA(/1)
  199.              DO 32 IN=1,N
  200.                 IPOINT = NUM(1,IN)
  201.                 DO 33 ID=(IDIM+1),IDIMB
  202. * On récupère l'axe de rotation
  203.                    XAXROT(ID-IDIM) = MPOVA1.VPOCHA(IN,ID)
  204.  33             CONTINUE
  205. * En 3D on le norme, on vérifie qu'il n'est pas nul
  206.                 CALL DYNE41(XAXROT,MERR,IDIM)
  207. * Calcul des fausses déformées modales de rotation
  208.                 CALL DYNE42(XROTA,XAXROT,IPOINT,ICDG,IDIMB,MERR)
  209.                 IF (ITYP.EQ.0) THEN
  210. * Recombinaison de déplacements
  211.                 DO 34 ID=1,IDIM
  212.                    VPOCHA(IN,ID)=VPOCHA(IN,ID)+ (XROTA(1,ID)*
  213.      &(COS(XVAL)-1) + XROTA(2,ID)*SIN(XVAL))
  214.  34             CONTINUE
  215.                 ELSE
  216. * Recombinaison de vitesses ou d accélérations
  217.                 DO 35 ID=1,IDIM
  218.                    VPOCHA(IN,ID)=VPOCHA(IN,ID)+XVAL*(COS(XANGLE)*
  219.      &XROTA(2,ID)-SIN(XANGLE)*XROTA(1,ID))
  220.  35             CONTINUE
  221.                  IF (ITYP.EQ.-1) THEN
  222. * Recombinaison  d accélérations
  223.                    DO 36 ID=1,IDIM
  224.                      VPOCHA(IN,ID)=VPOCHA(IN,ID)-XVIT*XVIT*
  225.      &(COS(XANGLE)*XROTA(1,ID)+SIN(XANGLE)*XROTA(2,ID))
  226.  36                CONTINUE
  227.                  ENDIF
  228.                 ENDIF
  229.  32          CONTINUE
  230.              SEGDES MPOVAL,MSOUPO,MELEME,MPOVA1,MSOUP1
  231.  30       CONTINUE
  232.           SEGDES MCHPO1
  233.          ENDIF
  234.          GOTO 20
  235.       ENDIF
  236.       SEGDES MCHPOI
  237. *
  238. *     Prise en compte des pseudo-modes
  239. *
  240.       IF (KCHAR.NE.0 .OR. ITLIA.NE.0) THEN
  241.         TYPRET = ' '
  242.         CALL ACCTAB(IBAS,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0,
  243.      &                  TYPRET,I1,X1,CHARRE,L1,ITPS)
  244.        IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
  245.           IF (ITYP.EQ.0.OR.ITYP.EQ.1.OR.ITYP.EQ.-1) THEN
  246.        CALL PSRCD2('DEPL',ITPS,IBBB,ICHDE,KCHAR,XTEMP,ITRES,IPOS,ITLIA)
  247.           ELSE IF (ITYP.EQ.2) THEN
  248.        CALL PSRCD2('REAC',ITPS,IBBB,ICHDE,KCHAR,XTEMP,ITRES,IPOS,ITLIA)
  249.           ENDIF
  250.        ELSE
  251.           CALL ERREUR(429)
  252.        ENDIF
  253.       ENDIF
  254. *
  255.       END
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  

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