Skip to content

Commit

Permalink
Prettify
Browse files Browse the repository at this point in the history
  • Loading branch information
@oschuett
oschuett committed Sep 12, 2019
1 parent b97225a commit beaa17b
Show file tree
Hide file tree
Showing 4 changed files with 56 additions and 56 deletions.
6 changes: 3 additions & 3 deletions src/graphcon.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -534,15 +534,15 @@ SUBROUTINE all_permutations(x,n,q,first)
q(m)=n
END DO
ENDIF
IF(q(n-1).eq.n) THEN
IF(q(n-1).EQ.n) THEN
q(n-1)=n-1
t=x(n)
x(n)=x(n-1)
x(n-1)=t
RETURN
ENDIF
DO k=n-1,1,-1
IF(q(k).eq.k) THEN
IF(q(k).EQ.k) THEN
q(k)=n
ELSE
go to 1
Expand All @@ -563,7 +563,7 @@ SUBROUTINE all_permutations(x,n,q,first)
x(k)=t
m=m-1
k=k+1
DO WHILE (k.lt.m)
DO WHILE (k.LT.m)
t=x(m)
x(m)=x(k)
x(k)=t
Expand Down
40 changes: 20 additions & 20 deletions src/motion/bfgs_optimizer.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -227,7 +227,7 @@ RECURSIVE SUBROUTINE geoopt_bfgs(force_env,gopt_param,globenv,geo_section,gopt_e
"BFGS: Matrix diagonalization failed, using unity as model Hessian."
ELSE
DO its=1,SIZE(eigval)
IF(eigval(its).lt.0.1_dp)eigval(its)=0.1_dp
IF(eigval(its).LT.0.1_dp)eigval(its)=0.1_dp
END DO
CALL cp_fm_to_fm(eigvec_mat,hess_tmp)
CALL cp_fm_column_scale(eigvec_mat,eigval)
Expand Down Expand Up @@ -1015,35 +1015,35 @@ SUBROUTINE construct_initial_hess(force_env,hess_mat)
iglobal=col_indices(i)
iind=MOD(iglobal-1,3)+1
iat_col=(iglobal+2)/3
IF(iat_col.gt.natom)CYCLE
IF(iat_col.GT.natom)CYCLE
DO j=1,nrow_local
jglobal=row_indices(j)
jind=MOD(jglobal-1,3)+1
iat_row=(jglobal+2)/3
IF(iat_row.gt.natom)CYCLE
IF(iat_row.ne.iat_col)THEN
IF(d_ij(iat_row,iat_col).lt.6.0_dp)&
IF(iat_row.GT.natom)CYCLE
IF(iat_row.NE.iat_col)THEN
IF(d_ij(iat_row,iat_col).LT.6.0_dp)&
local_data(j,i)=local_data(j,i)+&
angle_second_deriv(r_ij,d_ij,rho_ij,iind,jind,iat_col,iat_row,natom)
ELSE
local_data(j,i)=local_data(j,i)+&
angle_second_deriv(r_ij,d_ij,rho_ij,iind,jind,iat_col,iat_row,natom)
END IF
IF(iat_col.NE.iat_row)THEN
IF(d_ij(iat_row,iat_col).lt.6.0_dp) &
IF(d_ij(iat_row,iat_col).LT.6.0_dp) &
local_data(j,i)=local_data(j,i)-&
dist_second_deriv(r_ij(iat_col,iat_row,:),&
iind,jind,d_ij(iat_row,iat_col),rho_ij(iat_row,iat_col))
ELSE
DO k=1,natom
IF(k==iat_col)CYCLE
IF(d_ij(iat_row,k).lt.6.0_dp) &
IF(d_ij(iat_row,k).LT.6.0_dp) &
local_data(j,i)=local_data(j,i)+&
dist_second_deriv(r_ij(iat_col,k,:),&
iind,jind,d_ij(iat_row,k),rho_ij(iat_row,k))
END DO
END IF
IF(fixed(jind,iat_row).lt.0.5_dp.OR.fixed(iind,iat_col).lt.0.5_dp)THEN
IF(fixed(jind,iat_row).LT.0.5_dp.OR.fixed(iind,iat_col).LT.0.5_dp)THEN
local_data(j,i)=0.0_dp
IF(jind==iind.AND.iat_row==iat_col)local_data(j,i)=1.0_dp
END IF
Expand Down Expand Up @@ -1101,11 +1101,11 @@ FUNCTION angle_second_deriv(r_ij,d_ij,rho_ij,idir,jdir,iat_der,jat_der,natom) RE
deriv=0._dp
IF(iat_der==jat_der)THEN
DO i=1,natom-1
IF(rho_ij(iat_der,i).lt.0.00001)CYCLE
IF(rho_ij(iat_der,i).LT.0.00001)CYCLE
DO j=i+1,natom
IF(rho_ij(iat_der,j).lt.0.00001)CYCLE
IF(rho_ij(iat_der,j).LT.0.00001)CYCLE
IF(i==iat_der.OR.j==iat_der)CYCLE
IF(iat_der.lt.i.OR.iat_der.gt.j)THEN
IF(iat_der.LT.i.OR.iat_der.GT.j)THEN
r12=r_ij(iat_der,i,:); r23=r_ij(i,j,:); r31=r_ij(j,iat_der,:)
d12=d_ij(iat_der,i); d23=d_ij(i,j); d31=d_ij(j,iat_der)
rho12=rho_ij(iat_der,i); rho23=rho_ij(i,j); rho31=rho_ij(j,iat_der)
Expand All @@ -1129,9 +1129,9 @@ FUNCTION angle_second_deriv(r_ij,d_ij,rho_ij,idir,jdir,iat_der,jat_der,natom) RE
rsst3*r12(idir)/(d31*d12**3)
D_mat(3,2)=(r31(jdir)-r12(jdir))/(d31*d12)+rsst3*r31(jdir)/(d31**3*d12)-&
rsst3*r12(jdir)/(d31*d12**3)
IF(ABS(denom1).le.0.011_dp)D_mat(1,1)=0.0_dp
IF(ABS(denom2).le.0.011_dp)D_mat(2,1)=0.0_dp
IF(ABS(denom3).le.0.011_dp)D_mat(3,1)=0.0_dp
IF(ABS(denom1).LE.0.011_dp)D_mat(1,1)=0.0_dp
IF(ABS(denom2).LE.0.011_dp)D_mat(2,1)=0.0_dp
IF(ABS(denom3).LE.0.011_dp)D_mat(3,1)=0.0_dp
deriv=deriv+ka1*D_mat(1,1)*D_mat(1,2)/denom1+&
ka2*D_mat(2,1)*D_mat(2,2)/denom2+&
ka3*D_mat(3,1)*D_mat(3,2)/denom3
Expand All @@ -1141,12 +1141,12 @@ FUNCTION angle_second_deriv(r_ij,d_ij,rho_ij,idir,jdir,iat_der,jat_der,natom) RE
ELSE
DO i=1,natom
IF(i==iat_der.OR.i==jat_der)CYCLE
IF(jat_der.lt.iat_der)THEN
IF(jat_der.LT.iat_der)THEN
iat=jat_der; jat=iat_der; idr=jdir; jdr=idir
ELSE
iat=iat_der; jat=jat_der; idr=idir; jdr=jdir
END IF
IF(jat.lt.i.OR.iat.gt.i)THEN
IF(jat.LT.i.OR.iat.GT.i)THEN
r12=r_ij(iat,jat,:); r23=r_ij(jat,i,:); r31=r_ij(i,iat,:)
d12=d_ij(iat,jat); d23=d_ij(jat,i); d31=d_ij(i,iat)
rho12=rho_ij(iat,jat); rho23=rho_ij(jat,i); rho31=rho_ij(i,iat)
Expand All @@ -1166,7 +1166,7 @@ FUNCTION angle_second_deriv(r_ij,d_ij,rho_ij,idir,jdir,iat_der,jat_der,natom) RE
D_mat(2,1)=-r23(idr)/(d23*d31)+rsst2*r31(idr)/(d23*d31**3)
D_mat(3,1)=(r31(idr)-r12(idr))/(d31*d12)+rsst3*r31(idr)/(d31**3*d12)-&
rsst3*r12(idr)/(d31*d12**3)
IF(jat.lt.i.OR.iat.gt.i)THEN
IF(jat.LT.i.OR.iat.GT.i)THEN
D_mat(1,2)=(r12(jdr)-r23(jdr))/(d12*d23)+rsst1*r12(jdr)/(d12**3*d23)-&
rsst1*r23(jdr)/(d12*d23**3)
D_mat(2,2)=r31(jdr)/(d23*d31)-rsst2*r23(jdr)/(d23**3*d31)
Expand All @@ -1177,9 +1177,9 @@ FUNCTION angle_second_deriv(r_ij,d_ij,rho_ij,idir,jdir,iat_der,jat_der,natom) RE
rsst2*r31(jdr)/(d23*d31**3)
D_mat(3,2)=r12(jdr)/(d31*d12)-rsst3*r31(jdr)/(d31**3*d12)
END IF
IF(ABS(denom1).le.0.011_dp)D_mat(1,1)=0.0_dp
IF(ABS(denom2).le.0.011_dp)D_mat(2,1)=0.0_dp
IF(ABS(denom3).le.0.011_dp)D_mat(3,1)=0.0_dp
IF(ABS(denom1).LE.0.011_dp)D_mat(1,1)=0.0_dp
IF(ABS(denom2).LE.0.011_dp)D_mat(2,1)=0.0_dp
IF(ABS(denom3).LE.0.011_dp)D_mat(3,1)=0.0_dp

deriv=deriv+ka1*D_mat(1,1)*D_mat(1,2)/denom1+&
ka2*D_mat(2,1)*D_mat(2,2)/denom2+&
Expand Down
16 changes: 8 additions & 8 deletions src/motion/cp_lbfgs.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2987,22 +2987,22 @@ SUBROUTINE subsm ( n, m, nsub, ind, lower_bound, upper_bound, nbd, x, d, xp, ws,
IF ( nbd(k) /= 0 ) THEN
!
! lower bounds only
IF ( nbd(k).eq.1 ) THEN
IF ( nbd(k).EQ.1 ) THEN
x(k) = MAX( lower_bound(k), xk + dk )
IF ( x(k).eq.lower_bound(k) ) iword = 1
IF ( x(k).EQ.lower_bound(k) ) iword = 1
ELSE
!
! upper and lower bounds
IF ( nbd(k).eq.2 ) THEN
IF ( nbd(k).EQ.2 ) THEN
xk = MAX( lower_bound(k), xk + dk )
x(k) = MIN( upper_bound(k), xk )
IF ( x(k).eq.lower_bound(k) .OR. x(k).eq.upper_bound(k) ) iword = 1
IF ( x(k).EQ.lower_bound(k) .OR. x(k).EQ.upper_bound(k) ) iword = 1
ELSE
!
! upper bounds only
IF ( nbd(k).eq.3 ) THEN
IF ( nbd(k).EQ.3 ) THEN
x(k) = MIN( upper_bound(k), xk + dk )
IF ( x(k).eq.upper_bound(k) ) iword = 1
IF ( x(k).EQ.upper_bound(k) ) iword = 1
END IF
END IF
END IF
Expand All @@ -3013,15 +3013,15 @@ SUBROUTINE subsm ( n, m, nsub, ind, lower_bound, upper_bound, nbd, x, d, xp, ws,
END IF
END DO
!
IF ( .NOT.(iword.eq.0) ) THEN
IF ( .NOT.(iword.EQ.0) ) THEN
!
! check sign of the directional derivative
!
dd_p = zero
DO i=1, n
dd_p = dd_p + (x(i) - xx(i))*gg(i)
END DO
IF ( dd_p .gt.zero ) THEN
IF ( dd_p .GT.zero ) THEN
CALL dcopy( n, xp, 1, x, 1 )
IF(iprint >0) WRITE(*,*) ' Positive dir derivative in projection '
IF(iprint >0) WRITE(*,*) ' Using the backtracking step '
Expand Down
50 changes: 25 additions & 25 deletions src/pw/ps_wavelet_fft3d.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -205,11 +205,11 @@ SUBROUTINE ctrig(n,trig,after,before,now,isign,ic)
WRITE(*,37) (idata(1,j),j=1,149)
CPABORT("")
ENDIF
IF (n.eq.idata(1,i)) THEN
IF (n.EQ.idata(1,i)) THEN
ic=0
DO j=1,6
itt=idata(1+j,i)
IF (itt.gt.1) THEN
IF (itt.GT.1) THEN
ic=ic+1
now(j)=idata(1+j,i)
ELSE
Expand All @@ -229,7 +229,7 @@ SUBROUTINE ctrig(n,trig,after,before,now,isign,ic)
twopi=6.283185307179586_dp
angle=isign*twopi/n
IF (MOD(n,2).eq.0) THEN
IF (MOD(n,2).EQ.0) THEN
nh=n/2
trig(1,1)=1._dp
trig(2,1)=0._dp
Expand Down Expand Up @@ -301,7 +301,7 @@ SUBROUTINE fftstp(mm,nfft,m,nn,n,zin,zout,trig,after,now,before,isign)
! sqrt(.5_dp)
rt2i=0.7071067811865475_dp
IF (now.eq.2) THEN
IF (now.EQ.2) THEN
ia=1
nin1=ia-after
nout1=ia-atn
Expand All @@ -322,8 +322,8 @@ SUBROUTINE fftstp(mm,nfft,m,nn,n,zin,zout,trig,after,now,before,isign)
ENDDO ; ENDDO
DO 2000,ia=2,after
ias=ia-1
IF (2*ias.eq.after) THEN
IF (isign.eq.1) THEN
IF (2*ias.EQ.after) THEN
IF (isign.EQ.1) THEN
nin1=ia-after
nout1=ia-atn
DO ib=1,before
Expand Down Expand Up @@ -360,8 +360,8 @@ SUBROUTINE fftstp(mm,nfft,m,nn,n,zin,zout,trig,after,now,before,isign)
zout(2,j,nout2)= s2 + s1
ENDDO ; ENDDO
ENDIF
ELSE IF (4*ias.eq.after) THEN
IF (isign.eq.1) THEN
ELSE IF (4*ias.EQ.after) THEN
IF (isign.EQ.1) THEN
nin1=ia-after
nout1=ia-atn
DO ib=1,before
Expand Down Expand Up @@ -402,8 +402,8 @@ SUBROUTINE fftstp(mm,nfft,m,nn,n,zin,zout,trig,after,now,before,isign)
zout(2,j,nout2)= s1 - s2
ENDDO ; ENDDO
ENDIF
ELSE IF (4*ias.eq.3*after) THEN
IF (isign.eq.1) THEN
ELSE IF (4*ias.EQ.3*after) THEN
IF (isign.EQ.1) THEN
nin1=ia-after
nout1=ia-atn
DO ib=1,before
Expand Down Expand Up @@ -469,8 +469,8 @@ SUBROUTINE fftstp(mm,nfft,m,nn,n,zin,zout,trig,after,now,before,isign)
ENDDO ; ENDDO
ENDIF
2000 CONTINUE
ELSE IF (now.eq.4) THEN
IF (isign.eq.1) THEN
ELSE IF (now.EQ.4) THEN
IF (isign.EQ.1) THEN
ia=1
nin1=ia-after
nout1=ia-atn
Expand Down Expand Up @@ -511,7 +511,7 @@ SUBROUTINE fftstp(mm,nfft,m,nn,n,zin,zout,trig,after,now,before,isign)
ENDDO ; ENDDO
DO 4000,ia=2,after
ias=ia-1
IF (2*ias.eq.after) THEN
IF (2*ias.EQ.after) THEN
nin1=ia-after
nout1=ia-atn
DO ib=1,before
Expand Down Expand Up @@ -650,7 +650,7 @@ SUBROUTINE fftstp(mm,nfft,m,nn,n,zin,zout,trig,after,now,before,isign)
ENDDO ; ENDDO
DO 4100,ia=2,after
ias=ia-1
IF (2*ias.eq.after) THEN
IF (2*ias.EQ.after) THEN
nin1=ia-after
nout1=ia-atn
DO ib=1,before
Expand Down Expand Up @@ -749,8 +749,8 @@ SUBROUTINE fftstp(mm,nfft,m,nn,n,zin,zout,trig,after,now,before,isign)
ENDIF
4100 CONTINUE
ENDIF
ELSE IF (now.eq.8) THEN
IF (isign.eq.-1) THEN
ELSE IF (now.EQ.8) THEN
IF (isign.EQ.-1) THEN
ia=1
nin1=ia-after
nout1=ia-atn
Expand Down Expand Up @@ -1192,7 +1192,7 @@ SUBROUTINE fftstp(mm,nfft,m,nn,n,zin,zout,trig,after,now,before,isign)
8001 CONTINUE
ENDIF
ELSE IF (now.eq.3) THEN
ELSE IF (now.EQ.3) THEN
! .5_dp*sqrt(3._dp)
bb=isign*0.8660254037844387_dp
ia=1
Expand Down Expand Up @@ -1227,8 +1227,8 @@ SUBROUTINE fftstp(mm,nfft,m,nn,n,zin,zout,trig,after,now,before,isign)
ENDDO ; ENDDO
DO 3000,ia=2,after
ias=ia-1
IF (4*ias.eq.3*after) THEN
IF (isign.eq.1) THEN
IF (4*ias.EQ.3*after) THEN
IF (isign.EQ.1) THEN
nin1=ia-after
nout1=ia-atn
DO ib=1,before
Expand Down Expand Up @@ -1289,8 +1289,8 @@ SUBROUTINE fftstp(mm,nfft,m,nn,n,zin,zout,trig,after,now,before,isign)
zout(2,j,nout3) = s1 - r2
ENDDO ; ENDDO
ENDIF
ELSE IF (8*ias.eq.3*after) THEN
IF (isign.eq.1) THEN
ELSE IF (8*ias.EQ.3*after) THEN
IF (isign.EQ.1) THEN
nin1=ia-after
nout1=ia-atn
DO ib=1,before
Expand Down Expand Up @@ -1398,7 +1398,7 @@ SUBROUTINE fftstp(mm,nfft,m,nn,n,zin,zout,trig,after,now,before,isign)
ENDDO ; ENDDO
ENDIF
3000 CONTINUE
ELSE IF (now.eq.5) THEN
ELSE IF (now.EQ.5) THEN
! cos(2._dp*pi/5._dp)
cos2=0.3090169943749474_dp
! cos(4._dp*pi/5._dp)
Expand Down Expand Up @@ -1461,8 +1461,8 @@ SUBROUTINE fftstp(mm,nfft,m,nn,n,zin,zout,trig,after,now,before,isign)
ENDDO ; ENDDO
DO 5000,ia=2,after
ias=ia-1
IF (8*ias.eq.5*after) THEN
IF (isign.eq.1) THEN
IF (8*ias.EQ.5*after) THEN
IF (isign.EQ.1) THEN
nin1=ia-after
nout1=ia-atn
DO ib=1,before
Expand Down Expand Up @@ -1651,7 +1651,7 @@ SUBROUTINE fftstp(mm,nfft,m,nn,n,zin,zout,trig,after,now,before,isign)
ENDDO ; ENDDO
ENDIF
5000 CONTINUE
ELSE IF (now.eq.6) THEN
ELSE IF (now.EQ.6) THEN
! .5_dp*sqrt(3._dp)
bb=isign*0.8660254037844387_dp
Expand Down

0 comments on commit beaa17b

Please sign in to comment.