Télécharger la plaquette Cast3M


fr en

Télécharger seism2.eso

Retour à la liste

Numérotation des lignes : 

seism2

  1. C SEISM2    SOURCE    CB215821  25/04/23    21:15:44     12247          
  2.       SUBROUTINE SEISM2(IBAS,IPLA2,ICHPT)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. *                                                                    *
  7. *     G{n}re un CHPOINT qui repr{sente la r{partition spatiale du    *
  8. *     chargement sismique.                                           *
  9. *                                                                    *
  10. *     Param}tres:                                                    *
  11. *                                                                    *
  12. * e   ITBAS   Table repr{sentant une base modale                     *
  13. * e   IPLA2   num{ro du d{placement g{n{ralis{                       *
  14. *  s  ICHPT   chpoint cr{{                                           *
  15. *                                                                    *
  16. *     Auteur, date de cr{ation:                                      *
  17. *                                                                    *
  18. *     Lionel VIVAN, le 17 mai 1990.                                  *
  19. *                                                                    *
  20. *--------------------------------------------------------------------*
  21. *                                                                    *
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC CCGEOME
  26. -INC SMCHPOI
  27. -INC SMCOORD
  28. -INC SMELEME
  29. *
  30.       LOGICAL L0,L1
  31.       CHARACTER*8 TYPRET,CHARRE
  32. *
  33.       IM = 0
  34.       NBMODE = 0
  35.  10   CONTINUE
  36.       IM = IM + 1
  37.       TYPRET = ' '
  38.       CALL ACCTAB(IBAS,'ENTIER',IM,X0,' ',L0,IP0,
  39.      &                   TYPRET,I1,X1,CHARRE,L1,ITMOD)
  40.       IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
  41.          NBMODE = NBMODE + 1
  42.          GOTO 10
  43.       ENDIF
  44. *
  45.       NBNN = 1
  46.       NBELEM = NBMODE
  47.       NBSOUS = 0
  48.       NBREF = 0
  49.       SEGINI MELEME
  50.       IMAIL = MELEME
  51.       ITYPEL = 1
  52. *
  53.       NSOUPO = 1
  54.       NAT= 1
  55.       SEGINI MCHPOI
  56.       JATTRI(1)=2
  57.       ICHPT = MCHPOI
  58.       IFOPOI = IFOUR
  59.       NC = 1
  60.       SEGINI MSOUPO
  61.       IPCHP(1)=MSOUPO
  62.       NOHARM(1) = NIFOUR
  63.       NOCOMP(1) = 'FALF'
  64.       N = NBMODE
  65.       SEGINI MPOVAL
  66.       IPOVAL = MPOVAL
  67.       DO 20 IM = 1,NBMODE
  68.          CALL ACCTAB(IBAS,'ENTIER',IM,X0,' ',L0,IP0,
  69.      &                     'TABLE',I1,X1,' ',L1,ITMOD)
  70.          CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
  71.      &                   'POINT',I1,X1,' ',L1,IPTR)
  72.          NUM(1,IM) = IPTR
  73.          ICOLOR(IM) = IDCOUL
  74.          CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEPLACEMENTS_GENERALISES',L0,
  75.      &                     IP0,'TABLE',I1,X1,' ',L1,ITDEP)
  76.          CALL ACCTAB(ITDEP,'ENTIER',IPLA2,X0,' ',L0,IP0,
  77.      &                   'FLOTTANT',I1,XQN,' ',L1,IP1)
  78.          VPOCHA(IM,1) = -1.D0 * XQN
  79.  20      CONTINUE
  80. *     end do
  81.       SEGDES MELEME
  82.       SEGDES MPOVAL
  83.       IGEOC = IMAIL
  84.       SEGDES MSOUPO
  85.       SEGDES MCHPOI
  86. *
  87.       END
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  
  97.  
  98.  
  99.  

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