Skip to content

Commit 3a14275

Browse files
filippolipparinifilippolipparini
committed
added a test suite and fixed some printings.
1 parent b4bd8c8 commit 3a14275

20 files changed

+5653
-27
lines changed

‎cosmo.f90‎

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -56,9 +56,8 @@ subroutine cosmo( star, cart, phi, glm, psi, sigma, esolv )
5656
! - if star is false, computes the solvation energy.
5757
!---------------------------------------------------------------------------------------
5858
!
59-
use ddcosmo , only : ncav, nylm, nsph, iconv, zero, ngrid, &
60-
wghpot, intrhs, facl, pt5, eps, sprod, iout, iprint, &
61-
ndiis, one
59+
use ddcosmo , only : iprint, ncav, nylm, nsph, iconv, zero, ngrid, ndiis, &
60+
wghpot, intrhs, facl, pt5, eps, sprod, iout, one, prtsph
6261
!
6362
implicit none
6463
logical, intent(in) :: star, cart
@@ -128,6 +127,8 @@ subroutine cosmo( star, cart, phi, glm, psi, sigma, esolv )
128127
rhs = glm
129128
!
130129
endif
130+
!
131+
if (iprint.ge.4) call prtsph('rhs of the ddCOSMO equation',nsph,0,rhs)
131132
!
132133
! 2. INITIAL GUESS
133134
! ----------------
@@ -164,6 +165,8 @@ subroutine cosmo( star, cart, phi, glm, psi, sigma, esolv )
164165
! ==================================
165166
!
166167
else
168+
!
169+
if (iprint.ge.4) call prtsph('rhs of the ddCOSMO adjoint equation',nsph,0,psi)
167170
!
168171
! 1. INITIAL GUESS
169172
! ----------------

‎ddcosmo.f90‎

Lines changed: 40 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -14,8 +14,9 @@ module ddcosmo
1414
!
1515
!
1616
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
17-
! COPYRIGHT (C) 2015 by Filippo Lipparini, Benjamin Stamm, Eric Cancès, !
18-
! Yvon Maday, Jean-Philip Piquemal, Louis Lagardère and Benedetta Mennucci. !
17+
! COPYRIGHT (C) 2015 by Filippo Lipparini, Benjamin Stamm, Paolo Gatto !
18+
! Eric Cancès, Yvon Maday, Jean-Philip Piquemal, Louis Lagardère and !
19+
! Benedetta Mennucci. !
1920
! ALL RIGHT RESERVED. !
2021
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2122
!
@@ -269,6 +270,14 @@ subroutine ddinit(n,x,y,z,rvdw)
269270
write(*,*)'ddinit : [1] deallocation failed!'
270271
stop
271272
endif
273+
!
274+
if (iprint.ge.4) then
275+
call prtsph('facs',1,0,facs)
276+
call prtsph('facl',1,0,facs)
277+
call prtsph('basis',ngrid,0,basis)
278+
call ptcart('grid',3,0,grid)
279+
call ptcart('weights',1,0,w)
280+
end if
272281
!
273282
! build neighbors list (CSR format)
274283
! =================================
@@ -313,6 +322,20 @@ subroutine ddinit(n,x,y,z,rvdw)
313322
end do
314323
end do
315324
inl(nsph+1) = lnl+1
325+
!
326+
1000 format(t3,'neighbours of sphere ',i6)
327+
1010 format(t5,12i6)
328+
!
329+
if (iprint.ge.4) then
330+
write(iout,*) ' inl:'
331+
write(iout,'(10i6)') inl(1:nsph+1)
332+
write(iout,*)
333+
do isph = 1, nsph
334+
write(iout,1000) isph
335+
write(iout,1010) nl(inl(isph):inl(isph+1)-1)
336+
end do
337+
write(iout,*)
338+
end if
316339
!
317340
!-----------------------------------------------------------------------
318341
! Define :
@@ -385,9 +408,12 @@ subroutine ddinit(n,x,y,z,rvdw)
385408
!
386409
enddo
387410
enddo
388-
!
389411
!$omp end parallel do
390-
!
412+
!
413+
if (iprint.ge.4) then
414+
call ptcart('fi',nsph,0,fi)
415+
call ptcart('ui',nsph,0,ui)
416+
end if
391417
!
392418
! build cavity array
393419
! ==================
@@ -440,6 +466,16 @@ subroutine ddinit(n,x,y,z,rvdw)
440466
endif
441467
enddo
442468
enddo
469+
!
470+
1100 format(t3,i8,3f14.6)
471+
!
472+
if (iprint.ge.4) then
473+
write(iout,*) ' external cavity points:'
474+
do ii = 1, ncav
475+
write(iout,1100) ii, ccav(:,ii)
476+
end do
477+
write(iout,*)
478+
end if
443479
!
444480
return
445481
!

