Sources Esope | Cast3M

qztrir
C QZTRIR    SOURCE    CHAT      05/01/13    02:43:33     5004
      SUBROUTINE QZTRIR (IPMAS, IPRIG, IPAMO)
*
************************************************************************************
*                      RECONNAISSANCE ET TRI DES RIGIDITES                         *
*            MASSE, RIGIDITE ET AMORTISSEMENT EN ENTREE DE VIBRAC                  *
* ________________________________________________________________________________ *
*                                                                                  *
*     DATE : le 8 juin 1995                                                        *
*     AUTEUR : Nicolas BENECH                                                      *
* ________________________________________________________________________________ *
*                                                                                  *
*     MODULE(S) APPELANT(S) : VIBRAC                                               *
*                                                                                  *
*     MODULE(S) APPELE(S) : TYPRIG                                                 *
* ________________________________________________________________________________ *
*                                                                                  *
*     EN ENTREE :                                                                  *
*           IPMAS, IPRIG, IPAMO : Rigidites                                        *
*                                                                                  *
*     EN SORTIE :                                                                  *
*           IPMAS : Rigidite 'MASSE'                                               *
*           IPRIG : Rigidite 'RIGIDITE'                                            *
*           IPAMO : Rigidite 'AMORTISSEMENT'                                       *
* ________________________________________________________________________________ *
*                                                                                  *
*     REMARQUES :                                                                  *
*          -->   si les sous-types ne correspondent pas aux sous-types MASSE,      *
*                RIGIDITE ou AMORTISSEMENT l'ordre des rigidites n'est pas modifie *
*          -->   une rigidite peut-etre eventuellement absente. Pour VIBC il ne    *
*                s'agir que de l'AMORTISSEMENT                                     *
************************************************************************************
*
      IMPLICIT INTEGER(I-N)
      CHARACTER*8 LISTYP(3)
      INTEGER LSTRIG(3), RANGRIG(3), I, RANG
      LOGICAL AFFICH
*
      DATA LISTYP/'MASSE   ','RIGIDITE', 'AMORTISS'/
*
*--- Affichage des messages
      AFFICH =.FALSE.
*
      LSTRIG(1)=IPMAS
      LSTRIG(2)=IPRIG
      LSTRIG(3)=IPAMO
*
      DO 10, I=1, 3
        MRIGID=LSTRIG(I)
        IF (MRIGID.NE.0) THEN
          CALL TYPRIG(MRIGID, LISTYP, 3, RANG)
        ELSE
          RANG = 3
        ENDIF
        RANGRIG(I)=RANG
        IF (AFFICH) THEN
            WRITE (*,*) 'Matrice ', I, ' de type ',LISTYP(RANGRIG(I))
        ENDIF
 10   CONTINUE
*
      IF ((RANGRIG(1)*RANGRIG(2)*RANGRIG(3).EQ.6)) THEN
        LSTRIG(RANGRIG(1)) = IPMAS
        LSTRIG(RANGRIG(2)) = IPRIG
        LSTRIG(RANGRIG(3)) = IPAMO
        IPMAS = LSTRIG(1)
        IPRIG = LSTRIG(2)
        IPAMO = LSTRIG(3)
      ELSE
       IF (AFFICH) THEN
        WRITE (*,*) 'Matrices indiscernables:procedure de tri ignoree'
       ENDIF
      ENDIF
*
      END