Télécharger la plaquette Cast3M


fr en

Télécharger xintgr.eso

Retour à la liste

Numérotation des lignes : 

xintgr

  1. C XINTGR    SOURCE    CHAT      05/01/13    04:13:37     5004
  2.       FUNCTION XINTGR (INTGR,FCT,X1,X2,Y,Z,DELTA)
  3.       IMPLICIT INTEGER(I-N)
  4.       REAL*8 XINTGR
  5. ************************************************************************
  6. *
  7. *                             X I N T G R
  8. *                             -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. *     INTEGRATION DE X1 A X2 D'UNE FONCTION EN X,Y,Z
  14. *                 AVEC  X1 INFERIEUR OU EGAL A X2
  15. *
  16. * MODULES UTILISES:
  17. * -----------------
  18. *
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC CCREEL
  23. *
  24. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
  25. * -----------
  26. *
  27. *     INTGR   (E)  METHODE D'INTEGRATION:
  28. *                  1  FCT ESCALIER "INFERIEUR"
  29. *                  2  FCT ESCALIER "MEDIAN"
  30. *                  3  FCT ESCALIER "SUPERIEUR"
  31. *                  4  TRAPEZES
  32. *     FCT     (E)  FONCTION A INTEGRER
  33. *     X1,X2   (E)  BORNES D'INTEGRATION DE LA 1ERE VARIABLE.
  34. *     Y,Z     (E)  2IEME ET 3IEME VARIABLES DE LA FONCTION
  35. *     DELTA   (E)  VALEUR DU PAS D'INTEGRATION
  36. *
  37.       INTEGER INTGR
  38.       REAL*8 FCT,X1,X2,Y,Z,DELTA
  39. *
  40. * VARIABLES:
  41. * ----------
  42. *
  43.       INTEGER NPAS,IPAS
  44.       REAL*8 XINT,XINT1,XI,XJ,DELT2,FCTI,FCTJ
  45. *
  46. * CONSTANTES:
  47. * -----------
  48. *
  49.       REAL*8 PRECIS
  50.       PARAMETER (PRECIS = 1.D-5)
  51. *
  52. * FONCTIONS:
  53. * ----------
  54. *
  55.       LOGICAL EGALDP
  56. *
  57. * AUTEUR, DATE DE CREATION:
  58. * -------------------------
  59. *
  60. *     PASCAL MANIGOT     26 FEVRIER 1988
  61. *
  62. * LANGAGE:
  63. * --------
  64. *
  65. *     FORTRAN77
  66. *
  67. ************************************************************************
  68. *
  69.       NPAS=NINT((X2-X1)/DELTA)
  70.       IF (IIMPI.EQ.1804) THEN
  71.          WRITE(IOIMP,*) 'DISCRETISATION INTEGRALE EN ',NPAS,' PAS'
  72.       END IF
  73.       IF (NPAS.LE.0) THEN
  74.          NPAS=1
  75.          DELT2=X2-X1
  76.       ELSE
  77.          DELT2=DELTA
  78.       END IF
  79.       XINT=0.D0
  80. *
  81.       IF (INTGR .EQ. 4) THEN
  82. *
  83.          XI = X1
  84.          FCTI = FCT(XI,Y,Z)
  85.          DO 100 IPAS=1,NPAS
  86.             XJ = XI + DELT2
  87.             FCTJ = FCT(XJ,Y,Z)
  88.             XINT1 = XINT
  89.             XINT = XINT + DELT2 * (FCTI + FCTJ) / 2.D0
  90.             IF (EGALDP(XINT,XINT1,PRECIS)) THEN
  91. *              EXIT
  92.                GOTO 102
  93.             END IF
  94.             XI = XJ
  95.             FCTI = FCTJ
  96.   100       CONTINUE
  97. *        END DO
  98.   102    CONTINUE
  99. *
  100.       ELSE
  101. *
  102.          IF (INTGR .EQ. 1) THEN
  103.             XI=X1
  104.          ELSE IF (INTGR .EQ. 2) THEN
  105.             XI=X1+DELT2*0.5D0
  106.          ELSE IF (INTGR .EQ. 3) THEN
  107.             XI=DELT2
  108.          END IF
  109. *
  110.          DO 200 IPAS=1,NPAS
  111.             XINT1 = XINT
  112.             XINT=XINT+DELT2*FCT(XI,Y,Z)
  113.             IF (EGALDP(XINT,XINT1,PRECIS)) THEN
  114. *              EXIT
  115.                GOTO 202
  116.             END IF
  117.             XI=XI+DELT2
  118.   200       CONTINUE
  119. *        END DO
  120.   202    CONTINUE
  121. *
  122.       END IF
  123. *
  124.       IF (IIMPI.EQ.1804) THEN
  125.          IF (IPAS .LT. NPAS) THEN
  126.             WRITE(IOIMP,*) 'IPAS,XINT,XINT1',IPAS,XINT,XINT1
  127.          END IF
  128.       END IF
  129.       XINTGR=XINT
  130. *
  131.       END
  132.  
  133.  
  134.  
  135.  

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