Removal of stale Fortran kernels
[gromacs.git] / src / gmxlib / nonbonded / nb_kernel_power6 / pwr6kernel120.F
blobe2094101cf66f962886e431cc2aa6ebe3d39a59a
2 C                This source code is part of
4 C                 G   R   O   M   A   C   S
6 C Copyright (c) 1991-2000, University of Groningen, The Netherlands.
7 C Copyright (c) 2001-2009, The GROMACS Development Team
9 C Gromacs is a library for molecular simulation and trajectory analysis,
10 C written by Erik Lindahl, David van der Spoel, Berk Hess, and others - for
11 C a full list of developers and information, check out http://www.gromacs.org
13 C This program is free software; you can redistribute it and/or modify it under
14 C the terms of the GNU Lesser General Public License as published by the Free
15 C Software Foundation; either version 2 of the License, or (at your option) any
16 C later version.
17 C As a special exception, you may use this file as part of a free software
18 C library without restriction.  Specifically, if other files instantiate
19 C templates or use macros or inline functions from this file, or you compile
20 C this file and link it with other files to produce an executable, this
21 C file does not by itself cause the resulting executable to be covered by
22 C the GNU Lesser General Public License.
24 C In plain-speak: do not worry about classes/macros/templates either - only
25 C changes to the library have to be LGPL, not an application linking with it.
27 C To help fund GROMACS development, we humbly ask that you cite
28 C the papers people have written on it - you can find them on the website!
31 #ifdef HAVE_CONFIG_H
32 #  include<config.h>
33 #endif
35 #ifdef GMX_DOUBLE
36 #  define gmxreal real*8
37 #else
38 #  define gmxreal real*4
39 #endif
44 C Gromacs nonbonded kernel pwr6kernel120
45 C Coulomb interaction:     Normal Coulomb
46 C VdW interaction:         Buckingham
47 C water optimization:      No
48 C Calculate forces:        yes
50       subroutine pwr6kernel120(
51      &                          nri,
52      &                          iinr,
53      &                          jindex,
54      &                          jjnr,
55      &                          shift,
56      &                          shiftvec,
57      &                          fshift,
58      &                          gid,
59      &                          pos,
60      &                          faction,
61      &                          charge,
62      &                          facel,
63      &                          krf,
64      &                          crf,
65      &                          Vc,
66      &                          type,
67      &                          ntype,
68      &                          vdwparam,
69      &                          Vvdw,
70      &                          tabscale,
71      &                          VFtab,
72      &                          invsqrta,
73      &                          dvda,
74      &                          gbtabscale,
75      &                          GBtab,
76      &                          nthreads,
77      &                          count,
78      &                          mtx,
79      &                          outeriter,
80      &                          inneriter,
81      &                          work)
82       implicit      none
83       integer*4     nri,iinr(*),jindex(*),jjnr(*),shift(*)
84       gmxreal       shiftvec(*),fshift(*),pos(*),faction(*)
85       integer*4     gid(*),type(*),ntype
86       gmxreal       charge(*),facel,krf,crf,Vc(*),vdwparam(*)
87       gmxreal       Vvdw(*),tabscale,VFtab(*)
88       gmxreal       invsqrta(*),dvda(*),gbtabscale,GBtab(*)
89       integer*4     nthreads,count,mtx,outeriter,inneriter
90       gmxreal       work(*)
92       integer*4     n,ii,is3,ii3,k,nj0,nj1,jnr,j3,ggid
93       integer*4     nn0,nn1,nouter,ninner
94       gmxreal       shX,shY,shZ
95       gmxreal       fscal,tx,ty,tz
96       gmxreal       rinvsq
97       gmxreal       iq
98       gmxreal       qq,vcoul,vctot
99       integer*4     nti
100       integer*4     tj
101       gmxreal       rinvsix
102       gmxreal       Vvdw6,Vvdwtot
103       gmxreal       Vvdwexp,br
104       gmxreal       ix1,iy1,iz1,fix1,fiy1,fiz1
105       gmxreal       jx1,jy1,jz1
106       gmxreal       dx11,dy11,dz11,rsq11,rinv11
107       gmxreal       c6,cexp1,cexp2
110 C    Reset outer and inner iteration counters
111       nouter           = 0               
112       ninner           = 0               
114 C    Loop over thread workunits
115    10 call pwr6kernelsync(mtx,count,nri,nthreads,nn0,nn1)
116         if(nn1.gt.nri) nn1=nri
118 C      Start outer loop over neighborlists
119         
120         do n=nn0+1,nn1
122 C        Load shift vector for this list
123           is3              = 3*shift(n)+1    
124           shX              = shiftvec(is3)   
125           shY              = shiftvec(is3+1) 
126           shZ              = shiftvec(is3+2) 
128 C        Load limits for loop over neighbors
129           nj0              = jindex(n)+1     
130           nj1              = jindex(n+1)     
132 C        Get outer coordinate index
133           ii               = iinr(n)+1       
134           ii3              = 3*ii-2          
136 C        Load i atom data, add shift vector
137           ix1              = shX + pos(ii3+0)
138           iy1              = shY + pos(ii3+1)
139           iz1              = shZ + pos(ii3+2)
141 C        Load parameters for i atom
142           iq               = facel*charge(ii)
143           nti              = 3*ntype*type(ii)
145 C        Zero the potential energy for this list
146           vctot            = 0               
147           Vvdwtot          = 0               
149 C        Clear i atom forces
150           fix1             = 0               
151           fiy1             = 0               
152           fiz1             = 0               
153           
154           do k=nj0,nj1
156 C          Get j neighbor index, and coordinate index
157             jnr              = jjnr(k)+1       
158             j3               = 3*jnr-2         
160 C          load j atom coordinates
161             jx1              = pos(j3+0)       
162             jy1              = pos(j3+1)       
163             jz1              = pos(j3+2)       
165 C          Calculate distance
166             dx11             = ix1 - jx1       
167             dy11             = iy1 - jy1       
168             dz11             = iz1 - jz1       
169             rsq11            = dx11*dx11+dy11*dy11+dz11*dz11
171 C          Calculate 1/r and 1/r2
173 C          PowerPC intrinsics 1/sqrt lookup table
174 #ifndef GMX_BLUEGENE
175             rinv11           = frsqrtes(rsq11) 
176 #else
177             rinv11           = frsqrte(dble(rsq11)) 
178 #endif
179             rinv11           = (0.5*rinv11*(3.0-((rsq11*rinv11)
180      &  *rinv11)))
181 #ifdef GMX_DOUBLE
182             rinv11           = (0.5*rinv11*(3.0-((rsq11*rinv11)
183      &  *rinv11)))
184 #endif
186 C          Load parameters for j atom
187             qq               = iq*charge(jnr)  
188             tj               = nti+3*type(jnr)+1
189             c6               = vdwparam(tj)    
190             cexp1            = vdwparam(tj+1)  
191             cexp2            = vdwparam(tj+2)  
192             rinvsq           = rinv11*rinv11   
194 C          Coulomb interaction
195             vcoul            = qq*rinv11       
196             vctot            = vctot+vcoul     
198 C          Buckingham interaction
199             rinvsix          = rinvsq*rinvsq*rinvsq
200             Vvdw6            = c6*rinvsix      
201             br               = cexp2*rsq11*rinv11
202             Vvdwexp          = cexp1*exp(-br)  
203             Vvdwtot          = Vvdwtot+Vvdwexp-Vvdw6
204             fscal            = (vcoul+br*Vvdwexp-6.0*Vvdw6)*rinvsq
206 C          Calculate temporary vectorial force
207             tx               = fscal*dx11      
208             ty               = fscal*dy11      
209             tz               = fscal*dz11      
211 C          Increment i atom force
212             fix1             = fix1 + tx       
213             fiy1             = fiy1 + ty       
214             fiz1             = fiz1 + tz       
216 C          Decrement j atom force
217             faction(j3+0)    = faction(j3+0) - tx
218             faction(j3+1)    = faction(j3+1) - ty
219             faction(j3+2)    = faction(j3+2) - tz
221 C          Inner loop uses 65 flops/iteration
222           end do
223           
225 C        Add i forces to mem and shifted force list
226           faction(ii3+0)   = faction(ii3+0) + fix1
227           faction(ii3+1)   = faction(ii3+1) + fiy1
228           faction(ii3+2)   = faction(ii3+2) + fiz1
229           fshift(is3)      = fshift(is3)+fix1
230           fshift(is3+1)    = fshift(is3+1)+fiy1
231           fshift(is3+2)    = fshift(is3+2)+fiz1
233 C        Add potential energies to the group for this list
234           ggid             = gid(n)+1        
235           Vc(ggid)         = Vc(ggid) + vctot
236           Vvdw(ggid)       = Vvdw(ggid) + Vvdwtot
238 C        Increment number of inner iterations
239           ninner           = ninner + nj1 - nj0
241 C        Outer loop uses 12 flops/iteration
242         end do
243         
245 C      Increment number of outer iterations
246         nouter           = nouter + nn1 - nn0
247       if(nn1.lt.nri) goto 10
249 C    Write outer/inner iteration count to pointers
250       outeriter        = nouter          
251       inneriter        = ninner          
252       return
253       end
261 C Gromacs nonbonded kernel pwr6kernel120nf
262 C Coulomb interaction:     Normal Coulomb
263 C VdW interaction:         Buckingham
264 C water optimization:      No
265 C Calculate forces:        no
267       subroutine pwr6kernel120nf(
268      &                          nri,
269      &                          iinr,
270      &                          jindex,
271      &                          jjnr,
272      &                          shift,
273      &                          shiftvec,
274      &                          fshift,
275      &                          gid,
276      &                          pos,
277      &                          faction,
278      &                          charge,
279      &                          facel,
280      &                          krf,
281      &                          crf,
282      &                          Vc,
283      &                          type,
284      &                          ntype,
285      &                          vdwparam,
286      &                          Vvdw,
287      &                          tabscale,
288      &                          VFtab,
289      &                          invsqrta,
290      &                          dvda,
291      &                          gbtabscale,
292      &                          GBtab,
293      &                          nthreads,
294      &                          count,
295      &                          mtx,
296      &                          outeriter,
297      &                          inneriter,
298      &                          work)
299       implicit      none
300       integer*4     nri,iinr(*),jindex(*),jjnr(*),shift(*)
301       gmxreal       shiftvec(*),fshift(*),pos(*),faction(*)
302       integer*4     gid(*),type(*),ntype
303       gmxreal       charge(*),facel,krf,crf,Vc(*),vdwparam(*)
304       gmxreal       Vvdw(*),tabscale,VFtab(*)
305       gmxreal       invsqrta(*),dvda(*),gbtabscale,GBtab(*)
306       integer*4     nthreads,count,mtx,outeriter,inneriter
307       gmxreal       work(*)
309       integer*4     n,ii,is3,ii3,k,nj0,nj1,jnr,j3,ggid
310       integer*4     nn0,nn1,nouter,ninner
311       gmxreal       shX,shY,shZ
312       gmxreal       rinvsq
313       gmxreal       iq
314       gmxreal       qq,vcoul,vctot
315       integer*4     nti
316       integer*4     tj
317       gmxreal       rinvsix
318       gmxreal       Vvdw6,Vvdwtot
319       gmxreal       Vvdwexp,br
320       gmxreal       ix1,iy1,iz1
321       gmxreal       jx1,jy1,jz1
322       gmxreal       dx11,dy11,dz11,rsq11,rinv11
323       gmxreal       c6,cexp1,cexp2
326 C    Reset outer and inner iteration counters
327       nouter           = 0               
328       ninner           = 0               
330 C    Loop over thread workunits
331    10 call pwr6kernelsync(mtx,count,nri,nthreads,nn0,nn1)
332         if(nn1.gt.nri) nn1=nri
334 C      Start outer loop over neighborlists
335         
336         do n=nn0+1,nn1
338 C        Load shift vector for this list
339           is3              = 3*shift(n)+1    
340           shX              = shiftvec(is3)   
341           shY              = shiftvec(is3+1) 
342           shZ              = shiftvec(is3+2) 
344 C        Load limits for loop over neighbors
345           nj0              = jindex(n)+1     
346           nj1              = jindex(n+1)     
348 C        Get outer coordinate index
349           ii               = iinr(n)+1       
350           ii3              = 3*ii-2          
352 C        Load i atom data, add shift vector
353           ix1              = shX + pos(ii3+0)
354           iy1              = shY + pos(ii3+1)
355           iz1              = shZ + pos(ii3+2)
357 C        Load parameters for i atom
358           iq               = facel*charge(ii)
359           nti              = 3*ntype*type(ii)
361 C        Zero the potential energy for this list
362           vctot            = 0               
363           Vvdwtot          = 0               
365 C        Clear i atom forces
366           
367           do k=nj0,nj1
369 C          Get j neighbor index, and coordinate index
370             jnr              = jjnr(k)+1       
371             j3               = 3*jnr-2         
373 C          load j atom coordinates
374             jx1              = pos(j3+0)       
375             jy1              = pos(j3+1)       
376             jz1              = pos(j3+2)       
378 C          Calculate distance
379             dx11             = ix1 - jx1       
380             dy11             = iy1 - jy1       
381             dz11             = iz1 - jz1       
382             rsq11            = dx11*dx11+dy11*dy11+dz11*dz11
384 C          Calculate 1/r and 1/r2
386 C          PowerPC intrinsics 1/sqrt lookup table
387 #ifndef GMX_BLUEGENE
388             rinv11           = frsqrtes(rsq11) 
389 #else
390             rinv11           = frsqrte(dble(rsq11)) 
391 #endif
392             rinv11           = (0.5*rinv11*(3.0-((rsq11*rinv11)
393      &  *rinv11)))
394 #ifdef GMX_DOUBLE
395             rinv11           = (0.5*rinv11*(3.0-((rsq11*rinv11)
396      &  *rinv11)))
397 #endif
399 C          Load parameters for j atom
400             qq               = iq*charge(jnr)  
401             tj               = nti+3*type(jnr)+1
402             c6               = vdwparam(tj)    
403             cexp1            = vdwparam(tj+1)  
404             cexp2            = vdwparam(tj+2)  
405             rinvsq           = rinv11*rinv11   
407 C          Coulomb interaction
408             vcoul            = qq*rinv11       
409             vctot            = vctot+vcoul     
411 C          Buckingham interaction
412             rinvsix          = rinvsq*rinvsq*rinvsq
413             Vvdw6            = c6*rinvsix      
414             br               = cexp2*rsq11*rinv11
415             Vvdwexp          = cexp1*exp(-br)  
416             Vvdwtot          = Vvdwtot+Vvdwexp-Vvdw6
418 C          Inner loop uses 52 flops/iteration
419           end do
420           
422 C        Add i forces to mem and shifted force list
424 C        Add potential energies to the group for this list
425           ggid             = gid(n)+1        
426           Vc(ggid)         = Vc(ggid) + vctot
427           Vvdw(ggid)       = Vvdw(ggid) + Vvdwtot
429 C        Increment number of inner iterations
430           ninner           = ninner + nj1 - nj0
432 C        Outer loop uses 6 flops/iteration
433         end do
434         
436 C      Increment number of outer iterations
437         nouter           = nouter + nn1 - nn0
438       if(nn1.lt.nri) goto 10
440 C    Write outer/inner iteration count to pointers
441       outeriter        = nouter          
442       inneriter        = ninner          
443       return
444       end