gcc/testsuite/gfortran.dg/common_resize_1.f

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