Télécharger green.eso

Retour à la liste

Numérotation des lignes :

  1. C GREEN SOURCE FANDEUR 10/12/14 21:16:58 6812
  2. C
  3. SUBROUTINE GREEN
  4. C ======================================================================
  5. C FABRICATION D'UN OBJET EVOLUTION CONTENANT LES FONCTIONS
  6. C DE GREEN D'UN ELEMENT DE POUTRE
  7. C
  8. C EVOL1 = GREEN STR1 TEMPS DT1
  9. C I BERNOUILLI-EULER I NON-FILTRE
  10. C I I FILTRE FREQ1 FREQ2 (AMORTISSEMENT EPS
  11. C I
  12. C I TIMOSHENKO FILTRE FREQ1 FREQ2 (AMORTISSEMENT EPS)
  13. C
  14. C STR1 : OBJET STRUCTURE CONTENANT L'ELEMENT DE POUTRE
  15. C TEMPS : VALEUR DU TEMPS DE CALCUL
  16. C DT1 : VALEUR DU PAS DE TEMPS
  17. C
  18. C 2 MODELES POSSIBLES : BERNOUILLI-EULER OU TIMOSHENKO
  19. C FILTRE : FONCTIONS DE GREEN FILTREES
  20. C FREQ1 : FREQUENCE BASSE DE FILTRAGE
  21. C FREQ2 : FREQUENCE HAUTE DE FILTRAGE
  22. C
  23. C POUR LES FONCTIONS DE GREEN FILTREES EN OPTION :
  24. C AMORTISSEMENT DE VALEUR EPS
  25. C
  26. C L ACCES AUX VERSIONS 2 ET 3 EST SUPPRIME AINSI QUE L UTILISATION
  27. C D UN FILTRE F1 F2
  28. C
  29. C EVOL1 : OBJET EVOLUTION CONTENANT LES FCTS DE GREEN
  30. C
  31. C PROGRAMMEUR : GUILBAUD
  32. C CREATION : 21/09/87
  33. C MODIFICATIONS: LIONEL VIVAN 18/02/88
  34. C : PASCAL MANIGOT 22/02/88
  35. C : XAVIER VACELET 09/01/89
  36. C ======================================================================
  37. C
  38. IMPLICIT INTEGER(I-N)
  39. IMPLICIT REAL*8(A-H,O-Z)
  40. -INC CCOPTIO
  41. -INC CCREEL
  42.  
  43. -INC SMCHAML
  44. -INC SMCOORD
  45. -INC SMELEME
  46. -INC SMSTRUC
  47. PARAMETER (NBRMOT=3)
  48. CHARACTER*8 LISMOT(NBRMOT)
  49. DATA LISMOT/'FILTRE ','VERSION ','INTEGRAT'/
  50. C
  51. CALL LIROBJ ('STRUCTUR',MSTRUC,1,IRETOU)
  52. IF(IERR.NE.0) RETURN
  53. SEGACT MCOORD
  54. SEGACT MSTRUC
  55. NSTR= LISTRU(/1)
  56. IF(NSTR.NE.1) THEN
  57. C *** LA SOUS-STRUCTURE DOIT ETRE ELEMENTAIRE
  58. INTERR(1)=MSTRUC
  59. CALL ERREUR(90)
  60. RETURN
  61. ENDIF
  62. MSOSTU =LISTRU(1)
  63. SEGACT MSOSTU
  64. MCHELM=ISCHAM(1)
  65. MCHEL1=ISCHAM(2)
  66. SEGDES MSOSTU
  67. IF(MCHELM.EQ.0.OR.MCHEL1.EQ.0) THEN
  68. C *** LA SOUS-STRUCTURE DOIT ETRE DEFINIE A PARTIR DES CHAMPS PAR ELEMEN
  69. INTERR(1)=MSOSTU
  70. CALL ERREUR(376)
  71. RETURN
  72. ENDIF
  73. SEGACT MCHELM,MCHEL1
  74. NSOUS=IMACHE(/1)
  75. IF(NSOUS.NE.1) THEN
  76. C *** LA SOUS-STRUCTURE DOIT ETRE COMPOSEE D'UNE SEULE ZONE D'ELEMENTS
  77. INTERR(1)=MSOSTU
  78. CALL ERREUR(377)
  79. RETURN
  80. ENDIF
  81. MELEME=IMACHE(1)
  82. SEGACT MELEME
  83. IF(ITYPEL.NE.2) THEN
  84. C *** LA SOUS-STRUCTURE DOIT ETRE COMPOSEE D'ELEMENTS SEG2
  85. INTERR(1)=MSOSTU
  86. CALL ERREUR(378)
  87. RETURN
  88. ENDIF
  89. NBELEM=NUM(/2)
  90. IF(NBELEM.NE.1) THEN
  91. C *** LA SOUS-STRUCTURE DOIT ETRE COMPOSEE D'UN SEUL ELEMENT
  92. INTERR(1)=MSOSTU
  93. CALL ERREUR(379)
  94. RETURN
  95. ENDIF
  96. C
  97. NCOO1=(NUM(1,1)-1)*(IDIM+1)
  98. NCOO2=(NUM(2,1)-1)*(IDIM+1)
  99. XE1=XCOOR(NCOO1+1)
  100. XE2=XCOOR(NCOO2+1)
  101. YE1=XCOOR(NCOO1+2)
  102. YE2=XCOOR(NCOO2+2)
  103. ZE1=XCOOR(NCOO1+3)
  104. ZE2=XCOOR(NCOO2+3)
  105. XL=XE2-XE1
  106. YL=YE2-YE1
  107. ZL=ZE2-ZE1
  108. DLL=SQRT(XL*XL+YL*YL+ZL*ZL)
  109. SEGDES MELEME
  110. C
  111. KMATER=ICHAML(1)
  112. KCARAC=MCHEL1.ICHAML(1)
  113. C
  114. SEGDES MCHELM,MCHEL1
  115. SEGDES MSTRUC
  116. IF(DLL.EQ.0.D0) THEN
  117. C *** L'ELEMENT EST DE LONGUEUR NULLE
  118. INTERR(1)=MSOSTU
  119. CALL ERREUR(381)
  120. RETURN
  121. ENDIF
  122. C
  123. CALL LIRREE (TEMPS,1,IRETOU)
  124. IF(IERR.NE.0) RETURN
  125. CALL LIRREE (DT1,1,IRETOU)
  126. IF(IERR.NE.0) RETURN
  127. IF ((TEMPS.LE.0.D0) .OR. (DT1.LE.0.D0)) THEN
  128. C VALEURS DE TEMPS NEGATIVES OU NULLES
  129. CALL ERREUR(414)
  130. RETURN
  131. END IF
  132. IF (TEMPS.LT.DT1) THEN
  133. FA=TEMPS
  134. TEMPS=DT1
  135. DT1=FA
  136. END IF
  137. *
  138. IVERS = 1
  139. F1=0.D0
  140. F2=0.D0
  141. NIN0 = 4
  142. NIN = NIN0
  143. DO 10 I=1,NBRMOT
  144. CALL LIRMOT(LISMOT,NBRMOT,IMOT,0)
  145. IF (IMOT.LE.0) THEN
  146. * EXIT
  147. GOTO 20
  148. END IF
  149. IF (IMOT.EQ.1) THEN
  150. CALL LIRREE (F1,1,IRETOU)
  151. IF (IERR.NE.0) RETURN
  152. CALL LIRREE (F2,1,IRETOU)
  153. IF (IERR.NE.0) RETURN
  154. IF ((F1.LT.0.D0) .OR. (F2.LT.0.D0)) THEN
  155. C FREQUENCE DE FILTRE NEGATIVE
  156. CALL ERREUR(375)
  157. RETURN
  158. END IF
  159. IF (F2.LT.F1) THEN
  160. FA=F1
  161. F1=F2
  162. F2=FA
  163. END IF
  164. ELSE IF (IMOT.EQ.2) THEN
  165. CALL LIRENT (IVERS,1,IRETOU)
  166. IF (IERR.NE.0) RETURN
  167. ELSE IF (IMOT.EQ.3) THEN
  168. CALL LIRENT (NIN,1,IRETOU)
  169. IF (IERR.NE.0) RETURN
  170. IF (NIN.LT.1 .OR. NIN.GT.4) THEN
  171. INTERR(1) = NIN
  172. NIN=NIN0
  173. INTERR(2) = NIN
  174. CALL ERREUR(413)
  175. END IF
  176. END IF
  177. 10 CONTINUE
  178. 20 CONTINUE
  179. C
  180. IF (IVERS .EQ. 2) THEN
  181. CALL GREEN2 (KMATER,KCARAC,DLL,TEMPS,DT1,F1,F2,NIN, IGREEN)
  182. ELSE IF (IVERS .EQ. 3) THEN
  183. CALL GREEN3 (KMATER,KCARAC,DLL,TEMPS,DT1,F1,F2,NIN, IGREEN)
  184. ELSE
  185. CALL GREEN1 (KMATER,KCARAC,DLL,TEMPS,DT1,F1,F2, IGREEN)
  186. END IF
  187. C
  188. CALL ECROBJ ('EVOLUTIO',IGREEN)
  189. C
  190. RETURN
  191. END
  192.  
  193.  
  194.  

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