Télécharger la plaquette Cast3M


fr en

Télécharger green1.eso

Retour à la liste

Numérotation des lignes : 

green1

  1. C GREEN1    SOURCE    BP208322  16/11/18    21:17:28     9177           
  2. C
  3.       SUBROUTINE GREEN1(KMATER,KCARAC,DLL,TEMPS,DELTAT,F1,F2,KGREEN)
  4. C
  5. C =====================================================================
  6. C    APPELE PAR GREEN
  7. C
  8. C    IL EST A NOTER QUE POUR LA FLEXION , DANS LE CAS NON FILTRE ,
  9. C    L'AIGUILLAGE NE SE FAIT PLUS SUR GFLEX1 MAIS SUR GFLEX0.
  10. C    TOUTEFOIS IL EST POSSIBLE DE FAIRE LE CALCUL AVEC GFLEX1 EN
  11. C    CHANGEANT LA VALEUR DE ITEST
  12. C
  13. C
  14. C    VERSION     : 21/09/86
  15. C    PROGRAMMEUR : GUILBAUD
  16. C    MODIFICATIONS: LIONEL VIVAN    15/02/88
  17. C                 : PASCAL MANIGOT  02/03/88
  18. C                 : XAVIER VACELET  09/01/89
  19. C
  20. C =====================================================================
  21. C
  22.       IMPLICIT INTEGER(I-N)
  23.       IMPLICIT REAL*8(A-H,O-Z)
  24. C
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC CCGEOME
  29. C
  30. -INC SMCHAML
  31. -INC SMLREEL
  32. -INC SMEVOLL
  33. C
  34.       SEGMENT MAB
  35.        REAL*8 AB(10,LAB)
  36.       ENDSEGMENT
  37.       CHARACTER*12 NOMFCT(10)
  38.       CHARACTER*40 CHA1
  39.       CHARACTER*40 CHA2
  40.       CHARACTER*40 CHA3
  41.       CHARACTER*57 ITEX
  42.       CHARACTER *72 JTEX
  43.       DATA  NOMFCT/'G(X=0)      ','DG/DX(X=0)  ','D2G/DX2(X=0)',
  44.      &             'D3G/DX3(X=0)','D4G/DX4(X=0)',
  45.      &             'G(X=L)      ','DG/DX(X=L)  ','D2G/DX2(X=L)',
  46.      &             'D3G/DX3(X=L)','D4G/DX4(X=L)'/
  47. C
  48.       ITEX=' L =               C =               RF = '
  49.       JTEX='FCTS DE GREEN FILTREES DE              HZ A              HZ'
  50. C
  51.       IF (IIMPI.EQ.1) THEN
  52.          WRITE(IOIMP,*) ' DEBUT DE GREEN1 '
  53.       END IF
  54. C
  55. C     RECUPERATION DES CARACTERISTIQUES DYNAMIQUES DE L'ELEMENT
  56. C
  57.       MCHAML=KMATER
  58.       SEGACT,MCHAML
  59.       MELVAL=IELVAL(1)
  60.       SEGACT,MELVAL
  61.       E  =VELCHE(1,1)
  62.       SEGDES,MELVAL
  63.       MELVAL=IELVAL(2)
  64.       SEGACT,MELVAL
  65.       ANU=VELCHE(1,1)
  66.       SEGDES,MELVAL
  67.       MELVAL=IELVAL(3)
  68.       SEGACT,MELVAL
  69.       RHO=VELCHE(1,1)
  70.       SEGDES,MELVAL
  71.       SEGDES,MCHAML
  72. C
  73.       MCHAML=KCARAC
  74.       SEGACT,MCHAML
  75.       MELVAL=IELVAL(1)
  76.       SEGACT,MELVAL
  77.       TORS=VELCHE(1,1)
  78.       SEGDES,MELVAL
  79.       MELVAL=IELVAL(2)
  80.       SEGACT,MELVAL
  81.       AINRY=VELCHE(1,1)
  82.       SEGDES,MELVAL
  83.       MELVAL=IELVAL(3)
  84.       SEGACT,MELVAL
  85.       AINRZ=VELCHE(1,1)
  86.       SEGDES,MELVAL
  87.       MELVAL=IELVAL(4)
  88.       SEGACT,MELVAL
  89.       SECT=VELCHE(1,1)
  90.       SEGDES,MELVAL
  91.       SEGDES,MCHAML
  92. C
  93.       ES=E*SECT
  94.       AIP=AINRY+AINRZ
  95.       AMU=E/(2.D0*(1.D0+ANU))
  96.       CTC=SQRT(E/RHO)
  97.       RTC=SQRT(AIP/SECT)
  98.       CTO=SQRT(AMU/RHO)
  99.       RTO=SQRT(TORS*2.D0*(1.D0+ANU)/SECT)
  100.       RFY=SQRT(AINRY/SECT)
  101.       RFZ=SQRT(AINRZ/SECT)
  102. C
  103. C     CREATION DE L'OBJET EVOLUTION
  104. C
  105.       EPS=1.D-3
  106.       LANBN=NINT(TEMPS/DELTAT)
  107.       JG=LANBN
  108.       SEGINI MLREE1
  109.       DO 10 NP=1,LANBN
  110.          MLREE1.PROG(NP)=DELTAT*DBLE(NP)
  111. 10    CONTINUE
  112.       SEGDES MLREE1
  113.       N=28
  114.       SEGINI MEVOLL
  115.       FB=1.D0/TEMPS
  116.       FH=0.1D0/DELTAT
  117.       WRITE (JTEX(27:38),FMT='(1PE12.5)') FB
  118.       WRITE (JTEX(45:56),FMT='(1PE12.5)') FH
  119.       IEVTEX=JTEX
  120.       ITYEVO='REEL'
  121.       LAB=LANBN+1
  122.       SEGINI MAB
  123. C
  124. C     1 - TRACTION COMPRESSION
  125. C
  126.       CALL GTRAC1(AB,DLL,RTC,CTC,DELTAT,LANBN,F1,F2)
  127.       K=0
  128.       DO 40 I=1,4
  129.          SEGINI KEVOLL
  130.          WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
  131.          WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC
  132.          WRITE (ITEX(43:54),FMT='(1PE12.5)') RTC
  133.          KEVTEX=ITEX // '  TRACTION'
  134.          NUMEVX=IDCOUL
  135.          NUMEVY='REEL'
  136.          TYPX='LISTREEL'
  137.          TYPY='LISTREEL'
  138.          IPROGX=MLREE1
  139.          JG=LANBN
  140.          SEGINI MLREEL
  141.          IPROGY=MLREEL
  142.          NOMEVX='TEMPS   (S)'
  143.          II=I
  144.          IF (I.GE.3) II=I+3
  145.          NOMEVY=NOMFCT(II)
  146.          DO 30 NP=1,LANBN
  147.             PROG(NP)=AB(I,NP)
  148. 30       CONTINUE
  149.          K=K+1
  150.          IF (I.EQ.3) K=15
  151.          IEVOLL(K)=KEVOLL
  152.          SEGDES KEVOLL,MLREEL
  153. 40    CONTINUE
  154. C
  155. C     2 - TORSION
  156. C
  157.       CALL GTRAC1(AB,DLL,RTO,CTO,DELTAT,LANBN,F1,F2)
  158.       K=2
  159.       DO 60 I=1,4
  160.          SEGINI KEVOLL
  161.          WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
  162.          WRITE (ITEX(24:35),FMT='(1PE12.5)') CTO
  163.          WRITE (ITEX(43:54),FMT='(1PE12.5)') RTO
  164.          KEVTEX=ITEX // '  TORSION'
  165.          NUMEVX=IDCOUL
  166.          NUMEVY='REEL'
  167.          TYPX='LISTREEL'
  168.          TYPY='LISTREEL'
  169.          IPROGX=MLREE1
  170.          JG=LANBN
  171.          SEGINI MLREEL
  172.          IPROGY=MLREEL
  173.          NOMEVX='TEMPS   (S)'
  174.          II=I
  175.          IF (I.GE.3) II=I+3
  176.          NOMEVY=NOMFCT(II)
  177.          DO 50 NP=1,LANBN
  178.             PROG(NP)=AB(I,NP)
  179. 50       CONTINUE
  180.          K=K+1
  181.          IF (I.EQ.3) K=17
  182.          IEVOLL(K)=KEVOLL
  183.          SEGDES KEVOLL,MLREEL
  184. 60    CONTINUE
  185. C
  186. C===============================
  187. C    CAS DE LA FLEXION
  188. C===============================
  189. C     3 - FLEXION DANS LE PLAN X Y ( AUTOUR DE Z )
  190. C
  191. C     AIGUILLAGE VERS LES DIFFERENTS PROGRAMMES :
  192. C     GFLEX1 , GFLEX2 , GFLEX3 , GFLEX4 , GFLEX5
  193. C
  194.       ITEST = 1
  195.       CALL LIRCHA( CHA1,1,IRETOU )
  196.       IF (CHA1(1:16).EQ. 'BERNOUILLI_EULER') THEN
  197.         CALL LIRCHA( CHA2,1,IRETOU )
  198.         IF (CHA2(1:10).EQ. 'NON_FILTRE') THEN
  199.           IF(ITEST.EQ.1) THEN
  200.             CALL GFLEX0(AB,DLL,RFZ,CTC,DELTAT,LANBN)
  201.           ELSE
  202.             CALL GFLEX1(AB,DLL,RFZ,CTC,DELTAT,LANBN)
  203.           ENDIF
  204.         ELSEIF (CHA2(1:6).EQ. 'FILTRE') THEN
  205.           CALL LIRREE(FREQ1,1,IRETOU)
  206.           CALL LIRREE(FREQ2,1,IRETOU)
  207.           CALL LIRCHA(CHA3,0,IRETOU)
  208.           IF (IRETOU.NE.0) THEN
  209.             CALL LIRREE(EPS,1,IRETOU)
  210.             CALL GFLEX3(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,EPS)
  211.           ELSE
  212.             CALL GFLEX2(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2)
  213.           ENDIF
  214.         ENDIF
  215.       ELSEIF (CHA1(1:10).EQ. 'TIMOSHENKO') THEN
  216.         CALL LIRCHA( CHA2,1,IRETOU )
  217.         IF (CHA2(1:6).EQ. 'FILTRE') THEN
  218.           CALL LIRREE(BETA,1,IRETOU)
  219.           CALL LIRREE(FREQ1,1,IRETOU)
  220.           CALL LIRREE(FREQ2,1,IRETOU)
  221.           CALL LIRCHA(CHA3,0,IRETOU)
  222.           IF (IRETOU.NE.0) THEN
  223.            CALL LIRREE(EPS,1,IRETOU)
  224.            CALL GFLEX5(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,BETA,EPS)
  225.           ELSE
  226.            CALL GFLEX4(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,BETA)
  227.           ENDIF
  228.         ENDIF
  229.       ENDIF
  230. C
  231.       K=4
  232.       DO 80 I=1,10
  233.          SEGINI KEVOLL
  234.          WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
  235.          WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC
  236.          WRITE (ITEX(43:54),FMT='(1PE12.5)') RFZ
  237.          KEVTEX=ITEX // '  FLEXION XOY'
  238.          TYPX='LISTREEL'
  239.          TYPY='LISTREEL'
  240.          NUMEVX=IDCOUL
  241.          NUMEVY='REEL'
  242.          IPROGX=MLREE1
  243.          JG=LANBN
  244.          SEGINI MLREEL
  245.          IPROGY=MLREEL
  246.          NOMEVX='TEMPS   (S)'
  247.          NOMEVY=NOMFCT(I)
  248.          DO 70 NP=1,LANBN
  249.             PROG(NP)=AB(I,NP)
  250. 70       CONTINUE
  251.          K=K+1
  252.          IF (I.EQ.6) K=19
  253.          IEVOLL(K)=KEVOLL
  254.          SEGDES KEVOLL,MLREEL
  255. 80    CONTINUE
  256. C
  257. C     4 - FLEXION DANS LE PLAN X Z ( AUTOUR DE Y )
  258. C
  259.       DIF=ABS(1.D0-RFY/RFZ)
  260.       IF (DIF.GT.EPS) THEN
  261. C
  262. C     AIGUILLAGE ENTRE LES DIFFERENTS PROGRAMMES :
  263. C     GFLEX1 , GFLEX2 , GFLEX3 , GFLEX4 , GFLEX5
  264. C
  265.       IF (CHA1(1:16).EQ. 'BERNOUILLI_EULER') THEN
  266.         IF (CHA2(1:10).EQ. 'NON_FILTRE') THEN
  267.           IF (ITEST.EQ.1) THEN
  268.             CALL GFLEX0(AB,DLL,RFZ,CTC,DELTAT,LANBN)
  269.           ELSE
  270.             CALL GFLEX1(AB,DLL,RFZ,CTC,DELTAT,LANBN)
  271.           ENDIF
  272.         ELSEIF (CHA2(1:6).EQ. 'FILTRE') THEN
  273.           IF (IRETOU.NE.0) THEN
  274.             CALL GFLEX3(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,EPS)
  275.           ELSE
  276.             CALL GFLEX2(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2)
  277.           ENDIF
  278.         ENDIF
  279.       ELSEIF (CHA1(1:10).EQ. 'TIMOSHENKO') THEN
  280.         IF (CHA2(1:6).EQ. 'FILTRE') THEN
  281.           IF (IRETOU.NE.0) THEN
  282.            CALL GFLEX5(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,BETA,EPS)
  283.           ELSE
  284.            CALL GFLEX4(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,BETA)
  285.           ENDIF
  286.         ENDIF
  287.       ENDIF
  288.       ENDIF
  289. C
  290.       K=9
  291.       DO 100 I=1,10
  292.          SEGINI KEVOLL
  293.          WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
  294.          WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC
  295.          WRITE (ITEX(43:54),FMT='(1PE12.5)') RFY
  296.          KEVTEX=ITEX // '  FLEXION XOZ'
  297.          TYPX='LISTREEL'
  298.          TYPY='LISTREEL'
  299.          NUMEVX=IDCOUL
  300.          NUMEVY='REEL'
  301.          IPROGX=MLREE1
  302.          NOMEVX='TEMPS   (S)'
  303.          NOMEVY=NOMFCT(I)
  304.          JG=LANBN
  305.          SEGINI MLREEL
  306.          IPROGY=MLREEL
  307.          DO 90 NP=1,LANBN
  308.             PROG(NP)=AB(I,NP)
  309. 90       CONTINUE
  310.          K=K+1
  311.          IF (I.EQ.6) K=24
  312.          IEVOLL(K)=KEVOLL
  313.          SEGDES KEVOLL,MLREEL
  314. 100   CONTINUE
  315.       SEGDES MEVOLL
  316.       KGREEN = MEVOLL
  317.       IF (IIMPI.EQ.1) THEN
  318.          WRITE (IOIMP,*) ' FIN DE GREEN1 '
  319.       END IF
  320.       RETURN
  321.       END
  322.  
  323.  
  324.  
  325.  
  326.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales