Télécharger la plaquette Cast3M


fr en

Télécharger green3.eso

Retour à la liste

Numérotation des lignes : 

green3

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

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