Télécharger elfgr0.eso

Retour à la liste

Numérotation des lignes :

  1. C ELFGR0 SOURCE CHAT 05/01/12 23:31:56 5004
  2. SUBROUTINE ELFGR0(KGREEN,DELTAT,NPAS, KGREE2)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * E L F G R 0
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * TRANSFORMER LES FONCTIONS DE GREEN ET DERIVEES EN INTEGRALES SUR
  14. * LES PAS DE TEMPS DE CALCUL.
  15. *
  16. * MODULES UTILISES:
  17. * -----------------
  18. *
  19. -INC CCOPTIO
  20. -INC SMEVOLL
  21. -INC SMLREEL
  22. *
  23. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  24. * -----------
  25. *
  26. * KGREEN (E) OBJET "EVOLUTION" CONTENANT LES FONCTIONS DE GREEN.
  27. * DELTAT (E) PAS DE TEMPS DU CALCUL.
  28. * NPAS (E) NOMBRE DE PAS DE CALCUL.
  29. * KGREE2 (S) OBJET "EVOLUTION" CONTENANT LES INTEGRALES DES
  30. * FONCTIONS DE GREEN.
  31. *
  32. REAL*8 DELTAT
  33. *
  34. * VARIABLES:
  35. * ----------
  36. *
  37. CHARACTER*72 ITEX
  38. LOGICAL TRACTI,TORSIO
  39. *
  40. * AUTEUR, DATE DE CREATION:
  41. * -------------------------
  42. *
  43. * PASCAL MANIGOT 29 MARS 1988
  44. *
  45. * LANGAGE:
  46. * --------
  47. *
  48. * ESOPE + FORTRAN77
  49. *
  50. ************************************************************************
  51. *
  52. MEVOL1 = KGREEN
  53. SEGACT MEVOL1
  54. NBEL = MEVOL1.IEVOLL(/1)
  55. IF (MOD(NBEL,28).NE.0) THEN
  56. * IL MANQUE DES FONCTIONS DE GREEN
  57. CALL ERREUR(388)
  58. SEGDES MEVOL1
  59. RETURN
  60. END IF
  61. *
  62. ITEX = MEVOL1.IEVTEX
  63. IND = INDEX(ITEX,'VERSION')
  64. IF (IND .NE. 0) THEN
  65. READ (ITEX(IND+7:IND+7),'(I1)') IVERS
  66. END IF
  67. *
  68. IF (IND.EQ.0 .OR. IVERS.EQ.1) THEN
  69. KGREE2 = KGREEN
  70. * INUTILE DE DESACTIVER: CA VA RESSERVIR BIENTOT.
  71. RETURN
  72. END IF
  73. *
  74. * ON DEPASSE LE TEMPS MINIMUM NECESSAIRE POUR PALIER A
  75. * DES ERREURS D'ARRONDI SUR DES CUMULS DE PAS DE TEMPS
  76. TMAX = (NPAS + 1) * DELTAT
  77. *
  78. * CALCUL DES FONCTIONS INTEGRALES:
  79. TINI = 0.D0
  80. CALL SOMME1 (KGREEN,TINI,TMAX,DELTAT, KGREE2)
  81. IF (IERR .NE. 0) RETURN
  82. *
  83. MEVOLL = KGREE2
  84. SEGACT,MEVOLL,MEVOL1
  85. NBEL = NBEL/28 - 1
  86. *
  87. *
  88. * BOUCLAGE SUR LES DIFFERENTS TYPES DE POUTRES:
  89. DO 200 NB=0,NBEL
  90. *
  91. DO 280 J=1,28
  92. TRACTI = J.EQ.1.OR.J.EQ.2.OR.J.EQ.15.OR.J.EQ.16
  93. TORSIO = J.EQ.3.OR.J.EQ.4.OR.J.EQ.17.OR.J.EQ.18
  94. *
  95. KEVOLL = IEVOLL(NB*28+J)
  96. SEGACT KEVOLL
  97. *
  98. IF (TRACTI.OR.TORSIO) THEN
  99. *
  100. ITEX = KEVTEX
  101. READ (ITEX(24:35),FMT='(1PE12.5)') CT
  102. READ (ITEX(43:54),FMT='(1PE12.5)') RT
  103. CSR = CT / RT
  104. CSR1 = - CSR
  105. MLREEL = IPROGY
  106. SEGACT MLREEL
  107. NBINTG = PROG(/1)
  108. *
  109. IF ((J/2)*2 .NE. J) THEN
  110. * INTEGRALE DE "G"
  111. CALL MULVE1 (CSR,PROG,NBINTG)
  112. IF (IIMPI .EQ. 1806) THEN
  113. IF (TRACTI) THEN
  114. WRITE (IOIMP,*) 'INTEGRALE DE G'
  115. WRITE (IOIMP,*) (PROG(NP),NP=1,NBINTG)
  116. END IF
  117. END IF
  118. ELSE
  119. * INTEGRALE DE "DG/DX"
  120. CALL MULVE1 (CSR1,PROG,NBINTG)
  121. IF (IIMPI .EQ. 1806) THEN
  122. IF (TRACTI) THEN
  123. WRITE (IOIMP,*) 'INTEGRALE DE DG/DX'
  124. WRITE (IOIMP,*) (PROG(NP),NP=1,NBINTG)
  125. END IF
  126. END IF
  127. END IF
  128. *
  129. SEGDES,MLREEL
  130. *
  131. ELSE
  132. * FLEXION
  133. *
  134. *+* READ (ITEX(43:54),FMT='(1PE12.5)') RFZ
  135. *
  136. * EN FLEXION, LA VERSION 2 N'EXISTE PAS ENCORE. LES
  137. * INTEGRALES CALCULEES SONT BIDON ET LES BONNES SONT DANS
  138. * LE "KEVOLL" ORIGINEL:
  139. *
  140. KEVOL1 = MEVOL1.IEVOLL(NB*28+J)
  141. SEGACT,KEVOL1
  142. MLREE1 = KEVOL1.IPROGY
  143. SEGINI,MLREEL=MLREE1
  144. IPROGY = MLREEL
  145. SEGDES,MLREEL
  146. SEGDES,KEVOL1
  147. *
  148. END IF
  149. *
  150. SEGDES,KEVOLL
  151. *
  152. 280 CONTINUE
  153. * END DO
  154. *
  155. 200 CONTINUE
  156. * END DO
  157. *
  158. SEGDES,MEVOLL,MEVOL1
  159. *
  160. END
  161.  
  162.  

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