Commit 590db57c authored by Claus Kleinwort's avatar Claus Kleinwort
Browse files

minor fixes, cleanup

git-svn-id: http://svnsrv.desy.de/public/MillepedeII/trunk@164 3547b9b0-65b8-46d3-b95d-921b3f43af62
parent cda274d7
......@@ -2683,51 +2683,51 @@ SUBROUTINE sqmibb2(v,b,n,nbdr,nbnd,inv,nrank,vbnd,vbdr,aux,vbk,vzru,scdiag,scfla
ELSE
CALL dbcinb(vbnd,mp1,nmb,v)
END IF
! assemble band and border
IF (nbdr > 0) THEN
! band part
ip1=(nmb*nmb+nmb)/2
DO i=nmb-1,0,-1
j0=0
IF (inv == 1) j0=MAX(0,i-nbnd)
DO j=i,j0,-1
ioff=1
DO ib=1,nbdr
joff=1
DO jb=1,nbdr
ij=MAX(ib,jb)
ij=(ij*ij-ij)/2+MIN(ib,jb)
v(ip1)=v(ip1)+vbk(ij)*aux(ioff+i)*aux(joff+j)
joff=joff+n
END DO
ioff=ioff+n
END DO
ip1=ip1-1
END DO
ip1=ip1-j0
END DO
! assemble band and border
IF (nbdr > 0) THEN
! band part
ip1=(nmb*nmb+nmb)/2
ip=0
DO i=nmb-1,0,-1
j0=0
IF (inv == 1) j0=MAX(0,i-nbnd)
DO j=i,j0,-1
ioff=1
DO ib=1,nbdr
joff=1
DO jb=1,nbdr
ij=MAX(ib,jb)
ij=(ij*ij-ij)/2+MIN(ib,jb)
v(ip1)=v(ip1)+vbk(ij)*aux(ioff+i)*aux(joff+j)
joff=joff+n
END DO
ioff=ioff+n
END DO
ip1=ip1-1
END DO
ip1=ip1-j0
END DO
! border part
ip1=(nmb*nmb+nmb)/2
ip=0
DO ib=1,nbdr
DO i=1,nmb
ip1=ip1+1
v(ip1)=0.0_mpd
joff=0
DO jb=1,nbdr
ij=MAX(ib,jb)
ij=(ij*ij-ij)/2+MIN(ib,jb)
v(ip1)=v(ip1)-vbk(ij)*aux(i+joff)
joff=joff+n
END DO
ip1=ip1+1
v(ip1)=0.0_mpd
joff=0
DO jb=1,nbdr
ij=MAX(ib,jb)
ij=(ij*ij-ij)/2+MIN(ib,jb)
v(ip1)=v(ip1)-vbk(ij)*aux(i+joff)
joff=joff+n
END DO
END DO
DO jb=1,ib
ip1=ip1+1
ip=ip+1
v(ip1)=vbk(ip)
END DO
END DO
v(ip1)=vbk(ip)
END DO
END DO
END IF
END IF
END IF
......
......@@ -52,7 +52,7 @@
!! 1. Download the software package from the DESY \c svn server to
!! \a target directory, e.g.:
!!
!! svn checkout http://svnsrv.desy.de/public/MillepedeII/tags/V04-03-10 target
!! svn checkout http://svnsrv.desy.de/public/MillepedeII/tags/V04-03-11 target
!!
!! 2. Create **Pede** executable (in \a target directory):
!!
......@@ -2552,7 +2552,7 @@ SUBROUTINE ploopb(lunp)
iitera,istopa,chicut,nrej,nhour,minut,nsecnd,ccalcm(lcalcm)
ELSE
CALL ptlopt(nfa,ma,slopes,steps) ! slopes steps
ratae=ABS(slopes(2)/slopes(1))
ratae=MAX(-99.9,MIN(99.9,slopes(2)/slopes(1)))
stepl=steps(2)
WRITE(lunp,104) iterat,nloopn,fvalue,delfun,ratae,angras, &
iitera,istopa,lsinfo,stepl, chicut,nrej,nhour,minut,nsecnd,ccalcm(lcalcm)
......@@ -2598,11 +2598,16 @@ SUBROUTINE ploopc(lunp)
deltim=rstb-rstart
CALL sechms(deltim,nhour,minut,secnd) ! time
nsecnd=nint(secnd,mpi)
CALL ptlopt(nfa,ma,slopes,steps) ! slopes steps
ratae=ABS(slopes(2)/slopes(1))
stepl=steps(2)
WRITE(lunp,105) nloopn,fvalue, ratae,lsinfo, &
stepl,nrej,nhour,minut,nsecnd,ccalcm(lcalcm)
IF (lsinfo == 10) THEN ! line search skipped
WRITE(lunp,104) nloopn,fvalue,nrej,nhour,minut,nsecnd,ccalcm(lcalcm)
ELSE
CALL ptlopt(nfa,ma,slopes,steps) ! slopes steps
ratae=ABS(slopes(2)/slopes(1))
stepl=steps(2)
WRITE(lunp,105) nloopn,fvalue, ratae,lsinfo, &
stepl,nrej,nhour,minut,nsecnd,ccalcm(lcalcm)
END IF
104 FORMAT(3X,i3,e12.5,9X, 35X, i7, i3,i2.2,i2.2,a4)
105 FORMAT(3X,i3,e12.5,9X, f6.3,14X,i3,f6.3,6X, i7, i3,i2.2,i2.2,a4)
RETURN
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment