Télécharger la plaquette Cast3M


fr en

Télécharger cremod.eso

Retour à la liste

Numérotation des lignes : 

cremod

  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.  
  66. -INC PPARAM
  67. -INC CCOPTIO
  68. *
  69.       REAL*8 PROPRE(*),FREQ,GDEPL1,GDEPL2,GDEPL3,FREQPP,GMASSE
  70. *
  71. *
  72. *
  73. *     VALEURS LITTERALES POUR LE SOUS-PROGRAMME "MANUMO":
  74. *
  75. *     FREQPP = PROPRE(1)
  76. *     GMASSE = PROPRE(2)
  77. *     GDEPL1 = PROPRE(3)
  78. *     GDEPL2 = PROPRE(4)
  79. *     GDEPL3 = PROPRE(5)
  80. *
  81. *     -- NUMERO DU MODE TROUVE --
  82. *
  83.       CALL DIAGN1 (IPKW2M,NMODEN)
  84.       IF (IERR .NE. 0) RETURN
  85. *      IF (NUMODE2.EQ. 0) THEN
  86. *       FREQPP = PROPRE(1)
  87. *       IF (FREQPP .GE. FREQ) THEN
  88. *         NUMODE = NUMODE + 1
  89. *       END IF
  90. *      ENDIF
  91.       NUMODE = NMODEN + NUMODE2
  92.       NUMODE = NUMODE - INF0
  93. *         write(6,*)'cremod : (NMODEN + NUMODE2) - INFO = NUMODE'
  94. *         write(6,*) NMODEN,NUMODE2,INF0,NUMODE
  95.       IF (IIMPI .EQ. 747) THEN
  96.          WRITE (IOIMP,*) 'NUMERO DU MODE OBTENU = ',NUMODE
  97.          WRITE (IOIMP,*) '---------------------'
  98.       END IF
  99. *
  100. *     RQ: PAR SOUCIS D'ECONOMIE, ON NE CHERCHE PAS LE NUMERO DU MODE
  101. *         TROUVE EN DECOMPOSANT LA 'RIGIDITE' DECALEE DE LA VALEUR
  102. *         EXACTE DE LA PULSATION PROPRE AU CARRE.
  103. *         LE RESULTAT EST QUE, SI L'ON EST EN PRESENCE D'UN MODE
  104. *         MULTIPLE DE FREQUENCE PROPRE INFERIEURE AU DECALAGE APPROCHE
  105. *         EFFECTUE SUR "K", ALORS "NUMODE" SERA EGAL AU NUMERO D'ORDRE
  106. *         DE LA FREQUENCE PROPRE + (ORDRE DE MULTIPLICITE) - 1 AU LIEU
  107. *         D'ETRE EGAL SIMPLEMENT AU NUMERO D'ORDRE DE LA FREQUENCE.
  108. *
  109. *     -- CREATION DU MODE --
  110. *
  111. *  ATTENTION LES FLOTTANTS PASSES A ECRIRE DOIVENT ETRE
  112. *  EN SIMPLE PRECISION
  113. *     CALL ECROBJ ('CHPOINT ',IPVECP)
  114. *     CALL ECRREE (GDEPL3)
  115. *     CALL ECRREE (GDEPL2)
  116. *     CALL ECRREE (GDEPL1)
  117. *     CALL ECRREE (GMASSE)
  118. *     CALL ECRREE (FREQPP)
  119. *     CALL ECRENT (NUMODE)
  120. *     CALL ECRCHA ('NUME')
  121. *     CALL MANUMO
  122. *
  123.       CALL MANUSO('MODE    ',NUMODE,PROPRE(1),PROPRE(2),PROPRE(3)
  124.      C ,PROPRE(4),PROPRE(5),IPVECP,0,0,IPMODE)
  125. *
  126.       IF (IERR .NE. 0) RETURN
  127.       ICODE = 1
  128. *     CALL LIROBJ ('SOLUTION',IPMODE,ICODE,IRETOU)
  129. *     IF (IERR .NE. 0) RETURN
  130. *
  131.       END
  132.  
  133.  
  134.  

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