C GREEN1    SOURCE    OF166741  25/02/20    21:16:40     12165          
C
      SUBROUTINE GREEN1(KMATER,KCARAC,DLL,TEMPS,DELTAT,F1,F2,KGREEN)
C
C =====================================================================
C    APPELE PAR GREEN
C
C    IL EST A NOTER QUE POUR LA FLEXION , DANS LE CAS NON FILTRE ,
C    L'AIGUILLAGE NE SE FAIT PLUS SUR GFLEX1 MAIS SUR GFLEX0.
C    TOUTEFOIS IL EST POSSIBLE DE FAIRE LE CALCUL AVEC GFLEX1 EN
C    CHANGEANT LA VALEUR DE ITEST
C
C
C    VERSION     : 21/09/86
C    PROGRAMMEUR : GUILBAUD
C    MODIFICATIONS: LIONEL VIVAN    15/02/88
C                 : PASCAL MANIGOT  02/03/88
C                 : XAVIER VACELET  09/01/89
C
C =====================================================================
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C

-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
C
-INC SMCHAML
-INC SMLREEL
-INC SMEVOLL
C
      SEGMENT MAB
       REAL*8 AB(10,LAB)
      ENDSEGMENT
      CHARACTER*12 NOMFCT(10)
      CHARACTER*40 CHA1
      CHARACTER*40 CHA2
      CHARACTER*40 CHA3
      CHARACTER*57 ITEX
      CHARACTER *72 JTEX
      DATA  NOMFCT/'G(X=0)      ','DG/DX(X=0)  ','D2G/DX2(X=0)',
     &             'D3G/DX3(X=0)','D4G/DX4(X=0)',
     &             'G(X=L)      ','DG/DX(X=L)  ','D2G/DX2(X=L)',
     &             'D3G/DX3(X=L)','D4G/DX4(X=L)'/
C
      ITEX=' L =               C =               RF = '
      JTEX='FCTS DE GREEN FILTREES DE              HZ A              HZ'
C
      IF (IIMPI.EQ.1) THEN
         WRITE(IOIMP,*) ' DEBUT DE GREEN1 '
      END IF
C
C     RECUPERATION DES CARACTERISTIQUES DYNAMIQUES DE L'ELEMENT
C
      MCHAML=KMATER
      SEGACT,MCHAML
      MELVAL=IELVAL(1)
      SEGACT,MELVAL
      E  =VELCHE(1,1)
      SEGDES,MELVAL
      MELVAL=IELVAL(2)
      SEGACT,MELVAL
      ANU=VELCHE(1,1)
      SEGDES,MELVAL
      MELVAL=IELVAL(3)
      SEGACT,MELVAL
      RHO=VELCHE(1,1)
      SEGDES,MELVAL
      SEGDES,MCHAML
C
      MCHAML=KCARAC
      SEGACT,MCHAML
      MELVAL=IELVAL(1)
      SEGACT,MELVAL
      TORS=VELCHE(1,1)
      SEGDES,MELVAL
      MELVAL=IELVAL(2)
      SEGACT,MELVAL
      AINRY=VELCHE(1,1)
      SEGDES,MELVAL
      MELVAL=IELVAL(3)
      SEGACT,MELVAL
      AINRZ=VELCHE(1,1)
      SEGDES,MELVAL
      MELVAL=IELVAL(4)
      SEGACT,MELVAL
      SECT=VELCHE(1,1)
      SEGDES,MELVAL
      SEGDES,MCHAML
C
      ES=E*SECT
      AIP=AINRY+AINRZ
      AMU=E/(2.D0*(1.D0+ANU))
      CTC=SQRT(E/RHO)
      RTC=SQRT(AIP/SECT)
      CTO=SQRT(AMU/RHO)
      RTO=SQRT(TORS*2.D0*(1.D0+ANU)/SECT)
      RFY=SQRT(AINRY/SECT)
      RFZ=SQRT(AINRZ/SECT)
C
C     CREATION DE L'OBJET EVOLUTION
C
      EPS=1.D-3
      LANBN=NINT(TEMPS/DELTAT)
      JG=LANBN
      SEGINI MLREE1
      DO 10 NP=1,LANBN
         MLREE1.PROG(NP)=DELTAT*DBLE(NP)
