← Back to branch summary

~ubuntu-branches/ubuntu/saucy/nwchem/saucy

« back to all changes in this revision

Viewing changes to src/nwpw/pspw/kbpp/hghppv1.F

  • Committer: Package Import Robot
  • Author(s): Michael Banck, Michael Banck, Daniel Leidert
  • Date: 2012-02-09 20:02:41 UTC
  • mfrom: (1.1.1)
  • Revision ID: package-import@ubuntu.com-20120209200241-jgk03qfsphal4ug2
Tags: 6.1-1
http://bugs.debian.org/632611
https://launchpad.net/bugs/791308
* New upstream release.

[ Michael Banck ]
* debian/patches/02_makefile_flags.patch: Updated.
* debian/patches/02_makefile_flags.patch: Use internal blas and lapack code.
* debian/patches/02_makefile_flags.patch: Define GCC4 for LINUX and LINUX64
  (Closes: #632611 and LP: #791308).
* debian/control (Build-Depends): Added openssh-client.
* debian/rules (USE_SCALAPACK, SCALAPACK): Removed variables (Closes:
  #654658).
* debian/rules (LIBDIR, USE_MPIF4, ARMCI_NETWORK): New variables.
* debian/TODO: New file.
* debian/control (Build-Depends): Removed libblas-dev, liblapack-dev and
  libscalapack-mpi-dev.
* debian/patches/04_show_testsuite_diff_output.patch: New patch, shows the
  diff output for failed tests.
* debian/patches/series: Adjusted.
* debian/testsuite: Optionally run all tests if "all" is passed as option.
* debian/rules: Run debian/testsuite with "all" if DEB_BUILD_OPTIONS
  contains "checkall".

[ Daniel Leidert ]
* debian/control: Used wrap-and-sort. Added Vcs-Svn and Vcs-Browser fields.
  (Priority): Moved to extra according to policy section 2.5.
  (Standards-Version): Bumped to 3.9.2.
  (Description): Fixed a typo.
* debian/watch: Added.
* debian/patches/03_hurd-i386_define_path_max.patch: Added.
  - Define MAX_PATH if not defines to fix FTBFS on hurd.
* debian/patches/series: Adjusted.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/nwpw/pspw/kbpp/hghppv1.F
1
1
*
2
 
* $Id: hghppv1.F,v 1.6 2007-02-07 18:45:25 d3p708 Exp $
 
2
* $Id: hghppv1.F 21318 2011-10-27 23:22:23Z bylaska $
3
3
*
4
4
 
5
5
*     **************************************
18
18
#include "msgtypesf.h"
19
19
#include "errquit.fh"
20
20
#include "util.fh"
 
21
#include "stdio.fh"
21
22
 
22
23
      logical          oprint_in
23
24
      integer          version
24
 
      character*25     psp_filename,formatted_filename
 
25
      character*50     psp_filename,formatted_filename
25
26
      integer          ngrid(3)
26
27
      double precision unita(3,3)
27
28
      real*8  rlocal
46
47
 
47
48
      integer lmax,locp
48
49
 
49
 
      integer n_prj_indx,l_prj_indx,m_prj_indx
50
 
      integer n_prj_hndl,l_prj_hndl,m_prj_hndl
 
50
      integer n_prj_indx,l_prj_indx,m_prj_indx,b_prj_indx
 
51
      integer n_prj_hndl,l_prj_hndl,m_prj_hndl,b_prj_hndl
51
52
 
52
53
*     ***** ngrid data *****
53
54
      integer Ylm_indx,vl_indx,vnl_indx,G_indx
140
141
      !**** determine nprj ****
141
142
      nprj= 0
142
143
      do l=0,lmax
143
 
            !write(*,*) "???H :",l,(H(i,l),i=1,3)
 
144
            !write(luout,*) "???H :",l,(H(i,l),i=1,3)
144
145
      do i=1,3 
145
146
        if ((H(i,l).ne.0.0d0)) nprj = nprj + (2*l+1)
146
147
      end do
147
148
      end do
148
 
      !write(*,*) "???nprj:", nprj
 
149
      !write(luout,*) "???nprj:", nprj
149
150
        
150
151
 
151
152
 
215
216
     >                        'l_prj', l_prj_hndl, l_prj_indx)
216
217
      value = value.and.MA_alloc_get(mt_int,nprj,
217
218
     >                        'm_prj', m_prj_hndl, m_prj_indx)
 
219
      value = value.and.MA_alloc_get(mt_int,nprj,
 
220
     >                        'b_prj', b_prj_hndl, b_prj_indx)
218
221
      if(.not.value)
219
222
     >    call errquit('hghppv1: out of heap memory', 0, MA_ERR)
220
223
 
221
224
 
222
225
      !**** determine n_prj, l_prj, and m_prj arrays ****
223
 
      indx = 0
 
226
      indx  = 0
 
227
      nfft1 = 1
224
228
      do l=0,lmax
225
229
      do i=1,3 
226
230
        if ((H(i,l).ne.0.0d0)) then
228
232
            int_mb(n_prj_indx+indx) = i
229
233
            int_mb(l_prj_indx+indx) = l
230
234
            int_mb(m_prj_indx+indx) = m
 
235
            int_mb(b_prj_indx+indx) = nfft1
231
236
            indx = indx + 1
232
237
          end do 
 
238
          nfft1=nfft1+1
233
239
        end if
234
240
      end do
235
241
      end do
262
268
     >                     dbl_mb(G_indx),
263
269
     >                     dbl_mb(vnl_indx+(i-1)*nsize))
