------- Comment #1 from dir at lanl dot gov 2007-06-18 14:48 -------
Here are the mingw32 results -
$ gfortran -g -o g95Test01 g95Test01.f
[EMAIL PROTECTED] ~/tests
$ g95Test01
1
lower triangular matrix with 3 rows
row 1 0.8000E+01
row 2 0.9000E+01 0.1000E+02
row 3 0.1100E+02 0.1200E+02 0.1300E+02
iprec = 1
1
lower triangular matrix with 3 rows
row 1 0.1600E+02
row 2 0.9000E+01 0.2000E+02
row 3 0.1100E+02 0.1200E+02 0.2600E+02
[EMAIL PROTECTED] ~/tests
$ gfortran -O3 -o g95Test01 g95Test01.f
[EMAIL PROTECTED] ~/tests
$ g95Test01
1
lower triangular matrix with 3 rows
row 1 0.0000E+00
row 2 0.1000E+01 0.2000E+01
row 3 0.3000E+01 0.4000E+01 0.5000E+01
iprec = 1
1
lower triangular matrix with 3 rows
row 1 0.0000E+00
row 2 0.1000E+01 0.4000E+01
row 3 0.3000E+01 0.4000E+01 0.1000E+02
[EMAIL PROTECTED] ~/tests
$ cat g95Test01.f
*deck vr2
subroutine vr2 ( intp, ivg, ccrans, cc, ns, stdb, stdm, t,
$ k2, nlin, istab )
save
c+---------------------------------------------------------------------+
c| master foutine for |
c| second variation of the strain energy |
c| at an integration point |
c| |
c| output quantities |
c| t local accumulator for elt second variation|
c| w global accumulator for elt second variatio|
c+---------------------------------------------------------------------+
c+---------------------------------------------------------------------+
c| t y p e & d i m e n s i o n |
c+---------------------------------------------------------------------+
character its1*4
character title*72
integer t
real cc, ctrans, dprod2, sdb, sdm,
$ stdb, stdm, sum, ttt, uf,
$ vf, wsf
real tgc
dimension cc(1), ccrans(1),ivg(1), stdb(1), stdm(1),
$ t(100)
c+---------------------------------------------------------------------+
c| e q u i v a l e n c e s |
c+---------------------------------------------------------------------+
equivalence (jt,tt)
c+---------------------------------------------------------------------+
c| c o m m o n & g l o b a l s |
c+---------------------------------------------------------------------+
common/comvd1/ jelt, jntp
common/comvd2/ plva, plvb, lpr, iulpr, wplv(8)
common/comvd3/ wsf(12,9),uf(20), vf(20)
common/con5 / dmy(3), icom(18)
common/corot1/ iadcor(30), lcor, kcor
common/corot8/ ctrans(150)
common/fmloc / jf(6), js(6), jp(6), l1, l2,
$ l3, l4, l5, l6
common/forms / mtrans(40), itrans(150), sdb(540),
$ sdm(1008),npform
common/hybcom/ ihyb, ihres(9), ttt(78)
common/nitnot/ nit, not
common/prec / iprec
common/scrat1/ w(600)
common/test / ktest
common/titcom/ title
common/vr410c/ tgc(3,3,4)
common/vrdat / np, np1, np2, np3, np4,
$ np5, np6, np7, np8, np9,
$ np10
common/vrdat1/ nmsh, ntyp, nods, neta, nitp,
$ nst, ntr, nmp, nth, nvg,
$ nvl, nvb, nvm, nvr2, idvr,
$ ifab
common a(100)
c+---------------------------------------------------------------------+
c| d a t a |
c+---------------------------------------------------------------------+
data its1 / 'dbug' /
c+---------------------------------------------------------------------+
c| l o g i c |
c+---------------------------------------------------------------------+
ielt=jelt
npr=iprec
npd=3-npr
nvr2 = 1
if(intp.gt.1) go to 20
c+---------------------------------------------------------------------+
c| begin new element |
c+---------------------------------------------------------------------+
nj=nvg+5
nn=nvg+4+(nvg*nvg+nvg)/npd
nnl=nvg+4+(nvl*nvl+nvl)/npd
t(1)=nvg
t(4)=1
call mover (ivg,1,t(5),1,nvg)
if(k2.eq.0.or.nvr2.gt.0) go to 5
if(istab.eq.1.or.nlin.eq.1) go to 5
return
5 continue
c+---------------------------------------------------------------------+
c| clear t for element stiffness matrix |
c+---------------------------------------------------------------------+
call mover (0.,0,t,1,nnl)
t(1)=nvg
t(4)=1
call mover (ivg,1,t(5),1,nvg)
c
nl1 = nvl
if(lpr+iulpr.gt.0) nl1=nvl
20 continue
if(istab.eq.1.or.nlin.eq.1) go to 25
if(k2.eq.0.or.nvr2.gt.0) go to 25
return
25 continue
c+---------------------------------------------------------------------+
c| skip second variation if cc matrix = 0 |
c+---------------------------------------------------------------------+
call scprod (ns*ns,1,1,cc,cc,sum)
if (sum.le.0.)go to 180
c+---------------------------------------------------------------------+
c| choose appropriate computational routine |
c| |
c| one-dimensional continuum element (beam/stiffener) |
c+---------------------------------------------------------------------+
if (idvr.eq.1) call vr21d (cc,ns,stdb,nlin,istab,t)
c+---------------------------------------------------------------------+
c| two-dimensional continuum element (plate/shell) |
c+---------------------------------------------------------------------+
if (idvr.eq.2) call vr22d (cc,ns,stdb,stdm,nlin,istab,t,t(nj))
c+---------------------------------------------------------------------+
c| three-dimensional continnum element (solid) |
c+---------------------------------------------------------------------+
if (idvr.eq.3) call vr23d (cc,ns,stdm,nlin,istab,t)
if(intp.lt.nitp) return
ll=l1+np6+7
if (ntyp.eq.411) ll=ll+iprec*144
if(ntyp.eq.411) call penal(a(ll),istab,t(nj))
if (title(1:4).ne.its1 .or. ielt.gt.4) go to 180
write (6,905) ielt,intp
if (ntyp.lt.410 .or. ntyp.gt.411) go to 170
write (6,906)
906 format (/40h bending penalty constraint conditions )
do 160 i=1,4
call scopu (12,a(ll),w)
ll=ll+iprec*12
160 write (not,908) i, (w(j),j=1,12)
908 format (/i5,4x,6e12.4/9x,6e12.4)
170 continue
905 format (//30x,26h stiffness matrix for elt ,i3,7h intp ,i3)
call prmx (t(nj),nvl)
180 jj=nj
if (ntyp.ne.410 .and. ntyp.ne.415) go to 190
c+---------------------------------------------------------------------+
c| special procedures for 410,415 |
c+---------------------------------------------------------------------+
call mid2 (4,tgc,t(nj),t(nj))
if (title(1:4).eq.its1 .and. ielt.le.4) call prmx(t(nj),nvg)
return
190 continue
do 200 i=1,nvl
j2=jj+iprec*(i-1)
c+---------------------------------------------------------------------+
c| divide main diagonals by 2 before collecting |
c+---------------------------------------------------------------------+
jt=t(j2)
tt=.5*tt
t(j2)=jt
200 jj=jj+iprec*i
210 call scopu (nnl,t,w)
nj1=nn-nj+1
call mover (0.,0,t(nj),1,nj1)
call clect2 (t(nj),w(nj),nvg,nl1,mtrans,ctrans,itrans)
call prmx(t(nj),nvg)
jj=nj
do 242 i=1,nvg
j2=jj+iprec*(i-1)
c+---------------------------------------------------------------------+
c| multiply main diagonals by 2 |
c+---------------------------------------------------------------------+
jt=t(j2)
tt=tt+tt
t(j2)=jt
242 jj=jj+iprec*i
write(*,*)' iprec =',iprec
call prmx(t(nj),nvg)
return
end
program main
common/nitnot/ nit, not
common/vrdat1/ nmsh, ntyp, nods, neta, nitp,
$ nst, ntr, nmp, nth, nvg,
$ nvl, nvb, nvm, nvr2, idvr,
$ ifab
common/prec / iprec
dimension t(20)
do 10 i=1,20
t(i)=i
10 continue
not=6
nvg=3
iprec = 1
call vr2 ( intp, ivg, ccrans, cc, ns, stdb, stdm, t,
$ k2, nlin, istab )
stop
end
subroutine clect2
return
end
subroutine mid2
return
end
subroutine mover
return
end
subroutine penal
return
end
subroutine prmx (a,n)
save
c+---------------------------------------------------------------------+
c| print nxn lower triangular matrix a |
c+---------------------------------------------------------------------+
c+---------------------------------------------------------------------+
c| t y p e & d i m e n s i o n |
c+---------------------------------------------------------------------+
real a
dimension a(1)
c+---------------------------------------------------------------------+
c| c o m m o n & g l o b a l s |
c+---------------------------------------------------------------------+
common/nitnot/ nit, not
c+---------------------------------------------------------------------+
c| l o g i c |
c+---------------------------------------------------------------------+
write (not,900) n
900 format ('1'// ' lower triangular matrix with ',i3,' rows'/)
jj=0
do 200 i=1,n
write (not,910) i, (a(jj+j),j=1,i)
910 format (5h row ,i3,2x,10e12.4/(10x,10e12.4))
200 jj=jj+i
return
end
subroutine scopu
return
end
subroutine scprod
return
end
subroutine vr21d
return
end
subroutine vr22d
return
end
subroutine vr23d
return
end
[EMAIL PROTECTED] ~/tests
$ gfortran --v
Using built-in specs.
Target: i386-pc-mingw32
Configured with: ../trunk/configure --prefix=/mingw
--enable-languages=c,fortran --with-gmp=/home/coudert/local --disable-nls
--with-ld=/mingw/bin/ld --with-as=/mingw/bin/as --disable-werror
--enable-bootstrap --enable-threads --build=i386-pc-mingw32 --disable-shared
--enable-libgomp
Thread model: win32
gcc version 4.3.0 20070522 (experimental)
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=32393