10    CONTINUE
      SEGDES MLREE1
      N=28
      SEGINI MEVOLL
      FB=1.D0/TEMPS
      FH=0.1D0/DELTAT
      WRITE (JTEX(27:38),FMT='(1PE12.5)') FB
      WRITE (JTEX(45:56),FMT='(1PE12.5)') FH
      IEVTEX=JTEX
      ITYEVO='REEL'
      LAB=LANBN+1
      SEGINI MAB
C
C     1 - TRACTION COMPRESSION
C
      CALL GTRAC1(AB,DLL,RTC,CTC,DELTAT,LANBN,F1,F2)
      K=0
      DO 40 I=1,4
         SEGINI KEVOLL
         WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
         WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC
         WRITE (ITEX(43:54),FMT='(1PE12.5)') RTC
         KEVTEX=ITEX // '  TRACTION'
         NUMEVX=IDCOUL
         NUMEVY='REEL'
         TYPX='LISTREEL'
         TYPY='LISTREEL'
         IPROGX=MLREE1
         JG=LANBN
         SEGINI MLREEL
         IPROGY=MLREEL
         NOMEVX='TEMPS   (S)'
         II=I
         IF (I.GE.3) II=I+3
         NOMEVY=NOMFCT(II)
         DO 30 NP=1,LANBN
            PROG(NP)=AB(I,NP)
30       CONTINUE
         K=K+1
         IF (I.EQ.3) K=15
         IEVOLL(K)=KEVOLL
         SEGDES KEVOLL,MLREEL
40    CONTINUE
C
C     2 - TORSION
C
      CALL GTRAC1(AB,DLL,RTO,CTO,DELTAT,LANBN,F1,F2)
      K=2
      DO 60 I=1,4
         SEGINI KEVOLL
         WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
         WRITE (ITEX(24:35),FMT='(1PE12.5)') CTO
         WRITE (ITEX(43:54),FMT='(1PE12.5)') RTO
         KEVTEX=ITEX // '  TORSION'
         NUMEVX=IDCOUL
         NUMEVY='REEL'
         TYPX='LISTREEL'
         TYPY='LISTREEL'
         IPROGX=MLREE1
         JG=LANBN
         SEGINI MLREEL
         IPROGY=MLREEL
         NOMEVX='TEMPS   (S)'
         II=I
         IF (I.GE.3) II=I+3
         NOMEVY=NOMFCT(II)
         DO 50 NP=1,LANBN
            PROG(NP)=AB(I,NP)
50       CONTINUE
         K=K+1
         IF (I.EQ.3) K=17
         IEVOLL(K)=KEVOLL
         SEGDES KEVOLL,MLREEL
60    CONTINUE
C
C===============================
C    CAS DE LA FLEXION
C===============================
C     3 - FLEXION DANS LE PLAN X Y ( AUTOUR DE Z )
C
C     AIGUILLAGE VERS LES DIFFERENTS PROGRAMMES :
C     GFLEX1 , GFLEX2 , GFLEX3 , GFLEX4 , GFLEX5
C
      ITEST = 1
      CALL LIRCHA( CHA1,1,IRETOU )
      IF (CHA1(1:16).EQ. 'BERNOUILLI_EULER') THEN
        CALL LIRCHA( CHA2,1,IRETOU )
        IF (CHA2(1:10).EQ. 'NON_FILTRE') THEN
          IF(ITEST.EQ.1) THEN
            CALL GFLEX0(AB,DLL,RFZ,CTC,DELTAT,LANBN)
          ELSE
            CALL GFLEX1(AB,DLL,RFZ,CTC,DELTAT,LANBN)
          ENDIF
        ELSEIF (CHA2(1:6).EQ. 'FILTRE') THEN
          CALL LIRREE(FREQ1,1,IRETOU)
          CALL LIRREE(FREQ2,1,IRETOU)
          CALL LIRCHA(CHA3,0,IRETOU)
          IF (IRETOU.NE.0) THEN
            CALL LIRREE(EPS,1,IRETOU)
            CALL GFLEX3(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,EPS)
          ELSE
            CALL GFLEX2(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2)
          ENDIF
        ENDIF
      ELSEIF (CHA1(1:10).EQ. 'TIMOSHENKO') THEN
        CALL LIRCHA( CHA2,1,IRETOU )
        IF (CHA2(1:6).EQ. 'FILTRE') THEN
          CALL LIRREE(BETA,1,IRETOU)
          CALL LIRREE(FREQ1,1,IRETOU)
          CALL LIRREE(FREQ2,1,IRETOU)
          CALL LIRCHA(CHA3,0,IRETOU)
          IF (IRETOU.NE.0) THEN
           CALL LIRREE(EPS,1,IRETOU)
           CALL GFLEX5(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,BETA,EPS)
          ELSE
           CALL GFLEX4(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,BETA)
          ENDIF
        ENDIF
      ENDIF
