Sources Esope | Cast3M

gtrac1
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