1C { dg-do  run }
2C { dg-options "-fcheck=bounds -fdump-tree-optimized -fblas-matmul-limit=1 -O -fexternal-blas" }
3C { dg-additional-sources blas_gemm_routines.f }
4C Test calling of BLAS routines
5
6      program main
7      call sub_s
8      call sub_d
9      call sub_c
10      call sub_z
11      end
12
13      subroutine sub_d
14      implicit none
15      real(8), dimension(3,2) :: a
16      real(8), dimension(2,3) :: at
17      real(8), dimension(2,4) :: b
18      real(8), dimension(4,2) :: bt
19      real(8), dimension(3,4) :: c
20      real(8), dimension(3,4) :: cres
21      real(8), dimension(:,:), allocatable :: c_alloc
22      data a / 2.,  -3.,  5.,  -7., 11., -13./
23      data b /17., -23., 29., -31., 37., -39., 41., -47./
24      data cres /195., -304.,  384.,  275., -428.,  548.,  347., -540.,
25     &           692.,  411., -640.,  816./
26
27      c = matmul(a,b)
28      if (any (c /= cres)) stop 31
29
30      at = transpose(a)
31      c = (1.2,-2.2)
32      c = matmul(transpose(at), b)
33      if (any (c /= cres)) stop 32
34
35      bt = transpose(b)
36      c = (1.2,-2.1)
37      c = matmul(a, transpose(bt))
38      if (any (c /= cres)) stop 33
39
40      c_alloc = matmul(a,b)
41      if (any (c /= cres)) stop 34
42
43      at = transpose(a)
44      deallocate (c_alloc)
45      c = matmul(transpose(at), b)
46      if (any (c /= cres)) stop 35
47
48      bt = transpose(b)
49      allocate (c_alloc(20,20))
50      c = (1.2,-2.1)
51      c = matmul(a, transpose(bt))
52      if (any (c /= cres)) stop 36
53
54      end
55
56      subroutine sub_s
57      implicit none
58      real, dimension(3,2) :: a
59      real, dimension(2,3) :: at
60      real, dimension(2,4) :: b
61      real, dimension(4,2) :: bt
62      real, dimension(3,4) :: c
63      real, dimension(3,4) :: cres
64      real, dimension(:,:), allocatable :: c_alloc
65      data a / 2.,  -3.,  5.,  -7., 11., -13./
66      data b /17., -23., 29., -31., 37., -39., 41., -47./
67      data cres /195., -304.,  384.,  275., -428.,  548.,  347., -540.,
68     &           692.,  411., -640.,  816./
69
70      c = matmul(a,b)
71      if (any (c /= cres)) stop 21
72
73      at = transpose(a)
74      c = (1.2,-2.2)
75      c = matmul(transpose(at), b)
76      if (any (c /= cres)) stop 22
77
78      bt = transpose(b)
79      c = (1.2,-2.1)
80      c = matmul(a, transpose(bt))
81      if (any (c /= cres)) stop 23
82
83      c_alloc = matmul(a,b)
84      if (any (c /= cres)) stop 24
85
86      at = transpose(a)
87      deallocate (c_alloc)
88      c = matmul(transpose(at), b)
89      if (any (c /= cres)) stop 25
90
91      bt = transpose(b)
92      allocate (c_alloc(20,20))
93      c = (1.2,-2.1)
94      c = matmul(a, transpose(bt))
95      if (any (c /= cres)) stop 26
96
97      end
98
99      subroutine sub_c
100      implicit none
101      complex, dimension(3,2) :: a
102      complex, dimension(2,3) :: at, ah
103      complex, dimension(2,4) :: b
104      complex, dimension(4,2) :: bt, bh
105      complex, dimension(3,4) :: c
106      complex, dimension(3,4) :: cres
107      complex, dimension(:,:), allocatable :: c_alloc
108
109      data a / (2.,-3.), (-5.,7.), (11.,-13.), (17.,19), (-23., -29),
110     &     (-31., 37.)/
111
112      data b / (-41., 43.), (-47., 53.), (-59.,-61.), (-67., 71),
113     &     ( 73.,79. ), (83.,-89.), (97.,-101.), (-107.,-109.)/
114      data cres /(-1759.,217.), (2522.,-358.), (-396.,-2376.),
115     &     (-2789.,-11.),
116     &     (4322.,202.), (-1992.,-4584.), (3485.,3.), (-5408.,-244.),
117     &     (2550.,5750.), (143.,-4379.), (-478.,6794.), (7104.,-2952.) /
118
119      c = matmul(a,b)
120      if (any (c /= cres)) stop 1
121
122      at = transpose(a)
123      c = (1.2,-2.2)
124      c = matmul(transpose(at), b)
125      if (any (c /= cres)) stop 2
126
127      bt = transpose(b)
128      c = (1.2,-2.1)
129      c = matmul(a, transpose(bt))
130      if (any (c /= cres)) stop 3
131
132      ah = transpose(conjg(a))
133      c = (1.2,-2.2)
134      c = matmul(conjg(transpose(ah)), b)
135      if (any (c /= cres)) stop 4
136
137      bh = transpose(conjg(b))
138      c = (1.2,-2.2)
139      c = matmul(a, transpose(conjg(bh)))
140      if (any (c /= cres)) stop 5
141
142      c_alloc = matmul(a,b)
143      if (any (c /= cres)) stop 6
144
145      at = transpose(a)
146      deallocate (c_alloc)
147      c = matmul(transpose(at), b)
148      if (any (c /= cres)) stop 7
149
150      bt = transpose(b)
151      allocate (c_alloc(20,20))
152      c = (1.2,-2.1)
153      c = matmul(a, transpose(bt))
154      if (any (c /= cres)) stop 8
155
156      ah = transpose(conjg(a))
157      c = (1.2,-2.2)
158      c = matmul(conjg(transpose(ah)), b)
159      if (any (c /= cres)) stop 9
160
161      deallocate (c_alloc)
162      allocate (c_alloc(0,0))
163      bh = transpose(conjg(b))
164      c = (1.2,-2.2)
165      c = matmul(a, transpose(conjg(bh)))
166      if (any (c /= cres)) stop 10
167
168      end
169
170      subroutine sub_z
171      implicit none
172      complex(8), dimension(3,2) :: a
173      complex(8), dimension(2,3) :: at, ah
174      complex(8), dimension(2,4) :: b
175      complex(8), dimension(4,2) :: bt, bh
176      complex(8), dimension(3,4) :: c
177      complex(8), dimension(3,4) :: cres
178      complex(8), dimension(:,:), allocatable :: c_alloc
179
180      data a / (2.,-3.), (-5._8,7.), (11.,-13.), (17.,19),
181     &         (-23., -29), (-31., 37.)/
182
183      data b / (-41., 43.), (-47., 53.), (-59.,-61.), (-67., 71),
184     &     ( 73.,79. ), (83.,-89.), (97.,-101.), (-107.,-109.)/
185      data cres /(-1759.,217.), (2522.,-358.), (-396.,-2376.),
186     &     (-2789.,-11.),
187     &     (4322.,202.), (-1992.,-4584.), (3485.,3.), (-5408.,-244.),
188     &     (2550.,5750.), (143.,-4379.), (-478.,6794.), (7104.,-2952.) /
189
190      c = matmul(a,b)
191      if (any (c /= cres)) stop 11
192
193      at = transpose(a)
194      c = (1.2,-2.2)
195      c = matmul(transpose(at), b)
196      if (any (c /= cres)) stop 12
197
198      bt = transpose(b)
199      c = (1.2,-2.1)
200      c = matmul(a, transpose(bt))
201      if (any (c /= cres)) stop 13
202
203      ah = transpose(conjg(a))
204      c = (1.2,-2.2)
205      c = matmul(conjg(transpose(ah)), b)
206      if (any (c /= cres)) stop 14
207
208      bh = transpose(conjg(b))
209      c = (1.2,-2.2)
210      c = matmul(a, transpose(conjg(bh)))
211      if (any (c /= cres)) stop 15
212
213      c_alloc = matmul(a,b)
214      if (any (c /= cres)) stop 16
215
216      at = transpose(a)
217      deallocate (c_alloc)
218      c = matmul(transpose(at), b)
219      if (any (c /= cres)) stop 17
220
221      bt = transpose(b)
222      allocate (c_alloc(20,20))
223      c = (1.2,-2.1)
224      c = matmul(a, transpose(bt))
225      if (any (c /= cres)) stop 18
226
227      ah = transpose(conjg(a))
228      c = (1.2,-2.2)
229      c = matmul(conjg(transpose(ah)), b)
230      if (any (c /= cres)) stop 19
231
232      deallocate (c_alloc)
233      allocate (c_alloc(0,0))
234      bh = transpose(conjg(b))
235      c = (1.2,-2.2)
236      c = matmul(a, transpose(conjg(bh)))
237      if (any (c /= cres)) stop 20
238
239      end
240! { dg-final { scan-tree-dump-times "_gfortran_matmul" 0 "optimized" } }
241