← Back to branch summary

~ubuntu-branches/ubuntu/raring/blitz++/raring

« back to all changes in this revision

Viewing changes to benchmarks/acousticf90.f

  • Committer: Bazaar Package Importer
  • Author(s): Konstantinos Margaritis
  • Date: 2005-02-28 20:25:01 UTC
  • mfrom: (2.1.2 hoary)
  • Revision ID: james.westby@ubuntu.com-20050228202501-3i4f2sknnprsqfhz
Tags: 1:0.8-4
http://bugs.debian.org/297323
Added missing build-depends (Closes: #297323)

Show diffs side-by-side

added added

removed removed

Lines of Context:
benchmarks/acousticf90.f
1
 
!INTEGER N, niters
2
 
!REAL check
3
 
!N = 128
4
 
!niters = 128*3
5
 
!CALL echo_f90(N, niters, check)
6
 
!PRINT *, check
7
 
!END
8
 
 
9
 
SUBROUTINE echo_f90(N, niters, check)
10
 
  INTEGER, INTENT( IN ) :: N, niters
11
 
  REAL, INTENT( OUT ) :: check
12
 
 
13
 
  REAL, DIMENSION (N,N) :: P1, P2, P3, c
14
 
  INTEGER iter
15
 
 
16
 
  CALL echo_f90_setupInitialConditions(c, P1, P2, P3, N)
17
 
  CALL checkArray_f90(P2, N)
18
 
  CALL checkArray_f90(c, N)
19
 
 
20
 
  DO iter=1, niters
21
 
    P3(2:N-1,2:N-1) = (2-4*c(2:N-1,2:N-1)) * P2(2:N-1,2:N-1) &
22
 
        + c(2:N-1,2:N-1)*(P2(1:N-2,2:N-1) + P2(3:N,2:N-1)    &
23
 
        + P2(2:N-1,1:N-2) + P2(2:N-1,3:N)) - P1(2:N-1,2:N-1)
24
 
    P1 = P2
25
 
    P2 = P3
26
 
  END DO
27
 
 
28
 
  check = P1(N/2,7*N/8)
29
 
 
30
 
  RETURN
31
 
END
32
 
 
33
 
 
34
 
 
35
 
 
36
 
 
37
 
SUBROUTINE echo_f90_setupInitialConditions(c, P1, P2, P3, N)
38
 
  INTEGER, INTENT( IN ) :: N
39
 
  REAL, DIMENSION (N,N) :: P1(N,N), P2(N,N), P3(N,N), c(N,N)
40
 
 
41
 
  INTEGER blockLeft, blockRight, blockTop, blockBottom
42
 
  INTEGER channelLeft, channelRight, channel1Height, channel2Height
43
 
  REAL cr, cc
44
 
  INTEGER i, j
45
 
  REAL s2
46
 
 
47
 
  ! Set the velocity field
48
 
  c = 0.2
49
 
 
50
 
  ! Solid block with which the pulse collides
51
 
  blockLeft = 1
52
 
  blockRight = 2 * N / 5.0
53
 
  blockTop = N / 3.0
54
 
  blockBottom = 2 * N / 3.0
55
 
  c(blockTop:blockBottom, blockLeft:blockRight) = 0.5
56
 
 
57
 
  ! Channel directing the pulse leftwards
58
 
  channelLeft = 4 * N / 5.0
59
 
  channelRight = N
60
 
  channel1Height = 3 * N / 8.0
61
 
  channel2Height = 5 * N / 8.0
62
 
 
63
 
  c(channel1Height,channelLeft:channelRight) = 0.0;
64
 
  c(channel2Height,channelLeft:channelRight) = 0.0;
65
 
 
66
 
  ! Initial pressure distribution: a gaussian pulse inside the channel
67
 
  cr = N / 2.0
68
 
  cc = 7.0 * N / 8.0
69
 
  s2 = 64.0 * 9.0 / ((N / 2.0) ** 2)
70
 
 
71
 
  DO j=1,N
72
 
    DO i=1,N
73
 
      P2(i,j) = exp(-((i-cr)**2 + (j-cc)**2) * s2)
74
 
    END DO
75
 
  END DO
76
 
 
77
 
  P1 = 0.0
78
 
  P3 = 0.0
79
 
END
80
 
 
81
 
 
82
 
 
83
 
 
84
 
 
85
 
      SUBROUTINE checkArray_f90(A, N)
86
 
      INTEGER N
87
 
      REAL, DIMENSION(N,N) :: A
88
 
 
89
 
      INTEGER i,j
90
 
      REAL check
91
 
      check = 0.0
92
 
      DO j=1,N
93
 
        DO i=1,N
94
 
          check = check + (i*n+j)*A(i,j)
95
 
        END DO
96
 
      END DO
97
 
 
98
 
      PRINT *, 'Array check: ', check
99
 
      RETURN
100
 
      END
101