Changes with the subgroups. This probably won't work with Venus at this point

and there are more changes needed for the updated interfaces.

src/geninterface/NWChemWrap.F

@@ -1,4 +1,5 @@
-      subroutine NWChem_nwchemStart(directory)
+C $Id: NWChemWrap.F,v 1.4 2006-06-13 06:31:26 windus Exp $
+      subroutine NWChem_nwchemStart(scratch_dir, permanent_dir)
       implicit none
 #include "mafdecls.fh"
 #include "global.fh"
@@ -10,20 +11,50 @@
 
 
       character*(nw_max_path_len) input_filename, rtdb_name
-      character*(*) directory
+      character*(nw_max_path_len) input_filename0
+      character*(*) scratch_dir, permanent_dir
       integer stack, heap, global
       logical overify, ohardfail, ostartup, ocontinue
       integer rtdb
       common /sidlinfo/ rtdb
-      character*32 temp_directory1, temp_directory2
+      character*(nw_max_path_len) temp_directory1, temp_directory2
+      integer init_counter, sgroupid
+      common /global_counter/ init_counter
+      logical ma_status
 
 C  Create parallel processes
-      call pbeginf()
+!      call pbeginf()
+
+      sgroupid=ga_pgroup_get_default()
+      write (6,*) 'sgroupid=',sgroupid
+      write (6,*) 'LuIn=',LuIn
+
+C  Create unique input file name
+      write(input_filename0, '('''',a,''/junk.'')')
+     $     permanent_dir(1:inp_strlen(permanent_dir))
+
+C temporary hack to resolve file name issues      
+      if(sgroupid.eq.-1) then
+         write(input_filename, '('''',a,i2,''.nw'')')
+     $        input_filename0(1:inp_strlen(input_filename0)),sgroupid
+      else if(sgroupid.gt.9) then
+         write(input_filename, '('''',a,i2,''.nw'')')
+     $        input_filename0(1:inp_strlen(input_filename0)),sgroupid
+      else if(sgroupid.gt.99) then
+         write(input_filename, '('''',a,i3,''.nw'')')
+     $        input_filename0(1:inp_strlen(input_filename0)),sgroupid
+      else
+         write(input_filename, '('''',a,i1,''.nw'')')
+     $        input_filename0(1:inp_strlen(input_filename0)),sgroupid
+      endif
+      
+      write(6,*) 'input file name =', input_filename
+      write(6,*) 'my node id is', ga_nodeid()
     
 C  Worry about input file.  For now use a dummy one
-      write(input_filename, '('''',a,''/junk.nw'')')
-     $      directory(1:inp_strlen(directory))
-      if (nodeid().eq.0) then
+c      write(input_filename, '('''',a,''/junk.nw'')')
+c     $      permanent_dir(1:inp_strlen(permanent_dir))
+      if (ga_nodeid().eq.0) then
          open(LuIn, file=input_filename, status='unknown', 
      $        form='formatted',
      $        err=10000)
@@ -40,43 +71,50 @@ c
 C  Write scratch directory path into dummy input file
 
       write(temp_directory1, '(''scratch_dir '',a,'''')')
-     $      directory(1:inp_strlen(directory))
+     $      scratch_dir(1:inp_strlen(scratch_dir))
 
