Télécharger la plaquette Cast3M


fr en

Télécharger reacti.eso

Retour à la liste

Numérotation des lignes : 

reacti

  1. C REACTI    SOURCE    CB215821  19/08/20    21:21:25     10287          
  2.       SUBROUTINE REACTI
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5.  
  6. -INC PPARAM
  7. -INC CCOPTIO
  8.       LOGICAL L0,L1
  9.       CHARACTER*8 TYPRET,CTYP,CHARRE
  10.       PARAMETER (IUN=1)
  11. *
  12.       CALL LIRTAB('LIAISONS_STATIQUES',ITBAS,0,IRET)
  13.  
  14.       CALL LIROBJ ('RIGIDITE',MRIGID,IUN,IRETOU)
  15.       IF(IERR.NE.0) RETURN
  16.       IF (IRET.NE.0) goto 1100
  17. *
  18. *     lecture d'une TABLE ou d'un objet CHPOINT
  19. *
  20.       CALL QUETYP(CTYP,0  ,IRETOU)
  21.       IF(IRETOU.EQ.0) THEN
  22.          CALL ERREUR(533)
  23.          RETURN
  24.       ENDIF
  25.       IF (CTYP(1:8).EQ.'TABLE   ') THEN
  26.          CALL LIRTAB('BASE_MODALE',ITBAS,IUN,IRET)
  27.          IF (IERR.NE.0) RETURN
  28. *
  29. *        On r{cup}re la base des modes
  30. *
  31.          CALL ACCTAB(ITBAS,'MOT',I0,X0,'MODES',L0,IP0,
  32.      &                   'TABLE',I1,X1,' ',L1,IBAS)
  33.          IB = 0
  34.  10      CONTINUE
  35.          TYPRET = ' '
  36.          IB = IB + 1
  37.          CALL ACCTAB(IBAS,'ENTIER',IB,X0,' ',L0,IP0,
  38.      &                      TYPRET,I1,X1,CHARRE,L1,ITTBAS)
  39.          IF (ITTBAS.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
  40.             CALL ACCTAB(ITTBAS,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  41.      &                     'CHPOINT',I1,X1,' ',L1,MCHPOI)
  42.             CALL REACT1(MRIGID,MCHPOI,MCHPO1)
  43.             IF(IERR.NE.0) RETURN
  44.             CALL ECCTAB(ITTBAS,'MOT',I0,X0,'REACTION_MODALE',L0,IP0,
  45.      &                     'CHPOINT',I1,X1,' ',L1,MCHPO1)
  46.             GOTO 10
  47.          ENDIF
  48. *
  49. *        On r{cup}re la base des pseudo-modes
  50. *
  51.          TYPRET = ' '
  52.          CALL ACCTAB(ITBAS,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0,
  53.      &                    TYPRET,I1,X1,CHARRE,L1,ITPS)
  54.          IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
  55.             IB = 0
  56.  20         CONTINUE
  57.             TYPRET = ' '
  58.             IB = IB + 1
  59.             CALL ACCTAB(ITPS,'ENTIER',IB,X0,' ',L0,IP0,
  60.      &                         TYPRET,I1,X1,CHARRE,L1,ITTBAS)
  61.             IF (ITTBAS.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
  62.                CALL ACCTAB(ITTBAS,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  63.      &                        'CHPOINT',I1,X1,' ',L1,MCHPOI)
  64.                CALL REACT1(MRIGID,MCHPOI,MCHPO1)
  65.                IF(IERR.NE.0) RETURN
  66.                CALL ECCTAB(ITTBAS,'MOT',I0,X0,'REACTION',L0,IP0,
  67.      &                        'CHPOINT',I1,X1,' ',L1,MCHPO1)
  68.                GOTO 20
  69.             ENDIF
  70.          ENDIF
  71.          CALL ECROBJ('TABLE   ',ITBAS)
  72.          RETURN
  73.       ENDIF
  74.       CALL LIROBJ ('CHPOINT ',MCHPOI,1,IRETOU)
  75.       CALL ACTOBJ ('CHPOINT ',MCHPOI,1)
  76.       IF(IERR.NE.0) RETURN
  77.       CALL REACT1(MRIGID,MCHPOI,MCHPO1)
  78.       IF(IERR.NE.0) RETURN
  79.       CALL ACTOBJ('CHPOINT ',MCHPO1,1)
  80.       CALL ECROBJ('CHPOINT ',MCHPO1)
  81.       RETURN
  82. *
  83.  1100 CONTINUE
  84.             IB = 0
  85.  1120    CONTINUE
  86.             TYPRET = ' '
  87.             IB = IB + 1
  88.             CALL ACCTAB(ITBAS,'ENTIER',IB,X0,' ',L0,IP0,
  89.      &                         TYPRET,I1,X1,CHARRE,L1,ITTBAS)
  90.             IF (ITTBAS.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
  91.               IF (MRIGID.GT.0) THEN
  92.                CALL ACCTAB(ITTBAS,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  93.      &                        'CHPOINT',I1,X1,' ',L1,MCHPOI)
  94.                CALL REACT1(MRIGID,MCHPOI,MCHPO1)
  95.                IF(IERR.NE.0) RETURN
  96.                CALL ECCTAB(ITTBAS,'MOT',I0,X0,'REACTION',L0,IP0,
  97.      &                        'CHPOINT',I1,X1,' ',L1,MCHPO1)
  98.               ENDIF
  99.                GOTO 1120
  100.             ENDIF
  101.  
  102.          CALL ECROBJ('TABLE   ',ITBAS)
  103.          RETURN
  104.       END
  105.  
  106.  
  107.  

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