Esope source files

   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 :