Télécharger la plaquette Cast3M


fr en

Télécharger hbm26.eso

Retour à la liste

Numérotation des lignes : 

hbm26

  1. C HBM26     SOURCE    OF166741  26/05/11    21:15:06     12538          
  2.  
  3. *--------------------------------------------------------------------*
  4. *                                                                    *
  5. *     Operateur DYNE : algorithme de Fu - de Vogelaere               *
  6. *     ________________________________________________               *
  7. *                                                                    *
  8. *     Transpose l'information des objets de Castem2000 dans des      *
  9. *     tableaux de travail.                                           *
  10. *                                                                    *
  11. *     Parametres:                                                    *
  12. *                                                                    *
  13. * e   IBAS    Table representant une base modale                     *
  14. * es  KTKAM   Segment contenant les matrices XK, XASM et XM          *
  15. * es  KTPHI   Segment des deformees modales                          *
  16. * e   KTLIAB  Segment des liaisons sur base B                        *
  17. * es  IA1     Compteur                                               *
  18. * e   IB      Compteur de la sous base                               *
  19. * es  RIGIDE  Vrai si l'on a un corps rigide, faux sinon             *
  20. * e   ITKM    >0 si table RAIDEUR_ET_MASSE fournie                   *
  21. *                                                                    *
  22. *     Auteur, date de creation:                                      *
  23. *                                                                    *
  24. *     Lionel VIVAN, le 24 octobre 1989.                              *
  25. *                                                                    *
  26. *--------------------------------------------------------------------*
  27.       SUBROUTINE HBM26(IBAS,KTKAM,KTLIAB,KTPHI,IA1,IB,ICOMP,RIGIDE,ITKM)
  28.  
  29.       IMPLICIT INTEGER(I-N)
  30.       IMPLICIT REAL*8(A-H,O-Z)
  31.  
  32. -INC PPARAM
  33. -INC CCOPTIO
  34. -INC CCREEL
  35.  
  36. -INC SMCHAML
  37. -INC SMELEME
  38. -INC SMMODEL
  39.  
  40. -INC TMDYNC
  41.  
  42.       LOGICAL L0,L1,RIGIDE
  43.       CHARACTER*4 NOMTRI(6),NOMAXI(6),NOMPLA(3)
  44.       CHARACTER*8 CMOT,TYPRET,MORIGI,CHARRE
  45.       REAL*8      XAXROT(3),XROTA(2,3)
  46. *
  47. *     si IFOMOD = -1  :  modele PLAN
  48. *     si IFOMOD =  0  :  modele AXIS
  49. *     si IFOMOD =  1  :  modele FOUR
  50. *     si IFOMOD =  2  :  modele TRID
  51. *
  52. *     Les noms de composante sont
  53. *       - en modele PLAN   :  UX, UY, RT
  54. *       - en modele AXIS   :  UX, UY, RZ
  55. *       - en modele FOUR 1 :  UR, UZ, UT, RT
  56. *       - en modele TRID   :  UX, UY, UZ, RX, RY, RZ
  57. *
  58.       DATA NOMTRI/'UX  ','UY  ','UZ  ','RX  ','RY  ','RZ  '/
  59.       DATA NOMAXI/'UR  ','UT  ','UZ  ','RR  ','RT  ','RZ  '/
  60.       DATA NOMPLA/'UX  ','UY  ','RZ  '/
  61. *
  62.       MTKAM  = KTKAM
  63.       MTPHI  = KTPHI
  64.       MTLIAB = KTLIAB
  65. *
  66.       NLIAB  = IPALB(/1)
  67.       NPLB   = JPLIB(/1)
  68.       NSB    = XPHILB(/1)
  69.       NPLSB  = XPHILB(/2)
  70.       NA2    = XPHILB(/3)
  71.       IDIMB  = XPHILB(/4)
  72.       DEUXPI = 2.D0 * XPI
  73. *
  74.       IORSB(IB) = IA1 + 1
  75.       IAROTA(IB) = 0
  76.       IROT = 0
  77.       IN = 0
  78.  
  79. ************************************************************************
  80. *     table BASE_MODALE
  81. ************************************************************************
  82.  
  83.  10   CONTINUE
  84.       IN = IN + 1
  85.       TYPRET = ' '
  86.       CALL ACCTAB(IBAS,'ENTIER',IN,X0,' ',L0,IP0,
  87.      &                   TYPRET,I1,X1,CHARRE,L1,IBAMOD)
  88.       IF (IERR.NE.0) RETURN
  89. *    -on a bien un objet de type table
  90.       IF (IBAMOD.NE.0) THEN
  91.        IF (TYPRET.EQ.'TABLE   ') THEN
  92.  
  93.          IA1 = IA1 + 1
  94.  
  95. *        remplissage de XM et XK diagonale depuis la table BASE_MODALE
  96. *        sauf si deja fait car on a une table RAIDEUR_ET_MASSE !
  97.          IF (ITKM.LE.0) THEN
  98.            CALL ACCTAB(IBAMOD,'MOT',I0,X0,'MASSE_GENERALISEE',L0,IP0,
  99.      &                        'FLOTTANT',I1,XMASSE,' ',L1,IP1)
  100.            IF (IERR.NE.0) RETURN
  101.            XM(IA1,1) = XMASSE
  102.            CALL ACCTAB(IBAMOD,'MOT',I0,X0,'FREQUENCE',L0,IP0,
  103.      &                        'FLOTTANT',I1,XFREQ,' ',L1,IP1)
  104.            IF (IERR.NE.0) RETURN
  105.            OMEGA = XFREQ * DEUXPI
  106.            XK(IA1,1) = XMASSE * OMEGA * OMEGA
  107.            IF (IIMPI.EQ.333) THEN
  108.               WRITE(IOIMP,*)'HBM26 :   XM(',IA1,') =',XMASSE
  109.               WRITE(IOIMP,*)'HBM26 :   XK(',IA1,') =',XK(IA1,1)
  110.            ENDIF
  111.          ENDIF
  112.  
  113. *    si liaison_B existe, remplissage de IPLSB, XPHILB, IAROTA, INMSB...
  114.          IF (NLIAB.NE.0) THEN
  115.             CALL ACCTAB(IBAMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  116.      &                         'CHPOINT',I1,X1,' ',L1,ICDM)
  117.             IF (IERR.NE.0) RETURN
  118.             CALL ACTOBJ('CHPOINT',ICDM,1)
  119.  
  120.             DO 12 ID = 1,IDIMB
  121.                IF (IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN
  122.                   CMOT = NOMAXI(ID)
  123.                ELSE
  124.                   IF (IFOMOD.EQ.-1) THEN
  125.                       CMOT = NOMPLA(ID)
  126.                   ELSE
  127.                       CMOT = NOMTRI(ID)
  128.                   ENDIF
  129.                ENDIF
  130.                IF (IIMPI.EQ.333)
  131.      &         WRITE(IOIMP,*)'HBM26 :  composante a extraire :',CMOT
  132.                ICOMP  = 0
  133.                DO 14 IP = 1,NPLB
  134.                   IPOINT = JPLIB(IP)
  135. *      On extrait du chpoint ICDM au point IPOINT de composante CMOT
  136.                   CALL EXTRA9(ICDM,IPOINT,CMOT,0,.FALSE.,XVAL,IRET)
  137.                   ICOMP = ICOMP + 1
  138. *          on ajuste la taille si necessaire
  139.                   IF(ICOMP.GT.NPLSB) THEN
  140.                       NPLSB=ICOMP
  141.                       SEGADJ MTPHI
  142.                   ENDIF
  143.                   IPLSB(IP) = ICOMP
  144. * suite a la modif dans extra9, car on attribue une valeur meme
  145. * si le point n'existe pas dans le chpoint
  146.                   IF (XVAL.NE.0.) THEN
  147.                     IF ((IBASB(IP).NE.0).AND.(IBASB(IP).NE.IB)) THEN
  148.                       call erreur (783)
  149.                       RETURN
  150.                     ENDIF
  151.                     IBASB(IP) = IB
  152.                   ELSEIF ((IB.EQ.NSB).AND.(IBASB(IP).EQ.0)) THEN
  153.                     IBASB(IP) = IB
  154.                   ENDIF
  155.                   XPHILB(IB,ICOMP,IN,ID) = XVAL
  156.       IF (IIMPI.EQ.333) THEN
  157.         WRITE(IOIMP,*)'HBM26 :   IPLSB(',IP,') =',IPLSB(IP)
  158.         WRITE(IOIMP,*)'HBM26 :   IBASB(',IP,') =',IBASB(IP)
  159.         XVA2 = XPHILB(IB,ICOMP,IN,ID)
  160.         WRITE(IOIMP,*)'HBM26 :   XPHILB(',IB,ICOMP,IN,ID,') =',XVA2
  161.       ENDIF
  162.  14            CONTINUE
  163.  12         CONTINUE
  164.          ENDIF
  165.  
  166. c *        Prise en compte d'un mode de rotation de corps rigide
  167.           MORIGI = ' '
  168.           CALL ACCTAB(IBAMOD,'MOT',I0,X0,'CORPS_RIGIDE',L0,IP0,
  169.      &                      MORIGI,I1,X1,CMOT,L1,IP1)
  170.           IF (IERR.NE.0) RETURN
  171.           IF (MORIGI.EQ.'MOT') THEN
  172.              IF (CMOT(1:4).EQ.'VRAI') THEN
  173.                  CALL ACCTAB(IBAMOD,'MOT',I0,X0,'CENTRE_DE_GRAVITE',
  174.      &          L0,IP0,'POINT',I1,X1,'  ',L1,ICDG)
  175.                  IF (IERR.NE.0) RETURN
  176.                  IAROTA(IB)=IA1
  177.                  IROT = IN
  178.              ENDIF
  179.           ENDIF
  180.          GOTO 10
  181.        ELSE
  182.          CALL ERREUR(491)
  183.          RETURN
  184.        ENDIF
  185.       ENDIF
  186. *    -fin du cas ou on a bien un objet de type table
  187.       INMSB(IB) = IN - 1
  188. *
  189. ************************************************************************
  190. *     Remplissage des fausses deformees modales de rotations
  191. ************************************************************************
  192. *
  193. *50   continue
  194.       IF (IAROTA(IB).NE.0) THEN
  195.          RIGIDE = .TRUE.
  196.          MERR = 0
  197.          NPLUS = IN + 1
  198.          IF (NPLUS.GT.NA2) THEN
  199. * On reajuste le dimension NA2 de XPHILB
  200.                  NA2 = NPLUS
  201.                  SEGADJ MTPHI
  202.          ENDIF
  203.          DO 18 IP=1,NPLB
  204.              IPOINT=JPLIB(IP)
  205.              IPOS=IPLSB(IP)
  206.              IBBAS= IBASB(IP)
  207.              IF (IBBAS.EQ.IB) THEN
  208.                 DO 20 ID=(IDIM+1),IDIMB
  209.                   XAXROT(ID-IDIM) = XPHILB(IB,IPOS,IROT,ID)
  210.  20             CONTINUE
  211. * En tridimensionnel l'axe de rotation est le vecteur propre de rotation
  212. * On norme l axe du plan de rotation
  213.                 CALL DYNE41(XAXROT,MERR,IDIM)
  214. * En bidimensionnel l'axe de rotation est fixe
  215. * Calcul des fausses deformees modales de rotation
  216.                 CALL DYNE42(XROTA,XAXROT,IPOINT,ICDG,IDIMB,MERR)
  217.              DO 22 ID =1,IDIMB
  218.                  XPHILB(IB,IPOS,IN,ID)  = XROTA(1,ID)
  219.                  XPHILB(IB,IPOS,IN+1,ID)= XROTA(2,ID)
  220.  22          CONTINUE
  221.              ENDIF
  222.  18       CONTINUE
  223.       ENDIF
  224.  
  225.       IF (IIMPI.EQ.333) THEN
  226.         WRITE(IOIMP,*)'HBM26 :   INMSB(',IB,') =',INMSB(IB)
  227.         WRITE(IOIMP,*)'HBM26 :   IORSB(',IB,') =',IORSB(IB)
  228.         WRITE(IOIMP,*)'HBM26 :   IAROTA(',IB,') =',IAROTA(IB)
  229.       ENDIF
  230.  
  231.       RETURN
  232.       END
  233.  
  234.  
  235.  

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