Télécharger la plaquette Cast3M


fr en

Télécharger green2.eso

Retour à la liste

Numérotation des lignes : 

green2

  1. C GREEN2    SOURCE    FANDEUR   10/12/14    21:16:53     6812
  2.       SUBROUTINE GREEN2 (KMATER,KCARAC,DLL,TEMP1,DELTAT,FB,FH,NIN
  3.      &                  ,KGREEN)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6. ************************************************************************
  7. *
  8. *                             G R E E N 2
  9. *                             -----------
  10. *
  11. * FONCTION:
  12. * ---------
  13. *
  14. *     CALCULE LES FONCTIONS DE GREEN ADIMENSIONNELLES
  15. *
  16. *                                      G(X+DX) - G(X)
  17. *     LES DERIVEES SONT CALCULEES PAR  --------------
  18. *                                            DX
  19. *
  20. * MODULES UTILISES:
  21. * -----------------
  22. *
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26. -INC CCREEL
  27. -INC SMCHAML
  28. -INC SMLREEL
  29. -INC SMEVOLL
  30. *
  31. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
  32. * -----------
  33. *
  34. *     KMATER  (E)  POINTEUR SUR LE CHAMP "MATERIAU"
  35. *     KCARAC  (E)  POINTEUR SUR LE CHAMP "CARACTERISTIQUE"
  36. *     DLL     (E)  LONGUEUR DE L'ELEMENT
  37. *     TEMP1   (E)  TEMPS DE CALCUL
  38. *     DELTAT  (E)  PAS DE TEMPS
  39. *     FB, FH  (E)  FREQUENCES DE FILTRAGE, BORNES DE L'INTERVALLE
  40. *                  D'INTEGRATION.
  41. *     NIN     (E)  METHODE D'INTEGRATION:
  42. *                  1  FCT ESCALIER "INFERIEUR"
  43. *                  2  FCT ESCALIER "MEDIAN"
  44. *                  3  FCT ESCALIER "SUPERIEUR"
  45. *                  4  TRAPEZES
  46. *     KGREEN  (S)  POINTEUR DE L'OBJET "EVOLUTION" CONTENANT LES
  47. *                  FONCTIONS DE GREEN.
  48. *                  IL MANQUE LE FACTEUR C/ES (OU ANALOGUE) POUR AVOIR
  49. *                  LES VRAIES FONCTIONS DE GREEN EN TRACTION (OU
  50. *                  TORSION).
  51. *
  52. * FONCTIONS :
  53. * -----------
  54. *
  55.       REAL*8 GRET
  56.       EXTERNAL GRET
  57. *
  58. * CONSTANTES:
  59. * -----------
  60. *
  61.       PARAMETER (ZERO = 0.D0)
  62.       PARAMETER (EPS = 1.D-3)
  63.       PARAMETER (EPS9 = 1.D0 - EPS)
  64. *
  65. * VARIABLES:
  66. * ----------
  67. *
  68. *     ....TC = RELATIF A TRACTION.
  69. *     ....TO = RELATIF A TORSION.
  70. *     PAS... = PAS DE TEMPS SPECIFIQUE POUR LA TRACTION OU LA TORSION
  71. *              OU LA FLEXION.
  72. *     NPAS.. = NOMBRE DE PAS POUR LA PROPAGATION D'UNE IMPULSION DE X=0
  73. *              A X=L, SELON QUE TRACTION OU TORSION.
  74. *     TPRO.. = TEMPS DE PROPAGATION D'UNE IMPULSION DE X=0 A X=L,
  75. *              SELON QUE TRACTION OU TORSION.
  76. *     INSTAN = POINTEURS DES INSTANTS DE DEFINITION DES FONCTIONS DE
  77. *              GREEN ET DERIVEES (LISTREEL).
  78. *     IGREEN = POINTEURS DES FONCTIONS DE GREEN ET DERIVEES (LISTREEL).
  79. *     NINS.. = NOMBRE D'INSTANTS.
  80. *     TEMP0  = TEMPS INITIAL POUR LEQUEL LES FONCTIONS DE GREEN SONT
  81. *              DEFINIES.
  82. *
  83.       INTEGER INSTAN(4),IGREEN(4)
  84. *+*   SEGMENT A VIRER QUAND LA FLEXION SERA INTEGREE NUMERIQUEMENT.
  85.       SEGMENT MAB
  86.        REAL*8  AB(10,LAB)
  87.       ENDSEGMENT
  88. *+*
  89.       CHARACTER*12 NOMFCT(10)
  90.       CHARACTER*12 INDICE
  91.       CHARACTER*57 ITEX
  92.       CHARACTER*72 JTEX
  93.       POINTEUR G0.MLREEL,GL.MLREEL,DG0.MLREEL,DGL.MLREEL
  94. *
  95. * AUTEUR, DATE DE CREATION:
  96. * -------------------------
  97. *
  98. *     LIONEL VIVAN       11 FEVRIER 1988
  99. *     REPRISE P. MANIGOT 04/03/88
  100. *
  101. * LANGAGE:
  102. * --------
  103. *
  104. *     ESOPE + FORTRAN77
  105. *
  106. ************************************************************************
  107. *
  108.       DATA  NOMFCT/'G(X=0)      ','DG/DX(X=0)  ','D2G/DX2(X=0)',
  109.      &             'D3G/DX3(X=0)','D4G/DX4(X=0)',
  110.      &             'G(X=L)      ','DG/DX(X=L)  ','D2G/DX2(X=L)',
  111.      &             'D3G/DX3(X=L)','D4G/DX4(X=L)'/
  112. *
  113.       ITEX=' L =               C =               RF = '
  114.       JTEX='FCTS DE GREEN FILTREES DE              HZ A              HZ'
  115.      &     //'  VERSION2'
  116. *
  117. *     1) RECUPERATION DES CARACTERISTIQUES
  118. *        ---------------------------------
  119. *
  120.       MCHAML=KMATER
  121.       SEGACT,MCHAML
  122.       MELVAL=IELVAL(1)
  123.       SEGACT,MELVAL
  124.       E  =VELCHE(1,1)
  125.       SEGDES,MELVAL
  126.       MELVAL=IELVAL(2)
  127.       SEGACT,MELVAL
  128.       ANU=VELCHE(1,1)
  129.       SEGDES,MELVAL
  130.       MELVAL=IELVAL(3)
  131.       SEGACT,MELVAL
  132.       RHO=VELCHE(1,1)
  133.       SEGDES,MELVAL
  134.       SEGDES,MCHAML
  135.       IF (E.LT.XPETIT) THEN
  136.          CALL ERREUR (411)
  137.          RETURN
  138.       END IF
  139.       IF (RHO.LT.XPETIT) THEN
  140.          CALL ERREUR (412)
  141.          RETURN
  142.       END IF
  143.  
  144.       MCHAML=KCARAC
  145.       SEGACT,MCHAML
  146.       MELVAL=IELVAL(1)
  147.       SEGACT,MELVAL
  148.       TORS=VELCHE(1,1)
  149.       SEGDES,MELVAL
  150.       MELVAL=IELVAL(2)
  151.       SEGACT,MELVAL
  152.       AINRY=VELCHE(1,1)
  153.       SEGDES,MELVAL
  154.       MELVAL=IELVAL(3)
  155.       SEGACT,MELVAL
  156.       AINRZ=VELCHE(1,1)
  157.       SEGDES,MELVAL
  158.       MELVAL=IELVAL(4)
  159.       SEGACT,MELVAL
  160.       SECT=VELCHE(1,1)
  161.       SEGDES,MELVAL
  162.       SEGDES,MCHAML
  163.       IF (SECT.LT.XPETIT) THEN
  164.          CALL ERREUR (415)
  165.          RETURN
  166.       END IF
  167. *
  168.       ES=E*SECT
  169.       AIP=AINRY+AINRZ
  170.       AMU=E/(2.D0*(1.D0+ANU))
  171.       CTC=SQRT(E/RHO)
  172.       CTO=SQRT(AMU/RHO)
  173.       RTC=SQRT(AIP/SECT)
  174.       RTO=SQRT(TORS*2.D0*(1.D0+ANU)/SECT)
  175.       RFY=SQRT(AINRY/SECT)
  176.       RFZ=SQRT(AINRZ/SECT)
  177. *
  178.       TPROTC = DLL / CTC
  179.       NPASTC = INT(TPROTC*EPS9/DELTAT) + 1
  180.       PASTC = TPROTC / DBLE(NPASTC)
  181.       TPROTO = DLL / CTO
  182.       NPASTO = INT(TPROTO*EPS9/DELTAT) + 1
  183.       PASTO = TPROTC / DBLE(NPASTO)
  184.       IF (IIMPI .EQ. 1806) THEN
  185.          WRITE (IOIMP,*)
  186.          WRITE (IOIMP,*) 'DELTAT = ',DELTAT
  187.          WRITE (IOIMP,*) 'TPROTC,PASTC,NPASTC,TPROTO,PASTO,NPASTO'
  188.          WRITE (IOIMP,*)  TPROTC,PASTC,NPASTC,TPROTO,PASTO,NPASTO
  189.          WRITE (IOIMP,*)
  190.       END IF
  191. *
  192.       TEMPS = MAX(TEMP1,TPROTC,TPROTO)
  193. *
  194.       N=28
  195.       SEGINI MEVOLL
  196.       WRITE (JTEX(27:38),FMT='(1PE12.5)') FB
  197.       WRITE (JTEX(45:56),FMT='(1PE12.5)') FH
  198.       IEVTEX=JTEX
  199.       ITYEVO='REEL'
  200. *
  201. *     1 - TRACTION COMPRESSION
  202. *     2 - TORSION
  203. *
  204.       DO 150 ITRACT=1,2
  205. *
  206.          IF (ITRACT.EQ.1) THEN
  207.             K0=0
  208.             CT=CTC
  209.             RT=RTC
  210.             PAS = PASTC
  211.             NPAS = NPASTC
  212.             INDICE='TRACTION'
  213.          ELSE
  214.             K0=2
  215.             CT=CTO
  216.             RT=RTO
  217.             PAS = PASTO
  218.             NPAS = NPASTO
  219.             INDICE='TORSION '
  220.          END IF
  221. *
  222. *
  223. *        2) INSTANTS DE DEFINITION DES FONCTIONS DE GREEN ET DERIVEES.
  224. *           ----------------------------------------------------------
  225. *
  226.          NINS0 = NINT(TEMPS/PAS) + 1
  227. *
  228. *        INSTANTS DE DEFINITION DES FONCTIONS DE GREEN
  229.          JG=NINS0
  230.          SEGINI MLREEL
  231.          INSTAN(1) = MLREEL
  232.          INSTAN(3) = MLREEL
  233.          TEMP0 = 0.D0
  234.          TEMP = TEMP0
  235.          DO 100 NP=1,NINS0
  236.             PROG(NP)=TEMP
  237.             TEMP=TEMP+PAS
  238.   100       CONTINUE
  239. *        END DO
  240.          SEGDES MLREEL
  241. *
  242. *        INSTANTS DE DEFINITION DES DERIVEES PREMIERES DES FONCTIONS DE
  243. *        GREEN DE TRACTION ET TORSION.
  244.          NINS1T = 2 * (NINS0 - 1)
  245.          JG = NINS1T
  246.          SEGINI MLREEL
  247.          INSTAN(2) = MLREEL
  248.          INSTAN(4) = MLREEL
  249.          TEMP = TEMP0
  250.          PAS1 = PAS * EPS
  251.          DO 110 NP=1,NINS1T,2
  252.             PROG(NP) = TEMP + PAS1
  253.             TEMP = TEMP + PAS
  254.             PROG(NP+1) = TEMP - PAS1
  255.   110       CONTINUE
  256. *        END DO
  257.          SEGDES MLREEL
  258. *
  259. *        3) VALEURS DES FONCTIONS DE GREEN ET DERIVEES.
  260. *           -------------------------------------------
  261. *
  262. *+*      AVEC LA FLEXION INTEGREE NUMERIQUEMENT, IL FAUDRA METTRE
  263. *+*      CETTE BOUCLE 140 EN TETE.
  264. *
  265.          DO 140 I=1,4
  266. *
  267.             IF (I.EQ.3) K0 = K0+12
  268.             K = K0 + I
  269.             SEGINI KEVOLL
  270.             IEVOLL(K)=KEVOLL
  271. *
  272.             WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
  273.             WRITE (ITEX(24:35),FMT='(1PE12.5)') CT
  274.             WRITE (ITEX(43:54),FMT='(1PE12.5)') RT
  275.             KEVTEX=ITEX // '  ' // INDICE
  276.             TYPX='LISTREEL'
  277.             TYPY='LISTREEL'
  278.             NUMEVX = 4
  279.             NUMEVY='REEL'
  280.             IPROGX = INSTAN(I)
  281.             IF ( (I/2)*2 .EQ. I) THEN
  282.                JG = NINS1T
  283.             ELSE
  284.                JG = NINS0
  285.             END IF
  286.             SEGINI MLREEL
  287.             IGREEN(I) = MLREEL
  288.             IPROGY=MLREEL
  289.             NOMEVX='TEMPS   (S)'
  290.             IF (I .LT. 3) THEN
  291.                NOMEVY=NOMFCT(I)
  292.             ELSE
  293.                NOMEVY=NOMFCT(I+3)
  294.             END IF
  295. *
  296.             SEGDES KEVOLL
  297. *           LE "LISTREEL" DE FONCTION DE GREEN EST LAISSE ACTIF.
  298.   140       CONTINUE
  299. *        END DO
  300. *
  301.          CSTE = 2.D0*XPI*RT/CT
  302.          XK1 = CSTE * FB
  303.          IF (FH .LT. XPETIT) THEN
  304.             XK2 = 1.3D0 * CSTE / DELTAT
  305.          ELSE
  306.             XK2 = CSTE * FH
  307.          END IF
  308.          TETA0 = TEMP0 * CT/RT
  309.          DTETA = PAS * CT/RT
  310.          DTET2 = DTETA / 2.D0
  311. *
  312. *        EXTREMITE X=0 :
  313. *
  314.          G0 = IGREEN(1)
  315.          TETA = TETA0
  316.          DO 120 NP=1,NINS0
  317.             IF (TETA .LT. -DTET2) THEN
  318.                G0.PROG(NP)=0.D0
  319.             ELSE
  320.                IF (TETA .LT. XPETIT) THEN
  321.                   DELTK = XGRAND
  322.                ELSE
  323.                   DELTK = XPI / (4.D0 * ABS(TETA) )
  324.                END IF
  325.                G0.PROG(NP)=
  326.      &         XINTGR(NIN,GRET,XK1,XK2,TETA,ZERO,DELTK)/XPI
  327.             END IF
  328.             TETA=TETA+DTETA
  329.   120       CONTINUE
  330. *        END DO
  331.          DG0 = IGREEN(2)
  332. *        (LA DERIVEE EN KHI EST OPPOSEE A LA DERIVEE EN TETA)
  333.          DO 122 NP=1,(NINS0-1)
  334.             NP2 = NP * 2
  335.             VALCST = -(G0.PROG(NP+1) - G0.PROG(NP)) / DTETA
  336.             DG0.PROG(NP2-1) = VALCST
  337.             DG0.PROG(NP2) = VALCST
  338.   122       CONTINUE
  339. *        END DO
  340. *
  341. *+*      LISSAGE ARTIFICIEL DE DG/DX:
  342. *
  343.          CALL MAXIM3 (DG0,IPLACE,VALMAX)
  344.          VALMAX = ABS(VALMAX) * 1.D-2
  345.          SEGACT,DG0
  346.          DO 130 IB=1,NINS1T
  347.             IF (ABS(DG0.PROG(IB)) .LT. VALMAX) THEN
  348.                DG0.PROG(IB) = 0.D0
  349.             END IF
  350.   130       CONTINUE
  351. *        END DO
  352. *
  353. *        EXTREMITE X=L :
  354. *
  355.          GL = IGREEN(3)
  356.          DGL = IGREEN(4)
  357.          DO 132 NP=1,NPAS
  358.             GL.PROG(NP)=0.D0
  359.             NP2 = NP * 2
  360.             DGL.PROG(NP2-1) = 0.D0
  361.             DGL.PROG(NP2) = 0.D0
  362.   132       CONTINUE
  363. *        END DO
  364.          DO 134 NP=(NPAS+1),(NINS0-1)
  365.             NP1 = NP - NPAS
  366.             GL.PROG(NP) = G0.PROG(NP1)
  367.             NP2 = NP * 2
  368.             NP3 = NP1 * 2
  369.             DGL.PROG(NP2-1) = DG0.PROG(NP3-1)
  370.             DGL.PROG(NP2) = DG0.PROG(NP3)
  371.   134       CONTINUE
  372. *        END DO
  373.          IF (NPAS .LT. NINS0) THEN
  374.             GL.PROG(NINS0) = G0.PROG(NINS0-NPAS)
  375.          END IF
  376. *
  377.          SEGDES,G0,GL,DG0,DGL
  378. *
  379.   150    CONTINUE
  380. *     END DO
  381. *
  382. *
  383. C--------------------------------------------------------------
  384.       JG=NINT(TEMPS/DELTAT)
  385.       SEGINI MLREE1
  386.       TEMP=0.D0
  387.       DO 10 NP=1,JG
  388.          TEMP=TEMP+DELTAT
  389.          MLREE1.PROG(NP)=TEMP
  390. 10    CONTINUE
  391.       SEGDES MLREE1
  392.       LAB=JG + 1
  393.       SEGINI MAB
  394. C
  395. C     3 - FLEXION DANS LE PLAN X Y ( AUTOUR DE Z )
  396. C
  397.       CALL GFLEX1(AB,DLL,RFZ,CTC,DELTAT,JG)
  398.       K=4
  399.       DO 80 I=1,10
  400.          SEGINI KEVOLL
  401.          WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
  402.          WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC
  403.          WRITE (ITEX(43:54),FMT='(1PE12.5)') RFZ
  404.          KEVTEX=ITEX // '  FLEXION XOY'
  405.          NUMEVX=4
  406.          NUMEVY='REEL'
  407.          TYPX='LISTREEL'
  408.          TYPY='LISTREEL'
  409.          IPROGX=MLREE1
  410.          SEGINI MLREEL
  411.          IPROGY=MLREEL
  412.          NOMEVX='TEMPS   (S)'
  413.          NOMEVY=NOMFCT(I)
  414.          DO 70 NP=1,JG
  415.             PROG(NP)=AB(I,NP)
  416. 70       CONTINUE
  417.          K=K+1
  418.          IF (I.EQ.6) K=19
  419.          IEVOLL(K)=KEVOLL
  420.          SEGDES KEVOLL,MLREEL
  421. 80    CONTINUE
  422. C
  423. C     4 - FLEXION DANS LE PLAN X Z ( AUTOUR DE Y )
  424. C
  425.       DIF=ABS(1.D0-RFY/RFZ)
  426.       IF (DIF.GT.EPS) THEN
  427.          CALL GFLEX1(AB,DLL,RFY,CTC,DELTAT,JG)
  428.       END IF
  429.       K=9
  430.       DO 200 I=1,10
  431.          SEGINI KEVOLL
  432.          WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
  433.          WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC
  434.          WRITE (ITEX(43:54),FMT='(1PE12.5)') RFY
  435.          KEVTEX=ITEX // '  FLEXION XOZ'
  436.          NUMEVX=4
  437.          TYPX='LISTREEL'
  438.          TYPY='LISTREEL'
  439.          NUMEVY='REEL'
  440.          IPROGX=MLREE1
  441.          NOMEVX='TEMPS   (S)'
  442.          NOMEVY=NOMFCT(I)
  443.          SEGINI MLREEL
  444.          IPROGY=MLREEL
  445.          DO 90 NP=1,JG
  446.             PROG(NP)=AB(I,NP)
  447. 90       CONTINUE
  448.          K=K+1
  449.          IF (I.EQ.6) K=24
  450.          IEVOLL(K)=KEVOLL
  451.          SEGDES KEVOLL,MLREEL
  452. 200   CONTINUE
  453.       SEGSUP,MAB
  454. *
  455.       SEGDES MEVOLL
  456.       KGREEN = MEVOLL
  457. *
  458.       RETURN
  459.       END
  460.  
  461.  
  462.  

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