Esope source files

   1 : C QZTRIR    SOURCE    CHAT      05/01/13    02:43:33     5004           
   2 :       SUBROUTINE QZTRIR (IPMAS, IPRIG, IPAMO)
   3 : *
   4 : ************************************************************************************
   5 : *                      RECONNAISSANCE ET TRI DES RIGIDITES                         *
   6 : *            MASSE, RIGIDITE ET AMORTISSEMENT EN ENTREE DE VIBRAC                  *
   7 : * ________________________________________________________________________________ *
   8 : *                                                                                  *
   9 : *     DATE : le 8 juin 1995                                                        *
  10 : *     AUTEUR : Nicolas BENECH                                                      *
  11 : * ________________________________________________________________________________ *
  12 : *                                                                                  *
  13 : *     MODULE(S) APPELANT(S) : VIBRAC                                               *
  14 : *                                                                                  *
  15 : *     MODULE(S) APPELE(S) : TYPRIG                                                 *
  16 : * ________________________________________________________________________________ *
  17 : *                                                                                  *
  18 : *     EN ENTREE :                                                                  *
  19 : *           IPMAS, IPRIG, IPAMO : Rigidites                                        *
  20 : *                                                                                  *
  21 : *     EN SORTIE :                                                                  *
  22 : *           IPMAS : Rigidite 'MASSE'                                               *
  23 : *           IPRIG : Rigidite 'RIGIDITE'                                            *
  24 : *           IPAMO : Rigidite 'AMORTISSEMENT'                                       *
  25 : * ________________________________________________________________________________ *
  26 : *                                                                                  *
  27 : *     REMARQUES :                                                                  *
  28 : *          -->   si les sous-types ne correspondent pas aux sous-types MASSE,      *
  29 : *                RIGIDITE ou AMORTISSEMENT l'ordre des rigidites n'est pas modifie * 
  30 : *          -->   une rigidite peut-etre eventuellement absente. Pour VIBC il ne    *
  31 : *                s'agir que de l'AMORTISSEMENT                                     *
  32 : ************************************************************************************
  33 : *
  34 :       IMPLICIT INTEGER(I-N)
  35 :       CHARACTER*8 LISTYP(3)
  36 :       INTEGER LSTRIG(3), RANGRIG(3), I, RANG
  37 :       LOGICAL AFFICH
  38 : *
  39 :       DATA LISTYP/'MASSE   ','RIGIDITE', 'AMORTISS'/
  40 : *
  41 : *--- Affichage des messages
  42 :       AFFICH =.FALSE.
  43 : *
  44 :       LSTRIG(1)=IPMAS
  45 :       LSTRIG(2)=IPRIG
  46 :       LSTRIG(3)=IPAMO
  47 : *
  48 :       DO 10, I=1, 3
  49 :         MRIGID=LSTRIG(I)
  50 :         IF (MRIGID.NE.0) THEN
  50 :           CALL TYPRIG(MRIGID, LISTYP, 3, RANG)
  51 :         ELSE
  52 :           RANG = 3
  53 :         ENDIF
  54 :         RANGRIG(I)=RANG
  55 :         IF (AFFICH) THEN
  56 :             WRITE (*,*) 'Matrice ', I, ' de type ',LISTYP(RANGRIG(I))
  57 :         ENDIF
  58 :  10   CONTINUE
  59 : *
  60 :       IF ((RANGRIG(1)*RANGRIG(2)*RANGRIG(3).EQ.6)) THEN
  61 :         LSTRIG(RANGRIG(1)) = IPMAS
  62 :         LSTRIG(RANGRIG(2)) = IPRIG
  63 :         LSTRIG(RANGRIG(3)) = IPAMO
  64 :         IPMAS = LSTRIG(1)
  65 :         IPRIG = LSTRIG(2)
  66 :         IPAMO = LSTRIG(3)
  67 :       ELSE
  68 :        IF (AFFICH) THEN 
  69 :         WRITE (*,*) 'Matrices indiscernables:procedure de tri ignoree'
  70 :        ENDIF
  71 :       ENDIF
  72 : *
  73 :       END
  74 :  
  75 :  
  76 :