Télécharger devpsm.eso

Retour à la liste

Numérotation des lignes :

  1. C DEVPSM SOURCE BP208322 15/07/22 21:15:27 8586
  2. SUBROUTINE DEVPSM(ITCHAR,ITBAS,KTLIAB,KTNUM,KTPHI,KTFEX,REPRIS)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. * *
  7. * Opérateur DYNE : algorithme de Fu - de Vogelaere *
  8. * ________________________________________________ *
  9. * *
  10. * Traitement des pseudo-modes. *
  11. * *
  12. * Paramètres: *
  13. * *
  14. * e ITCHAR Table représentant les chargements *
  15. * e ITBAS Table représentant la base modale *
  16. * e KTLIAB Segment contenant les liaisons sur base B *
  17. * e KTNUM Segment contenant les paramètres numériques *
  18. * e KTPHI Segment des déformées modales *
  19. * es KTFEX Segment contenant les chargements libres *
  20. * e REPRIS Logique indiquant si le calcul est en reprise *
  21. * *
  22. * Auteur, date de création: *
  23. * *
  24. * Lionel VIVAN, le 10 avril 1990 *
  25. * *
  26. *--------------------------------------------------------------------*
  27. *
  28. -INC CCOPTIO
  29. *
  30. SEGMENT,MTPHI
  31. INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB)
  32. INTEGER IAROTA(NSB)
  33. REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB)
  34. ENDSEGMENT
  35. *
  36. LOGICAL L0,L1,REPRIS
  37. CHARACTER*8 TYPRET,CHARRE
  38. CHARACTER*40 MOTSOU
  39. *
  40. MTPHI = KTPHI
  41. NPLB = IBASB(/1)
  42.  
  43. IF(IIMPI.EQ.333) THEN
  44. IF(NPLB.EQ.0) WRITE(IOIMP,*)
  45. & 'DEVPSM: PAS DE PSEUDO_MODES SI pas de liaison B'
  46. IF(ITBAS.EQ.0) WRITE(IOIMP,*)
  47. & 'DEVPSM: PAS DE PSEUDO_MODES SI TABLE RAIDEUR_ET_MASSE'
  48. RETURN
  49. ENDIF
  50.  
  51. * pas de pseudo modes si pas de liaison B
  52. IF (NPLB.EQ.0) RETURN
  53. * pas de pseudo modes si table RAIDEUR_ET_MASSE
  54. IF (ITBAS.EQ.0) RETURN
  55. *
  56. * On extrait les chargements de la table
  57. *
  58. TYPRET = ' '
  59. CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_A',L0,IP0,
  60. & TYPRET,I1,X1,CHARRE,L1,ICHAR1)
  61.  
  62. IF (ICHAR1.NE.0 .AND. TYPRET.EQ.'CHARGEME') THEN
  63. TYPRET = ' '
  64. CALL ACCTAB(ITBAS,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  65. & 'MOT',I1,X1,MOTSOU,L1,IP1)
  66. IF (MOTSOU(1:17).EQ.'ENSEMBLE_DE_BASES') THEN
  67. IBA = 0
  68. 10 CONTINUE
  69. IBA = IBA + 1
  70. TYPRET = ' '
  71. CALL ACCTAB(ITBAS,'ENTIER',IBA,X0,' ',L0,IP0,
  72. & TYPRET,I1,X1,CHARRE,L1,IBBB)
  73. IF (IBBB.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  74. TYPRET = ' '
  75. CALL ACCTAB(IBBB,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0,
  76. & TYPRET,I1,X1,CHARRE,L1,ITPS)
  77. IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  78. CALL ACCTAB(IBBB,'MOT',I0,X0,'MODES',L0,IP0,
  79. & 'TABLE',I1,X1,' ',L1,IBAS)
  80. CALL DEVPS2(ICHAR1,KTLIAB,KTNUM,KTPHI,KTFEX,REPRIS,
  81. & ITPS,IBAS,IBA)
  82. IF (IERR.NE.0) RETURN
  83. ENDIF
  84. GOTO 10
  85. ENDIF
  86. ELSE IF (MOTSOU(1:11).EQ.'BASE_MODALE') THEN
  87. TYPRET = ' '
  88. CALL ACCTAB(ITBAS,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0,
  89. & TYPRET,I1,X1,CHARRE,L1,ITPS)
  90. IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  91. CALL ACCTAB(ITBAS,'MOT',I0,X0,'MODES',L0,IP0,
  92. & 'TABLE',I1,X1,' ',L1,IBAS)
  93. CALL DEVPS2(ICHAR1,KTLIAB,KTNUM,KTPHI,KTFEX,REPRIS,
  94. & ITPS,IBAS,1)
  95. IF (IERR.NE.0) RETURN
  96. ENDIF
  97. ENDIF
  98. ENDIF
  99. *
  100. END
  101.  
  102.  
  103.  
  104.  
  105.  

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