diff --git a/src/GNUmakefile b/src/GNUmakefile index 2b3515699b..48f06d1f68 100644 --- a/src/GNUmakefile +++ b/src/GNUmakefile @@ -17,6 +17,7 @@ ifeq ($(XLFMAC),y) endif NWBINNAME = nwchem +NWLIBNAME = libnwchem.so # # This should be the first target so that a simple make builds @@ -29,7 +30,16 @@ endif .PHONY: nwchem_config .PRECIOUS: $(BINDIR)/$(NWBINNAME) $(NWBINNAME) -all $(BINDIR)/$(NWBINNAME) $(NWBINNAME): directories libraries + +all: nwchem + +nwchem: $(BINDIR)/$(NWBINNAME) + echo "Built $@" + +libnwchem: $(LIBDIR)/$(NWLIBNAME) + echo "Built $@" + +$(BINDIR)/$(NWBINNAME): directories libraries @/bin/rm -f nwchem.o stubs.o $(MAKE) nwchem.o stubs.o ifeq ($(TARGET),SOLARIS) @@ -40,7 +50,7 @@ ifdef SUMO $(AR) rcv $(LIBDIR)/libnwchem-sumo.a $(LIBDIR)/objs/*.o $(RANLIB) $(LIBDIR)/libnwchem-sumo.a endif - /bin/rm -f nwchem.o stubs.o + @/bin/rm -f nwchem.o stubs.o $(INSTALL) # # This to link only and avoid tedious subdir makes @@ -50,6 +60,20 @@ PFLAGS = -messages=first -leaks-at-exit=yes -follow-child-processes=yes \ -windows=no -cache-dir=/tmp/purify/cache -best-effort #PURIFY = purify $(PFLAGS) +$(LIBDIR)/$(NWLIBNAME): directories libraries + @/bin/rm -f libnwchem.o stubs.o + $(MAKE) libnwchem.o stubs.o +ifeq ($(TARGET),SOLARIS) + /bin/rm -f $(LIBDIR)/$(NWLIBNAME) +endif + $(LINK.f) -shared -fPIC \ + -o $(LIBDIR)/$(NWLIBNAME) libnwchem.o stubs.o \ + -Wl,--allow-multiple-definition \ + -Wl,--whole-archive -lnwctask -lnwcutil -Wl,--no-whole-archive \ + -Wl,--start-group $(LIBS) -Wl,--end-group -Wl,--no-undefined + @/bin/rm -f libnwchem.o stubs.o + $(INSTALL) + link nwchem_link: @/bin/rm -f nwchem.o stubs.o $(MAKE) nwchem.o stubs.o @@ -61,7 +85,6 @@ ifdef SUMO $(AR) rcv $(LIBDIR)/libnwchem-sumo.a $(LIBDIR)/objs/*.o $(RANLIB) $(LIBDIR)/libnwchem-sumo.a endif -# /bin/rm -f nwchem.o stubs.o $(INSTALL) ccalink: @@ -99,7 +122,7 @@ endif # This dependency so that includes which are made by libraries rule # are updated before nwchem is compiled -libraries: +libraries: $(SUBDIRS) @for dir in $(SUBDIRS); do \ echo Making $@ in $$dir; \ $(MAKE) -C $$dir || exit 1 ; \ @@ -195,6 +218,7 @@ ifeq ($(NWCHEM_MODULES),) else $(MAKE) -C config -f make_nwchem_config NWCHEM_MODULES="$(NWCHEM_MODULES)" endif + touch $@ # # This is a convenience target that will make the TAGS file for current @@ -234,7 +258,7 @@ stripdepend: .PHONY: source source: - cat stubs.F nwchem.F > source + cat stubs.F nwchem.F libnwchem.F > source ifdef SUBDIRS for dir in $(SUBDIRS); do \ $(MAKE) -C $$dir $@ || exit 1 ; \ diff --git a/src/diana/dia_rdhdr.F b/src/diana/dia_rdhdr.F index ed4f07306f..bfb11eb0f9 100644 --- a/src/diana/dia_rdhdr.F +++ b/src/diana/dia_rdhdr.F @@ -7,6 +7,8 @@ subroutine dia_rdhdr(sgmnam) #include "dia_common.fh" #include "mafdecls.fh" c +c throws dia_rdhdr.F: undefined reference to `ftell_' on +c GNU Fortran (Ubuntu 4.9.1-16ubuntu6) 4.9.1 integer ftell external ftell c diff --git a/src/libnwchem.F b/src/libnwchem.F new file mode 100644 index 0000000000..6c06483b23 --- /dev/null +++ b/src/libnwchem.F @@ -0,0 +1,771 @@ + subroutine nwchem_init(mem) + implicit none +#include "errquit.fh" +#include "mafdecls.fh" +#include "global.fh" +#include "rtdb.fh" +#include "tcgmsg.fh" +#include "msgids.fh" +#include "util/cfileprefix.fh" + integer mem +c +#include "pstat.fh" + integer total +#include "util.fh" +#include "inp.fh" +#include "bgj_common.fh" +#include "stdio.fh" + integer rtdb + integer stack + integer heap + integer global + logical status + logical overify, ohardfail +#ifdef CRAY_T3D + integer oldact, fsigctl +#endif +c +c $Id$ +c +c ====================================================================================================== +C> \mainpage Northwest Computational Chemistry Package (NWChem) 6.8 +C> +C> NWChem is an open-source computational chemistry package distributed under the terms of +C> the Educational Community License (ECL) 2.0 +C> +C> This software and its documentation were developed at the EMSL at Pacific Northwest National Laboratory, +C> a multiprogram national laboratory, operated for the U.S. Department of Energy by Battelle under +C> Contract Number DE-AC05-76RL01830. Support for this work was provided by the Department of Energy +C> Office of Biological and Environmental Research, Office of Basic Energy Science, and the Office of +C> Advanced Scientific Computing. +C> +C> Licensed under the Educational Community License, Version 2.0 (the "License"); you may +C> not use this file except in compliance with the License. You may obtain a copy of the +C> License at http://www.osedu.org/licenses/ECL-2.0. +C> +C> Unless required by applicable law or agreed to in writing, software distributed under the +C> License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, +C> either express or implied. See the License for the specific language governing +C> permissions and limitations under the License. +C> +C> Further information, including user documentation and forums, may be found at +C> http://www.nwchem-sw.org/. Alternatively, +C> the paper +C> +C> * M. Valiev, E.J. Bylaska, N. Govind, K. Kowalski, T.P. Straatsma, H.J.J. Van Dam, +C> D. Wang, J. Nieplocha, E. Apra, T.L. Windus, W.A. de Jong (2010)
+C> "NWChem: A comprehensive and scalable open-source solution for large scale molecular simulations"
+C> Computer Physics Communications, 181, 1477–1489, DOI: 10.1016/j.cpc.2010.04.018 +C> +C> provides details on the codes capabilities. +C> +C> Copyright (c) 1994-2015 Pacific Northwest National Laboratory, Battelle Memorial Institute +C> +C> Environmental Molecular Sciences Laboratory (EMSL)
+C> Pacific Northwest National Laboratory
+C> Richland, WA 99352 +c +c ====================================================================================================== +c + character*120 mem_line + character*(nw_max_path_len) rtdb_name + double precision start_wall, start_cpu +#ifdef USE_OFFLOAD + integer ppnout + logical offload_master + Character*1 Total_Src, Heap_Src, Stack_Src, Global_Src + integer f, n + + external offload_master +#endif + + logical input_parse + external input_parse +#if defined(USE_OPENMP) + integer omp_get_max_threads + external omp_get_max_threads +#endif + file_prefix = 'yarr' + scratch_dir = './scratch' + permanent_dir = './perm' + rtdb_name = './perm/yarr.db' +c +c Create parallel processes and initialize IPC layer +c + call pbeginf() +c +c MXINIT is needed by PeIGS and PFFT to initialize +c the communication fabric they use. +c + call mxinit +c +c Initialize timers so they are relative to job start +c + start_wall = util_wallsec() + start_cpu = util_cpusec() +c +c Create and parse memory directive +c +C The user input model has well-defined categories of memory, +C each of which has a specific size. How we use these limits +C depends on the platform we are running on. +C +c call input_mem_size(stack, heap, global, overify, ohardfail) +c -> replaced by calls to memory_input and broadcast. +c Has to be TCGMSG broadcast since GA is not yet initialized +c + overify = .false. + ohardfail = .false. + if (nodeid() .eq. 0) then +c If there were a reliable way to pass strings to fortran. +c call push_inp_string(mem(1:inp_strlen(mem))) + write (mem_line, "(A13,I0)") "memory total ", mem + call push_inp_string(mem_line) + call memory_input(-1, .false., stack, heap, + $ global, total, overify, ohardfail) +c Total_Src = 'N' +c Heap_Src = 'N' +c Stack_Src = 'N' +c Global_Src = 'N' +c call Memory_defaults( total, Total_Src, heap, Heap_Src, +c $ stack, Stack_Src, global, Global_Src) + endif + call brdcst(Msg_HeapMem, heap, mitob(1), 0) + call brdcst(Msg_StkMem, stack, mitob(1), 0) + call brdcst(Msg_GblMem, global, mitob(1), 0) + call brdcst(Msg_StkMem,overify, mitob(1), 0) +c +c Initialize local memory allocator & global array tools +C + call ga_initialize_ltd(ma_sizeof(mt_dbl,global,mt_byte)) + if ( ga_uses_ma() ) then + if (.not.ma_init(mt_dbl, stack, heap+global)) + & call errquit('nwchemlib.F: ma_init failed (ga_uses_ma=T)', + & 911,MA_ERR) + else + if (.not.ma_init(mt_dbl,stack,heap)) + & call errquit('nwchemlib.F: ma_init failed (ga_uses_ma=F)', + & 911,MA_ERR) + endif +! +! Touch OpenMP here so that any runtime initialization happens up-front. +! This ensures that any printout that the OpenMP runtime generates, +! such as affinity information, appears at the top of the output file. +! Otherwise, it might not appear until e.g. the CCSD module, at which +! point it will pollute the output file in an undesirable way. +! +! Do not move this in front of GA/MPI/TCGMSG initialization, since the +! OpenMP runtime may inherit affinity information from MPI that is only +! determined during MPI initialization. +! +! Format definition is outside of preprocessor protection to ensure the +! label is not accidentally reused, since that will not be caught by +! testing that does not enable OpenMP. +! + 99 format(2x,'NWChem w/ OpenMP: maximum threads = ',i2) +#if defined(USE_OPENMP) + !$omp parallel + !$omp master + if (ga_nodeid().eq.0) write(luout,99) omp_get_max_threads() + !$omp end master + !$omp end parallel +#endif +! + call rtdb_init() +c +* +* More for amusement then efficiency force all MA allocated entities +* to be aligned at the beginning of a 128 byte cache line +* +! if (.not. ma_set_numalign(7)) +! $ call errquit('nwchemlib.F: ma_set_numalign failed',911, MA_ERR) +c aligned to 64byte record + if (.not. ma_set_numalign(6)) + $ call errquit('nwchem.F: ma_set_numalign failed',911, MA_ERR) +* +* +***** call nxtval_ga_initialize() +c +c Trap SIGFPE after GA to override handler +c +***** call ieeetrap() +#if defined(DECOSF) || defined(LINUXALPHA) + call dec_fpe ! To avoid underflow problems on Alpha in Texas +#endif +#ifdef CRAY_T3D +* This as a temporary fix for SIGFPE in Texas that does not seem +* to affect the final results + oldact = fsigctl('IGNORE','SIGFPE',0) +#endif +#ifdef LINUX +c uncommenting this line turns on sigfpe trapping under linux +! call linux_trapfpe() +#endif +#if defined(MACX) +c uncommenting this line turns on sigfpe trapping under Mac OSX +! call macx_trapfpe() +#endif +c +c Hard fail is good for development but means that we cannot +c respond to allocation problems. Disable by default. +c + status = ma_set_auto_verify(overify) + status = ma_set_hard_fail(ohardfail) + status = ma_set_error_print(ohardfail) +c +c Initialize pstat +c + if (.not. pstat_init(20, 1, ' ')) call errquit + $ ('nwchem: pstat_init failed', 0, UNKNOWN_ERR) +c + +c +c Now are ready to summarize the environment +c + call nwchem_banner("push_inp_cstring", rtdb_name, .true., .false.) +c +c Actually open the database and store the file prefix +c +c Note that only process 0 has the database name ... that is OK. +c + if (.not. rtdb_open(rtdb_name, 'unknown', rtdb)) + $ call errquit('start: rtdb_open empty failed ', 0, + & RTDB_ERR) +C +C initialize nxtask +C + call nxtask_init(rtdb) +c!!! BGJ + bgj_rtdb = rtdb +c!!! BGJ +c + call util_set_rtdb_state(rtdb,.true.,.false.,.false.) +c + call util_file_info_rtdb(rtdb) ! Save file info for restart +c + call movecs_ecce_print_on() +c + call geom_hnd_parallel(.true.) +c + call perfm_start() + +#ifdef USE_OFFLOAD + call util_getppn(ppnout) + if(ppnout.eq.0) call errquit('util_getppn failed ',0,UERR) + if(ga_nodeid().eq.0)write(luout,*) ga_nodeid(),' ppn ',ppnout + if(offload_master()) then + if(ga_nodeid().lt.ppnout) + w write(luout,*) ga_nodeid(),' offload_master ' + call util_mic_set_affinity() + endif + call ga_sync() +#endif + + end + +c +c Choose the form of the destructor! +c + subroutine nwchem_dtor(rtdb, start_wall, start_cpu) + implicit none +#include "errquit.fh" +#include "mafdecls.fh" +#include "global.fh" +#include "rtdb.fh" +#include "tcgmsg.fh" +#include "pstat.fh" +#include "util.fh" +#include "inp.fh" +#include "bgj_common.fh" +#include "stdio.fh" + integer rtdb + double precision start_wall, start_cpu + double precision total_wall, total_cpu +#ifdef PSCALE + integer io_code +#else + integer*4 io_code +#endif +c +c Close the RTDB +c + call util_print_rtdb_load(rtdb,' ') ! High level print + if (util_print('rtdbvalues', print_debug)) then + if (.not. rtdb_print(rtdb, .true.)) + $ call errquit('control: rtdb_print failed', 0, RTDB_ERR) + else if (util_print('rtdb', print_high)) then + if (.not. rtdb_print(rtdb, .false.)) + $ call errquit('control: rtdb_print failed', 0, RTDB_ERR) + endif +c + if (.not. rtdb_close(rtdb, 'keep')) + $ call errquit('nwchem: rtdb_close failed', rtdb, RTDB_ERR) +c + if (util_print('rtdb', print_high) .or. + $ util_print('rtdbvalues', print_high)) then + call rtdb_print_usage ! Called after closing so memory leaks apparent + endif +c Close any temp. input. + call pop_inp_string() +c +c Tidy up pstat +c + if (.not. pstat_terminate()) call errquit + $ ('nwchem: pstat_terminate failed', 0, UNKNOWN_ERR) +c +**** call nxtval_ga_terminate() +c +c Print memory and other info +c + call ga_sync() + if (ga_nodeid() .eq. 0) then + if (util_print('ga summary', print_default)) + $ call ga_summarize(0) + if (util_print('ga stats', print_default)) then + call ga_print_stats() + write(LuOut,*) + endif + if (util_print('ma summary', print_default)) + $ call ma_summarize_allocated_blocks() + if (util_print('ma stats', print_high)) then + call ma_print_stats(.true.) + else if (util_print('ma stats', print_default)) then + call ma_print_stats(.false.) + endif + if (util_print('version', print_debug)) + $ call util_version + if (util_print('citation', print_none)) + & call util_cite() + endif + call perfm_end() + total_wall = util_wallsec() - start_wall + total_cpu = util_cpusec() - start_cpu + if (ga_nodeid() .eq. 0) then + if (util_print('total time', print_none)) then + write(LuOut,1,iostat=io_code) total_cpu, total_wall + 1 format(/' Total times cpu:',f11.1,'s wall:',f11.1,'s') + if(io_code.ne.0.and. + A util_print('total time', print_high)) then + write(luout,*) ' iostat ',io_code + endif + call util_flush(LuOut) + endif + endif + call ecce_print1('all tasks cpu time',mt_dbl,total_cpu,1) + call ecce_print1('all tasks wall time',mt_dbl,total_wall,1) + call ga_sync() +c +c Tidy up the global memory +c + call ga_terminate() +c +c Tidy up the parallel environment +c + call pend() +c +c Close the ECCE' output file if there is one +c + call ecce_print_file_close() + end +c +c Done +c + + subroutine nwchem_banner(input_filename, rtdb_name, + @ ostartup, ocontinue) + implicit none +#include "global.fh" +#include "inp.fh" +#include "mafdecls.fh" +#include "util.fh" +#include "stdio.fh" +c +c Print a banner at the top of the output to identify the origin +c of the code along with hostname, no. of processors, date, ... +c + character*(*) input_filename, rtdb_name + logical ostartup + logical ocontinue +c + double precision dbletomb + character*80 hostname, compiled, batchid + character*(nw_max_path_len) executable, srcdir, file_prefix + character*(nw_max_path_len) branch, nwchem_rev, ga_rev + character*26 date +#if defined(CRAY) + integer ilen,ierror +#endif + integer heap, stack, global, global_b, total, nproc + logical status +#ifdef CATAMOUNT + integer istatus,setvbuf3f + external setvbuf3f +#endif + logical util_scalapack_info + external util_scalapack_info + character*3 cstatus, fstatus + character*10 cstart + Character*40 GStatus +c +#ifdef CATAMOUNT + istatus=setvbuf3f(luout, 0, 4096) + istatus=setvbuf3f(0, 0, 4096) +#endif + if (ga_nodeid() .ne.0) goto 10101 +c + call util_print_centered(LuOut, + $ ' ', + $ 40, .true.) + write(LuOut,*) + write(LuOut,*) + call util_print_centered(LuOut, + $ 'Northwest Computational Chemistry Package (NWChem) 6.8', + $ 40, .true.) + write(LuOut,*) + write(LuOut,*) + call util_print_centered(LuOut, + $ 'Environmental Molecular Sciences Laboratory', + $ 40, .false.) + call util_print_centered(LuOut, + $ 'Pacific Northwest National Laboratory', + $ 40, .false.) + call util_print_centered(LuOut,'Richland, WA 99352', + $ 40, .false.) + write(LuOut,*) + call util_print_centered(LuOut,'Copyright (c) 1994-2015', + $ 40, .false.) + call util_print_centered(LuOut, + $ 'Pacific Northwest National Laboratory', + $ 40, .false.) + call util_print_centered(LuOut,'Battelle Memorial Institute', + $ 40, .false.) + write(LuOut,*) + call util_print_centered(LuOut, + $'NWChem is an open-source computational chemistry package' + $ , 40, .false.) + call util_print_centered(LuOut, + $'distributed under the terms of the' + $ , 40, .false.) + call util_print_centered(LuOut, + $'Educational Community License (ECL) 2.0' + $ , 40, .false.) + call util_print_centered(LuOut, + $'A copy of the license is included with this distribution' + $ , 40, .false.) + call util_print_centered(LuOut, + $'in the LICENSE.TXT file' + $ , 40, .false.) + write(LuOut,*) + call util_legal() +c + call util_getarg(0,executable) + call util_hostname(hostname) + call util_date(date) + nproc = ga_nnodes() + if (ostartup) then + cstart = 'startup' + else + if (ocontinue) then + cstart = 'continue' + else + cstart = 'restart' + endif + endif + call util_file_prefix(' ',file_prefix) +c + compiled = + & COMPILATION_DATE + call util_nwchem_srcdir(srcdir) + srcdir = srcdir(1:max(1,inp_strlen(srcdir)-4)) + branch = + & NWCHEM_BRANCH + call util_nwchem_version(nwchem_rev) + call util_ga_version(ga_rev) +C +C See if we can get the batch system id. We understand NQS and +C LoadLeveler at present +C + BatchID = ' ' + Call Util_GetEnv('QSUB_REQID', batchid) + If ( Inp_StrLen(batchid) .eq. 0 ) then + Call Util_GetEnv('LOADL_JOB_NAME', batchid) + If ( inp_strlen(batchid) .eq. 0 ) then + call util_getenv('LSB_JOBID', batchid) + endif + EndIf +C + call util_print_centered(LuOut, 'Job information', 17, .true.) + write(LuOut,2) + $ hostname(1:inp_strlen(hostname)), + $ executable(1:inp_strlen(executable)), + $ date(1:inp_strlen(date)), + $ compiled(1:inp_strlen(compiled)), + $ srcdir(1:inp_strlen(srcdir)), + & branch(1:inp_strlen(branch)), + & nwchem_rev(1:inp_strlen(nwchem_rev)), + & ga_rev(1:inp_strlen(ga_rev)), + S util_scalapack_info(), + $ input_filename(1:inp_strlen(input_filename)), + $ file_prefix(1:inp_strlen(file_prefix)), + $ rtdb_name(1:inp_strlen(rtdb_name)), + $ cstart(1:inp_strlen(cstart)), + $ nproc, + $ util_batch_job_time_remaining() +C +C Print version information to ecce.out file +C + compiled(inp_strlen(compiled)+1:inp_strlen(compiled)+25) = + $ ' Version 6.8' + call ecce_print_version(compiled(1:inp_strlen(compiled))) +C + If ( Inp_StrLen(BatchID) .gt. 0) then + Write(LuOut,22) BatchID(:Inp_StrLen(BatchID)) + Else + Write(LuOut,'(//)') + EndIf +C + 2 format(/ + $ ' hostname = ', a/ + $ ' program = ', a/ + $ ' date = ', a/ + $ ' compiled = ', a/ + $ ' source = ', a/ + $ ' nwchem branch = ', a/ + $ ' nwchem revision = ', a/ + $ ' ga revision = ', a/ + $ ' use scalapack = ', l1/ + $ ' input = ', a/ + $ ' prefix = ', a/ + $ ' data base = ', a/ + $ ' status = ', a/ + $ ' nproc = ', i8/, + $ ' time left = ', i6,'s') + 22 format( + $ ' batch job id = ', a/) +c +c Determine, without altering, setting of memory verification +c and hardfail. +c + status = ma_set_auto_verify(.true.) + if (status) then + cstatus = 'yes' + else + cstatus = 'no ' + endif + status = ma_set_auto_verify(status) +c + status = ma_set_hard_fail(.true.) + if (status) then + fstatus = 'yes' + else + fstatus = 'no ' + endif + status = ma_set_hard_fail(status) +C +C Memory size information. Note: Subtleties of MA & friends +C will likely result in actual heap and stack sizes _slightly_ +C larger than requested at initialization, and other slight +C "inconsistencies". It has to do with the overhead associated +C with an allocation. +C + heap = ma_inquire_heap(MT_Dbl) + stack = ma_inquire_stack(MT_Dbl) +C +C If GA cannot determine a limit on the available memory, it +C will return a negative number, which MA_SizeOf does not +C appreciate. This should not happen in NWChem, but we might +C as well play it safe. +C + global_b = ga_memory_avail() + If ( Global_B .ge. 0) then + global = MA_SizeOf(MT_Byte, global_b, MT_Dbl) + Else + global = 0 + EndIf + +C + Total = Heap + Stack + If ( .NOT. GA_Uses_MA() ) Total = Total + Global +C + If ( GA_Uses_MA() ) then + GStatus = '(within heap+stack)' + Else + GStatus = '(distinct from heap & stack)' + EndIf +c + call util_print_centered(LuOut, 'Memory information', 19, .true.) +c +*old: write(LuOut,3) heap, stack, global, GStatus, total, cstatus, +*old: $ fstatus +*old: 3 format(/ +*old: $ ' heap = ', i10,' doubles'/ +*old: $ ' stack = ', i10,' doubles'/ +*old: $ ' global = ', i10,' doubles ', A/ +*old: $ ' total = ', i10,' doubles'/ +*old: $ ' verify = ', a3/ +*old: $ ' hardfail = ', a3//) + dbletomb = 8.0d00/(1024.0d00*1024.0d00) + write(LuOut,3) + & heap,((dble(heap)*dbletomb)), + & stack,((dble(stack)*dbletomb)), + & global,((dble(global)*dbletomb)), + & GStatus(1:inp_strlen(gstatus)), + & total,((dble(total)*dbletomb)), + & cstatus, + & fstatus + 3 format(/ + $ ' heap = ', i10,' doubles',' = ',f8.1,' Mbytes',/, + $ ' stack = ', i10,' doubles',' = ',f8.1,' Mbytes',/, + $ ' global = ', i10,' doubles',' = ',f8.1,' Mbytes', + & ' ',A,/, + $ ' total = ', i10,' doubles',' = ',f8.1,' Mbytes',/, + $ ' verify = ', a3,/, + $ ' hardfail = ', a3,//) +c + call util_print_centered(LuOut, + & 'Directory information', 20, .true.) + write(LuOut,*) +c +c Below here back to parallel execution +c +10101 call util_file_print_dirs() + if(ga_nodeid().eq.0) write(LuOut,*) +c + end +c + subroutine nw_print_restart_info(rtdb) + implicit none +#include "global.fh" +#include "errquit.fh" +#include "inp.fh" +#include "mafdecls.fh" +#include "rtdb.fh" +#include "stdio.fh" +#include "util.fh" + integer rtdb +c +c Summarize the status of a restart calculation +c + logical mode, task_qmmm, ignore, lstatus + character*30 operation, status + character*32 theory +c + if (ga_nodeid() .eq. 0) then + mode = rtdb_parallel(.false.) + if (.not.rtdb_get(rtdb,'task:QMMM',mt_log,1,task_qmmm)) + & task_qmmm = .false. +c + if (.not. rtdb_cget(rtdb, 'task:operation', 1, operation)) + $ operation = ' ' +c + if(.not.rtdb_cget(rtdb,'task:theory',1,theory)) + $ theory = ' ' +c + if (.not. rtdb_get(rtdb, 'task:ignore', mt_log, 1, ignore)) + $ ignore = .false. +c + if (rtdb_get(rtdb, 'task:status', mt_log, 1, lstatus)) then + if (lstatus) then + status = 'ok' + else + status = 'fail' + endif + else + status = 'unknown' + endif +c + if (theory.ne.' ' .or. operation.ne.' ' .or. task_qmmm) then + call util_print_centered(LuOut,'Previous task information', + $ 22, .true.) + write(LuOut,1) theory, operation, status, task_qmmm, ignore + 1 format(/, + $ ' Theory = ', a,/, + $ ' Operation = ', a,/, + $ ' Status = ', a,/, + $ ' Qmmm = ', l1,/, + $ ' Ignore = ', l1,/) + endif + call geom_print_known_geoms(rtdb) + call bas_print_known_bases(rtdb) + call util_flush(LuOut) + mode = rtdb_parallel(mode) + endif +c + call ga_sync() +c + end + subroutine call_all() + implicit none + external input_parse + external task,task_input,tce_input,util_print_rtdb_load + external geom_input,bsse_input,bas_input + external cosmo_input,intgrl_input,scf_input,mp2_input + external drdy_input,stepper_input,mepgs_input,tropt_input + external driver_input,dft_input,occup_input,pre_input,md_input + external argos_input,esp_input,et_input,ana_input + external dia_input,gradients_input,ccsd_input,oniom_input + external mcscf_input,bq_input,cons_input,dplot_input + external prop_input,speech_input,nwpw_input,smd_input,rism_input + external qmmm_input,ccca_input,rel_input,nbo_input,vscf_input + external raman_input,dntmc_input,freq_vib_input,hess_input + external tddft_input,mymd_input,mymc_input,string_input,input_time + external input_set,input_unset,input_title,input_qcharge + external input_charge + call input_parse() + call task_input() + call task() + call util_print_rtdb_load() + call tce_input() + call geom_input() + call bsse_input() + call bas_input() + call cosmo_input() + call intgrl_input() + call scf_input() + call mp2_input() + call drdy_input() + call stepper_input() + call mepgs_input() + call tropt_input() + call driver_input() + call dft_input() + call occup_input() + call pre_input() + call md_input() + call argos_input() + call esp_input() + call et_input() + call ana_input() + call dia_input() + call gradients_input() + call ccsd_input() + call oniom_input() + call mcscf_input() + call bq_input() + call cons_input() + call dplot_input() + call prop_input() + call speech_input() + call nwpw_input() + call smd_input() + call rism_input() + call qmmm_input() + call ccca_input() + call rel_input() + call nbo_input() + call vscf_input() + call raman_input() + call dntmc_input() + call freq_vib_input() + call hess_input() + call tddft_input() + call mymd_input() + call mymc_input() + call string_input() + call input_time() + call input_set() + call input_unset() + call input_title() + call input_qcharge() + call input_charge() + end diff --git a/src/python/dbtest.py b/src/python/dbtest.py new file mode 100644 index 0000000000..3f7a3403e2 --- /dev/null +++ b/src/python/dbtest.py @@ -0,0 +1,5 @@ +from nwchem import * + +# nwchem_init has to be called to set up tcgmsg +db = nwchem_init(400) +db.ls() diff --git a/src/python/nwchem.py b/src/python/nwchem.py new file mode 100644 index 0000000000..b5a628673d --- /dev/null +++ b/src/python/nwchem.py @@ -0,0 +1,112 @@ +# Since each sub-task assumes it can read parameters from stdin, +# we have to call them like so: +# +# Load up the nwchem library. +# db = nwchem_init(1500) +# +# Set parameters and do a DFT run. +# dft(db, "xc b3lyp") +# nwtask(db, "energy") + +import atexit +from nwproto import * +from rtdb import * + +# NWChem Initialization. +# Send it the total requested memory (in MB) +# and receive an rtdb class object. +def nwchem_init(mem=400 * 1<<20): + mem *= 1<<(20-3) # convert to # of 8-byte doubles + def to_strbuf_p(x): # Can't seem to pass strings, use generic names. + s = strbuf() + s[:] = x.ljust(len(s)) + return byref(s) + zmem = c_int(mem) + db = nwlib.nwchem_init_(byref(zmem)) # calls pbegin, etc. + z = byref(c_int(0)) + atexit.register(nwlib.nwchem_dtor_, byref(c_int(db)), z, z) # "swept and put in order." + return rtdb(db) + +# cast the function to run only on the head node. +def single_op(f): + def run_single(*args): + if nwlib.ga_nodeid_() == 0: + nwlib.rtdb_parallel(0) + f(*args) + nwlib.rtdb_parallel(1) + return run_single + +# Abstract wrapper for an interface function. +def nw_interface(fname): + try: + nwf = getattr(nwlib, fname+"_") # fortran name mangling + except AttributeError: + print "Symbol not found: %s_"%fname + return lambda x,y: None + int_fn(nwf, c_int_p) # declare the function to ctypes. + def fn(db, inp): + nwlib.push_inp_cstring(inp) + nwf(byref(db._n)) + return single_op(fn) + +# Wrap all top-level functions. +toplev = ["geom", "bsse", "bas", +# "python", + "cosmo", "intgrl", "scf", + "mp2", "drdy", "stepper", + "mepgs", "tropt", "driver", +# "string", + "dft", "occup", + "pre", "md", "argos", + "esp", "et", "ana", "dia", + "gradients", "ccsd", "oniom", + "mcscf", "bq", + "cons", "dplot", "prop", + "speech", "nwpw", "smd", + "rism", "qmmm", "ccca", + "rel", "nbo", "vscf", + "raman", "dntmc", "freq_vib", + "hess", "tddft", "mymd", "mymc" ] + +for fname in toplev: + globals()[fname] = nw_interface(fname+"_input") + +# Some need re-naming... +# First is the name we shall call it by. +top_cust = [ ("string_input", "string_input"), + ("time_input", "input_time"), + ("set_input", "input_set"), + ("unset_input", "input_unset"), + ("title_input", "input_title"), + ("qcharge", "input_qcharge"), + ("charge", "input_charge") ] +for fname, alt_name in top_cust: + globals()[fname] = nw_interface(alt_name) + +# The awkward squad: +# else if (inp_compare(.false.,test,'print')) then +# call util_print_input(db,' ') +# call util_print_rtdb_load(db,' ') ! High level print +# else if (inp_compare(.false.,test,'noprint')) then +# call util_print_input(db,' ') + +# tce -> tce(db, inp, 'tce') +# uccsd -> tce(db, inp, 'uccsd') +# etc. +def do_tce(db, inp, *tp): + if 'tce' in tp: # sic + db['tce:model'] = 'ccsd' + for t in tp: + db['tce:module'] = tp + nwlib.push_inp_cstring(inp) + nwlib.tce_input_(byref(db._n)) +tce = single_op(do_tce) # wrap with single_op incantations + +def nwtask(db, task): + def read_task(): + nwlib.push_inp_cstring("task " + task) + nwlib.task_input_(byref(db._n)) + nwlib.util_print_rtdb_load_(byref(db._n), "", 0) + single_op(read_task)() + nwlib.task_(byref(db._n)) + diff --git a/src/python/nwproto.py b/src/python/nwproto.py new file mode 100644 index 0000000000..b86220db22 --- /dev/null +++ b/src/python/nwproto.py @@ -0,0 +1,40 @@ +# This file declares the top-level functions that can be called inside nwchem. +# +# More are available inside nwlib, but these represent all those accessible +# from the usual config file. +# +import os +from ctypes import * + +# Shorthand for setting function prototypes +def decl_fn(a, *args): + a.argtypes = args[:-1] + a.restype = args[-1] + +def void_fn(a, *args): + decl_fn(a, *(args+(None,))) + +def int_fn(a, *args): + decl_fn(a, *(args+(c_int,))) + +def dbl_fn(a, *args): + decl_fn(a, *(args+(c_double,))) + +strbuf = c_char*120 +strbuf_p = POINTER(strbuf) +c_int_p = POINTER(c_int) +cwd = os.path.dirname(os.path.abspath(__file__)) + +# The library. +nwlib = cdll.LoadLibrary(os.path.join(cwd, "../../lib/LINUX64/libnwchem.so")) + +# Function type declaration +int_fn(nwlib.push_inp_cstring, c_char_p) +int_fn(nwlib.input_parse_, c_int_p) # just in case. +int_fn(nwlib.nwchem_init_, c_int_p) # unfortunately, strings are over my head +void_fn(nwlib.nwchem_dtor_, c_int_p, c_int_p, c_int_p) +void_fn(nwlib.task_input_, c_int_p) +void_fn(nwlib.task_, c_int_p) +int_fn(nwlib.tce_input_, c_int) # handled specially by tce() +void_fn(nwlib.util_print_rtdb_load_, c_int_p, c_char_p, c_int) + diff --git a/src/python/rtdb.py b/src/python/rtdb.py new file mode 100644 index 0000000000..b3a7aecebf --- /dev/null +++ b/src/python/rtdb.py @@ -0,0 +1,198 @@ +from nwproto import * +import numpy as np +#import numpy.ctypeslib as nc +from ctypes import * + +#int rtdb_parallel(const int mode) +int_fn(nwlib.rtdb_parallel, c_int) +int_fn(nwlib.rtdb_parallel, c_int) +int_fn(nwlib.rtdb_open, c_char_p, c_char_p, c_int_p) +int_fn(nwlib.rtdb_clone, c_int, c_char_p) +int_fn(nwlib.rtdb_getfname, c_int, c_char_p) +int_fn(nwlib.rtdb_close, c_int, c_char_p) +int_fn(nwlib.rtdb_put, c_int, c_char_p, c_int, c_int, c_void_p) +int_fn(nwlib.rtdb_get, c_int, c_char_p, c_int, c_int, c_void_p) +int_fn(nwlib.rtdb_get_info, c_int, c_char_p, c_int_p, c_int_p, c_char*26) +int_fn(nwlib.rtdb_first, c_int, c_int, c_char_p) +int_fn(nwlib.rtdb_next, c_int, c_int, c_char_p) +int_fn(nwlib.rtdb_print, c_int, c_int) +int_fn(nwlib.rtdb_delete, c_int, c_char_p) + +# from tools/ma/macommon.h +#ma_tp = {1000:c_char, +# 1001:c_int, +# 1002:c_longlong, +# 1003:c_float, +# 1004:c_double, +# 1005:c_longdouble, +# 1006:c_float*2, # complex +# 1007:c_double*2, # complex +# 1008:c_longdouble*2 } # complex +ma_tp = {1000:np.char, + 1001:np.int32, + 1002:np.int64, + 1003:np.float32, + 1004:np.float64, + 1005:np.float128, + 1006:np.complex64, + 1007:np.complex128, + 1008:np.complex256, + 1009:np.char, + 1010:np.int, + 1011:np.bool, + 1012:np.float32, + 1013:np.float64, + 1014:np.complex64, + 1015:np.complex128, + 1016:np.int64 } +#define MT_F_BYTE (MT_BASE + 9) +#define MT_F_INT (MT_BASE + 10) +#define MT_F_LOG (MT_BASE + 11) +#define MT_F_REAL (MT_BASE + 12) +#define MT_F_DBL (MT_BASE + 13) +#define MT_F_SCPL (MT_BASE + 14) +#define MT_F_DCPL (MT_BASE + 15) +#define MT_C_LONGLONG (MT_BASE + 16) + +def lookup_ma_dtype(t): + #if t == np.char: + # return 1000 + if t == np.int32: + return 1001 + elif t == np.int64: + return 1002 + elif t == np.float32: + return 1003 + elif t == np.float64: + return 1004 + elif t == np.float128: + return 1005 + elif t == np.complex64: + return 1006 + elif t == np.complex128: + return 1007 + elif t == np.complex256: + return 1008 + elif t == np.bool: + return 1011 + raise KeyError + +class rtdb: +# mode = 'new' Open only if it does not exist already +# 'old', Open only if it does exist already +# 'unknown' Create new or open existing (preserving contents) +# 'empty' Create new or open existing (deleting contents) +# 'scratch' Create new or open existing (deleting contents) +# and automatically delete upon closing. Also, items +# cached in memory are not written to disk. + def __init__(self, name, mode="unknown"): + self._n = None + self._fname = "" + self._opened = False + if type(name) == type(0): + self._n = c_int(name) + elif type(name) == type("string"): + p = c_int() + if nwlib.rtdb_open(name, mode, byref(p)) == 0: + raise RuntimeError, "Error opening RTDB." + self._n = p + self._opened = True + else: + raise RuntimeError, "usage: rtdb(name or id, mode)" + self._fname = name + def __del__(self): + if self._opened: + nwlib.rtdb_close(self._n, "keep") + # return the filename of the rtdb + def getfname(self): + # unsafe method + #fname = (c_char*1024)() + #nwlib.rtdb_getfname(self._n, fname) + #return fname.value + return self._fname + + # Copy the database to a new file, to be named + # .suffix + def clone(self, suf): + if nwlib.rtdb_clone(self._n, suf) == 0: + raise RuntimeError, "Error cloning RTDB." + # store the string or array x in the rtdb at the given key + def put(self, key, x): + # If the key exists, coerce the type to the key's type. + try: + tp, _, _ = self.stat(key) + except KeyError: + tp = None + + if type(x) == type("string"): + if tp != None or tp != 1000: + raise ValueError, "Can't overwrite a non-string with a string." + tp = 1000 + n = len(x) + x = cast(create_string_buffer(x), c_void_p) + else: + if tp != None: + x = x.astype(ma_tp[tp]) + else: + tp = lookup_ma_dtype(x.dtype) + n = np.prod(x.shape) + x = x.ctypes.data_as(c_void_p) + if nwlib.rtdb_put(self._n, key, tp, n, x) == 0: + raise KeyError + # returns ma_type, number, and the array + def get(self, key): + tp, n, date = self.stat(key) + if tp == 1000: + x = (c_char*(n+1))() + if nwlib.rtdb_get(self._n, key, tp, n, cast(x, c_void_p)) == 0: + raise KeyError + x = x.value + else: + #x = (ma_tp[tp]*n)() + x = np.zeros(n, dtype=ma_tp[tp]) + if nwlib.rtdb_get(self._n, key, tp, n, x.ctypes.data_as(c_void_p)) == 0: + raise KeyError + return x + # stat of the object - returns ma_type, number, and date + def stat(self, key): + tp = c_int() + n = c_int() + date = (c_char*26)() + if nwlib.rtdb_get_info(self._n, key, byref(tp), byref(n), date) == 0: + raise KeyError + return tp.value, n.value, date.value + # val = True => print values and keys. + def ls(self, val=False): + nwlib.rtdb_print(self._n, int(val)) + # make the rtdb act like a dictionary. + def __getitem__(self, key): + return self.get(key) + def __setitem__(self, key, val): + return self.put(key, val) + def __delitem__(self, key): + nwlib.rtdb_delete(self._n, key) + #def __getattribute__(self, name): + # if name in ("A", "B", "C"): + # return "Immutable value of %s" % name + # else: + # # This should trigger the default behavior for any other + # # attribute name. + # raise AttributeError() + #def __setattr__(self, name, value): + # if name in ("A", "B", "C"): + # raise AttributeError("%s is an immutable attribute.") + # else: + # dict.__getitem__(self, + #def __delattr__(self, name): + # return an iterator over my keys. + def iterkeys(self): + name = (c_char*1024)() + x = nwlib.rtdb_first(self._n, 1024, name) + while x: + yield name.value + x = nwlib.rtdb_next(self._n, 1024, name) + raise StopIteration + def __iter__(self): + return self.iterkeys() + def keys(self): + return [k for k in self.iterkeys()] diff --git a/src/python/test.py b/src/python/test.py new file mode 100644 index 0000000000..99db3761c7 --- /dev/null +++ b/src/python/test.py @@ -0,0 +1,47 @@ +#!/usr/bin/env python + +import sys +#from mpi4py import MPI +from nwchem import * + +def main(argv): + #mpi_init(argv) + db = nwchem_init(1500) + + inp = """geometry autosym + O 0.0 0.0 -0.02 + H -0.74 0.0 -0.76 + H 0.74 0.0 -0.76 +end +""" + #nwlib.push_inp_cstring(inp) + # This will not work next, since push_inp_cstring calls read_inp() + #nwlib.input_parse_(byref(c_int(db))) + + geom(db, inp) + bas(db, """basis + H library cc-pvdz + O library cc-pvdz +end +""") + driver(db, "driver; clear; end;") + + scf(db, "scf; print low; end;") + nwtask(db, "scf optimize\n") + + x = db['geometry:geometry:coords'].reshape((3,3)) + y = db["task:energy"] + if nwlib.ga_nodeid_() == 0: + print x + print y + +def test_newgeom(db): + x = db["geometry:geometry:coords"] + x[3:] *= 1.01 + db["geometry:geometry:coords"] = x + nwtask(db, "scf energy") + return db["scf:energy"] + +if __name__=="__main__": + main(sys.argv) + diff --git a/src/rtdb/hdbm/GNUmakefile b/src/rtdb/hdbm/GNUmakefile index 85e87c0d63..f233d413c4 100644 --- a/src/rtdb/hdbm/GNUmakefile +++ b/src/rtdb/hdbm/GNUmakefile @@ -32,5 +32,8 @@ test: test.o hdbm.o words: words.o hdbm.o $(CC) $(CFLAGS) -o $@ $^ +hdbm.so: hdbm.o + $(CC) $(CFLAGS) -shared -o $@ $^ + test.o word.o hdbm.o: hdbm.h diff --git a/src/rtdb/rtdb_seq.c b/src/rtdb/rtdb_seq.c index 1ad25850d4..9a75dff866 100644 --- a/src/rtdb/rtdb_seq.c +++ b/src/rtdb/rtdb_seq.c @@ -1181,7 +1181,7 @@ int rtdb_seq_copy(const int handle, const char *suffix) return 0; } #else -fixme +#error "non-hdbm rtdb_seq_copy not implemented" #endif return 1; } diff --git a/src/task/GNUmakefile b/src/task/GNUmakefile index c79c7a1030..63a6ed3bfc 100644 --- a/src/task/GNUmakefile +++ b/src/task/GNUmakefile @@ -8,7 +8,7 @@ task_hessian.o task_dynamics.o task_thermo.o task_et.o\ task_save_state.o task.o task_input.o task_shell_input.o task_num_grad.o \ task_vscf.o task_property.o task_dntmc.o task_bsse.o \ - task_jefftce.o task_ncc.o task_rfcf.o + task_rfcf.o USES_BLAS = task_num_grad.F task_bsse.F diff --git a/src/util/GNUmakefile b/src/util/GNUmakefile index d4b0d49d3f..a86d187d52 100644 --- a/src/util/GNUmakefile +++ b/src/util/GNUmakefile @@ -205,7 +205,7 @@ endif util_nwchemrc.o util_md.o util_md_c.o util_md_sockets.o\ dgewr.o atoi.o indint.o util_wall_remain.o \ ga_normf.o corr_mk_ref.o \ - nw_inp_from_file.o \ + nw_inp_from_file.o push_inp_cstring.o \ bgj.o movecs_ecce.o\ get_density.o moeig_read.o\ util_file_copy.o \ diff --git a/src/util/nw_inp_from_file.F b/src/util/nw_inp_from_file.F index 9e07e69bd8..dd66d6a299 100644 --- a/src/util/nw_inp_from_file.F +++ b/src/util/nw_inp_from_file.F @@ -84,5 +84,52 @@ logical function nw_inp_from_file(rtdb, filename) return c 100 call errquit(filename,0, INPUT_ERR) +c + end + subroutine pop_inp_string() +* +* $Id: pop_inp_string.F 19707 2010-10-29 17:59:36Z d3y133 $ +* + implicit none +#include "errquit.fh" +#include "inp.fh" +#include "util.fh" +#include "global.fh" + logical lopen + if (ga_nodeid() .eq. 0) then +c call inp_restore_state() ! restore state of any inp unit + inquire(unit=4,opened=lopen) + if (lopen) then + close(4,err=102) + endif + endif + return +c + 102 call errquit('pop_inp_string: error closing file',0, INPUT_ERR) + end + logical function push_inp_string(string) + implicit none +#include "errquit.fh" +#include "global.fh" +#include "inp.fh" +#include "util.fh" +#include "stdio.fh" + + character*(*) string +c + call pop_inp_string() + if (ga_nodeid() .eq. 0) then + open(4,form='formatted',status='scratch',err=100) + write(4,'(a)',err=101) string + rewind(4,err=101) +c call inp_save_state() ! save state of any inp unit + call inp_init(4,LuOut) + endif +c + push_inp_string = inp_read() + return +c + 100 call errquit('push_inp_string: error opening file',0, INPUT_ERR) + 101 call errquit('push_inp_string: error writing file',0, INPUT_ERR) c end diff --git a/src/util/push_inp_cstring.c b/src/util/push_inp_cstring.c new file mode 100644 index 0000000000..620e84820a --- /dev/null +++ b/src/util/push_inp_cstring.c @@ -0,0 +1,50 @@ +/* + $Id: push_inp_cstring.c 19695 2013-03-08 16:51:02Z d3y133 $ +*/ +#include "ga.h" +#include +#include +#include +#ifdef CRAY_T3E +#define FATR +#include /* Required for Fortran-C string interface on Crays */ +#endif +#ifndef WIN32 +#include +#else +#include "typesf2c.h" +#endif + +#if defined(CRAY_T3E) || defined(WIN32) +#define push_inp_string_ PUSH_INP_STRING +#endif + +#if defined(CRAY_T3E) || defined(USE_FCD) || defined(WIN32) +extern Integer FATR push_inp_string_(_fcd inp); +#else +extern Integer FATR push_inp_string_(char *inp, int len); +#endif + +int push_inp_cstring(const char *input) +{ + int status; +#if defined(USE_FCD) || defined(CRAY_T3E) || defined(WIN32) + _fcd inp; +#else + const char *inp = input; +#endif + +#if defined(CRAY_T3E) + inp = _cptofcd(input, strlen(input)); + status = push_inp_string_(inp); +#elif defined(WIN32) + inp.string = input; + inp.len = strlen(input); + status = push_inp_string_(inp); +#elif defined(USE_FCD) +#error Do something about _fcd +#else + status = push_inp_string_(inp, strlen(inp)); +#endif + return status; +}