Download rigmod.eso

Back to the list

   1 : C RIGMOD    SOURCE    CHAT      09/10/09    21:23:58     6519           
   2 : C RIGMOD    SOURCE    PETI      88/08/12    21:14:26
   3 :       SUBROUTINE RIGMOD(IMODE,IRIG,IRET)
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)
   6 : C
   7 : C=======================================================================
   8 : C  CE SUBROUTINE CALCULE POUR LES MODES IMODE LES PETITES MATRICES
   9 : C  RIGIDITE CONTENANT LA MASSE (IRIG=1) OU LA RAIDEUR (IRIG=2)GENERALISE
  10 : C  CES MATRICES SONT ASSOCIEES A L ELEMENT QUI CONTIENT LE POINT QUI
  11 : C  EST L INDICE DE CHAQUE MODE . LE RESULTAT EST MIS DANS IRET .
  12 : C  IRIG=3 PREPARATION DE LA MATRICE D'AMORTISSEMENTS MODAUX
  13 : C
  14 : C  OPERATEUR AVEC LA SYNTAXE : K = RIGI M;
  15 : C                    K : OBJET DE TYPE RIGIDITE
  16 : C                    M : OBJET DE TYPE SOLUTION( SOUS TYPE MODE)
  17 : C
  18 : C  PROGRAMME PAR FARVACQUE
  19 : C  APPELE PAR RGBASE RIGI
  20 : C  N'APPELLE RIEN.
  21 : C=======================================================================
  22 : C
  23 : C
  24 : -INC SMRIGID
  25 : -INC SMELEME
  26 : -INC SMSOLUT
  27 : -INC CCREEL
  28 : *- 
  29 : -INC CCOPTIO
  30 : C
  31 :       IRET=0
  32 :       IF(IRIG.NE.1.AND.IRIG.NE.2.AND.IRIG.NE.3) GOTO 5000
  33 :       MSOLUT=IMODE
  34 :       IF(MSOLUT.EQ.0) GO TO 5000
  35 :       SEGACT MSOLUT
  36 :       NIPO=MSOLIS(/1)
  37 :       MSOLEN=MSOLIS(4)
  38 :       MELEME=MSOLIS(3)
  39 :       SEGACT MSOLEN
  40 :       SEGACT MELEME*MOD
  41 :       LTAB=ISOLEN(/1)
  42 : C
  43 : C  **** NBELEM=NBRE DE POINTS,DE RIGIDITE,D ELEMENTS
  44 : C  **** FABRICATION DES PETITES MATRICES
  45 : C
  46 :       NELRIG=LTAB
  47 :       NLIGRP=1
  48 :       NLIGRD=1
  49 :       SEGINI xMATRI
  50 :       ITYPEL=1
  51 :       DO 3 IR=1,NELRIG
  52 :       MMODE=ISOLEN(IR)
  53 :       SEGACT MMODE
  54 : *      SEGINI XMATRI
  55 :       IF(IRIG.NE.1) GO TO 4
  56 :       RE(1,1,ir)=FMMODD(2)
  57 :       GO TO 10
  58 :  4    CONTINUE
  59 :       OMEG=2.*XPI*FMMODD(1)
  60 :       IF(IRIG.EQ.3) GOTO 20
  61 :       OMEG=OMEG*OMEG
  62 :       RE(1,1,ir)=FMMODD(2)*OMEG
  63 :       GOTO 10
  64 :    20 RE(1,1,ir)=FMMODD(2)*OMEG*2.
  65 :  10   CONTINUE
  66 :       SEGDES MMODE
  67 : *      IMATTT(IR)=XMATRI
  68 :  3    CONTINUE
  69 :       SEGDES MSOLUT,xMATRI,MSOLEN
  70 :       NLIGRP=1
  71 :       NLIGRD=1
  72 :       SEGINI DESCR
  73 :       NOELEP(1)=1
  74 :       NOELED(1)=1
  75 :       LISINC(1)='ALFA'
  76 :       LISDUA(1)='FALF'
  77 :       SEGDES DESCR
  78 :       NRIGE=6
  79 :       NRIGEL=1
  80 :       SEGINI MRIGID
  81 :       IFORIG=IFOMOD
  82 :       COERIG(1)=1.D0
  83 :       IMGEO1=0
  84 :       IMGEO2=0
  85 :       ICHOLE=0
  86 :       IRIGEL(1,1)=MELEME
  87 :       IRIGEL(2,1)=0
  88 :       IRIGEL(3,1)=DESCR
  89 :       IRIGEL(4,1)=xMATRI
  90 :       IRIGEL(5,1)=NIFOUR
  91 :       IRIGEL(6,1)=0
  92 :       IF(IRIG.NE.1) GO TO 11
  93 :       MTYMAT='MASSE'
  94 :       GOTO 13
  95 :   11  IF(IRIG.NE.2) GO TO 12
  96 :       MTYMAT='RIGIDITE'
  97 :       GOTO 13
  98 :    12 MTYMAT='AMORMODA'
  99 :    13 CONTINUE
 100 :       SEGDES MRIGID
 101 :       SEGDES MELEME
 102 :       IRET=MRIGID
 103 :  5000 CONTINUE
 104 :       RETURN
 105 :       END
 106 :  
 107 :  

© Cast3M 2003 - All rights reserved.
Disclaimer