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