-      if (nodeid().eq.0) then
+      if (ga_nodeid().eq.0) then
+         write(6,*) 'writing to file:', input_filename
          write (LuIn,*) temp_directory1
       end if
 
       write(temp_directory2, '(''permanent_dir '',a,'''')')
-     $      directory(1:inp_strlen(directory))
+     $      permanent_dir(1:inp_strlen(permanent_dir))
 
-      if (nodeid().eq.0) then
+      if (ga_nodeid().eq.0) then
+         write(6,*) 'writing to file:', input_filename
          write (LuIn,*) temp_directory2
       end if
 
-C  Set up memory environment
+C     Set up memory environment
+      write (6,*) 'Set up memory environment'
       call input_mem_size(stack, heap, global, overify, ohardfail)
-      call ga_initialize()
+c      if (.not.(init_counter.eq.1)) then
+!     call ga_initialize()
+!     write (6,*) 'Called ga_initialize inside NWChemWrap.F'
       if ( ga_uses_ma() ) then
-        if (.not.ma_init(mt_dbl, stack, heap+global))
-     $      call errquit
-     $      ('initialize_qm: ma_init failed (ga_uses_ma=T)',555)
+         ma_status=ma_init(mt_dbl, stack, heap+global) 
       else
-        if (.not.ma_init(mt_dbl,stack,heap))
-     $      call errquit
-     $      ('initialize_qm: ma_init failed (ga_uses_ma=F)',555)
-        call ga_set_memory_limit(ma_sizeof(mt_dbl,global,mt_byte))
+         ma_status=ma_init(mt_dbl,stack,heap)
+         call ga_set_memory_limit(ma_sizeof(mt_dbl,global,mt_byte))
       endif
-
-C  Open rtdb
-C  Need to get the input file name and the rtdb_name taken care of
+      
+C     Open rtdb
+      write(6,*) 'Opening rtdb'
+C     Need to get the input file name and the rtdb_name taken care of
+      
       call input_file_info(input_filename, rtdb_name,
-     $                     ostartup, ocontinue)
+     $     ostartup, ocontinue)
+      write(6,*) 'Before rtdb_open'
       if (.not. rtdb_open(rtdb_name, 'empty', rtdb))
-     $     call errquit('initialize_qm: rtdb_open empty failed ', 555,0)
+     $     call errquit('initialize_qm: rtdb_open empty failed ',555,0)
+      write(6,*) 'After rtdb_open'
       call util_set_rtdb_state(rtdb,.true.,.false.,.false.)
       call util_file_info_rtdb(rtdb)
+      write(6,*) 'Before geom_hnd_parallel'
       call geom_hnd_parallel(.true.)
-
+      
+      write(6,*) 'end NWChem_nwchemStart'
       return
       end
 
@@ -94,11 +132,11 @@ C  Close the rtdb
      $     call errquit('finalize_qm: rtdb_close failed', rtdb,0)
 
 C  Close the global memory
-      call ga_sync()
-      call ga_terminate()
+!      call ga_sync()
+!      call ga_terminate()
 
 C  Close the parallel environment
-      call pend()
+!      call pend()
 
       return
       end
@@ -142,17 +180,21 @@ C  Close the parallel environment
       logical nw_inp_from_character
 
       character*(*) basisSet
-      character*32 temp_basis
+      character*30 temp_basis
 
       integer rtdb
       common /sidlinfo/ rtdb
 
+      write(6,*) 'In NWChem_setBasisSet(): basisSet=',basisSet
       write(temp_basis, '(''basis; * library '',a,'' ; end'')')
      $      basisSet(1:inp_strlen(basisSet))
-
+      
+      write(6,*) 'In NWChem_setBasisSet(): temp_basis = ', temp_basis
+      write(6,*) 'In NWChem_setBasisSet(): rtdb = ', rtdb
       if (.not. nw_inp_from_character(rtdb, temp_basis))
      $ call errquit('setBasisSet: nw_inp_from_character failed',555,0)
 
+      write(6,*) 'End NWChem_setBasisSet()'
       return
       end
 
@@ -204,8 +246,8 @@ C  Close the parallel environment
 
       call NWChem_getNumCoordinates(ncent)
 
-      if (.not.task_energy(rtdb))
-     $     call errquit('NWChemMod:task_energy failed',555,0)
+C      if (.not.task_energy(rtdb))
+C     $     call errquit('NWChemMod:task_energy failed',555,0)
 
       if (.not.task_gradient(rtdb))
      $     call errquit('NWChemMod:task_gradient failed',555,0)
@@ -228,14 +270,16 @@ C  Close the parallel environment
       logical nw_inp_from_file
       external nw_inp_from_file
 
-      character*(nw_max_path_len) filename
-
+      character*(*) filename
+      character*(nw_max_path_len) input_filename
       integer rtdb
       common /sidlinfo/ rtdb
 
-      if (.not.nw_inp_from_file(rtdb,filename))
+      write(6,*) 'In NWChem_setCoordinatesFromFile'
+      write(6,*) 'filename = ', filename
+      if (.not.nw_inp_from_file(rtdb, filename))
      $ call errquit('setCoordinatesFromFile: read inp from file failed'
-     $ ,555)
+     $     ,555)
 
       return
       end
@@ -247,7 +291,7 @@ C  Close the parallel environment
       integer rtdb
       common /sidlinfo/ rtdb
 
-      character*(30) theoryName
+      character*(*) theoryName
 
       if (.not. rtdb_cput(rtdb, 'task:theory', 1, theoryName))
      $     call errquit('setTheory: failed setting theory',555,0)