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  20/11/25    13:39:37     10792          
  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 SMELEME
  28. *
  29.       LOGICAL L0,L1
  30.       CHARACTER*8 TYPRET,CHARRE
  31. *
  32.       IM = 0
  33.       NBMODE = 0
  34.  10   CONTINUE
  35.       IM = IM + 1
  36.       TYPRET = ' '
  37.       CALL ACCTAB(IBAS,'ENTIER',IM,X0,' ',L0,IP0,
  38.      &                   TYPRET,I1,X1,CHARRE,L1,ITMOD)
  39.       IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
  40.          NBMODE = NBMODE + 1
  41.          GOTO 10
  42.       ENDIF
  43. *
  44.       NBNN = 1
  45.       NBELEM = NBMODE
  46.       NBSOUS = 0
  47.       NBREF = 0
  48.       SEGINI MELEME
  49.       IMAIL = MELEME
  50.       ITYPEL = 1
  51. *
  52.       NSOUPO = 1
  53.       NAT= 1
  54.       SEGINI MCHPOI
  55.       JATTRI(1)=2
  56.       ICHPT = MCHPOI
  57.       IFOPOI = IFOUR
  58.       NC = 1
  59.       SEGINI MSOUPO
  60.       IPCHP(1)=MSOUPO
  61.       NOHARM(1) = NIFOUR
  62.       NOCOMP(1) = 'FALF'
  63.       N = NBMODE
  64.       SEGINI MPOVAL
  65.       IPOVAL = MPOVAL
  66.       DO 20 IM = 1,NBMODE
  67.          CALL ACCTAB(IBAS,'ENTIER',IM,X0,' ',L0,IP0,
  68.      &                     'TABLE',I1,X1,' ',L1,ITMOD)
  69.          CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
  70.      &                   'POINT',I1,X1,' ',L1,IPTR)
  71.          NUM(1,IM) = IPTR
  72.          ICOLOR(IM) = IDCOUL
  73.          CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEPLACEMENTS_GENERALISES',L0,
  74.      &                     IP0,'TABLE',I1,X1,' ',L1,ITDEP)
  75.          CALL ACCTAB(ITDEP,'ENTIER',IPLA2,X0,' ',L0,IP0,
  76.      &                   'FLOTTANT',I1,XQN,' ',L1,IP1)
  77.          VPOCHA(IM,1) = -1.D0 * XQN
  78.  20      CONTINUE
  79. *     end do
  80.       SEGDES MELEME
  81.       SEGDES MPOVAL
  82.       IGEOC = IMAIL
  83.       SEGDES MSOUPO
  84.       SEGDES MCHPOI
  85. *
  86.       END
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  
  97.  

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