C DYNAR     SOURCE    OF166741  25/11/04    21:15:43     12349          
      SUBROUTINE DYNAR(WRK52,WRK53,WRK54,IECOU)

C=======================================================================
C
C        MODELE VISCOPLASTIQUE VISCOENDOMMAGEABLE POUR LA DYNAMIQUE
C                    - PROGRAMME PRINCIPAL -
C                          VERSION 2.0
C
C=======================================================================
C     CREATION :F.GATUINGT
C=======================================================================
C=========== Hypopthese: au temps t=0 tout est nul   ===================
C=======================================================================
        IMPLICIT REAL*8(A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
-INC DECHE
        DIMENSION EPSPTDT(6),EPSTE(6),EPSPOPT(6),EPSPO(6),SIGPO(6),
     &     sigt(6),sigtdt(6),EPST(6),EPSTDT(6),EPSPT(6),EPSTDTE(6),
     &   S(3,3),EPSIPP(3),ARRAY(3,3),SIGTDTE(6),DFIDSIG(6),EPSPOPTDT(6)
C
        PARAMETER (XUnDemi=0.5D0,XZERO=0.D0,UN=1.D0,DEUX=2.D0)
        PARAMETER (XPETIT=1.D-12)
        PARAMETER (TROIS=3.D0)
C
C - Recuperation des donnees materiau
C
        Eini=XMAT(1)
        XNU=XMAT(2)
        D0=XMAT(5)
        Q1=XMAT(6)
        Q2=XMAT(7)
        Q3=XMAT(8)
        SIGM0=XMAT(9)
        XN=XMAT(10)
        XKPLAS = XMAT(12)
        XMPLAS = XMAT(11)
        XK=XMAT(13)
        XMDt=XMAT(14)
        XNDt=XMAT(15)
        At=XMAT(16)
        Bt=XMAT(17)
        XMDc=XMAT(18)
        XNDc=XMAT(19)
        Ac=XMAT(20)
        Bc=XMAT(21)
        ED0=XMAT(22)
C - Pas de temps
        DELTAT=TEMPF-TEMP0
        deltat = max (1d-30,deltat)
C - Contrainte au temps T
        SIGT(1)=SIG0(1)
        SIGT(2)=SIG0(2)
        SIGT(3)=SIG0(3)
        SIGT(4)=SIG0(4)
        SIGT(5)=SIG0(5)
        SIGT(6)=SIG0(6)
C - Deformation au temps T
        EPST(1)=EPST0(1)
        EPST(2)=EPST0(2)
        EPST(3)=EPST0(3)
        EPST(4)=EPST0(4)*0.5D0
        EPST(5)=EPST0(5)*0.5D0
        EPST(6)=EPST0(6)*0.5D0
C - Increment de deformation
        DEPST(1)=DEPST(1)
        DEPST(2)=DEPST(2)
        DEPST(3)=DEPST(3)
        DEPST(4)=DEPST(4)*0.5D0
        DEPST(5)=DEPST(5)*0.5D0
        DEPST(6)=DEPST(6)*0.5D0
C======================================================================
C - Subcycling si le pas de temps est trop grand=======================
C======================================================================
        IF (DELTAT.GT.1.D-3) THEN
          coef=100
        ELSE
          coef=max (1.d0 , deltat/ 1.d-5)
        ENDIF
        nbiter=int(coef)
        DO i=1,6
          DEPST(i)=DEPST(i)/nbiter
        ENDDO
        DELTAT=DELTAT/nbiter
        l=0
        DO WHILE (l.LT.nbiter)
C - Debut des boucles
C=======================================================================
C - Recuperation des variables historiques
C=======================================================================
        DT=VAR0(1)
        fT=VAR0(2)+D0
        EPSPT(1)=VAR0(3)
        EPSPT(2)=VAR0(4)
        EPSPT(3)=VAR0(5)
        EPSPT(4)=VAR0(6)
        EPSPT(5)=VAR0(7)
        EPSPT(6)=VAR0(8)
        SIGMT=VAR0(9)+SIGM0
        dtt=VAR0(10)
        dct=VAR0(11)
        ES=VAR0(12)+ED0
C======================================================================
C - Deformation au temps t+dt
C======================================================================
        EPSTDT(1)=EPST(1)+DEPST(1)
        EPSTDT(2)=EPST(2)+DEPST(2)
        EPSTDT(3)=EPST(3)+DEPST(3)
        EPSTDT(4)=EPST(4)+DEPST(4)
        EPSTDT(5)=EPST(5)+DEPST(5)
        EPSTDT(6)=EPST(6)+DEPST(6)
        TRACEPSTDT=EPSTDT(1)+EPSTDT(2)+EPSTDT(3)
C======================================================================
C - Vitesse de Deformation
C======================================================================
        DO i=1,6
          EPSPO(i)=DEPST(i)/DELTAT
        ENDDO
        TRACEPSPO=EPSPO(1)+EPSPO(2)+EPSPO(3)
C=======================================================================
C - Module d'elasticite tangent de la Matrice
C=======================================================================
        ETAN=(Eini)/XN*(SIGMt/SIGM0)**(1-XN)
C=======================================================================
C - Coefficients de compressibilite et cisaillement de la matrice sans les pores
C=======================================================================
        XKm=Eini/(TROIS*(UN-DEUX*XNU))
        XGm=Eini/(DEUX*(UN+XNU))
C=======================================================================
C - Coeficients de compressibilite et cisaillement de la matrice avec les pores (Mori-Tanaka)
C=======================================================================
        XKporo=4.D0*XKm*XGm*(UN-fT)/(4.D0*XGm+3.D0*XKm*fT)
        XGporo=XGm*(UN-fT)/(UN+fT*
     &  (6.D0*XKm+12.D0*XGm)/(9.D0*XKm+8.D0*XGm))
C ======================================================================
C - Coefficients de compressibilite et cisaillement de la matrice endommagee
C ======================================================================
        XKendo=(UN-Dt)*XKporo
        XGendo=(UN-Dt)*XGporo
C ======================================================================
C Calcul des invariants de la contrainte
C ======================================================================
        XI1t=SIGT(1)+SIGT(2)+SIGT(3)
        XJ2t=0.5D0*((SIGT(1)-SIGT(2))**2
     &  +(SIGT(2)-SIGT(3))**2+(SIGT(3)-SIGT(1))**2
     &  +6.D0*(SIGT(4)**2+SIGT(5)**2+SIGT(6)**2))
C======================================================================
C - Deformation elastique au temps t+dt
C======================================================================
C Calcul du multiplicateur plastique au temps t
        Fit=XJ2t/(SIGMT**2)+2*Q1*fT*COSH((Q2*XI1t)/(2*SIGMT))
     &     -(1+(Q3*fT)**2)
        IF (Fit.LT.0.) THEN
          Fit=0.
        ENDIF
        xlambdapo=(fT/(1-fT))*(Fit/XKPLAS)**XMPLAS

C - Calcul des deformations plastique au temps t
C Derivees partielles de fi
        DFIDSIG(1)=0.5*(4*SIGT(1)-2*SIGT(2)-2*SIGT(3))/SIGMT**2
     &  +Q1*Q2*ft*SINH(Q2*XI1t/(2*SIGMt))/SIGMt
        DFIDSIG(2)=0.5*(-2*SIGT(1)+4*SIGT(2)-2*SIGT(3))/SIGMT**2
     &  +Q1*Q2*ft*SINH(Q2*XI1t/(2*SIGMt))/SIGMt
        DFIDSIG(3)=0.5*(-2*SIGT(1)-2*SIGT(2)+4*SIGT(3))/SIGMT**2
     &  +Q1*Q2*ft*SINH(Q2*XI1t/(2*SIGMt))/SIGMt
        DFIDSIG(4)=6/(SIGMt**2)*SIGT(4)
        DFIDSIG(5)=6/(SIGMt**2)*SIGT(5)
        DFIDSIG(6)=6/(SIGMt**2)*SIGT(6)
C
        DO i=1,6
          EPSPOPT(i)=xlambdapo*DFIDSIG(i)
        ENDDO
        TRACEPSPOPT=EPSPOPT(1)+EPSPOPT(2)+EPSPOPT(3)
C - Déformation viscoplastique
        DO i=1,6
          EPSPTDT(i)=EPSPT(i)+EPSPOPT(i)*DELTAT
        ENDDO
        TRACEPSPTDT=EPSPTDT(1)+EPSPTDT(2)+EPSPTDT(3)
C - Deformation elastique
        DO i=1,6
          EPSTDTE(i)=EPSTDT(i)-EPSPTDT(i)
        ENDDO
        TRACEPSTDTE=EPSTDTE(1)+EPSTDTE(2)+EPSTDTE(3)
C======================================================================
C - Deformation equivalente elastique au sens de Mazars a t
        ARRAY(1,1)=EPSTDTE(1)
        ARRAY(2,2)=EPSTDTE(2)
        ARRAY(3,3)=EPSTDTE(3)
        ARRAY(1,2)=EPSTDTE(4)
        ARRAY(2,3)=EPSTDTE(5)
        ARRAY(1,3)=EPSTDTE(6)
        ARRAY(3,1)=ARRAY(1,3)
        ARRAY(3,2)=ARRAY(2,3)
        ARRAY(2,1)=ARRAY(1,2)
C
        CALL JACOB3(ARRAY,3,EPSIPP,S)
        EPSE=MAX( XZERO , EPSIPP(1) )**2 +
     1       MAX( XZERO , EPSIPP(2) )**2 +
     2       MAX( XZERO , EPSIPP(3) )**2
        EPSE=SQRT(EPSE)
C - Nouveau seuil de Mazars
        ES=max (ES, EPSE)
C ==============================================================
C - Prediction élastique de la contrainte (pas d'évolution de d)
        DO i=1,3
          SIGPO(i)=XKendo*(TRACEPSPO-TRACEPSPOPT)+2*XGendo*
     &    ((EPSPO(i)-1./3.*TRACEPSPO)-(EPSPOPT(i)-1./3.*TRACEPSPOPT))
        ENDDO
        DO i=4,6
          SIGPO(i)=2*XGendo*((EPSPO(i))
     &     -(EPSPOPT(i)))
        ENDDO
C
        DO i=1,6
          SIGTDTE(i)=SIGT(i)+SIGPO(i)*DELTAT
        ENDDO
C ============================================================
C - Calcul des parametres avec la contrainte predite elastique
C - Calcul des invariants à t
        XI1tdte=SIGTDTE(1)+SIGTDTE(2)+SIGTDTE(3)
C
        XJ2tdte=0.5*((SIGTDTE(1)-SIGTDTE(2))**2
     &  +(SIGTDTE(2)-SIGTDTE(3))**2+(SIGTDTE(3)-SIGTDTE(1))**2
     &  +6*(SIGTDTE(4)**2+SIGTDTE(5)**2+SIGTDTE(6)**2))
C
C Derivees partielles de fi
        DFIDSIG(1)=0.5*(4*SIGTDTE(1)
     &  -2*SIGTDTE(2)-2*SIGTDTE(3))/SIGMT**2
     &  +Q1*Q2*ft*SINH(Q2*XI1tdte/(2*SIGMt))/SIGMt
        DFIDSIG(2)=0.5*(-2*SIGTDTE(1)+4*SIGTDTE(2)
     &  -2*SIGTDTE(3))/SIGMT**2
     &  +Q1*Q2*ft*SINH(Q2*XI1tdte/(2*SIGMt))/SIGMt
        DFIDSIG(3)=0.5*(-2*SIGTDTE(1)-2*SIGTDTE(2)
     &  +4*SIGTDTE(3))/SIGMT**2
     &  +Q1*Q2*ft*SINH(Q2*XI1tdte/(2*SIGMt))/SIGMt
        DFIDSIG(4)=6/(SIGMt**2)*SIGTDTE(4)
        DFIDSIG(5)=6/(SIGMt**2)*SIGTDTE(5)
        DFIDSIG(6)=6/(SIGMt**2)*SIGTDTE(6)
C
        TRACEDFIDSIG=DFIDSIG(1)+DFIDSIG(2)+DFIDSIG(3)
C
        DFIDSIGM=-2*XJ2tdte/(SIGMt**3)-Q1*Q2*ft*XI1tdte
     &  *SINH(Q2*XI1tdte/(2*SIGMt))/(SIGMt**2)
C
        DFIDft=2*Q1*COSH(Q2*XI1tdte/(2*SIGMt))-2*ft*Q3*Q3
C===================================================================
C - Calcul de la surface seuil fi à l'aide de la contrainte prédite
        Fi=XJ2tdte/(SIGMT**2)+2*Q1*fT*COSH((Q2*XI1tdte)/(2*SIGMT))
     &     -(1+(Q3*fT)**2)
C
C======================================================================
C========= Organigramme du calcul de la contrainte a t+Dt =============
C======================================================================
C
C Test sur le signe de la deformation equivalente
        IF(EPSE.GT.XZERO) THEN
          IF(fi.LT.XZERO)THEN
            IF(EPSE.LT.ES) THEN
C =====================================================================
C - Elasticite Seule
              dtdt=dt
              ftdt=ft
              dttdt=dtt
              dctdt=dct
              sigmtdt=sigmt
              DO i=1,6
                sigtdt(i)=sigtdte(i)
              ENDDO
            ELSE
C =====================================================================
C - Visco-Endommagement Seul
              sigmtdt=sigmt
              ftdt=ft
              CALL VISCOE(XMAT,EPSIPP,EPSE,DTT,DCT,DT
     &                    ,DELTAT,DTTDT,DCTDT,DTDT)
C
              Dpo=(Dtdt-Dt)/DELTAT
C
C - Raideur endommagee et ses derivees
              XKendo=(1-Dtdt)*XKporo
              XGendo=(1-Dtdt)*XGporo
              XKpo=-Dpo*XKporo
              XGpo=-Dpo*XGporo
C
C - Calcul de la contrainte
              DO i=1,3
               SIGPO(i)=XKendo*(TRACEPSPO-TRACEPSPOPT)+2*XGendo
     &         *((EPSPO(i)-1./3.*TRACEPSPO)-(EPSPOPT(i)
     &         -1./3.*TRACEPSPOPT))
     &         +XKpo*(TRACEPSTDT-TRACEPSPTDT)+2*XGpo
     &          *((EPSTDT(i)-1./3.*TRACEPSTDT)-(EPSPTDT(i)
     &         -1./3.*TRACEPSPTDT))
              ENDDO
              DO i=4,6
                SIGPO(i)=2*XGendo*((EPSPO(i))
     &          -(EPSPOPT(i)))+2*XGpo
     &        *((EPSTDT(i))-(EPSPTDT(i)))
              ENDDO
C
              DO i=1,6
                SIGTDT(i)=SIGT(i)+SIGPO(i)*DELTAT
              ENDDO
           ENDIF
         ELSE
           IF(EPSE.LT.ES) THEN
C =====================================================================
C - Plasticite sans endommagement
             Dtdt=Dt
             dttdt=dtt
             dctdt=dct
C - Evolution de la contrainte dans la matrice
             EPSPOPM=-xlambdapo*DFIDSIGM
             SIGPOM=(Etan*Eini/(Eini-Etan))*EPSPOPM
             SIGMTDT=SIGMT+SIGPOM*DELTAT
C - Evolution de la porosite
             fpo=XK*((UN-ft)*ft*TRACEPSPOPT)
             ftdt=ft+fpo*DELTAT
             IF (ftdt.LT.XPETIT) THEN
                ftdt=XZERO
             ENDIF
C - Raideur endommagee et ses derives
             XKporo=4*XKm*XGm*(1-fTDT)/(4*XGm+3*XKm*fTDT)
             XGporo=XGm*(1-fTDT)/(1+fTDT*(6*XKm+12*XGm)/(9*XKm+8*XGm))
             XKendo=(1-Dtdt)*XKporo
             XGendo=(1-Dtdt)*XGporo
             XKpo=(1-Dtdt)*(-4*XKm*XGm*(4*XGm+3*XKm)
     &        /(4*XGm+3*XKm*fTDT)**2)*fpo
             XGpo=(1-Dtdt)*(-5*XGm*(32*XGm**2+60*XGm*XKm+27*XKm**2)
     &        /(4*(2+3*fTDT)*XGm+3*(3+2*fTDT)*XKm)**2)*fpo
C =============================
C - Correction de la contrainte
             DO i=1,3
               SIGPO(i)=XKendo*(TRACEPSPO-TRACEPSPOPT)+2*XGendo
     &         *((EPSPO(i)-1./3.*TRACEPSPO)-(EPSPOPT(i)
     &         -1./3.*TRACEPSPOPT))
     &         +XKpo*(TRACEPSTDT-TRACEPSPTDT)+2*XGpo*
     &         ((EPSTDT(i)-1./3.*TRACEPSTDT)-(EPSPTDT(i)
     &          -1./3.*TRACEPSPTDT))
             ENDDO
             DO i=4,6
               SIGPO(i)=2*XGendo*((EPSPO(i))
     &          -(EPSPOPT(i)))+2*XGpo*
     &         ((EPSTDT(i))-(EPSPTDT(i)))
             ENDDO
C
             DO i=1,6
                SIGTDT(i)=SIGT(i)+SIGPO(i)*DELTAT
             ENDDO
           ELSE
C =====================================================================
C - Plasticite avec endommagement
C - Evolution de l'endommagement
              CALL VISCOE(XMAT,EPSIPP,EPSE,DTT,DCT,DT
     &                    ,DELTAT,DTTDT,DCTDT,DTDT)
C
             Dpo=(Dtdt-Dt)/DELTAT
             IF (Dpo.LE.0.) THEN
               Dtdt=Dt
               Dpo=0.
             ENDIF
C - Evolution de la contrainte dans la matrice
             EPSPOPM=-xlambdapo*DFIDSIGM
             SIGPOM=(Etan*Eini/(Eini-Etan))*EPSPOPM
             SIGMTDT=SIGMT+SIGPOM*DELTAT
C - Evolution de la porosite
             fpo=XK*((1-ft)*ft*TRACEPSPOPT)
             ftdt=ft+fpo*DELTAT
             IF (ftdt.LT.0.) THEN
                ftdt=0.
             ENDIF
C - Raideur endommagee et ses derives
             XKporo=4*XKm*XGm*(1-fTDT)/(4*XGm+3*XKm*fTDT)
             XGporo=XGm*(1-fTDT)/(1+fTDT*(6*XKm+12*XGm)/(9*XKm+8*XGm))
             XKendo=(1-dtdt)*XKporo
             XGendo=(1-dtdt)*XGporo
             XKpo=-Dpo*XKporo+(1-Dtdt)*
     &        (-4*XKm*XGm*(4*XGm+3*XKm)/(4*XGm+3*XKm*fTDT)**2)*fpo
             XGpo=-Dpo*XGporo
     &        +(1-Dtdt)*(-5*XGm*(32*XGm**2+60*XGm*XKm+27*XKm**2)
     &        /(4*(2+3*fTDT)*XGm+3*(3+2*fTDT)*XKm)**2)*fpo
C =============================
C - Correction de la contrainte
             DO i=1,3
               SIGPO(i)=XKendo*(TRACEPSPO-TRACEPSPOPT)+2*XGendo
     &         *((EPSPO(i)-1./3.*TRACEPSPO)-(EPSPOPT(i)
     &          -1./3.*TRACEPSPOPT))
     &         +XKpo*(TRACEPSTDT-TRACEPSPTDT)+2*XGpo*
     &        ((EPSTDT(i)-1./3.*TRACEPSTDT)-(EPSPTDT(i)
     &         -1./3.*TRACEPSPTDT))
             ENDDO
             DO i=4,6
               SIGPO(i)=2*XGendo*((EPSPO(i))
     &           -(EPSPOPT(i)))+2*XGpo*
     &        ((EPSTDT(i))-(EPSPTDT(i)))
             ENDDO
C
             DO i=1,6
                SIGTDT(i)=SIGT(i)+SIGPO(i)*DELTAT
             ENDDO
           ENDIF
         ENDIF
        ELSE
         IF(fi.LT.XZERO)THEN
C =====================================================================
C - Elasticite Seule
           Dtdt=Dt
           ftdt=ft
           dttdt=dtt
           dctdt=dct
           sigmtdt=sigmt
           DO i=1,6
             sigtdt(i)=sigtdte(i)
           ENDDO
         ELSE
C =====================================================================
C - Plasticite sans endommagement
           Dtdt=Dt
           dttdt=dtt
           dctdt=dct
C - Evolution de la contrainte dans la matrice
           EPSPOPM=-xlambdapo*DFIDSIGM
           SIGPOM=(Etan*Eini/(Eini-Etan))*EPSPOPM
           SIGMTDT=SIGMT+SIGPOM*DELTAT
C - Evolution de la porosite
           fpo=XK*((1-ft)*ft*TRACEPSPOPT)
           ftdt=ft+fpo*DELTAT
           IF (ftdt.LT.0.) THEN
             ftdt=0.
           ENDIF
C - Raideur endommagee et ses derives
           XKporo=4*XKm*XGm*(1-fTDT)/(4*XGm+3*XKm*fTDT)
           XGporo=XGm*(1-fTDT)/(1+fTDT*(6*XKm+12*XGm)/(9*XKm+8*XGm))
           XKendo=(1-Dtdt)*XKporo
           XGendo=(1-Dtdt)*XGporo
           XKpo=(1-Dtdt)*(-4*XKm*XGm*(4*XGm+3*XKm)
     &      /(4*XGm+3*XKm*fTDT)**2)*fpo
           XGpo=(1-Dtdt)*(-5*XGm*(32*XGm**2+60*XGm*XKm+27*XKm**2)
     &      /(4*(2+3*fTDT)*XGm+3*(3+2*fTDT)*XKm)**2)*fpo
C =============================
C - Correction de la contrainte
           DO i=1,3
             SIGPO(i)=XKendo*(TRACEPSPO-TRACEPSPOPT)+2*XGendo
     &       *((EPSPO(i)-1./3.*TRACEPSPO)-(EPSPOPT(i)
     &       -1./3.*TRACEPSPOPT))
     &       +XKpo*(TRACEPSTDT-TRACEPSPTDT)+2*XGpo*
     &      ((EPSTDT(i)-1./3.*TRACEPSTDT)-(EPSPTDT(i)
     &       -1./3.*TRACEPSPTDT))
           ENDDO
           DO i=4,6
             SIGPO(i)=2*XGendo*((EPSPO(i))
     &        -(EPSPOPT(i)))+2*XGpo*
     &      ((EPSTDT(i))-(EPSPTDT(i)))
           ENDDO
C
           DO i=1,6
             SIGTDT(i)=SIGT(i)+SIGPO(i)*DELTAT
           ENDDO
         ENDIF
        ENDIF
C
C======================================================================
C========= Fin de l'organigramme du calcul de la contrainte a t+dt ====
C======================================================================
C
C =====================================================================
C - Evolution des variables historiques
        VAR0(1)=DTDT
        VAR0(2)=fTDT-D0
        VAR0(3)=EPSPTDT(1)
        VAR0(4)=EPSPTDT(2)
        VAR0(5)=EPSPTDT(3)
        VAR0(6)=EPSPTDT(4)
        VAR0(7)=EPSPTDT(5)
        VAR0(8)=EPSPTDT(6)
        VAR0(9)=SIGMTDT-SIGM0
        VAR0(10)=dttdt
        VAR0(11)=dctdt
        VAR0(12)=ES-ED0
C =====================================================================
        SIGT(1)=SIGTDT(1)
        SIGT(2)=SIGTDT(2)
        SIGT(3)=SIGTDT(3)
        SIGT(4)=SIGTDT(4)
        SIGT(5)=SIGTDT(5)
        SIGT(6)=SIGTDT(6)
C =====================================================================
        EPST(1)=EPSTDT(1)
        EPST(2)=EPSTDT(2)
        EPST(3)=EPSTDT(3)
        EPST(4)=EPSTDT(4)
        EPST(5)=EPSTDT(5)
        EPST(6)=EPSTDT(6)
C =====================================================================
C  - Compteur du Subcycling
        l=l+1
        ENDDO
C =====================================================================
C ========Fin du Subcycling=================
C =====================================================================
C - Evolution des variables historiques
        VARF(1)=DTDT
        VARF(2)=fTDT-D0
        VARF(3)=EPSPTDT(1)
        VARF(4)=EPSPTDT(2)
        VARF(5)=EPSPTDT(3)
        VARF(6)=EPSPTDT(4)
        VARF(7)=EPSPTDT(5)
        VARF(8)=EPSPTDT(6)
        VARF(9)=SIGMTDT-SIGM0
        VARF(10)=dttdt
        VARF(11)=dctdt
        VARF(12)=ES-ED0
C======================================================================
C - Mise a jour des contraintes
        SIGF(1)=SIGTDT(1)
        SIGF(2)=SIGTDT(2)
        SIGF(3)=SIGTDT(3)
        SIGF(4)=SIGTDT(4)
        SIGF(5)=SIGTDT(5)
        SIGF(6)=SIGTDT(6)
C
        END