Télécharger devpsm.eso

Retour à la liste

Numérotation des lignes :

devpsm
  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.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. *
  32. SEGMENT,MTPHI
  33. INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB)
  34. INTEGER IAROTA(NSB)
  35. REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB)
  36. ENDSEGMENT
  37. *
  38. LOGICAL L0,L1,REPRIS
  39. CHARACTER*8 TYPRET,CHARRE
  40. CHARACTER*40 MOTSOU
  41. *
  42. MTPHI = KTPHI
  43. NPLB = IBASB(/1)
  44.  
  45. IF(IIMPI.EQ.333) THEN
  46. IF(NPLB.EQ.0) WRITE(IOIMP,*)
  47. & 'DEVPSM: PAS DE PSEUDO_MODES SI pas de liaison B'
  48. IF(ITBAS.EQ.0) WRITE(IOIMP,*)
  49. & 'DEVPSM: PAS DE PSEUDO_MODES SI TABLE RAIDEUR_ET_MASSE'
  50. RETURN
  51. ENDIF
  52.  
  53. * pas de pseudo modes si pas de liaison B
  54. IF (NPLB.EQ.0) RETURN
  55. * pas de pseudo modes si table RAIDEUR_ET_MASSE
  56. IF (ITBAS.EQ.0) RETURN
  57. *
  58. * On extrait les chargements de la table
  59. *
  60. TYPRET = ' '
  61. CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_A',L0,IP0,
  62. & TYPRET,I1,X1,CHARRE,L1,ICHAR1)
  63.  
  64. IF (ICHAR1.NE.0 .AND. TYPRET.EQ.'CHARGEME') THEN
  65. TYPRET = ' '
  66. CALL ACCTAB(ITBAS,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  67. & 'MOT',I1,X1,MOTSOU,L1,IP1)
  68. IF (MOTSOU(1:17).EQ.'ENSEMBLE_DE_BASES') THEN
  69. IBA = 0
  70. 10 CONTINUE
  71. IBA = IBA + 1
  72. TYPRET = ' '
  73. CALL ACCTAB(ITBAS,'ENTIER',IBA,X0,' ',L0,IP0,
  74. & TYPRET,I1,X1,CHARRE,L1,IBBB)
  75. IF (IBBB.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  76. TYPRET = ' '
  77. CALL ACCTAB(IBBB,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0,
  78. & TYPRET,I1,X1,CHARRE,L1,ITPS)
  79. IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  80. CALL ACCTAB(IBBB,'MOT',I0,X0,'MODES',L0,IP0,
  81. & 'TABLE',I1,X1,' ',L1,IBAS)
  82. CALL DEVPS2(ICHAR1,KTLIAB,KTNUM,KTPHI,KTFEX,REPRIS,
  83. & ITPS,IBAS,IBA)
  84. IF (IERR.NE.0) RETURN
  85. ENDIF
  86. GOTO 10
  87. ENDIF
  88. ELSE IF (MOTSOU(1:11).EQ.'BASE_MODALE') THEN
  89. TYPRET = ' '
  90. CALL ACCTAB(ITBAS,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0,
  91. & TYPRET,I1,X1,CHARRE,L1,ITPS)
  92. IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  93. CALL ACCTAB(ITBAS,'MOT',I0,X0,'MODES',L0,IP0,
  94. & 'TABLE',I1,X1,' ',L1,IBAS)
  95. CALL DEVPS2(ICHAR1,KTLIAB,KTNUM,KTPHI,KTFEX,REPRIS,
  96. & ITPS,IBAS,1)
  97. IF (IERR.NE.0) RETURN
  98. ENDIF
  99. ENDIF
  100. ENDIF
  101. *
  102. END
  103.  
  104.  
  105.  
  106.  
  107.  

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