Télécharger qztrir.eso

Retour à la liste

Numérotation des lignes :

qztrir
  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
  51. CALL TYPRIG(MRIGID, LISTYP, 3, RANG)
  52. ELSE
  53. RANG = 3
  54. ENDIF
  55. RANGRIG(I)=RANG
  56. IF (AFFICH) THEN
  57. WRITE (*,*) 'Matrice ', I, ' de type ',LISTYP(RANGRIG(I))
  58. ENDIF
  59. 10 CONTINUE
  60. *
  61. IF ((RANGRIG(1)*RANGRIG(2)*RANGRIG(3).EQ.6)) THEN
  62. LSTRIG(RANGRIG(1)) = IPMAS
  63. LSTRIG(RANGRIG(2)) = IPRIG
  64. LSTRIG(RANGRIG(3)) = IPAMO
  65. IPMAS = LSTRIG(1)
  66. IPRIG = LSTRIG(2)
  67. IPAMO = LSTRIG(3)
  68. ELSE
  69. IF (AFFICH) THEN
  70. WRITE (*,*) 'Matrices indiscernables:procedure de tri ignoree'
  71. ENDIF
  72. ENDIF
  73. *
  74. END
  75.  
  76.  
  77.  
  78.  

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