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                        ! XFAILed here and below because of PRs 45045 and 45044\r
  53       common/aux32/    ! { dg-warning "shall be of the same size" "" { xfail *-*-*} }\r
  54      a a17(lnv),a28(lnv),dett(lnv),\r
  55      1 aj1(lnv),aj2(lnv),aj3(lnv),aj4(lnv),\r
  56      2 aj5(lnv),aj6(lnv),aj7(lnv),aj8(lnv),\r
  57      3 aj9(lnv),x17(lnv),x28(lnv),x35(lnv),\r
  58      4 x46(lnv),y17(lnv),y28(lnv),y35(lnv),\r
  59      5 y46(lnv),z17(lnv),z28(lnv),z35(lnv),z46(lnv)\r
  60       common/aux33/    ! { dg-warning "shall be of the same size" "" { xfail *-*-*} }\r
  61      a ix1(lnv),ix2(lnv),ix3(lnv),ix4(lnv),ix5(lnv),\r
  62      1             ix6(lnv),ix7(lnv),ix8(lnv),mxt(lnv),nmel\r
  63       common/aux36/lft,llt\r
  64       common/failu/sieu(lnv),failu(lnv)\r
  65       common/sand1/ihf,ibemf,ishlf,itshf\r
  66       dimension aj5968(lnv),aj6749(lnv),aj4857(lnv),aji1(lnv),aji2(lnv),\r
  67      1          aji3(lnv),aji4(lnv),aji5(lnv),\r
  68      1          aji6(lnv),aji7(lnv),aji8(lnv),aji9(lnv),aj12(lnv),\r
  69      2          aj45(lnv),aj78(lnv),b17(lnv),b28(lnv),c17(lnv),c28(lnv)\r
  70 c\r
  71       equivalence (x17,aj5968),(x28,aj6749),(x35,aj4857),(x46,aji1),\r
  72      1 (y17,aji2),(y28,aji3),(y35,aji4),(y46,aji5),(z17,aji6),\r
  73      2 (z28,aji7),(z35,aji8),(z46,aji9),(aj1,aj12),(aj2,aj45),\r
  74      3 (aj3,aj78),(px1,b17),(px2,b28),(px3,c17),(px4,c28)\r
  75       data o64th/0.0156250/\r
  76 c\r
  77 c     jacobian matrix\r
  78 c\r
  79       do 10 i=lft,llt\r
  80       x17(i)=x7(i)-x1(i)\r
  81       x28(i)=x8(i)-x2(i)\r
  82       x35(i)=x5(i)-x3(i)\r
  83       x46(i)=x6(i)-x4(i)\r
  84       y17(i)=y7(i)-y1(i)\r
  85       y28(i)=y8(i)-y2(i)\r
  86       y35(i)=y5(i)-y3(i)\r
  87       y46(i)=y6(i)-y4(i)\r
  88       z17(i)=z7(i)-z1(i)\r
  89       z28(i)=z8(i)-z2(i)\r
  90       z35(i)=z5(i)-z3(i)\r
  91    10 z46(i)=z6(i)-z4(i)\r
  92       do 20 i=lft,llt\r
  93       aj1(i)=x17(i)+x28(i)-x35(i)-x46(i)\r
  94       aj2(i)=y17(i)+y28(i)-y35(i)-y46(i)\r
  95       aj3(i)=z17(i)+z28(i)-z35(i)-z46(i)\r
  96       a17(i)=x17(i)+x46(i)\r
  97       a28(i)=x28(i)+x35(i)\r
  98       b17(i)=y17(i)+y46(i)\r
  99       b28(i)=y28(i)+y35(i)\r
 100       c17(i)=z17(i)+z46(i)\r
 101    20 c28(i)=z28(i)+z35(i)\r
 102       do 30 i=lft,llt\r
 103       aj4(i)=a17(i)+a28(i)\r
 104       aj5(i)=b17(i)+b28(i)\r
 105       aj6(i)=c17(i)+c28(i)\r
 106       aj7(i)=a17(i)-a28(i)\r
 107       aj8(i)=b17(i)-b28(i)\r
 108    30 aj9(i)=c17(i)-c28(i)\r
 109 c\r
 110 c     jacobian\r
 111 c\r
 112       do 40 i=lft,llt\r
 113       aj5968(i)=aj5(i)*aj9(i)-aj6(i)*aj8(i)\r
 114       aj6749(i)=aj6(i)*aj7(i)-aj4(i)*aj9(i)\r
 115    40 aj4857(i)=aj4(i)*aj8(i)-aj5(i)*aj7(i)\r
 116       if (ihf.ne.1) then\r
 117       do 50 i=lft,llt\r
 118    50 det(i)=o64th*(aj1(i)*aj5968(i)+aj2(i)*aj6749(i)+aj3(i)*aj4857(i))\r
 119       else\r
 120       do 55 i=lft,llt\r
 121       det(i)=o64th*(aj1(i)*aj5968(i)+aj2(i)*aj6749(i)+aj3(i)*aj4857(i))\r
 122      1       *failu(i) + (1. - failu(i))\r
 123    55 continue\r
 124       endif\r
 125       do 60 i=lft,llt\r
 126    60 dett(i)=o64th/det(i)\r
 127 \r
 128       if (det(lft) .ne. 1d0) call abort ()
 129       if (det(llt) .ne. 1d0) call abort ()\r
 130 \r
 131       return\r
 132 c\r
 133       end\r
 134       program main\r
 135       parameter(lnv=32)\r
 136       implicit double precision (a-h,o-z)                                    dp\r
 137       common/aux8/\r
 138      & x1(lnv),x2(lnv),x3(lnv),x4(lnv),\r
 139      & x5(lnv),x6(lnv),x7(lnv),x8(lnv),\r
 140      & y1(lnv),y2(lnv),y3(lnv),y4(lnv),\r
 141      & y5(lnv),y6(lnv),y7(lnv),y8(lnv),\r
 142      & z1(lnv),z2(lnv),z3(lnv),z4(lnv),\r
 143      & z5(lnv),z6(lnv),z7(lnv),z8(lnv)\r
 144       common/aux36/lft,llt\r
 145       common/sand1/ihf,ibemf,ishlf,itshf\r
 146       lft=1\r
 147       llt=1\r
 148       x1(1)=0\r
 149       x2(1)=1\r
 150       x3(1)=1\r
 151       x4(1)=0\r
 152       x5(1)=0\r
 153       x6(1)=1\r
 154       x7(1)=1\r
 155       x8(1)=0\r
 156 \r
 157       y1(1)=0\r
 158       y2(1)=0\r
 159       y3(1)=1\r
 160       y4(1)=1\r
 161       y5(1)=0\r
 162       y6(1)=0\r
 163       y7(1)=1\r
 164       y8(1)=1\r
 165 \r
 166       z1(1)=0\r
 167       z2(1)=0\r
 168       z3(1)=0\r
 169       z4(1)=0\r
 170       z5(1)=1\r
 171       z6(1)=1\r
 172       z7(1)=1\r
 173       z8(1)=1\r
 174       call prtal\r
 175       stop\r
 176       end\r
 177 \r