264
270
         if ((taskid.eq.MASTER).and.(oprint)) 
265
 
     >      write(*,*) "creating projector:",n,l,m
 
271
     >      write(luout,*) "creating projector:",n,l,m
266
272
         do j=1,nsize
267
273
          dbl_mb(vnl_indx+(i-1)*nsize+j-1)
268
274
     >    = dbl_mb(vnl_indx+(i-1)*nsize+j-1)*dbl_mb(Ylm_indx+j-1)
272
278
 
273
279
 
274
280
      if ((taskid.eq.MASTER).and.(oprint)) then
275
 
      write(*,*) "     ********************************************"
276
 
      write(*,*) "     *                                          *"
277
 
      write(*,*) "     *    HGHPPV1 - Pseudopotential Formatter   *"
278
 
      write(*,*) "     *                                          *"
279
 
      write(*,*) "     *      version last updated 11/13/03       *"
280
 
      write(*,*) "     *                                          *"
281
 
      write(*,*) "     *       developed by Eric J. Bylaska       *"
282
 
      write(*,*) "     *                                          *"
283
 
      write(*,*) "     ********************************************"
 
281
      write(luout,*) "     ********************************************"
 
282
      write(luout,*) "     *                                          *"
 
283
      write(luout,*) "     *    HGHPPV1 - Pseudopotential Formatter   *"
 
284
      write(luout,*) "     *                                          *"
 
285
      write(luout,*) "     *      version last updated 11/13/03       *"
 
286
      write(luout,*) "     *                                          *"
 
287
      write(luout,*) "     *       developed by Eric J. Bylaska       *"
 
288
      write(luout,*) "     *                                          *"
 
289
      write(luout,*) "     ********************************************"
284
290
      call nwpw_message(1)
285
 
      write(*,*)
286
 
      write(*,*) "Pseudpotential Data"
287
 
      write(*,*) "-------------------"
288
 
      write(*,*) "  atom     :",atom
289
 
      write(*,*) "  charge   :",Zion
290
 
      write(*,*) "  highest angular component used :",lmax
291
 
      write(*,*) "  highest radial  component used :",nmax
292
 
      write(*,*) "  number of non-local projectors :",nprj
293
 
      write(*,111) "   projector cutoffs: ",(r(i), i=0,lmax)
294
 
      write(*,*)
295
 
      write(*,111) " local psp cutoff       : ",rloc
