C GTRAC1 SOURCE CHAT 05/01/13 00:21:57 5004 SUBROUTINE GTRAC1(AB,DLL,RF,CTC,DELTAT,LANBN,F1,F2) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C C ===================================================================== C = SOUS-PROGRAMME FORTRAN APPELE PAR GREEN1 POUR LE CALCUL DES FCTS C = DE GREEN EN TRACTION COMPRESSION OU TORSION C = C = CREATION : 21/09/87 C = PROGRAMMEUR : GUILBAUD C MODIFICATIONS: LIONEL VIVAN 9/02/88 C : PASCAL MANIGOT 22/02/88 C ===================================================================== -INC PPARAM -INC CCOPTIO -INC CCREEL PARAMETER (DEMI=0.5D0) DIMENSION AB(10,*) IF (IIMPI.EQ.1) THEN WRITE(IOIMP,*) ' DEBUT DE GTRAC1 ' END IF CSRF=CTC/RF VALINT=DEMI*CSRF*DELTAT T=0.D0 C IF ((F1+F2).LT.XPETIT) THEN C C--------BOUCLE SUR LES PAS DE TEMPS-------------------------- C NBETA=0 DO 10 NP=1,LANBN T=T+DELTAT TKSI=T-(DLL/CTC) AB(1,NP)=VALINT IF (NP.EQ.1) THEN AB(2,NP)=DEMI ELSE AB(2,NP)=0.D0 END IF IF (TKSI.LE.0.D0) THEN AB(3,NP)=0.D0 AB(4,NP)=0.D0 ELSE NBETA=NBETA+1 IF (NBETA.GT.2) THEN AB(3,NP)=VALINT AB(4,NP)=0.D0 ELSE IF (NBETA.EQ.1) THEN BETA=TKSI/DELTAT AB(3,NP)=BETA*VALINT AB(4,NP)=BETA*DEMI ELSE BETA=MAX((1.D0-BETA),0.D0) AB(3,NP)=VALINT AB(4,NP)=BETA*DEMI END IF END IF 10 CONTINUE C C--------SI GREEN FILTRE-------------------------------------- C ELSE C C--------BOUCLE SUR LES PAS DE TEMPS-------------------------- C DO 20 NP=1,LANBN NRG=0 T=T+DELTAT TETA=CSRF*T TETA1=TETA-CSRF*DELTAT ALPHA=2.D0*XPI*RF/CTC DK1=ALPHA*F1 DK2=ALPHA*F2 C C-----------BOUCLE SUR LES EXTREMITES------------------------- C DO 30 NE=1,2 DKSI=(NE-1)*DLL/RF CALL INTFIL(GP1,GP2,DKSI,TETA1,TETA,DK1,DK2) AB(NRG+1,NP)=GP1 AB(NRG+2,NP)=GP2 NRG=NRG+2 30 CONTINUE 20 CONTINUE END IF IF (IIMPI.EQ.1) THEN WRITE(IOIMP,*) ' FIN DE GTRAC1 ' END IF RETURN END