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