Télécharger la plaquette Cast3M


fr en

Télécharger crtbas.eso

Retour à la liste

Numérotation des lignes : 

crtbas

  1. C CRTBAS    SOURCE    GOUNAND   25/03/12    21:15:03     12194          
  2.       SUBROUTINE CRTBAS(IPSOLU,IPMASS)
  3. C***********************************************************************
  4. C
  5. C                             C R T B A S
  6. C                             -----------
  7. C
  8. C     SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "VIBRATION"
  9. C
  10. C FONCTION:
  11. C ---------
  12. C
  13. C     CREATION D'UNE TABLE DE TYPE BASE_MODALE COMME SORTIE
  14. C     DE L'OPERATEUR "VIBRATION"
  15. C
  16. C ARGUMENTS D'ENTREE:
  17. C ------------------
  18. C
  19. C     IPSOLU = POINTEUR SUR L'OBJET SOLUTION
  20. C     IPMASS = POINTEUR SUR LA MATRICE MASSE
  21. C
  22. C DESCRIPTION DE LA TABLE BASE_MODALE CREE:
  23. C ----------------------------------------
  24. C
  25. C     TAB1 = 'TABLE' 'BASE_MODALE'               ( POINTEUR IPTAB1 )
  26. C     TAB2 = 'TABLE' 'BASE_DE_MODES'             ( POINTEUR IPTAB2 )
  27. C            DE MEME STRUCTURE QUE CELLE ISSUE DE LA PROCEDURE
  28. C            TRADUIRE.
  29. C     TAB3 = 'TABLE' 'MODE'                      ( POINTEUR IPTAB3 )
  30. C     TAB4 = 'TABLE' 'DEPLACEMENTS_GENERALISES'  ( POINTEUR IPTAB4 )
  31. C
  32. C ----------------------------------------
  33. C
  34. C     TAB1.'SOUSTYPE'                 = 'BASE_MODALE'
  35. C     TAB1.'MODES'                    = IPTAB2
  36. C
  37. C     TAB2.'SOUSTYPE'                 = 'BASE_DE_MODES'
  38. C     TAB2.'MAILLAGE'                 = IPG1 ( POINTEUR SUR LE
  39. C                                       MAILLAGE EXTRAIT DE LA MATRICE
  40. C                                       MASSE )
  41. C
  42. C PUIS POUR CHAQUE MODE IMOD1 CONTENU DANS L'OBJET SOLUTION
  43. C
  44. C     TAB3.'SOUSTYPE'                 = 'MODE'
  45. C     TAB4.'SOUSTYPE'                 = 'DEPLACEMENTS_GENERALISES'
  46. C
  47. C     TAB4.1                          = QX DU MODE
  48. C     TAB4.2                          = QY DU MODE
  49. C     TAB4.3                          = QZ DU MODE
  50. C
  51. C     TAB3.'NUMERO_MODE'              = NUME1 ( NUMERO DU MODE )
  52. C     TAB3.'POINT_REPERE'             = IPOIN1 ( NUMERO DU POINT ASSOCIE
  53. C                                       AU MODE )
  54. C     TAB3.'FREQUENCE'                = FREQ1  DU MODE
  55. C     TAB3.'MASSE_GENERALISEE'        = XMGEN1 DU MODE
  56. C     TAB3.'DEPLACEMENTS_GENERALISES' = IPTAB4
  57. C     TAB3.'DEFORMEE_MODALE'          = IPDEP1 ( POINTEUR SUR LE CHAMP
  58. C                                       DE DEPLACEMENTS DU MODE )
  59. C
  60. C     TAB2.IMOD1                      = IPTAB3
  61. C
  62. C
  63. C AUTEUR, DATE DE CREATION:
  64. C -------------------------
  65. C
  66. C     NADINE BLAY        21 OCTOBRE 1991
  67. C
  68. C***********************************************************************
  69. C
  70.       IMPLICIT INTEGER(I-N)
  71.       IMPLICIT REAL*8 (A-H,O-Z)
  72. C
  73.  
  74. -INC PPARAM
  75. -INC CCOPTIO
  76. C
  77. -INC SMSOLUT
  78. -INC SMRIGID
  79. -INC SMTABLE
  80. -INC SMELEME
  81. -INC SMLREEL
  82. -INC SMLENTI
  83. -INC SMCHPOI
  84.       CHARACTER*8 letyp,charre
  85.       LOGICAL boolin,ltelq
  86.       CHARACTER *72 ITEX
  87. C
  88. C---  RECUPERATION DU MAILLAGE DANS LA MATRICE MASSE
  89. C
  90.       CALL MELRIG(IPMASS,IPG1)
  91. C
  92. C---  CREATION DE LA TABLE BASE_DE_MODES
  93. C
  94.       CALL CRTABL(IPTAB2)
  95.       CALL ECCTAB(IPTAB2,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
  96.      #                   'MOT',0,0.D0,'BASE_DE_MODES',.TRUE.,0)
  97.       CALL ECCTAB(IPTAB2,'MOT',0,0.D0,'MAILLAGE',.TRUE.,0,
  98.      #            'MAILLAGE',0,0.D0,' ',.TRUE.,IPG1)
  99. C
  100. C---  EXTRACTION DES INFORMATIONS DE L'OBJET SOLUTION
  101. C
  102.  
  103.       MSOLUT=IPSOLU
  104.       SEGACT MSOLUT
  105. C
  106.       MSOLE1=MSOLIS(4)
  107. *     si l'objet solution n'est pas vide
  108.       if (msole1.ne.0) then
  109.       SEGACT MSOLE1
  110.       NBMOD1=MSOLE1.ISOLEN(/1)
  111. C
  112.       MSOLE2=MSOLIS(5)
  113.       SEGACT MSOLE2
  114. C
  115.       DO 20 I=1,NBMOD1
  116.       IMOD1=I
  117. C
  118. C---  CREATION DE LA TABLE MODE
  119. C
  120.       CALL CRTABL(IPTAB3)
  121.       CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
  122.      #                   'MOT',0,0.D0,'MODE',.TRUE.,0)
  123. C
  124. C---  CREATION DE LA TABLE DEPLACEMENTS_GENERALISES
  125. C
  126.       CALL CRTABL(IPTAB4)
  127.       CALL ECCTAB(IPTAB4,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
  128.      #            'MOT',0,0.D0,'DEPLACEMENTS_GENERALISES',.TRUE.,0)
  129. C
  130.       MMODE=MSOLE1.ISOLEN(IMOD1)
  131.       SEGACT MMODE
  132. C
  133.       NUME1=IMMODD(1)
  134.       FRQ1=FMMODD(1)
  135.       XMGEN1=FMMODD(2)
  136.       QX1=FMMODD(3)
  137.       QY1=FMMODD(4)
  138.       QZ1=FMMODD(5)
  139. C
  140.       MELEME=MSOLIS(3)
  141.       SEGACT MELEME
  142.       IPOIN1=NUM(1,IMOD1)
  143.       SEGDES MELEME
  144. C
  145.       IPDEP1=MSOLE2.ISOLEN(IMOD1)
  146. c     ajout du titre au chpoint
  147.       CALL TITMOD(MMODE,ITEX)
  148.       MCHPOI=IPDEP1
  149.       segact,MCHPOI*MOD
  150.       MOCHDE=ITEX
  151.       segdes,MCHPOI
  152. C
  153. C---  REMPLISSAGE DE LA TABLE DEPLACEMENTS_GENERALISES
  154. C
  155.       CALL ECCTAB(IPTAB4,'ENTIER',1,0.D0,' ',.TRUE.,0,
  156.      #                   'FLOTTANT',0,QX1,' ',.TRUE.,0)
  157.       CALL ECCTAB(IPTAB4,'ENTIER',2,0.D0,' ',.TRUE.,0,
  158.      #                   'FLOTTANT',0,QY1,' ',.TRUE.,0)
  159.       CALL ECCTAB(IPTAB4,'ENTIER',3,0.D0,' ',.TRUE.,0,
  160.      #                   'FLOTTANT',0,QZ1,' ',.TRUE.,0)
  161. C
  162. C---  REMPLISSAGE DE LA TABLE MODE
  163. C
  164.       CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'NUMERO_MODE',.TRUE.,0,
  165.      #                   'ENTIER',NUME1,0.D0,' ',.TRUE.,0)
  166.       CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'POINT_REPERE',.TRUE.,0,
  167.      #                   'POINT',0,0.D0,' ',.TRUE.,IPOIN1)
  168.       CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'FREQUENCE',.TRUE.,0,
  169.      #                   'FLOTTANT',0,FRQ1,' ',.TRUE.,0)
  170.       CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'MASSE_GENERALISEE',.TRUE.,0,
  171.      #                   'FLOTTANT',0,XMGEN1,' ',.TRUE.,0)
  172.       CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'DEPLACEMENTS_GENERALISES',
  173.      #            .TRUE.,0,'TABLE',0,0.D0,' ',.TRUE.,IPTAB4)
  174.       CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'DEFORMEE_MODALE',.TRUE.,0,
  175.      #                   'CHPOINT',0,0.D0,' ',.TRUE.,IPDEP1)
  176. C
  177. C---  SUITE DU REMPLISSAGE DE LA TABLE BASE_DE_MODES
  178. C
  179.       CALL ECCTAB(IPTAB2,'ENTIER',IMOD1,0.D0,' ',.TRUE.,0,
  180.      #                   'TABLE',0,0.D0,' ',.TRUE.,IPTAB3)
  181. C
  182.       SEGDES MMODE
  183.   20  CONTINUE
  184. C
  185. C
  186.       SEGDES MSOLE1
  187.       SEGDES MSOLE2
  188.       SEGDES MSOLUT
  189.  
  190.       endif
  191. *
  192. * tri selon les frequences
  193.         jg = 10000
  194.         segini mlreel,mlenti
  195.         do 350 i = 1, 10000
  196.         letyp=' '
  197.         call acctab (iptab2,'ENTIER  ',i,xva,charre,boolin,iobin,
  198.      $         letyp,ivalre,xvalre,charre,boolin,mtab2)
  199.         if(letyp.ne.'TABLE   ') go to 351
  200.         lect(i) = mtab2
  201.         call acctab (mtab2,'MOT     ',iva,xva,'FREQUENCE',boolin,iobin,
  202.      $         'FLOTTANT',ivalre,xvalre,charre,boolin,ioboi)
  203.         prog(i) = xvalre
  204.  350    continue
  205.  351    jg = i - 1
  206.         segadj mlreel,mlenti
  207.  
  208.         call ecrobj('LISTENTI',mlenti)
  209.         call ecrobj('LISTREEL',mlreel)
  210.         call ORDONN
  211.         call lirobj('LISTREEL',mlreel,1,IRETOU)
  212.         call lirobj('LISTENTI',mlenti,1,IRETOU)
  213.         IF (IERR.NE.0) RETURN
  214.         segact mlenti
  215.         do i = 1,jg
  216.         mtab2 = lect(i)
  217.         call ecctab (iptab2,'ENTIER  ',i,xva,charre,boolin,iobin,
  218.      $        'TABLE   ',ivalre,xvalre,charre,boolin,mtab2)
  219.  
  220.         enddo
  221.  
  222. C
  223. C---  CREATION DE LA TABLE BASE_MODALE
  224. C
  225.       CALL CRTABL(IPTAB1)
  226.       CALL ECCTAB(IPTAB1,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
  227.      #                   'MOT',0,0.D0,'BASE_MODALE',.TRUE.,0)
  228.       CALL ECCTAB(IPTAB1,'MOT',0,0.D0,'MODES',.TRUE.,0,
  229.      #                   'TABLE',0,0.D0,' ',.TRUE.,IPTAB2)
  230.       CALL ECROBJ('TABLE',IPTAB1)
  231. C
  232.       END
  233.  
  234.  

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