Commit ec8b0032 authored by Claus Kleinwort's avatar Claus Kleinwort
Browse files

reformatting of continuation lines

git-svn-id: http://svnsrv.desy.de/public/MillepedeII/trunk@103 3547b9b0-65b8-46d3-b95d-921b3f43af62
parent 45197edf
......@@ -287,7 +287,7 @@ SUBROUTINE ptlprt(lunp)
IF(nsfd <= 0) RETURN
WRITE(lun,*) ' '
WRITE(lun,*) 'PTLINE: line-search method based on slopes', &
' with sufficient slope-decrease'
' with sufficient slope-decrease'
WRITE(lun,*) 'PTLDEF: slope ratio limit=',gtol
WRITE(lun,*) 'PTLDEF: maximum step =',stmx
WRITE(lun,*) 'PTLDEF:',minf,' <= nr of calls <=',maxf
......@@ -310,7 +310,7 @@ SUBROUTINE ptlprt(lunp)
END DO
IF(lsinfo == 0) WRITE(lun,*) &
'PTLINE: INFO=0 input error (e.g. gradient not negative)'
'PTLINE: INFO=0 input error (e.g. gradient not negative)'
IF(lsinfo == 1) WRITE(lun,*) 'PTLINE: INFO=1 convergence reached'
IF(lsinfo == 2) WRITE(lun,*) 'PTLINE: INFO=2 too many function calls'
IF(lsinfo == 3) WRITE(lun,*) 'PTLINE: INFO=3 maximum step reached'
......@@ -318,7 +318,7 @@ SUBROUTINE ptlprt(lunp)
WRITE(lun,*) ' '
101 FORMAT(' i x F(x) F''(X)', &
' minimum F''(X)')
' minimum F''(X)')
102 FORMAT(i3,f12.6,1X,a2,g15.6,g14.6,f12.6,' ratio')
103 FORMAT(i3,f12.6,1X,a2,g15.6,g14.6,f12.6,f10.3)
......
......@@ -287,15 +287,15 @@
!! \endverbatim
SUBROUTINE minres( n, b, r1, r2, v, w, w1, w2, x, y, &
aprod, msolve, checka, precon, shift, nout , itnlim, rtol, &
istop, itn, anorm, acond, rnorm, ynorm )
aprod, msolve, checka, precon, shift, nout , itnlim, rtol, &
istop, itn, anorm, acond, rnorm, ynorm )
IMPLICIT NONE
EXTERNAL aprod, msolve
INTEGER :: n, nout, itnlim, istop, itn
LOGICAL :: checka, precon
DOUBLE PRECISION :: shift, rtol, anorm, acond, rnorm, ynorm, &
b(n), r1(n), r2(n), v(n), w(n), w1(n), w2(n), x(n), y(n)
b(n), r1(n), r2(n), v(n), w(n), w1(n), w2(n), x(n), y(n)
EXTERNAL ddot , dnrm2
DOUBLE PRECISION :: ddot , dnrm2
......@@ -303,15 +303,15 @@ istop, itn, anorm, acond, rnorm, ynorm )
! Local variables
DOUBLE PRECISION :: alfa , beta , beta1 , cs , &
dbar , delta , denom , diag , eps , epsa , epsln , epsr , epsx , &
agamma, gbar , gmax , gmin , oldb , oldeps, qrnorm, phi , phibar, &
rhs1 , rhs2 , s , sn , t , tnorm2, ynorm2, z
dbar , delta , denom , diag , eps , epsa , epsln , epsr , epsx , &
agamma, gbar , gmax , gmin , oldb , oldeps, qrnorm, phi , phibar, &
rhs1 , rhs2 , s , sn , t , tnorm2, ynorm2, z
INTEGER :: i
LOGICAL :: debug, prnt
DOUBLE PRECISION :: zero, one, two, ten
PARAMETER ( zero = 0.0D+0, one = 1.0D+0, &
two = 2.0D+0, ten = 10.0D+0 )
two = 2.0D+0, ten = 10.0D+0 )
CHARACTER (LEN=16) :: enter, EXIT
CHARACTER (LEN=52) :: msg(-1:8)
......@@ -319,15 +319,15 @@ istop, itn, anorm, acond, rnorm, ynorm )
DATA enter /' Enter MINRES. '/, EXIT /' Exit MINRES. '/
DATA msg &
/ 'beta2 = 0. If M = I, b and x are eigenvectors of A', &
'beta1 = 0. The exact solution is x = 0', &
'Requested accuracy achieved, as determined by rtol', &
'Reasonable accuracy achieved, given eps', &
'x has converged to an eigenvector', 'Acond has exceeded 0.1/eps', &
'The iteration limit was reached', &
'Aprod does not define a symmetric matrix', &
'Msolve does not define a symmetric matrix', &
'Msolve does not define a pos-def preconditioner' /
/ 'beta2 = 0. If M = I, b and x are eigenvectors of A', &
'beta1 = 0. The exact solution is x = 0', &
'Requested accuracy achieved, as determined by rtol', &
'Reasonable accuracy achieved, given eps', &
'x has converged to an eigenvector', 'Acond has exceeded 0.1/eps', &
'The iteration limit was reached', &
'Aprod does not define a symmetric matrix', &
'Msolve does not define a symmetric matrix', &
'Msolve does not define a pos-def preconditioner' /
! ------------------------------------------------------------------
debug = .false.
......@@ -620,7 +620,7 @@ istop, itn, anorm, acond, rnorm, ynorm )
900 IF (nout > 0) THEN
WRITE(nout, 2000) EXIT, istop, itn, EXIT, anorm, acond, &
EXIT, rnorm, ynorm
EXIT, rnorm, ynorm
WRITE(nout, 3000) EXIT, msg(istop)
END IF
......@@ -628,15 +628,15 @@ istop, itn, anorm, acond, rnorm, ynorm )
1000 FORMAT(// 1P, a, 5X, 'Solution of symmetric Ax = b' &
/ ' n =', i7, 5X, 'checkA =', l4, 12X, 'precon =', l4 &
/ ' itnlim =', i7, 5X, 'rtol =', e11.2, 5X, 'shift =', e23.14)
/ ' n =', i7, 5X, 'checkA =', l4, 12X, 'precon =', l4 &
/ ' itnlim =', i7, 5X, 'rtol =', e11.2, 5X, 'shift =', e23.14)
1200 FORMAT(// 5X, 'itn', 8X, 'x(1)', 10X, &
'norm(r)', 3X, 'norm(A)', 3X, 'cond(A)')
'norm(r)', 3X, 'norm(A)', 3X, 'cond(A)')
1300 FORMAT(1P, i8, e19.10, 3E10.2)
1500 FORMAT(1X)
2000 FORMAT(/ 1P, a, 5X, 'istop =', i3, 14X, 'itn =', i8 &
/ a, 5X, 'Anorm =', e12.4, 5X, 'Acond =', e12.4 &
/ a, 5X, 'rnorm =', e12.4, 5X, 'ynorm =', e12.4)
/ a, 5X, 'Anorm =', e12.4, 5X, 'Acond =', e12.4 &
/ a, 5X, 'rnorm =', e12.4, 5X, 'ynorm =', e12.4)
3000 FORMAT( a, 5X, a )
END SUBROUTINE minres
......@@ -188,7 +188,7 @@ DOUBLE PRECISION FUNCTION ddot(n,dx,incx,dy,incy)
40 mp1 = m + 1
DO i = mp1,n,5
dtemp = dtemp + dx(i)*dy(i) + dx(i + 1)*dy(i + 1) + &
dx(i + 2)*dy(i + 2) + dx(i + 3)*dy(i + 3) + dx(i + 4)*dy(i + 4)
dx(i + 2)*dy(i + 2) + dx(i + 3)*dy(i + 3) + dx(i + 4)*dy(i + 4)
END DO
60 ddot = dtemp
......
......@@ -18,12 +18,12 @@ MODULE mpdalc
!> allocate array
INTERFACE mpalloc
MODULE PROCEDURE mpallocdvec, mpallocfvec, mpallocivec, &
mpallocfarr, mpallociarr, mpalloclarr, mpalloclist, mpalloccvec
mpallocfarr, mpallociarr, mpalloclarr, mpalloclist, mpalloccvec
END INTERFACE mpalloc
!> deallocate array
INTERFACE mpdealloc
MODULE PROCEDURE mpdeallocdvec, mpdeallocfvec, mpdeallocivec, &
mpdeallocfarr, mpdeallociarr, mpdealloclarr, mpdealloclist, mpdealloccvec
mpdeallocfarr, mpdeallociarr, mpdealloclarr, mpdealloclist, mpdealloccvec
END INTERFACE mpdealloc
CONTAINS
......
......@@ -210,7 +210,7 @@ SUBROUTINE hmpdef(ih,xa,xb,text) ! book, reset histogram
IF(khist(ihc) /= 0) THEN
IF(khist(ihc) == 1) THEN
CALL hmpmak(inhist(1,ihc),fnhist(1,ihc),jnhist(1,ihc), &
xl(1,ihc),dl(1,ihc))
xl(1,ihc),dl(1,ihc))
END IF
nn=jnhist(1,ihc)+jnhist(2,ihc)+jnhist(3,ihc)
IF(nn /= 0.OR.khist(ihc) == 3) THEN
......@@ -225,7 +225,7 @@ SUBROUTINE hmpdef(ih,xa,xb,text) ! book, reset histogram
WRITE(*,*) ' Out_low inside out_high = ', (jnhist(j,ihc),j=1,3)
ELSE IF(khist(ihc) == 2) THEN
WRITE(*,*) ' 0_or_negative inside above_10^6 = ', &
(jnhist(j,ihc),j=1,3)
(jnhist(j,ihc),j=1,3)
END IF
IF(khist(ihc) == 3) THEN
CALL pfvert(120,fnhist(1,ihc))
......@@ -249,7 +249,7 @@ SUBROUTINE hmpdef(ih,xa,xb,text) ! book, reset histogram
END IF
ELSE IF(khist(ihc) == 2) THEN
WRITE(*,*) ' Plot of log10 of entries. Min and Max are', &
jnhist(4,ihc),jnhist(5,ihc)
jnhist(4,ihc),jnhist(5,ihc)
END IF
END IF
END IF
......@@ -275,14 +275,14 @@ SUBROUTINE hmpdef(ih,xa,xb,text) ! book, reset histogram
IF(khist(ihc) /= 0) THEN
IF(khist(ihc) == 1) THEN
CALL hmpmak(inhist(1,ihc),fnhist(1,ihc),jnhist(1,ihc), &
xl(1,ihc),dl(1,ihc))
xl(1,ihc),dl(1,ihc))
END IF
nbin=120
WRITE(lun,204) ' '
WRITE(lun,201) ihc,kvers(ihc),khist(ihc)
WRITE(lun,204) htext(ihc)
IF (jnhist(1,ihc)+jnhist(2,ihc)+jnhist(3,ihc) == 0 &
.AND.xl(1,ihc) == xl(2,ihc)) THEN
.AND.xl(1,ihc) == xl(2,ihc)) THEN
! hist is empty and hist range makes no sense
! - cause: hist with 'variable edges' was never filled
! - workaround: make lower and upper edge of hist differ in output
......@@ -441,7 +441,7 @@ SUBROUTINE bintab(tab,n,xa,xb) ! hist scale from data
x1=-xx
x2=+xx
ELSE IF(x1*x2 > 0.0.AND. & ! include zero ?
ABS(MIN(x1,x2)) < 0.4*ABS(MAX(x1,x2))) THEN
ABS(MIN(x1,x2)) < 0.4*ABS(MAX(x1,x2))) THEN
IF(x1 < 0.0) THEN
x2=0.0
ELSE
......@@ -734,7 +734,7 @@ SUBROUTINE gmpdef(ig,ityp,text) ! book, reset XY storage
WRITE(*,*) ' stored n-tuples: ',jflc(3,igc)
ELSE
WRITE(*,*) ' stored n-tuples, not-stored n-tuples: ', &
jflc(3,igc),', ',jflc(4,igc)
jflc(3,igc),', ',jflc(4,igc)
END IF
CALL stmacp(jflc(1,igc),array,na) ! get all data
......@@ -751,7 +751,7 @@ SUBROUTINE gmpdef(ig,ityp,text) ! book, reset XY storage
WRITE(*,*) ' stored n-tuples: ',jflc(3,igc)
ELSE
WRITE(*,*) ' stored n-tuples, not-stored n-tuples: ', &
jflc(3,igc),', ',jflc(4,igc)
jflc(3,igc),', ',jflc(4,igc)
END IF
CALL stmacp(jflc(1,igc),array,na) ! get all data
......@@ -791,7 +791,7 @@ SUBROUTINE gmpdef(ig,ityp,text) ! book, reset XY storage
WRITE(*,*) ' stored n-tuples: ',jflc(3,igc)
ELSE
WRITE(*,*) ' stored n-tuples, not-stored n-tuples: ', &
jflc(3,igc),', ',jflc(4,igc)
jflc(3,igc),', ',jflc(4,igc)
END IF
CALL stmacp(jflc(1,igc),array,na) ! get all data
......
......@@ -940,7 +940,7 @@ SUBROUTINE vabdec(n,val,ilptr)
DO i=MAX(mj,mk),j-1
val(kj)=val(kj) & ! L_kj := L_kj - L_ki D_ii L_ji
-val(ilptr(k)-k+i)*val(ilptr(i))*val(ilptr(j)-j+i)
-val(ilptr(k)-k+i)*val(ilptr(i))*val(ilptr(j)-j+i)
END DO !
......@@ -1070,7 +1070,7 @@ DOUBLE PRECISION FUNCTION dbdot(n,dx,dy)
END DO
DO i =MOD(n,5)+1,n,5
dtemp=dtemp+dx(i)*dy(i)+dx(i+1)*dy(i+1)+dx(i+2)*dy(i+2) &
+dx(i+3)*dy(i+3)+dx(i+4)*dy(i+4)
+dx(i+3)*dy(i+3)+dx(i+4)*dy(i+4)
END DO
dbdot=dtemp
END FUNCTION dbdot
......@@ -1650,17 +1650,17 @@ REAL FUNCTION chindl(n,nd)
! DATA PN/0.31731,0.0455002785,2.69985E-3/ ! probabilities
DATA sn/0.47523,1.690140,2.782170/
DATA table/ 1.0000, 1.1479, 1.1753, 1.1798, 1.1775, 1.1730, 1.1680, 1.1630, &
1.1581, 1.1536, 1.1493, 1.1454, 1.1417, 1.1383, 1.1351, 1.1321, &
1.1293, 1.1266, 1.1242, 1.1218, 1.1196, 1.1175, 1.1155, 1.1136, &
1.1119, 1.1101, 1.1085, 1.1070, 1.1055, 1.1040, &
4.0000, 3.0900, 2.6750, 2.4290, 2.2628, 2.1415, 2.0481, 1.9736, &
1.9124, 1.8610, 1.8171, 1.7791, 1.7457, 1.7161, 1.6897, 1.6658, &
1.6442, 1.6246, 1.6065, 1.5899, 1.5745, 1.5603, 1.5470, 1.5346, &
1.5230, 1.5120, 1.5017, 1.4920, 1.4829, 1.4742, &
9.0000, 5.9146, 4.7184, 4.0628, 3.6410, 3.3436, 3.1209, 2.9468, &
2.8063, 2.6902, 2.5922, 2.5082, 2.4352, 2.3711, 2.3143, 2.2635, &
2.2178, 2.1764, 2.1386, 2.1040, 2.0722, 2.0428, 2.0155, 1.9901, &
1.9665, 1.9443, 1.9235, 1.9040, 1.8855, 1.8681/
1.1581, 1.1536, 1.1493, 1.1454, 1.1417, 1.1383, 1.1351, 1.1321, &
1.1293, 1.1266, 1.1242, 1.1218, 1.1196, 1.1175, 1.1155, 1.1136, &
1.1119, 1.1101, 1.1085, 1.1070, 1.1055, 1.1040, &
4.0000, 3.0900, 2.6750, 2.4290, 2.2628, 2.1415, 2.0481, 1.9736, &
1.9124, 1.8610, 1.8171, 1.7791, 1.7457, 1.7161, 1.6897, 1.6658, &
1.6442, 1.6246, 1.6065, 1.5899, 1.5745, 1.5603, 1.5470, 1.5346, &
1.5230, 1.5120, 1.5017, 1.4920, 1.4829, 1.4742, &
9.0000, 5.9146, 4.7184, 4.0628, 3.6410, 3.3436, 3.1209, 2.9468, &
2.8063, 2.6902, 2.5922, 2.5082, 2.4352, 2.3711, 2.3143, 2.2635, &
2.2178, 2.1764, 2.1386, 2.1040, 2.0722, 2.0428, 2.0155, 1.9901, &
1.9665, 1.9443, 1.9235, 1.9040, 1.8855, 1.8681/
SAVE sn,table
! ...
IF(nd < 1) THEN
......@@ -1895,7 +1895,7 @@ SUBROUTINE equdec(n,m,c,india,nrkd,nrkd2)
ntotal=n+n*m+(m*m+m)/2
RETURN
END SUBROUTINE equdec
END SUBROUTINE equdec
!> Solution of equilibrium systems (after decomposition).
!!
......@@ -1912,7 +1912,7 @@ SUBROUTINE equdec(n,m,c,india,nrkd,nrkd2)
!! \param [in] india pointer array
!! \param [in,out] x r.h.s vector B, replaced by solution vector X
!!
SUBROUTINE equslv(n,m,c,india,x) ! solution vector
SUBROUTINE equslv(n,m,c,india,x) ! solution vector
IMPLICIT NONE
INTEGER :: i
INTEGER :: j
......@@ -2031,7 +2031,7 @@ SUBROUTINE precon(p,n,c,cu,a,s)
END DO ! J
END DO ! I
RETURN
END SUBROUTINE precon
END SUBROUTINE precon
!> Constrained preconditioner, solution.
!!
......@@ -2043,7 +2043,7 @@ SUBROUTINE precon(p,n,c,cu,a,s)
!! \param [out] x result vector
!! \param [in] y rhs vector (changed if x=y as actual parameters)
SUBROUTINE presol(p,n,cu,a,s,x,y) ! solution
SUBROUTINE presol(p,n,cu,a,s,x,y) ! solution
IMPLICIT NONE
INTEGER :: i
INTEGER :: j
......
......@@ -107,9 +107,9 @@ SUBROUTINE mptest
IF(ex3) CALL system('rm mp2tst.bin') ! remove old file
IF(.NOT.ex1) OPEN(UNIT=7,ACCESS='SEQUENTIAL',FORM='FORMATTED', &
FILE='mp2str.txt')
FILE='mp2str.txt')
IF(.NOT.ex2) OPEN(UNIT=9,ACCESS='SEQUENTIAL',FORM='FORMATTED', &
FILE='mp2con.txt')
FILE='mp2con.txt')
OPEN(UNIT=51,ACCESS='SEQUENTIAL',FORM='UNFORMATTED', FILE='mp2tst.bin')
DO i=1,nplan
......@@ -149,13 +149,13 @@ SUBROUTINE mptest
WRITE(luns,101) '*chisqcut 1.0 1.0 ! cut factor in iterations 1 and 2'
WRITE(luns,101) '*entries 10 ! lower limit on number of entries/parameter'
WRITE(luns,101) &
'*pairentries 10 ! lower limit on number of parameter pairs', &
' ! (not yet!)'
'*pairentries 10 ! lower limit on number of parameter pairs', &
' ! (not yet!)'
WRITE(luns,101) '*printrecord 1 2 ! debug printout for records'
WRITE(luns,101) &
'*printrecord -1 -1 ! debug printout for bad data records'
'*printrecord -1 -1 ! debug printout for bad data records'
WRITE(luns,101) &
'*outlierdownweighting 2 ! number of internal iterations (> 1)'
'*outlierdownweighting 2 ! number of internal iterations (> 1)'
WRITE(luns,101) '*dwfractioncut 0.2 ! 0 < value < 0.5'
WRITE(luns,101) '*presigma 0.01 ! default value for presigma'
WRITE(luns,101) '*regularisation 1.0 ! regularisation factor'
......
......@@ -153,9 +153,9 @@ SUBROUTINE mptst2(imodel) ! generate test files
IF(ex3) CALL system('rm mp2tst.bin') ! remove old file
IF(.NOT.ex1) OPEN(UNIT=7,ACCESS='SEQUENTIAL',FORM='FORMATTED', &
FILE='mp2str.txt')
FILE='mp2str.txt')
IF(.NOT.ex2) OPEN(UNIT=9,ACCESS='SEQUENTIAL',FORM='FORMATTED', &
FILE='mp2con.txt')
FILE='mp2con.txt')
OPEN(UNIT=51,ACCESS='SEQUENTIAL',FORM='UNFORMATTED', FILE='mp2tst.bin')
s=dets
......@@ -229,13 +229,13 @@ SUBROUTINE mptst2(imodel) ! generate test files
WRITE(luns,101) '*chisqcut 1.0 1.0 ! cut factor in iterations 1 and 2'
WRITE(luns,101) '*entries 10 ! lower limit on number of entries/parameter'
WRITE(luns,101) &
'*pairentries 10 ! lower limit on number of parameter pairs', &
' ! (not yet!)'
'*pairentries 10 ! lower limit on number of parameter pairs', &
' ! (not yet!)'
WRITE(luns,101) '*printrecord 1 2 ! debug printout for records'
WRITE(luns,101) &
'*printrecord -1 -1 ! debug printout for bad data records'
'*printrecord -1 -1 ! debug printout for bad data records'
WRITE(luns,101) &
'*outlierdownweighting 2 ! number of internal iterations (> 1)'
'*outlierdownweighting 2 ! number of internal iterations (> 1)'
WRITE(luns,101) '*dwfractioncut 0.2 ! 0 < value < 0.5'
WRITE(luns,101) '*presigma 0.01 ! default value for presigma'
WRITE(luns,101) '*regularisation 1.0 ! regularisation factor'
......
This diff is collapsed.
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