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    CB215821  20/11/25    13:23:26     10792          
  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.       MRIGID=IPMASS
  91.       SEGACT MRIGID
  92.       NBSOUS=IRIGEL(/2)
  93.       IPG1=IRIGEL(1,1)
  94. C
  95. c       IF(NBSOUS.GT.1) THEN
  96. c         DO 10 I=2,NBSOUS
  97. c         IPP2=IRIGEL(1,I)
  98. c         ltelq=.false.
  99. c         CALL FUSE(IPG1,IPP2,IRET,ltelq)
  100. c         IPG1=IRET
  101. c   10    CONTINUE
  102. c       ENDIF
  103. cbp : FUSE ne teste pas si il genere des doublons...
  104. c     on preferera utiliser fusebo
  105.       IF(NBSOUS.GT.1) THEN
  106.         nbref=0
  107.         nbnn=0
  108.         nbelem=0
  109.         segini ipt4
  110.         kt4 = 1
  111.         ipt4.lisous(kt4) = IPG1
  112.         DO 10 I=2,NBSOUS
  113.           IPP2=IRIGEL(1,I)
  114.           do 1029 kk=1,kt4
  115. c            maillage deja vu --> on saute
  116.              if(IPP2.eq.ipt4.lisous(kk)) goto 10
  117.  1029     continue
  118.           kt4=kt4+1
  119.           ipt4.lisous(kt4) = IPP2
  120.   10    CONTINUE
  121.         nbsous = kt4
  122.         segadj ipt4
  123.         call fusebo(ipt4,IRET)
  124.         IPG1=IRET
  125.       ENDIF
  126.       SEGDES MRIGID
  127. C
  128. C---  CREATION DE LA TABLE BASE_DE_MODES
  129. C
  130.       CALL CRTABL(IPTAB2)
  131.       CALL ECCTAB(IPTAB2,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
  132.      #                   'MOT',0,0.D0,'BASE_DE_MODES',.TRUE.,0)
  133.       CALL ECCTAB(IPTAB2,'MOT',0,0.D0,'MAILLAGE',.TRUE.,0,
  134.      #            'MAILLAGE',0,0.D0,' ',.TRUE.,IPG1)
  135. C
  136. C---  EXTRACTION DES INFORMATIONS DE L'OBJET SOLUTION
  137. C
  138.  
  139.       MSOLUT=IPSOLU
  140.       SEGACT MSOLUT
  141. C
  142.       MSOLE1=MSOLIS(4)
  143. *     si l'objet solution n'est pas vide
  144.       if (msole1.ne.0) then
  145.       SEGACT MSOLE1
  146.       NBMOD1=MSOLE1.ISOLEN(/1)
  147. C
  148.       MSOLE2=MSOLIS(5)
  149.       SEGACT MSOLE2
  150. C
  151.       DO 20 I=1,NBMOD1
  152.       IMOD1=I
  153. C
  154. C---  CREATION DE LA TABLE MODE
  155. C
  156.       CALL CRTABL(IPTAB3)
  157.       CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
  158.      #                   'MOT',0,0.D0,'MODE',.TRUE.,0)
  159. C
  160. C---  CREATION DE LA TABLE DEPLACEMENTS_GENERALISES
  161. C
  162.       CALL CRTABL(IPTAB4)
  163.       CALL ECCTAB(IPTAB4,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
  164.      #            'MOT',0,0.D0,'DEPLACEMENTS_GENERALISES',.TRUE.,0)
  165. C
  166.       MMODE=MSOLE1.ISOLEN(IMOD1)
  167.       SEGACT MMODE
  168. C
  169.       NUME1=IMMODD(1)
  170.       FRQ1=FMMODD(1)
  171.       XMGEN1=FMMODD(2)
  172.       QX1=FMMODD(3)
  173.       QY1=FMMODD(4)
  174.       QZ1=FMMODD(5)
  175. C
  176.       MELEME=MSOLIS(3)
  177.       SEGACT MELEME
  178.       IPOIN1=NUM(1,IMOD1)
  179.       SEGDES MELEME
  180. C
  181.       IPDEP1=MSOLE2.ISOLEN(IMOD1)
  182. c     ajout du titre au chpoint
  183.       CALL TITMOD(MMODE,ITEX)
  184.       MCHPOI=IPDEP1
  185.       segact,MCHPOI*MOD
  186.       MOCHDE=ITEX
  187.       segdes,MCHPOI
  188. C
  189. C---  REMPLISSAGE DE LA TABLE DEPLACEMENTS_GENERALISES
  190. C
  191.       CALL ECCTAB(IPTAB4,'ENTIER',1,0.D0,' ',.TRUE.,0,
  192.      #                   'FLOTTANT',0,QX1,' ',.TRUE.,0)
  193.       CALL ECCTAB(IPTAB4,'ENTIER',2,0.D0,' ',.TRUE.,0,
  194.      #                   'FLOTTANT',0,QY1,' ',.TRUE.,0)
  195.       CALL ECCTAB(IPTAB4,'ENTIER',3,0.D0,' ',.TRUE.,0,
  196.      #                   'FLOTTANT',0,QZ1,' ',.TRUE.,0)
  197. C
  198. C---  REMPLISSAGE DE LA TABLE MODE
  199. C
  200.       CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'NUMERO_MODE',.TRUE.,0,
  201.      #                   'ENTIER',NUME1,0.D0,' ',.TRUE.,0)
  202.       CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'POINT_REPERE',.TRUE.,0,
  203.      #                   'POINT',0,0.D0,' ',.TRUE.,IPOIN1)
  204.       CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'FREQUENCE',.TRUE.,0,
  205.      #                   'FLOTTANT',0,FRQ1,' ',.TRUE.,0)
  206.       CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'MASSE_GENERALISEE',.TRUE.,0,
  207.      #                   'FLOTTANT',0,XMGEN1,' ',.TRUE.,0)
  208.       CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'DEPLACEMENTS_GENERALISES',
  209.      #            .TRUE.,0,'TABLE',0,0.D0,' ',.TRUE.,IPTAB4)
  210.       CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'DEFORMEE_MODALE',.TRUE.,0,
  211.      #                   'CHPOINT',0,0.D0,' ',.TRUE.,IPDEP1)
  212. C
  213. C---  SUITE DU REMPLISSAGE DE LA TABLE BASE_DE_MODES
  214. C
  215.       CALL ECCTAB(IPTAB2,'ENTIER',IMOD1,0.D0,' ',.TRUE.,0,
  216.      #                   'TABLE',0,0.D0,' ',.TRUE.,IPTAB3)
  217. C
  218.       SEGDES MMODE
  219.   20  CONTINUE
  220. C
  221. C
  222.       SEGDES MSOLE1
  223.       SEGDES MSOLE2
  224.       SEGDES MSOLUT
  225.  
  226.       endif
  227. *
  228. * tri selon les frequences
  229.         jg = 10000
  230.         segini mlreel,mlenti
  231.         do 350 i = 1, 10000
  232.         letyp=' '
  233.         call acctab (iptab2,'ENTIER  ',i,xva,charre,boolin,iobin,
  234.      $         letyp,ivalre,xvalre,charre,boolin,mtab2)
  235.         if(letyp.ne.'TABLE   ') go to 351
  236.         lect(i) = mtab2
  237.         call acctab (mtab2,'MOT     ',iva,xva,'FREQUENCE',boolin,iobin,
  238.      $         'FLOTTANT',ivalre,xvalre,charre,boolin,ioboi)
  239.         prog(i) = xvalre
  240.  350    continue
  241.  351    jg = i - 1
  242.         segadj mlreel,mlenti
  243.  
  244.         call ecrobj('LISTENTI',mlenti)
  245.         call ecrobj('LISTREEL',mlreel)
  246.         call ORDONN
  247.         call lirobj('LISTREEL',mlreel,1,IRETOU)
  248.         call lirobj('LISTENTI',mlenti,1,IRETOU)
  249.         IF (IERR.NE.0) RETURN
  250.         segact mlenti
  251.         do i = 1,jg
  252.         mtab2 = lect(i)
  253.         call ecctab (iptab2,'ENTIER  ',i,xva,charre,boolin,iobin,
  254.      $        'TABLE   ',ivalre,xvalre,charre,boolin,mtab2)
  255.  
  256.         enddo
  257.  
  258. C
  259. C---  CREATION DE LA TABLE BASE_MODALE
  260. C
  261.       CALL CRTABL(IPTAB1)
  262.       CALL ECCTAB(IPTAB1,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
  263.      #                   'MOT',0,0.D0,'BASE_MODALE',.TRUE.,0)
  264.       CALL ECCTAB(IPTAB1,'MOT',0,0.D0,'MODES',.TRUE.,0,
  265.      #                   'TABLE',0,0.D0,' ',.TRUE.,IPTAB2)
  266.       CALL ECROBJ('TABLE',IPTAB1)
  267. C
  268.       END
  269.  
  270.  
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  

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