1c { dg-do run } 2c { dg-options "-std=legacy" } 3c 4c Tests the fix for PR32302, in which the resizing of 'aux32' would cause 5c misalignment for double precision types and a wrong result would be obtained 6c at any level of optimization except none. 7c 8c Contributed by Dale Ranta <dir@lanl.gov> 9c 10 subroutine unpki(ixp,nwcon,nmel) 11 parameter(lnv=32) 12 implicit double precision (a-h,o-z) dp 13c 14c unpack connection data 15c 16 common/aux32/kka(lnv),kkb(lnv),kkc(lnv), ! { dg-warning "shall be of the same size as elsewhere" } 17 1 kk1(lnv),kk2(lnv),kk3(lnv),dxy(lnv), 18 2 dyx(lnv),dyz(lnv),dzy(lnv),dzx(lnv), 19 3 dxz(lnv),vx17(lnv),vx28(lnv),vx35(lnv), 20 4 vx46(lnv),vy17(lnv),vy28(lnv), 21 5 vy35(lnv),vy46(lnv),vz17(lnv),vz28(lnv),vz35(lnv),vz46(lnv) 22 common/aux33/ix1(lnv),ix2(lnv),ix3(lnv),ix4(lnv),ix5(lnv), ! { dg-warning "shall be of the same size as elsewhere" } 23 1 ix6(lnv),ix7(lnv),ix8(lnv),mxt(lnv) 24 dimension ixp(nwcon,*) 25c 26 return 27 end 28 subroutine prtal 29 parameter(lnv=32) 30 implicit double precision (a-h,o-z) dp 31 common/aux8/ 32 & x1(lnv),x2(lnv),x3(lnv),x4(lnv), 33 & x5(lnv),x6(lnv),x7(lnv),x8(lnv), 34 & y1(lnv),y2(lnv),y3(lnv),y4(lnv), 35 & y5(lnv),y6(lnv),y7(lnv),y8(lnv), 36 & z1(lnv),z2(lnv),z3(lnv),z4(lnv), 37 & z5(lnv),z6(lnv),z7(lnv),z8(lnv) 38 common/aux9/vlrho(lnv),det(lnv) 39 common/aux10/ 40 1 px1(lnv),px2(lnv),px3(lnv),px4(lnv), 41 & px5(lnv),px6(lnv),px7(lnv),px8(lnv), 42 2 py1(lnv),py2(lnv),py3(lnv),py4(lnv), 43 & py5(lnv),py6(lnv),py7(lnv),py8(lnv), 44 3 pz1(lnv),pz2(lnv),pz3(lnv),pz4(lnv), 45 & pz5(lnv),pz6(lnv),pz7(lnv),pz8(lnv), 46 4 vx1(lnv),vx2(lnv),vx3(lnv),vx4(lnv), 47 5 vx5(lnv),vx6(lnv),vx7(lnv),vx8(lnv), 48 6 vy1(lnv),vy2(lnv),vy3(lnv),vy4(lnv), 49 7 vy5(lnv),vy6(lnv),vy7(lnv),vy8(lnv), 50 8 vz1(lnv),vz2(lnv),vz3(lnv),vz4(lnv), 51 9 vz5(lnv),vz6(lnv),vz7(lnv),vz8(lnv) 52 ! XFAILed here and below because of PRs 45045 and 45044 53 common/aux32/ ! { dg-warning "shall be of the same size" "" { xfail *-*-*} } 54 a a17(lnv),a28(lnv),dett(lnv), 55 1 aj1(lnv),aj2(lnv),aj3(lnv),aj4(lnv), 56 2 aj5(lnv),aj6(lnv),aj7(lnv),aj8(lnv), 57 3 aj9(lnv),x17(lnv),x28(lnv),x35(lnv), 58 4 x46(lnv),y17(lnv),y28(lnv),y35(lnv), 59 5 y46(lnv),z17(lnv),z28(lnv),z35(lnv),z46(lnv) 60 common/aux33/ ! { dg-warning "shall be of the same size" "" { xfail *-*-*} } 61 a ix1(lnv),ix2(lnv),ix3(lnv),ix4(lnv),ix5(lnv), 62 1 ix6(lnv),ix7(lnv),ix8(lnv),mxt(lnv),nmel 63 common/aux36/lft,llt 64 common/failu/sieu(lnv),failu(lnv) 65 common/sand1/ihf,ibemf,ishlf,itshf 66 dimension aj5968(lnv),aj6749(lnv),aj4857(lnv),aji1(lnv),aji2(lnv), 67 1 aji3(lnv),aji4(lnv),aji5(lnv), 68 1 aji6(lnv),aji7(lnv),aji8(lnv),aji9(lnv),aj12(lnv), 69 2 aj45(lnv),aj78(lnv),b17(lnv),b28(lnv),c17(lnv),c28(lnv) 70c 71 equivalence (x17,aj5968),(x28,aj6749),(x35,aj4857),(x46,aji1), 72 1 (y17,aji2),(y28,aji3),(y35,aji4),(y46,aji5),(z17,aji6), 73 2 (z28,aji7),(z35,aji8),(z46,aji9),(aj1,aj12),(aj2,aj45), 74 3 (aj3,aj78),(px1,b17),(px2,b28),(px3,c17),(px4,c28) 75 data o64th/0.0156250/ 76c 77c jacobian matrix 78c 79 do 10 i=lft,llt 80 x17(i)=x7(i)-x1(i) 81 x28(i)=x8(i)-x2(i) 82 x35(i)=x5(i)-x3(i) 83 x46(i)=x6(i)-x4(i) 84 y17(i)=y7(i)-y1(i) 85 y28(i)=y8(i)-y2(i) 86 y35(i)=y5(i)-y3(i) 87 y46(i)=y6(i)-y4(i) 88 z17(i)=z7(i)-z1(i) 89 z28(i)=z8(i)-z2(i) 90 z35(i)=z5(i)-z3(i) 91 10 z46(i)=z6(i)-z4(i) 92 do 20 i=lft,llt 93 aj1(i)=x17(i)+x28(i)-x35(i)-x46(i) 94 aj2(i)=y17(i)+y28(i)-y35(i)-y46(i) 95 aj3(i)=z17(i)+z28(i)-z35(i)-z46(i) 96 a17(i)=x17(i)+x46(i) 97 a28(i)=x28(i)+x35(i) 98 b17(i)=y17(i)+y46(i) 99 b28(i)=y28(i)+y35(i) 100 c17(i)=z17(i)+z46(i) 101 20 c28(i)=z28(i)+z35(i) 102 do 30 i=lft,llt 103 aj4(i)=a17(i)+a28(i) 104 aj5(i)=b17(i)+b28(i) 105 aj6(i)=c17(i)+c28(i) 106 aj7(i)=a17(i)-a28(i) 107 aj8(i)=b17(i)-b28(i) 108 30 aj9(i)=c17(i)-c28(i) 109c 110c jacobian 111c 112 do 40 i=lft,llt 113 aj5968(i)=aj5(i)*aj9(i)-aj6(i)*aj8(i) 114 aj6749(i)=aj6(i)*aj7(i)-aj4(i)*aj9(i) 115 40 aj4857(i)=aj4(i)*aj8(i)-aj5(i)*aj7(i) 116 if (ihf.ne.1) then 117 do 50 i=lft,llt 118 50 det(i)=o64th*(aj1(i)*aj5968(i)+aj2(i)*aj6749(i)+aj3(i)*aj4857(i)) 119 else 120 do 55 i=lft,llt 121 det(i)=o64th*(aj1(i)*aj5968(i)+aj2(i)*aj6749(i)+aj3(i)*aj4857(i)) 122 1 *failu(i) + (1. - failu(i)) 123 55 continue 124 endif 125 do 60 i=lft,llt 126 60 dett(i)=o64th/det(i) 127 128 if (det(lft) .ne. 1d0) call abort () 129 if (det(llt) .ne. 1d0) call abort () 130 131 return 132c 133 end 134 program main 135 parameter(lnv=32) 136 implicit double precision (a-h,o-z) dp 137 common/aux8/ 138 & x1(lnv),x2(lnv),x3(lnv),x4(lnv), 139 & x5(lnv),x6(lnv),x7(lnv),x8(lnv), 140 & y1(lnv),y2(lnv),y3(lnv),y4(lnv), 141 & y5(lnv),y6(lnv),y7(lnv),y8(lnv), 142 & z1(lnv),z2(lnv),z3(lnv),z4(lnv), 143 & z5(lnv),z6(lnv),z7(lnv),z8(lnv) 144 common/aux36/lft,llt 145 common/sand1/ihf,ibemf,ishlf,itshf 146 lft=1 147 llt=1 148 x1(1)=0 149 x2(1)=1 150 x3(1)=1 151 x4(1)=0 152 x5(1)=0 153 x6(1)=1 154 x7(1)=1 155 x8(1)=0 156 157 y1(1)=0 158 y2(1)=0 159 y3(1)=1 160 y4(1)=1 161 y5(1)=0 162 y6(1)=0 163 y7(1)=1 164 y8(1)=1 165 166 z1(1)=0 167 z2(1)=0 168 z3(1)=0 169 z4(1)=0 170 z5(1)=1 171 z6(1)=1 172 z7(1)=1 173 z8(1)=1 174 call prtal 175 stop 176 end 177 178