296
 
      write(*,111) " local psp coefficients : ",C1,C2,C3,C4
 
291
      write(luout,*)
 
292
      write(luout,*) "Pseudpotential Data"
 
293
      write(luout,*) "-------------------"
 
294
      write(luout,*) "  atom     :",atom
 
295
      write(luout,*) "  charge   :",Zion
 
296
      write(luout,*) "  highest angular component used :",lmax
 
297
      write(luout,*) "  highest radial  component used :",nmax
 
298
      write(luout,*) "  number of non-local projectors :",nprj
 
299
      write(luout,111) "   projector cutoffs: ",(r(i), i=0,lmax)
 
300
      write(luout,*)
 
301
      write(luout,111) " local psp cutoff       : ",rloc
 
302
      write(luout,111) " local psp coefficients : ",C1,C2,C3,C4
297
303
      if (version.eq.4) 
298
 
     >   write(*,*) "  aperiodic cutoff radius        :",rlocal
 
304
     >   write(luout,*) "  aperiodic cutoff radius        :",rlocal
299
305
      
300
 
      write(*,*)
301
 
      write(*,*) "Simulation Cell"
302
 
      write(*,*) "---------------"
303
 
      if (version.eq.3) write(*,112) "  boundry: periodic"
304
 
      if (version.eq.4) write(*,112) "  boundry: aperiodic"
305
 
      write(*,113) "  ngrid  :",ngrid
306
 
      write(*,114) "  unita  :",unita(1,1),unita(2,1),unita(3,1)
307
 
      write(*,114) "          ",unita(1,2),unita(2,2),unita(3,2)
308
 
      write(*,114) "          ",unita(1,3),unita(2,3),unita(3,3)
309
 
      write(*,*)
 
306
      write(luout,*)
 
307
      write(luout,*) "Simulation Cell"
 
308
      write(luout,*) "---------------"
 
309
      if (version.eq.3) write(luout,112) "  boundry: periodic"
 
310
      if (version.eq.4) write(luout,112) "  boundry: aperiodic"
 
311
      write(luout,113) "  ngrid  :",ngrid
 
312
      write(luout,114) "  unita  :",unita(1,1),unita(2,1),unita(3,1)
 
313
      write(luout,114) "          ",unita(1,2),unita(2,2),unita(3,2)
 
314
      write(luout,114) "          ",unita(1,3),unita(2,3),unita(3,3)
 
315
      write(luout,*)
310
316
  111 format(a,10f10.3)
311
317
  112 format(a)
312
318
  113 format(a,3I4)
324
330
     >                    full_filename)
325
331
      l = index(full_filename,' ') - 1
326
332
      if (mprint) then
327
 
      write(*,*)
328
 
      write(*,*) "Generated formatted_filename: ",full_filename(1:l)
329
 
      !write(*,*)
 
333
      write(luout,*)
 
334
      write(luout,*) "Generated formatted_filename: ",full_filename(1:l)
 
335
      !write(luout,*)
330
336
      end if
331
337
      call openfile(2,full_filename,l,'w',l)     
332
338
 
350
356
          call iwrite(2,int_mb(n_prj_indx),nprj)
351
357
          call iwrite(2,int_mb(l_prj_indx),nprj)
352
358
          call iwrite(2,int_mb(m_prj_indx),nprj)
 
359
          call iwrite(2,int_mb(b_prj_indx),nprj)
353
360
          call dwrite(2,Gijl,(nmax*nmax*(lmax+1)))
354
361
         end if
355
362
 
373
380
      value = value.and.MA_free_heap(n_prj_hndl)
374
381
      value = value.and.MA_free_heap(l_prj_hndl)
375
382
      value = value.and.MA_free_heap(m_prj_hndl)
 
383
      value = value.and.MA_free_heap(b_prj_hndl)
376
384
      if(.not.value)
377
385
     >  call errquit('hghppv1: deallocatin heap memory', 0, MA_ERR)
378
386