‎efld.f90‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -11,11 +11,12 @@ subroutine efld(nsrc,src,csrc,ntrg,ctrg,ef)
1111
! "Y88888 "Y88888 "Y8888P" "Y88888P" "Y8888P" 888 888 "Y88888P"
1212
!
1313
!
14-
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15-
! COPYRIGHT (C) 2015 by Filippo Lipparini, Benjamin Stamm, Eric Cancès, !
16-
! Yvon Maday, Jean-Philip Piquemal, Louis Lagardère and Benedetta Mennucci. !
1714
! ALL RIGHT RESERVED. !
1815
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16+
! COPYRIGHT (C) 2015 by Filippo Lipparini, Benjamin Stamm, Paolo Gatto !
17+
! Eric Cancès, Yvon Maday, Jean-Philip Piquemal, Louis Lagardère and !
18+
! Benedetta Mennucci. !
19+
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1920
!
2021
!
2122
! A modular implementation of COSMO using a domain decomposition linear scaling

‎forces_dd.f90‎

Lines changed: 15 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -12,8 +12,9 @@ subroutine forces_dd(n,phi,sigma,s,fx)
1212
!
1313
!
1414
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15-
! COPYRIGHT (C) 2015 by Filippo Lipparini, Benjamin Stamm, Eric Cancès, !
16-
! Yvon Maday, Jean-Philip Piquemal, Louis Lagardère and Benedetta Mennucci. !
15+
! COPYRIGHT (C) 2015 by Filippo Lipparini, Benjamin Stamm, Paolo Gatto !
16+
! Eric Cancès, Yvon Maday, Jean-Philip Piquemal, Louis Lagardère and !
17+
! Benedetta Mennucci. !
1718
! ALL RIGHT RESERVED. !
1819
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1920
!
@@ -112,6 +113,8 @@ subroutine forces_dd(n,phi,sigma,s,fx)
112113
end do
113114
!$omp end parallel do
114115
!
116+
if (iprint.ge.4) call ptcart('xi',nsph,0,xi)
117+
!
115118
! expand the potential on a sphere-by-sphere basis (needed for parallelism):
116119
!
117120
ii = 0
@@ -131,7 +134,16 @@ subroutine forces_dd(n,phi,sigma,s,fx)
131134
call fdokb(isph,sigma,xi,basloc,dbsloc,vplm,vcos,vsin,fx(:,isph))
132135
call fdoga(isph,xi,phiexp,fx(:,isph))
133136
end do
134-
137+
!
138+
2000 format(1x,'ddCOSMO-only contributions to the forces (atomic units):',/, &
139+
1x,' atom',15x,'x',15x,'y',15x,'z')
140+
!
141+
if (iprint.ge.4) then
142+
write(iout,2000)
143+
do isph = 1, nsph
144+
write(6,'(1x,i5,3f16.8)') isph, fx(:,isph)
145+
end do
146+
end if
135147
!
136148
deallocate (basloc,dbsloc,vplm,vcos,vsin)
137149
!

‎main.f90‎

Lines changed: 11 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -12,8 +12,9 @@ program main
1212
!
1313
!
1414
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15-
! COPYRIGHT (C) 2015 by Filippo Lipparini, Benjamin Stamm, Eric Cancès, !
16-
! Yvon Maday, Jean-Philip Piquemal, Louis Lagardère and Benedetta Mennucci. !
15+
! COPYRIGHT (C) 2015 by Filippo Lipparini, Benjamin Stamm, Paolo Gatto !
16+
! Eric Cancès, Yvon Maday, Jean-Philip Piquemal, Louis Lagardère and !
17+
! Benedetta Mennucci. !
1718
! ALL RIGHT RESERVED. !
1819
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1920
!
@@ -74,8 +75,9 @@ program main
7475
! algebraic order of accuracy"
7576
! Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481.
7677
!
77-
! Written by Filippo Lipparini, October 2015 and
78+
! Written by Filippo Lipparini, October 2015
7879
! Paolo Gatto, December 2017
80+
! Filippo Lipparini, March 2018
7981
!
8082
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
8183
! !
@@ -183,6 +185,8 @@ program main
183185
!
184186
call cosmo(.false., .true., phi, xx, psi, sigma, esolv)
185187
!
188+
if (iprint.ge.3) call prtsph('solution to the ddCOSMO equation',nsph,0,sigma)
189+
!
186190
write (6,'(1x,a,f14.6)') 'ddcosmo electrostatic solvation energy (kcal/mol):', esolv*tokcal
187191
!
188192
! this is all for the energy. if the forces are also required, call the solver for
@@ -195,6 +199,8 @@ program main
195199
allocate (s(nylm,n))
196200
allocate (fx(3,n))
197201
call cosmo(.true., .false., xx, xx, psi, s, esolv)
202+
!
203+
if (iprint.ge.3) call prtsph('solution to the ddCOSMO adjoint equation',nsph,0,s)
198204
!
199205
! now call the routine that computes the ddcosmo specific contributions to the forces.
200206
!
@@ -204,6 +210,8 @@ program main
204210
!
205211
allocate (zeta(ncav))
206212
call ddmkzeta(s,zeta)
213+
!
214+
if (iprint.ge.4) call ptcart('zeta',nsph,0,zeta)
207215
!
208216
! -------------------------- modify here --------------------------
209217
!

