1 : C GREEN1 SOURCE FANDEUR 10/12/14 21:16:50 6812 2 : C 3 : SUBROUTINE GREEN1(KMATER,KCARAC,DLL,TEMPS,DELTAT,F1,F2,KGREEN) 4 : C 5 : C ===================================================================== 6 : C APPELE PAR GREEN 7 : C 8 : C IL EST A NOTER QUE POUR LA FLEXION , DANS LE CAS NON FILTRE , 9 : C L'AIGUILLAGE NE SE FAIT PLUS SUR GFLEX1 MAIS SUR GFLEX0. 10 : C TOUTEFOIS IL EST POSSIBLE DE FAIRE LE CALCUL AVEC GFLEX1 EN 11 : C CHANGEANT LA VALEUR DE ITEST 12 : C 13 : C 14 : C VERSION : 21/09/86 15 : C PROGRAMMEUR : GUILBAUD 16 : C MODIFICATIONS: LIONEL VIVAN 15/02/88 17 : C : PASCAL MANIGOT 02/03/88 18 : C : XAVIER VACELET 09/01/89 19 : C 20 : C ===================================================================== 21 : C 22 : IMPLICIT INTEGER(I-N) 23 : IMPLICIT REAL*8(A-H,O-Z) 24 : C 25 : -INC CCOPTIO 26 : -INC CCGEOME 27 : C 28 : -INC SMCHAML 29 : -INC SMLREEL 30 : -INC SMEVOLL 31 : C 32 : SEGMENT MAB 33 : REAL*8 AB(10,LAB) 34 : ENDSEGMENT 35 : CHARACTER*12 NOMFCT(10) 36 : CHARACTER*40 CHA1 37 : CHARACTER*40 CHA2 38 : CHARACTER*40 CHA3 39 : CHARACTER*57 ITEX 40 : CHARACTER *72 JTEX 41 : DATA NOMFCT/'G(X=0) ','DG/DX(X=0) ','D2G/DX2(X=0)', 42 : & 'D3G/DX3(X=0)','D4G/DX4(X=0)', 43 : & 'G(X=L) ','DG/DX(X=L) ','D2G/DX2(X=L)', 44 : & 'D3G/DX3(X=L)','D4G/DX4(X=L)'/ 45 : C 46 : ITEX=' L = C = RF = ' 47 : JTEX='FCTS DE GREEN FILTREES DE HZ A HZ' 48 : C 49 : IF (IIMPI.EQ.1) THEN 50 : WRITE(IOIMP,*) ' DEBUT DE GREEN1 ' 51 : END IF 52 : C 53 : C RECUPERATION DES CARACTERISTIQUES DYNAMIQUES DE L'ELEMENT 54 : C 55 : MCHAML=KMATER 56 : SEGACT,MCHAML 57 : MELVAL=IELVAL(1) 58 : SEGACT,MELVAL 59 : E =VELCHE(1,1) 60 : SEGDES,MELVAL 61 : MELVAL=IELVAL(2) 62 : SEGACT,MELVAL 63 : ANU=VELCHE(1,1) 64 : SEGDES,MELVAL 65 : MELVAL=IELVAL(3) 66 : SEGACT,MELVAL 67 : RHO=VELCHE(1,1) 68 : SEGDES,MELVAL 69 : SEGDES,MCHAML 70 : C 71 : MCHAML=KCARAC 72 : SEGACT,MCHAML 73 : MELVAL=IELVAL(1) 74 : SEGACT,MELVAL 75 : TORS=VELCHE(1,1) 76 : SEGDES,MELVAL 77 : MELVAL=IELVAL(2) 78 : SEGACT,MELVAL 79 : AINRY=VELCHE(1,1) 80 : SEGDES,MELVAL 81 : MELVAL=IELVAL(3) 82 : SEGACT,MELVAL 83 : AINRZ=VELCHE(1,1) 84 : SEGDES,MELVAL 85 : MELVAL=IELVAL(4) 86 : SEGACT,MELVAL 87 : SECT=VELCHE(1,1) 88 : SEGDES,MELVAL 89 : SEGDES,MCHAML 90 : C 91 : ES=E*SECT 92 : AIP=AINRY+AINRZ 93 : AMU=E/(2.D0*(1.D0+ANU)) 94 : CTC=SQRT(E/RHO) 95 : RTC=SQRT(AIP/SECT) 96 : CTO=SQRT(AMU/RHO) 97 : RTO=SQRT(TORS*2.D0*(1.D0+ANU)/SECT) 98 : RFY=SQRT(AINRY/SECT) 99 : RFZ=SQRT(AINRZ/SECT) 100 : C 101 : C CREATION DE L'OBJET EVOLUTION 102 : C 103 : EPS=1.D-3 104 : LANBN=NINT(TEMPS/DELTAT) 105 : JG=LANBN 106 : SEGINI MLREE1 107 : DO 10 NP=1,LANBN 108 : MLREE1.PROG(NP)=DELTAT*DBLE(NP) 109 : 10 CONTINUE 110 : SEGDES MLREE1 111 : N=28 112 : SEGINI MEVOLL 113 : FB=1.D0/TEMPS 114 : FH=0.1D0/DELTAT 115 : WRITE (JTEX(27:38),FMT='(1PE12.5)') FB 116 : WRITE (JTEX(45:56),FMT='(1PE12.5)') FH 117 : IEVTEX=JTEX 118 : ITYEVO='REEL' 119 : LAB=LANBN+1 120 : SEGINI MAB 121 : C 122 : C 1 - TRACTION COMPRESSION 123 : C 123 : CALL GTRAC1(AB,DLL,RTC,CTC,DELTAT,LANBN,F1,F2) 124 : K=0 125 : DO 40 I=1,4 126 : SEGINI KEVOLL 127 : WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL 128 : WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC 129 : WRITE (ITEX(43:54),FMT='(1PE12.5)') RTC 130 : KEVTEX=ITEX // ' TRACTION' 131 : NUMEVX=IDCOUL 132 : NUMEVY='REEL' 133 : TYPX='LISTREEL' 134 : TYPY='LISTREEL' 135 : IPROGX=MLREE1 136 : JG=LANBN 137 : SEGINI MLREEL 138 : IPROGY=MLREEL 139 : NOMEVX='TEMPS (S)' 140 : II=I 141 : IF (I.GE.3) II=I+3 142 : NOMEVY=NOMFCT(II) 143 : DO 30 NP=1,LANBN 144 : PROG(NP)=AB(I,NP) 145 : 30 CONTINUE 146 : K=K+1 147 : IF (I.EQ.3) K=15 148 : IEVOLL(K)=KEVOLL 149 : SEGDES KEVOLL,MLREEL 150 : 40 CONTINUE 151 : C 152 : C 2 - TORSION 153 : C 153 : CALL GTRAC1(AB,DLL,RTO,CTO,DELTAT,LANBN,F1,F2) 154 : K=2 155 : DO 60 I=1,4 156 : SEGINI KEVOLL 157 : WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL 158 : WRITE (ITEX(24:35),FMT='(1PE12.5)') CTO 159 : WRITE (ITEX(43:54),FMT='(1PE12.5)') RTO 160 : KEVTEX=ITEX // ' TORSION' 161 : NUMEVX=IDCOUL 162 : NUMEVY='REEL' 163 : TYPX='LISTREEL' 164 : TYPY='LISTREEL' 165 : IPROGX=MLREE1 166 : JG=LANBN 167 : SEGINI MLREEL 168 : IPROGY=MLREEL 169 : NOMEVX='TEMPS (S)' 170 : II=I 171 : IF (I.GE.3) II=I+3 172 : NOMEVY=NOMFCT(II) 173 : DO 50 NP=1,LANBN 174 : PROG(NP)=AB(I,NP) 175 : 50 CONTINUE 176 : K=K+1 177 : IF (I.EQ.3) K=17 178 : IEVOLL(K)=KEVOLL 179 : SEGDES KEVOLL,MLREEL 180 : 60 CONTINUE 181 : C 182 : C=============================== 183 : C CAS DE LA FLEXION 184 : C=============================== 185 : C 3 - FLEXION DANS LE PLAN X Y ( AUTOUR DE Z ) 186 : C 187 : C AIGUILLAGE VERS LES DIFFERENTS PROGRAMMES : 188 : C GFLEX1 , GFLEX2 , GFLEX3 , GFLEX4 , GFLEX5 189 : C 190 : ITEST = 1 190 : CALL LIRCHA( CHA1,1,IRETOU ) 191 : IF (CHA1(1:16).EQ. 'BERNOUILLI_EULER') THEN 191 : CALL LIRCHA( CHA2,1,IRETOU ) 192 : IF (CHA2(1:10).EQ. 'NON_FILTRE') THEN 193 : IF(ITEST.EQ.1) THEN 193 : CALL GFLEX0(AB,DLL,RFZ,CTC,DELTAT,LANBN) 194 : ELSE 194 : CALL GFLEX1(AB,DLL,RFZ,CTC,DELTAT,LANBN) 195 : ENDIF 196 : ELSEIF (CHA2(1:6).EQ. 'FILTRE') THEN 196 : CALL LIRREE(FREQ1,1,IRETOU) 196 : CALL LIRREE(FREQ2,1,IRETOU) 196 : CALL LIRCHA(CHA3,0,IRETOU) 197 : IF (IRETOU.NE.0) THEN 197 : CALL LIRREE(EPS,1,IRETOU) 197 : CALL GFLEX3(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,EPS) 198 : ELSE 198 : CALL GFLEX2(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2) 199 : ENDIF 200 : ENDIF 201 : ELSEIF (CHA1(1:10).EQ. 'TIMOSHENKO') THEN 201 : CALL LIRCHA( CHA2,1,IRETOU ) 202 : IF (CHA2(1:6).EQ. 'FILTRE') THEN 202 : CALL LIRREE(BETA,1,IRETOU) 202 : CALL LIRREE(FREQ1,1,IRETOU) 202 : CALL LIRREE(FREQ2,1,IRETOU) 202 : CALL LIRCHA(CHA3,0,IRETOU) 203 : IF (IRETOU.NE.0) THEN 203 : CALL LIRREE(EPS,1,IRETOU) 203 : CALL GFLEX5(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,BETA,EPS) 204 : ELSE 204 : CALL GFLEX4(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,BETA) 205 : ENDIF 206 : ENDIF 207 : ENDIF 208 : C 209 : K=4 210 : DO 80 I=1,10 211 : SEGINI KEVOLL 212 : WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL 213 : WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC 214 : WRITE (ITEX(43:54),FMT='(1PE12.5)') RFZ 215 : KEVTEX=ITEX // ' FLEXION XOY' 216 : TYPX='LISTREEL' 217 : TYPY='LISTREEL' 218 : NUMEVX=IDCOUL 219 : NUMEVY='REEL' 220 : IPROGX=MLREE1 221 : JG=LANBN 222 : SEGINI MLREEL 223 : IPROGY=MLREEL 224 : NOMEVX='TEMPS (S)' 225 : NOMEVY=NOMFCT(I) 226 : DO 70 NP=1,LANBN 227 : PROG(NP)=AB(I,NP) 228 : 70 CONTINUE 229 : K=K+1 230 : IF (I.EQ.6) K=19 231 : IEVOLL(K)=KEVOLL 232 : SEGDES KEVOLL,MLREEL 233 : 80 CONTINUE 234 : C 235 : C 4 - FLEXION DANS LE PLAN X Z ( AUTOUR DE Y ) 236 : C 237 : DIF=ABS(1.D0-RFY/RFZ) 238 : IF (DIF.GT.EPS) THEN 239 : C 240 : C AIGUILLAGE ENTRE LES DIFFERENTS PROGRAMMES : 241 : C GFLEX1 , GFLEX2 , GFLEX3 , GFLEX4 , GFLEX5 242 : C 243 : IF (CHA1(1:16).EQ. 'BERNOUILLI_EULER') THEN 244 : IF (CHA2(1:10).EQ. 'NON_FILTRE') THEN 245 : IF (ITEST.EQ.1) THEN 245 : CALL GFLEX0(AB,DLL,RFZ,CTC,DELTAT,LANBN) 246 : ELSE 246 : CALL GFLEX1(AB,DLL,RFZ,CTC,DELTAT,LANBN) 247 : ENDIF 248 : ELSEIF (CHA2(1:6).EQ. 'FILTRE') THEN 249 : IF (IRETOU.NE.0) THEN 249 : CALL GFLEX3(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,EPS) 250 : ELSE 250 : CALL GFLEX2(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2) 251 : ENDIF 252 : ENDIF 253 : ELSEIF (CHA1(1:10).EQ. 'TIMOSHENKO') THEN 254 : IF (CHA2(1:6).EQ. 'FILTRE') THEN 255 : IF (IRETOU.NE.0) THEN 255 : CALL GFLEX5(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,BETA,EPS) 256 : ELSE 256 : CALL GFLEX4(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,BETA) 257 : ENDIF 258 : ENDIF 259 : ENDIF 260 : ENDIF 261 : C 262 : K=9 263 : DO 100 I=1,10 264 : SEGINI KEVOLL 265 : WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL 266 : WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC 267 : WRITE (ITEX(43:54),FMT='(1PE12.5)') RFY 268 : KEVTEX=ITEX // ' FLEXION XOZ' 269 : TYPX='LISTREEL' 270 : TYPY='LISTREEL' 271 : NUMEVX=IDCOUL 272 : NUMEVY='REEL' 273 : IPROGX=MLREE1 274 : NOMEVX='TEMPS (S)' 275 : NOMEVY=NOMFCT(I) 276 : JG=LANBN 277 : SEGINI MLREEL 278 : IPROGY=MLREEL 279 : DO 90 NP=1,LANBN 280 : PROG(NP)=AB(I,NP) 281 : 90 CONTINUE 282 : K=K+1 283 : IF (I.EQ.6) K=24 284 : IEVOLL(K)=KEVOLL 285 : SEGDES KEVOLL,MLREEL 286 : 100 CONTINUE 287 : SEGDES MEVOLL 288 : KGREEN = MEVOLL 289 : IF (IIMPI.EQ.1) THEN 290 : WRITE (IOIMP,*) ' FIN DE GREEN1 ' 291 : END IF 292 : RETURN 293 : END 294 : 295 :
© Cast3M 2003 - All rights reserved.
Disclaimer