Going back to the old interface.

src/geninterface/NWChemWrap.F

@@ -1,5 +1,5 @@
-C $Id: NWChemWrap.F,v 1.4 2006-06-13 06:31:26 windus Exp $
-      subroutine NWChem_nwchemStart(scratch_dir, permanent_dir)
+C $Id: NWChemWrap.F,v 1.5 2006-06-13 16:50:03 windus Exp $
+      subroutine NWChem_nwchemStart(directory)
       implicit none
 #include "mafdecls.fh"
 #include "global.fh"
@@ -11,50 +11,20 @@ C $Id: NWChemWrap.F,v 1.4 2006-06-13 06:31:26 windus Exp $
 
 
       character*(nw_max_path_len) input_filename, rtdb_name
-      character*(nw_max_path_len) input_filename0
-      character*(*) scratch_dir, permanent_dir
+      character*(*) directory
       integer stack, heap, global
       logical overify, ohardfail, ostartup, ocontinue
       integer rtdb
       common /sidlinfo/ rtdb
-      character*(nw_max_path_len) temp_directory1, temp_directory2
-      integer init_counter, sgroupid
-      common /global_counter/ init_counter
-      logical ma_status
+      character*32 temp_directory1, temp_directory2
 
 C  Create parallel processes
-!      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()
+      call pbeginf()
     
 C  Worry about input file.  For now use a dummy one
-c      write(input_filename, '('''',a,''/junk.nw'')')
-c     $      permanent_dir(1:inp_strlen(permanent_dir))
-      if (ga_nodeid().eq.0) then
+      write(input_filename, '('''',a,''/junk.nw'')')
+     $      directory(1:inp_strlen(directory))
+      if (nodeid().eq.0) then
          open(LuIn, file=input_filename, status='unknown', 
      $        form='formatted',
      $        err=10000)
@@ -71,50 +41,43 @@ c
 C  Write scratch directory path into dummy input file
 
       write(temp_directory1, '(''scratch_dir '',a,'''')')
-     $      scratch_dir(1:inp_strlen(scratch_dir))
+     $      directory(1:inp_strlen(directory))
 
-      if (ga_nodeid().eq.0) then
-         write(6,*) 'writing to file:', input_filename
+      if (nodeid().eq.0) then
          write (LuIn,*) temp_directory1
       end if
 
       write(temp_directory2, '(''permanent_dir '',a,'''')')
-     $      permanent_dir(1:inp_strlen(permanent_dir))
+     $      directory(1:inp_strlen(directory))
 
-      if (ga_nodeid().eq.0) then
-         write(6,*) 'writing to file:', input_filename
+      if (nodeid().eq.0) then
          write (LuIn,*) temp_directory2
       end if
 
-C     Set up memory environment
-      write (6,*) 'Set up memory environment'
+C  Set up memory environment
       call input_mem_size(stack, heap, global, overify, ohardfail)
-c      if (.not.(init_counter.eq.1)) then
-!     call ga_initialize()
-!     write (6,*) 'Called ga_initialize inside NWChemWrap.F'
+      call ga_initialize()
       if ( ga_uses_ma() ) then
-         ma_status=ma_init(mt_dbl, stack, heap+global) 
+        if (.not.ma_init(mt_dbl, stack, heap+global))
+     $      call errquit
+     $      ('initialize_qm: ma_init failed (ga_uses_ma=T)',555)
       else
-         ma_status=ma_init(mt_dbl,stack,heap)
-         call ga_set_memory_limit(ma_sizeof(mt_dbl,global,mt_byte))
+        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))
       endif
-      
-C     Open rtdb
-      write(6,*) 'Opening rtdb'
-C     Need to get the input file name and the rtdb_name taken care of
-      
+
+C  Open 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)
-      write(6,*) 'Before rtdb_open'
+     $                     ostartup, ocontinue)
       if (.not. rtdb_open(rtdb_name, 'empty', rtdb))
-     $     call errquit('initialize_qm: rtdb_open empty failed ',555,0)
-      write(6,*) 'After rtdb_open'
+     $     call errquit('initialize_qm: rtdb_open empty failed ', 555,0)
       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
 
@@ -132,11 +95,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
@@ -180,21 +143,17 @@ C  Close the parallel environment
       logical nw_inp_from_character
 
       character*(*) basisSet
-      character*30 temp_basis
+      character*32 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
 
@@ -246,8 +205,8 @@ C  Close the parallel environment
 
       call NWChem_getNumCoordinates(ncent)
 
-C      if (.not.task_energy(rtdb))
-C     $     call errquit('NWChemMod:task_energy failed',555,0)
+      if (.not.task_energy(rtdb))
+     $     call errquit('NWChemMod:task_energy failed',555,0)
 
       if (.not.task_gradient(rtdb))
      $     call errquit('NWChemMod:task_gradient failed',555,0)
@@ -270,16 +229,14 @@ C     $     call errquit('NWChemMod:task_energy failed',555,0)
       logical nw_inp_from_file
       external nw_inp_from_file
 
-      character*(*) filename
-      character*(nw_max_path_len) input_filename
+      character*(nw_max_path_len) filename
+
       integer rtdb
       common /sidlinfo/ rtdb
 
-      write(6,*) 'In NWChem_setCoordinatesFromFile'
-      write(6,*) 'filename = ', filename
-      if (.not.nw_inp_from_file(rtdb, filename))
+      if (.not.nw_inp_from_file(rtdb,filename))
      $ call errquit('setCoordinatesFromFile: read inp from file failed'
-     $     ,555)
+     $ ,555)
 
       return
       end
@@ -291,7 +248,7 @@ C     $     call errquit('NWChemMod:task_energy failed',555,0)
       integer rtdb
       common /sidlinfo/ rtdb
 
-      character*(*) theoryName
+      character*(30) theoryName
 
       if (.not. rtdb_cput(rtdb, 'task:theory', 1, theoryName))
      $     call errquit('setTheory: failed setting theory',555,0)