‎matvec.f90‎

Lines changed: 16 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -10,8 +10,9 @@
1010
!
1111
!
1212
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
13-
! COPYRIGHT (C) 2015 by Filippo Lipparini, Benjamin Stamm, Eric Cancès, !
14-
! Yvon Maday, Jean-Philip Piquemal, Louis Lagardère and Benedetta Mennucci. !
13+
! COPYRIGHT (C) 2015 by Filippo Lipparini, Benjamin Stamm, Paolo Gatto !
14+
! Eric Cancès, Yvon Maday, Jean-Philip Piquemal, Louis Lagardère and !
15+
! Benedetta Mennucci. !
1516
! ALL RIGHT RESERVED. !
1617
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1718
!
@@ -92,8 +93,8 @@
9293
!
9394
subroutine lx( n, x, y )
9495
!
95-
use ddcosmo , only : nylm, nsph, ngrid, lmax, zero, calcv, intrhs, &
96-
facl
96+
use ddcosmo , only : iprint, nylm, nsph, ngrid, lmax, zero, calcv, intrhs, &
97+
facl, prtsph
9798
!
9899
implicit none
99100
integer, intent(in) :: n
@@ -112,6 +113,8 @@ subroutine lx( n, x, y )
112113
write(*,*) 'lx: allocation failed !'
113114
stop
114115
endif
116+
!
117+
if (iprint.ge.5) call prtsph('X',nsph,0,x)
115118
!
116119
! initialize
117120
y = zero
@@ -130,8 +133,9 @@ subroutine lx( n, x, y )
130133
! action of off-diagonal blocks
131134
y(:,isph) = - y(:,isph)
132135
!
133-
! add action of diagonal block
134136
enddo
137+
!
138+
if (iprint.ge.5) call prtsph('LX (off diagonal)',nsph,0,y)
135139
!
136140
! deallocate workspaces
137141
deallocate( pot, basloc, vplm, vcos, vsin , stat=istatus )
@@ -156,11 +160,11 @@ end subroutine lx
156160
!
157161
subroutine lstarx( n, x, y )
158162
!
159-
use ddcosmo , only : nylm, nsph, ngrid, lmax, zero, basis, &
160-
adjrhs, facl
163+
use ddcosmo , only : iprint, nylm, nsph, ngrid, lmax, zero, basis, &
164+
adjrhs, facl, prtsph
161165
!
162166
implicit none
163-
integer, intent(in) :: n
167+
integer, intent(in) :: n
164168
real*8, dimension(nylm,nsph), intent(in) :: x
165169
real*8, dimension(nylm,nsph), intent(inout) :: y
166170
!
@@ -176,6 +180,8 @@ subroutine lstarx( n, x, y )
176180
write(*,*) 'lstarx: allocation failed!'
177181
stop
178182
endif
183+
!
184+
if (iprint.ge.5) call prtsph('X',nsph,0,x)
179185
!
180186
! initilize
181187
y = zero
@@ -215,6 +221,8 @@ subroutine lstarx( n, x, y )
215221
! add action of diagonal block
216222
!
217223
enddo
224+
!
225+
if (iprint.ge.5) call prtsph('L*X (off-diagonal)',nsph,0,y)
218226
!
219227
! deallocate workspaces
220228
deallocate( xi, basloc, vplm, vcos, vsin , stat=istatus )

‎mkrhs.f90‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -12,8 +12,9 @@ subroutine mkrhs(n,charge,x,y,z,ncav,ccav,phi,nylm,psi)
1212
!
1313
!
1414
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15-
! COPYRIGHT (C) 2015 by Filippo Lipparini, Benjamin Stamm, Eric Cancès, !
16-
! Yvon Maday, Jean-Philip Piquemal, Louis Lagardère and Benedetta Mennucci. !
15+
! COPYRIGHT (C) 2015 by Filippo Lipparini, Benjamin Stamm, Paolo Gatto !
16+
! Eric Cancès, Yvon Maday, Jean-Philip Piquemal, Louis Lagardère and !
17+
! Benedetta Mennucci. !
1718
! ALL RIGHT RESERVED. !
1819
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1920
!
@@ -86,7 +87,7 @@ subroutine mkrhs(n,charge,x,y,z,ncav,ccav,phi,nylm,psi)
8687
real*8, dimension(n), intent(in) :: x, y, z, charge
8788
real*8, dimension(3,ncav), intent(in) :: ccav
8889
real*8, dimension(ncav), intent(inout) :: phi
89-
real*8, dimension(nylm,n), intent(inout) :: psi
90+
real*8, dimension(nylm,n), intent(inout) :: psi
9091
!
9192
integer :: isph, ic, j
9293
real*8 :: v

0 commit comments

Comments
 (0)