Télécharger la plaquette Cast3M


fr en

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