From f152a19c4b3e7f8dfb1141817d4cea60dbd09029 Mon Sep 17 00:00:00 2001 From: Theresa Windus Date: Tue, 13 Jun 2006 06:31:26 +0000 Subject: [PATCH] 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 | 120 +++++++++++++++++++++++----------- 1 file changed, 82 insertions(+), 38 deletions(-) diff --git a/src/geninterface/NWChemWrap.F b/src/geninterface/NWChemWrap.F index 7a1c017e01..a50ee67986 100644 --- a/src/geninterface/NWChemWrap.F +++ b/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)