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.  
  41. -INC PPARAM
  42. -INC CCOPTIO
  43. -INC CCREEL
  44.  
  45. -INC SMCHAML
  46. -INC SMCOORD
  47. -INC SMELEME
  48. -INC SMSTRUC
  49. PARAMETER (NBRMOT=3)
  50. CHARACTER*8 LISMOT(NBRMOT)
  51. DATA LISMOT/'FILTRE ','VERSION ','INTEGRAT'/
  52. C
  53. CALL LIROBJ ('STRUCTUR',MSTRUC,1,IRETOU)
  54. IF(IERR.NE.0) RETURN
  55. SEGACT MCOORD
  56. SEGACT MSTRUC
  57. NSTR= LISTRU(/1)
  58. IF(NSTR.NE.1) THEN
  59. C *** LA SOUS-STRUCTURE DOIT ETRE ELEMENTAIRE
  60. INTERR(1)=MSTRUC
  61. CALL ERREUR(90)
  62. RETURN
  63. ENDIF
  64. MSOSTU =LISTRU(1)
  65. SEGACT MSOSTU
  66. MCHELM=ISCHAM(1)
  67. MCHEL1=ISCHAM(2)
  68. SEGDES MSOSTU
  69. IF(MCHELM.EQ.0.OR.MCHEL1.EQ.0) THEN
  70. C *** LA SOUS-STRUCTURE DOIT ETRE DEFINIE A PARTIR DES CHAMPS PAR ELEMEN
  71. INTERR(1)=MSOSTU
  72. CALL ERREUR(376)
  73. RETURN
  74. ENDIF
  75. SEGACT MCHELM,MCHEL1
  76. NSOUS=IMACHE(/1)
  77. IF(NSOUS.NE.1) THEN
  78. C *** LA SOUS-STRUCTURE DOIT ETRE COMPOSEE D'UNE SEULE ZONE D'ELEMENTS
  79. INTERR(1)=MSOSTU
  80. CALL ERREUR(377)
  81. RETURN
  82. ENDIF
  83. MELEME=IMACHE(1)
  84. SEGACT MELEME
  85. IF(ITYPEL.NE.2) THEN
  86. C *** LA SOUS-STRUCTURE DOIT ETRE COMPOSEE D'ELEMENTS SEG2
  87. INTERR(1)=MSOSTU
  88. CALL ERREUR(378)
  89. RETURN
  90. ENDIF
  91. NBELEM=NUM(/2)
  92. IF(NBELEM.NE.1) THEN
  93. C *** LA SOUS-STRUCTURE DOIT ETRE COMPOSEE D'UN SEUL ELEMENT
  94. INTERR(1)=MSOSTU
  95. CALL ERREUR(379)
  96. RETURN
  97. ENDIF
  98. C
  99. NCOO1=(NUM(1,1)-1)*(IDIM+1)
  100. NCOO2=(NUM(2,1)-1)*(IDIM+1)
  101. XE1=XCOOR(NCOO1+1)
  102. XE2=XCOOR(NCOO2+1)
  103. YE1=XCOOR(NCOO1+2)
  104. YE2=XCOOR(NCOO2+2)
  105. ZE1=XCOOR(NCOO1+3)
  106. ZE2=XCOOR(NCOO2+3)
  107. XL=XE2-XE1
  108. YL=YE2-YE1
  109. ZL=ZE2-ZE1
  110. DLL=SQRT(XL*XL+YL*YL+ZL*ZL)
  111. SEGDES MELEME
  112. C
  113. KMATER=ICHAML(1)
  114. KCARAC=MCHEL1.ICHAML(1)
  115. C
  116. SEGDES MCHELM,MCHEL1
  117. SEGDES MSTRUC
  118. IF(DLL.EQ.0.D0) THEN
  119. C *** L'ELEMENT EST DE LONGUEUR NULLE
  120. INTERR(1)=MSOSTU
  121. CALL ERREUR(381)
  122. RETURN
  123. ENDIF
  124. C
  125. CALL LIRREE (TEMPS,1,IRETOU)
  126. IF(IERR.NE.0) RETURN
  127. CALL LIRREE (DT1,1,IRETOU)
  128. IF(IERR.NE.0) RETURN
  129. IF ((TEMPS.LE.0.D0) .OR. (DT1.LE.0.D0)) THEN
  130. C VALEURS DE TEMPS NEGATIVES OU NULLES
  131. CALL ERREUR(414)
  132. RETURN
  133. END IF
  134. IF (TEMPS.LT.DT1) THEN
  135. FA=TEMPS
  136. TEMPS=DT1
  137. DT1=FA
  138. END IF
  139. *
  140. IVERS = 1
  141. F1=0.D0
  142. F2=0.D0
  143. NIN0 = 4
  144. NIN = NIN0
  145. DO 10 I=1,NBRMOT
  146. CALL LIRMOT(LISMOT,NBRMOT,IMOT,0)
  147. IF (IMOT.LE.0) THEN
  148. * EXIT
  149. GOTO 20
  150. END IF
  151. IF (IMOT.EQ.1) THEN
  152. CALL LIRREE (F1,1,IRETOU)
  153. IF (IERR.NE.0) RETURN
  154. CALL LIRREE (F2,1,IRETOU)
  155. IF (IERR.NE.0) RETURN
  156. IF ((F1.LT.0.D0) .OR. (F2.LT.0.D0)) THEN
  157. C FREQUENCE DE FILTRE NEGATIVE
  158. CALL ERREUR(375)
  159. RETURN
  160. END IF
  161. IF (F2.LT.F1) THEN
  162. FA=F1
  163. F1=F2
  164. F2=FA
  165. END IF
  166. ELSE IF (IMOT.EQ.2) THEN
  167. CALL LIRENT (IVERS,1,IRETOU)
  168. IF (IERR.NE.0) RETURN
  169. ELSE IF (IMOT.EQ.3) THEN
  170. CALL LIRENT (NIN,1,IRETOU)
  171. IF (IERR.NE.0) RETURN
  172. IF (NIN.LT.1 .OR. NIN.GT.4) THEN
  173. INTERR(1) = NIN
  174. NIN=NIN0
  175. INTERR(2) = NIN
  176. CALL ERREUR(413)
  177. END IF
  178. END IF
  179. 10 CONTINUE
  180. 20 CONTINUE
  181. C
  182. IF (IVERS .EQ. 2) THEN
  183. CALL GREEN2 (KMATER,KCARAC,DLL,TEMPS,DT1,F1,F2,NIN, IGREEN)
  184. ELSE IF (IVERS .EQ. 3) THEN
  185. CALL GREEN3 (KMATER,KCARAC,DLL,TEMPS,DT1,F1,F2,NIN, IGREEN)
  186. ELSE
  187. CALL GREEN1 (KMATER,KCARAC,DLL,TEMPS,DT1,F1,F2, IGREEN)
  188. END IF
  189. C
  190. CALL ECROBJ ('EVOLUTIO',IGREEN)
  191. C
  192. RETURN
  193. END
  194.  
  195.  
  196.  

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