Télécharger cremod.eso

Retour à la liste

Numérotation des lignes :

  1. C CREMOD SOURCE BP208322 09/03/20 21:15:06 6331
  2. * SUBROUTINE CREMOD (PROPRE,IPVECP,IPKW2M,INF0,FREQ,
  3. * > NUMODE2,IPMODE)
  4. SUBROUTINE CREMOD (PROPRE,IPVECP,IPKW2M,INF0,
  5. > NUMODE2,IPMODE)
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. ************************************************************************
  9. *
  10. * C R E M O D
  11. * -----------
  12. *
  13. * FONCTION:
  14. * ---------
  15. *
  16. * CREATION DE L'OBJET REPRESENTANT LE MODE PROPRE CALCULE.
  17. *
  18. * MODE D'APPEL:
  19. * -------------
  20. *
  21. * CALL CREMOD (PROPRE,IPVECP,IPKW2M,INF0,FREQ,NUMODE2,IPMODE)
  22. *
  23. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  24. * -----------
  25. *
  26. * PROPRE REEL DP (E) TABLEAU DE CARACTERISTIQUES DU MODE PROPRE
  27. * CALCULE:
  28. * PROPRE(1) = FREQUENCE PROPRE,
  29. * PROPRE(2) = MASSE GENERALISEE,
  30. * PROPRE(3,4 ET 5) = DEPLACEMENTS GENERALISES
  31. * IPVECP ENTIER (E) POINTEUR DU 'CHPOINT' PROPRE.
  32. * IPKW2M ENTIER (E) POINTEUR DE LA 'RIGIDITE' "DECALEE" QUI A
  33. * SERVI AU CALCUL DU MODE PROPRE.
  34. * INF0 ENTIER (E) NOMBRE DE TERMES DIAGONAUX NEGATIFS DE LA
  35. * 'RIGIDITE' "K" NON "DECALEE" LORSQU'ELLE
  36. * EST DECOMPOSEE EN LT.D.L.(il est nul.On
  37. * l'a laissé parce qu'on est paresseux)
  38. * FREQ REEL DP (E) FREQUENCE QUI A ETE UTILISEE POUR LE
  39. * DECALAGE DE LA 'RIGIDITE' "K".
  40. *
  41. * NUMODE2 ENTIER (E) TERME CORRECTIF DANS LE CAS DES ITERATIONS
  42. * SIMULTANEES,POUR CALCULER LE NUMERO DU MODE
  43. * (dans les iterations simples numode2=0)
  44. * IPMODE ENTIER (S) POINTEUR DE L'OBJET 'SOLUTION' REPRESENTANT
  45. * LE MODE PROPRE.
  46. *
  47. * SOUS-PROGRAMMES APPELES:
  48. * ------------------------
  49. *
  50. * DIAGN1, ECR..., LIR.ALL/LIMO.
  51. *
  52. * AUTEUR, DATE DE CREATION:
  53. * -------------------------
  54. *
  55. * PASCAL MANIGOT 28 NOVEMBRE 1984
  56. * MODIF: Benoit Prabel Mars 2009
  57. *
  58. * LANGAGE:
  59. * --------
  60. *
  61. * FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS.
  62. *
  63. ************************************************************************
  64. *
  65. -INC CCOPTIO
  66. *
  67. REAL*8 PROPRE(*),FREQ,GDEPL1,GDEPL2,GDEPL3,FREQPP,GMASSE
  68. *
  69. *
  70. *
  71. * VALEURS LITTERALES POUR LE SOUS-PROGRAMME "MANUMO":
  72. *
  73. * FREQPP = PROPRE(1)
  74. * GMASSE = PROPRE(2)
  75. * GDEPL1 = PROPRE(3)
  76. * GDEPL2 = PROPRE(4)
  77. * GDEPL3 = PROPRE(5)
  78. *
  79. * -- NUMERO DU MODE TROUVE --
  80. *
  81. CALL DIAGN1 (IPKW2M,NMODEN)
  82. IF (IERR .NE. 0) RETURN
  83. * IF (NUMODE2.EQ. 0) THEN
  84. * FREQPP = PROPRE(1)
  85. * IF (FREQPP .GE. FREQ) THEN
  86. * NUMODE = NUMODE + 1
  87. * END IF
  88. * ENDIF
  89. NUMODE = NMODEN + NUMODE2
  90. NUMODE = NUMODE - INF0
  91. * write(6,*)'cremod : (NMODEN + NUMODE2) - INFO = NUMODE'
  92. * write(6,*) NMODEN,NUMODE2,INF0,NUMODE
  93. IF (IIMPI .EQ. 747) THEN
  94. WRITE (IOIMP,*) 'NUMERO DU MODE OBTENU = ',NUMODE
  95. WRITE (IOIMP,*) '---------------------'
  96. END IF
  97. *
  98. * RQ: PAR SOUCIS D'ECONOMIE, ON NE CHERCHE PAS LE NUMERO DU MODE
  99. * TROUVE EN DECOMPOSANT LA 'RIGIDITE' DECALEE DE LA VALEUR
  100. * EXACTE DE LA PULSATION PROPRE AU CARRE.
  101. * LE RESULTAT EST QUE, SI L'ON EST EN PRESENCE D'UN MODE
  102. * MULTIPLE DE FREQUENCE PROPRE INFERIEURE AU DECALAGE APPROCHE
  103. * EFFECTUE SUR "K", ALORS "NUMODE" SERA EGAL AU NUMERO D'ORDRE
  104. * DE LA FREQUENCE PROPRE + (ORDRE DE MULTIPLICITE) - 1 AU LIEU
  105. * D'ETRE EGAL SIMPLEMENT AU NUMERO D'ORDRE DE LA FREQUENCE.
  106. *
  107. * -- CREATION DU MODE --
  108. *
  109. * ATTENTION LES FLOTTANTS PASSES A ECRIRE DOIVENT ETRE
  110. * EN SIMPLE PRECISION
  111. * CALL ECROBJ ('CHPOINT ',IPVECP)
  112. * CALL ECRREE (GDEPL3)
  113. * CALL ECRREE (GDEPL2)
  114. * CALL ECRREE (GDEPL1)
  115. * CALL ECRREE (GMASSE)
  116. * CALL ECRREE (FREQPP)
  117. * CALL ECRENT (NUMODE)
  118. * CALL ECRCHA ('NUME')
  119. * CALL MANUMO
  120. *
  121. CALL MANUSO('MODE ',NUMODE,PROPRE(1),PROPRE(2),PROPRE(3)
  122. C ,PROPRE(4),PROPRE(5),IPVECP,0,0,IPMODE)
  123. *
  124. IF (IERR .NE. 0) RETURN
  125. ICODE = 1
  126. * CALL LIROBJ ('SOLUTION',IPMODE,ICODE,IRETOU)
  127. * IF (IERR .NE. 0) RETURN
  128. *
  129. END
  130.  
  131.  
  132.  

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