OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [compile/] [pr32583.f] - Blame information for rev 859

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 303 jeremybenn
      subroutine detune(iv,ekk,ep,beta,dtu,dtup,dfac)
2
      implicit real*8 (a-h,o-z)
3
      parameter(npart=64,nmac=1)
4
      parameter(nele=700,nblo=300,nper=16,
5
     &nelb=100,nblz=20000,nzfz=300000,mmul=11)
6
      parameter(nran=280000,ncom=100,mran=500,mpa=6,nrco=5,nema=15)
7
      parameter(mcor=10)
8
      parameter(npos=20000,nlya=10000,ninv=1000,nplo=20000)
9
      parameter(nmon1=600,ncor1=600)
10
      parameter(pieni=1d-17)
11
      parameter(zero=0.0d0,half=0.5d0,one=1.0d0)
12
      parameter(two=2.0d0,three=3.0d0,four=4.0d0)
13
      dimension dfac(10),dtu(2,5),ep(2),beta(2),dtup(2,5,0:4,0:4)
14
      save
15
      pi=four*atan(one)
16
      iv2=2*iv
17
      iv3=iv+1
18
      vtu1=-ekk*(half**iv2)*dfac(iv2)/pi
19
      dtu1=zero
20
      dtu2=zero
21
      do 10 iv4=1,iv3
22
        iv5=iv4-1
23
        iv6=iv-iv5
24
        vor=one
25
        if(mod(iv6,2).ne.0) vor=-one
26
        vtu2=vor/(dfac(iv5+1)**2)/(dfac(iv6+1)**2)*(beta(1)**iv5)* (beta
27
     +  (2)**iv6)
28
        if(iv5.ne.0) then
29
          dtu1=dtu1+vtu2*iv5*(ep(1)**(iv5-1))*(ep(2)**iv6)
30
          dtup(1,iv,iv5-1,iv6)=dtup(1,iv,iv5-1,iv6)+vtu2*iv5*vtu1
31
        endif
32
        if(iv6.ne.0) then
33
          dtu2=dtu2+vtu2*iv6*(ep(1)**iv5)*(ep(2)**(iv6-1))
34
          dtup(2,iv,iv5,iv6-1)=dtup(2,iv,iv5,iv6-1)+vtu2*iv6*vtu1
35
        endif
36
   10 continue
37
      dtu(1,iv)=dtu(1,iv)+vtu1*dtu1
38
      dtu(2,iv)=dtu(2,iv)+vtu1*dtu2
39
      return
40
      end

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.