Télécharger elpti7.eso

Retour à la liste

Numérotation des lignes :

  1. C ELPTI7 SOURCE CHAT 05/01/12 23:37:56 5004
  2. SUBROUTINE ELPTI7 (NMAX,NM,ENTIER)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. -INC CCREEL
  6. SEGMENT STAB
  7. REAL*8 ICOS(INMAX), INTELL(INM,6)
  8. END SEGMENT
  9. LOGICAL ON_C
  10. INTEGER NMAX,NM
  11. INTEGER N,M,K,P,INT,ENTIER
  12. REAL*8 VALA,ALPHA,ALPHA0,THETA,VAL2,VAL3
  13. REAL*8 VAL4,VAL5,CO1,V1,V2,DV1,DV2,DK,L1
  14.  
  15. * WRITE (6,*) '##discretisation integrale elliptique##'
  16. THETA= (45./NMAX)-90.
  17. ALPHA=0.
  18. ALPHA0=0.5*(1.-0.02)
  19. DK= (XPI/NMAX)
  20.  
  21. INMAX=NMAX
  22. INM=NM+1
  23. SEGINI STAB
  24.  
  25. DO 1 N=1,INMAX
  26. ICOS(N)= COS (THETA*XPI/180.)
  27. THETA=THETA+(90./INMAX)
  28. 1 CONTINUE
  29.  
  30. INTELL(1,1)=0.
  31. INTELL(1,2)=0.
  32.  
  33. INT=1
  34. 21 INT= INT + 1
  35. DO 2 M=INT,INM
  36. P=M-1
  37. VALA=0.
  38. ALPHA=0.5*P/(INM)
  39. c WRITE (6,*) 'ALPHA=',ALPHA
  40. INTELL(M,1)=ALPHA
  41.  
  42. DO 3 K=1,INMAX
  43. VAL4=ABS(1.+(2.*ALPHA*ICOS(K)))
  44. VAL5= VAL4**0.5
  45. VALA=VALA-(ALPHA*ICOS(K)*XPI/(VAL5*INMAX))
  46. 3 CONTINUE
  47.  
  48. c WRITE (6,*) 'B1 M',P,'VALA',VALA
  49.  
  50. K=0
  51. ON_C=.TRUE.
  52. DO WHILE (ON_C)
  53. K=K+1
  54. VAL2=ABS(1.-(2.*ALPHA*ICOS(K)))
  55. VAL3=VAL2**0.5
  56. C WRITE (6,*) 'VAL3',K,'= ',VAL3
  57. VALA=VALA +(ALPHA*ICOS(K)*XPI/(VAL3*INMAX))
  58. IF ((K.GE.INMAX).OR.((XPI/VAL3/INMAX).GE.(2*DK))) THEN
  59. ON_C=.FALSE.
  60. END IF
  61. END DO
  62. c WRITE (6,*) 'B2 M',P,'VALA',VALA,'K', K,(XPI/VAL3/INMAX),(2*DK)
  63.  
  64. IF (K.GE.INMAX) THEN
  65. INTELL(M,2)=VALA
  66. GOTO 21
  67. END IF
  68.  
  69. VAL2=0.
  70. V2=(K*XPI/2/INMAX)-(XPI/2)
  71. DV2= DK*((100.-(200.*ALPHA*(COS(V2))))**0.5)/10.
  72.  
  73. ON_C=.TRUE.
  74. DO WHILE (ON_C)
  75. K=K+1
  76. V1=V2
  77. DV1=DV2
  78. V2=V1+(DV1/2.)
  79. CO1=COS(V2)
  80. VAL2=20.*ALPHA*CO1*DV1/((100.-(200.*ALPHA*CO1))**0.5)
  81. VALA=VALA+VAL2
  82. V2=V1+DV1
  83. DV2= DK*((100.-(200.*ALPHA*(COS(V2))))**0.5)/10.
  84. IF ((K.GE.6000).OR.(V2.GE.0.)) THEN
  85. ON_C=.FALSE.
  86. END IF
  87. END DO
  88.  
  89. L1=K
  90. VALA=VALA-VAL2
  91. CO1=COS((DV1-V2)/2)
  92. VAL2=20.*ALPHA*CO1*(DV1-V2)/((100.-(200.*ALPHA*CO1))**0.5)
  93. VALA=VALA+VAL2
  94. INTELL(M,2)=VALA
  95. c WRITE (6,*) 'FIN M',P,'VALA',VALA
  96. 2 CONTINUE
  97.  
  98. c WRITE (6,*) 'INTELL2= ',INTELL(INM,2),'L1= ', L1
  99. ENTIER=STAB
  100. SEGDES STAB
  101.  
  102. RETURN
  103. END
  104.  
  105.  
  106.  

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