1 : C GTRAC1 SOURCE CHAT 05/01/13 00:21:57 5004 2 : SUBROUTINE GTRAC1(AB,DLL,RF,CTC,DELTAT,LANBN,F1,F2) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C 6 : C ===================================================================== 7 : C = SOUS-PROGRAMME FORTRAN APPELE PAR GREEN1 POUR LE CALCUL DES FCTS 8 : C = DE GREEN EN TRACTION COMPRESSION OU TORSION 9 : C = 10 : C = CREATION : 21/09/87 11 : C = PROGRAMMEUR : GUILBAUD 12 : C MODIFICATIONS: LIONEL VIVAN 9/02/88 13 : C : PASCAL MANIGOT 22/02/88 14 : C ===================================================================== 15 : -INC CCOPTIO 16 : -INC CCREEL 17 : PARAMETER (DEMI=0.5D0) 18 : DIMENSION AB(10,*) 19 : IF (IIMPI.EQ.1) THEN 20 : WRITE(IOIMP,*) ' DEBUT DE GTRAC1 ' 21 : END IF 22 : CSRF=CTC/RF 23 : VALINT=DEMI*CSRF*DELTAT 24 : T=0.D0 25 : C 26 : IF ((F1+F2).LT.XPETIT) THEN 27 : C 28 : C--------BOUCLE SUR LES PAS DE TEMPS-------------------------- 29 : C 30 : NBETA=0 31 : DO 10 NP=1,LANBN 32 : T=T+DELTAT 33 : TKSI=T-(DLL/CTC) 34 : AB(1,NP)=VALINT 35 : IF (NP.EQ.1) THEN 36 : AB(2,NP)=DEMI 37 : ELSE 38 : AB(2,NP)=0.D0 39 : END IF 40 : IF (TKSI.LE.0.D0) THEN 41 : AB(3,NP)=0.D0 42 : AB(4,NP)=0.D0 43 : ELSE 44 : NBETA=NBETA+1 45 : IF (NBETA.GT.2) THEN 46 : AB(3,NP)=VALINT 47 : AB(4,NP)=0.D0 48 : ELSE IF (NBETA.EQ.1) THEN 49 : BETA=TKSI/DELTAT 50 : AB(3,NP)=BETA*VALINT 51 : AB(4,NP)=BETA*DEMI 52 : ELSE 53 : BETA=MAX((1.D0-BETA),0.D0) 54 : AB(3,NP)=VALINT 55 : AB(4,NP)=BETA*DEMI 56 : END IF 57 : END IF 58 : 10 CONTINUE 59 : C 60 : C--------SI GREEN FILTRE-------------------------------------- 61 : C 62 : ELSE 63 : C 64 : C--------BOUCLE SUR LES PAS DE TEMPS-------------------------- 65 : C 66 : DO 20 NP=1,LANBN 67 : NRG=0 68 : T=T+DELTAT 69 : TETA=CSRF*T 70 : TETA1=TETA-CSRF*DELTAT 71 : ALPHA=2.D0*XPI*RF/CTC 72 : DK1=ALPHA*F1 73 : DK2=ALPHA*F2 74 : C 75 : C-----------BOUCLE SUR LES EXTREMITES------------------------- 76 : C 77 : DO 30 NE=1,2 78 : DKSI=(NE-1)*DLL/RF 78 : CALL INTFIL(GP1,GP2,DKSI,TETA1,TETA,DK1,DK2) 79 : AB(NRG+1,NP)=GP1 80 : AB(NRG+2,NP)=GP2 81 : NRG=NRG+2 82 : 30 CONTINUE 83 : 20 CONTINUE 84 : END IF 85 : IF (IIMPI.EQ.1) THEN 86 : WRITE(IOIMP,*) ' FIN DE GTRAC1 ' 87 : END IF 88 : RETURN 89 : END 90 : 91 : 92 :
© Cast3M 2003 - All rights reserved.
Disclaimer