C
      K=4
      DO 80 I=1,10
         SEGINI KEVOLL
         WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
         WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC
         WRITE (ITEX(43:54),FMT='(1PE12.5)') RFZ
         KEVTEX=ITEX // '  FLEXION XOY'
         TYPX='LISTREEL'
         TYPY='LISTREEL'
         NUMEVX=IDCOUL
         NUMEVY='REEL'
         IPROGX=MLREE1
         JG=LANBN
         SEGINI MLREEL
         IPROGY=MLREEL
         NOMEVX='TEMPS   (S)'
         NOMEVY=NOMFCT(I)
         DO 70 NP=1,LANBN
            PROG(NP)=AB(I,NP)
70       CONTINUE
         K=K+1
         IF (I.EQ.6) K=19
         IEVOLL(K)=KEVOLL
         SEGDES KEVOLL,MLREEL
80    CONTINUE
C
C     4 - FLEXION DANS LE PLAN X Z ( AUTOUR DE Y )
C
      DIF=ABS(1.D0-RFY/RFZ)
      IF (DIF.GT.EPS) THEN
C
C     AIGUILLAGE ENTRE LES DIFFERENTS PROGRAMMES :
C     GFLEX1 , GFLEX2 , GFLEX3 , GFLEX4 , GFLEX5
C
      IF (CHA1(1:16).EQ. 'BERNOUILLI_EULER') THEN
        IF (CHA2(1:10).EQ. 'NON_FILTRE') THEN
          IF (ITEST.EQ.1) THEN
            CALL GFLEX0(AB,DLL,RFZ,CTC,DELTAT,LANBN)
          ELSE
            CALL GFLEX1(AB,DLL,RFZ,CTC,DELTAT,LANBN)
          ENDIF
        ELSEIF (CHA2(1:6).EQ. 'FILTRE') THEN
          IF (IRETOU.NE.0) THEN
            CALL GFLEX3(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,EPS)
          ELSE
            CALL GFLEX2(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2)
          ENDIF
        ENDIF
      ELSEIF (CHA1(1:10).EQ. 'TIMOSHENKO') THEN
        IF (CHA2(1:6).EQ. 'FILTRE') THEN
          IF (IRETOU.NE.0) THEN
           CALL GFLEX5(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,BETA,EPS)
          ELSE
           CALL GFLEX4(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,BETA)
          ENDIF
        ENDIF
      ENDIF
      ENDIF
C
      K=9
      DO 100 I=1,10
         SEGINI KEVOLL
         WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
         WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC
         WRITE (ITEX(43:54),FMT='(1PE12.5)') RFY
         KEVTEX=ITEX // '  FLEXION XOZ'
         TYPX='LISTREEL'
         TYPY='LISTREEL'
         NUMEVX=IDCOUL
         NUMEVY='REEL'
         IPROGX=MLREE1
         NOMEVX='TEMPS   (S)'
         NOMEVY=NOMFCT(I)
         JG=LANBN
         SEGINI MLREEL
         IPROGY=MLREEL
         DO 90 NP=1,LANBN
            PROG(NP)=AB(I,NP)
90       CONTINUE
         K=K+1
         IF (I.EQ.6) K=24
         IEVOLL(K)=KEVOLL
         SEGDES KEVOLL,MLREEL
100   CONTINUE
      SEGDES MEVOLL
      KGREEN = MEVOLL
      IF (IIMPI.EQ.1) THEN
         WRITE (IOIMP,*) ' FIN DE GREEN1 '
      END IF
      RETURN
      END