From: Dawid Jagiela Date: Tue, 15 May 2012 13:17:01 +0000 (+0200) Subject: Added CMake files for building source/wham/src-M X-Git-Tag: v.3.2~115^2~5 X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?p=unres.git;a=commitdiff_plain;h=5e7ef767e99a894dc6976db6fa4a2e4041318ed0 Added CMake files for building source/wham/src-M --- diff --git a/CMakeLists.txt b/CMakeLists.txt index c0641e3..6bac0ac 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -176,6 +176,7 @@ else() add_subdirectory(source/xdrfpdb/src) add_subdirectory(source/xdrfpdb/src-M) add_subdirectory(source/wham/src) + add_subdirectory(source/wham/src-M) endif(UNRES_WITH_MPI) add_subdirectory(source/unres/src_MIN) diff --git a/source/unres/src_MIN/CMakeLists.txt b/source/unres/src_MIN/CMakeLists.txt index ddb6896..c57587a 100644 --- a/source/unres/src_MIN/CMakeLists.txt +++ b/source/unres/src_MIN/CMakeLists.txt @@ -118,7 +118,7 @@ if (Fortran_COMPILER_NAME STREQUAL "ifort") set(FFLAGS2 "-w -g -00 ") set(FFLAGS3 "-g -w -ipo " ) elseif (Fortran_COMPILER_NAME STREQUAL "gfortran") - set(FFLAGS0 " " ) + set(FFLAGS0 "-O" ) set(FFLAGS1 "-g -C" ) set(FFLAGS2 "-g -O0 ") set(FFLAGS3 "-O3" ) diff --git a/source/wham/src-M/CMakeLists.txt b/source/wham/src-M/CMakeLists.txt new file mode 100644 index 0000000..2382618 --- /dev/null +++ b/source/wham/src-M/CMakeLists.txt @@ -0,0 +1,282 @@ +# +# CMake project file for WHAM multichain version +# + +enable_language (Fortran) + +#================================ +# Set source file lists +#================================ +set(UNRES_WHAM_M_SRC0 + wham_multparm.F + bxread.F + xread.F + cxread.F + enecalc1.F + energy_p_new.F + initialize_p.F + molread_zs.F + openunits.F + readrtns.F + arcos.f + cartder.f + cartprint.f + chainbuild.F + geomout.F + icant.f + intcor.f + int_from_cart.f + make_ensemble1.F + matmult.f + misc.f + mygetenv.F + parmread.F + pinorm.f + printmat.f + rescode.f + setup_var.f + slices.F + store_parm.F + timing.F + wham_calc1.F + readrtns_compar.F + readpdb.f + fitsq.f + contact.f + elecont.f + contfunc.f + cont_frag.f + conf_compar.F + match_contact.f + angnorm.f + odlodc.f + promienie.f + qwolynes.f + read_ref_str.F + rmscalc.f + secondary.f + proc_cont.f + define_pairs.f + mysort.f +) + +set(UNRES_WHAM_M_PP_SRC + bxread.F + chainbuild.F + conf_compar.F + cxread.F + enecalc1.F + energy_p_new.F + geomout.F + initialize_p.F + make_ensemble1.F + molread_zs.F + mygetenv.F + openunits.F + parmread.F + read_ref_str.F + readrtns_compar.F + readrtns.F + slices.F + store_parm.F + timing.F + wham_calc1.F + wham_multparm.F + xread.F + proc_proc.c +) + + +#================================================ +# Set comipiler flags for different sourcefiles +#================================================ +if (Fortran_COMPILER_NAME STREQUAL "ifort") + set(FFLAGS0 "-g -CB -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres -I${MPIF_INCLUDE_DIRECTORIES}" ) +elseif (Fortran_COMPILER_NAME STREQUAL "gfortran") + set(FFLAGS0 "-g -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres +-I${MPIF_INCLUDE_DIRECTORIES}" ) +endif (Fortran_COMPILER_NAME STREQUAL "ifort") + + +#========================================= +# Add MPI compiler flags +#========================================= +if(UNRES_WITH_MPI) + set(FFLAGS0 "${FFLAGS0} -I${MPIF_INCLUDE_DIRECTORIES}") +endif(UNRES_WITH_MPI) + +set_property(SOURCE ${UNRES_WHAM_M_SRC0} PROPERTY COMPILE_FLAGS ${FFLAGS0} ) + +#========================================= +# WHAM preprocesor flags +#========================================= + +set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) + +#========================================= +# System specific flags +#========================================= +if(${CMAKE_SYSTEM_NAME} MATCHES "Linux") + set(CPPFLAGS "${CPPFLAGS} -DLINUX") +endif(${CMAKE_SYSTEM_NAME} MATCHES "Linux") + +#========================================= +# Compiler specific flags +#========================================= + +if (Fortran_COMPILER_NAME STREQUAL "ifort") + # Add ifort preprocessor flags + set(CPPFLAGS "${CPPFLAGS} -DPGI") +elseif (Fortran_COMPILER_NAME STREQUAL "f95") + # Add new gfortran flags + set(CPPFLAGS "${CPPFLAGS} -DG77") +elseif (Fortran_COMPILER_NAME STREQUAL "gfortran") + # Add old gfortran flags + set(CPPFLAGS "${CPPFLAGS} -DG77") +endif (Fortran_COMPILER_NAME STREQUAL "ifort") + +#========================================= +# Add MPI preprocessor flags +#========================================= +set(CPPFLAGS "${CPPFLAGS} -DMPI") + +#========================================= +# Add 64-bit specific preprocessor flags +#========================================= +if (architektura STREQUAL "64") + set(CPPFLAGS "${CPPFLAGS} -DAMD64") +endif (architektura STREQUAL "64") + +#========================================= +# Apply preprocesor flags to *.F files +#========================================= +set_property(SOURCE ${UNRES_WHAM_M_PP_SRC} PROPERTY COMPILE_DEFINITIONS ${CPPFLAGS} ) + + +#======================================== +# Setting binary name +#======================================== +set(UNRES_WHAM_M_BIN "wham_${Fortran_COMPILER_NAME}.exe") + +#========================================= +# cinfo.f stupid workaround for cmake +# - shame on me ]:) +#========================================= +set_property(SOURCE compinfo.c PROPERTY CMAKE_C_FLAGS "-c" ) +add_executable(compinfo-wham-m compinfo.c) +set_target_properties(compinfo-wham-m PROPERTIES OUTPUT_NAME compinfo) + +set(UNRES_CINFO_DIR "${CMAKE_CURRENT_BINARY_DIR}" ) +add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f + COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/cinfo.f ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f + COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/COMMON.IOUNITS ${CMAKE_CURRENT_BINARY_DIR}/COMMON.IOUNITS + COMMAND ${CMAKE_CURRENT_BINARY_DIR}/compinfo | true + DEPENDS compinfo-wham-m ) +set_property(SOURCE ${UNRES_CINFO_DIR}/cinfo.f PROPERTY COMPILE_FLAGS ${FFLAGS0} ) + +#========================================= +# Set full unres CSA sources +#========================================= +set(UNRES_WHAM_M_SRCS ${UNRES_WHAM_M_SRC0} ${UNRES_CINFO_DIR}/cinfo.f proc_proc.c) + +#========================================= +# Build the binary +#========================================= +add_executable(UNRES_WHAM_M_BIN ${UNRES_WHAM_M_SRCS} ) +set_target_properties(UNRES_WHAM_M_BIN PROPERTIES OUTPUT_NAME ${UNRES_WHAM_M_BIN}) + +#set_property(TARGET ${UNRES_BIN} PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin/unres/MD ) +#add_dependencies (${UNRES_BIN} ${UNRES_XDRFLIB}) + +#========================================= +# Link libraries +#========================================= +# link MPI library (libmpich.a) +target_link_libraries( UNRES_WHAM_M_BIN ${MPIF_LIBRARIES} ) +# link libxdrf.a +target_link_libraries( UNRES_WHAM_M_BIN xdrf ) + +#========================================= +# TESTS +#========================================= + +#-- Copy all the data files from the test directory into the source directory +#SET(UNRES_TEST_FILES +# ala10.inp +# ) + +#FOREACH (UNRES_TEST_FILE ${UNRES_TEST_FILES}) +# SET (unres_test_dest "${CMAKE_CURRENT_BINARY_DIR}/${UNRES_TEST_FILE}") +# MESSAGE (STATUS " Copying ${UNRES_TEST_FILE} from ${CMAKE_SOURCE_DIR}/examples/unres/MD/ff_gab/${UNRES_TEST_FILE} to ${unres_test_dest}") +# ADD_CUSTOM_COMMAND ( +# TARGET ${UNRES_BIN} +# POST_BUILD +# COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_SOURCE_DIR}/examples/unres/MD/ff_gab/${UNRES_TEST_FILE} ${unres_test_dest} +# ) +#ENDFOREACH (UNRES_TEST_FILE ${UNRES_TEST_FILES}) + +#========================================= +# Generate data test files +#========================================= +# test_single_ala.sh +#========================================= + +#FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh +#"#!/bin/sh +#export POT=GB +#export PREFIX=ala10 +#----------------------------------------------------------------------------- +#UNRES_BIN=./${UNRES_BIN} +#----------------------------------------------------------------------------- +#DD=${CMAKE_SOURCE_DIR}/PARAM +#export BONDPAR=$DD/bond.parm +#export THETPAR=$DD/thetaml.5parm +#export ROTPAR=$DD/scgauss.parm +#export TORPAR=$DD/torsion_631Gdp.parm +#export TORDPAR=$DD/torsion_double_631Gdp.parm +#export ELEPAR=$DD/electr_631Gdp.parm +#export SIDEPAR=$DD/sc_GB_opt.1gab_3S_qclass5no310-shan2-sc-16-10-8k +#export FOURIER=$DD/fourier_opt.parm.1igd_hc_iter3_3 +#export SCPPAR=$DD/scp.parm +#export SCCORPAR=$DD/rotcorr_AM1.parm +#export PATTERN=$DD/patterns.cart +#----------------------------------------------------------------------------- +#$UNRES_BIN +#") + +#========================================= +# ala10.inp +#========================================= + +#file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/ala10.inp +#"ala10 unblocked +#SEED=-1111333 MD ONE_LETTER rescale_mode=2 PDBOUT +#nstep=15000 ntwe=100 ntwx=1000 dt=0.1 lang=0 tbf t_bath=300 damax=1.0 & +#reset_moment=1000 reset_vel=1000 MDPDB +#WLONG=1.35279 WSCP=1.59304 WELEC=0.71534 WBOND=1.00000 WANG=1.13873 & +#WSCLOC=0.16258 WTOR=1.98599 WTORD=1.57069 WCORRH=0.42887 WCORR5=0.00000 & +#WCORR6=0.00000 WEL_LOC=0.16036 WTURN3=1.68722 WTURN4=0.66230 WTURN6=0.00000 & +#WVDWPP=0.11371 WHPB=1.00000 & +#CUTOFF=7.00000 WCORR4=0.00000 +#12 +#XAAAAAAAAAAX +# 0 +# 0 +# 90.0000 90.0000 90.0000 90.000 90.000 90.000 90.000 90.000 +# 90.0000 90.0000 +# 180.0000 180.0000 180.0000 180.000 180.000 180.000 180.000 180.000 +# 180.0000 +# 110.0000 110.0000 110.0000 100.000 110.000 100.000 110.000 110.000 +# 110.0000 110.0000 +# -120.0000 -120.0000 -120.000 -120.000 -120.000 -120.000 -120.000 -120.000 +# -120.0000 -120.0000 +#") + + +# Add tests + +#if(NOT UNRES_WITH_MPI) + +# add_test(NAME UNRES_MD_Ala10 COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh ) + +#endif(NOT UNRES_WITH_MPI) diff --git a/source/wham/src-M/compinfo b/source/wham/src-M/compinfo deleted file mode 100755 index a9d3c1d..0000000 Binary files a/source/wham/src-M/compinfo and /dev/null differ diff --git a/source/wham/src-M/compinfo.c b/source/wham/src-M/compinfo.c index 813cf31..177dbd3 100644 --- a/source/wham/src-M/compinfo.c +++ b/source/wham/src-M/compinfo.c @@ -26,17 +26,19 @@ fprintf(out," write(iout,*)'++++ Compile info ++++'\n"); fprintf(out," write(iout,*)'Version %d.%-d build %d'\n",iv1,iv2,iv3); uname(&Name); time(&Tp); -system("rm tmptmp; whoami > tmptmp"); +system("whoami > tmptmp"); in1=fopen("tmptmp","r"); fscanf(in1,"%s",buf1); fclose(in1); +system("rm tmptmp"); p1=ctime(&Tp); p1[strlen(p1)-1]='\0'; fprintf(out," write(iout,*)'compiled %s'\n",p1); fprintf(out," write(iout,*)'compiled by %s@%s'\n",buf1,Name.nodename); fprintf(out," write(iout,*)'OS name: %s '\n",Name.sysname); fprintf(out," write(iout,*)'OS release: %s '\n",Name.release); -fprintf(out," write(iout,*)'OS version: %s '\n",Name.version); +fprintf(out," write(iout,*)'OS version:',\n"); +fprintf(out," & ' %s '\n",Name.version); fprintf(out," write(iout,*)'flags:'\n"); in1=fopen("Makefile","r"); while(fgets(buf,498,in1) != NULL) diff --git a/source/wham/src-M/differ b/source/wham/src-M/differ deleted file mode 100644 index 48384a1..0000000 --- a/source/wham/src-M/differ +++ /dev/null @@ -1,5173 +0,0 @@ -1c1 -< subroutine etotal(energia,fact) ---- -> subroutine etotal(energia) -4,5d3 -< include 'DIMENSIONS.ZSCOPT' -< -8d5 -< #endif -12,18d8 -< -< include 'COMMON.IOUNITS' -< double precision energia(0:max_ene),energia1(0:max_ene+1) -< #ifdef MPL -< include 'COMMON.INFO' -< external d_vadd -< integer ready -19a10,17 -> #ifdef MPI -> include "mpif.h" -> double precision weights_(n_ene) -> #endif -> include 'COMMON.SETUP' -> include 'COMMON.IOUNITS' -> double precision energia(0:n_ene) -> include 'COMMON.LOCAL' -25,28c23,98 -< double precision fact(6) -< cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot -< cd print *,'nnt=',nnt,' nct=',nct -< C ---- -> include 'COMMON.VAR' -> include 'COMMON.MD' -> include 'COMMON.CONTROL' -> include 'COMMON.TIME1' -> #ifdef MPI -> c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank, -> c & " nfgtasks",nfgtasks -> if (nfgtasks.gt.1) then -> time00=MPI_Wtime() -> C FG slaves call the following matching MPI_Bcast in ERGASTULUM -> if (fg_rank.eq.0) then -> call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR) -> c print *,"Processor",myrank," BROADCAST iorder" -> C FG master sets up the WEIGHTS_ array which will be broadcast to the -> C FG slaves as WEIGHTS array. -> weights_(1)=wsc -> weights_(2)=wscp -> weights_(3)=welec -> weights_(4)=wcorr -> weights_(5)=wcorr5 -> weights_(6)=wcorr6 -> weights_(7)=wel_loc -> weights_(8)=wturn3 -> weights_(9)=wturn4 -> weights_(10)=wturn6 -> weights_(11)=wang -> weights_(12)=wscloc -> weights_(13)=wtor -> weights_(14)=wtor_d -> weights_(15)=wstrain -> weights_(16)=wvdwpp -> weights_(17)=wbond -> weights_(18)=scal14 -> weights_(21)=wsccor -> C FG Master broadcasts the WEIGHTS_ array -> call MPI_Bcast(weights_(1),n_ene, -> & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) -> else -> C FG slaves receive the WEIGHTS array -> call MPI_Bcast(weights(1),n_ene, -> & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) -> wsc=weights(1) -> wscp=weights(2) -> welec=weights(3) -> wcorr=weights(4) -> wcorr5=weights(5) -> wcorr6=weights(6) -> wel_loc=weights(7) -> wturn3=weights(8) -> wturn4=weights(9) -> wturn6=weights(10) -> wang=weights(11) -> wscloc=weights(12) -> wtor=weights(13) -> wtor_d=weights(14) -> wstrain=weights(15) -> wvdwpp=weights(16) -> wbond=weights(17) -> scal14=weights(18) -> wsccor=weights(21) -> endif -> time_Bcast=time_Bcast+MPI_Wtime()-time00 -> time_Bcastw=time_Bcastw+MPI_Wtime()-time00 -> c call chainbuild_cart -> endif -> c print *,'Processor',myrank,' calling etotal ipot=',ipot -> c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct -> #else -> c if (modecalc.eq.12.or.modecalc.eq.14) then -> c call int_from_cart1(.false.) -> c endif -> #endif -> #ifdef TIMING -> time00=MPI_Wtime() -> #endif -> C -31c101 -< goto (101,102,103,104,105) ipot ---- -> goto (101,102,103,104,105,106) ipot -33c103 -< 101 call elj(evdw,evdw_t) ---- -> 101 call elj(evdw) -35c105 -< goto 106 ---- -> goto 107 -37,38c107,108 -< 102 call eljk(evdw,evdw_t) -< goto 106 ---- -> 102 call eljk(evdw) -> goto 107 -40,41c110,111 -< 103 call ebp(evdw,evdw_t) -< goto 106 ---- -> 103 call ebp(evdw) -> goto 107 -43,44c113,114 -< 104 call egb(evdw,evdw_t) -< goto 106 ---- -> 104 call egb(evdw) -> goto 107 -46c116,119 -< 105 call egbv(evdw,evdw_t) ---- -> 105 call egbv(evdw) -> goto 107 -> C Soft-sphere potential -> 106 call e_softsphere(evdw) -50c123,158 -< 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) ---- -> 107 continue -> c print *,"Processor",myrank," computed USCSC" -> #ifdef TIMING -> time01=MPI_Wtime() -> #endif -> call vec_and_deriv -> #ifdef TIMING -> time_vec=time_vec+MPI_Wtime()-time01 -> #endif -> c print *,"Processor",myrank," left VEC_AND_DERIV" -> if (ipot.lt.6) then -> #ifdef SPLITELE -> if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. -> & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 -> & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 -> & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -> #else -> if (welec.gt.0d0.or.wel_loc.gt.0d0.or. -> & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 -> & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 -> & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -> #endif -> call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) -> else -> ees=0.0d0 -> evdw1=0.0d0 -> eel_loc=0.0d0 -> eello_turn3=0.0d0 -> eello_turn4=0.0d0 -> endif -> else -> c write (iout,*) "Soft-spheer ELEC potential" -> call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, -> & eello_turn4) -> endif -> c print *,"Processor",myrank," computed UELEC" -55c163,173 -< call escp(evdw2,evdw2_14) ---- -> if (ipot.lt.6) then -> if(wscp.gt.0d0) then -> call escp(evdw2,evdw2_14) -> else -> evdw2=0 -> evdw2_14=0 -> endif -> else -> c write (iout,*) "Soft-sphere SCP potential" -> call escp_soft_sphere(evdw2,evdw2_14) -> endif -60d177 -< c write (iout,*) "estr",estr -70,71c187,192 -< call ebend(ebe) -< cd print *,'Bend energy finished.' ---- -> if (wang.gt.0d0) then -> call ebend(ebe) -> else -> ebe=0 -> endif -> c print *,"Processor",myrank," computed UB" -76c197 -< cd print *,'SCLOC energy finished.' ---- -> c print *,"Processor",myrank," computed USC" -81c202,208 -< call etor(etors,edihcnstr,fact(1)) ---- -> if (wtor.gt.0) then -> call etor(etors,edihcnstr) -> else -> etors=0 -> edihcnstr=0 -> endif -> c print *,"Processor",myrank," computed Utor" -85c212,217 -< call etor_d(etors_d,fact(2)) ---- -> if (wtor_d.gt.0) then -> call etor_d(etors_d) -> else -> etors_d=0 -> endif -> c print *,"Processor",myrank," computed Utord" -89c221,226 -< call eback_sc_corr(esccor) ---- -> if (wsccor.gt.0.0d0) then -> call eback_sc_corr(esccor) -> else -> esccor=0.0d0 -> endif -> c print *,"Processor",myrank," computed Usccorr" -95,97c232,233 -< if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 -< & .or. wturn6.gt.0.0d0) then -< c print *,"calling multibody_eello" ---- -> if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 -> & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then -99,100c235,241 -< c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1 -< c print *,ecorr,ecorr5,ecorr6,eturn6 ---- -> cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1, -> cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 -> else -> ecorr=0.0d0 -> ecorr5=0.0d0 -> ecorr6=0.0d0 -> eturn6=0.0d0 -102c243 -< if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then ---- -> if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then -103a245 -> cd write (iout,*) "multibody_hb ecorr",ecorr -105,123c247,259 -< c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t -< #ifdef SPLITELE -< etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees -< & +wvdwpp*evdw1 -< & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc -< & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 -< & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4 -< & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6 -< & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d -< & +wbond*estr+wsccor*fact(1)*esccor -< #else -< etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2 -< & +welec*fact(1)*(ees+evdw1) -< & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc -< & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 -< & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4 -< & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6 -< & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d -< & +wbond*estr+wsccor*fact(1)*esccor ---- -> c print *,"Processor",myrank," computed Ucorr" -> C -> C If performing constraint dynamics, call the constraint energy -> C after the equilibration time -> if(usampl.and.totT.gt.eq_time) then -> call EconstrQ -> call Econstr_back -> else -> Uconst=0.0d0 -> Uconst_back=0.0d0 -> endif -> #ifdef TIMING -> time_enecalc=time_enecalc+MPI_Wtime()-time00 -125c261,267 -< energia(0)=etot ---- -> c print *,"Processor",myrank," computed Uconstr" -> #ifdef TIMING -> time00=MPI_Wtime() -> #endif -> c -> C Sum the energies -> C -129c271 -< energia(17)=evdw2_14 ---- -> energia(18)=evdw2_14 -132c274 -< energia(17)=0.0d0 ---- -> energia(18)=0.0d0 -153,156c295,402 -< energia(18)=estr -< energia(19)=esccor -< energia(20)=edihcnstr -< energia(21)=evdw_t ---- -> energia(19)=edihcnstr -> energia(17)=estr -> energia(20)=Uconst+Uconst_back -> energia(21)=esccor -> c print *," Processor",myrank," calls SUM_ENERGY" -> call sum_energy(energia,.true.) -> c print *," Processor",myrank," left SUM_ENERGY" -> #ifdef TIMING -> time_sumene=time_sumene+MPI_Wtime()-time00 -> #endif -> return -> end -> c------------------------------------------------------------------------------- -> subroutine sum_energy(energia,reduce) -> implicit real*8 (a-h,o-z) -> include 'DIMENSIONS' -> #ifndef ISNAN -> external proc_proc -> #ifdef WINPGI -> cMS$ATTRIBUTES C :: proc_proc -> #endif -> #endif -> #ifdef MPI -> include "mpif.h" -> #endif -> include 'COMMON.SETUP' -> include 'COMMON.IOUNITS' -> double precision energia(0:n_ene),enebuff(0:n_ene+1) -> include 'COMMON.FFIELD' -> include 'COMMON.DERIV' -> include 'COMMON.INTERACT' -> include 'COMMON.SBRIDGE' -> include 'COMMON.CHAIN' -> include 'COMMON.VAR' -> include 'COMMON.CONTROL' -> include 'COMMON.TIME1' -> logical reduce -> #ifdef MPI -> if (nfgtasks.gt.1 .and. reduce) then -> #ifdef DEBUG -> write (iout,*) "energies before REDUCE" -> call enerprint(energia) -> call flush(iout) -> #endif -> do i=0,n_ene -> enebuff(i)=energia(i) -> enddo -> time00=MPI_Wtime() -> call MPI_Barrier(FG_COMM,IERR) -> time_barrier_e=time_barrier_e+MPI_Wtime()-time00 -> time00=MPI_Wtime() -> call MPI_Reduce(enebuff(0),energia(0),n_ene+1, -> & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) -> #ifdef DEBUG -> write (iout,*) "energies after REDUCE" -> call enerprint(energia) -> call flush(iout) -> #endif -> time_Reduce=time_Reduce+MPI_Wtime()-time00 -> endif -> if (fg_rank.eq.0) then -> #endif -> evdw=energia(1) -> #ifdef SCP14 -> evdw2=energia(2)+energia(18) -> evdw2_14=energia(18) -> #else -> evdw2=energia(2) -> #endif -> #ifdef SPLITELE -> ees=energia(3) -> evdw1=energia(16) -> #else -> ees=energia(3) -> evdw1=0.0d0 -> #endif -> ecorr=energia(4) -> ecorr5=energia(5) -> ecorr6=energia(6) -> eel_loc=energia(7) -> eello_turn3=energia(8) -> eello_turn4=energia(9) -> eturn6=energia(10) -> ebe=energia(11) -> escloc=energia(12) -> etors=energia(13) -> etors_d=energia(14) -> ehpb=energia(15) -> edihcnstr=energia(19) -> estr=energia(17) -> Uconst=energia(20) -> esccor=energia(21) -> #ifdef SPLITELE -> etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 -> & +wang*ebe+wtor*etors+wscloc*escloc -> & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5 -> & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 -> & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d -> & +wbond*estr+Uconst+wsccor*esccor -> #else -> etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) -> & +wang*ebe+wtor*etors+wscloc*escloc -> & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5 -> & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 -> & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d -> & +wbond*estr+Uconst+wsccor*esccor -> #endif -> energia(0)=etot -173,174c419,464 -< #ifdef MPL -< c endif ---- -> #ifdef MPI -> endif -> #endif -> return -> end -> c------------------------------------------------------------------------------- -> subroutine sum_gradient -> implicit real*8 (a-h,o-z) -> include 'DIMENSIONS' -> #ifndef ISNAN -> external proc_proc -> #ifdef WINPGI -> cMS$ATTRIBUTES C :: proc_proc -> #endif -> #endif -> #ifdef MPI -> include 'mpif.h' -> double precision gradbufc(3,maxres),gradbufx(3,maxres), -> & glocbuf(4*maxres),gradbufc_sum(3,maxres) -> #endif -> include 'COMMON.SETUP' -> include 'COMMON.IOUNITS' -> include 'COMMON.FFIELD' -> include 'COMMON.DERIV' -> include 'COMMON.INTERACT' -> include 'COMMON.SBRIDGE' -> include 'COMMON.CHAIN' -> include 'COMMON.VAR' -> include 'COMMON.CONTROL' -> include 'COMMON.TIME1' -> include 'COMMON.MAXGRAD' -> #ifdef TIMING -> time01=MPI_Wtime() -> #endif -> #ifdef DEBUG -> write (iout,*) "sum_gradient gvdwc, gvdwx" -> do i=1,nres -> write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') -> & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3) -> enddo -> call flush(iout) -> #endif -> #ifdef MPI -> C FG slaves call the following matching MPI_Bcast in ERGASTULUM -> if (nfgtasks.gt.1 .and. fg_rank.eq.0) -> & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR) -176d465 -< if (calc_grad) then -178c467,468 -< C Sum up the components of the Cartesian gradient. ---- -> C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient -> C in virtual-bond-vector coordinates -179a470,488 -> #ifdef DEBUG -> c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc" -> c do i=1,nres-1 -> c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)') -> c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i) -> c enddo -> c write (iout,*) "gel_loc_tur3 gel_loc_turn4" -> c do i=1,nres-1 -> c write (iout,'(i5,3f10.5,2x,f10.5)') -> c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i) -> c enddo -> write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc" -> do i=1,nres -> write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') -> & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3), -> & g_corr5_loc(i) -> enddo -> call flush(iout) -> #endif -183,198c492,500 -< gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+ -< & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+ -< & wbond*gradb(j,i)+ -< & wstrain*ghpbc(j,i)+ -< & wcorr*fact(3)*gradcorr(j,i)+ -< & wel_loc*fact(2)*gel_loc(j,i)+ -< & wturn3*fact(2)*gcorr3_turn(j,i)+ -< & wturn4*fact(3)*gcorr4_turn(j,i)+ -< & wcorr5*fact(4)*gradcorr5(j,i)+ -< & wcorr6*fact(5)*gradcorr6(j,i)+ -< & wturn6*fact(5)*gcorr6_turn(j,i)+ -< & wsccor*fact(2)*gsccorc(j,i) -< gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ -< & wbond*gradbx(j,i)+ -< & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ -< & wsccor*fact(2)*gsccorx(j,i) ---- -> gradbufc(j,i)=wsc*gvdwc(j,i)+ -> & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ -> & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ -> & wel_loc*gel_loc_long(j,i)+ -> & wcorr*gradcorr_long(j,i)+ -> & wcorr5*gradcorr5_long(j,i)+ -> & wcorr6*gradcorr6_long(j,i)+ -> & wturn6*gcorr6_turn_long(j,i)+ -> & wstrain*ghpbc(j,i) -199a502 -> enddo -203,204c506,508 -< gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+ -< & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+ ---- -> gradbufc(j,i)=wsc*gvdwc(j,i)+ -> & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ -> & welec*gelc_long(j,i)+ -206,213c510,670 -< & wcorr*fact(3)*gradcorr(j,i)+ -< & wel_loc*fact(2)*gel_loc(j,i)+ -< & wturn3*fact(2)*gcorr3_turn(j,i)+ -< & wturn4*fact(3)*gcorr4_turn(j,i)+ -< & wcorr5*fact(4)*gradcorr5(j,i)+ -< & wcorr6*fact(5)*gradcorr6(j,i)+ -< & wturn6*fact(5)*gcorr6_turn(j,i)+ -< & wsccor*fact(2)*gsccorc(j,i) ---- -> & wel_loc*gel_loc_long(j,i)+ -> & wcorr*gradcorr_long(j,i)+ -> & wcorr5*gradcorr5_long(j,i)+ -> & wcorr6*gradcorr6_long(j,i)+ -> & wturn6*gcorr6_turn_long(j,i)+ -> & wstrain*ghpbc(j,i) -> enddo -> enddo -> #endif -> #ifdef MPI -> if (nfgtasks.gt.1) then -> time00=MPI_Wtime() -> #ifdef DEBUG -> write (iout,*) "gradbufc before allreduce" -> do i=1,nres -> write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) -> enddo -> call flush(iout) -> #endif -> do i=1,nres -> do j=1,3 -> gradbufc_sum(j,i)=gradbufc(j,i) -> enddo -> enddo -> c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres, -> c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR) -> c time_reduce=time_reduce+MPI_Wtime()-time00 -> #ifdef DEBUG -> c write (iout,*) "gradbufc_sum after allreduce" -> c do i=1,nres -> c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3) -> c enddo -> c call flush(iout) -> #endif -> #ifdef TIMING -> c time_allreduce=time_allreduce+MPI_Wtime()-time00 -> #endif -> do i=nnt,nres -> do k=1,3 -> gradbufc(k,i)=0.0d0 -> enddo -> enddo -> #ifdef DEBUG -> write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end -> write (iout,*) (i," jgrad_start",jgrad_start(i), -> & " jgrad_end ",jgrad_end(i), -> & i=igrad_start,igrad_end) -> #endif -> c -> c Obsolete and inefficient code; we can make the effort O(n) and, therefore, -> c do not parallelize this part. -> c -> c do i=igrad_start,igrad_end -> c do j=jgrad_start(i),jgrad_end(i) -> c do k=1,3 -> c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j) -> c enddo -> c enddo -> c enddo -> do j=1,3 -> gradbufc(j,nres-1)=gradbufc_sum(j,nres) -> enddo -> do i=nres-2,nnt,-1 -> do j=1,3 -> gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) -> enddo -> enddo -> #ifdef DEBUG -> write (iout,*) "gradbufc after summing" -> do i=1,nres -> write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) -> enddo -> call flush(iout) -> #endif -> else -> #endif -> #ifdef DEBUG -> write (iout,*) "gradbufc" -> do i=1,nres -> write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) -> enddo -> call flush(iout) -> #endif -> do i=1,nres -> do j=1,3 -> gradbufc_sum(j,i)=gradbufc(j,i) -> gradbufc(j,i)=0.0d0 -> enddo -> enddo -> do j=1,3 -> gradbufc(j,nres-1)=gradbufc_sum(j,nres) -> enddo -> do i=nres-2,nnt,-1 -> do j=1,3 -> gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) -> enddo -> enddo -> c do i=nnt,nres-1 -> c do k=1,3 -> c gradbufc(k,i)=0.0d0 -> c enddo -> c do j=i+1,nres -> c do k=1,3 -> c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j) -> c enddo -> c enddo -> c enddo -> #ifdef DEBUG -> write (iout,*) "gradbufc after summing" -> do i=1,nres -> write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) -> enddo -> call flush(iout) -> #endif -> #ifdef MPI -> endif -> #endif -> do k=1,3 -> gradbufc(k,nres)=0.0d0 -> enddo -> do i=1,nct -> do j=1,3 -> #ifdef SPLITELE -> gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ -> & wel_loc*gel_loc(j,i)+ -> & 0.5d0*(wscp*gvdwc_scpp(j,i)+ -> & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ -> & wel_loc*gel_loc_long(j,i)+ -> & wcorr*gradcorr_long(j,i)+ -> & wcorr5*gradcorr5_long(j,i)+ -> & wcorr6*gradcorr6_long(j,i)+ -> & wturn6*gcorr6_turn_long(j,i))+ -> & wbond*gradb(j,i)+ -> & wcorr*gradcorr(j,i)+ -> & wturn3*gcorr3_turn(j,i)+ -> & wturn4*gcorr4_turn(j,i)+ -> & wcorr5*gradcorr5(j,i)+ -> & wcorr6*gradcorr6(j,i)+ -> & wturn6*gcorr6_turn(j,i)+ -> & wsccor*gsccorc(j,i) -> & +wscloc*gscloc(j,i) -> #else -> gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ -> & wel_loc*gel_loc(j,i)+ -> & 0.5d0*(wscp*gvdwc_scpp(j,i)+ -> & welec*gelc_long(j,i) -> & wel_loc*gel_loc_long(j,i)+ -> & wcorr*gcorr_long(j,i)+ -> & wcorr5*gradcorr5_long(j,i)+ -> & wcorr6*gradcorr6_long(j,i)+ -> & wturn6*gcorr6_turn_long(j,i))+ -> & wbond*gradb(j,i)+ -> & wcorr*gradcorr(j,i)+ -> & wturn3*gcorr3_turn(j,i)+ -> & wturn4*gcorr4_turn(j,i)+ -> & wcorr5*gradcorr5(j,i)+ -> & wcorr6*gradcorr6(j,i)+ -> & wturn6*gcorr6_turn(j,i)+ -> & wsccor*gsccorc(j,i) -> & +wscloc*gscloc(j,i) -> #endif -217c674,675 -< & wsccor*fact(1)*gsccorx(j,i) ---- -> & wsccor*gsccorx(j,i) -> & +wscloc*gsclocx(j,i) -219c677,681 -< #endif ---- -> enddo -> #ifdef DEBUG -> write (iout,*) "gloc before adding corr" -> do i=1,4*nres -> write (iout,*) i,gloc(i,icg) -221,222c683 -< -< ---- -> #endif -224,231c685,697 -< gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i) -< & +wcorr5*fact(4)*g_corr5_loc(i) -< & +wcorr6*fact(5)*g_corr6_loc(i) -< & +wturn4*fact(3)*gel_loc_turn4(i) -< & +wturn3*fact(2)*gel_loc_turn3(i) -< & +wturn6*fact(5)*gel_loc_turn6(i) -< & +wel_loc*fact(2)*gel_loc_loc(i) -< & +wsccor*fact(1)*gsccor_loc(i) ---- -> gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) -> & +wcorr5*g_corr5_loc(i) -> & +wcorr6*g_corr6_loc(i) -> & +wturn4*gel_loc_turn4(i) -> & +wturn3*gel_loc_turn3(i) -> & +wturn6*gel_loc_turn6(i) -> & +wel_loc*gel_loc_loc(i) -> & +wsccor*gsccor_loc(i) -> enddo -> #ifdef DEBUG -> write (iout,*) "gloc after adding corr" -> do i=1,4*nres -> write (iout,*) i,gloc(i,icg) -232a699,727 -> #endif -> #ifdef MPI -> if (nfgtasks.gt.1) then -> do j=1,3 -> do i=1,nres -> gradbufc(j,i)=gradc(j,i,icg) -> gradbufx(j,i)=gradx(j,i,icg) -> enddo -> enddo -> do i=1,4*nres -> glocbuf(i)=gloc(i,icg) -> enddo -> time00=MPI_Wtime() -> call MPI_Barrier(FG_COMM,IERR) -> time_barrier_g=time_barrier_g+MPI_Wtime()-time00 -> time00=MPI_Wtime() -> call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres, -> & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) -> call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres, -> & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) -> call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres, -> & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) -> time_reduce=time_reduce+MPI_Wtime()-time00 -> #ifdef DEBUG -> write (iout,*) "gloc after reduce" -> do i=1,4*nres -> write (iout,*) i,gloc(i,icg) -> enddo -> #endif -233a729,897 -> #endif -> if (gnorm_check) then -> c -> c Compute the maximum elements of the gradient -> c -> gvdwc_max=0.0d0 -> gvdwc_scp_max=0.0d0 -> gelc_max=0.0d0 -> gvdwpp_max=0.0d0 -> gradb_max=0.0d0 -> ghpbc_max=0.0d0 -> gradcorr_max=0.0d0 -> gel_loc_max=0.0d0 -> gcorr3_turn_max=0.0d0 -> gcorr4_turn_max=0.0d0 -> gradcorr5_max=0.0d0 -> gradcorr6_max=0.0d0 -> gcorr6_turn_max=0.0d0 -> gsccorc_max=0.0d0 -> gscloc_max=0.0d0 -> gvdwx_max=0.0d0 -> gradx_scp_max=0.0d0 -> ghpbx_max=0.0d0 -> gradxorr_max=0.0d0 -> gsccorx_max=0.0d0 -> gsclocx_max=0.0d0 -> do i=1,nct -> gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i))) -> if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm -> gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i))) -> if (gvdwc_scp_norm.gt.gvdwc_scp_max) -> & gvdwc_scp_max=gvdwc_scp_norm -> gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i))) -> if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm -> gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i))) -> if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm -> gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i))) -> if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm -> ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i))) -> if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm -> gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i))) -> if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm -> gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i))) -> if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm -> gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i), -> & gcorr3_turn(1,i))) -> if (gcorr3_turn_norm.gt.gcorr3_turn_max) -> & gcorr3_turn_max=gcorr3_turn_norm -> gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i), -> & gcorr4_turn(1,i))) -> if (gcorr4_turn_norm.gt.gcorr4_turn_max) -> & gcorr4_turn_max=gcorr4_turn_norm -> gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i))) -> if (gradcorr5_norm.gt.gradcorr5_max) -> & gradcorr5_max=gradcorr5_norm -> gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i))) -> if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm -> gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i), -> & gcorr6_turn(1,i))) -> if (gcorr6_turn_norm.gt.gcorr6_turn_max) -> & gcorr6_turn_max=gcorr6_turn_norm -> gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i))) -> if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm -> gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i))) -> if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm -> gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i))) -> if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm -> gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i))) -> if (gradx_scp_norm.gt.gradx_scp_max) -> & gradx_scp_max=gradx_scp_norm -> ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i))) -> if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm -> gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i))) -> if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm -> gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i))) -> if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm -> gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i))) -> if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm -> enddo -> if (gradout) then -> #ifdef AIX -> open(istat,file=statname,position="append") -> #else -> open(istat,file=statname,access="append") -> #endif -> write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max, -> & gelc_max,gvdwpp_max,gradb_max,ghpbc_max, -> & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max, -> & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max, -> & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max, -> & gsccorx_max,gsclocx_max -> close(istat) -> if (gvdwc_max.gt.1.0d4) then -> write (iout,*) "gvdwc gvdwx gradb gradbx" -> do i=nnt,nct -> write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i), -> & gradb(j,i),gradbx(j,i),j=1,3) -> enddo -> call pdbout(0.0d0,'cipiszcze',iout) -> call flush(iout) -> endif -> endif -> endif -> #ifdef DEBUG -> write (iout,*) "gradc gradx gloc" -> do i=1,nres -> write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') -> & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg) -> enddo -> #endif -> #ifdef TIMING -> time_sumgradient=time_sumgradient+MPI_Wtime()-time01 -> #endif -> return -> end -> c------------------------------------------------------------------------------- -> subroutine rescale_weights(t_bath) -> implicit real*8 (a-h,o-z) -> include 'DIMENSIONS' -> include 'COMMON.IOUNITS' -> include 'COMMON.FFIELD' -> include 'COMMON.SBRIDGE' -> double precision kfac /2.4d0/ -> double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/ -> c facT=temp0/t_bath -> c facT=2*temp0/(t_bath+temp0) -> if (rescale_mode.eq.0) then -> facT=1.0d0 -> facT2=1.0d0 -> facT3=1.0d0 -> facT4=1.0d0 -> facT5=1.0d0 -> else if (rescale_mode.eq.1) then -> facT=kfac/(kfac-1.0d0+t_bath/temp0) -> facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2) -> facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3) -> facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4) -> facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5) -> else if (rescale_mode.eq.2) then -> x=t_bath/temp0 -> x2=x*x -> x3=x2*x -> x4=x3*x -> x5=x4*x -> facT=licznik/dlog(dexp(x)+dexp(-x)) -> facT2=licznik/dlog(dexp(x2)+dexp(-x2)) -> facT3=licznik/dlog(dexp(x3)+dexp(-x3)) -> facT4=licznik/dlog(dexp(x4)+dexp(-x4)) -> facT5=licznik/dlog(dexp(x5)+dexp(-x5)) -> else -> write (iout,*) "Wrong RESCALE_MODE",rescale_mode -> write (*,*) "Wrong RESCALE_MODE",rescale_mode -> #ifdef MPI -> call MPI_Finalize(MPI_COMM_WORLD,IERROR) -> #endif -> stop 555 -> endif -> welec=weights(3)*fact -> wcorr=weights(4)*fact3 -> wcorr5=weights(5)*fact4 -> wcorr6=weights(6)*fact5 -> wel_loc=weights(7)*fact2 -> wturn3=weights(8)*fact2 -> wturn4=weights(9)*fact3 -> wturn6=weights(10)*fact5 -> wtor=weights(13)*fact -> wtor_d=weights(14)*fact2 -> wsccor=weights(21)*fact -> -237c901 -< subroutine enerprint(energia,fact) ---- -> subroutine enerprint(energia) -240d903 -< include 'DIMENSIONS.ZSCOPT' -244c907,908 -< double precision energia(0:max_ene),fact(6) ---- -> include 'COMMON.MD' -> double precision energia(0:n_ene) -246c910,911 -< evdw=energia(1)+fact(6)*energia(21) ---- -> evdw=energia(1) -> evdw2=energia(2) -248c913 -< evdw2=energia(2)+energia(17) ---- -> evdw2=energia(2)+energia(18) -268,270c933,936 -< esccor=energia(19) -< edihcnstr=energia(20) -< estr=energia(18) ---- -> edihcnstr=energia(19) -> estr=energia(17) -> Uconst=energia(20) -> esccor=energia(21) -272,279c938,945 -< write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1, -< & wvdwpp, -< & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1), -< & etors_d,wtor_d*fact(2),ehpb,wstrain, -< & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5), -< & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2), -< & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5), -< & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot ---- -> write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp, -> & estr,wbond,ebe,wang, -> & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, -> & ecorr,wcorr, -> & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, -> & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor, -> & edihcnstr,ebr*nss, -> & Uconst,etot -283c949 -< & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/ ---- -> & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ -301c967,968 -< & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ ---- -> & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ -> & 'UCONST= ',1pE16.6,' (Constraint energy)'/ -304,310c971,977 -< write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond, -< & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2, -< & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4), -< & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2), -< & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3), -< & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor, -< & edihcnstr,ebr*nss,etot ---- -> write (iout,10) evdw,wsc,evdw2,wscp,ees,welec, -> & estr,wbond,ebe,wang, -> & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, -> & ecorr,wcorr, -> & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, -> & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr, -> & ebr*nss,Uconst,etot -331c998,999 -< & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ ---- -> & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ -> & 'UCONST=',1pE16.6,' (Constraint energy)'/ -337c1005 -< subroutine elj(evdw,evdw_t) ---- -> subroutine elj(evdw) -344,345d1011 -< include 'DIMENSIONS.ZSCOPT' -< include "DIMENSIONS.COMPAR" -354d1019 -< include 'COMMON.ENEPS' -360,367c1025 -< integer icant -< external icant -< cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon -< do i=1,210 -< do j=1,2 -< eneps_temp(j,i)=0.0d0 -< enddo -< enddo ---- -> c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon -369d1026 -< evdw_t=0.0d0 -400,402d1056 -< ij=icant(itypi,itypj) -< eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij) -< eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij -409,414c1063 -< if (bb(itypi,itypj).gt.0.0d0) then -< evdw=evdw+evdwij -< else -< evdw_t=evdw_t+evdwij -< endif -< if (calc_grad) then ---- -> evdw=evdw+evdwij -424a1074,1075 -> gvdwc(k,i)=gvdwc(k,i)-gg(k) -> gvdwc(k,j)=gvdwc(k,j)+gg(k) -426,431c1077,1081 -< do k=i,j-1 -< do l=1,3 -< gvdwc(l,k)=gvdwc(l,k)+gg(l) -< enddo -< enddo -< endif ---- -> cgrad do k=i,j-1 -> cgrad do l=1,3 -> cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) -> cgrad enddo -> cgrad enddo -493d1142 -< if (calc_grad) then -500d1148 -< endif -513c1161 -< subroutine eljk(evdw,evdw_t) ---- -> subroutine eljk(evdw) -520,521d1167 -< include 'DIMENSIONS.ZSCOPT' -< include "DIMENSIONS.COMPAR" -528d1173 -< include 'COMMON.ENEPS' -533,534d1177 -< integer icant -< external icant -536,540d1178 -< do i=1,210 -< do j=1,2 -< eneps_temp(j,i)=0.0d0 -< enddo -< enddo -542d1179 -< evdw_t=0.0d0 -570,573d1206 -< ij=icant(itypi,itypj) -< eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm) -< & /dabs(eps(itypi,itypj)) -< eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj) -581,586c1214 -< if (bb(itypi,itypj).gt.0.0d0) then -< evdw=evdw+evdwij -< else -< evdw_t=evdw_t+evdwij -< endif -< if (calc_grad) then ---- -> evdw=evdw+evdwij -596a1225,1226 -> gvdwc(k,i)=gvdwc(k,i)-gg(k) -> gvdwc(k,j)=gvdwc(k,j)+gg(k) -598,603c1228,1232 -< do k=i,j-1 -< do l=1,3 -< gvdwc(l,k)=gvdwc(l,k)+gg(l) -< enddo -< enddo -< endif ---- -> cgrad do k=i,j-1 -> cgrad do l=1,3 -> cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) -> cgrad enddo -> cgrad enddo -607d1235 -< if (calc_grad) then -614d1241 -< endif -618c1245 -< subroutine ebp(evdw,evdw_t) ---- -> subroutine ebp(evdw) -625,626d1251 -< include 'DIMENSIONS.ZSCOPT' -< include "DIMENSIONS.COMPAR" -634d1258 -< include 'COMMON.ENEPS' -640,646d1263 -< integer icant -< external icant -< do i=1,210 -< do j=1,2 -< eneps_temp(j,i)=0.0d0 -< enddo -< enddo -648d1264 -< evdw_t=0.0d0 -649a1266 -> evdw=0.0D0 -665a1283 -> c dsci_inv=dsc_inv(itypi) -674a1293 -> c dscj_inv=dsc_inv(itypj) -719,729c1338 -< ij=icant(itypi,itypj) -< aux=eps1*eps2rt**2*eps3rt**2 -< eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux -< & /dabs(eps(itypi,itypj)) -< eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj) -< if (bb(itypi,itypj).gt.0.0d0) then -< evdw=evdw+evdwij -< else -< evdw_t=evdw_t+evdwij -< endif -< if (calc_grad) then ---- -> evdw=evdw+evdwij -752d1360 -< endif -760c1368 -< subroutine egb(evdw,evdw_t) ---- -> subroutine egb(evdw) -767,768d1374 -< include 'DIMENSIONS.ZSCOPT' -< include "DIMENSIONS.COMPAR" -776d1381 -< include 'COMMON.ENEPS' -778a1384 -> include 'COMMON.CONTROL' -780,787c1386,1387 -< common /srutu/icall -< integer icant -< external icant -< do i=1,210 -< do j=1,2 -< eneps_temp(j,i)=0.0d0 -< enddo -< enddo ---- -> evdw=0.0D0 -> ccccc energy_dec=.false. -790d1389 -< evdw_t=0.0d0 -792c1391 -< c if (icall.gt.0) lprn=.true. ---- -> c if (icall.eq.0) lprn=.false. -803a1403 -> c dsci_inv=dsc_inv(itypi) -804a1405,1406 -> c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -> c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -812a1415 -> c dscj_inv=dsc_inv(itypj) -813a1417,1419 -> c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -> c & 1.0d0/vbld(j+nres) -> c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) -840c1446,1448 -< c write (iout,*) i,j,xj,yj,zj ---- -> c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi -> c write (iout,*) "j",j," dc_norm", -> c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) -848a1457,1458 -> c for diagnostics; uncomment -> c rij_shift=1.2*sig0ij -851a1462,1464 -> cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -> cd & restyp(itypi),i,restyp(itypj),j, -> cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) -862a1476,1477 -> c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -> c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 -864,876c1479 -< if (bb(itypi,itypj).gt.0) then -< evdw=evdw+evdwij -< else -< evdw_t=evdw_t+evdwij -< endif -< ij=icant(itypi,itypj) -< aux=eps1*eps2rt**2*eps3rt**2 -< eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1 -< & /dabs(eps(itypi,itypj)) -< eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj) -< c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj, -< c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)), -< c & aux*e2/eps(itypi,itypj) ---- -> evdw=evdw+evdwij -887c1490,1493 -< if (calc_grad) then ---- -> -> if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') -> & 'evdw',i,j,evdwij -> -892a1499 -> c fac=0.0d0 -899d1505 -< endif -902a1509,1510 -> c write (iout,*) "Number of loop steps in EGB:",ind -> cccc energy_dec=.false. -906c1514 -< subroutine egbv(evdw,evdw_t) ---- -> subroutine egbv(evdw) -913,914d1520 -< include 'DIMENSIONS.ZSCOPT' -< include "DIMENSIONS.COMPAR" -922d1527 -< include 'COMMON.ENEPS' -927,933d1531 -< integer icant -< external icant -< do i=1,210 -< do j=1,2 -< eneps_temp(j,i)=0.0d0 -< enddo -< enddo -935d1532 -< evdw_t=0.0d0 -939c1536 -< c if (icall.gt.0) lprn=.true. ---- -> c if (icall.eq.0) lprn=.true. -950a1548 -> c dsci_inv=dsc_inv(itypi) -959a1558 -> c dscj_inv=dsc_inv(itypj) -1013,1016c1612,1622 -< if (bb(itypi,itypj).gt.0.0d0) then -< evdw=evdw+evdwij+e_augm -< else -< evdw_t=evdw_t+evdwij+e_augm ---- -> evdw=evdw+evdwij+e_augm -> if (lprn) then -> sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -> epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -> write (iout,'(2(a3,i3,2x),17(0pf7.3))') -> & restyp(itypi),i,restyp(itypj),j, -> & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0), -> & chi1,chi2,chip1,chip2, -> & eps1,eps2rt**2,eps3rt**2, -> & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -> & evdwij+e_augm -1018,1036d1623 -< ij=icant(itypi,itypj) -< aux=eps1*eps2rt**2*eps3rt**2 -< eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm) -< & /dabs(eps(itypi,itypj)) -< eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj) -< c eneps_temp(ij)=eneps_temp(ij) -< c & +(evdwij+e_augm)/eps(itypi,itypj) -< c if (lprn) then -< c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -< c epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -< c write (iout,'(2(a3,i3,2x),17(0pf7.3))') -< c & restyp(itypi),i,restyp(itypj),j, -< c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0), -< c & chi1,chi2,chip1,chip2, -< c & eps1,eps2rt**2,eps3rt**2, -< c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -< c & evdwij+e_augm -< c endif -< if (calc_grad) then -1048d1634 -< endif -1052d1637 -< return -1059a1645 -> include 'COMMON.IOUNITS' -1072a1659,1663 -> c diagnostics only -> c faceps1_inv=om12 -> c eps1=om12 -> c eps1_om12=1.0d0 -> c write (iout,*) "om12",om12," eps1",eps1 -1082a1674,1681 -> c diagnostics only -> c sigsq=1.0d0 -> c sigsq_om1=0.0d0 -> c sigsq_om2=0.0d0 -> c sigsq_om12=0.0d0 -> c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12 -> c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv, -> c & " eps1",eps1 -1089a1689,1690 -> c write (iout,*) "chipom1",chipom1," chipom2",chipom2, -> c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv -1098a1700,1702 -> c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt -> c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2, -> c & " eps2rt_om12",eps2rt_om12 -1107d1710 -< include 'DIMENSIONS.ZSCOPT' -1110a1714 -> include 'COMMON.IOUNITS' -1115a1720,1728 -> c diagnostics only -> c eom1=0.0d0 -> c eom2=0.0d0 -> c eom12=evdwij*eps1_om12 -> c end diagnostics -> c write (iout,*) "eps2der",eps2der," eps3der",eps3der, -> c & " sigder",sigder -> c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12 -> c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12 -1122a1736 -> c write (iout,*) "gg",(gg(k),k=1,3) -1129a1744,1747 -> c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) -> c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv -> c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) -> c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv -1134,1137c1752,1759 -< do k=i,j-1 -< do l=1,3 -< gvdwc(l,k)=gvdwc(l,k)+gg(l) -< enddo ---- -> cgrad do k=i,j-1 -> cgrad do l=1,3 -> cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) -> cgrad enddo -> cgrad enddo -> do l=1,3 -> gvdwc(l,i)=gvdwc(l,i)-gg(l) -> gvdwc(l,j)=gvdwc(l,j)+gg(l) -1141,1142c1763,1768 -< c------------------------------------------------------------------------------ -< subroutine vec_and_deriv ---- -> C----------------------------------------------------------------------- -> subroutine e_softsphere(evdw) -> C -> C This subroutine calculates the interaction energy of nonbonded side chains -> C assuming the LJ potential of interaction. -> C -1145,1146c1771 -< include 'DIMENSIONS.ZSCOPT' -< include 'COMMON.IOUNITS' ---- -> parameter (accur=1.0d-10) -1151d1775 -< include 'COMMON.VECTORS' -1154,1247c1778,1815 -< dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2) -< C Compute the local reference systems. For reference system (i), the -< C X-axis points from CA(i) to CA(i+1), the Y axis is in the -< C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane. -< do i=1,nres-1 -< c if (i.eq.nres-1 .or. itel(i+1).eq.0) then -< if (i.eq.nres-1) then -< C Case of the last full residue -< C Compute the Z-axis -< call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i)) -< costh=dcos(pi-theta(nres)) -< fac=1.0d0/dsqrt(1.0d0-costh*costh) -< do k=1,3 -< uz(k,i)=fac*uz(k,i) -< enddo -< if (calc_grad) then -< C Compute the derivatives of uz -< uzder(1,1,1)= 0.0d0 -< uzder(2,1,1)=-dc_norm(3,i-1) -< uzder(3,1,1)= dc_norm(2,i-1) -< uzder(1,2,1)= dc_norm(3,i-1) -< uzder(2,2,1)= 0.0d0 -< uzder(3,2,1)=-dc_norm(1,i-1) -< uzder(1,3,1)=-dc_norm(2,i-1) -< uzder(2,3,1)= dc_norm(1,i-1) -< uzder(3,3,1)= 0.0d0 -< uzder(1,1,2)= 0.0d0 -< uzder(2,1,2)= dc_norm(3,i) -< uzder(3,1,2)=-dc_norm(2,i) -< uzder(1,2,2)=-dc_norm(3,i) -< uzder(2,2,2)= 0.0d0 -< uzder(3,2,2)= dc_norm(1,i) -< uzder(1,3,2)= dc_norm(2,i) -< uzder(2,3,2)=-dc_norm(1,i) -< uzder(3,3,2)= 0.0d0 -< endif -< C Compute the Y-axis -< facy=fac -< do k=1,3 -< uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i)) -< enddo -< if (calc_grad) then -< C Compute the derivatives of uy -< do j=1,3 -< do k=1,3 -< uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) -< & -dc_norm(k,i)*dc_norm(j,i-1) -< uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i) -< enddo -< uyder(j,j,1)=uyder(j,j,1)-costh -< uyder(j,j,2)=1.0d0+uyder(j,j,2) -< enddo -< do j=1,2 -< do k=1,3 -< do l=1,3 -< uygrad(l,k,j,i)=uyder(l,k,j) -< uzgrad(l,k,j,i)=uzder(l,k,j) -< enddo -< enddo -< enddo -< call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i)) -< call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i)) -< call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i)) -< call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i)) -< endif -< else -< C Other residues -< C Compute the Z-axis -< call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i)) -< costh=dcos(pi-theta(i+2)) -< fac=1.0d0/dsqrt(1.0d0-costh*costh) -< do k=1,3 -< uz(k,i)=fac*uz(k,i) -< enddo -< if (calc_grad) then -< C Compute the derivatives of uz -< uzder(1,1,1)= 0.0d0 -< uzder(2,1,1)=-dc_norm(3,i+1) -< uzder(3,1,1)= dc_norm(2,i+1) -< uzder(1,2,1)= dc_norm(3,i+1) -< uzder(2,2,1)= 0.0d0 -< uzder(3,2,1)=-dc_norm(1,i+1) -< uzder(1,3,1)=-dc_norm(2,i+1) -< uzder(2,3,1)= dc_norm(1,i+1) -< uzder(3,3,1)= 0.0d0 -< uzder(1,1,2)= 0.0d0 -< uzder(2,1,2)= dc_norm(3,i) -< uzder(3,1,2)=-dc_norm(2,i) -< uzder(1,2,2)=-dc_norm(3,i) -< uzder(2,2,2)= 0.0d0 -< uzder(3,2,2)= dc_norm(1,i) -< uzder(1,3,2)= dc_norm(2,i) -< uzder(2,3,2)=-dc_norm(1,i) -< uzder(3,3,2)= 0.0d0 ---- -> include 'COMMON.TORSION' -> include 'COMMON.SBRIDGE' -> include 'COMMON.NAMES' -> include 'COMMON.IOUNITS' -> include 'COMMON.CONTACTS' -> dimension gg(3) -> cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct -> evdw=0.0D0 -> do i=iatsc_s,iatsc_e -> itypi=itype(i) -> if (itypi.eq.21) cycle -> itypi1=itype(i+1) -> xi=c(1,nres+i) -> yi=c(2,nres+i) -> zi=c(3,nres+i) -> C -> C Calculate SC interaction energy. -> C -> do iint=1,nint_gr(i) -> cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), -> cd & 'iend=',iend(i,iint) -> do j=istart(i,iint),iend(i,iint) -> itypj=itype(j) -> if (itypj.eq.21) cycle -> xj=c(1,nres+j)-xi -> yj=c(2,nres+j)-yi -> zj=c(3,nres+j)-zi -> rij=xj*xj+yj*yj+zj*zj -> c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj -> r0ij=r0(itypi,itypj) -> r0ijsq=r0ij*r0ij -> c print *,i,j,r0ij,dsqrt(rij) -> if (rij.lt.r0ijsq) then -> evdwij=0.25d0*(rij-r0ijsq)**2 -> fac=rij-r0ijsq -> else -> evdwij=0.0d0 -> fac=0.0d0 -1249,1250c1817,1823 -< C Compute the Y-axis -< facy=fac ---- -> evdw=evdw+evdwij -> C -> C Calculate the components of the gradient in DC and X -> C -> gg(1)=xj*fac -> gg(2)=yj*fac -> gg(3)=zj*fac -1252,1263c1825,1828 -< uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i)) -< enddo -< if (calc_grad) then -< C Compute the derivatives of uy -< do j=1,3 -< do k=1,3 -< uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) -< & -dc_norm(k,i)*dc_norm(j,i+1) -< uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i) -< enddo -< uyder(j,j,1)=uyder(j,j,1)-costh -< uyder(j,j,2)=1.0d0+uyder(j,j,2) ---- -> gvdwx(k,i)=gvdwx(k,i)-gg(k) -> gvdwx(k,j)=gvdwx(k,j)+gg(k) -> gvdwc(k,i)=gvdwc(k,i)-gg(k) -> gvdwc(k,j)=gvdwc(k,j)+gg(k) -1265,1277c1830,1898 -< do j=1,2 -< do k=1,3 -< do l=1,3 -< uygrad(l,k,j,i)=uyder(l,k,j) -< uzgrad(l,k,j,i)=uzder(l,k,j) -< enddo -< enddo -< enddo -< call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i)) -< call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i)) -< call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i)) -< call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i)) -< endif ---- -> cgrad do k=i,j-1 -> cgrad do l=1,3 -> cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) -> cgrad enddo -> cgrad enddo -> enddo ! j -> enddo ! iint -> enddo ! i -> return -> end -> C-------------------------------------------------------------------------- -> subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, -> & eello_turn4) -> C -> C Soft-sphere potential of p-p interaction -> C -> implicit real*8 (a-h,o-z) -> include 'DIMENSIONS' -> include 'COMMON.CONTROL' -> include 'COMMON.IOUNITS' -> include 'COMMON.GEO' -> include 'COMMON.VAR' -> include 'COMMON.LOCAL' -> include 'COMMON.CHAIN' -> include 'COMMON.DERIV' -> include 'COMMON.INTERACT' -> include 'COMMON.CONTACTS' -> include 'COMMON.TORSION' -> include 'COMMON.VECTORS' -> include 'COMMON.FFIELD' -> dimension ggg(3) -> cd write(iout,*) 'In EELEC_soft_sphere' -> ees=0.0D0 -> evdw1=0.0D0 -> eel_loc=0.0d0 -> eello_turn3=0.0d0 -> eello_turn4=0.0d0 -> ind=0 -> do i=iatel_s,iatel_e -> if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle -> dxi=dc(1,i) -> dyi=dc(2,i) -> dzi=dc(3,i) -> xmedi=c(1,i)+0.5d0*dxi -> ymedi=c(2,i)+0.5d0*dyi -> zmedi=c(3,i)+0.5d0*dzi -> num_conti=0 -> c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) -> do j=ielstart(i),ielend(i) -> if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle -> ind=ind+1 -> iteli=itel(i) -> itelj=itel(j) -> if (j.eq.i+2 .and. itelj.eq.2) iteli=2 -> r0ij=rpp(iteli,itelj) -> r0ijsq=r0ij*r0ij -> dxj=dc(1,j) -> dyj=dc(2,j) -> dzj=dc(3,j) -> xj=c(1,j)+0.5D0*dxj-xmedi -> yj=c(2,j)+0.5D0*dyj-ymedi -> zj=c(3,j)+0.5D0*dzj-zmedi -> rij=xj*xj+yj*yj+zj*zj -> if (rij.lt.r0ijsq) then -> evdw1ij=0.25d0*(rij-r0ijsq)**2 -> fac=rij-r0ijsq -> else -> evdw1ij=0.0d0 -> fac=0.0d0 -1279,1288c1900,1906 -< enddo -< if (calc_grad) then -< do i=1,nres-1 -< vbld_inv_temp(1)=vbld_inv(i+1) -< if (i.lt.nres-1) then -< vbld_inv_temp(2)=vbld_inv(i+2) -< else -< vbld_inv_temp(2)=vbld_inv(i) -< endif -< do j=1,2 ---- -> evdw1=evdw1+evdw1ij -> C -> C Calculate contributions to the Cartesian gradient. -> C -> ggg(1)=fac*xj -> ggg(2)=fac*yj -> ggg(3)=fac*zj -1290,1293c1908,1909 -< do l=1,3 -< uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i) -< uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i) -< enddo ---- -> gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) -> gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) -1295,1297c1911,1930 -< enddo -< enddo -< endif ---- -> * -> * Loop over residues i+1 thru j-1. -> * -> cgrad do k=i+1,j-1 -> cgrad do l=1,3 -> cgrad gelc(l,k)=gelc(l,k)+ggg(l) -> cgrad enddo -> cgrad enddo -> enddo ! j -> enddo ! i -> cgrad do i=nnt,nct-1 -> cgrad do k=1,3 -> cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i) -> cgrad enddo -> cgrad do j=i+1,nct-1 -> cgrad do k=1,3 -> cgrad gelc(k,i)=gelc(k,i)+gelc(k,j) -> cgrad enddo -> cgrad enddo -> cgrad enddo -1300,1301c1933,1934 -< C----------------------------------------------------------------------------- -< subroutine vec_and_deriv_test ---- -> c------------------------------------------------------------------------------ -> subroutine vec_and_deriv -1304c1937,1939 -< include 'DIMENSIONS.ZSCOPT' ---- -> #ifdef MPI -> include 'mpif.h' -> #endif -1311c1946,1948 -< dimension uyder(3,3,2),uzder(3,3,2) ---- -> include 'COMMON.SETUP' -> include 'COMMON.TIME1' -> dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2) -1314a1952,1954 -> #ifdef PARVEC -> do i=ivec_start,ivec_end -> #else -1315a1956 -> #endif -1322,1324d1962 -< c write (iout,*) 'fac',fac, -< c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i))) -< fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i))) -1348,1350d1985 -< do k=1,3 -< uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i)) -< enddo -1352,1365d1986 -< facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))* -< & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2- -< & scalar(dc_norm(1,i),dc_norm(1,i-1))**2)) -< do k=1,3 -< c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i)) -< uy(k,i)= -< c & facy*( -< & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i)) -< & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i) -< c & ) -< enddo -< c write (iout,*) 'facy',facy, -< c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i))) -< facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i))) -1367c1988 -< uy(k,i)=facy*uy(k,i) ---- -> uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i)) -1376,1381c1997,1998 -< c uyder(j,j,1)=uyder(j,j,1)-costh -< c uyder(j,j,2)=1.0d0+uyder(j,j,2) -< uyder(j,j,1)=uyder(j,j,1) -< & -scalar(dc_norm(1,i),dc_norm(1,i-1)) -< uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i)) -< & +uyder(j,j,2) ---- -> uyder(j,j,1)=uyder(j,j,1)-costh -> uyder(j,j,2)=1.0d0+uyder(j,j,2) -1401d2017 -< fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i))) -1426,1439d2041 -< facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))* -< & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2- -< & scalar(dc_norm(1,i),dc_norm(1,i+1))**2)) -< do k=1,3 -< c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i)) -< uy(k,i)= -< c & facy*( -< & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i)) -< & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i) -< c & ) -< enddo -< c write (iout,*) 'facy',facy, -< c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i))) -< facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i))) -1441c2043 -< uy(k,i)=facy*uy(k,i) ---- -> uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i)) -1450,1455c2052,2053 -< c uyder(j,j,1)=uyder(j,j,1)-costh -< c uyder(j,j,2)=1.0d0+uyder(j,j,2) -< uyder(j,j,1)=uyder(j,j,1) -< & -scalar(dc_norm(1,i),dc_norm(1,i+1)) -< uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i)) -< & +uyder(j,j,2) ---- -> uyder(j,j,1)=uyder(j,j,1)-costh -> uyder(j,j,2)=1.0d0+uyder(j,j,2) -1471a2070,2075 -> vbld_inv_temp(1)=vbld_inv(i+1) -> if (i.lt.nres-1) then -> vbld_inv_temp(2)=vbld_inv(i+2) -> else -> vbld_inv_temp(2)=vbld_inv(i) -> endif -1475,1476c2079,2080 -< uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i) -< uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i) ---- -> uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i) -> uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i) -1480a2085,2112 -> #if defined(PARVEC) && defined(MPI) -> if (nfgtasks1.gt.1) then -> time00=MPI_Wtime() -> c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start, -> c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1), -> c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1) -> call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1), -> & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1), -> & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(uygrad(1,1,1,ivec_start), -> & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0), -> & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR) -> call MPI_Allgatherv(uzgrad(1,1,1,ivec_start), -> & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0), -> & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR) -> time_gather=time_gather+MPI_Wtime()-time00 -> endif -> c if (fg_rank.eq.0) then -> c write (iout,*) "Arrays UY and UZ" -> c do i=1,nres-1 -> c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3), -> c & (uz(k,i),k=1,3) -> c enddo -> c endif -> #endif -1487d2118 -< include 'DIMENSIONS.ZSCOPT' -1572c2203,2208 -< include 'DIMENSIONS.ZSCOPT' ---- -> #ifdef MPI -> include "mpif.h" -> include "COMMON.SETUP" -> integer IERR -> integer status(MPI_STATUS_SIZE) -> #endif -1588a2225,2227 -> #ifdef PARMAT -> do i=ivec_start+2,ivec_end+2 -> #else -1589a2229 -> #endif -1655a2296 -> c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then -1657,1661c2298 -< if (itype(i-2).le.ntyp) then -< iti = itortyp(itype(i-2)) -< else -< iti=ntortyp+1 -< endif ---- -> iti = itortyp(itype(i-2)) -1664a2302 -> c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then -1666,1670c2304 -< if (itype(i-1).le.ntyp) then -< iti1 = itortyp(itype(i-1)) -< else -< iti1=ntortyp+1 -< endif ---- -> iti1 = itortyp(itype(i-1)) -1678,1679c2312,2313 -< c print *,"itilde1 i iti iti1",i,iti,iti1 -< if (i .gt. iatel_s+2) then ---- -> c if (i .gt. iatel_s+2) then -> if (i .gt. nnt+2) then -1681a2316,2317 -> if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) -> & then -1686a2323 -> endif -1700d2336 -< c print *,"itilde2 i iti iti1",i,iti,iti1 -1703,1708d2338 -< call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2)) -< call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2)) -< call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2)) -< call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2)) -< call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2)) -< c print *,"itilde3 i iti iti1",i,iti,iti1 -1711a2342 -> c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then -1713,1717c2344 -< if (itype(i-1).le.ntyp) then -< iti1 = itortyp(itype(i-1)) -< else -< iti1=ntortyp+1 -< endif ---- -> iti1 = itortyp(itype(i-1)) -1723a2351,2360 -> cd write (iout,*) 'mu ',mu(:,i-2) -> cd write (iout,*) 'mu1',mu1(:,i-2) -> cd write (iout,*) 'mu2',mu2(:,i-2) -> if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) -> & then -> call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2)) -> call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2)) -> call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2)) -> call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2)) -> call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2)) -1734,1735c2371 -< cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2), -< cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2) ---- -> endif -1738a2375,2377 -> if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) -> &then -> c do i=max0(ivec_start,2),ivec_end -1748a2388,2636 -> endif -> #if defined(MPI) && defined(PARMAT) -> #ifdef DEBUG -> c if (fg_rank.eq.0) then -> write (iout,*) "Arrays UG and UGDER before GATHER" -> do i=1,nres-1 -> write (iout,'(i5,4f10.5,5x,4f10.5)') i, -> & ((ug(l,k,i),l=1,2),k=1,2), -> & ((ugder(l,k,i),l=1,2),k=1,2) -> enddo -> write (iout,*) "Arrays UG2 and UG2DER" -> do i=1,nres-1 -> write (iout,'(i5,4f10.5,5x,4f10.5)') i, -> & ((ug2(l,k,i),l=1,2),k=1,2), -> & ((ug2der(l,k,i),l=1,2),k=1,2) -> enddo -> write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER" -> do i=1,nres-1 -> write (iout,'(i5,4f10.5,5x,4f10.5)') i, -> & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2), -> & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2) -> enddo -> write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2" -> do i=1,nres-1 -> write (iout,'(i5,4f10.5,5x,4f10.5)') i, -> & costab(i),sintab(i),costab2(i),sintab2(i) -> enddo -> write (iout,*) "Array MUDER" -> do i=1,nres-1 -> write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i) -> enddo -> c endif -> #endif -> if (nfgtasks.gt.1) then -> time00=MPI_Wtime() -> c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start, -> c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1), -> c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1) -> #ifdef MATGATHER -> call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1), -> & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1), -> & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1), -> & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1), -> & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1), -> & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1), -> & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1), -> & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0), -> & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -> call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1), -> & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0), -> & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -> call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1), -> & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0), -> & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -> call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1), -> & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0), -> & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -> if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) -> & then -> call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1), -> & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1), -> & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1), -> & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1), -> & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1), -> & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(Ug2Db1tder(1,ivec_start), -> & ivec_count(fg_rank1), -> & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1), -> & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1), -> & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1), -> & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1), -> & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1), -> & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1), -> & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1), -> & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(Dtug2der(1,1,ivec_start), -> & ivec_count(fg_rank1), -> & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1), -> & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1), -> & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1), -> & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1), -> & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start), -> & ivec_count(fg_rank1), -> & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start), -> & ivec_count(fg_rank1), -> & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, -> & FG_COMM1,IERR) -> call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start), -> & ivec_count(fg_rank1), -> & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0), -> & MPI_MAT2,FG_COMM1,IERR) -> call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start), -> & ivec_count(fg_rank1), -> & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0), -> & MPI_MAT2,FG_COMM1,IERR) -> endif -> #else -> c Passes matrix info through the ring -> isend=fg_rank1 -> irecv=fg_rank1-1 -> if (irecv.lt.0) irecv=nfgtasks1-1 -> iprev=irecv -> inext=fg_rank1+1 -> if (inext.ge.nfgtasks1) inext=0 -> do i=1,nfgtasks1-1 -> c write (iout,*) "isend",isend," irecv",irecv -> c call flush(iout) -> lensend=lentyp(isend) -> lenrecv=lentyp(irecv) -> c write (iout,*) "lensend",lensend," lenrecv",lenrecv -> c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1, -> c & MPI_ROTAT1(lensend),inext,2200+isend, -> c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv), -> c & iprev,2200+irecv,FG_COMM,status,IERR) -> c write (iout,*) "Gather ROTAT1" -> c call flush(iout) -> c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1, -> c & MPI_ROTAT2(lensend),inext,3300+isend, -> c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv), -> c & iprev,3300+irecv,FG_COMM,status,IERR) -> c write (iout,*) "Gather ROTAT2" -> c call flush(iout) -> call MPI_SENDRECV(costab(ivec_displ(isend)+1),1, -> & MPI_ROTAT_OLD(lensend),inext,4400+isend, -> & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv), -> & iprev,4400+irecv,FG_COMM,status,IERR) -> c write (iout,*) "Gather ROTAT_OLD" -> c call flush(iout) -> call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1, -> & MPI_PRECOMP11(lensend),inext,5500+isend, -> & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv), -> & iprev,5500+irecv,FG_COMM,status,IERR) -> c write (iout,*) "Gather PRECOMP11" -> c call flush(iout) -> call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1, -> & MPI_PRECOMP12(lensend),inext,6600+isend, -> & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv), -> & iprev,6600+irecv,FG_COMM,status,IERR) -> c write (iout,*) "Gather PRECOMP12" -> c call flush(iout) -> if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) -> & then -> call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1, -> & MPI_ROTAT2(lensend),inext,7700+isend, -> & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv), -> & iprev,7700+irecv,FG_COMM,status,IERR) -> c write (iout,*) "Gather PRECOMP21" -> c call flush(iout) -> call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1, -> & MPI_PRECOMP22(lensend),inext,8800+isend, -> & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv), -> & iprev,8800+irecv,FG_COMM,status,IERR) -> c write (iout,*) "Gather PRECOMP22" -> c call flush(iout) -> call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1, -> & MPI_PRECOMP23(lensend),inext,9900+isend, -> & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1, -> & MPI_PRECOMP23(lenrecv), -> & iprev,9900+irecv,FG_COMM,status,IERR) -> c write (iout,*) "Gather PRECOMP23" -> c call flush(iout) -> endif -> isend=irecv -> irecv=irecv-1 -> if (irecv.lt.0) irecv=nfgtasks1-1 -> enddo -> #endif -> time_gather=time_gather+MPI_Wtime()-time00 -> endif -> #ifdef DEBUG -> c if (fg_rank.eq.0) then -> write (iout,*) "Arrays UG and UGDER" -> do i=1,nres-1 -> write (iout,'(i5,4f10.5,5x,4f10.5)') i, -> & ((ug(l,k,i),l=1,2),k=1,2), -> & ((ugder(l,k,i),l=1,2),k=1,2) -> enddo -> write (iout,*) "Arrays UG2 and UG2DER" -> do i=1,nres-1 -> write (iout,'(i5,4f10.5,5x,4f10.5)') i, -> & ((ug2(l,k,i),l=1,2),k=1,2), -> & ((ug2der(l,k,i),l=1,2),k=1,2) -> enddo -> write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER" -> do i=1,nres-1 -> write (iout,'(i5,4f10.5,5x,4f10.5)') i, -> & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2), -> & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2) -> enddo -> write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2" -> do i=1,nres-1 -> write (iout,'(i5,4f10.5,5x,4f10.5)') i, -> & costab(i),sintab(i),costab2(i),sintab2(i) -> enddo -> write (iout,*) "Array MUDER" -> do i=1,nres-1 -> write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i) -> enddo -> c endif -> #endif -> #endif -1768a2657,2659 -> #ifdef MPI -> include 'mpif.h' -> #endif -1770d2660 -< include 'DIMENSIONS.ZSCOPT' -1771a2662 -> include 'COMMON.SETUP' -1782a2674 -> include 'COMMON.TIME1' -1787c2679,2681 -< common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1 ---- -> common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, -> & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, -> & num_conti,j1,j2 -1788a2683,2685 -> #ifdef MOMENT -> double precision scal_el /1.0d0/ -> #else -1789a2687 -> #endif -1818,1823c2716,2719 -< cd if (wel_loc.gt.0.0d0) then -< if (icheckgrad.eq.1) then -< call vec_and_deriv_test -< else -< call vec_and_deriv -< endif ---- -> c call vec_and_deriv -> #ifdef TIMING -> time01=MPI_Wtime() -> #endif -1824a2721,2723 -> #ifdef TIMING -> time_mat=time_mat+MPI_Wtime()-time01 -> #endif -1829c2728 -< cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i) ---- -> cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i) -1836c2735 -< num_conti_hb=0 ---- -> t_eelecij=0.0d0 -1851a2751,2795 -> c -> c -> c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms -> C -> C Loop over i,i+2 and i,i+3 pairs of the peptide groups -> C -> do i=iturn3_start,iturn3_end -> if (itype(i).eq.21 .or. itype(i+1).eq.21 -> & .or. itype(i+2).eq.21 .or. itype(i+3).eq.21) cycle -> dxi=dc(1,i) -> dyi=dc(2,i) -> dzi=dc(3,i) -> dx_normi=dc_norm(1,i) -> dy_normi=dc_norm(2,i) -> dz_normi=dc_norm(3,i) -> xmedi=c(1,i)+0.5d0*dxi -> ymedi=c(2,i)+0.5d0*dyi -> zmedi=c(3,i)+0.5d0*dzi -> num_conti=0 -> call eelecij(i,i+2,ees,evdw1,eel_loc) -> if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3) -> num_cont_hb(i)=num_conti -> enddo -> do i=iturn4_start,iturn4_end -> if (itype(i).eq.21 .or. itype(i+1).eq.21 -> & .or. itype(i+3).eq.21 -> & .or. itype(i+4).eq.21) cycle -> dxi=dc(1,i) -> dyi=dc(2,i) -> dzi=dc(3,i) -> dx_normi=dc_norm(1,i) -> dy_normi=dc_norm(2,i) -> dz_normi=dc_norm(3,i) -> xmedi=c(1,i)+0.5d0*dxi -> ymedi=c(2,i)+0.5d0*dyi -> zmedi=c(3,i)+0.5d0*dzi -> num_conti=num_cont_hb(i) -> call eelecij(i,i+3,ees,evdw1,eel_loc) -> if (wturn4.gt.0.0d0 .and. itype(i+2).ne.21) -> & call eturn4(i,eello_turn4) -> num_cont_hb(i)=num_conti -> enddo ! i -> c -> c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 -> c -1854d2797 -< if (itel(i).eq.0) goto 1215 -1864d2806 -< num_conti=0 -1865a2808 -> num_conti=num_cont_hb(i) -1866a2810 -> c write (iout,*) i,j,itype(i),itype(j) -1868,1869c2812,2866 -< if (itel(j).eq.0) goto 1216 -< ind=ind+1 ---- -> call eelecij(i,j,ees,evdw1,eel_loc) -> enddo ! j -> num_cont_hb(i)=num_conti -> enddo ! i -> c write (iout,*) "Number of loop steps in EELEC:",ind -> cd do i=1,nres -> cd write (iout,'(i3,3f10.5,5x,3f10.5)') -> cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i) -> cd enddo -> c 12/7/99 Adam eello_turn3 will be considered as a separate energy term -> ccc eel_loc=eel_loc+eello_turn3 -> cd print *,"Processor",fg_rank," t_eelecij",t_eelecij -> return -> end -> C------------------------------------------------------------------------------- -> subroutine eelecij(i,j,ees,evdw1,eel_loc) -> implicit real*8 (a-h,o-z) -> include 'DIMENSIONS' -> #ifdef MPI -> include "mpif.h" -> #endif -> include 'COMMON.CONTROL' -> include 'COMMON.IOUNITS' -> include 'COMMON.GEO' -> include 'COMMON.VAR' -> include 'COMMON.LOCAL' -> include 'COMMON.CHAIN' -> include 'COMMON.DERIV' -> include 'COMMON.INTERACT' -> include 'COMMON.CONTACTS' -> include 'COMMON.TORSION' -> include 'COMMON.VECTORS' -> include 'COMMON.FFIELD' -> include 'COMMON.TIME1' -> dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), -> & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) -> double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), -> & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4) -> common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, -> & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, -> & num_conti,j1,j2 -> c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions -> #ifdef MOMENT -> double precision scal_el /1.0d0/ -> #else -> double precision scal_el /0.5d0/ -> #endif -> C 12/13/98 -> C 13-go grudnia roku pamietnego... -> double precision unmat(3,3) /1.0d0,0.0d0,0.0d0, -> & 0.0d0,1.0d0,0.0d0, -> & 0.0d0,0.0d0,1.0d0/ -> c time00=MPI_Wtime() -> cd write (iout,*) "eelecij",i,j -> c ind=ind+1 -1875,1880d2871 -< C Diagnostics only!!! -< c aaa=0.0D0 -< c bbb=0.0D0 -< c ael6i=0.0D0 -< c ael3i=0.0D0 -< C End diagnostics -1912d2902 -< c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij -1920a2911,2916 -> -> if (energy_dec) then -> write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij -> write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij -> endif -> -1925c2921 -< facvdw=-6*rrmij*(ev1+evdwij) ---- -> facvdw=-6*rrmij*(ev1+evdwij) -1931d2926 -< if (calc_grad) then -1934c2929 -< * ---- -> * -1937a2933,2938 -> c do k=1,3 -> c ghalf=0.5D0*ggg(k) -> c gelc(k,i)=gelc(k,i)+ghalf -> c gelc(k,j)=gelc(k,j)+ghalf -> c enddo -> c 9/28/08 AL Gradient compotents will be summed only at the end -1939,1941c2940,2941 -< ghalf=0.5D0*ggg(k) -< gelc(k,i)=gelc(k,i)+ghalf -< gelc(k,j)=gelc(k,j)+ghalf ---- -> gelc_long(k,j)=gelc_long(k,j)+ggg(k) -> gelc_long(k,i)=gelc_long(k,i)-ggg(k) -1946,1950c2946,2950 -< do k=i+1,j-1 -< do l=1,3 -< gelc(l,k)=gelc(l,k)+ggg(l) -< enddo -< enddo ---- -> cgrad do k=i+1,j-1 -> cgrad do l=1,3 -> cgrad gelc(l,k)=gelc(l,k)+ggg(l) -> cgrad enddo -> cgrad enddo -1953a2954,2959 -> c do k=1,3 -> c ghalf=0.5D0*ggg(k) -> c gvdwpp(k,i)=gvdwpp(k,i)+ghalf -> c gvdwpp(k,j)=gvdwpp(k,j)+ghalf -> c enddo -> c 9/28/08 AL Gradient compotents will be summed only at the end -1955,1957c2961,2962 -< ghalf=0.5D0*ggg(k) -< gvdwpp(k,i)=gvdwpp(k,i)+ghalf -< gvdwpp(k,j)=gvdwpp(k,j)+ghalf ---- -> gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) -> gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) -1962,1966c2967,2971 -< do k=i+1,j-1 -< do l=1,3 -< gvdwpp(l,k)=gvdwpp(l,k)+ggg(l) -< enddo -< enddo ---- -> cgrad do k=i+1,j-1 -> cgrad do l=1,3 -> cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l) -> cgrad enddo -> cgrad enddo -1975d2979 -< if (calc_grad) then -1981a2986,2991 -> c do k=1,3 -> c ghalf=0.5D0*ggg(k) -> c gelc(k,i)=gelc(k,i)+ghalf -> c gelc(k,j)=gelc(k,j)+ghalf -> c enddo -> c 9/28/08 AL Gradient compotents will be summed only at the end -1983,1985c2993,2994 -< ghalf=0.5D0*ggg(k) -< gelc(k,i)=gelc(k,i)+ghalf -< gelc(k,j)=gelc(k,j)+ghalf ---- -> gelc_long(k,j)=gelc(k,j)+ggg(k) -> gelc_long(k,i)=gelc(k,i)-ggg(k) -1990,1993c2999,3010 -< do k=i+1,j-1 -< do l=1,3 -< gelc(l,k)=gelc(l,k)+ggg(l) -< enddo ---- -> cgrad do k=i+1,j-1 -> cgrad do l=1,3 -> cgrad gelc(l,k)=gelc(l,k)+ggg(l) -> cgrad enddo -> cgrad enddo -> c 9/28/08 AL Gradient compotents will be summed only at the end -> ggg(1)=facvdw*xj -> ggg(2)=facvdw*yj -> ggg(3)=facvdw*zj -> do k=1,3 -> gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) -> gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) -2012a3030,3043 -> c do k=1,3 -> c ghalf=0.5D0*ggg(k) -> c gelc(k,i)=gelc(k,i)+ghalf -> c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) -> c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) -> c gelc(k,j)=gelc(k,j)+ghalf -> c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) -> c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) -> c enddo -> cgrad do k=i+1,j-1 -> cgrad do l=1,3 -> cgrad gelc(l,k)=gelc(l,k)+ggg(l) -> cgrad enddo -> cgrad enddo -2014,2015c3045 -< ghalf=0.5D0*ggg(k) -< gelc(k,i)=gelc(k,i)+ghalf ---- -> gelc(k,i)=gelc(k,i) -2018c3048 -< gelc(k,j)=gelc(k,j)+ghalf ---- -> gelc(k,j)=gelc(k,j) -2020a3051,3052 -> gelc_long(k,j)=gelc_long(k,j)+ggg(k) -> gelc_long(k,i)=gelc_long(k,i)-ggg(k) -2022,2028d3053 -< do k=i+1,j-1 -< do l=1,3 -< gelc(l,k)=gelc(l,k)+ggg(l) -< enddo -< enddo -< endif -< -2064,2068d3088 -< C For diagnostics only -< cd a22=1.0d0 -< cd a23=1.0d0 -< cd a32=1.0d0 -< cd a33=1.0d0 -2070,2072d3089 -< cd write (2,*) 'fac=',fac -< C For diagnostics only -< cd fac=1.0d0 -2080,2081c3097,3098 -< cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3), -< cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3) ---- -> cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i), -> cd & uy(:,j),uz(:,j) -2086c3103 -< cd write (iout,'(2i3,9f10.5/)') i,j, ---- -> cd write (iout,'(9f10.5/)') -2088d3104 -< if (calc_grad) then -2090,2095c3106 -< call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1)) -< cd do k=1,3 -< cd do l=1,3 -< cd erder(k,l)=0.0d0 -< cd enddo -< cd enddo ---- -> call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1)) -2110,2117d3120 -< cd do k=1,3 -< cd do l=1,3 -< cd uryg(k,l)=0.0d0 -< cd urzg(k,l)=0.0d0 -< cd vryg(k,l)=0.0d0 -< cd vrzg(k,l)=0.0d0 -< cd enddo -< cd enddo -2124,2127d3126 -< cd a22der=0.0d0 -< cd a23der=0.0d0 -< cd a32der=0.0d0 -< cd a33der=0.0d0 -2150,2153c3149,3152 -< ghalf1=0.5d0*agg(k,1) -< ghalf2=0.5d0*agg(k,2) -< ghalf3=0.5d0*agg(k,3) -< ghalf4=0.5d0*agg(k,4) ---- -> cgrad ghalf1=0.5d0*agg(k,1) -> cgrad ghalf2=0.5d0*agg(k,2) -> cgrad ghalf3=0.5d0*agg(k,3) -> cgrad ghalf4=0.5d0*agg(k,4) -2155c3154 -< & -3.0d0*uryg(k,2)*vry)+ghalf1 ---- -> & -3.0d0*uryg(k,2)*vry)!+ghalf1 -2157c3156 -< & -3.0d0*uryg(k,2)*vrz)+ghalf2 ---- -> & -3.0d0*uryg(k,2)*vrz)!+ghalf2 -2159c3158 -< & -3.0d0*urzg(k,2)*vry)+ghalf3 ---- -> & -3.0d0*urzg(k,2)*vry)!+ghalf3 -2161c3160 -< & -3.0d0*urzg(k,2)*vrz)+ghalf4 ---- -> & -3.0d0*urzg(k,2)*vrz)!+ghalf4 -2164c3163 -< & -3.0d0*uryg(k,3)*vry)+agg(k,1) ---- -> & -3.0d0*uryg(k,3)*vry)!+agg(k,1) -2166c3165 -< & -3.0d0*uryg(k,3)*vrz)+agg(k,2) ---- -> & -3.0d0*uryg(k,3)*vrz)!+agg(k,2) -2168c3167 -< & -3.0d0*urzg(k,3)*vry)+agg(k,3) ---- -> & -3.0d0*urzg(k,3)*vry)!+agg(k,3) -2170c3169 -< & -3.0d0*urzg(k,3)*vrz)+agg(k,4) ---- -> & -3.0d0*urzg(k,3)*vrz)!+agg(k,4) -2173c3172 -< & -3.0d0*vryg(k,2)*ury)+ghalf1 ---- -> & -3.0d0*vryg(k,2)*ury)!+ghalf1 -2175c3174 -< & -3.0d0*vrzg(k,2)*ury)+ghalf2 ---- -> & -3.0d0*vrzg(k,2)*ury)!+ghalf2 -2177c3176 -< & -3.0d0*vryg(k,2)*urz)+ghalf3 ---- -> & -3.0d0*vryg(k,2)*urz)!+ghalf3 -2179c3178 -< & -3.0d0*vrzg(k,2)*urz)+ghalf4 ---- -> & -3.0d0*vrzg(k,2)*urz)!+ghalf4 -2189,2213c3188,3192 -< cd aggi(k,1)=ghalf1 -< cd aggi(k,2)=ghalf2 -< cd aggi(k,3)=ghalf3 -< cd aggi(k,4)=ghalf4 -< C Derivatives in DC(i+1) -< cd aggi1(k,1)=agg(k,1) -< cd aggi1(k,2)=agg(k,2) -< cd aggi1(k,3)=agg(k,3) -< cd aggi1(k,4)=agg(k,4) -< C Derivatives in DC(j) -< cd aggj(k,1)=ghalf1 -< cd aggj(k,2)=ghalf2 -< cd aggj(k,3)=ghalf3 -< cd aggj(k,4)=ghalf4 -< C Derivatives in DC(j+1) -< cd aggj1(k,1)=0.0d0 -< cd aggj1(k,2)=0.0d0 -< cd aggj1(k,3)=0.0d0 -< cd aggj1(k,4)=0.0d0 -< if (j.eq.nres-1 .and. i.lt.j-2) then -< do l=1,4 -< aggj1(k,l)=aggj1(k,l)+agg(k,l) -< cd aggj1(k,l)=agg(k,l) -< enddo -< endif ---- -> cgrad if (j.eq.nres-1 .and. i.lt.j-2) then -> cgrad do l=1,4 -> cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l) -> cgrad enddo -> cgrad endif -2215,2217d3193 -< endif -< c goto 11111 -< C Check the loc-el terms by numerical integration -2261d3236 -< 11111 continue -2267c3242,3245 -< cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) ---- -> -> if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') -> & 'eelloc',i,j,eel_loc_ij -> -2270d3247 -< if (calc_grad) then -2278,2284d3254 -< cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij) -< cd write(iout,*) 'agg ',agg -< cd write(iout,*) 'aggi ',aggi -< cd write(iout,*) 'aggi1',aggi1 -< cd write(iout,*) 'aggj ',aggj -< cd write(iout,*) 'aggj1',aggj1 -< -2289,2294c3259,3269 -< enddo -< do k=i+2,j2 -< do l=1,3 -< gel_loc(l,k)=gel_loc(l,k)+ggg(l) -< enddo -< enddo ---- -> gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l) -> gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l) -> cgrad ghalf=0.5d0*ggg(l) -> cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf -> cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf -> enddo -> cgrad do k=i+1,j2 -> cgrad do l=1,3 -> cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l) -> cgrad enddo -> cgrad enddo -2306d3280 -< endif -2308,2315d3281 -< if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then -< C Contributions from turns -< a_temp(1,1)=a22 -< a_temp(1,2)=a23 -< a_temp(2,1)=a32 -< a_temp(2,2)=a33 -< call eturn34(i,j,eello_turn3,eello_turn4) -< endif -2317c3283,3286 -< if (j.gt.i+1 .and. num_conti.le.maxconts) then ---- -> c if (j.gt.i+1 .and. num_conti.le.maxconts) then -> if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 -> & .and. num_conti.le.maxconts) then -> c write (iout,*) i,j," entered corr" -2334a3304,3305 -> cd write (iout,*) "i",i," j",j," num_conti",num_conti, -> cd & " jcont_hb",jcont_hb(num_conti,i) -2350,2382d3320 -< c if (i.eq.1) then -< c a_chuj(1,1,num_conti,i)=-0.61d0 -< c a_chuj(1,2,num_conti,i)= 0.4d0 -< c a_chuj(2,1,num_conti,i)= 0.65d0 -< c a_chuj(2,2,num_conti,i)= 0.50d0 -< c else if (i.eq.2) then -< c a_chuj(1,1,num_conti,i)= 0.0d0 -< c a_chuj(1,2,num_conti,i)= 0.0d0 -< c a_chuj(2,1,num_conti,i)= 0.0d0 -< c a_chuj(2,2,num_conti,i)= 0.0d0 -< c endif -< C --- and its gradients -< cd write (iout,*) 'i',i,' j',j -< cd do kkk=1,3 -< cd write (iout,*) 'iii 1 kkk',kkk -< cd write (iout,*) agg(kkk,:) -< cd enddo -< cd do kkk=1,3 -< cd write (iout,*) 'iii 2 kkk',kkk -< cd write (iout,*) aggi(kkk,:) -< cd enddo -< cd do kkk=1,3 -< cd write (iout,*) 'iii 3 kkk',kkk -< cd write (iout,*) aggi1(kkk,:) -< cd enddo -< cd do kkk=1,3 -< cd write (iout,*) 'iii 4 kkk',kkk -< cd write (iout,*) aggj(kkk,:) -< cd enddo -< cd do kkk=1,3 -< cd write (iout,*) 'iii 5 kkk',kkk -< cd write (iout,*) aggj1(kkk,:) -< cd enddo -2393,2395d3330 -< c do mm=1,5 -< c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0 -< c enddo -2408,2409c3343,3356 -< ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1) -< ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2) ---- -> c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1) -> ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1 -> if (ees0tmp.gt.0) then -> ees0pij=dsqrt(ees0tmp) -> else -> ees0pij=0 -> endif -> c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2) -> ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2 -> if (ees0tmp.gt.0) then -> ees0mij=dsqrt(ees0tmp) -> else -> ees0mij=0 -> endif -2418,2421c3365,3366 -< c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij, -< c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont -< facont_hb(num_conti,i)=fcont -< if (calc_grad) then ---- -> c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij, -> c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont -2448a3394 -> facont_hb(num_conti,i)=fcont -2472,2474c3418,3424 -< ghalfp=0.5D0*gggp(k) -< ghalfm=0.5D0*gggm(k) -< gacontp_hb1(k,num_conti,i)=ghalfp ---- -> c -> c 10/24/08 cgrad and ! comments indicate the parts of the code removed -> c following the change of gradient-summation algorithm. -> c -> cgrad ghalfp=0.5D0*gggp(k) -> cgrad ghalfm=0.5D0*gggm(k) -> gacontp_hb1(k,num_conti,i)=!ghalfp -2477c3427 -< gacontp_hb2(k,num_conti,i)=ghalfp ---- -> gacontp_hb2(k,num_conti,i)=!ghalfp -2481c3431 -< gacontm_hb1(k,num_conti,i)=ghalfm ---- -> gacontm_hb1(k,num_conti,i)=!ghalfm -2484c3434 -< gacontm_hb2(k,num_conti,i)=ghalfm ---- -> gacontm_hb2(k,num_conti,i)=!ghalfm -2489d3438 -< endif -2503,2513c3452,3469 -< 1216 continue -< enddo ! j -< num_cont_hb(i)=num_conti -< 1215 continue -< enddo ! i -< cd do i=1,nres -< cd write (iout,'(i3,3f10.5,5x,3f10.5)') -< cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i) -< cd enddo -< c 12/7/99 Adam eello_turn3 will be considered as a separate energy term -< ccc eel_loc=eel_loc+eello_turn3 ---- -> if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then -> do k=1,4 -> do l=1,3 -> ghalf=0.5d0*agg(l,k) -> aggi(l,k)=aggi(l,k)+ghalf -> aggi1(l,k)=aggi1(l,k)+agg(l,k) -> aggj(l,k)=aggj(l,k)+ghalf -> enddo -> enddo -> if (j.eq.nres-1 .and. i.lt.j-2) then -> do k=1,4 -> do l=1,3 -> aggj1(l,k)=aggj1(l,k)+agg(l,k) -> enddo -> enddo -> endif -> endif -> c t_eelecij=t_eelecij+MPI_Wtime()-time00 -2517c3473 -< subroutine eturn34(i,j,eello_turn3,eello_turn4) ---- -> subroutine eturn3(i,eello_turn3) -2521d3476 -< include 'DIMENSIONS.ZSCOPT' -2532a3488 -> include 'COMMON.CONTROL' -2538,2540c3494,3503 -< & aggj(3,4),aggj1(3,4),a_temp(2,2) -< common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2 -< if (j.eq.i+2) then ---- -> & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2) -> common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, -> & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, -> & num_conti,j1,j2 -> j=i+2 -> c write (iout,*) "eturn3",i,j,j1,j2 -> a_temp(1,1)=a22 -> a_temp(1,2)=a23 -> a_temp(2,1)=a32 -> a_temp(2,2)=a33 -2555a3519,3520 -> if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') -> & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2)) -2559d3523 -< if (calc_grad) then -2562,2563c3526,3527 -< call transpose2(auxmat2(1,1),pizda(1,1)) -< call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1)) ---- -> call transpose2(auxmat2(1,1),auxmat3(1,1)) -> call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) -2567,2568c3531,3532 -< call transpose2(auxmat2(1,1),pizda(1,1)) -< call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1)) ---- -> call transpose2(auxmat2(1,1),auxmat3(1,1)) -> call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) -2573,2576c3537,3544 -< a_temp(1,1)=aggi(l,1) -< a_temp(1,2)=aggi(l,2) -< a_temp(2,1)=aggi(l,3) -< a_temp(2,2)=aggi(l,4) ---- -> c ghalf1=0.5d0*agg(l,1) -> c ghalf2=0.5d0*agg(l,2) -> c ghalf3=0.5d0*agg(l,3) -> c ghalf4=0.5d0*agg(l,4) -> a_temp(1,1)=aggi(l,1)!+ghalf1 -> a_temp(1,2)=aggi(l,2)!+ghalf2 -> a_temp(2,1)=aggi(l,3)!+ghalf3 -> a_temp(2,2)=aggi(l,4)!+ghalf4 -2580,2583c3548,3551 -< a_temp(1,1)=aggi1(l,1) -< a_temp(1,2)=aggi1(l,2) -< a_temp(2,1)=aggi1(l,3) -< a_temp(2,2)=aggi1(l,4) ---- -> a_temp(1,1)=aggi1(l,1)!+agg(l,1) -> a_temp(1,2)=aggi1(l,2)!+agg(l,2) -> a_temp(2,1)=aggi1(l,3)!+agg(l,3) -> a_temp(2,2)=aggi1(l,4)!+agg(l,4) -2587,2590c3555,3558 -< a_temp(1,1)=aggj(l,1) -< a_temp(1,2)=aggj(l,2) -< a_temp(2,1)=aggj(l,3) -< a_temp(2,2)=aggj(l,4) ---- -> a_temp(1,1)=aggj(l,1)!+ghalf1 -> a_temp(1,2)=aggj(l,2)!+ghalf2 -> a_temp(2,1)=aggj(l,3)!+ghalf3 -> a_temp(2,2)=aggj(l,4)!+ghalf4 -2602,2603c3570,3598 -< endif -< else if (j.eq.i+3 .and. itype(i+2).ne.21) then ---- -> return -> end -> C------------------------------------------------------------------------------- -> subroutine eturn4(i,eello_turn4) -> C Third- and fourth-order contributions from turns -> implicit real*8 (a-h,o-z) -> include 'DIMENSIONS' -> include 'COMMON.IOUNITS' -> include 'COMMON.GEO' -> include 'COMMON.VAR' -> include 'COMMON.LOCAL' -> include 'COMMON.CHAIN' -> include 'COMMON.DERIV' -> include 'COMMON.INTERACT' -> include 'COMMON.CONTACTS' -> include 'COMMON.TORSION' -> include 'COMMON.VECTORS' -> include 'COMMON.FFIELD' -> include 'COMMON.CONTROL' -> dimension ggg(3) -> double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2), -> & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2), -> & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2) -> double precision agg(3,4),aggi(3,4),aggi1(3,4), -> & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2) -> common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, -> & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, -> & num_conti,j1,j2 -> j=i+3 -2615a3611,3615 -> c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2 -> a_temp(1,1)=a22 -> a_temp(1,2)=a23 -> a_temp(2,1)=a32 -> a_temp(2,2)=a33 -2618a3619 -> c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3 -2631a3633,3634 -> if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') -> & 'eturn4',i,j,-(s1+s2+s3) -2635d3637 -< if (calc_grad) then -2658,2659c3660,3661 -< call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1)) -< call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1)) ---- -> call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1)) -> call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1)) -2739a3742 -> c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3 -2742,2743d3744 -< endif -< endif -2779a3781,3877 -> subroutine escp_soft_sphere(evdw2,evdw2_14) -> C -> C This subroutine calculates the excluded-volume interaction energy between -> C peptide-group centers and side chains and its gradient in virtual-bond and -> C side-chain vectors. -> C -> implicit real*8 (a-h,o-z) -> include 'DIMENSIONS' -> include 'COMMON.GEO' -> include 'COMMON.VAR' -> include 'COMMON.LOCAL' -> include 'COMMON.CHAIN' -> include 'COMMON.DERIV' -> include 'COMMON.INTERACT' -> include 'COMMON.FFIELD' -> include 'COMMON.IOUNITS' -> include 'COMMON.CONTROL' -> dimension ggg(3) -> evdw2=0.0D0 -> evdw2_14=0.0d0 -> r0_scp=4.5d0 -> cd print '(a)','Enter ESCP' -> cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e -> do i=iatscp_s,iatscp_e -> if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle -> iteli=itel(i) -> xi=0.5D0*(c(1,i)+c(1,i+1)) -> yi=0.5D0*(c(2,i)+c(2,i+1)) -> zi=0.5D0*(c(3,i)+c(3,i+1)) -> -> do iint=1,nscp_gr(i) -> -> do j=iscpstart(i,iint),iscpend(i,iint) -> if (itype(j).eq.21) cycle -> itypj=itype(j) -> C Uncomment following three lines for SC-p interactions -> c xj=c(1,nres+j)-xi -> c yj=c(2,nres+j)-yi -> c zj=c(3,nres+j)-zi -> C Uncomment following three lines for Ca-p interactions -> xj=c(1,j)-xi -> yj=c(2,j)-yi -> zj=c(3,j)-zi -> rij=xj*xj+yj*yj+zj*zj -> r0ij=r0_scp -> r0ijsq=r0ij*r0ij -> if (rij.lt.r0ijsq) then -> evdwij=0.25d0*(rij-r0ijsq)**2 -> fac=rij-r0ijsq -> else -> evdwij=0.0d0 -> fac=0.0d0 -> endif -> evdw2=evdw2+evdwij -> C -> C Calculate contributions to the gradient in the virtual-bond and SC vectors. -> C -> ggg(1)=xj*fac -> ggg(2)=yj*fac -> ggg(3)=zj*fac -> cgrad if (j.lt.i) then -> cd write (iout,*) 'j C Uncomment following three lines for SC-p interactions -> c do k=1,3 -> c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) -> c enddo -> cgrad else -> cd write (iout,*) 'j>i' -> cgrad do k=1,3 -> cgrad ggg(k)=-ggg(k) -> C Uncomment following line for SC-p interactions -> c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) -> cgrad enddo -> cgrad endif -> cgrad do k=1,3 -> cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) -> cgrad enddo -> cgrad kstart=min0(i+1,j) -> cgrad kend=max0(i-1,j-1) -> cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend -> cd write (iout,*) ggg(1),ggg(2),ggg(3) -> cgrad do k=kstart,kend -> cgrad do l=1,3 -> cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) -> cgrad enddo -> cgrad enddo -> do k=1,3 -> gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) -> gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) -> enddo -> enddo -> -> enddo ! iint -> enddo ! i -> return -> end -> C----------------------------------------------------------------------------- -2788d3885 -< include 'DIMENSIONS.ZSCOPT' -2796a3894 -> include 'COMMON.CONTROL' -2801,2802c3899 -< c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e, -< c & ' scal14',scal14 ---- -> cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e -2806,2808d3902 -< c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i), -< c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i)) -< if (iteli.eq.0) goto 1225 -2836d3929 -< c write (iout,*) i,j,evdwij -2838c3931,3932 -< if (calc_grad) then ---- -> if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') -> & 'evdw2',i,j,evdwij -2846c3940 -< if (j.lt.i) then ---- -> cgrad if (j.lt.i) then -2852c3946 -< else ---- -> cgrad else -2854,2855c3948,3949 -< do k=1,3 -< ggg(k)=-ggg(k) ---- -> cgrad do k=1,3 -> cgrad ggg(k)=-ggg(k) -2857,2864c3951,3959 -< c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) -< enddo -< endif -< do k=1,3 -< gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) -< enddo -< kstart=min0(i+1,j) -< kend=max0(i-1,j-1) ---- -> ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) -> c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) -> cgrad enddo -> cgrad endif -> cgrad do k=1,3 -> cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) -> cgrad enddo -> cgrad kstart=min0(i+1,j) -> cgrad kend=max0(i-1,j-1) -2867,2870c3962,3969 -< do k=kstart,kend -< do l=1,3 -< gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) -< enddo ---- -> cgrad do k=kstart,kend -> cgrad do l=1,3 -> cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) -> cgrad enddo -> cgrad enddo -> do k=1,3 -> gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) -> gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) -2872d3970 -< endif -2873a3972 -> -2875d3973 -< 1225 continue -2879a3978 -> gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i) -2901d3999 -< include 'DIMENSIONS.ZSCOPT' -2906a4005 -> include 'COMMON.IOUNITS' -2909,2910c4008,4009 -< cd print *,'edis: nhpb=',nhpb,' fbr=',fbr -< cd print *,'link_start=',link_start,' link_end=',link_end ---- -> cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr -> cd write(iout,*)'link_start=',link_start,' link_end=',link_end -2924a4024 -> cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj -2929a4030 -> cd write (iout,*) "eij",eij -2957,2960c4058,4065 -< do j=iii,jjj-1 -< do k=1,3 -< ghpbc(k,j)=ghpbc(k,j)+ggg(k) -< enddo ---- -> cgrad do j=iii,jjj-1 -> cgrad do k=1,3 -> cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k) -> cgrad enddo -> cgrad enddo -> do k=1,3 -> ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k) -> ghpbc(k,iii)=ghpbc(k,iii)-ggg(k) -2978d4082 -< include 'DIMENSIONS.ZSCOPT' -2994c4098,4099 -< dsci_inv=dsc_inv(itypi) ---- -> c dsci_inv=dsc_inv(itypi) -> dsci_inv=vbld_inv(nres+i) -2996c4101,4102 -< dscj_inv=dsc_inv(itypj) ---- -> c dscj_inv=dsc_inv(itypj) -> dscj_inv=vbld_inv(nres+j) -3034,3040c4140,4148 -< gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) -< enddo -< do k=1,3 -< ghpbx(k,i)=ghpbx(k,i)-gg(k) -< & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv -< ghpbx(k,j)=ghpbx(k,j)+gg(k) -< & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv ---- -> ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) -> ghpbx(k,i)=ghpbx(k,i)-ggk -> & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) -> & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv -> ghpbx(k,j)=ghpbx(k,j)+ggk -> & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) -> & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv -> ghpbc(k,i)=ghpbc(k,i)-ggk -> ghpbc(k,j)=ghpbc(k,j)+ggk -3045,3049c4153,4157 -< do k=i,j-1 -< do l=1,3 -< ghpbc(l,k)=ghpbc(l,k)+gg(l) -< enddo -< enddo ---- -> cgrad do k=i,j-1 -> cgrad do l=1,3 -> cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l) -> cgrad enddo -> cgrad enddo -3059d4166 -< include 'DIMENSIONS.ZSCOPT' -3070c4177 -< logical energy_dec /.false./ ---- -> include 'COMMON.SETUP' -3073,3074c4180,4181 -< write (iout,*) "distchainmax",distchainmax -< do i=nnt+1,nct ---- -> estr1=0.0d0 -> do i=ibondp_start,ibondp_end -3081c4188 -< if (energy_dec) write(iout,*) ---- -> if (energy_dec) write(iout,*) -3085,3090c4192,4199 -< diff = vbld(i)-vbldp0 -< c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff -< estr=estr+diff*diff -< do j=1,3 -< gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i) -< enddo ---- -> diff = vbld(i)-vbldp0 -> if (energy_dec) write (iout,*) -> & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff -> estr=estr+diff*diff -> do j=1,3 -> gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i) -> enddo -> c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3) -3092d4200 -< -3094c4202 -< estr=0.5d0*AKP*estr ---- -> estr=0.5d0*AKP*estr+estr1 -3098c4206 -< do i=nnt,nct ---- -> do i=ibond_start,ibond_end -3104,3105c4212,4214 -< c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff, -< c & AKSC(1,iti),AKSC(1,iti)*diff*diff ---- -> if (energy_dec) write (iout,*) -> & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff, -> & AKSC(1,iti),AKSC(1,iti)*diff*diff -3112c4221 -< diff=vbld(i+nres)-vbldsc0(j,iti) ---- -> diff=vbld(i+nres)-vbldsc0(j,iti) -3132c4241 -< usumsqder=usumsqder+ud(j)*uprod2 ---- -> usumsqder=usumsqder+ud(j)*uprod2 -3134,3135d4242 -< c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti), -< c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi) -3144c4251 -< end ---- -> end -3154d4260 -< include 'DIMENSIONS.ZSCOPT' -3163a4270 -> include 'COMMON.CONTROL' -3169,3170c4276,4277 -< time11=dexp(-2*time) -< time12=1.0d0 ---- -> c time11=dexp(-2*time) -> c time12=1.0d0 -3172d4278 -< c write (iout,*) "nres",nres -3174d4279 -< c write (iout,*) ithet_start,ithet_end -3182,3185c4287,4288 -< phii=phi(i) -< icrc=0 -< call proc_proc(phii,icrc) -< if (icrc.eq.1) phii=150.0 ---- -> phii=phi(i) -> if (phii.ne.phii) phii=150.0 -3191c4294 -< else ---- -> else -3197,3200c4300,4301 -< phii1=phi(i+1) -< icrc=0 -< call proc_proc(phii1,icrc) -< if (icrc.eq.1) phii1=150.0 ---- -> phii1=phi(i+1) -> if (phii1.ne.phii1) phii1=150.0 -3211c4312 -< endif ---- -> endif -3221d4321 -< c write (iout,*) "thet_pred_mean",thet_pred_mean -3224d4323 -< c write (iout,*) "thet_pred_mean",thet_pred_mean -3250,3251c4349,4350 -< c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i), -< c & rad2deg*phii,rad2deg*phii1,ethetai ---- -> if (energy_dec) write (iout,'(a6,i5,0pf7.3)') -> & 'ebend',i,ethetai -3255d4353 -< 1215 continue -3379d4476 -< include 'DIMENSIONS.ZSCOPT' -3396d4492 -< c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) -3449,3451d4544 -< c write (iout,*) "i",i," ityp1",itype(i-2),ityp1, -< c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3 -< c call flush(iout) -3571d4663 -< include 'DIMENSIONS.ZSCOPT' -3580a4673 -> include 'COMMON.CONTROL' -3598d4690 -< c write (iout,*) "i",i," x",x(1),x(2),x(3) -3672c4764,4766 -< c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc ---- -> if (energy_dec) write (iout,'(a6,i5,0pf7.3)') -> & 'escloc',i,escloci -> c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc -3745a4840,4844 -> #ifdef OSF -> adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin -> if(adexp.ne.adexp) adexp=1.0 -> expfac=dexp(adexp) -> #else -3746a4846 -> #endif -3856d4955 -< include 'DIMENSIONS.ZSCOPT' -3991,3992c5090 -< c write (2,*) "escloc",escloc -< if (.not. calc_grad) goto 1 ---- -> c write (2,*) "i",i," escloc",sumene,escloc -4168a5267,5304 -> c------------------------------------------------------------------------------ -> double precision function enesc(x,xx,yy,zz,cost2,sint2) -> implicit none -> double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2, -> & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6 -> sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 -> & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy -> & + x(10)*yy*zz -> sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 -> & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy -> & + x(20)*yy*zz -> sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 -> & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy -> & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 -> & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx -> & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy -> & +x(40)*xx*yy*zz -> sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 -> & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy -> & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 -> & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx -> & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy -> & +x(60)*xx*yy*zz -> dsc_i = 0.743d0+x(61) -> dp2_i = 1.9d0+x(62) -> dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i -> & *(xx*cost2+yy*sint2)) -> dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i -> & *(xx*cost2-yy*sint2)) -> s1=(1+x(63))/(0.1d0 + dscp1) -> s1_6=(1+x(64))/(0.1d0 + dscp1**6) -> s2=(1+x(65))/(0.1d0 + dscp2) -> s2_6=(1+x(65))/(0.1d0 + dscp2**6) -> sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) -> & + (sumene4*cost2 +sumene2)*(s2+s2_6) -> enesc=sumene -> return -> end -4207d5342 -< include 'DIMENSIONS.ZSCOPT' -4252c5387 -< subroutine etor(etors,edihcnstr,fact) ---- -> subroutine etor(etors,edihcnstr) -4255d5389 -< include 'DIMENSIONS.ZSCOPT' -4266a5401 -> include 'COMMON.CONTROL' -4273c5408,5409 -< if (itype(i-2).eq.21 .or. itype(i-1).eq.21 ---- -> etors_ii=0.0D0 -> if (itype(i-2).eq.21 .or. itype(i-1).eq.21 -4286a5423 -> if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3) -4294a5432,5433 -> if (energy_dec) etors_ii=etors_ii+ -> & v2ij*sinphi+dabs(v1ij)+dabs(v2ij) -4303a5443,5444 -> if (energy_dec) etors_ii=etors_ii+ -> & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) -4306a5448,5449 -> if (energy_dec) write (iout,'(a6,i5,0pf7.3)') -> 'etor',i,etors_ii -4311c5454 -< gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci ---- -> gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci -4335a5479,5483 -> subroutine etor_d(etors_d) -> etors_d=0.0d0 -> return -> end -> c---------------------------------------------------------------------------- -4337c5485 -< subroutine etor(etors,edihcnstr,fact) ---- -> subroutine etor(etors,edihcnstr) -4340d5487 -< include 'DIMENSIONS.ZSCOPT' -4351a5499 -> include 'COMMON.CONTROL' -4355c5503 -< c lprn=.true. ---- -> c lprn=.true. -4358c5506 -< if (itype(i-2).eq.21 .or. itype(i-1).eq.21 ---- -> if (itype(i-2).eq.21 .or. itype(i-1).eq.21 -4360c5508 -< if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215 ---- -> etors_ii=0.0D0 -4371a5520,5521 -> if (energy_dec) etors_ii=etors_ii+ -> & v1ij*cosphi+v2ij*sinphi -4387a5538,5539 -> if (energy_dec) etors_ii=etors_ii+ -> & vl1ij*pom1 -4392a5545,5546 -> if (energy_dec) write (iout,'(a6,i5,0pf7.3)') -> & 'etor',i,etors_ii-v0(itori,itori1) -4397c5551 -< gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci ---- -> gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci -4399d5552 -< 1215 continue -4403c5556,5557 -< do i=1,ndih_constr ---- -> c do i=1,ndih_constr -> do i=idihconstr_start,idihconstr_end -4407d5560 -< edihi=0.0d0 -4412d5564 -< edihi=0.25d0*ftors*difi**4 -4417d5568 -< edihi=0.25d0*ftors*difi**4 -4419c5570 -< difi=0.0d0 ---- -> difi=0.0 -4421,4424c5572,5574 -< c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi, -< c & drange(i),edihi -< ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii, -< ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) ---- -> cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii, -> cd & rad2deg*phi0(i), rad2deg*drange(i), -> cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) -4426c5576 -< ! write (iout,*) 'edihcnstr',edihcnstr ---- -> cd write (iout,*) 'edihcnstr',edihcnstr -4430c5580 -< subroutine etor_d(etors_d,fact2) ---- -> subroutine etor_d(etors_d) -4434d5583 -< include 'DIMENSIONS.ZSCOPT' -4451c5600 -< do i=iphi_start,iphi_end-1 ---- -> do i=iphid_start,iphid_end -4454,4455d5602 -< if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0) -< & goto 1215 -4496,4498c5643,5644 -< gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1 -< gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2 -< 1215 continue ---- -> gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1 -> gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2 -4509c5655 -< c of residues computed from AM1 energy surfaces of terminally-blocked ---- -> c of residues computed from AM1 energy surfaces of terminally-blocked -4513d5658 -< include 'DIMENSIONS.ZSCOPT' -4551c5696 -< gsccor_loc(i-3)=gloci ---- -> gsccor_loc(i-3)=gsccor_loc(i-3)+gloci -4555c5700 -< c------------------------------------------------------------------------------ ---- -> c---------------------------------------------------------------------------- -4638,4702c5783,5794 -< enddo -< do m=i,j-1 -< do ll=1,3 -< gradcorr(ll,m)=gradcorr(ll,m)+gx(ll) -< enddo -< enddo -< do m=k,l-1 -< do ll=1,3 -< gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll) -< enddo -< enddo -< esccorr=-eij*ekl -< return -< end -< c------------------------------------------------------------------------------ -< #ifdef MPL -< subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer) -< implicit real*8 (a-h,o-z) -< include 'DIMENSIONS' -< integer dimen1,dimen2,atom,indx -< double precision buffer(dimen1,dimen2) -< double precision zapas -< common /contacts_hb/ zapas(3,20,maxres,7), -< & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres), -< & num_cont_hb(maxres),jcont_hb(20,maxres) -< num_kont=num_cont_hb(atom) -< do i=1,num_kont -< do k=1,7 -< do j=1,3 -< buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k) -< enddo ! j -< enddo ! k -< buffer(i,indx+22)=facont_hb(i,atom) -< buffer(i,indx+23)=ees0p(i,atom) -< buffer(i,indx+24)=ees0m(i,atom) -< buffer(i,indx+25)=dfloat(jcont_hb(i,atom)) -< enddo ! i -< buffer(1,indx+26)=dfloat(num_kont) -< return -< end -< c------------------------------------------------------------------------------ -< subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer) -< implicit real*8 (a-h,o-z) -< include 'DIMENSIONS' -< integer dimen1,dimen2,atom,indx -< double precision buffer(dimen1,dimen2) -< double precision zapas -< common /contacts_hb/ zapas(3,20,maxres,7), -< & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres), -< & num_cont_hb(maxres),jcont_hb(20,maxres) -< num_kont=buffer(1,indx+26) -< num_kont_old=num_cont_hb(atom) -< num_cont_hb(atom)=num_kont+num_kont_old -< do i=1,num_kont -< ii=i+num_kont_old -< do k=1,7 -< do j=1,3 -< zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j) -< enddo ! j -< enddo ! k -< facont_hb(ii,atom)=buffer(i,indx+22) -< ees0p(ii,atom)=buffer(i,indx+23) -< ees0m(ii,atom)=buffer(i,indx+24) -< jcont_hb(ii,atom)=buffer(i,indx+25) -< enddo ! i ---- -> enddo -> do m=i,j-1 -> do ll=1,3 -> gradcorr(ll,m)=gradcorr(ll,m)+gx(ll) -> enddo -> enddo -> do m=k,l-1 -> do ll=1,3 -> gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll) -> enddo -> enddo -> esccorr=-eij*ekl -4706d5797 -< #endif -4711d5801 -< include 'DIMENSIONS.ZSCOPT' -4713,4714c5803,5812 -< #ifdef MPL -< include 'COMMON.INFO' ---- -> #ifdef MPI -> include "mpif.h" -> parameter (max_cont=maxconts) -> parameter (max_dim=26) -> integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error -> double precision zapas(max_dim,maxconts,max_fg_procs), -> & zapas_recv(max_dim,maxconts,max_fg_procs) -> common /przechowalnia/ zapas -> integer status(MPI_STATUS_SIZE),req(maxconts*2), -> & status_array(MPI_STATUS_SIZE,maxconts*2) -4715a5814 -> include 'COMMON.SETUP' -4720,4728c5819,5821 -< #ifdef MPL -< parameter (max_cont=maxconts) -< parameter (max_dim=2*(8*3+2)) -< parameter (msglen1=max_cont*max_dim*4) -< parameter (msglen2=2*msglen1) -< integer source,CorrelType,CorrelID,Error -< double precision buffer(max_cont,max_dim) -< #endif -< double precision gx(3),gx1(3) ---- -> include 'COMMON.CONTROL' -> include 'COMMON.LOCAL' -> double precision gx(3),gx1(3),time00 -4733c5826 -< #ifdef MPL ---- -> #ifdef MPI -4736c5829 -< if (fgProcs.le.1) goto 30 ---- -> if (nfgtasks.le.1) goto 30 -4738c5831 -< write (iout,'(a)') 'Contact function values:' ---- -> write (iout,'(a)') 'Contact function values before RECEIVE:' -4745,4746c5838,5917 -< C Caution! Following code assumes that electrostatic interactions concerning -< C a given atom are split among at most two processors! ---- -> call flush(iout) -> do i=1,ntask_cont_from -> ncont_recv(i)=0 -> enddo -> do i=1,ntask_cont_to -> ncont_sent(i)=0 -> enddo -> c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to", -> c & ntask_cont_to -> C Make the list of contacts to send to send to other procesors -> c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end -> c call flush(iout) -> do i=iturn3_start,iturn3_end -> c write (iout,*) "make contact list turn3",i," num_cont", -> c & num_cont_hb(i) -> call add_hb_contact(i,i+2,iturn3_sent_local(1,i)) -> enddo -> do i=iturn4_start,iturn4_end -> c write (iout,*) "make contact list turn4",i," num_cont", -> c & num_cont_hb(i) -> call add_hb_contact(i,i+3,iturn4_sent_local(1,i)) -> enddo -> do ii=1,nat_sent -> i=iat_sent(ii) -> c write (iout,*) "make contact list longrange",i,ii," num_cont", -> c & num_cont_hb(i) -> do j=1,num_cont_hb(i) -> do k=1,4 -> jjc=jcont_hb(j,i) -> iproc=iint_sent_local(k,jjc,ii) -> c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc -> if (iproc.gt.0) then -> ncont_sent(iproc)=ncont_sent(iproc)+1 -> nn=ncont_sent(iproc) -> zapas(1,nn,iproc)=i -> zapas(2,nn,iproc)=jjc -> zapas(3,nn,iproc)=facont_hb(j,i) -> zapas(4,nn,iproc)=ees0p(j,i) -> zapas(5,nn,iproc)=ees0m(j,i) -> zapas(6,nn,iproc)=gacont_hbr(1,j,i) -> zapas(7,nn,iproc)=gacont_hbr(2,j,i) -> zapas(8,nn,iproc)=gacont_hbr(3,j,i) -> zapas(9,nn,iproc)=gacontm_hb1(1,j,i) -> zapas(10,nn,iproc)=gacontm_hb1(2,j,i) -> zapas(11,nn,iproc)=gacontm_hb1(3,j,i) -> zapas(12,nn,iproc)=gacontp_hb1(1,j,i) -> zapas(13,nn,iproc)=gacontp_hb1(2,j,i) -> zapas(14,nn,iproc)=gacontp_hb1(3,j,i) -> zapas(15,nn,iproc)=gacontm_hb2(1,j,i) -> zapas(16,nn,iproc)=gacontm_hb2(2,j,i) -> zapas(17,nn,iproc)=gacontm_hb2(3,j,i) -> zapas(18,nn,iproc)=gacontp_hb2(1,j,i) -> zapas(19,nn,iproc)=gacontp_hb2(2,j,i) -> zapas(20,nn,iproc)=gacontp_hb2(3,j,i) -> zapas(21,nn,iproc)=gacontm_hb3(1,j,i) -> zapas(22,nn,iproc)=gacontm_hb3(2,j,i) -> zapas(23,nn,iproc)=gacontm_hb3(3,j,i) -> zapas(24,nn,iproc)=gacontp_hb3(1,j,i) -> zapas(25,nn,iproc)=gacontp_hb3(2,j,i) -> zapas(26,nn,iproc)=gacontp_hb3(3,j,i) -> endif -> enddo -> enddo -> enddo -> if (lprn) then -> write (iout,*) -> & "Numbers of contacts to be sent to other processors", -> & (ncont_sent(i),i=1,ntask_cont_to) -> write (iout,*) "Contacts sent" -> do ii=1,ntask_cont_to -> nn=ncont_sent(ii) -> iproc=itask_cont_to(ii) -> write (iout,*) nn," contacts to processor",iproc, -> & " of CONT_TO_COMM group" -> do i=1,nn -> write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) -> enddo -> enddo -> call flush(iout) -> endif -4748,4836c5919,6040 -< CorrelID=MyID+1 -< ldone=.false. -< do i=1,max_cont -< do j=1,max_dim -< buffer(i,j)=0.0D0 -< enddo -< enddo -< mm=mod(MyRank,2) -< cd write (iout,*) 'MyRank',MyRank,' mm',mm -< if (mm) 20,20,10 -< 10 continue -< cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone -< if (MyRank.gt.0) then -< C Send correlation contributions to the preceding processor -< msglen=msglen1 -< nn=num_cont_hb(iatel_s) -< call pack_buffer(max_cont,max_dim,iatel_s,0,buffer) -< cd write (iout,*) 'The BUFFER array:' -< cd do i=1,nn -< cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26) -< cd enddo -< if (ielstart(iatel_s).gt.iatel_s+ispp) then -< msglen=msglen2 -< call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer) -< C Clear the contacts of the atom passed to the neighboring processor -< nn=num_cont_hb(iatel_s+1) -< cd do i=1,nn -< cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26) -< cd enddo -< num_cont_hb(iatel_s)=0 -< endif -< cd write (iout,*) 'Processor ',MyID,MyRank, -< cd & ' is sending correlation contribution to processor',MyID-1, -< cd & ' msglen=',msglen -< cd write (*,*) 'Processor ',MyID,MyRank, -< cd & ' is sending correlation contribution to processor',MyID-1, -< cd & ' msglen=',msglen,' CorrelType=',CorrelType -< call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID) -< cd write (iout,*) 'Processor ',MyID, -< cd & ' has sent correlation contribution to processor',MyID-1, -< cd & ' msglen=',msglen,' CorrelID=',CorrelID -< cd write (*,*) 'Processor ',MyID, -< cd & ' has sent correlation contribution to processor',MyID-1, -< cd & ' msglen=',msglen,' CorrelID=',CorrelID -< msglen=msglen1 -< endif ! (MyRank.gt.0) -< if (ldone) goto 30 -< ldone=.true. -< 20 continue -< cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone -< if (MyRank.lt.fgProcs-1) then -< C Receive correlation contributions from the next processor -< msglen=msglen1 -< if (ielend(iatel_e).lt.nct-1) msglen=msglen2 -< cd write (iout,*) 'Processor',MyID, -< cd & ' is receiving correlation contribution from processor',MyID+1, -< cd & ' msglen=',msglen,' CorrelType=',CorrelType -< cd write (*,*) 'Processor',MyID, -< cd & ' is receiving correlation contribution from processor',MyID+1, -< cd & ' msglen=',msglen,' CorrelType=',CorrelType -< nbytes=-1 -< do while (nbytes.le.0) -< call mp_probe(MyID+1,CorrelType,nbytes) -< enddo -< cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes -< call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes) -< cd write (iout,*) 'Processor',MyID, -< cd & ' has received correlation contribution from processor',MyID+1, -< cd & ' msglen=',msglen,' nbytes=',nbytes -< cd write (iout,*) 'The received BUFFER array:' -< cd do i=1,max_cont -< cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52) -< cd enddo -< if (msglen.eq.msglen1) then -< call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer) -< else if (msglen.eq.msglen2) then -< call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer) -< call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer) -< else -< write (iout,*) -< & 'ERROR!!!! message length changed while processing correlations.' -< write (*,*) -< & 'ERROR!!!! message length changed while processing correlations.' -< call mp_stopall(Error) -< endif ! msglen.eq.msglen1 -< endif ! MyRank.lt.fgProcs-1 -< if (ldone) goto 30 -< ldone=.true. -< goto 10 ---- -> CorrelID=fg_rank+1 -> CorrelType1=478 -> CorrelID1=nfgtasks+fg_rank+1 -> ireq=0 -> C Receive the numbers of needed contacts from other processors -> do ii=1,ntask_cont_from -> iproc=itask_cont_from(ii) -> ireq=ireq+1 -> call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType, -> & FG_COMM,req(ireq),IERR) -> enddo -> c write (iout,*) "IRECV ended" -> c call flush(iout) -> C Send the number of contacts needed by other processors -> do ii=1,ntask_cont_to -> iproc=itask_cont_to(ii) -> ireq=ireq+1 -> call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType, -> & FG_COMM,req(ireq),IERR) -> enddo -> c write (iout,*) "ISEND ended" -> c write (iout,*) "number of requests (nn)",ireq -> call flush(iout) -> if (ireq.gt.0) -> & call MPI_Waitall(ireq,req,status_array,ierr) -> c write (iout,*) -> c & "Numbers of contacts to be received from other processors", -> c & (ncont_recv(i),i=1,ntask_cont_from) -> c call flush(iout) -> C Receive contacts -> ireq=0 -> do ii=1,ntask_cont_from -> iproc=itask_cont_from(ii) -> nn=ncont_recv(ii) -> c write (iout,*) "Receiving",nn," contacts from processor",iproc, -> c & " of CONT_TO_COMM group" -> call flush(iout) -> if (nn.gt.0) then -> ireq=ireq+1 -> call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim, -> & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR) -> c write (iout,*) "ireq,req",ireq,req(ireq) -> endif -> enddo -> C Send the contacts to processors that need them -> do ii=1,ntask_cont_to -> iproc=itask_cont_to(ii) -> nn=ncont_sent(ii) -> c write (iout,*) nn," contacts to processor",iproc, -> c & " of CONT_TO_COMM group" -> if (nn.gt.0) then -> ireq=ireq+1 -> call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION, -> & iproc,CorrelType1,FG_COMM,req(ireq),IERR) -> c write (iout,*) "ireq,req",ireq,req(ireq) -> c do i=1,nn -> c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) -> c enddo -> endif -> enddo -> c write (iout,*) "number of requests (contacts)",ireq -> c write (iout,*) "req",(req(i),i=1,4) -> c call flush(iout) -> if (ireq.gt.0) -> & call MPI_Waitall(ireq,req,status_array,ierr) -> do iii=1,ntask_cont_from -> iproc=itask_cont_from(iii) -> nn=ncont_recv(iii) -> if (lprn) then -> write (iout,*) "Received",nn," contacts from processor",iproc, -> & " of CONT_FROM_COMM group" -> call flush(iout) -> do i=1,nn -> write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5) -> enddo -> call flush(iout) -> endif -> do i=1,nn -> ii=zapas_recv(1,i,iii) -> c Flag the received contacts to prevent double-counting -> jj=-zapas_recv(2,i,iii) -> c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj -> c call flush(iout) -> nnn=num_cont_hb(ii)+1 -> num_cont_hb(ii)=nnn -> jcont_hb(nnn,ii)=jj -> facont_hb(nnn,ii)=zapas_recv(3,i,iii) -> ees0p(nnn,ii)=zapas_recv(4,i,iii) -> ees0m(nnn,ii)=zapas_recv(5,i,iii) -> gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii) -> gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii) -> gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii) -> gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii) -> gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii) -> gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii) -> gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii) -> gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii) -> gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii) -> gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii) -> gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii) -> gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii) -> gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii) -> gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii) -> gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii) -> gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii) -> gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii) -> gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii) -> gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii) -> gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii) -> gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii) -> enddo -> enddo -> call flush(iout) -> if (lprn) then -> write (iout,'(a)') 'Contact function values after receive:' -> do i=nnt,nct-2 -> write (iout,'(2i3,50(1x,i3,f5.2))') -> & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), -> & j=1,num_cont_hb(i)) -> enddo -> call flush(iout) -> endif -4842c6046 -< write (iout,'(2i3,50(1x,i2,f5.2))') ---- -> write (iout,'(2i3,50(1x,i3,f5.2))') -4856c6060 -< do i=iatel_s,iatel_e+1 ---- -> do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end) -4861a6066 -> jp=iabs(j) -4863a6069 -> jp1=iabs(j1) -4866c6072,6074 -< if (j1.eq.j+1 .or. j1.eq.j-1) then ---- -> if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 -> & .or. j.lt.0 .and. j1.gt.0) .and. -> & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then -4869c6077,6079 -< ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0) ---- -> ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0) -> if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') -> & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0) -4891a6102,6158 -> subroutine add_hb_contact(ii,jj,itask) -> implicit real*8 (a-h,o-z) -> include "DIMENSIONS" -> include "COMMON.IOUNITS" -> integer max_cont -> integer max_dim -> parameter (max_cont=maxconts) -> parameter (max_dim=26) -> include "COMMON.CONTACTS" -> double precision zapas(max_dim,maxconts,max_fg_procs), -> & zapas_recv(max_dim,maxconts,max_fg_procs) -> common /przechowalnia/ zapas -> integer i,j,ii,jj,iproc,itask(4),nn -> c write (iout,*) "itask",itask -> do i=1,2 -> iproc=itask(i) -> if (iproc.gt.0) then -> do j=1,num_cont_hb(ii) -> jjc=jcont_hb(j,ii) -> c write (iout,*) "i",ii," j",jj," jjc",jjc -> if (jjc.eq.jj) then -> ncont_sent(iproc)=ncont_sent(iproc)+1 -> nn=ncont_sent(iproc) -> zapas(1,nn,iproc)=ii -> zapas(2,nn,iproc)=jjc -> zapas(3,nn,iproc)=facont_hb(j,ii) -> zapas(4,nn,iproc)=ees0p(j,ii) -> zapas(5,nn,iproc)=ees0m(j,ii) -> zapas(6,nn,iproc)=gacont_hbr(1,j,ii) -> zapas(7,nn,iproc)=gacont_hbr(2,j,ii) -> zapas(8,nn,iproc)=gacont_hbr(3,j,ii) -> zapas(9,nn,iproc)=gacontm_hb1(1,j,ii) -> zapas(10,nn,iproc)=gacontm_hb1(2,j,ii) -> zapas(11,nn,iproc)=gacontm_hb1(3,j,ii) -> zapas(12,nn,iproc)=gacontp_hb1(1,j,ii) -> zapas(13,nn,iproc)=gacontp_hb1(2,j,ii) -> zapas(14,nn,iproc)=gacontp_hb1(3,j,ii) -> zapas(15,nn,iproc)=gacontm_hb2(1,j,ii) -> zapas(16,nn,iproc)=gacontm_hb2(2,j,ii) -> zapas(17,nn,iproc)=gacontm_hb2(3,j,ii) -> zapas(18,nn,iproc)=gacontp_hb2(1,j,ii) -> zapas(19,nn,iproc)=gacontp_hb2(2,j,ii) -> zapas(20,nn,iproc)=gacontp_hb2(3,j,ii) -> zapas(21,nn,iproc)=gacontm_hb3(1,j,ii) -> zapas(22,nn,iproc)=gacontm_hb3(2,j,ii) -> zapas(23,nn,iproc)=gacontm_hb3(3,j,ii) -> zapas(24,nn,iproc)=gacontp_hb3(1,j,ii) -> zapas(25,nn,iproc)=gacontp_hb3(2,j,ii) -> zapas(26,nn,iproc)=gacontp_hb3(3,j,ii) -> exit -> endif -> enddo -> endif -> enddo -> return -> end -> c------------------------------------------------------------------------------ -4897d6163 -< include 'DIMENSIONS.ZSCOPT' -4899,4900c6165,6174 -< #ifdef MPL -< include 'COMMON.INFO' ---- -> #ifdef MPI -> include "mpif.h" -> parameter (max_cont=maxconts) -> parameter (max_dim=70) -> integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error -> double precision zapas(max_dim,maxconts,max_fg_procs), -> & zapas_recv(max_dim,maxconts,max_fg_procs) -> common /przechowalnia/ zapas -> integer status(MPI_STATUS_SIZE),req(maxconts*2), -> & status_array(MPI_STATUS_SIZE,maxconts*2) -4901a6176 -> include 'COMMON.SETUP' -4903a6179 -> include 'COMMON.LOCAL' -4906,4913c6182,6183 -< #ifdef MPL -< parameter (max_cont=maxconts) -< parameter (max_dim=2*(8*3+2)) -< parameter (msglen1=max_cont*max_dim*4) -< parameter (msglen2=2*msglen1) -< integer source,CorrelType,CorrelID,Error -< double precision buffer(max_cont,max_dim) -< #endif ---- -> include 'COMMON.CHAIN' -> include 'COMMON.CONTROL' -4914a6185 -> integer num_cont_hb_old(maxres) -4916c6187,6188 -< ---- -> double precision eello4,eello5,eelo6,eello_turn6 -> external eello4,eello5,eello6,eello_turn6 -4920c6192,6195 -< #ifdef MPL ---- -> #ifdef MPI -> do i=1,nres -> num_cont_hb_old(i)=num_cont_hb(i) -> enddo -4923c6198 -< if (fgProcs.le.1) goto 30 ---- -> if (nfgtasks.le.1) goto 30 -4925c6200 -< write (iout,'(a)') 'Contact function values:' ---- -> write (iout,'(a)') 'Contact function values before RECEIVE:' -4932,4933c6207,6282 -< C Caution! Following code assumes that electrostatic interactions concerning -< C a given atom are split among at most two processors! ---- -> call flush(iout) -> do i=1,ntask_cont_from -> ncont_recv(i)=0 -> enddo -> do i=1,ntask_cont_to -> ncont_sent(i)=0 -> enddo -> c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to", -> c & ntask_cont_to -> C Make the list of contacts to send to send to other procesors -> do i=iturn3_start,iturn3_end -> c write (iout,*) "make contact list turn3",i," num_cont", -> c & num_cont_hb(i) -> call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i)) -> enddo -> do i=iturn4_start,iturn4_end -> c write (iout,*) "make contact list turn4",i," num_cont", -> c & num_cont_hb(i) -> call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i)) -> enddo -> do ii=1,nat_sent -> i=iat_sent(ii) -> c write (iout,*) "make contact list longrange",i,ii," num_cont", -> c & num_cont_hb(i) -> do j=1,num_cont_hb(i) -> do k=1,4 -> jjc=jcont_hb(j,i) -> iproc=iint_sent_local(k,jjc,ii) -> c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc -> if (iproc.ne.0) then -> ncont_sent(iproc)=ncont_sent(iproc)+1 -> nn=ncont_sent(iproc) -> zapas(1,nn,iproc)=i -> zapas(2,nn,iproc)=jjc -> zapas(3,nn,iproc)=d_cont(j,i) -> ind=3 -> do kk=1,3 -> ind=ind+1 -> zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i) -> enddo -> do kk=1,2 -> do ll=1,2 -> ind=ind+1 -> zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i) -> enddo -> enddo -> do jj=1,5 -> do kk=1,3 -> do ll=1,2 -> do mm=1,2 -> ind=ind+1 -> zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i) -> enddo -> enddo -> enddo -> enddo -> endif -> enddo -> enddo -> enddo -> if (lprn) then -> write (iout,*) -> & "Numbers of contacts to be sent to other processors", -> & (ncont_sent(i),i=1,ntask_cont_to) -> write (iout,*) "Contacts sent" -> do ii=1,ntask_cont_to -> nn=ncont_sent(ii) -> iproc=itask_cont_to(ii) -> write (iout,*) nn," contacts to processor",iproc, -> & " of CONT_TO_COMM group" -> do i=1,nn -> write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10) -> enddo -> enddo -> call flush(iout) -> endif -4935,5023c6284,6403 -< CorrelID=MyID+1 -< ldone=.false. -< do i=1,max_cont -< do j=1,max_dim -< buffer(i,j)=0.0D0 -< enddo -< enddo -< mm=mod(MyRank,2) -< cd write (iout,*) 'MyRank',MyRank,' mm',mm -< if (mm) 20,20,10 -< 10 continue -< cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone -< if (MyRank.gt.0) then -< C Send correlation contributions to the preceding processor -< msglen=msglen1 -< nn=num_cont_hb(iatel_s) -< call pack_buffer(max_cont,max_dim,iatel_s,0,buffer) -< cd write (iout,*) 'The BUFFER array:' -< cd do i=1,nn -< cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26) -< cd enddo -< if (ielstart(iatel_s).gt.iatel_s+ispp) then -< msglen=msglen2 -< call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer) -< C Clear the contacts of the atom passed to the neighboring processor -< nn=num_cont_hb(iatel_s+1) -< cd do i=1,nn -< cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26) -< cd enddo -< num_cont_hb(iatel_s)=0 -< endif -< cd write (iout,*) 'Processor ',MyID,MyRank, -< cd & ' is sending correlation contribution to processor',MyID-1, -< cd & ' msglen=',msglen -< cd write (*,*) 'Processor ',MyID,MyRank, -< cd & ' is sending correlation contribution to processor',MyID-1, -< cd & ' msglen=',msglen,' CorrelType=',CorrelType -< call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID) -< cd write (iout,*) 'Processor ',MyID, -< cd & ' has sent correlation contribution to processor',MyID-1, -< cd & ' msglen=',msglen,' CorrelID=',CorrelID -< cd write (*,*) 'Processor ',MyID, -< cd & ' has sent correlation contribution to processor',MyID-1, -< cd & ' msglen=',msglen,' CorrelID=',CorrelID -< msglen=msglen1 -< endif ! (MyRank.gt.0) -< if (ldone) goto 30 -< ldone=.true. -< 20 continue -< cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone -< if (MyRank.lt.fgProcs-1) then -< C Receive correlation contributions from the next processor -< msglen=msglen1 -< if (ielend(iatel_e).lt.nct-1) msglen=msglen2 -< cd write (iout,*) 'Processor',MyID, -< cd & ' is receiving correlation contribution from processor',MyID+1, -< cd & ' msglen=',msglen,' CorrelType=',CorrelType -< cd write (*,*) 'Processor',MyID, -< cd & ' is receiving correlation contribution from processor',MyID+1, -< cd & ' msglen=',msglen,' CorrelType=',CorrelType -< nbytes=-1 -< do while (nbytes.le.0) -< call mp_probe(MyID+1,CorrelType,nbytes) -< enddo -< cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes -< call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes) -< cd write (iout,*) 'Processor',MyID, -< cd & ' has received correlation contribution from processor',MyID+1, -< cd & ' msglen=',msglen,' nbytes=',nbytes -< cd write (iout,*) 'The received BUFFER array:' -< cd do i=1,max_cont -< cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52) -< cd enddo -< if (msglen.eq.msglen1) then -< call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer) -< else if (msglen.eq.msglen2) then -< call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer) -< call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer) -< else -< write (iout,*) -< & 'ERROR!!!! message length changed while processing correlations.' -< write (*,*) -< & 'ERROR!!!! message length changed while processing correlations.' -< call mp_stopall(Error) -< endif ! msglen.eq.msglen1 -< endif ! MyRank.lt.fgProcs-1 -< if (ldone) goto 30 -< ldone=.true. -< goto 10 ---- -> CorrelID=fg_rank+1 -> CorrelType1=478 -> CorrelID1=nfgtasks+fg_rank+1 -> ireq=0 -> C Receive the numbers of needed contacts from other processors -> do ii=1,ntask_cont_from -> iproc=itask_cont_from(ii) -> ireq=ireq+1 -> call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType, -> & FG_COMM,req(ireq),IERR) -> enddo -> c write (iout,*) "IRECV ended" -> c call flush(iout) -> C Send the number of contacts needed by other processors -> do ii=1,ntask_cont_to -> iproc=itask_cont_to(ii) -> ireq=ireq+1 -> call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType, -> & FG_COMM,req(ireq),IERR) -> enddo -> c write (iout,*) "ISEND ended" -> c write (iout,*) "number of requests (nn)",ireq -> call flush(iout) -> if (ireq.gt.0) -> & call MPI_Waitall(ireq,req,status_array,ierr) -> c write (iout,*) -> c & "Numbers of contacts to be received from other processors", -> c & (ncont_recv(i),i=1,ntask_cont_from) -> c call flush(iout) -> C Receive contacts -> ireq=0 -> do ii=1,ntask_cont_from -> iproc=itask_cont_from(ii) -> nn=ncont_recv(ii) -> c write (iout,*) "Receiving",nn," contacts from processor",iproc, -> c & " of CONT_TO_COMM group" -> call flush(iout) -> if (nn.gt.0) then -> ireq=ireq+1 -> call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim, -> & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR) -> c write (iout,*) "ireq,req",ireq,req(ireq) -> endif -> enddo -> C Send the contacts to processors that need them -> do ii=1,ntask_cont_to -> iproc=itask_cont_to(ii) -> nn=ncont_sent(ii) -> c write (iout,*) nn," contacts to processor",iproc, -> c & " of CONT_TO_COMM group" -> if (nn.gt.0) then -> ireq=ireq+1 -> call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION, -> & iproc,CorrelType1,FG_COMM,req(ireq),IERR) -> c write (iout,*) "ireq,req",ireq,req(ireq) -> c do i=1,nn -> c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) -> c enddo -> endif -> enddo -> c write (iout,*) "number of requests (contacts)",ireq -> c write (iout,*) "req",(req(i),i=1,4) -> c call flush(iout) -> if (ireq.gt.0) -> & call MPI_Waitall(ireq,req,status_array,ierr) -> do iii=1,ntask_cont_from -> iproc=itask_cont_from(iii) -> nn=ncont_recv(iii) -> if (lprn) then -> write (iout,*) "Received",nn," contacts from processor",iproc, -> & " of CONT_FROM_COMM group" -> call flush(iout) -> do i=1,nn -> write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10) -> enddo -> call flush(iout) -> endif -> do i=1,nn -> ii=zapas_recv(1,i,iii) -> c Flag the received contacts to prevent double-counting -> jj=-zapas_recv(2,i,iii) -> c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj -> c call flush(iout) -> nnn=num_cont_hb(ii)+1 -> num_cont_hb(ii)=nnn -> jcont_hb(nnn,ii)=jj -> d_cont(nnn,ii)=zapas_recv(3,i,iii) -> ind=3 -> do kk=1,3 -> ind=ind+1 -> grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii) -> enddo -> do kk=1,2 -> do ll=1,2 -> ind=ind+1 -> a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii) -> enddo -> enddo -> do jj=1,5 -> do kk=1,3 -> do ll=1,2 -> do mm=1,2 -> ind=ind+1 -> a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii) -> enddo -> enddo -> enddo -> enddo -> enddo -> enddo -> call flush(iout) -> if (lprn) then -> write (iout,'(a)') 'Contact function values after receive:' -> do i=nnt,nct-2 -> write (iout,'(2i3,50(1x,i3,5f6.3))') -> & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i), -> & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i)) -> enddo -> call flush(iout) -> endif -5029,5031c6409,6411 -< write (iout,'(2i3,50(1x,i2,f5.2))') -< & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), -< & j=1,num_cont_hb(i)) ---- -> write (iout,'(2i3,50(1x,i2,5f6.3))') -> & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i), -> & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i)) -5049a6430 -> #ifdef MOMENT -5050a6432 -> #endif -5055c6437,6443 -< do i=iatel_s,iatel_e+1 ---- -> c write (iout,*) "gradcorr5 in eello5 before loop" -> c do iii=1,nres -> c write (iout,'(i5,3f10.5)') -> c & iii,(gradcorr5(jjj,iii),jjj=1,3) -> c enddo -> do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1) -> c write (iout,*) "corr loop i",i -5060a6449 -> jp=iabs(j) -5063c6452,6453 -< c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, ---- -> jp1=iabs(j1) -> c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -5065c6455,6458 -< if (j1.eq.j+1 .or. j1.eq.j-1) then ---- -> c if (j1.eq.j+1 .or. j1.eq.j-1) then -> if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 -> & .or. j.lt.0 .and. j1.gt.0) .and. -> & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then -5075,5076c6468,6469 -< c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -< c & ' jj=',jj,' kk=',kk ---- -> cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1, -> cd & ' jj=',jj,' kk=',kk -5085,5086c6478,6483 -< cd & ' ekont=',ekont,' fprim=',fprimcont -< call calc_eello(i,j,i+1,j1,jj,kk) ---- -> cd & ' ekont=',ekont,' fprim=',fprimcont, -> cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2 -> cd write (iout,*) "g_contij",g_contij -> cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i) -> cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1) -> call calc_eello(i,jp,i+1,jp1,jj,kk) -5088c6485,6493 -< & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk) ---- -> & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk) -> if (energy_dec.and.wcorr4.gt.0.0d0) -> 1 write (iout,'(a6,4i5,0pf7.3)') -> 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk) -> c write (iout,*) "gradcorr5 before eello5" -> c do iii=1,nres -> c write (iout,'(i5,3f10.5)') -> c & iii,(gradcorr5(jjj,iii),jjj=1,3) -> c enddo -5090,5091c6495,6503 -< & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk) -< c print *,"wcorr5",ecorr5 ---- -> & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk) -> c write (iout,*) "gradcorr5 after eello5" -> c do iii=1,nres -> c write (iout,'(i5,3f10.5)') -> c & iii,(gradcorr5(jjj,iii),jjj=1,3) -> c enddo -> if (energy_dec.and.wcorr5.gt.0.0d0) -> 1 write (iout,'(a6,4i5,0pf7.3)') -> 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk) -5093,5094c6505,6506 -< cd write(2,*)'ijkl',i,j,i+1,j1 -< if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3 ---- -> cd write(2,*)'ijkl',i,jp,i+1,jp1 -> if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 -5097c6509,6511 -< ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk) ---- -> ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk) -> if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') -> 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk) -5101,5103c6515,6517 -< cd & dabs(eello4(i,j,i+1,j1,jj,kk)), -< cd & dabs(eello5(i,j,i+1,j1,jj,kk)), -< cd & dabs(eello6(i,j,i+1,j1,jj,kk)) ---- -> cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)), -> cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)), -> cd & dabs(eello6(i,jp,i+1,jp1,jj,kk)) -5105,5106c6519,6520 -< & .and. (j.eq.i+4 .and. j1.eq.i+3)) then -< cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1 ---- -> & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then -> cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1 -5107a6522,6523 -> if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') -> 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk) -5112,5115d6527 -< else if (j1.eq.j) then -< C Contacts I-J and I-(J+1) occur simultaneously. -< C The system loses extra energy. -< c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0) -5118,5127d6529 -< do kk=1,num_conti -< j1=jcont_hb(kk,i) -< c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -< c & ' jj=',jj,' kk=',kk -< if (j1.eq.j+1) then -< C Contacts I-J and (I+1)-J occur simultaneously. -< C The system loses extra energy. -< c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0) -< endif ! j1==j+1 -< enddo ! kk -5129a6532,6594 -> do i=1,nres -> num_cont_hb(i)=num_cont_hb_old(i) -> enddo -> c write (iout,*) "gradcorr5 in eello5" -> c do iii=1,nres -> c write (iout,'(i5,3f10.5)') -> c & iii,(gradcorr5(jjj,iii),jjj=1,3) -> c enddo -> return -> end -> c------------------------------------------------------------------------------ -> subroutine add_hb_contact_eello(ii,jj,itask) -> implicit real*8 (a-h,o-z) -> include "DIMENSIONS" -> include "COMMON.IOUNITS" -> integer max_cont -> integer max_dim -> parameter (max_cont=maxconts) -> parameter (max_dim=70) -> include "COMMON.CONTACTS" -> double precision zapas(max_dim,maxconts,max_fg_procs), -> & zapas_recv(max_dim,maxconts,max_fg_procs) -> common /przechowalnia/ zapas -> integer i,j,ii,jj,iproc,itask(4),nn -> c write (iout,*) "itask",itask -> do i=1,2 -> iproc=itask(i) -> if (iproc.gt.0) then -> do j=1,num_cont_hb(ii) -> jjc=jcont_hb(j,ii) -> c write (iout,*) "send turns i",ii," j",jj," jjc",jjc -> if (jjc.eq.jj) then -> ncont_sent(iproc)=ncont_sent(iproc)+1 -> nn=ncont_sent(iproc) -> zapas(1,nn,iproc)=ii -> zapas(2,nn,iproc)=jjc -> zapas(3,nn,iproc)=d_cont(j,ii) -> ind=3 -> do kk=1,3 -> ind=ind+1 -> zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii) -> enddo -> do kk=1,2 -> do ll=1,2 -> ind=ind+1 -> zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii) -> enddo -> enddo -> do jj=1,5 -> do kk=1,3 -> do ll=1,2 -> do mm=1,2 -> ind=ind+1 -> zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii) -> enddo -> enddo -> enddo -> enddo -> exit -> endif -> enddo -> endif -> enddo -5157,5161c6622,6626 -< c write (iout,*)'Contacts have occurred for peptide groups',i,j, -< c & ' and',k,l -< c write (iout,*)'Contacts have occurred for peptide groups', -< c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l -< c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees ---- -> c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)') -> c & 'Contacts ',i,j, -> c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l -> c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees, -> c & 'gradcorr_long' -5163,5164c6628 -< ecorr=ecorr+ekont*ees -< if (calc_grad) then ---- -> c ecorr=ecorr+ekont*ees -5165a6630,6633 -> coeffpees0pij=coeffp*ees0pij -> coeffmees0mij=coeffm*ees0mij -> coeffpees0pkl=coeffp*ees0pkl -> coeffmees0mkl=coeffm*ees0mkl -5167,5198c6635,6678 -< ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i) -< gradcorr(ll,i)=gradcorr(ll,i)+ghalf -< & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+ -< & coeffm*ees0mkl*gacontm_hb1(ll,jj,i)) -< gradcorr(ll,j)=gradcorr(ll,j)+ghalf -< & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+ -< & coeffm*ees0mkl*gacontm_hb2(ll,jj,i)) -< ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k) -< gradcorr(ll,k)=gradcorr(ll,k)+ghalf -< & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+ -< & coeffm*ees0mij*gacontm_hb1(ll,kk,k)) -< gradcorr(ll,l)=gradcorr(ll,l)+ghalf -< & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+ -< & coeffm*ees0mij*gacontm_hb2(ll,kk,k)) -< enddo -< do m=i+1,j-1 -< do ll=1,3 -< gradcorr(ll,m)=gradcorr(ll,m)+ -< & ees*ekl*gacont_hbr(ll,jj,i)- -< & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+ -< & coeffm*ees0mkl*gacontm_hb3(ll,jj,i)) -< enddo -< enddo -< do m=k+1,l-1 -< do ll=1,3 -< gradcorr(ll,m)=gradcorr(ll,m)+ -< & ees*eij*gacont_hbr(ll,kk,k)- -< & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+ -< & coeffm*ees0mij*gacontm_hb3(ll,kk,k)) -< enddo -< enddo -< endif ---- -> cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i) -> gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi -> & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ -> & coeffmees0mkl*gacontm_hb1(ll,jj,i)) -> gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi -> & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ -> & coeffmees0mkl*gacontm_hb2(ll,jj,i)) -> cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k) -> gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk -> & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ -> & coeffmees0mij*gacontm_hb1(ll,kk,k)) -> gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk -> & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ -> & coeffmees0mij*gacontm_hb2(ll,kk,k)) -> gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- -> & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ -> & coeffmees0mkl*gacontm_hb3(ll,jj,i)) -> gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij -> gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij -> gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- -> & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ -> & coeffmees0mij*gacontm_hb3(ll,kk,k)) -> gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl -> gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl -> c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl -> enddo -> c write (iout,*) -> cgrad do m=i+1,j-1 -> cgrad do ll=1,3 -> cgrad gradcorr(ll,m)=gradcorr(ll,m)+ -> cgrad & ees*ekl*gacont_hbr(ll,jj,i)- -> cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+ -> cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i)) -> cgrad enddo -> cgrad enddo -> cgrad do m=k+1,l-1 -> cgrad do ll=1,3 -> cgrad gradcorr(ll,m)=gradcorr(ll,m)+ -> cgrad & ees*eij*gacont_hbr(ll,kk,k)- -> cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+ -> cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k)) -> cgrad enddo -> cgrad enddo -> c write (iout,*) "ehbcorr",ekont*ees -5201a6682 -> #ifdef MOMENT -5206d6686 -< include 'DIMENSIONS.ZSCOPT' -5240d6719 -< if (.not.calc_grad) return -5264a6744 -> #endif -5273d6752 -< include 'DIMENSIONS.ZSCOPT' -5289a6769,6770 -> cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2) -> cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2) -5650d7130 -< include 'DIMENSIONS.ZSCOPT' -5671d7150 -< if (calc_grad) then -5713,5718c7192,7197 -< cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i) -< ggg1(ll)=eel4*g_contij(ll,1) -< ggg2(ll)=eel4*g_contij(ll,2) -< ghalf=0.5d0*ggg1(ll) -< cd ghalf=0.0d0 -< gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1) ---- -> cgrad ggg1(ll)=eel4*g_contij(ll,1) -> cgrad ggg2(ll)=eel4*g_contij(ll,2) -> glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1) -> glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2) -> cgrad ghalf=0.5d0*ggg1(ll) -> gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1) -5720c7199 -< gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1) ---- -> gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1) -5722,5725c7201,7204 -< cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k) -< ghalf=0.5d0*ggg2(ll) -< cd ghalf=0.0d0 -< gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2) ---- -> gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij -> gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij -> cgrad ghalf=0.5d0*ggg2(ll) -> gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2) -5727c7206 -< gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2) ---- -> gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2) -5728a7208,7209 -> gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl -> gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl -5730,5753c7211,7230 -< cd goto 1112 -< do m=i+1,j-1 -< do ll=1,3 -< cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i) -< gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll) -< enddo -< enddo -< do m=k+1,l-1 -< do ll=1,3 -< cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k) -< gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll) -< enddo -< enddo -< 1112 continue -< do m=i+2,j2 -< do ll=1,3 -< gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1) -< enddo -< enddo -< do m=k+2,l2 -< do ll=1,3 -< gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2) -< enddo -< enddo ---- -> cgrad do m=i+1,j-1 -> cgrad do ll=1,3 -> cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll) -> cgrad enddo -> cgrad enddo -> cgrad do m=k+1,l-1 -> cgrad do ll=1,3 -> cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll) -> cgrad enddo -> cgrad enddo -> cgrad do m=i+2,j2 -> cgrad do ll=1,3 -> cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1) -> cgrad enddo -> cgrad enddo -> cgrad do m=k+2,l2 -> cgrad do ll=1,3 -> cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2) -> cgrad enddo -> cgrad enddo -5757d7233 -< endif -5767d7242 -< include 'DIMENSIONS.ZSCOPT' -5847d7321 -< if (calc_grad) then -5886d7359 -< endif -5895d7367 -< if (calc_grad) then -5926d7397 -< endif -5938d7408 -< if (calc_grad) then -5971d7440 -< endif -5980d7448 -< if (calc_grad) then -6004d7471 -< endif -6015d7481 -< if (calc_grad) then -6048d7513 -< endif -6057d7521 -< if (calc_grad) then -6082d7545 -< endif -6094d7556 -< if (calc_grad) then -6112a7575,7578 -> C 2/11/08 AL Gradients over DC's connecting interacting sites will be -> C summed up outside the subrouine as for the other subroutines -> C handling long-range interactions. The old code is commented out -> C with "cgrad" to keep track of changes. -6114,6115c7580,7591 -< ggg1(ll)=eel5*g_contij(ll,1) -< ggg2(ll)=eel5*g_contij(ll,2) ---- -> cgrad ggg1(ll)=eel5*g_contij(ll,1) -> cgrad ggg2(ll)=eel5*g_contij(ll,2) -> gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1) -> gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2) -> c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)') -> c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1), -> c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2), -> c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont -> c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)') -> c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1), -> c & gradcorr5ij, -> c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl -6117c7593 -< ghalf=0.5d0*ggg1(ll) ---- -> cgrad ghalf=0.5d0*ggg1(ll) -6119c7595 -< gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1) ---- -> gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1) -6121c7597 -< gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1) ---- -> gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1) -6122a7599,7600 -> gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij -> gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij -6124c7602 -< ghalf=0.5d0*ggg2(ll) ---- -> cgrad ghalf=0.5d0*ggg2(ll) -6129a7608,7609 -> gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl -> gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl -6132,6133c7612,7613 -< do m=i+1,j-1 -< do ll=1,3 ---- -> cgrad do m=i+1,j-1 -> cgrad do ll=1,3 -6135,6139c7615,7619 -< gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll) -< enddo -< enddo -< do m=k+1,l-1 -< do ll=1,3 ---- -> cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll) -> cgrad enddo -> cgrad enddo -> cgrad do m=k+1,l-1 -> cgrad do ll=1,3 -6141,6143c7621,7623 -< gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll) -< enddo -< enddo ---- -> cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll) -> cgrad enddo -> cgrad enddo -6145,6154c7625,7634 -< do m=i+2,j2 -< do ll=1,3 -< gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1) -< enddo -< enddo -< do m=k+2,l2 -< do ll=1,3 -< gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2) -< enddo -< enddo ---- -> cgrad do m=i+2,j2 -> cgrad do ll=1,3 -> cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1) -> cgrad enddo -> cgrad enddo -> cgrad do m=k+2,l2 -> cgrad do ll=1,3 -> cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2) -> cgrad enddo -> cgrad enddo -6158d7637 -< endif -6168d7646 -< include 'DIMENSIONS.ZSCOPT' -6228,6233c7706,7711 -< cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num -< cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num -< cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num -< cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num -< cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num -< cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num ---- -> cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num -> cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num -> cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num -> cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num -> cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num -> cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num -6235d7712 -< if (calc_grad) then -6251,6252c7728,7729 -< ggg1(ll)=eel6*g_contij(ll,1) -< ggg2(ll)=eel6*g_contij(ll,2) ---- -> cgrad ggg1(ll)=eel6*g_contij(ll,1) -> cgrad ggg2(ll)=eel6*g_contij(ll,2) -6254c7731 -< ghalf=0.5d0*ggg1(ll) ---- -> cgrad ghalf=0.5d0*ggg1(ll) -6256c7733,7735 -< gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1) ---- -> gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1) -> gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2) -> gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1) -6258c7737 -< gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1) ---- -> gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1) -6260c7739,7741 -< ghalf=0.5d0*ggg2(ll) ---- -> gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij -> gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij -> cgrad ghalf=0.5d0*ggg2(ll) -6263c7744 -< gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2) ---- -> gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2) -6265c7746 -< gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2) ---- -> gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2) -6266a7748,7749 -> gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl -> gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl -6269,6270c7752,7753 -< do m=i+1,j-1 -< do ll=1,3 ---- -> cgrad do m=i+1,j-1 -> cgrad do ll=1,3 -6272,6276c7755,7759 -< gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll) -< enddo -< enddo -< do m=k+1,l-1 -< do ll=1,3 ---- -> cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll) -> cgrad enddo -> cgrad enddo -> cgrad do m=k+1,l-1 -> cgrad do ll=1,3 -6278,6291c7761,7774 -< gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll) -< enddo -< enddo -< 1112 continue -< do m=i+2,j2 -< do ll=1,3 -< gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1) -< enddo -< enddo -< do m=k+2,l2 -< do ll=1,3 -< gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2) -< enddo -< enddo ---- -> cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll) -> cgrad enddo -> cgrad enddo -> cgrad1112 continue -> cgrad do m=i+2,j2 -> cgrad do ll=1,3 -> cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1) -> cgrad enddo -> cgrad enddo -> cgrad do m=k+2,l2 -> cgrad do ll=1,3 -> cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2) -> cgrad enddo -> cgrad enddo -6295d7777 -< endif -6305d7786 -< include 'DIMENSIONS.ZSCOPT' -6346d7826 -< if (.not. calc_grad) return -6411d7890 -< include 'DIMENSIONS.ZSCOPT' -6461d7939 -< if (.not. calc_grad) return -6598d8075 -< include 'DIMENSIONS.ZSCOPT' -6651c8128,8129 -< cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4 ---- -> cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4, -> cd & "sum",-(s2+s3+s4) -6658d8135 -< if (.not. calc_grad) return -6714d8190 -< include 'DIMENSIONS.ZSCOPT' -6794d8269 -< if (.not. calc_grad) return -6960d8434 -< include 'DIMENSIONS.ZSCOPT' -6975a8450,8453 -> s1=0.0d0 -> s8=0.0d0 -> s13=0.0d0 -> c -7013,7014d8490 -< #else -< s1 = 0.0d0 -7024,7025d8499 -< #else -< s8=0.0d0 -7037,7038d8510 -< #else -< s13=0.0d0 -7047d8518 -< if (calc_grad) then -7048a8520,8521 -> s1d =0.0d0 -> s8d =0.0d0 -7056,7057d8528 -< #else -< s8d=0.0d0 -7074,7075d8544 -< #else -< s1d=0.0d0 -7089,7090d8557 -< #else -< s13d=0.0d0 -7112,7113d8578 -< #else -< s13d = 0.0d0 -7130,7131d8594 -< #else -< s1d = 0.0d0 -7140,7141d8602 -< #else -< s8d = 0.0d0 -7149,7150d8609 -< #else -< s13d = 0.0d0 -7172,7173d8630 -< #else -< s1d = 0.0d0 -7184,7185d8640 -< #else -< s8d = 0.0d0 -7248,7250c8703,8705 -< ggg1(ll)=eel_turn6*g_contij(ll,1) -< ggg2(ll)=eel_turn6*g_contij(ll,2) -< ghalf=0.5d0*ggg1(ll) ---- -> cgrad ggg1(ll)=eel_turn6*g_contij(ll,1) -> cgrad ggg2(ll)=eel_turn6*g_contij(ll,2) -> cgrad ghalf=0.5d0*ggg1(ll) -7252c8707,8709 -< gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf ---- -> gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1) -> gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2) -> gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf -7255c8712 -< gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf ---- -> gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf -7258c8715,8717 -< ghalf=0.5d0*ggg2(ll) ---- -> gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij -> gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij -> cgrad ghalf=0.5d0*ggg2(ll) -7260c8719 -< gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf ---- -> gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf -7263c8722 -< gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf ---- -> gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf -7265a8725,8726 -> gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl -> gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl -7268,7288c8729,8749 -< do m=i+1,j-1 -< do ll=1,3 -< gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll) -< enddo -< enddo -< do m=k+1,l-1 -< do ll=1,3 -< gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll) -< enddo -< enddo -< 1112 continue -< do m=i+2,j2 -< do ll=1,3 -< gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1) -< enddo -< enddo -< do m=k+2,l2 -< do ll=1,3 -< gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2) -< enddo -< enddo ---- -> cgrad do m=i+1,j-1 -> cgrad do ll=1,3 -> cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll) -> cgrad enddo -> cgrad enddo -> cgrad do m=k+1,l-1 -> cgrad do ll=1,3 -> cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll) -> cgrad enddo -> cgrad enddo -> cgrad1112 continue -> cgrad do m=i+2,j2 -> cgrad do ll=1,3 -> cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1) -> cgrad enddo -> cgrad enddo -> cgrad do m=k+2,l2 -> cgrad do ll=1,3 -> cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2) -> cgrad enddo -> cgrad enddo -7292d8752 -< endif -7297a8758,8777 -> -> C----------------------------------------------------------------------------- -> double precision function scalar(u,v) -> !DIR$ INLINEALWAYS scalar -> #ifndef OSF -> cDEC$ ATTRIBUTES FORCEINLINE::scalar -> #endif -> implicit none -> double precision u(3),v(3) -> cd double precision sc -> cd integer i -> cd sc=0.0d0 -> cd do i=1,3 -> cd sc=sc+u(i)*v(i) -> cd enddo -> cd scalar=sc -> -> scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3) -> return -> end -7299a8780,8783 -> !DIR$ INLINEALWAYS MATVEC2 -> #ifndef OSF -> cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2 -> #endif -7317a8802,8804 -> #ifndef OSF -> cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2 -> #endif -7343a8831 -> !DIR$ INLINEALWAYS scalar2 -7354a8843,8846 -> !DIR$ INLINEALWAYS transpose2 -> #ifndef OSF -> cDEC$ ATTRIBUTES FORCEINLINE::transpose2 -> #endif -7376a8869,8872 -> !DIR$ INLINEALWAYS prodmat3 -> #ifndef OSF -> cDEC$ ATTRIBUTES FORCEINLINE::prodmat3 -> #endif -7419,7431d8914 -< C----------------------------------------------------------------------------- -< double precision function scalar(u,v) -< implicit none -< double precision u(3),v(3) -< double precision sc -< integer i -< sc=0.0d0 -< do i=1,3 -< sc=sc+u(i)*v(i) -< enddo -< scalar=sc -< return -< end diff --git a/source/wham/src-M/xdrf.org/Makefile b/source/wham/src-M/xdrf.org/Makefile deleted file mode 100644 index 0af9b06..0000000 --- a/source/wham/src-M/xdrf.org/Makefile +++ /dev/null @@ -1,31 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -BGLSYS = /bgl/BlueLight/ppcfloor/bglsys - -CC = xlc -CPPC = xlc - -CFLAGS= -I. -O2 -qarch=440d -qtune=440 - -M4 = m4 -M4FILE = RS6K.m4 - -libxdrf.a: libxdrf.o ftocstr.o xdr_array.o xdr.o xdr_float.o xdr_stdio.o - ar cr libxdrf.a $? - -clean: - rm -f libxdrf.o ftocstr.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c -# rm -f libxdrf.c - diff --git a/source/wham/src-M/xdrf.org/RS6K.m4 b/source/wham/src-M/xdrf.org/RS6K.m4 deleted file mode 100644 index 0331d97..0000000 --- a/source/wham/src-M/xdrf.org/RS6K.m4 +++ /dev/null @@ -1,20 +0,0 @@ -divert(-1) -undefine(`len') -# -# do nothing special to FORTRAN function names -# -define(`FUNCTION',`$1') -# -# FORTRAN character strings are passed as follows: -# a pointer to the base of the string is passed in the normal -# argument list, and the length is passed by value as an extra -# argument, after all of the other arguments. -# -define(`ARGS',`($1`'undivert(1))') -define(`SAVE',`divert(1)$1`'divert(0)') -define(`STRING_ARG',`$1_ptr`'SAVE(`, $1_len')') -define(`STRING_ARG_DECL',`char * $1_ptr; int $1_len') -define(`STRING_LEN',`$1_len') -define(`STRING_PTR',`$1_ptr') -divert(0) - diff --git a/source/wham/src-M/xdrf.org/features.h b/source/wham/src-M/xdrf.org/features.h deleted file mode 100644 index 5733b9b..0000000 --- a/source/wham/src-M/xdrf.org/features.h +++ /dev/null @@ -1,334 +0,0 @@ -/* Copyright (C) 1991-1993,1995-2003,2004,2005 Free Software Foundation, Inc. - This file is part of the GNU C Library. - - The GNU C Library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - The GNU C Library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with the GNU C Library; if not, write to the Free - Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - 02111-1307 USA. */ - -#ifndef _FEATURES_H -#define _FEATURES_H 1 - -/* These are defined by the user (or the compiler) - to specify the desired environment: - - __STRICT_ANSI__ ISO Standard C. - _ISOC99_SOURCE Extensions to ISO C89 from ISO C99. - _POSIX_SOURCE IEEE Std 1003.1. - _POSIX_C_SOURCE If ==1, like _POSIX_SOURCE; if >=2 add IEEE Std 1003.2; - if >=199309L, add IEEE Std 1003.1b-1993; - if >=199506L, add IEEE Std 1003.1c-1995; - if >=200112L, all of IEEE 1003.1-2004 - _XOPEN_SOURCE Includes POSIX and XPG things. Set to 500 if - Single Unix conformance is wanted, to 600 for the - upcoming sixth revision. - _XOPEN_SOURCE_EXTENDED XPG things and X/Open Unix extensions. - _LARGEFILE_SOURCE Some more functions for correct standard I/O. - _LARGEFILE64_SOURCE Additional functionality from LFS for large files. - _FILE_OFFSET_BITS=N Select default filesystem interface. - _BSD_SOURCE ISO C, POSIX, and 4.3BSD things. - _SVID_SOURCE ISO C, POSIX, and SVID things. - _GNU_SOURCE All of the above, plus GNU extensions. - _REENTRANT Select additionally reentrant object. - _THREAD_SAFE Same as _REENTRANT, often used by other systems. - _FORTIFY_SOURCE If set to numeric value > 0 additional security - measures are defined, according to level. - - The `-ansi' switch to the GNU C compiler defines __STRICT_ANSI__. - If none of these are defined, the default is to have _SVID_SOURCE, - _BSD_SOURCE, and _POSIX_SOURCE set to one and _POSIX_C_SOURCE set to - 199506L. If more than one of these are defined, they accumulate. - For example __STRICT_ANSI__, _POSIX_SOURCE and _POSIX_C_SOURCE - together give you ISO C, 1003.1, and 1003.2, but nothing else. - - These are defined by this file and are used by the - header files to decide what to declare or define: - - __USE_ISOC99 Define ISO C99 things. - __USE_POSIX Define IEEE Std 1003.1 things. - __USE_POSIX2 Define IEEE Std 1003.2 things. - __USE_POSIX199309 Define IEEE Std 1003.1, and .1b things. - __USE_POSIX199506 Define IEEE Std 1003.1, .1b, .1c and .1i things. - __USE_XOPEN Define XPG things. - __USE_XOPEN_EXTENDED Define X/Open Unix things. - __USE_UNIX98 Define Single Unix V2 things. - __USE_XOPEN2K Define XPG6 things. - __USE_LARGEFILE Define correct standard I/O things. - __USE_LARGEFILE64 Define LFS things with separate names. - __USE_FILE_OFFSET64 Define 64bit interface as default. - __USE_BSD Define 4.3BSD things. - __USE_SVID Define SVID things. - __USE_MISC Define things common to BSD and System V Unix. - __USE_GNU Define GNU extensions. - __USE_REENTRANT Define reentrant/thread-safe *_r functions. - __USE_FORTIFY_LEVEL Additional security measures used, according to level. - __FAVOR_BSD Favor 4.3BSD things in cases of conflict. - - The macros `__GNU_LIBRARY__', `__GLIBC__', and `__GLIBC_MINOR__' are - defined by this file unconditionally. `__GNU_LIBRARY__' is provided - only for compatibility. All new code should use the other symbols - to test for features. - - All macros listed above as possibly being defined by this file are - explicitly undefined if they are not explicitly defined. - Feature-test macros that are not defined by the user or compiler - but are implied by the other feature-test macros defined (or by the - lack of any definitions) are defined by the file. */ - - -/* Undefine everything, so we get a clean slate. */ -#undef __USE_ISOC99 -#undef __USE_POSIX -#undef __USE_POSIX2 -#undef __USE_POSIX199309 -#undef __USE_POSIX199506 -#undef __USE_XOPEN -#undef __USE_XOPEN_EXTENDED -#undef __USE_UNIX98 -#undef __USE_XOPEN2K -#undef __USE_LARGEFILE -#undef __USE_LARGEFILE64 -#undef __USE_FILE_OFFSET64 -#undef __USE_BSD -#undef __USE_SVID -#undef __USE_MISC -#undef __USE_GNU -#undef __USE_REENTRANT -#undef __USE_FORTIFY_LEVEL -#undef __FAVOR_BSD -#undef __KERNEL_STRICT_NAMES - -/* Suppress kernel-name space pollution unless user expressedly asks - for it. */ -#ifndef _LOOSE_KERNEL_NAMES -# define __KERNEL_STRICT_NAMES -#endif - -/* Always use ISO C things. */ -#define __USE_ANSI 1 - -/* Convenience macros to test the versions of glibc and gcc. - Use them like this: - #if __GNUC_PREREQ (2,8) - ... code requiring gcc 2.8 or later ... - #endif - Note - they won't work for gcc1 or glibc1, since the _MINOR macros - were not defined then. */ -#if defined __GNUC__ && defined __GNUC_MINOR__ -# define __GNUC_PREREQ(maj, min) \ - ((__GNUC__ << 16) + __GNUC_MINOR__ >= ((maj) << 16) + (min)) -#else -# define __GNUC_PREREQ(maj, min) 0 -#endif - - -/* If _BSD_SOURCE was defined by the user, favor BSD over POSIX. */ -#if defined _BSD_SOURCE && \ - !(defined _POSIX_SOURCE || defined _POSIX_C_SOURCE || \ - defined _XOPEN_SOURCE || defined _XOPEN_SOURCE_EXTENDED || \ - defined _GNU_SOURCE || defined _SVID_SOURCE) -# define __FAVOR_BSD 1 -#endif - -/* If _GNU_SOURCE was defined by the user, turn on all the other features. */ -#ifdef _GNU_SOURCE -# undef _ISOC99_SOURCE -# define _ISOC99_SOURCE 1 -# undef _POSIX_SOURCE -# define _POSIX_SOURCE 1 -# undef _POSIX_C_SOURCE -# define _POSIX_C_SOURCE 199506L -# undef _XOPEN_SOURCE -# define _XOPEN_SOURCE 600 -# undef _XOPEN_SOURCE_EXTENDED -# define _XOPEN_SOURCE_EXTENDED 1 -# undef _LARGEFILE64_SOURCE -# define _LARGEFILE64_SOURCE 1 -# undef _BSD_SOURCE -# define _BSD_SOURCE 1 -# undef _SVID_SOURCE -# define _SVID_SOURCE 1 -#endif - -/* If nothing (other than _GNU_SOURCE) is defined, - define _BSD_SOURCE and _SVID_SOURCE. */ -#if (!defined __STRICT_ANSI__ && !defined _ISOC99_SOURCE && \ - !defined _POSIX_SOURCE && !defined _POSIX_C_SOURCE && \ - !defined _XOPEN_SOURCE && !defined _XOPEN_SOURCE_EXTENDED && \ - !defined _BSD_SOURCE && !defined _SVID_SOURCE) -# define _BSD_SOURCE 1 -# define _SVID_SOURCE 1 -#endif - -/* This is to enable the ISO C99 extension. Also recognize the old macro - which was used prior to the standard acceptance. This macro will - eventually go away and the features enabled by default once the ISO C99 - standard is widely adopted. */ -#if (defined _ISOC99_SOURCE || defined _ISOC9X_SOURCE \ - || (defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L)) -# define __USE_ISOC99 1 -#endif - -/* If none of the ANSI/POSIX macros are defined, use POSIX.1 and POSIX.2 - (and IEEE Std 1003.1b-1993 unless _XOPEN_SOURCE is defined). */ -#if ((!defined __STRICT_ANSI__ || (_XOPEN_SOURCE - 0) >= 500) && \ - !defined _POSIX_SOURCE && !defined _POSIX_C_SOURCE) -# define _POSIX_SOURCE 1 -# if defined _XOPEN_SOURCE && (_XOPEN_SOURCE - 0) < 500 -# define _POSIX_C_SOURCE 2 -# else -# define _POSIX_C_SOURCE 199506L -# endif -#endif - -#if defined _POSIX_SOURCE || _POSIX_C_SOURCE >= 1 || defined _XOPEN_SOURCE -# define __USE_POSIX 1 -#endif - -#if defined _POSIX_C_SOURCE && _POSIX_C_SOURCE >= 2 || defined _XOPEN_SOURCE -# define __USE_POSIX2 1 -#endif - -#if (_POSIX_C_SOURCE - 0) >= 199309L -# define __USE_POSIX199309 1 -#endif - -#if (_POSIX_C_SOURCE - 0) >= 199506L -# define __USE_POSIX199506 1 -#endif - -#if (_POSIX_C_SOURCE - 0) >= 200112L -# define __USE_XOPEN2K 1 -#endif - -#ifdef _XOPEN_SOURCE -# define __USE_XOPEN 1 -# if (_XOPEN_SOURCE - 0) >= 500 -# define __USE_XOPEN_EXTENDED 1 -# define __USE_UNIX98 1 -# undef _LARGEFILE_SOURCE -# define _LARGEFILE_SOURCE 1 -# if (_XOPEN_SOURCE - 0) >= 600 -# define __USE_XOPEN2K 1 -# undef __USE_ISOC99 -# define __USE_ISOC99 1 -# endif -# else -# ifdef _XOPEN_SOURCE_EXTENDED -# define __USE_XOPEN_EXTENDED 1 -# endif -# endif -#endif - -#ifdef _LARGEFILE_SOURCE -# define __USE_LARGEFILE 1 -#endif - -#ifdef _LARGEFILE64_SOURCE -# define __USE_LARGEFILE64 1 -#endif - -#if defined _FILE_OFFSET_BITS && _FILE_OFFSET_BITS == 64 -# define __USE_FILE_OFFSET64 1 -#endif - -#if defined _BSD_SOURCE || defined _SVID_SOURCE -# define __USE_MISC 1 -#endif - -#ifdef _BSD_SOURCE -# define __USE_BSD 1 -#endif - -#ifdef _SVID_SOURCE -# define __USE_SVID 1 -#endif - -#ifdef _GNU_SOURCE -# define __USE_GNU 1 -#endif - -#if defined _REENTRANT || defined _THREAD_SAFE -# define __USE_REENTRANT 1 -#endif - -#if _FORTIFY_SOURCE > 0 && __GNUC_PREREQ (4, 1) && __OPTIMIZE__ > 0 -# if _FORTIFY_SOURCE == 1 -# define __USE_FORTIFY_LEVEL 1 -# elif _FORTIFY_SOURCE > 1 -# define __USE_FORTIFY_LEVEL 2 -# endif -#endif - -/* We do support the IEC 559 math functionality, real and complex. */ -#define __STDC_IEC_559__ 1 -#define __STDC_IEC_559_COMPLEX__ 1 - -/* wchar_t uses ISO 10646-1 (2nd ed., published 2000-09-15) / Unicode 3.1. */ -#define __STDC_ISO_10646__ 200009L - -/* This macro indicates that the installed library is the GNU C Library. - For historic reasons the value now is 6 and this will stay from now - on. The use of this variable is deprecated. Use __GLIBC__ and - __GLIBC_MINOR__ now (see below) when you want to test for a specific - GNU C library version and use the values in to get - the sonames of the shared libraries. */ -#undef __GNU_LIBRARY__ -#define __GNU_LIBRARY__ 6 - -/* Major and minor version number of the GNU C library package. Use - these macros to test for features in specific releases. */ -#define __GLIBC__ 2 -#define __GLIBC_MINOR__ 3 - -#define __GLIBC_PREREQ(maj, min) \ - ((__GLIBC__ << 16) + __GLIBC_MINOR__ >= ((maj) << 16) + (min)) - -/* Decide whether a compiler supports the long long datatypes. */ -#if defined __GNUC__ \ - || (defined __PGI && defined __i386__ ) \ - || (defined __INTEL_COMPILER && (defined __i386__ || defined __ia64__)) \ - || (defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L) -# define __GLIBC_HAVE_LONG_LONG 1 -#endif - -/* This is here only because every header file already includes this one. */ -#ifndef __ASSEMBLER__ -# ifndef _SYS_CDEFS_H -# include -# endif - -/* If we don't have __REDIRECT, prototypes will be missing if - __USE_FILE_OFFSET64 but not __USE_LARGEFILE[64]. */ -# if defined __USE_FILE_OFFSET64 && !defined __REDIRECT -# define __USE_LARGEFILE 1 -# define __USE_LARGEFILE64 1 -# endif - -#endif /* !ASSEMBLER */ - -/* Decide whether we can define 'extern inline' functions in headers. */ -#if __GNUC_PREREQ (2, 7) && defined __OPTIMIZE__ \ - && !defined __OPTIMIZE_SIZE__ && !defined __NO_INLINE__ -# define __USE_EXTERN_INLINES 1 -#endif - - -/* This is here only because every header file already includes this one. - Get the definitions of all the appropriate `__stub_FUNCTION' symbols. - contains `#define __stub_FUNCTION' when FUNCTION is a stub - that will always return failure (and set errno to ENOSYS). */ -#include - - -#endif /* features.h */ diff --git a/source/wham/src-M/xdrf.org/ftocstr.c b/source/wham/src-M/xdrf.org/ftocstr.c deleted file mode 100644 index ed2113f..0000000 --- a/source/wham/src-M/xdrf.org/ftocstr.c +++ /dev/null @@ -1,35 +0,0 @@ - - -int ftocstr(ds, dl, ss, sl) - char *ds, *ss; /* dst, src ptrs */ - int dl; /* dst max len */ - int sl; /* src len */ -{ - char *p; - - for (p = ss + sl; --p >= ss && *p == ' '; ) ; - sl = p - ss + 1; - dl--; - ds[0] = 0; - if (sl > dl) - return 1; - while (sl--) - (*ds++ = *ss++); - *ds = '\0'; - return 0; -} - - -int ctofstr(ds, dl, ss) - char *ds; /* dest space */ - int dl; /* max dest length */ - char *ss; /* src string (0-term) */ -{ - while (dl && *ss) { - *ds++ = *ss++; - dl--; - } - while (dl--) - *ds++ = ' '; - return 0; -} diff --git a/source/wham/src-M/xdrf.org/libxdrf.c b/source/wham/src-M/xdrf.org/libxdrf.c deleted file mode 100644 index 7fce1d1..0000000 --- a/source/wham/src-M/xdrf.org/libxdrf.c +++ /dev/null @@ -1,1236 +0,0 @@ - - -/*____________________________________________________________________________ - | - | libxdrf - portable fortran interface to xdr. some xdr routines - | are C routines for compressed coordinates - | - | version 1.1 - | - | This collection of routines is intended to write and read - | data in a portable way to a file, so data written on one type - | of machine can be read back on a different type. - | - | all fortran routines use an integer 'xdrid', which is an id to the - | current xdr file, and is set by xdrfopen. - | most routines have in integer 'ret' which is the return value. - | The value of 'ret' is zero on failure, and most of the time one - | on succes. - | - | There are three routines useful for C users: - | xdropen(), xdrclose(), xdr3dfcoord(). - | The first two replace xdrstdio_create and xdr_destroy, and *must* be - | used when you plan to use xdr3dfcoord(). (they are also a bit - | easier to interface). For writing data other than compressed coordinates - | you should use the standard C xdr routines (see xdr man page) - | - | xdrfopen(xdrid, filename, mode, ret) - | character *(*) filename - | character *(*) mode - | - | this will open the file with the given filename (string) - | and the given mode, it returns an id in xdrid, which is - | to be used in all other calls to xdrf routines. - | mode is 'w' to create, or update an file, for all other - | values of mode the file is opened for reading - | - | you need to call xdrfclose to flush the output and close - | the file. - | Note that you should not use xdrstdio_create, which comes with the - | standard xdr library - | - | xdrfclose(xdrid, ret) - | flush the data to the file, and closes the file; - | You should not use xdr_destroy (which comes standard with - | the xdr libraries. - | - | xdrfbool(xdrid, bp, ret) - | integer pb - | - | This filter produces values of either 1 or 0 - | - | xdrfchar(xdrid, cp, ret) - | character cp - | - | filter that translate between characters and their xdr representation - | Note that the characters in not compressed and occupies 4 bytes. - | - | xdrfdouble(xdrid, dp, ret) - | double dp - | - | read/write a double. - | - | xdrffloat(xdrid, fp, ret) - | float fp - | - | read/write a float. - | - | xdrfint(xdrid, ip, ret) - | integer ip - | - | read/write integer. - | - | xdrflong(xdrid, lp, ret) - | integer lp - | - | this routine has a possible portablility problem due to 64 bits longs. - | - | xdrfshort(xdrid, sp, ret) - | integer *2 sp - | - | xdrfstring(xdrid, sp, maxsize, ret) - | character *(*) - | integer maxsize - | - | read/write a string, with maximum length given by maxsize - | - | xdrfwrapstring(xdris, sp, ret) - | character *(*) - | - | read/write a string (it is the same as xdrfstring accept that it finds - | the stringlength itself. - | - | xdrfvector(xdrid, cp, size, xdrfproc, ret) - | character *(*) - | integer size - | external xdrfproc - | - | read/write an array pointed to by cp, with number of elements - | defined by 'size'. the routine 'xdrfproc' is the name - | of one of the above routines to read/write data (like xdrfdouble) - | In contrast with the c-version you don't need to specify the - | byte size of an element. - | xdrfstring is not allowed here (it is in the c version) - | - | xdrf3dfcoord(xdrid, fp, size, precision, ret) - | real (*) fp - | real precision - | integer size - | - | this is *NOT* a standard xdr routine. I named it this way, because - | it invites people to use the other xdr routines. - | It is introduced to store specifically 3d coordinates of molecules - | (as found in molecular dynamics) and it writes it in a compressed way. - | It starts by multiplying all numbers by precision and - | rounding the result to integer. effectively converting - | all floating point numbers to fixed point. - | it uses an algorithm for compression that is optimized for - | molecular data, but could be used for other 3d coordinates - | as well. There is subtantial overhead involved, so call this - | routine only if you have a large number of coordinates to read/write - | - | ________________________________________________________________________ - | - | Below are the routines to be used by C programmers. Use the 'normal' - | xdr routines to write integers, floats, etc (see man xdr) - | - | int xdropen(XDR *xdrs, const char *filename, const char *type) - | This will open the file with the given filename and the - | given mode. You should pass it an allocated XDR struct - | in xdrs, to be used in all other calls to xdr routines. - | Mode is 'w' to create, or update an file, and for all - | other values of mode the file is opened for reading. - | You need to call xdrclose to flush the output and close - | the file. - | - | Note that you should not use xdrstdio_create, which - | comes with the standard xdr library. - | - | int xdrclose(XDR *xdrs) - | Flush the data to the file, and close the file; - | You should not use xdr_destroy (which comes standard - | with the xdr libraries). - | - | int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) - | This is \fInot\fR a standard xdr routine. I named it this - | way, because it invites people to use the other xdr - | routines. - | - | (c) 1995 Frans van Hoesel, hoesel@chem.rug.nl -*/ - - -#include -#include -#include -/* #include -#include */ -#include "xdr.h" -#include -#include -#include "xdrf.h" - -int ftocstr(char *, int, char *, int); -int ctofstr(char *, int, char *); - -#define MAXID 20 -static FILE *xdrfiles[MAXID]; -static XDR *xdridptr[MAXID]; -static char xdrmodes[MAXID]; -static unsigned int cnt; - -typedef void (* xdrfproc) (int *, void *, int *); - -void -xdrfbool (xdrid, pb, ret) -int *xdrid, *ret; -int *pb; -{ - *ret = xdr_bool(xdridptr[*xdrid], (bool_t *) pb); - cnt += sizeof(int); -} - -void -xdrfchar (xdrid, cp, ret) -int *xdrid, *ret; -char *cp; -{ - *ret = xdr_char(xdridptr[*xdrid], cp); - cnt += sizeof(char); -} - -void -xdrfdouble (xdrid, dp, ret) -int *xdrid, *ret; -double *dp; -{ - *ret = xdr_double(xdridptr[*xdrid], dp); - cnt += sizeof(double); -} - -void -xdrffloat (xdrid, fp, ret) -int *xdrid, *ret; -float *fp; -{ - *ret = xdr_float(xdridptr[*xdrid], fp); - cnt += sizeof(float); -} - -void -xdrfint (xdrid, ip, ret) -int *xdrid, *ret; -int *ip; -{ - *ret = xdr_int(xdridptr[*xdrid], ip); - cnt += sizeof(int); -} - -void -xdrflong (xdrid, lp, ret) -int *xdrid, *ret; -long *lp; -{ - *ret = xdr_long(xdridptr[*xdrid], lp); - cnt += sizeof(long); -} - -void -xdrfshort (xdrid, sp, ret) -int *xdrid, *ret; -short *sp; -{ - *ret = xdr_short(xdridptr[*xdrid], sp); - cnt += sizeof(sp); -} - -void -xdrfuchar (xdrid, ucp, ret) -int *xdrid, *ret; -char *ucp; -{ - *ret = xdr_u_char(xdridptr[*xdrid], ucp); - cnt += sizeof(char); -} - -void -xdrfulong (xdrid, ulp, ret) -int *xdrid, *ret; -unsigned long *ulp; -{ - *ret = xdr_u_long(xdridptr[*xdrid], ulp); - cnt += sizeof(unsigned long); -} - -void -xdrfushort (xdrid, usp, ret) -int *xdrid, *ret; -unsigned short *usp; -{ - *ret = xdr_u_short(xdridptr[*xdrid], usp); - cnt += sizeof(unsigned short); -} - -void -xdrf3dfcoord (xdrid, fp, size, precision, ret) -int *xdrid, *ret; -float *fp; -int *size; -float *precision; -{ - *ret = xdr3dfcoord(xdridptr[*xdrid], fp, size, precision); -} - -void -xdrfstring (xdrid, sp_ptr, maxsize, ret, sp_len) -int *xdrid, *ret; -char * sp_ptr; int sp_len; -int *maxsize; -{ - char *tsp; - - tsp = (char*) malloc(((sp_len) + 1) * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, *maxsize+1, sp_ptr, sp_len)) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int) *maxsize); - ctofstr( sp_ptr, sp_len, tsp); - cnt += *maxsize; - free(tsp); -} - -void -xdrfwrapstring (xdrid, sp_ptr, ret, sp_len) -int *xdrid, *ret; -char * sp_ptr; int sp_len; -{ - char *tsp; - int maxsize; - maxsize = (sp_len) + 1; - tsp = (char*) malloc(maxsize * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, maxsize, sp_ptr, sp_len)) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int)maxsize); - ctofstr( sp_ptr, sp_len, tsp); - cnt += maxsize; - free(tsp); -} - -void -xdrfopaque (xdrid, cp, ccnt, ret) -int *xdrid, *ret; -caddr_t *cp; -int *ccnt; -{ - *ret = xdr_opaque(xdridptr[*xdrid], (caddr_t)*cp, (u_int)*ccnt); - cnt += *ccnt; -} - -void -xdrfsetpos (xdrid, pos, ret) -int *xdrid, *ret; -int *pos; -{ - *ret = xdr_setpos(xdridptr[*xdrid], (u_int) *pos); -} - -void -xdrf (xdrid, pos) -int *xdrid, *pos; -{ - *pos = xdr_getpos(xdridptr[*xdrid]); -} - -void -xdrfvector (xdrid, cp, size, elproc, ret) -int *xdrid, *ret; -char *cp; -int *size; -xdrfproc elproc; -{ - int lcnt; - cnt = 0; - for (lcnt = 0; lcnt < *size; lcnt++) { - elproc(xdrid, (cp+cnt) , ret); - } -} - - -void -xdrfclose (xdrid, ret) -int *xdrid; -int *ret; -{ - *ret = xdrclose(xdridptr[*xdrid]); - cnt = 0; -} - -void -xdrfopen (xdrid, fp_ptr, mode_ptr, ret, fp_len, mode_len) -int *xdrid; -char * fp_ptr; int fp_len; -char * mode_ptr; int mode_len; -int *ret; -{ - char fname[512]; - char fmode[3]; - - if (ftocstr(fname, sizeof(fname), fp_ptr, fp_len)) { - *ret = 0; - } - if (ftocstr(fmode, sizeof(fmode), mode_ptr, - mode_len)) { - *ret = 0; - } - - *xdrid = xdropen(NULL, fname, fmode); - if (*xdrid == 0) - *ret = 0; - else - *ret = 1; -} - -/*___________________________________________________________________________ - | - | what follows are the C routines for opening, closing xdr streams - | and the routine to read/write compressed coordinates together - | with some routines to assist in this task (those are marked - | static and cannot be called from user programs) -*/ -#define MAXABS INT_MAX-2 - -#ifndef MIN -#define MIN(x,y) ((x) < (y) ? (x):(y)) -#endif -#ifndef MAX -#define MAX(x,y) ((x) > (y) ? (x):(y)) -#endif -#ifndef SQR -#define SQR(x) ((x)*(x)) -#endif -static int magicints[] = { - 0, 0, 0, 0, 0, 0, 0, 0, 0, - 8, 10, 12, 16, 20, 25, 32, 40, 50, 64, - 80, 101, 128, 161, 203, 256, 322, 406, 512, 645, - 812, 1024, 1290, 1625, 2048, 2580, 3250, 4096, 5060, 6501, - 8192, 10321, 13003, 16384, 20642, 26007, 32768, 41285, 52015, 65536, - 82570, 104031, 131072, 165140, 208063, 262144, 330280, 416127, 524287, 660561, - 832255, 1048576, 1321122, 1664510, 2097152, 2642245, 3329021, 4194304, 5284491, 6658042, - 8388607, 10568983, 13316085, 16777216 }; - -#define FIRSTIDX 9 -/* note that magicints[FIRSTIDX-1] == 0 */ -#define LASTIDX (sizeof(magicints) / sizeof(*magicints)) - - -/*__________________________________________________________________________ - | - | xdropen - open xdr file - | - | This versions differs from xdrstdio_create, because I need to know - | the state of the file (read or write) so I can use xdr3dfcoord - | in eigther read or write mode, and the file descriptor - | so I can close the file (something xdr_destroy doesn't do). - | -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type) { - static int init_done = 0; - enum xdr_op lmode; - const char *type1; - int xdrid; - - if (init_done == 0) { - for (xdrid = 1; xdrid < MAXID; xdrid++) { - xdridptr[xdrid] = NULL; - } - init_done = 1; - } - xdrid = 1; - while (xdrid < MAXID && xdridptr[xdrid] != NULL) { - xdrid++; - } - if (xdrid == MAXID) { - return 0; - } - if (*type == 'w' || *type == 'W') { - type = "w+"; - type1 = "a+"; - lmode = XDR_ENCODE; - } else { - type = "r"; - type1 = "r"; - lmode = XDR_DECODE; - } - xdrfiles[xdrid] = fopen(filename, type1); - if (xdrfiles[xdrid] == NULL) { - xdrs = NULL; - return 0; - } - xdrmodes[xdrid] = *type; - /* next test isn't usefull in the case of C language - * but is used for the Fortran interface - * (C users are expected to pass the address of an already allocated - * XDR staructure) - */ - if (xdrs == NULL) { - xdridptr[xdrid] = (XDR *) malloc(sizeof(XDR)); - xdrstdio_create(xdridptr[xdrid], xdrfiles[xdrid], lmode); - } else { - xdridptr[xdrid] = xdrs; - xdrstdio_create(xdrs, xdrfiles[xdrid], lmode); - } - return xdrid; -} - -/*_________________________________________________________________________ - | - | xdrclose - close a xdr file - | - | This will flush the xdr buffers, and destroy the xdr stream. - | It also closes the associated file descriptor (this is *not* - | done by xdr_destroy). - | -*/ - -int xdrclose(XDR *xdrs) { - int xdrid; - - if (xdrs == NULL) { - fprintf(stderr, "xdrclose: passed a NULL pointer\n"); - exit(1); - } - for (xdrid = 1; xdrid < MAXID; xdrid++) { - if (xdridptr[xdrid] == xdrs) { - - xdr_destroy(xdrs); - fclose(xdrfiles[xdrid]); - xdridptr[xdrid] = NULL; - return 1; - } - } - fprintf(stderr, "xdrclose: no such open xdr file\n"); - exit(1); - -} - -/*____________________________________________________________________________ - | - | sendbits - encode num into buf using the specified number of bits - | - | This routines appends the value of num to the bits already present in - | the array buf. You need to give it the number of bits to use and you - | better make sure that this number of bits is enough to hold the value - | Also num must be positive. - | -*/ - -static void sendbits(int buf[], int num_of_bits, int num) { - - unsigned int cnt, lastbyte; - int lastbits; - unsigned char * cbuf; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = (unsigned int) buf[0]; - lastbits = buf[1]; - lastbyte =(unsigned int) buf[2]; - while (num_of_bits >= 8) { - lastbyte = (lastbyte << 8) | ((num >> (num_of_bits -8)) /* & 0xff*/); - cbuf[cnt++] = lastbyte >> lastbits; - num_of_bits -= 8; - } - if (num_of_bits > 0) { - lastbyte = (lastbyte << num_of_bits) | num; - lastbits += num_of_bits; - if (lastbits >= 8) { - lastbits -= 8; - cbuf[cnt++] = lastbyte >> lastbits; - } - } - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - if (lastbits>0) { - cbuf[cnt] = lastbyte << (8 - lastbits); - } -} - -/*_________________________________________________________________________ - | - | sizeofint - calculate bitsize of an integer - | - | return the number of bits needed to store an integer with given max size - | -*/ - -static int sizeofint(const int size) { - unsigned int num = 1; - int num_of_bits = 0; - - while (size >= num && num_of_bits < 32) { - num_of_bits++; - num <<= 1; - } - return num_of_bits; -} - -/*___________________________________________________________________________ - | - | sizeofints - calculate 'bitsize' of compressed ints - | - | given the number of small unsigned integers and the maximum value - | return the number of bits needed to read or write them with the - | routines receiveints and sendints. You need this parameter when - | calling these routines. Note that for many calls I can use - | the variable 'smallidx' which is exactly the number of bits, and - | So I don't need to call 'sizeofints for those calls. -*/ - -static int sizeofints( const int num_of_ints, unsigned int sizes[]) { - int i, num; - unsigned int num_of_bytes, num_of_bits, bytes[32], bytecnt, tmp; - num_of_bytes = 1; - bytes[0] = 1; - num_of_bits = 0; - for (i=0; i < num_of_ints; i++) { - tmp = 0; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - num = 1; - num_of_bytes--; - while (bytes[num_of_bytes] >= num) { - num_of_bits++; - num *= 2; - } - return num_of_bits + num_of_bytes * 8; - -} - -/*____________________________________________________________________________ - | - | sendints - send a small set of small integers in compressed format - | - | this routine is used internally by xdr3dfcoord, to send a set of - | small integers to the buffer. - | Multiplication with fixed (specified maximum ) sizes is used to get - | to one big, multibyte integer. Allthough the routine could be - | modified to handle sizes bigger than 16777216, or more than just - | a few integers, this is not done, because the gain in compression - | isn't worth the effort. Note that overflowing the multiplication - | or the byte buffer (32 bytes) is unchecked and causes bad results. - | - */ - -static void sendints(int buf[], const int num_of_ints, const int num_of_bits, - unsigned int sizes[], unsigned int nums[]) { - - int i; - unsigned int bytes[32], num_of_bytes, bytecnt, tmp; - - tmp = nums[0]; - num_of_bytes = 0; - do { - bytes[num_of_bytes++] = tmp & 0xff; - tmp >>= 8; - } while (tmp != 0); - - for (i = 1; i < num_of_ints; i++) { - if (nums[i] >= sizes[i]) { - fprintf(stderr,"major breakdown in sendints num %d doesn't " - "match size %d\n", nums[i], sizes[i]); - exit(1); - } - /* use one step multiply */ - tmp = nums[i]; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - if (num_of_bits >= num_of_bytes * 8) { - for (i = 0; i < num_of_bytes; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits - num_of_bytes * 8, 0); - } else { - for (i = 0; i < num_of_bytes-1; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits- (num_of_bytes -1) * 8, bytes[i]); - } -} - - -/*___________________________________________________________________________ - | - | receivebits - decode number from buf using specified number of bits - | - | extract the number of bits from the array buf and construct an integer - | from it. Return that value. - | -*/ - -static int receivebits(int buf[], int num_of_bits) { - - int cnt, num; - unsigned int lastbits, lastbyte; - unsigned char * cbuf; - int mask = (1 << num_of_bits) -1; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = buf[0]; - lastbits = (unsigned int) buf[1]; - lastbyte = (unsigned int) buf[2]; - - num = 0; - while (num_of_bits >= 8) { - lastbyte = ( lastbyte << 8 ) | cbuf[cnt++]; - num |= (lastbyte >> lastbits) << (num_of_bits - 8); - num_of_bits -=8; - } - if (num_of_bits > 0) { - if (lastbits < num_of_bits) { - lastbits += 8; - lastbyte = (lastbyte << 8) | cbuf[cnt++]; - } - lastbits -= num_of_bits; - num |= (lastbyte >> lastbits) & ((1 << num_of_bits) -1); - } - num &= mask; - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - return num; -} - -/*____________________________________________________________________________ - | - | receiveints - decode 'small' integers from the buf array - | - | this routine is the inverse from sendints() and decodes the small integers - | written to buf by calculating the remainder and doing divisions with - | the given sizes[]. You need to specify the total number of bits to be - | used from buf in num_of_bits. - | -*/ - -static void receiveints(int buf[], const int num_of_ints, int num_of_bits, - unsigned int sizes[], int nums[]) { - int bytes[32]; - int i, j, num_of_bytes, p, num; - - bytes[1] = bytes[2] = bytes[3] = 0; - num_of_bytes = 0; - while (num_of_bits > 8) { - bytes[num_of_bytes++] = receivebits(buf, 8); - num_of_bits -= 8; - } - if (num_of_bits > 0) { - bytes[num_of_bytes++] = receivebits(buf, num_of_bits); - } - for (i = num_of_ints-1; i > 0; i--) { - num = 0; - for (j = num_of_bytes-1; j >=0; j--) { - num = (num << 8) | bytes[j]; - p = num / sizes[i]; - bytes[j] = p; - num = num - p * sizes[i]; - } - nums[i] = num; - } - nums[0] = bytes[0] | (bytes[1] << 8) | (bytes[2] << 16) | (bytes[3] << 24); -} - -/*____________________________________________________________________________ - | - | xdr3dfcoord - read or write compressed 3d coordinates to xdr file. - | - | this routine reads or writes (depending on how you opened the file with - | xdropen() ) a large number of 3d coordinates (stored in *fp). - | The number of coordinates triplets to write is given by *size. On - | read this number may be zero, in which case it reads as many as were written - | or it may specify the number if triplets to read (which should match the - | number written). - | Compression is achieved by first converting all floating numbers to integer - | using multiplication by *precision and rounding to the nearest integer. - | Then the minimum and maximum value are calculated to determine the range. - | The limited range of integers so found, is used to compress the coordinates. - | In addition the differences between succesive coordinates is calculated. - | If the difference happens to be 'small' then only the difference is saved, - | compressing the data even more. The notion of 'small' is changed dynamically - | and is enlarged or reduced whenever needed or possible. - | Extra compression is achieved in the case of GROMOS and coordinates of - | water molecules. GROMOS first writes out the Oxygen position, followed by - | the two hydrogens. In order to make the differences smaller (and thereby - | compression the data better) the order is changed into first one hydrogen - | then the oxygen, followed by the other hydrogen. This is rather special, but - | it shouldn't harm in the general case. - | - */ - -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) { - - - static int *ip = NULL; - static int oldsize; - static int *buf; - - int minint[3], maxint[3], mindiff, *lip, diff; - int lint1, lint2, lint3, oldlint1, oldlint2, oldlint3, smallidx; - int minidx, maxidx; - unsigned sizeint[3], sizesmall[3], bitsizeint[3], size3, *luip; - int flag, k; - int small, smaller, larger, i, is_small, is_smaller, run, prevrun; - float *lfp, lf; - int tmp, *thiscoord, prevcoord[3]; - unsigned int tmpcoord[30]; - - int bufsize, xdrid, lsize; - unsigned int bitsize; - float inv_precision; - int errval = 1; - - /* find out if xdrs is opened for reading or for writing */ - xdrid = 0; - while (xdridptr[xdrid] != xdrs) { - xdrid++; - if (xdrid >= MAXID) { - fprintf(stderr, "xdr error. no open xdr stream\n"); - exit (1); - } - } - if (xdrmodes[xdrid] == 'w') { - - /* xdrs is open for writing */ - - if (xdr_int(xdrs, size) == 0) - return 0; - size3 = *size * 3; - /* when the number of coordinates is small, don't try to compress; just - * write them as floats using xdr_vector - */ - if (*size <= 9 ) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - /* buf[0-2] are special and do not contain actual data */ - buf[0] = buf[1] = buf[2] = 0; - minint[0] = minint[1] = minint[2] = INT_MAX; - maxint[0] = maxint[1] = maxint[2] = INT_MIN; - prevrun = -1; - lfp = fp; - lip = ip; - mindiff = INT_MAX; - oldlint1 = oldlint2 = oldlint3 = 0; - while(lfp < fp + size3 ) { - /* find nearest integer */ - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint1 = lf; - if (lint1 < minint[0]) minint[0] = lint1; - if (lint1 > maxint[0]) maxint[0] = lint1; - *lip++ = lint1; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint2 = lf; - if (lint2 < minint[1]) minint[1] = lint2; - if (lint2 > maxint[1]) maxint[1] = lint2; - *lip++ = lint2; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint3 = lf; - if (lint3 < minint[2]) minint[2] = lint3; - if (lint3 > maxint[2]) maxint[2] = lint3; - *lip++ = lint3; - lfp++; - diff = abs(oldlint1-lint1)+abs(oldlint2-lint2)+abs(oldlint3-lint3); - if (diff < mindiff && lfp > fp + 3) - mindiff = diff; - oldlint1 = lint1; - oldlint2 = lint2; - oldlint3 = lint3; - } - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - if ((float)maxint[0] - (float)minint[0] >= MAXABS || - (float)maxint[1] - (float)minint[1] >= MAXABS || - (float)maxint[2] - (float)minint[2] >= MAXABS) { - /* turning value in unsigned by subtracting minint - * would cause overflow - */ - errval = 0; - } - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - lip = ip; - luip = (unsigned int *) ip; - smallidx = FIRSTIDX; - while (smallidx < LASTIDX && magicints[smallidx] < mindiff) { - smallidx++; - } - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - larger = magicints[maxidx] / 2; - i = 0; - while (i < *size) { - is_small = 0; - thiscoord = (int *)(luip) + i * 3; - if (smallidx < maxidx && i >= 1 && - abs(thiscoord[0] - prevcoord[0]) < larger && - abs(thiscoord[1] - prevcoord[1]) < larger && - abs(thiscoord[2] - prevcoord[2]) < larger) { - is_smaller = 1; - } else if (smallidx > minidx) { - is_smaller = -1; - } else { - is_smaller = 0; - } - if (i + 1 < *size) { - if (abs(thiscoord[0] - thiscoord[3]) < small && - abs(thiscoord[1] - thiscoord[4]) < small && - abs(thiscoord[2] - thiscoord[5]) < small) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = thiscoord[3]; - thiscoord[3] = tmp; - tmp = thiscoord[1]; thiscoord[1] = thiscoord[4]; - thiscoord[4] = tmp; - tmp = thiscoord[2]; thiscoord[2] = thiscoord[5]; - thiscoord[5] = tmp; - is_small = 1; - } - - } - tmpcoord[0] = thiscoord[0] - minint[0]; - tmpcoord[1] = thiscoord[1] - minint[1]; - tmpcoord[2] = thiscoord[2] - minint[2]; - if (bitsize == 0) { - sendbits(buf, bitsizeint[0], tmpcoord[0]); - sendbits(buf, bitsizeint[1], tmpcoord[1]); - sendbits(buf, bitsizeint[2], tmpcoord[2]); - } else { - sendints(buf, 3, bitsize, sizeint, tmpcoord); - } - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - thiscoord = thiscoord + 3; - i++; - - run = 0; - if (is_small == 0 && is_smaller == -1) - is_smaller = 0; - while (is_small && run < 8*3) { - if (is_smaller == -1 && ( - SQR(thiscoord[0] - prevcoord[0]) + - SQR(thiscoord[1] - prevcoord[1]) + - SQR(thiscoord[2] - prevcoord[2]) >= smaller * smaller)) { - is_smaller = 0; - } - - tmpcoord[run++] = thiscoord[0] - prevcoord[0] + small; - tmpcoord[run++] = thiscoord[1] - prevcoord[1] + small; - tmpcoord[run++] = thiscoord[2] - prevcoord[2] + small; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - i++; - thiscoord = thiscoord + 3; - is_small = 0; - if (i < *size && - abs(thiscoord[0] - prevcoord[0]) < small && - abs(thiscoord[1] - prevcoord[1]) < small && - abs(thiscoord[2] - prevcoord[2]) < small) { - is_small = 1; - } - } - if (run != prevrun || is_smaller != 0) { - prevrun = run; - sendbits(buf, 1, 1); /* flag the change in run-length */ - sendbits(buf, 5, run+is_smaller+1); - } else { - sendbits(buf, 1, 0); /* flag the fact that runlength did not change */ - } - for (k=0; k < run; k+=3) { - sendints(buf, 3, smallidx, sizesmall, &tmpcoord[k]); - } - if (is_smaller != 0) { - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - smaller = magicints[smallidx-1] / 2; - } else { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - } - } - if (buf[1] != 0) buf[0]++;; - xdr_int(xdrs, &(buf[0])); /* buf[0] holds the length in bytes */ - return errval * (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0])); - } else { - - /* xdrs is open for reading */ - - if (xdr_int(xdrs, &lsize) == 0) - return 0; - if (*size != 0 && lsize != *size) { - fprintf(stderr, "wrong number of coordinates in xdr3dfcoor; " - "%d arg vs %d in file", *size, lsize); - } - *size = lsize; - size3 = *size * 3; - if (*size <= 9) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - buf[0] = buf[1] = buf[2] = 0; - - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - larger = magicints[maxidx]; - - /* buf[0] holds the length in bytes */ - - if (xdr_int(xdrs, &(buf[0])) == 0) - return 0; - if (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0]) == 0) - return 0; - buf[0] = buf[1] = buf[2] = 0; - - lfp = fp; - inv_precision = 1.0 / * precision; - run = 0; - i = 0; - lip = ip; - while ( i < lsize ) { - thiscoord = (int *)(lip) + i * 3; - - if (bitsize == 0) { - thiscoord[0] = receivebits(buf, bitsizeint[0]); - thiscoord[1] = receivebits(buf, bitsizeint[1]); - thiscoord[2] = receivebits(buf, bitsizeint[2]); - } else { - receiveints(buf, 3, bitsize, sizeint, thiscoord); - } - - i++; - thiscoord[0] += minint[0]; - thiscoord[1] += minint[1]; - thiscoord[2] += minint[2]; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - - flag = receivebits(buf, 1); - is_smaller = 0; - if (flag == 1) { - run = receivebits(buf, 5); - is_smaller = run % 3; - run -= is_smaller; - is_smaller--; - } - if (run > 0) { - thiscoord += 3; - for (k = 0; k < run; k+=3) { - receiveints(buf, 3, smallidx, sizesmall, thiscoord); - i++; - thiscoord[0] += prevcoord[0] - small; - thiscoord[1] += prevcoord[1] - small; - thiscoord[2] += prevcoord[2] - small; - if (k == 0) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = prevcoord[0]; - prevcoord[0] = tmp; - tmp = thiscoord[1]; thiscoord[1] = prevcoord[1]; - prevcoord[1] = tmp; - tmp = thiscoord[2]; thiscoord[2] = prevcoord[2]; - prevcoord[2] = tmp; - *lfp++ = prevcoord[0] * inv_precision; - *lfp++ = prevcoord[1] * inv_precision; - *lfp++ = prevcoord[2] * inv_precision; - } else { - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - } - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - } else { - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - if (smallidx > FIRSTIDX) { - smaller = magicints[smallidx - 1] /2; - } else { - smaller = 0; - } - } else if (is_smaller > 0) { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - } - } - return 1; -} - - - diff --git a/source/wham/src-M/xdrf.org/libxdrf.m4 b/source/wham/src-M/xdrf.org/libxdrf.m4 deleted file mode 100644 index 8704af2..0000000 --- a/source/wham/src-M/xdrf.org/libxdrf.m4 +++ /dev/null @@ -1,1234 +0,0 @@ -/*____________________________________________________________________________ - | - | libxdrf - portable fortran interface to xdr. some xdr routines - | are C routines for compressed coordinates - | - | version 1.1 - | - | This collection of routines is intended to write and read - | data in a portable way to a file, so data written on one type - | of machine can be read back on a different type. - | - | all fortran routines use an integer 'xdrid', which is an id to the - | current xdr file, and is set by xdrfopen. - | most routines have in integer 'ret' which is the return value. - | The value of 'ret' is zero on failure, and most of the time one - | on succes. - | - | There are three routines useful for C users: - | xdropen(), xdrclose(), xdr3dfcoord(). - | The first two replace xdrstdio_create and xdr_destroy, and *must* be - | used when you plan to use xdr3dfcoord(). (they are also a bit - | easier to interface). For writing data other than compressed coordinates - | you should use the standard C xdr routines (see xdr man page) - | - | xdrfopen(xdrid, filename, mode, ret) - | character *(*) filename - | character *(*) mode - | - | this will open the file with the given filename (string) - | and the given mode, it returns an id in xdrid, which is - | to be used in all other calls to xdrf routines. - | mode is 'w' to create, or update an file, for all other - | values of mode the file is opened for reading - | - | you need to call xdrfclose to flush the output and close - | the file. - | Note that you should not use xdrstdio_create, which comes with the - | standard xdr library - | - | xdrfclose(xdrid, ret) - | flush the data to the file, and closes the file; - | You should not use xdr_destroy (which comes standard with - | the xdr libraries. - | - | xdrfbool(xdrid, bp, ret) - | integer pb - | - | This filter produces values of either 1 or 0 - | - | xdrfchar(xdrid, cp, ret) - | character cp - | - | filter that translate between characters and their xdr representation - | Note that the characters in not compressed and occupies 4 bytes. - | - | xdrfdouble(xdrid, dp, ret) - | double dp - | - | read/write a double. - | - | xdrffloat(xdrid, fp, ret) - | float fp - | - | read/write a float. - | - | xdrfint(xdrid, ip, ret) - | integer ip - | - | read/write integer. - | - | xdrflong(xdrid, lp, ret) - | integer lp - | - | this routine has a possible portablility problem due to 64 bits longs. - | - | xdrfshort(xdrid, sp, ret) - | integer *2 sp - | - | xdrfstring(xdrid, sp, maxsize, ret) - | character *(*) - | integer maxsize - | - | read/write a string, with maximum length given by maxsize - | - | xdrfwrapstring(xdris, sp, ret) - | character *(*) - | - | read/write a string (it is the same as xdrfstring accept that it finds - | the stringlength itself. - | - | xdrfvector(xdrid, cp, size, xdrfproc, ret) - | character *(*) - | integer size - | external xdrfproc - | - | read/write an array pointed to by cp, with number of elements - | defined by 'size'. the routine 'xdrfproc' is the name - | of one of the above routines to read/write data (like xdrfdouble) - | In contrast with the c-version you don't need to specify the - | byte size of an element. - | xdrfstring is not allowed here (it is in the c version) - | - | xdrf3dfcoord(xdrid, fp, size, precision, ret) - | real (*) fp - | real precision - | integer size - | - | this is *NOT* a standard xdr routine. I named it this way, because - | it invites people to use the other xdr routines. - | It is introduced to store specifically 3d coordinates of molecules - | (as found in molecular dynamics) and it writes it in a compressed way. - | It starts by multiplying all numbers by precision and - | rounding the result to integer. effectively converting - | all floating point numbers to fixed point. - | it uses an algorithm for compression that is optimized for - | molecular data, but could be used for other 3d coordinates - | as well. There is subtantial overhead involved, so call this - | routine only if you have a large number of coordinates to read/write - | - | ________________________________________________________________________ - | - | Below are the routines to be used by C programmers. Use the 'normal' - | xdr routines to write integers, floats, etc (see man xdr) - | - | int xdropen(XDR *xdrs, const char *filename, const char *type) - | This will open the file with the given filename and the - | given mode. You should pass it an allocated XDR struct - | in xdrs, to be used in all other calls to xdr routines. - | Mode is 'w' to create, or update an file, and for all - | other values of mode the file is opened for reading. - | You need to call xdrclose to flush the output and close - | the file. - | - | Note that you should not use xdrstdio_create, which - | comes with the standard xdr library. - | - | int xdrclose(XDR *xdrs) - | Flush the data to the file, and close the file; - | You should not use xdr_destroy (which comes standard - | with the xdr libraries). - | - | int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) - | This is \fInot\fR a standard xdr routine. I named it this - | way, because it invites people to use the other xdr - | routines. - | - | (c) 1995 Frans van Hoesel, hoesel@chem.rug.nl -*/ - - -#include -#include -#include -/* #include -#include */ -#include "xdr.h" -#include -#include -#include "xdrf.h" - -int ftocstr(char *, int, char *, int); -int ctofstr(char *, int, char *); - -#define MAXID 20 -static FILE *xdrfiles[MAXID]; -static XDR *xdridptr[MAXID]; -static char xdrmodes[MAXID]; -static unsigned int cnt; - -typedef void (* FUNCTION(xdrfproc)) (int *, void *, int *); - -void -FUNCTION(xdrfbool) ARGS(`xdrid, pb, ret') -int *xdrid, *ret; -int *pb; -{ - *ret = xdr_bool(xdridptr[*xdrid], (bool_t *) pb); - cnt += sizeof(int); -} - -void -FUNCTION(xdrfchar) ARGS(`xdrid, cp, ret') -int *xdrid, *ret; -char *cp; -{ - *ret = xdr_char(xdridptr[*xdrid], cp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfdouble) ARGS(`xdrid, dp, ret') -int *xdrid, *ret; -double *dp; -{ - *ret = xdr_double(xdridptr[*xdrid], dp); - cnt += sizeof(double); -} - -void -FUNCTION(xdrffloat) ARGS(`xdrid, fp, ret') -int *xdrid, *ret; -float *fp; -{ - *ret = xdr_float(xdridptr[*xdrid], fp); - cnt += sizeof(float); -} - -void -FUNCTION(xdrfint) ARGS(`xdrid, ip, ret') -int *xdrid, *ret; -int *ip; -{ - *ret = xdr_int(xdridptr[*xdrid], ip); - cnt += sizeof(int); -} - -void -FUNCTION(xdrflong) ARGS(`xdrid, lp, ret') -int *xdrid, *ret; -long *lp; -{ - *ret = xdr_long(xdridptr[*xdrid], lp); - cnt += sizeof(long); -} - -void -FUNCTION(xdrfshort) ARGS(`xdrid, sp, ret') -int *xdrid, *ret; -short *sp; -{ - *ret = xdr_short(xdridptr[*xdrid], sp); - cnt += sizeof(sp); -} - -void -FUNCTION(xdrfuchar) ARGS(`xdrid, ucp, ret') -int *xdrid, *ret; -char *ucp; -{ - *ret = xdr_u_char(xdridptr[*xdrid], ucp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfulong) ARGS(`xdrid, ulp, ret') -int *xdrid, *ret; -unsigned long *ulp; -{ - *ret = xdr_u_long(xdridptr[*xdrid], ulp); - cnt += sizeof(unsigned long); -} - -void -FUNCTION(xdrfushort) ARGS(`xdrid, usp, ret') -int *xdrid, *ret; -unsigned short *usp; -{ - *ret = xdr_u_short(xdridptr[*xdrid], usp); - cnt += sizeof(unsigned short); -} - -void -FUNCTION(xdrf3dfcoord) ARGS(`xdrid, fp, size, precision, ret') -int *xdrid, *ret; -float *fp; -int *size; -float *precision; -{ - *ret = xdr3dfcoord(xdridptr[*xdrid], fp, size, precision); -} - -void -FUNCTION(xdrfstring) ARGS(`xdrid, STRING_ARG(sp), maxsize, ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -int *maxsize; -{ - char *tsp; - - tsp = (char*) malloc(((STRING_LEN(sp)) + 1) * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, *maxsize+1, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int) *maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += *maxsize; - free(tsp); -} - -void -FUNCTION(xdrfwrapstring) ARGS(`xdrid, STRING_ARG(sp), ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -{ - char *tsp; - int maxsize; - maxsize = (STRING_LEN(sp)) + 1; - tsp = (char*) malloc(maxsize * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, maxsize, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int)maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += maxsize; - free(tsp); -} - -void -FUNCTION(xdrfopaque) ARGS(`xdrid, cp, ccnt, ret') -int *xdrid, *ret; -caddr_t *cp; -int *ccnt; -{ - *ret = xdr_opaque(xdridptr[*xdrid], (caddr_t)*cp, (u_int)*ccnt); - cnt += *ccnt; -} - -void -FUNCTION(xdrfsetpos) ARGS(`xdrid, pos, ret') -int *xdrid, *ret; -int *pos; -{ - *ret = xdr_setpos(xdridptr[*xdrid], (u_int) *pos); -} - -void -FUNCTION(xdrf) ARGS(`xdrid, pos') -int *xdrid, *pos; -{ - *pos = xdr_getpos(xdridptr[*xdrid]); -} - -void -FUNCTION(xdrfvector) ARGS(`xdrid, cp, size, elproc, ret') -int *xdrid, *ret; -char *cp; -int *size; -FUNCTION(xdrfproc) elproc; -{ - int lcnt; - cnt = 0; - for (lcnt = 0; lcnt < *size; lcnt++) { - elproc(xdrid, (cp+cnt) , ret); - } -} - - -void -FUNCTION(xdrfclose) ARGS(`xdrid, ret') -int *xdrid; -int *ret; -{ - *ret = xdrclose(xdridptr[*xdrid]); - cnt = 0; -} - -void -FUNCTION(xdrfopen) ARGS(`xdrid, STRING_ARG(fp), STRING_ARG(mode), ret') -int *xdrid; -STRING_ARG_DECL(fp); -STRING_ARG_DECL(mode); -int *ret; -{ - char fname[512]; - char fmode[3]; - - if (ftocstr(fname, sizeof(fname), STRING_PTR(fp), STRING_LEN(fp))) { - *ret = 0; - } - if (ftocstr(fmode, sizeof(fmode), STRING_PTR(mode), - STRING_LEN(mode))) { - *ret = 0; - } - - *xdrid = xdropen(NULL, fname, fmode); - if (*xdrid == 0) - *ret = 0; - else - *ret = 1; -} - -/*___________________________________________________________________________ - | - | what follows are the C routines for opening, closing xdr streams - | and the routine to read/write compressed coordinates together - | with some routines to assist in this task (those are marked - | static and cannot be called from user programs) -*/ -#define MAXABS INT_MAX-2 - -#ifndef MIN -#define MIN(x,y) ((x) < (y) ? (x):(y)) -#endif -#ifndef MAX -#define MAX(x,y) ((x) > (y) ? (x):(y)) -#endif -#ifndef SQR -#define SQR(x) ((x)*(x)) -#endif -static int magicints[] = { - 0, 0, 0, 0, 0, 0, 0, 0, 0, - 8, 10, 12, 16, 20, 25, 32, 40, 50, 64, - 80, 101, 128, 161, 203, 256, 322, 406, 512, 645, - 812, 1024, 1290, 1625, 2048, 2580, 3250, 4096, 5060, 6501, - 8192, 10321, 13003, 16384, 20642, 26007, 32768, 41285, 52015, 65536, - 82570, 104031, 131072, 165140, 208063, 262144, 330280, 416127, 524287, 660561, - 832255, 1048576, 1321122, 1664510, 2097152, 2642245, 3329021, 4194304, 5284491, 6658042, - 8388607, 10568983, 13316085, 16777216 }; - -#define FIRSTIDX 9 -/* note that magicints[FIRSTIDX-1] == 0 */ -#define LASTIDX (sizeof(magicints) / sizeof(*magicints)) - - -/*__________________________________________________________________________ - | - | xdropen - open xdr file - | - | This versions differs from xdrstdio_create, because I need to know - | the state of the file (read or write) so I can use xdr3dfcoord - | in eigther read or write mode, and the file descriptor - | so I can close the file (something xdr_destroy doesn't do). - | -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type) { - static int init_done = 0; - enum xdr_op lmode; - const char *type1; - int xdrid; - - if (init_done == 0) { - for (xdrid = 1; xdrid < MAXID; xdrid++) { - xdridptr[xdrid] = NULL; - } - init_done = 1; - } - xdrid = 1; - while (xdrid < MAXID && xdridptr[xdrid] != NULL) { - xdrid++; - } - if (xdrid == MAXID) { - return 0; - } - if (*type == 'w' || *type == 'W') { - type = "w+"; - type1 = "a+"; - lmode = XDR_ENCODE; - } else { - type = "r"; - type1 = "r"; - lmode = XDR_DECODE; - } - xdrfiles[xdrid] = fopen(filename, type1); - if (xdrfiles[xdrid] == NULL) { - xdrs = NULL; - return 0; - } - xdrmodes[xdrid] = *type; - /* next test isn't usefull in the case of C language - * but is used for the Fortran interface - * (C users are expected to pass the address of an already allocated - * XDR staructure) - */ - if (xdrs == NULL) { - xdridptr[xdrid] = (XDR *) malloc(sizeof(XDR)); - xdrstdio_create(xdridptr[xdrid], xdrfiles[xdrid], lmode); - } else { - xdridptr[xdrid] = xdrs; - xdrstdio_create(xdrs, xdrfiles[xdrid], lmode); - } - return xdrid; -} - -/*_________________________________________________________________________ - | - | xdrclose - close a xdr file - | - | This will flush the xdr buffers, and destroy the xdr stream. - | It also closes the associated file descriptor (this is *not* - | done by xdr_destroy). - | -*/ - -int xdrclose(XDR *xdrs) { - int xdrid; - - if (xdrs == NULL) { - fprintf(stderr, "xdrclose: passed a NULL pointer\n"); - exit(1); - } - for (xdrid = 1; xdrid < MAXID; xdrid++) { - if (xdridptr[xdrid] == xdrs) { - - xdr_destroy(xdrs); - fclose(xdrfiles[xdrid]); - xdridptr[xdrid] = NULL; - return 1; - } - } - fprintf(stderr, "xdrclose: no such open xdr file\n"); - exit(1); - -} - -/*____________________________________________________________________________ - | - | sendbits - encode num into buf using the specified number of bits - | - | This routines appends the value of num to the bits already present in - | the array buf. You need to give it the number of bits to use and you - | better make sure that this number of bits is enough to hold the value - | Also num must be positive. - | -*/ - -static void sendbits(int buf[], int num_of_bits, int num) { - - unsigned int cnt, lastbyte; - int lastbits; - unsigned char * cbuf; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = (unsigned int) buf[0]; - lastbits = buf[1]; - lastbyte =(unsigned int) buf[2]; - while (num_of_bits >= 8) { - lastbyte = (lastbyte << 8) | ((num >> (num_of_bits -8)) /* & 0xff*/); - cbuf[cnt++] = lastbyte >> lastbits; - num_of_bits -= 8; - } - if (num_of_bits > 0) { - lastbyte = (lastbyte << num_of_bits) | num; - lastbits += num_of_bits; - if (lastbits >= 8) { - lastbits -= 8; - cbuf[cnt++] = lastbyte >> lastbits; - } - } - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - if (lastbits>0) { - cbuf[cnt] = lastbyte << (8 - lastbits); - } -} - -/*_________________________________________________________________________ - | - | sizeofint - calculate bitsize of an integer - | - | return the number of bits needed to store an integer with given max size - | -*/ - -static int sizeofint(const int size) { - unsigned int num = 1; - int num_of_bits = 0; - - while (size >= num && num_of_bits < 32) { - num_of_bits++; - num <<= 1; - } - return num_of_bits; -} - -/*___________________________________________________________________________ - | - | sizeofints - calculate 'bitsize' of compressed ints - | - | given the number of small unsigned integers and the maximum value - | return the number of bits needed to read or write them with the - | routines receiveints and sendints. You need this parameter when - | calling these routines. Note that for many calls I can use - | the variable 'smallidx' which is exactly the number of bits, and - | So I don't need to call 'sizeofints for those calls. -*/ - -static int sizeofints( const int num_of_ints, unsigned int sizes[]) { - int i, num; - unsigned int num_of_bytes, num_of_bits, bytes[32], bytecnt, tmp; - num_of_bytes = 1; - bytes[0] = 1; - num_of_bits = 0; - for (i=0; i < num_of_ints; i++) { - tmp = 0; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - num = 1; - num_of_bytes--; - while (bytes[num_of_bytes] >= num) { - num_of_bits++; - num *= 2; - } - return num_of_bits + num_of_bytes * 8; - -} - -/*____________________________________________________________________________ - | - | sendints - send a small set of small integers in compressed format - | - | this routine is used internally by xdr3dfcoord, to send a set of - | small integers to the buffer. - | Multiplication with fixed (specified maximum ) sizes is used to get - | to one big, multibyte integer. Allthough the routine could be - | modified to handle sizes bigger than 16777216, or more than just - | a few integers, this is not done, because the gain in compression - | isn't worth the effort. Note that overflowing the multiplication - | or the byte buffer (32 bytes) is unchecked and causes bad results. - | - */ - -static void sendints(int buf[], const int num_of_ints, const int num_of_bits, - unsigned int sizes[], unsigned int nums[]) { - - int i; - unsigned int bytes[32], num_of_bytes, bytecnt, tmp; - - tmp = nums[0]; - num_of_bytes = 0; - do { - bytes[num_of_bytes++] = tmp & 0xff; - tmp >>= 8; - } while (tmp != 0); - - for (i = 1; i < num_of_ints; i++) { - if (nums[i] >= sizes[i]) { - fprintf(stderr,"major breakdown in sendints num %d doesn't " - "match size %d\n", nums[i], sizes[i]); - exit(1); - } - /* use one step multiply */ - tmp = nums[i]; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - if (num_of_bits >= num_of_bytes * 8) { - for (i = 0; i < num_of_bytes; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits - num_of_bytes * 8, 0); - } else { - for (i = 0; i < num_of_bytes-1; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits- (num_of_bytes -1) * 8, bytes[i]); - } -} - - -/*___________________________________________________________________________ - | - | receivebits - decode number from buf using specified number of bits - | - | extract the number of bits from the array buf and construct an integer - | from it. Return that value. - | -*/ - -static int receivebits(int buf[], int num_of_bits) { - - int cnt, num; - unsigned int lastbits, lastbyte; - unsigned char * cbuf; - int mask = (1 << num_of_bits) -1; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = buf[0]; - lastbits = (unsigned int) buf[1]; - lastbyte = (unsigned int) buf[2]; - - num = 0; - while (num_of_bits >= 8) { - lastbyte = ( lastbyte << 8 ) | cbuf[cnt++]; - num |= (lastbyte >> lastbits) << (num_of_bits - 8); - num_of_bits -=8; - } - if (num_of_bits > 0) { - if (lastbits < num_of_bits) { - lastbits += 8; - lastbyte = (lastbyte << 8) | cbuf[cnt++]; - } - lastbits -= num_of_bits; - num |= (lastbyte >> lastbits) & ((1 << num_of_bits) -1); - } - num &= mask; - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - return num; -} - -/*____________________________________________________________________________ - | - | receiveints - decode 'small' integers from the buf array - | - | this routine is the inverse from sendints() and decodes the small integers - | written to buf by calculating the remainder and doing divisions with - | the given sizes[]. You need to specify the total number of bits to be - | used from buf in num_of_bits. - | -*/ - -static void receiveints(int buf[], const int num_of_ints, int num_of_bits, - unsigned int sizes[], int nums[]) { - int bytes[32]; - int i, j, num_of_bytes, p, num; - - bytes[1] = bytes[2] = bytes[3] = 0; - num_of_bytes = 0; - while (num_of_bits > 8) { - bytes[num_of_bytes++] = receivebits(buf, 8); - num_of_bits -= 8; - } - if (num_of_bits > 0) { - bytes[num_of_bytes++] = receivebits(buf, num_of_bits); - } - for (i = num_of_ints-1; i > 0; i--) { - num = 0; - for (j = num_of_bytes-1; j >=0; j--) { - num = (num << 8) | bytes[j]; - p = num / sizes[i]; - bytes[j] = p; - num = num - p * sizes[i]; - } - nums[i] = num; - } - nums[0] = bytes[0] | (bytes[1] << 8) | (bytes[2] << 16) | (bytes[3] << 24); -} - -/*____________________________________________________________________________ - | - | xdr3dfcoord - read or write compressed 3d coordinates to xdr file. - | - | this routine reads or writes (depending on how you opened the file with - | xdropen() ) a large number of 3d coordinates (stored in *fp). - | The number of coordinates triplets to write is given by *size. On - | read this number may be zero, in which case it reads as many as were written - | or it may specify the number if triplets to read (which should match the - | number written). - | Compression is achieved by first converting all floating numbers to integer - | using multiplication by *precision and rounding to the nearest integer. - | Then the minimum and maximum value are calculated to determine the range. - | The limited range of integers so found, is used to compress the coordinates. - | In addition the differences between succesive coordinates is calculated. - | If the difference happens to be 'small' then only the difference is saved, - | compressing the data even more. The notion of 'small' is changed dynamically - | and is enlarged or reduced whenever needed or possible. - | Extra compression is achieved in the case of GROMOS and coordinates of - | water molecules. GROMOS first writes out the Oxygen position, followed by - | the two hydrogens. In order to make the differences smaller (and thereby - | compression the data better) the order is changed into first one hydrogen - | then the oxygen, followed by the other hydrogen. This is rather special, but - | it shouldn't harm in the general case. - | - */ - -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) { - - - static int *ip = NULL; - static int oldsize; - static int *buf; - - int minint[3], maxint[3], mindiff, *lip, diff; - int lint1, lint2, lint3, oldlint1, oldlint2, oldlint3, smallidx; - int minidx, maxidx; - unsigned sizeint[3], sizesmall[3], bitsizeint[3], size3, *luip; - int flag, k; - int small, smaller, larger, i, is_small, is_smaller, run, prevrun; - float *lfp, lf; - int tmp, *thiscoord, prevcoord[3]; - unsigned int tmpcoord[30]; - - int bufsize, xdrid, lsize; - unsigned int bitsize; - float inv_precision; - int errval = 1; - - /* find out if xdrs is opened for reading or for writing */ - xdrid = 0; - while (xdridptr[xdrid] != xdrs) { - xdrid++; - if (xdrid >= MAXID) { - fprintf(stderr, "xdr error. no open xdr stream\n"); - exit (1); - } - } - if (xdrmodes[xdrid] == 'w') { - - /* xdrs is open for writing */ - - if (xdr_int(xdrs, size) == 0) - return 0; - size3 = *size * 3; - /* when the number of coordinates is small, don't try to compress; just - * write them as floats using xdr_vector - */ - if (*size <= 9 ) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - /* buf[0-2] are special and do not contain actual data */ - buf[0] = buf[1] = buf[2] = 0; - minint[0] = minint[1] = minint[2] = INT_MAX; - maxint[0] = maxint[1] = maxint[2] = INT_MIN; - prevrun = -1; - lfp = fp; - lip = ip; - mindiff = INT_MAX; - oldlint1 = oldlint2 = oldlint3 = 0; - while(lfp < fp + size3 ) { - /* find nearest integer */ - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint1 = lf; - if (lint1 < minint[0]) minint[0] = lint1; - if (lint1 > maxint[0]) maxint[0] = lint1; - *lip++ = lint1; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint2 = lf; - if (lint2 < minint[1]) minint[1] = lint2; - if (lint2 > maxint[1]) maxint[1] = lint2; - *lip++ = lint2; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint3 = lf; - if (lint3 < minint[2]) minint[2] = lint3; - if (lint3 > maxint[2]) maxint[2] = lint3; - *lip++ = lint3; - lfp++; - diff = abs(oldlint1-lint1)+abs(oldlint2-lint2)+abs(oldlint3-lint3); - if (diff < mindiff && lfp > fp + 3) - mindiff = diff; - oldlint1 = lint1; - oldlint2 = lint2; - oldlint3 = lint3; - } - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - if ((float)maxint[0] - (float)minint[0] >= MAXABS || - (float)maxint[1] - (float)minint[1] >= MAXABS || - (float)maxint[2] - (float)minint[2] >= MAXABS) { - /* turning value in unsigned by subtracting minint - * would cause overflow - */ - errval = 0; - } - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - lip = ip; - luip = (unsigned int *) ip; - smallidx = FIRSTIDX; - while (smallidx < LASTIDX && magicints[smallidx] < mindiff) { - smallidx++; - } - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - larger = magicints[maxidx] / 2; - i = 0; - while (i < *size) { - is_small = 0; - thiscoord = (int *)(luip) + i * 3; - if (smallidx < maxidx && i >= 1 && - abs(thiscoord[0] - prevcoord[0]) < larger && - abs(thiscoord[1] - prevcoord[1]) < larger && - abs(thiscoord[2] - prevcoord[2]) < larger) { - is_smaller = 1; - } else if (smallidx > minidx) { - is_smaller = -1; - } else { - is_smaller = 0; - } - if (i + 1 < *size) { - if (abs(thiscoord[0] - thiscoord[3]) < small && - abs(thiscoord[1] - thiscoord[4]) < small && - abs(thiscoord[2] - thiscoord[5]) < small) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = thiscoord[3]; - thiscoord[3] = tmp; - tmp = thiscoord[1]; thiscoord[1] = thiscoord[4]; - thiscoord[4] = tmp; - tmp = thiscoord[2]; thiscoord[2] = thiscoord[5]; - thiscoord[5] = tmp; - is_small = 1; - } - - } - tmpcoord[0] = thiscoord[0] - minint[0]; - tmpcoord[1] = thiscoord[1] - minint[1]; - tmpcoord[2] = thiscoord[2] - minint[2]; - if (bitsize == 0) { - sendbits(buf, bitsizeint[0], tmpcoord[0]); - sendbits(buf, bitsizeint[1], tmpcoord[1]); - sendbits(buf, bitsizeint[2], tmpcoord[2]); - } else { - sendints(buf, 3, bitsize, sizeint, tmpcoord); - } - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - thiscoord = thiscoord + 3; - i++; - - run = 0; - if (is_small == 0 && is_smaller == -1) - is_smaller = 0; - while (is_small && run < 8*3) { - if (is_smaller == -1 && ( - SQR(thiscoord[0] - prevcoord[0]) + - SQR(thiscoord[1] - prevcoord[1]) + - SQR(thiscoord[2] - prevcoord[2]) >= smaller * smaller)) { - is_smaller = 0; - } - - tmpcoord[run++] = thiscoord[0] - prevcoord[0] + small; - tmpcoord[run++] = thiscoord[1] - prevcoord[1] + small; - tmpcoord[run++] = thiscoord[2] - prevcoord[2] + small; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - i++; - thiscoord = thiscoord + 3; - is_small = 0; - if (i < *size && - abs(thiscoord[0] - prevcoord[0]) < small && - abs(thiscoord[1] - prevcoord[1]) < small && - abs(thiscoord[2] - prevcoord[2]) < small) { - is_small = 1; - } - } - if (run != prevrun || is_smaller != 0) { - prevrun = run; - sendbits(buf, 1, 1); /* flag the change in run-length */ - sendbits(buf, 5, run+is_smaller+1); - } else { - sendbits(buf, 1, 0); /* flag the fact that runlength did not change */ - } - for (k=0; k < run; k+=3) { - sendints(buf, 3, smallidx, sizesmall, &tmpcoord[k]); - } - if (is_smaller != 0) { - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - smaller = magicints[smallidx-1] / 2; - } else { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - } - } - if (buf[1] != 0) buf[0]++;; - xdr_int(xdrs, &(buf[0])); /* buf[0] holds the length in bytes */ - return errval * (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0])); - } else { - - /* xdrs is open for reading */ - - if (xdr_int(xdrs, &lsize) == 0) - return 0; - if (*size != 0 && lsize != *size) { - fprintf(stderr, "wrong number of coordinates in xdr3dfcoor; " - "%d arg vs %d in file", *size, lsize); - } - *size = lsize; - size3 = *size * 3; - if (*size <= 9) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - buf[0] = buf[1] = buf[2] = 0; - - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - larger = magicints[maxidx]; - - /* buf[0] holds the length in bytes */ - - if (xdr_int(xdrs, &(buf[0])) == 0) - return 0; - if (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0]) == 0) - return 0; - buf[0] = buf[1] = buf[2] = 0; - - lfp = fp; - inv_precision = 1.0 / * precision; - run = 0; - i = 0; - lip = ip; - while ( i < lsize ) { - thiscoord = (int *)(lip) + i * 3; - - if (bitsize == 0) { - thiscoord[0] = receivebits(buf, bitsizeint[0]); - thiscoord[1] = receivebits(buf, bitsizeint[1]); - thiscoord[2] = receivebits(buf, bitsizeint[2]); - } else { - receiveints(buf, 3, bitsize, sizeint, thiscoord); - } - - i++; - thiscoord[0] += minint[0]; - thiscoord[1] += minint[1]; - thiscoord[2] += minint[2]; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - - flag = receivebits(buf, 1); - is_smaller = 0; - if (flag == 1) { - run = receivebits(buf, 5); - is_smaller = run % 3; - run -= is_smaller; - is_smaller--; - } - if (run > 0) { - thiscoord += 3; - for (k = 0; k < run; k+=3) { - receiveints(buf, 3, smallidx, sizesmall, thiscoord); - i++; - thiscoord[0] += prevcoord[0] - small; - thiscoord[1] += prevcoord[1] - small; - thiscoord[2] += prevcoord[2] - small; - if (k == 0) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = prevcoord[0]; - prevcoord[0] = tmp; - tmp = thiscoord[1]; thiscoord[1] = prevcoord[1]; - prevcoord[1] = tmp; - tmp = thiscoord[2]; thiscoord[2] = prevcoord[2]; - prevcoord[2] = tmp; - *lfp++ = prevcoord[0] * inv_precision; - *lfp++ = prevcoord[1] * inv_precision; - *lfp++ = prevcoord[2] * inv_precision; - } else { - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - } - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - } else { - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - if (smallidx > FIRSTIDX) { - smaller = magicints[smallidx - 1] /2; - } else { - smaller = 0; - } - } else if (is_smaller > 0) { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - } - } - return 1; -} - - - diff --git a/source/wham/src-M/xdrf.org/libxdrf.m4.org b/source/wham/src-M/xdrf.org/libxdrf.m4.org deleted file mode 100644 index b14b374..0000000 --- a/source/wham/src-M/xdrf.org/libxdrf.m4.org +++ /dev/null @@ -1,1230 +0,0 @@ -/*____________________________________________________________________________ - | - | libxdrf - portable fortran interface to xdr. some xdr routines - | are C routines for compressed coordinates - | - | version 1.1 - | - | This collection of routines is intended to write and read - | data in a portable way to a file, so data written on one type - | of machine can be read back on a different type. - | - | all fortran routines use an integer 'xdrid', which is an id to the - | current xdr file, and is set by xdrfopen. - | most routines have in integer 'ret' which is the return value. - | The value of 'ret' is zero on failure, and most of the time one - | on succes. - | - | There are three routines useful for C users: - | xdropen(), xdrclose(), xdr3dfcoord(). - | The first two replace xdrstdio_create and xdr_destroy, and *must* be - | used when you plan to use xdr3dfcoord(). (they are also a bit - | easier to interface). For writing data other than compressed coordinates - | you should use the standard C xdr routines (see xdr man page) - | - | xdrfopen(xdrid, filename, mode, ret) - | character *(*) filename - | character *(*) mode - | - | this will open the file with the given filename (string) - | and the given mode, it returns an id in xdrid, which is - | to be used in all other calls to xdrf routines. - | mode is 'w' to create, or update an file, for all other - | values of mode the file is opened for reading - | - | you need to call xdrfclose to flush the output and close - | the file. - | Note that you should not use xdrstdio_create, which comes with the - | standard xdr library - | - | xdrfclose(xdrid, ret) - | flush the data to the file, and closes the file; - | You should not use xdr_destroy (which comes standard with - | the xdr libraries. - | - | xdrfbool(xdrid, bp, ret) - | integer pb - | - | This filter produces values of either 1 or 0 - | - | xdrfchar(xdrid, cp, ret) - | character cp - | - | filter that translate between characters and their xdr representation - | Note that the characters in not compressed and occupies 4 bytes. - | - | xdrfdouble(xdrid, dp, ret) - | double dp - | - | read/write a double. - | - | xdrffloat(xdrid, fp, ret) - | float fp - | - | read/write a float. - | - | xdrfint(xdrid, ip, ret) - | integer ip - | - | read/write integer. - | - | xdrflong(xdrid, lp, ret) - | integer lp - | - | this routine has a possible portablility problem due to 64 bits longs. - | - | xdrfshort(xdrid, sp, ret) - | integer *2 sp - | - | xdrfstring(xdrid, sp, maxsize, ret) - | character *(*) - | integer maxsize - | - | read/write a string, with maximum length given by maxsize - | - | xdrfwrapstring(xdris, sp, ret) - | character *(*) - | - | read/write a string (it is the same as xdrfstring accept that it finds - | the stringlength itself. - | - | xdrfvector(xdrid, cp, size, xdrfproc, ret) - | character *(*) - | integer size - | external xdrfproc - | - | read/write an array pointed to by cp, with number of elements - | defined by 'size'. the routine 'xdrfproc' is the name - | of one of the above routines to read/write data (like xdrfdouble) - | In contrast with the c-version you don't need to specify the - | byte size of an element. - | xdrfstring is not allowed here (it is in the c version) - | - | xdrf3dfcoord(xdrid, fp, size, precision, ret) - | real (*) fp - | real precision - | integer size - | - | this is *NOT* a standard xdr routine. I named it this way, because - | it invites people to use the other xdr routines. - | It is introduced to store specifically 3d coordinates of molecules - | (as found in molecular dynamics) and it writes it in a compressed way. - | It starts by multiplying all numbers by precision and - | rounding the result to integer. effectively converting - | all floating point numbers to fixed point. - | it uses an algorithm for compression that is optimized for - | molecular data, but could be used for other 3d coordinates - | as well. There is subtantial overhead involved, so call this - | routine only if you have a large number of coordinates to read/write - | - | ________________________________________________________________________ - | - | Below are the routines to be used by C programmers. Use the 'normal' - | xdr routines to write integers, floats, etc (see man xdr) - | - | int xdropen(XDR *xdrs, const char *filename, const char *type) - | This will open the file with the given filename and the - | given mode. You should pass it an allocated XDR struct - | in xdrs, to be used in all other calls to xdr routines. - | Mode is 'w' to create, or update an file, and for all - | other values of mode the file is opened for reading. - | You need to call xdrclose to flush the output and close - | the file. - | - | Note that you should not use xdrstdio_create, which - | comes with the standard xdr library. - | - | int xdrclose(XDR *xdrs) - | Flush the data to the file, and close the file; - | You should not use xdr_destroy (which comes standard - | with the xdr libraries). - | - | int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) - | This is \fInot\fR a standard xdr routine. I named it this - | way, because it invites people to use the other xdr - | routines. - | - | (c) 1995 Frans van Hoesel, hoesel@chem.rug.nl -*/ - - -#include -#include -#include -#include -#include -#include -#include -#include "xdrf.h" - -int ftocstr(char *, int, char *, int); -int ctofstr(char *, int, char *); - -#define MAXID 20 -static FILE *xdrfiles[MAXID]; -static XDR *xdridptr[MAXID]; -static char xdrmodes[MAXID]; -static unsigned int cnt; - -typedef void (* FUNCTION(xdrfproc)) (int *, void *, int *); - -void -FUNCTION(xdrfbool) ARGS(`xdrid, pb, ret') -int *xdrid, *ret; -int *pb; -{ - *ret = xdr_bool(xdridptr[*xdrid], (bool_t *) pb); - cnt += sizeof(int); -} - -void -FUNCTION(xdrfchar) ARGS(`xdrid, cp, ret') -int *xdrid, *ret; -char *cp; -{ - *ret = xdr_char(xdridptr[*xdrid], cp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfdouble) ARGS(`xdrid, dp, ret') -int *xdrid, *ret; -double *dp; -{ - *ret = xdr_double(xdridptr[*xdrid], dp); - cnt += sizeof(double); -} - -void -FUNCTION(xdrffloat) ARGS(`xdrid, fp, ret') -int *xdrid, *ret; -float *fp; -{ - *ret = xdr_float(xdridptr[*xdrid], fp); - cnt += sizeof(float); -} - -void -FUNCTION(xdrfint) ARGS(`xdrid, ip, ret') -int *xdrid, *ret; -int *ip; -{ - *ret = xdr_int(xdridptr[*xdrid], ip); - cnt += sizeof(int); -} - -void -FUNCTION(xdrflong) ARGS(`xdrid, lp, ret') -int *xdrid, *ret; -long *lp; -{ - *ret = xdr_long(xdridptr[*xdrid], lp); - cnt += sizeof(long); -} - -void -FUNCTION(xdrfshort) ARGS(`xdrid, sp, ret') -int *xdrid, *ret; -short *sp; -{ - *ret = xdr_short(xdridptr[*xdrid], sp); - cnt += sizeof(sp); -} - -void -FUNCTION(xdrfuchar) ARGS(`xdrid, ucp, ret') -int *xdrid, *ret; -char *ucp; -{ - *ret = xdr_u_char(xdridptr[*xdrid], ucp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfulong) ARGS(`xdrid, ulp, ret') -int *xdrid, *ret; -unsigned long *ulp; -{ - *ret = xdr_u_long(xdridptr[*xdrid], ulp); - cnt += sizeof(unsigned long); -} - -void -FUNCTION(xdrfushort) ARGS(`xdrid, usp, ret') -int *xdrid, *ret; -unsigned short *usp; -{ - *ret = xdr_u_short(xdridptr[*xdrid], usp); - cnt += sizeof(unsigned short); -} - -void -FUNCTION(xdrf3dfcoord) ARGS(`xdrid, fp, size, precision, ret') -int *xdrid, *ret; -float *fp; -int *size; -float *precision; -{ - *ret = xdr3dfcoord(xdridptr[*xdrid], fp, size, precision); -} - -void -FUNCTION(xdrfstring) ARGS(`xdrid, STRING_ARG(sp), maxsize, ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -int *maxsize; -{ - char *tsp; - - tsp = (char*) malloc(((STRING_LEN(sp)) + 1) * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, *maxsize+1, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int) *maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += *maxsize; - free(tsp); -} - -void -FUNCTION(xdrfwrapstring) ARGS(`xdrid, STRING_ARG(sp), ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -{ - char *tsp; - int maxsize; - maxsize = (STRING_LEN(sp)) + 1; - tsp = (char*) malloc(maxsize * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, maxsize, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int)maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += maxsize; - free(tsp); -} - -void -FUNCTION(xdrfopaque) ARGS(`xdrid, cp, ccnt, ret') -int *xdrid, *ret; -caddr_t *cp; -int *ccnt; -{ - *ret = xdr_opaque(xdridptr[*xdrid], (caddr_t)*cp, (u_int)*ccnt); - cnt += *ccnt; -} - -void -FUNCTION(xdrfsetpos) ARGS(`xdrid, pos, ret') -int *xdrid, *ret; -int *pos; -{ - *ret = xdr_setpos(xdridptr[*xdrid], (u_int) *pos); -} - -void -FUNCTION(xdrf) ARGS(`xdrid, pos') -int *xdrid, *pos; -{ - *pos = xdr_getpos(xdridptr[*xdrid]); -} - -void -FUNCTION(xdrfvector) ARGS(`xdrid, cp, size, elproc, ret') -int *xdrid, *ret; -char *cp; -int *size; -FUNCTION(xdrfproc) elproc; -{ - int lcnt; - cnt = 0; - for (lcnt = 0; lcnt < *size; lcnt++) { - elproc(xdrid, (cp+cnt) , ret); - } -} - - -void -FUNCTION(xdrfclose) ARGS(`xdrid, ret') -int *xdrid; -int *ret; -{ - *ret = xdrclose(xdridptr[*xdrid]); - cnt = 0; -} - -void -FUNCTION(xdrfopen) ARGS(`xdrid, STRING_ARG(fp), STRING_ARG(mode), ret') -int *xdrid; -STRING_ARG_DECL(fp); -STRING_ARG_DECL(mode); -int *ret; -{ - char fname[512]; - char fmode[3]; - - if (ftocstr(fname, sizeof(fname), STRING_PTR(fp), STRING_LEN(fp))) { - *ret = 0; - } - if (ftocstr(fmode, sizeof(fmode), STRING_PTR(mode), - STRING_LEN(mode))) { - *ret = 0; - } - - *xdrid = xdropen(NULL, fname, fmode); - if (*xdrid == 0) - *ret = 0; - else - *ret = 1; -} - -/*___________________________________________________________________________ - | - | what follows are the C routines for opening, closing xdr streams - | and the routine to read/write compressed coordinates together - | with some routines to assist in this task (those are marked - | static and cannot be called from user programs) -*/ -#define MAXABS INT_MAX-2 - -#ifndef MIN -#define MIN(x,y) ((x) < (y) ? (x):(y)) -#endif -#ifndef MAX -#define MAX(x,y) ((x) > (y) ? (x):(y)) -#endif -#ifndef SQR -#define SQR(x) ((x)*(x)) -#endif -static int magicints[] = { - 0, 0, 0, 0, 0, 0, 0, 0, 0, - 8, 10, 12, 16, 20, 25, 32, 40, 50, 64, - 80, 101, 128, 161, 203, 256, 322, 406, 512, 645, - 812, 1024, 1290, 1625, 2048, 2580, 3250, 4096, 5060, 6501, - 8192, 10321, 13003, 16384, 20642, 26007, 32768, 41285, 52015, 65536, - 82570, 104031, 131072, 165140, 208063, 262144, 330280, 416127, 524287, 660561, - 832255, 1048576, 1321122, 1664510, 2097152, 2642245, 3329021, 4194304, 5284491, 6658042, - 8388607, 10568983, 13316085, 16777216 }; - -#define FIRSTIDX 9 -/* note that magicints[FIRSTIDX-1] == 0 */ -#define LASTIDX (sizeof(magicints) / sizeof(*magicints)) - - -/*__________________________________________________________________________ - | - | xdropen - open xdr file - | - | This versions differs from xdrstdio_create, because I need to know - | the state of the file (read or write) so I can use xdr3dfcoord - | in eigther read or write mode, and the file descriptor - | so I can close the file (something xdr_destroy doesn't do). - | -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type) { - static int init_done = 0; - enum xdr_op lmode; - int xdrid; - - if (init_done == 0) { - for (xdrid = 1; xdrid < MAXID; xdrid++) { - xdridptr[xdrid] = NULL; - } - init_done = 1; - } - xdrid = 1; - while (xdrid < MAXID && xdridptr[xdrid] != NULL) { - xdrid++; - } - if (xdrid == MAXID) { - return 0; - } - if (*type == 'w' || *type == 'W') { - type = "w+"; - lmode = XDR_ENCODE; - } else { - type = "r"; - lmode = XDR_DECODE; - } - xdrfiles[xdrid] = fopen(filename, type); - if (xdrfiles[xdrid] == NULL) { - xdrs = NULL; - return 0; - } - xdrmodes[xdrid] = *type; - /* next test isn't usefull in the case of C language - * but is used for the Fortran interface - * (C users are expected to pass the address of an already allocated - * XDR staructure) - */ - if (xdrs == NULL) { - xdridptr[xdrid] = (XDR *) malloc(sizeof(XDR)); - xdrstdio_create(xdridptr[xdrid], xdrfiles[xdrid], lmode); - } else { - xdridptr[xdrid] = xdrs; - xdrstdio_create(xdrs, xdrfiles[xdrid], lmode); - } - return xdrid; -} - -/*_________________________________________________________________________ - | - | xdrclose - close a xdr file - | - | This will flush the xdr buffers, and destroy the xdr stream. - | It also closes the associated file descriptor (this is *not* - | done by xdr_destroy). - | -*/ - -int xdrclose(XDR *xdrs) { - int xdrid; - - if (xdrs == NULL) { - fprintf(stderr, "xdrclose: passed a NULL pointer\n"); - exit(1); - } - for (xdrid = 1; xdrid < MAXID; xdrid++) { - if (xdridptr[xdrid] == xdrs) { - - xdr_destroy(xdrs); - fclose(xdrfiles[xdrid]); - xdridptr[xdrid] = NULL; - return 1; - } - } - fprintf(stderr, "xdrclose: no such open xdr file\n"); - exit(1); - -} - -/*____________________________________________________________________________ - | - | sendbits - encode num into buf using the specified number of bits - | - | This routines appends the value of num to the bits already present in - | the array buf. You need to give it the number of bits to use and you - | better make sure that this number of bits is enough to hold the value - | Also num must be positive. - | -*/ - -static void sendbits(int buf[], int num_of_bits, int num) { - - unsigned int cnt, lastbyte; - int lastbits; - unsigned char * cbuf; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = (unsigned int) buf[0]; - lastbits = buf[1]; - lastbyte =(unsigned int) buf[2]; - while (num_of_bits >= 8) { - lastbyte = (lastbyte << 8) | ((num >> (num_of_bits -8)) /* & 0xff*/); - cbuf[cnt++] = lastbyte >> lastbits; - num_of_bits -= 8; - } - if (num_of_bits > 0) { - lastbyte = (lastbyte << num_of_bits) | num; - lastbits += num_of_bits; - if (lastbits >= 8) { - lastbits -= 8; - cbuf[cnt++] = lastbyte >> lastbits; - } - } - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - if (lastbits>0) { - cbuf[cnt] = lastbyte << (8 - lastbits); - } -} - -/*_________________________________________________________________________ - | - | sizeofint - calculate bitsize of an integer - | - | return the number of bits needed to store an integer with given max size - | -*/ - -static int sizeofint(const int size) { - unsigned int num = 1; - int num_of_bits = 0; - - while (size >= num && num_of_bits < 32) { - num_of_bits++; - num <<= 1; - } - return num_of_bits; -} - -/*___________________________________________________________________________ - | - | sizeofints - calculate 'bitsize' of compressed ints - | - | given the number of small unsigned integers and the maximum value - | return the number of bits needed to read or write them with the - | routines receiveints and sendints. You need this parameter when - | calling these routines. Note that for many calls I can use - | the variable 'smallidx' which is exactly the number of bits, and - | So I don't need to call 'sizeofints for those calls. -*/ - -static int sizeofints( const int num_of_ints, unsigned int sizes[]) { - int i, num; - unsigned int num_of_bytes, num_of_bits, bytes[32], bytecnt, tmp; - num_of_bytes = 1; - bytes[0] = 1; - num_of_bits = 0; - for (i=0; i < num_of_ints; i++) { - tmp = 0; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - num = 1; - num_of_bytes--; - while (bytes[num_of_bytes] >= num) { - num_of_bits++; - num *= 2; - } - return num_of_bits + num_of_bytes * 8; - -} - -/*____________________________________________________________________________ - | - | sendints - send a small set of small integers in compressed format - | - | this routine is used internally by xdr3dfcoord, to send a set of - | small integers to the buffer. - | Multiplication with fixed (specified maximum ) sizes is used to get - | to one big, multibyte integer. Allthough the routine could be - | modified to handle sizes bigger than 16777216, or more than just - | a few integers, this is not done, because the gain in compression - | isn't worth the effort. Note that overflowing the multiplication - | or the byte buffer (32 bytes) is unchecked and causes bad results. - | - */ - -static void sendints(int buf[], const int num_of_ints, const int num_of_bits, - unsigned int sizes[], unsigned int nums[]) { - - int i; - unsigned int bytes[32], num_of_bytes, bytecnt, tmp; - - tmp = nums[0]; - num_of_bytes = 0; - do { - bytes[num_of_bytes++] = tmp & 0xff; - tmp >>= 8; - } while (tmp != 0); - - for (i = 1; i < num_of_ints; i++) { - if (nums[i] >= sizes[i]) { - fprintf(stderr,"major breakdown in sendints num %d doesn't " - "match size %d\n", nums[i], sizes[i]); - exit(1); - } - /* use one step multiply */ - tmp = nums[i]; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - if (num_of_bits >= num_of_bytes * 8) { - for (i = 0; i < num_of_bytes; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits - num_of_bytes * 8, 0); - } else { - for (i = 0; i < num_of_bytes-1; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits- (num_of_bytes -1) * 8, bytes[i]); - } -} - - -/*___________________________________________________________________________ - | - | receivebits - decode number from buf using specified number of bits - | - | extract the number of bits from the array buf and construct an integer - | from it. Return that value. - | -*/ - -static int receivebits(int buf[], int num_of_bits) { - - int cnt, num; - unsigned int lastbits, lastbyte; - unsigned char * cbuf; - int mask = (1 << num_of_bits) -1; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = buf[0]; - lastbits = (unsigned int) buf[1]; - lastbyte = (unsigned int) buf[2]; - - num = 0; - while (num_of_bits >= 8) { - lastbyte = ( lastbyte << 8 ) | cbuf[cnt++]; - num |= (lastbyte >> lastbits) << (num_of_bits - 8); - num_of_bits -=8; - } - if (num_of_bits > 0) { - if (lastbits < num_of_bits) { - lastbits += 8; - lastbyte = (lastbyte << 8) | cbuf[cnt++]; - } - lastbits -= num_of_bits; - num |= (lastbyte >> lastbits) & ((1 << num_of_bits) -1); - } - num &= mask; - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - return num; -} - -/*____________________________________________________________________________ - | - | receiveints - decode 'small' integers from the buf array - | - | this routine is the inverse from sendints() and decodes the small integers - | written to buf by calculating the remainder and doing divisions with - | the given sizes[]. You need to specify the total number of bits to be - | used from buf in num_of_bits. - | -*/ - -static void receiveints(int buf[], const int num_of_ints, int num_of_bits, - unsigned int sizes[], int nums[]) { - int bytes[32]; - int i, j, num_of_bytes, p, num; - - bytes[1] = bytes[2] = bytes[3] = 0; - num_of_bytes = 0; - while (num_of_bits > 8) { - bytes[num_of_bytes++] = receivebits(buf, 8); - num_of_bits -= 8; - } - if (num_of_bits > 0) { - bytes[num_of_bytes++] = receivebits(buf, num_of_bits); - } - for (i = num_of_ints-1; i > 0; i--) { - num = 0; - for (j = num_of_bytes-1; j >=0; j--) { - num = (num << 8) | bytes[j]; - p = num / sizes[i]; - bytes[j] = p; - num = num - p * sizes[i]; - } - nums[i] = num; - } - nums[0] = bytes[0] | (bytes[1] << 8) | (bytes[2] << 16) | (bytes[3] << 24); -} - -/*____________________________________________________________________________ - | - | xdr3dfcoord - read or write compressed 3d coordinates to xdr file. - | - | this routine reads or writes (depending on how you opened the file with - | xdropen() ) a large number of 3d coordinates (stored in *fp). - | The number of coordinates triplets to write is given by *size. On - | read this number may be zero, in which case it reads as many as were written - | or it may specify the number if triplets to read (which should match the - | number written). - | Compression is achieved by first converting all floating numbers to integer - | using multiplication by *precision and rounding to the nearest integer. - | Then the minimum and maximum value are calculated to determine the range. - | The limited range of integers so found, is used to compress the coordinates. - | In addition the differences between succesive coordinates is calculated. - | If the difference happens to be 'small' then only the difference is saved, - | compressing the data even more. The notion of 'small' is changed dynamically - | and is enlarged or reduced whenever needed or possible. - | Extra compression is achieved in the case of GROMOS and coordinates of - | water molecules. GROMOS first writes out the Oxygen position, followed by - | the two hydrogens. In order to make the differences smaller (and thereby - | compression the data better) the order is changed into first one hydrogen - | then the oxygen, followed by the other hydrogen. This is rather special, but - | it shouldn't harm in the general case. - | - */ - -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) { - - - static int *ip = NULL; - static int oldsize; - static int *buf; - - int minint[3], maxint[3], mindiff, *lip, diff; - int lint1, lint2, lint3, oldlint1, oldlint2, oldlint3, smallidx; - int minidx, maxidx; - unsigned sizeint[3], sizesmall[3], bitsizeint[3], size3, *luip; - int flag, k; - int small, smaller, larger, i, is_small, is_smaller, run, prevrun; - float *lfp, lf; - int tmp, *thiscoord, prevcoord[3]; - unsigned int tmpcoord[30]; - - int bufsize, xdrid, lsize; - unsigned int bitsize; - float inv_precision; - int errval = 1; - - /* find out if xdrs is opened for reading or for writing */ - xdrid = 0; - while (xdridptr[xdrid] != xdrs) { - xdrid++; - if (xdrid >= MAXID) { - fprintf(stderr, "xdr error. no open xdr stream\n"); - exit (1); - } - } - if (xdrmodes[xdrid] == 'w') { - - /* xdrs is open for writing */ - - if (xdr_int(xdrs, size) == 0) - return 0; - size3 = *size * 3; - /* when the number of coordinates is small, don't try to compress; just - * write them as floats using xdr_vector - */ - if (*size <= 9 ) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - /* buf[0-2] are special and do not contain actual data */ - buf[0] = buf[1] = buf[2] = 0; - minint[0] = minint[1] = minint[2] = INT_MAX; - maxint[0] = maxint[1] = maxint[2] = INT_MIN; - prevrun = -1; - lfp = fp; - lip = ip; - mindiff = INT_MAX; - oldlint1 = oldlint2 = oldlint3 = 0; - while(lfp < fp + size3 ) { - /* find nearest integer */ - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint1 = lf; - if (lint1 < minint[0]) minint[0] = lint1; - if (lint1 > maxint[0]) maxint[0] = lint1; - *lip++ = lint1; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint2 = lf; - if (lint2 < minint[1]) minint[1] = lint2; - if (lint2 > maxint[1]) maxint[1] = lint2; - *lip++ = lint2; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint3 = lf; - if (lint3 < minint[2]) minint[2] = lint3; - if (lint3 > maxint[2]) maxint[2] = lint3; - *lip++ = lint3; - lfp++; - diff = abs(oldlint1-lint1)+abs(oldlint2-lint2)+abs(oldlint3-lint3); - if (diff < mindiff && lfp > fp + 3) - mindiff = diff; - oldlint1 = lint1; - oldlint2 = lint2; - oldlint3 = lint3; - } - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - if ((float)maxint[0] - (float)minint[0] >= MAXABS || - (float)maxint[1] - (float)minint[1] >= MAXABS || - (float)maxint[2] - (float)minint[2] >= MAXABS) { - /* turning value in unsigned by subtracting minint - * would cause overflow - */ - errval = 0; - } - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - lip = ip; - luip = (unsigned int *) ip; - smallidx = FIRSTIDX; - while (smallidx < LASTIDX && magicints[smallidx] < mindiff) { - smallidx++; - } - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - larger = magicints[maxidx] / 2; - i = 0; - while (i < *size) { - is_small = 0; - thiscoord = (int *)(luip) + i * 3; - if (smallidx < maxidx && i >= 1 && - abs(thiscoord[0] - prevcoord[0]) < larger && - abs(thiscoord[1] - prevcoord[1]) < larger && - abs(thiscoord[2] - prevcoord[2]) < larger) { - is_smaller = 1; - } else if (smallidx > minidx) { - is_smaller = -1; - } else { - is_smaller = 0; - } - if (i + 1 < *size) { - if (abs(thiscoord[0] - thiscoord[3]) < small && - abs(thiscoord[1] - thiscoord[4]) < small && - abs(thiscoord[2] - thiscoord[5]) < small) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = thiscoord[3]; - thiscoord[3] = tmp; - tmp = thiscoord[1]; thiscoord[1] = thiscoord[4]; - thiscoord[4] = tmp; - tmp = thiscoord[2]; thiscoord[2] = thiscoord[5]; - thiscoord[5] = tmp; - is_small = 1; - } - - } - tmpcoord[0] = thiscoord[0] - minint[0]; - tmpcoord[1] = thiscoord[1] - minint[1]; - tmpcoord[2] = thiscoord[2] - minint[2]; - if (bitsize == 0) { - sendbits(buf, bitsizeint[0], tmpcoord[0]); - sendbits(buf, bitsizeint[1], tmpcoord[1]); - sendbits(buf, bitsizeint[2], tmpcoord[2]); - } else { - sendints(buf, 3, bitsize, sizeint, tmpcoord); - } - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - thiscoord = thiscoord + 3; - i++; - - run = 0; - if (is_small == 0 && is_smaller == -1) - is_smaller = 0; - while (is_small && run < 8*3) { - if (is_smaller == -1 && ( - SQR(thiscoord[0] - prevcoord[0]) + - SQR(thiscoord[1] - prevcoord[1]) + - SQR(thiscoord[2] - prevcoord[2]) >= smaller * smaller)) { - is_smaller = 0; - } - - tmpcoord[run++] = thiscoord[0] - prevcoord[0] + small; - tmpcoord[run++] = thiscoord[1] - prevcoord[1] + small; - tmpcoord[run++] = thiscoord[2] - prevcoord[2] + small; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - i++; - thiscoord = thiscoord + 3; - is_small = 0; - if (i < *size && - abs(thiscoord[0] - prevcoord[0]) < small && - abs(thiscoord[1] - prevcoord[1]) < small && - abs(thiscoord[2] - prevcoord[2]) < small) { - is_small = 1; - } - } - if (run != prevrun || is_smaller != 0) { - prevrun = run; - sendbits(buf, 1, 1); /* flag the change in run-length */ - sendbits(buf, 5, run+is_smaller+1); - } else { - sendbits(buf, 1, 0); /* flag the fact that runlength did not change */ - } - for (k=0; k < run; k+=3) { - sendints(buf, 3, smallidx, sizesmall, &tmpcoord[k]); - } - if (is_smaller != 0) { - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - smaller = magicints[smallidx-1] / 2; - } else { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - } - } - if (buf[1] != 0) buf[0]++;; - xdr_int(xdrs, &(buf[0])); /* buf[0] holds the length in bytes */ - return errval * (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0])); - } else { - - /* xdrs is open for reading */ - - if (xdr_int(xdrs, &lsize) == 0) - return 0; - if (*size != 0 && lsize != *size) { - fprintf(stderr, "wrong number of coordinates in xdr3dfcoor; " - "%d arg vs %d in file", *size, lsize); - } - *size = lsize; - size3 = *size * 3; - if (*size <= 9) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - buf[0] = buf[1] = buf[2] = 0; - - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - larger = magicints[maxidx]; - - /* buf[0] holds the length in bytes */ - - if (xdr_int(xdrs, &(buf[0])) == 0) - return 0; - if (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0]) == 0) - return 0; - buf[0] = buf[1] = buf[2] = 0; - - lfp = fp; - inv_precision = 1.0 / * precision; - run = 0; - i = 0; - lip = ip; - while ( i < lsize ) { - thiscoord = (int *)(lip) + i * 3; - - if (bitsize == 0) { - thiscoord[0] = receivebits(buf, bitsizeint[0]); - thiscoord[1] = receivebits(buf, bitsizeint[1]); - thiscoord[2] = receivebits(buf, bitsizeint[2]); - } else { - receiveints(buf, 3, bitsize, sizeint, thiscoord); - } - - i++; - thiscoord[0] += minint[0]; - thiscoord[1] += minint[1]; - thiscoord[2] += minint[2]; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - - flag = receivebits(buf, 1); - is_smaller = 0; - if (flag == 1) { - run = receivebits(buf, 5); - is_smaller = run % 3; - run -= is_smaller; - is_smaller--; - } - if (run > 0) { - thiscoord += 3; - for (k = 0; k < run; k+=3) { - receiveints(buf, 3, smallidx, sizesmall, thiscoord); - i++; - thiscoord[0] += prevcoord[0] - small; - thiscoord[1] += prevcoord[1] - small; - thiscoord[2] += prevcoord[2] - small; - if (k == 0) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = prevcoord[0]; - prevcoord[0] = tmp; - tmp = thiscoord[1]; thiscoord[1] = prevcoord[1]; - prevcoord[1] = tmp; - tmp = thiscoord[2]; thiscoord[2] = prevcoord[2]; - prevcoord[2] = tmp; - *lfp++ = prevcoord[0] * inv_precision; - *lfp++ = prevcoord[1] * inv_precision; - *lfp++ = prevcoord[2] * inv_precision; - } else { - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - } - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - } else { - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - if (smallidx > FIRSTIDX) { - smaller = magicints[smallidx - 1] /2; - } else { - smaller = 0; - } - } else if (is_smaller > 0) { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - } - } - return 1; -} - - - diff --git a/source/wham/src-M/xdrf.org/types.h b/source/wham/src-M/xdrf.org/types.h deleted file mode 100644 index 871f3fd..0000000 --- a/source/wham/src-M/xdrf.org/types.h +++ /dev/null @@ -1,99 +0,0 @@ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -/* fixincludes should not add extern "C" to this file */ -/* - * Rpc additions to - */ -#ifndef _RPC_TYPES_H -#define _RPC_TYPES_H 1 - -typedef int bool_t; -typedef int enum_t; -/* This needs to be changed to uint32_t in the future */ -typedef unsigned long rpcprog_t; -typedef unsigned long rpcvers_t; -typedef unsigned long rpcproc_t; -typedef unsigned long rpcprot_t; -typedef unsigned long rpcport_t; - -#define __dontcare__ -1 - -#ifndef FALSE -# define FALSE (0) -#endif - -#ifndef TRUE -# define TRUE (1) -#endif - -#ifndef NULL -# define NULL 0 -#endif - -#include /* For malloc decl. */ -#define mem_alloc(bsize) malloc(bsize) -/* - * XXX: This must not use the second argument, or code in xdr_array.c needs - * to be modified. - */ -#define mem_free(ptr, bsize) free(ptr) - -#ifndef makedev /* ie, we haven't already included it */ -#include -#endif - -#ifndef __u_char_defined -typedef __u_char u_char; -typedef __u_short u_short; -typedef __u_int u_int; -typedef __u_long u_long; -typedef __quad_t quad_t; -typedef __u_quad_t u_quad_t; -typedef __fsid_t fsid_t; -# define __u_char_defined -#endif -#ifndef __daddr_t_defined -typedef __daddr_t daddr_t; -typedef __caddr_t caddr_t; -# define __daddr_t_defined -#endif - -#include -#include - -#include - -#ifndef INADDR_LOOPBACK -#define INADDR_LOOPBACK (u_long)0x7F000001 -#endif -#ifndef MAXHOSTNAMELEN -#define MAXHOSTNAMELEN 64 -#endif - -#endif /* rpc/types.h */ diff --git a/source/wham/src-M/xdrf.org/underscore.m4 b/source/wham/src-M/xdrf.org/underscore.m4 deleted file mode 100644 index 4d620a0..0000000 --- a/source/wham/src-M/xdrf.org/underscore.m4 +++ /dev/null @@ -1,19 +0,0 @@ -divert(-1) -undefine(`len') -# -# append an underscore to FORTRAN function names -# -define(`FUNCTION',`$1_') -# -# FORTRAN character strings are passed as follows: -# a pointer to the base of the string is passed in the normal -# argument list, and the length is passed by value as an extra -# argument, after all of the other arguments. -# -define(`ARGS',`($1`'undivert(1))') -define(`SAVE',`divert(1)$1`'divert(0)') -define(`STRING_ARG',`$1_ptr`'SAVE(`, $1_len')') -define(`STRING_ARG_DECL',`char * $1_ptr; int $1_len') -define(`STRING_LEN',`$1_len') -define(`STRING_PTR',`$1_ptr') -divert(0) diff --git a/source/wham/src-M/xdrf.org/xdr.c b/source/wham/src-M/xdrf.org/xdr.c deleted file mode 100644 index 33b8544..0000000 --- a/source/wham/src-M/xdrf.org/xdr.c +++ /dev/null @@ -1,752 +0,0 @@ -# define INTUSE(name) name -# define INTDEF(name) -/* @(#)xdr.c 2.1 88/07/29 4.0 RPCSRC */ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -#if !defined(lint) && defined(SCCSIDS) -static char sccsid[] = "@(#)xdr.c 1.35 87/08/12"; -#endif - -/* - * xdr.c, Generic XDR routines implementation. - * - * Copyright (C) 1986, Sun Microsystems, Inc. - * - * These are the "generic" xdr routines used to serialize and de-serialize - * most common data items. See xdr.h for more info on the interface to - * xdr. - */ - -#include -#include -#include -#include - -#include "types.h" -#include "xdr.h" - -#ifdef USE_IN_LIBIO -# include -#endif - -/* - * constants specific to the xdr "protocol" - */ -#define XDR_FALSE ((long) 0) -#define XDR_TRUE ((long) 1) -#define LASTUNSIGNED ((u_int) 0-1) - -/* - * for unit alignment - */ -static const char xdr_zero[BYTES_PER_XDR_UNIT] = {0, 0, 0, 0}; - -/* - * Free a data structure using XDR - * Not a filter, but a convenient utility nonetheless - */ -void -xdr_free (xdrproc_t proc, char *objp) -{ - XDR x; - - x.x_op = XDR_FREE; - (*proc) (&x, objp); -} - -/* - * XDR nothing - */ -bool_t -xdr_void (void) -{ - return TRUE; -} -INTDEF(xdr_void) - -/* - * XDR integers - */ -bool_t -xdr_int (XDR *xdrs, int *ip) -{ - -#if INT_MAX < LONG_MAX - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (long) *ip; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *ip = (int) l; - case XDR_FREE: - return TRUE; - } - return FALSE; -#elif INT_MAX == LONG_MAX - return INTUSE(xdr_long) (xdrs, (long *) ip); -#elif INT_MAX == SHRT_MAX - return INTUSE(xdr_short) (xdrs, (short *) ip); -#else -#error unexpected integer sizes in_xdr_int() -#endif -} -INTDEF(xdr_int) - -/* - * XDR unsigned integers - */ -bool_t -xdr_u_int (XDR *xdrs, u_int *up) -{ -#if UINT_MAX < ULONG_MAX - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (u_long) * up; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *up = (u_int) (u_long) l; - case XDR_FREE: - return TRUE; - } - return FALSE; -#elif UINT_MAX == ULONG_MAX - return INTUSE(xdr_u_long) (xdrs, (u_long *) up); -#elif UINT_MAX == USHRT_MAX - return INTUSE(xdr_short) (xdrs, (short *) up); -#else -#error unexpected integer sizes in_xdr_u_int() -#endif -} -INTDEF(xdr_u_int) - -/* - * XDR long integers - * The definition of xdr_long() is kept for backward - * compatibility. Instead xdr_int() should be used. - */ -bool_t -xdr_long (XDR *xdrs, long *lp) -{ - - if (xdrs->x_op == XDR_ENCODE - && (sizeof (int32_t) == sizeof (long) - || (int32_t) *lp == *lp)) - return XDR_PUTLONG (xdrs, lp); - - if (xdrs->x_op == XDR_DECODE) - return XDR_GETLONG (xdrs, lp); - - if (xdrs->x_op == XDR_FREE) - return TRUE; - - return FALSE; -} -INTDEF(xdr_long) - -/* - * XDR unsigned long integers - * The definition of xdr_u_long() is kept for backward - * compatibility. Instead xdr_u_int() should be used. - */ -bool_t -xdr_u_long (XDR *xdrs, u_long *ulp) -{ - switch (xdrs->x_op) - { - case XDR_DECODE: - { - long int tmp; - - if (XDR_GETLONG (xdrs, &tmp) == FALSE) - return FALSE; - - *ulp = (uint32_t) tmp; - return TRUE; - } - - case XDR_ENCODE: - if (sizeof (uint32_t) != sizeof (u_long) - && (uint32_t) *ulp != *ulp) - return FALSE; - - return XDR_PUTLONG (xdrs, (long *) ulp); - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_u_long) - -/* - * XDR hyper integers - * same as xdr_u_hyper - open coded to save a proc call! - */ -bool_t -xdr_hyper (XDR *xdrs, quad_t *llp) -{ - long int t1, t2; - - if (xdrs->x_op == XDR_ENCODE) - { - t1 = (long) ((*llp) >> 32); - t2 = (long) (*llp); - return (XDR_PUTLONG(xdrs, &t1) && XDR_PUTLONG(xdrs, &t2)); - } - - if (xdrs->x_op == XDR_DECODE) - { - if (!XDR_GETLONG(xdrs, &t1) || !XDR_GETLONG(xdrs, &t2)) - return FALSE; - *llp = ((quad_t) t1) << 32; - *llp |= (uint32_t) t2; - return TRUE; - } - - if (xdrs->x_op == XDR_FREE) - return TRUE; - - return FALSE; -} -INTDEF(xdr_hyper) - - -/* - * XDR hyper integers - * same as xdr_hyper - open coded to save a proc call! - */ -bool_t -xdr_u_hyper (XDR *xdrs, u_quad_t *ullp) -{ - long int t1, t2; - - if (xdrs->x_op == XDR_ENCODE) - { - t1 = (unsigned long) ((*ullp) >> 32); - t2 = (unsigned long) (*ullp); - return (XDR_PUTLONG(xdrs, &t1) && XDR_PUTLONG(xdrs, &t2)); - } - - if (xdrs->x_op == XDR_DECODE) - { - if (!XDR_GETLONG(xdrs, &t1) || !XDR_GETLONG(xdrs, &t2)) - return FALSE; - *ullp = ((u_quad_t) t1) << 32; - *ullp |= (uint32_t) t2; - return TRUE; - } - - if (xdrs->x_op == XDR_FREE) - return TRUE; - - return FALSE; -} -INTDEF(xdr_u_hyper) - -bool_t -xdr_longlong_t (XDR *xdrs, quad_t *llp) -{ - return INTUSE(xdr_hyper) (xdrs, llp); -} - -bool_t -xdr_u_longlong_t (XDR *xdrs, u_quad_t *ullp) -{ - return INTUSE(xdr_u_hyper) (xdrs, ullp); -} - -/* - * XDR short integers - */ -bool_t -xdr_short (XDR *xdrs, short *sp) -{ - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (long) *sp; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *sp = (short) l; - return TRUE; - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_short) - -/* - * XDR unsigned short integers - */ -bool_t -xdr_u_short (XDR *xdrs, u_short *usp) -{ - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (u_long) * usp; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *usp = (u_short) (u_long) l; - return TRUE; - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_u_short) - - -/* - * XDR a char - */ -bool_t -xdr_char (XDR *xdrs, char *cp) -{ - int i; - - i = (*cp); - if (!INTUSE(xdr_int) (xdrs, &i)) - { - return FALSE; - } - *cp = i; - return TRUE; -} - -/* - * XDR an unsigned char - */ -bool_t -xdr_u_char (XDR *xdrs, u_char *cp) -{ - u_int u; - - u = (*cp); - if (!INTUSE(xdr_u_int) (xdrs, &u)) - { - return FALSE; - } - *cp = u; - return TRUE; -} - -/* - * XDR booleans - */ -bool_t -xdr_bool (XDR *xdrs, bool_t *bp) -{ - long lb; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - lb = *bp ? XDR_TRUE : XDR_FALSE; - return XDR_PUTLONG (xdrs, &lb); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &lb)) - { - return FALSE; - } - *bp = (lb == XDR_FALSE) ? FALSE : TRUE; - return TRUE; - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_bool) - -/* - * XDR enumerations - */ -bool_t -xdr_enum (XDR *xdrs, enum_t *ep) -{ - enum sizecheck - { - SIZEVAL - }; /* used to find the size of an enum */ - - /* - * enums are treated as ints - */ - if (sizeof (enum sizecheck) == 4) - { -#if INT_MAX < LONG_MAX - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = *ep; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *ep = l; - case XDR_FREE: - return TRUE; - - } - return FALSE; -#else - return INTUSE(xdr_long) (xdrs, (long *) ep); -#endif - } - else if (sizeof (enum sizecheck) == sizeof (short)) - { - return INTUSE(xdr_short) (xdrs, (short *) ep); - } - else - { - return FALSE; - } -} -INTDEF(xdr_enum) - -/* - * XDR opaque data - * Allows the specification of a fixed size sequence of opaque bytes. - * cp points to the opaque object and cnt gives the byte length. - */ -bool_t -xdr_opaque (XDR *xdrs, caddr_t cp, u_int cnt) -{ - u_int rndup; - static char crud[BYTES_PER_XDR_UNIT]; - - /* - * if no data we are done - */ - if (cnt == 0) - return TRUE; - - /* - * round byte count to full xdr units - */ - rndup = cnt % BYTES_PER_XDR_UNIT; - if (rndup > 0) - rndup = BYTES_PER_XDR_UNIT - rndup; - - switch (xdrs->x_op) - { - case XDR_DECODE: - if (!XDR_GETBYTES (xdrs, cp, cnt)) - { - return FALSE; - } - if (rndup == 0) - return TRUE; - return XDR_GETBYTES (xdrs, (caddr_t)crud, rndup); - - case XDR_ENCODE: - if (!XDR_PUTBYTES (xdrs, cp, cnt)) - { - return FALSE; - } - if (rndup == 0) - return TRUE; - return XDR_PUTBYTES (xdrs, xdr_zero, rndup); - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_opaque) - -/* - * XDR counted bytes - * *cpp is a pointer to the bytes, *sizep is the count. - * If *cpp is NULL maxsize bytes are allocated - */ -bool_t -xdr_bytes (xdrs, cpp, sizep, maxsize) - XDR *xdrs; - char **cpp; - u_int *sizep; - u_int maxsize; -{ - char *sp = *cpp; /* sp is the actual string pointer */ - u_int nodesize; - - /* - * first deal with the length since xdr bytes are counted - */ - if (!INTUSE(xdr_u_int) (xdrs, sizep)) - { - return FALSE; - } - nodesize = *sizep; - if ((nodesize > maxsize) && (xdrs->x_op != XDR_FREE)) - { - return FALSE; - } - - /* - * now deal with the actual bytes - */ - switch (xdrs->x_op) - { - case XDR_DECODE: - if (nodesize == 0) - { - return TRUE; - } - if (sp == NULL) - { - *cpp = sp = (char *) mem_alloc (nodesize); - } - if (sp == NULL) - { - fprintf (NULL, "%s", "xdr_bytes: out of memory\n"); - return FALSE; - } - /* fall into ... */ - - case XDR_ENCODE: - return INTUSE(xdr_opaque) (xdrs, sp, nodesize); - - case XDR_FREE: - if (sp != NULL) - { - mem_free (sp, nodesize); - *cpp = NULL; - } - return TRUE; - } - return FALSE; -} -INTDEF(xdr_bytes) - -/* - * Implemented here due to commonality of the object. - */ -bool_t -xdr_netobj (xdrs, np) - XDR *xdrs; - struct netobj *np; -{ - - return INTUSE(xdr_bytes) (xdrs, &np->n_bytes, &np->n_len, MAX_NETOBJ_SZ); -} -INTDEF(xdr_netobj) - -/* - * XDR a discriminated union - * Support routine for discriminated unions. - * You create an array of xdrdiscrim structures, terminated with - * an entry with a null procedure pointer. The routine gets - * the discriminant value and then searches the array of xdrdiscrims - * looking for that value. It calls the procedure given in the xdrdiscrim - * to handle the discriminant. If there is no specific routine a default - * routine may be called. - * If there is no specific or default routine an error is returned. - */ -bool_t -xdr_union (xdrs, dscmp, unp, choices, dfault) - XDR *xdrs; - enum_t *dscmp; /* enum to decide which arm to work on */ - char *unp; /* the union itself */ - const struct xdr_discrim *choices; /* [value, xdr proc] for each arm */ - xdrproc_t dfault; /* default xdr routine */ -{ - enum_t dscm; - - /* - * we deal with the discriminator; it's an enum - */ - if (!INTUSE(xdr_enum) (xdrs, dscmp)) - { - return FALSE; - } - dscm = *dscmp; - - /* - * search choices for a value that matches the discriminator. - * if we find one, execute the xdr routine for that value. - */ - for (; choices->proc != NULL_xdrproc_t; choices++) - { - if (choices->value == dscm) - return (*(choices->proc)) (xdrs, unp, LASTUNSIGNED); - } - - /* - * no match - execute the default xdr routine if there is one - */ - return ((dfault == NULL_xdrproc_t) ? FALSE : - (*dfault) (xdrs, unp, LASTUNSIGNED)); -} -INTDEF(xdr_union) - - -/* - * Non-portable xdr primitives. - * Care should be taken when moving these routines to new architectures. - */ - - -/* - * XDR null terminated ASCII strings - * xdr_string deals with "C strings" - arrays of bytes that are - * terminated by a NULL character. The parameter cpp references a - * pointer to storage; If the pointer is null, then the necessary - * storage is allocated. The last parameter is the max allowed length - * of the string as specified by a protocol. - */ -bool_t -xdr_string (xdrs, cpp, maxsize) - XDR *xdrs; - char **cpp; - u_int maxsize; -{ - char *sp = *cpp; /* sp is the actual string pointer */ - u_int size; - u_int nodesize; - - /* - * first deal with the length since xdr strings are counted-strings - */ - switch (xdrs->x_op) - { - case XDR_FREE: - if (sp == NULL) - { - return TRUE; /* already free */ - } - /* fall through... */ - case XDR_ENCODE: - if (sp == NULL) - return FALSE; - size = strlen (sp); - break; - case XDR_DECODE: - break; - } - if (!INTUSE(xdr_u_int) (xdrs, &size)) - { - return FALSE; - } - if (size > maxsize) - { - return FALSE; - } - nodesize = size + 1; - if (nodesize == 0) - { - /* This means an overflow. It a bug in the caller which - provided a too large maxsize but nevertheless catch it - here. */ - return FALSE; - } - - /* - * now deal with the actual bytes - */ - switch (xdrs->x_op) - { - case XDR_DECODE: - if (sp == NULL) - *cpp = sp = (char *) mem_alloc (nodesize); - if (sp == NULL) - { - fprintf (NULL, "%s", "xdr_string: out of memory\n"); - return FALSE; - } - sp[size] = 0; - /* fall into ... */ - - case XDR_ENCODE: - return INTUSE(xdr_opaque) (xdrs, sp, size); - - case XDR_FREE: - mem_free (sp, nodesize); - *cpp = NULL; - return TRUE; - } - return FALSE; -} -INTDEF(xdr_string) - -/* - * Wrapper for xdr_string that can be called directly from - * routines like clnt_call - */ -bool_t -xdr_wrapstring (xdrs, cpp) - XDR *xdrs; - char **cpp; -{ - if (INTUSE(xdr_string) (xdrs, cpp, LASTUNSIGNED)) - { - return TRUE; - } - return FALSE; -} diff --git a/source/wham/src-M/xdrf.org/xdr.h b/source/wham/src-M/xdrf.org/xdr.h deleted file mode 100644 index 2602ad9..0000000 --- a/source/wham/src-M/xdrf.org/xdr.h +++ /dev/null @@ -1,379 +0,0 @@ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -/* - * xdr.h, External Data Representation Serialization Routines. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - */ - -#ifndef _RPC_XDR_H -#define _RPC_XDR_H 1 - -#include -#include -#include "types.h" - -/* We need FILE. */ -#include - -__BEGIN_DECLS - -/* - * XDR provides a conventional way for converting between C data - * types and an external bit-string representation. Library supplied - * routines provide for the conversion on built-in C data types. These - * routines and utility routines defined here are used to help implement - * a type encode/decode routine for each user-defined type. - * - * Each data type provides a single procedure which takes two arguments: - * - * bool_t - * xdrproc(xdrs, argresp) - * XDR *xdrs; - * *argresp; - * - * xdrs is an instance of a XDR handle, to which or from which the data - * type is to be converted. argresp is a pointer to the structure to be - * converted. The XDR handle contains an operation field which indicates - * which of the operations (ENCODE, DECODE * or FREE) is to be performed. - * - * XDR_DECODE may allocate space if the pointer argresp is null. This - * data can be freed with the XDR_FREE operation. - * - * We write only one procedure per data type to make it easy - * to keep the encode and decode procedures for a data type consistent. - * In many cases the same code performs all operations on a user defined type, - * because all the hard work is done in the component type routines. - * decode as a series of calls on the nested data types. - */ - -/* - * Xdr operations. XDR_ENCODE causes the type to be encoded into the - * stream. XDR_DECODE causes the type to be extracted from the stream. - * XDR_FREE can be used to release the space allocated by an XDR_DECODE - * request. - */ -enum xdr_op { - XDR_ENCODE = 0, - XDR_DECODE = 1, - XDR_FREE = 2 -}; - -/* - * This is the number of bytes per unit of external data. - */ -#define BYTES_PER_XDR_UNIT (4) -/* - * This only works if the above is a power of 2. But it's defined to be - * 4 by the appropriate RFCs. So it will work. And it's normally quicker - * than the old routine. - */ -#if 1 -#define RNDUP(x) (((x) + BYTES_PER_XDR_UNIT - 1) & ~(BYTES_PER_XDR_UNIT - 1)) -#else /* this is the old routine */ -#define RNDUP(x) ((((x) + BYTES_PER_XDR_UNIT - 1) / BYTES_PER_XDR_UNIT) \ - * BYTES_PER_XDR_UNIT) -#endif - -/* - * The XDR handle. - * Contains operation which is being applied to the stream, - * an operations vector for the particular implementation (e.g. see xdr_mem.c), - * and two private fields for the use of the particular implementation. - */ -typedef struct XDR XDR; -struct XDR - { - enum xdr_op x_op; /* operation; fast additional param */ - struct xdr_ops - { - bool_t (*x_getlong) (XDR *__xdrs, long *__lp); - /* get a long from underlying stream */ - bool_t (*x_putlong) (XDR *__xdrs, __const long *__lp); - /* put a long to " */ - bool_t (*x_getbytes) (XDR *__xdrs, caddr_t __addr, u_int __len); - /* get some bytes from " */ - bool_t (*x_putbytes) (XDR *__xdrs, __const char *__addr, u_int __len); - /* put some bytes to " */ - u_int (*x_getpostn) (__const XDR *__xdrs); - /* returns bytes off from beginning */ - bool_t (*x_setpostn) (XDR *__xdrs, u_int __pos); - /* lets you reposition the stream */ - int32_t *(*x_inline) (XDR *__xdrs, u_int __len); - /* buf quick ptr to buffered data */ - void (*x_destroy) (XDR *__xdrs); - /* free privates of this xdr_stream */ - bool_t (*x_getint32) (XDR *__xdrs, int32_t *__ip); - /* get a int from underlying stream */ - bool_t (*x_putint32) (XDR *__xdrs, __const int32_t *__ip); - /* put a int to " */ - } - *x_ops; - caddr_t x_public; /* users' data */ - caddr_t x_private; /* pointer to private data */ - caddr_t x_base; /* private used for position info */ - u_int x_handy; /* extra private word */ - }; - -/* - * A xdrproc_t exists for each data type which is to be encoded or decoded. - * - * The second argument to the xdrproc_t is a pointer to an opaque pointer. - * The opaque pointer generally points to a structure of the data type - * to be decoded. If this pointer is 0, then the type routines should - * allocate dynamic storage of the appropriate size and return it. - * bool_t (*xdrproc_t)(XDR *, caddr_t *); - */ -typedef bool_t (*xdrproc_t) (XDR *, void *,...); - - -/* - * Operations defined on a XDR handle - * - * XDR *xdrs; - * int32_t *int32p; - * long *longp; - * caddr_t addr; - * u_int len; - * u_int pos; - */ -#define XDR_GETINT32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_getint32)(xdrs, int32p) -#define xdr_getint32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_getint32)(xdrs, int32p) - -#define XDR_PUTINT32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_putint32)(xdrs, int32p) -#define xdr_putint32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_putint32)(xdrs, int32p) - -#define XDR_GETLONG(xdrs, longp) \ - (*(xdrs)->x_ops->x_getlong)(xdrs, longp) -#define xdr_getlong(xdrs, longp) \ - (*(xdrs)->x_ops->x_getlong)(xdrs, longp) - -#define XDR_PUTLONG(xdrs, longp) \ - (*(xdrs)->x_ops->x_putlong)(xdrs, longp) -#define xdr_putlong(xdrs, longp) \ - (*(xdrs)->x_ops->x_putlong)(xdrs, longp) - -#define XDR_GETBYTES(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_getbytes)(xdrs, addr, len) -#define xdr_getbytes(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_getbytes)(xdrs, addr, len) - -#define XDR_PUTBYTES(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_putbytes)(xdrs, addr, len) -#define xdr_putbytes(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_putbytes)(xdrs, addr, len) - -#define XDR_GETPOS(xdrs) \ - (*(xdrs)->x_ops->x_getpostn)(xdrs) -#define xdr_getpos(xdrs) \ - (*(xdrs)->x_ops->x_getpostn)(xdrs) - -#define XDR_SETPOS(xdrs, pos) \ - (*(xdrs)->x_ops->x_setpostn)(xdrs, pos) -#define xdr_setpos(xdrs, pos) \ - (*(xdrs)->x_ops->x_setpostn)(xdrs, pos) - -#define XDR_INLINE(xdrs, len) \ - (*(xdrs)->x_ops->x_inline)(xdrs, len) -#define xdr_inline(xdrs, len) \ - (*(xdrs)->x_ops->x_inline)(xdrs, len) - -#define XDR_DESTROY(xdrs) \ - do { \ - if ((xdrs)->x_ops->x_destroy) \ - (*(xdrs)->x_ops->x_destroy)(xdrs); \ - } while (0) -#define xdr_destroy(xdrs) \ - do { \ - if ((xdrs)->x_ops->x_destroy) \ - (*(xdrs)->x_ops->x_destroy)(xdrs); \ - } while (0) - -/* - * Support struct for discriminated unions. - * You create an array of xdrdiscrim structures, terminated with - * a entry with a null procedure pointer. The xdr_union routine gets - * the discriminant value and then searches the array of structures - * for a matching value. If a match is found the associated xdr routine - * is called to handle that part of the union. If there is - * no match, then a default routine may be called. - * If there is no match and no default routine it is an error. - */ -#define NULL_xdrproc_t ((xdrproc_t)0) -struct xdr_discrim -{ - int value; - xdrproc_t proc; -}; - -/* - * Inline routines for fast encode/decode of primitive data types. - * Caveat emptor: these use single memory cycles to get the - * data from the underlying buffer, and will fail to operate - * properly if the data is not aligned. The standard way to use these - * is to say: - * if ((buf = XDR_INLINE(xdrs, count)) == NULL) - * return (FALSE); - * <<< macro calls >>> - * where ``count'' is the number of bytes of data occupied - * by the primitive data types. - * - * N.B. and frozen for all time: each data type here uses 4 bytes - * of external representation. - */ - -#define IXDR_GET_INT32(buf) ((int32_t)ntohl((uint32_t)*(buf)++)) -#define IXDR_PUT_INT32(buf, v) (*(buf)++ = (int32_t)htonl((uint32_t)(v))) -#define IXDR_GET_U_INT32(buf) ((uint32_t)IXDR_GET_INT32(buf)) -#define IXDR_PUT_U_INT32(buf, v) IXDR_PUT_INT32(buf, (int32_t)(v)) - -/* WARNING: The IXDR_*_LONG defines are removed by Sun for new platforms - * and shouldn't be used any longer. Code which use this defines or longs - * in the RPC code will not work on 64bit Solaris platforms ! - */ -#define IXDR_GET_LONG(buf) ((long)IXDR_GET_U_INT32(buf)) -#define IXDR_PUT_LONG(buf, v) ((long)IXDR_PUT_INT32(buf, (long)(v))) -#define IXDR_GET_U_LONG(buf) ((u_long)IXDR_GET_LONG(buf)) -#define IXDR_PUT_U_LONG(buf, v) IXDR_PUT_LONG(buf, (long)(v)) - - -#define IXDR_GET_BOOL(buf) ((bool_t)IXDR_GET_LONG(buf)) -#define IXDR_GET_ENUM(buf, t) ((t)IXDR_GET_LONG(buf)) -#define IXDR_GET_SHORT(buf) ((short)IXDR_GET_LONG(buf)) -#define IXDR_GET_U_SHORT(buf) ((u_short)IXDR_GET_LONG(buf)) - -#define IXDR_PUT_BOOL(buf, v) IXDR_PUT_LONG(buf, (long)(v)) -#define IXDR_PUT_ENUM(buf, v) IXDR_PUT_LONG(buf, (long)(v)) -#define IXDR_PUT_SHORT(buf, v) IXDR_PUT_LONG(buf, (long)(v)) -#define IXDR_PUT_U_SHORT(buf, v) IXDR_PUT_LONG(buf, (long)(v)) - -/* - * These are the "generic" xdr routines. - * None of these can have const applied because it's not possible to - * know whether the call is a read or a write to the passed parameter - * also, the XDR structure is always updated by some of these calls. - */ -extern bool_t xdr_void (void) __THROW; -extern bool_t xdr_short (XDR *__xdrs, short *__sp) __THROW; -extern bool_t xdr_u_short (XDR *__xdrs, u_short *__usp) __THROW; -extern bool_t xdr_int (XDR *__xdrs, int *__ip) __THROW; -extern bool_t xdr_u_int (XDR *__xdrs, u_int *__up) __THROW; -extern bool_t xdr_long (XDR *__xdrs, long *__lp) __THROW; -extern bool_t xdr_u_long (XDR *__xdrs, u_long *__ulp) __THROW; -extern bool_t xdr_hyper (XDR *__xdrs, quad_t *__llp) __THROW; -extern bool_t xdr_u_hyper (XDR *__xdrs, u_quad_t *__ullp) __THROW; -extern bool_t xdr_longlong_t (XDR *__xdrs, quad_t *__llp) __THROW; -extern bool_t xdr_u_longlong_t (XDR *__xdrs, u_quad_t *__ullp) __THROW; -extern bool_t xdr_int8_t (XDR *__xdrs, int8_t *__ip) __THROW; -extern bool_t xdr_uint8_t (XDR *__xdrs, uint8_t *__up) __THROW; -extern bool_t xdr_int16_t (XDR *__xdrs, int16_t *__ip) __THROW; -extern bool_t xdr_uint16_t (XDR *__xdrs, uint16_t *__up) __THROW; -extern bool_t xdr_int32_t (XDR *__xdrs, int32_t *__ip) __THROW; -extern bool_t xdr_uint32_t (XDR *__xdrs, uint32_t *__up) __THROW; -extern bool_t xdr_int64_t (XDR *__xdrs, int64_t *__ip) __THROW; -extern bool_t xdr_uint64_t (XDR *__xdrs, uint64_t *__up) __THROW; -extern bool_t xdr_quad_t (XDR *__xdrs, quad_t *__ip) __THROW; -extern bool_t xdr_u_quad_t (XDR *__xdrs, u_quad_t *__up) __THROW; -extern bool_t xdr_bool (XDR *__xdrs, bool_t *__bp) __THROW; -extern bool_t xdr_enum (XDR *__xdrs, enum_t *__ep) __THROW; -extern bool_t xdr_array (XDR * _xdrs, caddr_t *__addrp, u_int *__sizep, - u_int __maxsize, u_int __elsize, xdrproc_t __elproc) - __THROW; -extern bool_t xdr_bytes (XDR *__xdrs, char **__cpp, u_int *__sizep, - u_int __maxsize) __THROW; -extern bool_t xdr_opaque (XDR *__xdrs, caddr_t __cp, u_int __cnt) __THROW; -extern bool_t xdr_string (XDR *__xdrs, char **__cpp, u_int __maxsize) __THROW; -extern bool_t xdr_union (XDR *__xdrs, enum_t *__dscmp, char *__unp, - __const struct xdr_discrim *__choices, - xdrproc_t dfault) __THROW; -extern bool_t xdr_char (XDR *__xdrs, char *__cp) __THROW; -extern bool_t xdr_u_char (XDR *__xdrs, u_char *__cp) __THROW; -extern bool_t xdr_vector (XDR *__xdrs, char *__basep, u_int __nelem, - u_int __elemsize, xdrproc_t __xdr_elem) __THROW; -extern bool_t xdr_float (XDR *__xdrs, float *__fp) __THROW; -extern bool_t xdr_double (XDR *__xdrs, double *__dp) __THROW; -extern bool_t xdr_reference (XDR *__xdrs, caddr_t *__xpp, u_int __size, - xdrproc_t __proc) __THROW; -extern bool_t xdr_pointer (XDR *__xdrs, char **__objpp, - u_int __obj_size, xdrproc_t __xdr_obj) __THROW; -extern bool_t xdr_wrapstring (XDR *__xdrs, char **__cpp) __THROW; -extern u_long xdr_sizeof (xdrproc_t, void *) __THROW; - -/* - * Common opaque bytes objects used by many rpc protocols; - * declared here due to commonality. - */ -#define MAX_NETOBJ_SZ 1024 -struct netobj -{ - u_int n_len; - char *n_bytes; -}; -typedef struct netobj netobj; -extern bool_t xdr_netobj (XDR *__xdrs, struct netobj *__np) __THROW; - -/* - * These are the public routines for the various implementations of - * xdr streams. - */ - -/* XDR using memory buffers */ -extern void xdrmem_create (XDR *__xdrs, __const caddr_t __addr, - u_int __size, enum xdr_op __xop) __THROW; - -/* XDR using stdio library */ -extern void xdrstdio_create (XDR *__xdrs, FILE *__file, enum xdr_op __xop) - __THROW; - -/* XDR pseudo records for tcp */ -extern void xdrrec_create (XDR *__xdrs, u_int __sendsize, - u_int __recvsize, caddr_t __tcp_handle, - int (*__readit) (char *, char *, int), - int (*__writeit) (char *, char *, int)) __THROW; - -/* make end of xdr record */ -extern bool_t xdrrec_endofrecord (XDR *__xdrs, bool_t __sendnow) __THROW; - -/* move to beginning of next record */ -extern bool_t xdrrec_skiprecord (XDR *__xdrs) __THROW; - -/* true if no more input */ -extern bool_t xdrrec_eof (XDR *__xdrs) __THROW; - -/* free memory buffers for xdr */ -extern void xdr_free (xdrproc_t __proc, char *__objp) __THROW; - -__END_DECLS - -#endif /* rpc/xdr.h */ diff --git a/source/wham/src-M/xdrf.org/xdr.o b/source/wham/src-M/xdrf.org/xdr.o deleted file mode 100644 index 913a61c..0000000 Binary files a/source/wham/src-M/xdrf.org/xdr.o and /dev/null differ diff --git a/source/wham/src-M/xdrf.org/xdr_array.c b/source/wham/src-M/xdrf.org/xdr_array.c deleted file mode 100644 index 836405c..0000000 --- a/source/wham/src-M/xdrf.org/xdr_array.c +++ /dev/null @@ -1,174 +0,0 @@ -# define INTUSE(name) name -# define INTDEF(name) -/* @(#)xdr_array.c 2.1 88/07/29 4.0 RPCSRC */ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -#if !defined(lint) && defined(SCCSIDS) -static char sccsid[] = "@(#)xdr_array.c 1.10 87/08/11 Copyr 1984 Sun Micro"; -#endif - -/* - * xdr_array.c, Generic XDR routines implementation. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - * - * These are the "non-trivial" xdr primitives used to serialize and de-serialize - * arrays. See xdr.h for more info on the interface to xdr. - */ - -#include -#include -#include "types.h" -#include "xdr.h" -#include -#include - -#ifdef USE_IN_LIBIO -# include -#endif - -#define LASTUNSIGNED ((u_int)0-1) - - -/* - * XDR an array of arbitrary elements - * *addrp is a pointer to the array, *sizep is the number of elements. - * If addrp is NULL (*sizep * elsize) bytes are allocated. - * elsize is the size (in bytes) of each element, and elproc is the - * xdr procedure to call to handle each element of the array. - */ -bool_t -xdr_array (xdrs, addrp, sizep, maxsize, elsize, elproc) - XDR *xdrs; - caddr_t *addrp; /* array pointer */ - u_int *sizep; /* number of elements */ - u_int maxsize; /* max numberof elements */ - u_int elsize; /* size in bytes of each element */ - xdrproc_t elproc; /* xdr routine to handle each element */ -{ - u_int i; - caddr_t target = *addrp; - u_int c; /* the actual element count */ - bool_t stat = TRUE; - u_int nodesize; - - /* like strings, arrays are really counted arrays */ - if (!INTUSE(xdr_u_int) (xdrs, sizep)) - { - return FALSE; - } - c = *sizep; - /* - * XXX: Let the overflow possibly happen with XDR_FREE because mem_free() - * doesn't actually use its second argument anyway. - */ - if ((c > maxsize || c > UINT_MAX / elsize) && (xdrs->x_op != XDR_FREE)) - { - return FALSE; - } - nodesize = c * elsize; - - /* - * if we are deserializing, we may need to allocate an array. - * We also save time by checking for a null array if we are freeing. - */ - if (target == NULL) - switch (xdrs->x_op) - { - case XDR_DECODE: - if (c == 0) - return TRUE; - *addrp = target = mem_alloc (nodesize); - if (target == NULL) - { - fprintf (stderr, "%s", "xdr_array: out of memory\n"); - return FALSE; - } - __bzero (target, nodesize); - break; - - case XDR_FREE: - return TRUE; - default: - break; - } - - /* - * now we xdr each element of array - */ - for (i = 0; (i < c) && stat; i++) - { - stat = (*elproc) (xdrs, target, LASTUNSIGNED); - target += elsize; - } - - /* - * the array may need freeing - */ - if (xdrs->x_op == XDR_FREE) - { - mem_free (*addrp, nodesize); - *addrp = NULL; - } - return stat; -} -INTDEF(xdr_array) - -/* - * xdr_vector(): - * - * XDR a fixed length array. Unlike variable-length arrays, - * the storage of fixed length arrays is static and unfreeable. - * > basep: base of the array - * > size: size of the array - * > elemsize: size of each element - * > xdr_elem: routine to XDR each element - */ -bool_t -xdr_vector (xdrs, basep, nelem, elemsize, xdr_elem) - XDR *xdrs; - char *basep; - u_int nelem; - u_int elemsize; - xdrproc_t xdr_elem; -{ - u_int i; - char *elptr; - - elptr = basep; - for (i = 0; i < nelem; i++) - { - if (!(*xdr_elem) (xdrs, elptr, LASTUNSIGNED)) - { - return FALSE; - } - elptr += elemsize; - } - return TRUE; -} diff --git a/source/wham/src-M/xdrf.org/xdr_array.o b/source/wham/src-M/xdrf.org/xdr_array.o deleted file mode 100644 index 7526a6f..0000000 Binary files a/source/wham/src-M/xdrf.org/xdr_array.o and /dev/null differ diff --git a/source/wham/src-M/xdrf.org/xdr_float.c b/source/wham/src-M/xdrf.org/xdr_float.c deleted file mode 100644 index 15d3c88..0000000 --- a/source/wham/src-M/xdrf.org/xdr_float.c +++ /dev/null @@ -1,307 +0,0 @@ -/* @(#)xdr_float.c 2.1 88/07/29 4.0 RPCSRC */ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -#if !defined(lint) && defined(SCCSIDS) -static char sccsid[] = "@(#)xdr_float.c 1.12 87/08/11 Copyr 1984 Sun Micro"; -#endif - -/* - * xdr_float.c, Generic XDR routines implementation. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - * - * These are the "floating point" xdr routines used to (de)serialize - * most common data items. See xdr.h for more info on the interface to - * xdr. - */ - -#include -#include - -#include "types.h" -#include "xdr.h" - -/* - * NB: Not portable. - * This routine works on Suns (Sky / 68000's) and Vaxen. - */ - -#define LSW (__FLOAT_WORD_ORDER == __BIG_ENDIAN) - -#ifdef vax - -/* What IEEE single precision floating point looks like on a Vax */ -struct ieee_single { - unsigned int mantissa: 23; - unsigned int exp : 8; - unsigned int sign : 1; -}; - -/* Vax single precision floating point */ -struct vax_single { - unsigned int mantissa1 : 7; - unsigned int exp : 8; - unsigned int sign : 1; - unsigned int mantissa2 : 16; -}; - -#define VAX_SNG_BIAS 0x81 -#define IEEE_SNG_BIAS 0x7f - -static struct sgl_limits { - struct vax_single s; - struct ieee_single ieee; -} sgl_limits[2] = { - {{ 0x7f, 0xff, 0x0, 0xffff }, /* Max Vax */ - { 0x0, 0xff, 0x0 }}, /* Max IEEE */ - {{ 0x0, 0x0, 0x0, 0x0 }, /* Min Vax */ - { 0x0, 0x0, 0x0 }} /* Min IEEE */ -}; -#endif /* vax */ - -bool_t -xdr_float(xdrs, fp) - XDR *xdrs; - float *fp; -{ -#ifdef vax - struct ieee_single is; - struct vax_single vs, *vsp; - struct sgl_limits *lim; - int i; -#endif - switch (xdrs->x_op) { - - case XDR_ENCODE: -#ifdef vax - vs = *((struct vax_single *)fp); - for (i = 0, lim = sgl_limits; - i < sizeof(sgl_limits)/sizeof(struct sgl_limits); - i++, lim++) { - if ((vs.mantissa2 == lim->s.mantissa2) && - (vs.exp == lim->s.exp) && - (vs.mantissa1 == lim->s.mantissa1)) { - is = lim->ieee; - goto shipit; - } - } - is.exp = vs.exp - VAX_SNG_BIAS + IEEE_SNG_BIAS; - is.mantissa = (vs.mantissa1 << 16) | vs.mantissa2; - shipit: - is.sign = vs.sign; - return (XDR_PUTLONG(xdrs, (long *)&is)); -#else - if (sizeof(float) == sizeof(long)) - return (XDR_PUTLONG(xdrs, (long *)fp)); - else if (sizeof(float) == sizeof(int)) { - long tmp = *(int *)fp; - return (XDR_PUTLONG(xdrs, &tmp)); - } - break; -#endif - - case XDR_DECODE: -#ifdef vax - vsp = (struct vax_single *)fp; - if (!XDR_GETLONG(xdrs, (long *)&is)) - return (FALSE); - for (i = 0, lim = sgl_limits; - i < sizeof(sgl_limits)/sizeof(struct sgl_limits); - i++, lim++) { - if ((is.exp == lim->ieee.exp) && - (is.mantissa == lim->ieee.mantissa)) { - *vsp = lim->s; - goto doneit; - } - } - vsp->exp = is.exp - IEEE_SNG_BIAS + VAX_SNG_BIAS; - vsp->mantissa2 = is.mantissa; - vsp->mantissa1 = (is.mantissa >> 16); - doneit: - vsp->sign = is.sign; - return (TRUE); -#else - if (sizeof(float) == sizeof(long)) - return (XDR_GETLONG(xdrs, (long *)fp)); - else if (sizeof(float) == sizeof(int)) { - long tmp; - if (XDR_GETLONG(xdrs, &tmp)) { - *(int *)fp = tmp; - return (TRUE); - } - } - break; -#endif - - case XDR_FREE: - return (TRUE); - } - return (FALSE); -} - -/* - * This routine works on Suns (Sky / 68000's) and Vaxen. - */ - -#ifdef vax -/* What IEEE double precision floating point looks like on a Vax */ -struct ieee_double { - unsigned int mantissa1 : 20; - unsigned int exp : 11; - unsigned int sign : 1; - unsigned int mantissa2 : 32; -}; - -/* Vax double precision floating point */ -struct vax_double { - unsigned int mantissa1 : 7; - unsigned int exp : 8; - unsigned int sign : 1; - unsigned int mantissa2 : 16; - unsigned int mantissa3 : 16; - unsigned int mantissa4 : 16; -}; - -#define VAX_DBL_BIAS 0x81 -#define IEEE_DBL_BIAS 0x3ff -#define MASK(nbits) ((1 << nbits) - 1) - -static struct dbl_limits { - struct vax_double d; - struct ieee_double ieee; -} dbl_limits[2] = { - {{ 0x7f, 0xff, 0x0, 0xffff, 0xffff, 0xffff }, /* Max Vax */ - { 0x0, 0x7ff, 0x0, 0x0 }}, /* Max IEEE */ - {{ 0x0, 0x0, 0x0, 0x0, 0x0, 0x0}, /* Min Vax */ - { 0x0, 0x0, 0x0, 0x0 }} /* Min IEEE */ -}; - -#endif /* vax */ - - -bool_t -xdr_double(xdrs, dp) - XDR *xdrs; - double *dp; -{ -#ifdef vax - struct ieee_double id; - struct vax_double vd; - register struct dbl_limits *lim; - int i; -#endif - - switch (xdrs->x_op) { - - case XDR_ENCODE: -#ifdef vax - vd = *((struct vax_double *)dp); - for (i = 0, lim = dbl_limits; - i < sizeof(dbl_limits)/sizeof(struct dbl_limits); - i++, lim++) { - if ((vd.mantissa4 == lim->d.mantissa4) && - (vd.mantissa3 == lim->d.mantissa3) && - (vd.mantissa2 == lim->d.mantissa2) && - (vd.mantissa1 == lim->d.mantissa1) && - (vd.exp == lim->d.exp)) { - id = lim->ieee; - goto shipit; - } - } - id.exp = vd.exp - VAX_DBL_BIAS + IEEE_DBL_BIAS; - id.mantissa1 = (vd.mantissa1 << 13) | (vd.mantissa2 >> 3); - id.mantissa2 = ((vd.mantissa2 & MASK(3)) << 29) | - (vd.mantissa3 << 13) | - ((vd.mantissa4 >> 3) & MASK(13)); - shipit: - id.sign = vd.sign; - dp = (double *)&id; -#endif - if (2*sizeof(long) == sizeof(double)) { - long *lp = (long *)dp; - return (XDR_PUTLONG(xdrs, lp+!LSW) && - XDR_PUTLONG(xdrs, lp+LSW)); - } else if (2*sizeof(int) == sizeof(double)) { - int *ip = (int *)dp; - long tmp[2]; - tmp[0] = ip[!LSW]; - tmp[1] = ip[LSW]; - return (XDR_PUTLONG(xdrs, tmp) && - XDR_PUTLONG(xdrs, tmp+1)); - } - break; - - case XDR_DECODE: -#ifdef vax - lp = (long *)&id; - if (!XDR_GETLONG(xdrs, lp++) || !XDR_GETLONG(xdrs, lp)) - return (FALSE); - for (i = 0, lim = dbl_limits; - i < sizeof(dbl_limits)/sizeof(struct dbl_limits); - i++, lim++) { - if ((id.mantissa2 == lim->ieee.mantissa2) && - (id.mantissa1 == lim->ieee.mantissa1) && - (id.exp == lim->ieee.exp)) { - vd = lim->d; - goto doneit; - } - } - vd.exp = id.exp - IEEE_DBL_BIAS + VAX_DBL_BIAS; - vd.mantissa1 = (id.mantissa1 >> 13); - vd.mantissa2 = ((id.mantissa1 & MASK(13)) << 3) | - (id.mantissa2 >> 29); - vd.mantissa3 = (id.mantissa2 >> 13); - vd.mantissa4 = (id.mantissa2 << 3); - doneit: - vd.sign = id.sign; - *dp = *((double *)&vd); - return (TRUE); -#else - if (2*sizeof(long) == sizeof(double)) { - long *lp = (long *)dp; - return (XDR_GETLONG(xdrs, lp+!LSW) && - XDR_GETLONG(xdrs, lp+LSW)); - } else if (2*sizeof(int) == sizeof(double)) { - int *ip = (int *)dp; - long tmp[2]; - if (XDR_GETLONG(xdrs, tmp+!LSW) && - XDR_GETLONG(xdrs, tmp+LSW)) { - ip[0] = tmp[0]; - ip[1] = tmp[1]; - return (TRUE); - } - } - break; -#endif - - case XDR_FREE: - return (TRUE); - } - return (FALSE); -} diff --git a/source/wham/src-M/xdrf.org/xdr_float.o b/source/wham/src-M/xdrf.org/xdr_float.o deleted file mode 100644 index ce1fabd..0000000 Binary files a/source/wham/src-M/xdrf.org/xdr_float.o and /dev/null differ diff --git a/source/wham/src-M/xdrf.org/xdr_stdio.c b/source/wham/src-M/xdrf.org/xdr_stdio.c deleted file mode 100644 index 12b1709..0000000 --- a/source/wham/src-M/xdrf.org/xdr_stdio.c +++ /dev/null @@ -1,196 +0,0 @@ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -/* - * xdr_stdio.c, XDR implementation on standard i/o file. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - * - * This set of routines implements a XDR on a stdio stream. - * XDR_ENCODE serializes onto the stream, XDR_DECODE de-serializes - * from the stream. - */ - -#include "types.h" -#include -#include "xdr.h" - -#ifdef USE_IN_LIBIO -# include -# define fflush(s) INTUSE(_IO_fflush) (s) -# define fread(p, m, n, s) INTUSE(_IO_fread) (p, m, n, s) -# define ftell(s) INTUSE(_IO_ftell) (s) -# define fwrite(p, m, n, s) INTUSE(_IO_fwrite) (p, m, n, s) -#endif - -static bool_t xdrstdio_getlong (XDR *, long *); -static bool_t xdrstdio_putlong (XDR *, const long *); -static bool_t xdrstdio_getbytes (XDR *, caddr_t, u_int); -static bool_t xdrstdio_putbytes (XDR *, const char *, u_int); -static u_int xdrstdio_getpos (const XDR *); -static bool_t xdrstdio_setpos (XDR *, u_int); -static int32_t *xdrstdio_inline (XDR *, u_int); -static void xdrstdio_destroy (XDR *); -static bool_t xdrstdio_getint32 (XDR *, int32_t *); -static bool_t xdrstdio_putint32 (XDR *, const int32_t *); - -/* - * Ops vector for stdio type XDR - */ -static const struct xdr_ops xdrstdio_ops = -{ - xdrstdio_getlong, /* deserialize a long int */ - xdrstdio_putlong, /* serialize a long int */ - xdrstdio_getbytes, /* deserialize counted bytes */ - xdrstdio_putbytes, /* serialize counted bytes */ - xdrstdio_getpos, /* get offset in the stream */ - xdrstdio_setpos, /* set offset in the stream */ - xdrstdio_inline, /* prime stream for inline macros */ - xdrstdio_destroy, /* destroy stream */ - xdrstdio_getint32, /* deserialize a int */ - xdrstdio_putint32 /* serialize a int */ -}; - -/* - * Initialize a stdio xdr stream. - * Sets the xdr stream handle xdrs for use on the stream file. - * Operation flag is set to op. - */ -void -xdrstdio_create (XDR *xdrs, FILE *file, enum xdr_op op) -{ - xdrs->x_op = op; - /* We have to add the const since the `struct xdr_ops' in `struct XDR' - is not `const'. */ - xdrs->x_ops = (struct xdr_ops *) &xdrstdio_ops; - xdrs->x_private = (caddr_t) file; - xdrs->x_handy = 0; - xdrs->x_base = 0; -} - -/* - * Destroy a stdio xdr stream. - * Cleans up the xdr stream handle xdrs previously set up by xdrstdio_create. - */ -static void -xdrstdio_destroy (XDR *xdrs) -{ - (void) fflush ((FILE *) xdrs->x_private); - /* xx should we close the file ?? */ -}; - -static bool_t -xdrstdio_getlong (XDR *xdrs, long *lp) -{ - u_int32_t mycopy; - - if (fread ((caddr_t) &mycopy, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - *lp = (long) ntohl (mycopy); - return TRUE; -} - -static bool_t -xdrstdio_putlong (XDR *xdrs, const long *lp) -{ - int32_t mycopy = htonl ((u_int32_t) *lp); - - if (fwrite ((caddr_t) &mycopy, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - return TRUE; -} - -static bool_t -xdrstdio_getbytes (XDR *xdrs, const caddr_t addr, u_int len) -{ - if ((len != 0) && (fread (addr, (int) len, 1, - (FILE *) xdrs->x_private) != 1)) - return FALSE; - return TRUE; -} - -static bool_t -xdrstdio_putbytes (XDR *xdrs, const char *addr, u_int len) -{ - if ((len != 0) && (fwrite (addr, (int) len, 1, - (FILE *) xdrs->x_private) != 1)) - return FALSE; - return TRUE; -} - -static u_int -xdrstdio_getpos (const XDR *xdrs) -{ - return (u_int) ftell ((FILE *) xdrs->x_private); -} - -static bool_t -xdrstdio_setpos (XDR *xdrs, u_int pos) -{ - return fseek ((FILE *) xdrs->x_private, (long) pos, 0) < 0 ? FALSE : TRUE; -} - -static int32_t * -xdrstdio_inline (XDR *xdrs, u_int len) -{ - /* - * Must do some work to implement this: must insure - * enough data in the underlying stdio buffer, - * that the buffer is aligned so that we can indirect through a - * long *, and stuff this pointer in xdrs->x_buf. Doing - * a fread or fwrite to a scratch buffer would defeat - * most of the gains to be had here and require storage - * management on this buffer, so we don't do this. - */ - return NULL; -} - -static bool_t -xdrstdio_getint32 (XDR *xdrs, int32_t *ip) -{ - int32_t mycopy; - - if (fread ((caddr_t) &mycopy, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - *ip = ntohl (mycopy); - return TRUE; -} - -static bool_t -xdrstdio_putint32 (XDR *xdrs, const int32_t *ip) -{ - int32_t mycopy = htonl (*ip); - - ip = &mycopy; - if (fwrite ((caddr_t) ip, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - return TRUE; -} - -/* libc_hidden_def (xdrstdio_create) */ diff --git a/source/wham/src-M/xdrf.org/xdr_stdio.o b/source/wham/src-M/xdrf.org/xdr_stdio.o deleted file mode 100644 index 6bb7365..0000000 Binary files a/source/wham/src-M/xdrf.org/xdr_stdio.o and /dev/null differ diff --git a/source/wham/src-M/xdrf.org/xdrf.h b/source/wham/src-M/xdrf.org/xdrf.h deleted file mode 100644 index dedf5a2..0000000 --- a/source/wham/src-M/xdrf.org/xdrf.h +++ /dev/null @@ -1,10 +0,0 @@ -/*_________________________________________________________________ - | - | xdrf.h - include file for C routines that want to use the - | functions below. -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type); -int xdrclose(XDR *xdrs) ; -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) ; - diff --git a/source/wham/src-M/xdrf/Makefile b/source/wham/src-M/xdrf/Makefile deleted file mode 100644 index f03276e..0000000 --- a/source/wham/src-M/xdrf/Makefile +++ /dev/null @@ -1,27 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -CC = cc -CFLAGS = -O - -M4 = m4 -M4FILE = underscore.m4 - -libxdrf.a: libxdrf.o ftocstr.o - ar cr libxdrf.a $? - -clean: - rm -f libxdrf.o ftocstr.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c - rm -f libxdrf.c - diff --git a/source/wham/src-M/xdrf/Makefile~ b/source/wham/src-M/xdrf/Makefile~ deleted file mode 100644 index 0539995..0000000 --- a/source/wham/src-M/xdrf/Makefile~ +++ /dev/null @@ -1,27 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -CC = cc -CFLAGS = -O - -M4 = m4 -M4FILE = underscore.m4 - -libxdrf.a: libxdrf.o ftocstr.o - ar cr libxdrf.a $? - -clean: - rm -f libxdrfo ftocstr.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c - rm -f libxdrf.c - diff --git a/source/wham/src-M/xdrf/ftocstr.c b/source/wham/src-M/xdrf/ftocstr.c deleted file mode 100644 index ed2113f..0000000 --- a/source/wham/src-M/xdrf/ftocstr.c +++ /dev/null @@ -1,35 +0,0 @@ - - -int ftocstr(ds, dl, ss, sl) - char *ds, *ss; /* dst, src ptrs */ - int dl; /* dst max len */ - int sl; /* src len */ -{ - char *p; - - for (p = ss + sl; --p >= ss && *p == ' '; ) ; - sl = p - ss + 1; - dl--; - ds[0] = 0; - if (sl > dl) - return 1; - while (sl--) - (*ds++ = *ss++); - *ds = '\0'; - return 0; -} - - -int ctofstr(ds, dl, ss) - char *ds; /* dest space */ - int dl; /* max dest length */ - char *ss; /* src string (0-term) */ -{ - while (dl && *ss) { - *ds++ = *ss++; - dl--; - } - while (dl--) - *ds++ = ' '; - return 0; -} diff --git a/source/wham/src-M/xdrf/ftocstr.o b/source/wham/src-M/xdrf/ftocstr.o deleted file mode 100644 index f0102ea..0000000 Binary files a/source/wham/src-M/xdrf/ftocstr.o and /dev/null differ diff --git a/source/wham/src-M/xdrf/libxdrf.a b/source/wham/src-M/xdrf/libxdrf.a deleted file mode 100644 index e3db089..0000000 Binary files a/source/wham/src-M/xdrf/libxdrf.a and /dev/null differ diff --git a/source/wham/src-M/xdrf/libxdrf.m4 b/source/wham/src-M/xdrf/libxdrf.m4 deleted file mode 100644 index aecb5b5..0000000 --- a/source/wham/src-M/xdrf/libxdrf.m4 +++ /dev/null @@ -1,1233 +0,0 @@ -/*____________________________________________________________________________ - | - | libxdrf - portable fortran interface to xdr. some xdr routines - | are C routines for compressed coordinates - | - | version 1.1 - | - | This collection of routines is intended to write and read - | data in a portable way to a file, so data written on one type - | of machine can be read back on a different type. - | - | all fortran routines use an integer 'xdrid', which is an id to the - | current xdr file, and is set by xdrfopen. - | most routines have in integer 'ret' which is the return value. - | The value of 'ret' is zero on failure, and most of the time one - | on succes. - | - | There are three routines useful for C users: - | xdropen(), xdrclose(), xdr3dfcoord(). - | The first two replace xdrstdio_create and xdr_destroy, and *must* be - | used when you plan to use xdr3dfcoord(). (they are also a bit - | easier to interface). For writing data other than compressed coordinates - | you should use the standard C xdr routines (see xdr man page) - | - | xdrfopen(xdrid, filename, mode, ret) - | character *(*) filename - | character *(*) mode - | - | this will open the file with the given filename (string) - | and the given mode, it returns an id in xdrid, which is - | to be used in all other calls to xdrf routines. - | mode is 'w' to create, or update an file, for all other - | values of mode the file is opened for reading - | - | you need to call xdrfclose to flush the output and close - | the file. - | Note that you should not use xdrstdio_create, which comes with the - | standard xdr library - | - | xdrfclose(xdrid, ret) - | flush the data to the file, and closes the file; - | You should not use xdr_destroy (which comes standard with - | the xdr libraries. - | - | xdrfbool(xdrid, bp, ret) - | integer pb - | - | This filter produces values of either 1 or 0 - | - | xdrfchar(xdrid, cp, ret) - | character cp - | - | filter that translate between characters and their xdr representation - | Note that the characters in not compressed and occupies 4 bytes. - | - | xdrfdouble(xdrid, dp, ret) - | double dp - | - | read/write a double. - | - | xdrffloat(xdrid, fp, ret) - | float fp - | - | read/write a float. - | - | xdrfint(xdrid, ip, ret) - | integer ip - | - | read/write integer. - | - | xdrflong(xdrid, lp, ret) - | integer lp - | - | this routine has a possible portablility problem due to 64 bits longs. - | - | xdrfshort(xdrid, sp, ret) - | integer *2 sp - | - | xdrfstring(xdrid, sp, maxsize, ret) - | character *(*) - | integer maxsize - | - | read/write a string, with maximum length given by maxsize - | - | xdrfwrapstring(xdris, sp, ret) - | character *(*) - | - | read/write a string (it is the same as xdrfstring accept that it finds - | the stringlength itself. - | - | xdrfvector(xdrid, cp, size, xdrfproc, ret) - | character *(*) - | integer size - | external xdrfproc - | - | read/write an array pointed to by cp, with number of elements - | defined by 'size'. the routine 'xdrfproc' is the name - | of one of the above routines to read/write data (like xdrfdouble) - | In contrast with the c-version you don't need to specify the - | byte size of an element. - | xdrfstring is not allowed here (it is in the c version) - | - | xdrf3dfcoord(xdrid, fp, size, precision, ret) - | real (*) fp - | real precision - | integer size - | - | this is *NOT* a standard xdr routine. I named it this way, because - | it invites people to use the other xdr routines. - | It is introduced to store specifically 3d coordinates of molecules - | (as found in molecular dynamics) and it writes it in a compressed way. - | It starts by multiplying all numbers by precision and - | rounding the result to integer. effectively converting - | all floating point numbers to fixed point. - | it uses an algorithm for compression that is optimized for - | molecular data, but could be used for other 3d coordinates - | as well. There is subtantial overhead involved, so call this - | routine only if you have a large number of coordinates to read/write - | - | ________________________________________________________________________ - | - | Below are the routines to be used by C programmers. Use the 'normal' - | xdr routines to write integers, floats, etc (see man xdr) - | - | int xdropen(XDR *xdrs, const char *filename, const char *type) - | This will open the file with the given filename and the - | given mode. You should pass it an allocated XDR struct - | in xdrs, to be used in all other calls to xdr routines. - | Mode is 'w' to create, or update an file, and for all - | other values of mode the file is opened for reading. - | You need to call xdrclose to flush the output and close - | the file. - | - | Note that you should not use xdrstdio_create, which - | comes with the standard xdr library. - | - | int xdrclose(XDR *xdrs) - | Flush the data to the file, and close the file; - | You should not use xdr_destroy (which comes standard - | with the xdr libraries). - | - | int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) - | This is \fInot\fR a standard xdr routine. I named it this - | way, because it invites people to use the other xdr - | routines. - | - | (c) 1995 Frans van Hoesel, hoesel@chem.rug.nl -*/ - - -#include -#include -#include -#include -#include -#include -#include -#include "xdrf.h" - -int ftocstr(char *, int, char *, int); -int ctofstr(char *, int, char *); - -#define MAXID 20 -static FILE *xdrfiles[MAXID]; -static XDR *xdridptr[MAXID]; -static char xdrmodes[MAXID]; -static unsigned int cnt; - -typedef void (* FUNCTION(xdrfproc)) (int *, void *, int *); - -void -FUNCTION(xdrfbool) ARGS(`xdrid, pb, ret') -int *xdrid, *ret; -int *pb; -{ - *ret = xdr_bool(xdridptr[*xdrid], (bool_t *) pb); - cnt += sizeof(int); -} - -void -FUNCTION(xdrfchar) ARGS(`xdrid, cp, ret') -int *xdrid, *ret; -char *cp; -{ - *ret = xdr_char(xdridptr[*xdrid], cp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfdouble) ARGS(`xdrid, dp, ret') -int *xdrid, *ret; -double *dp; -{ - *ret = xdr_double(xdridptr[*xdrid], dp); - cnt += sizeof(double); -} - -void -FUNCTION(xdrffloat) ARGS(`xdrid, fp, ret') -int *xdrid, *ret; -float *fp; -{ - *ret = xdr_float(xdridptr[*xdrid], fp); - cnt += sizeof(float); -} - -void -FUNCTION(xdrfint) ARGS(`xdrid, ip, ret') -int *xdrid, *ret; -int *ip; -{ - *ret = xdr_int(xdridptr[*xdrid], ip); - cnt += sizeof(int); -} - -void -FUNCTION(xdrflong) ARGS(`xdrid, lp, ret') -int *xdrid, *ret; -long *lp; -{ - *ret = xdr_long(xdridptr[*xdrid], lp); - cnt += sizeof(long); -} - -void -FUNCTION(xdrfshort) ARGS(`xdrid, sp, ret') -int *xdrid, *ret; -short *sp; -{ - *ret = xdr_short(xdridptr[*xdrid], sp); - cnt += sizeof(sp); -} - -void -FUNCTION(xdrfuchar) ARGS(`xdrid, ucp, ret') -int *xdrid, *ret; -char *ucp; -{ - *ret = xdr_u_char(xdridptr[*xdrid], ucp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfulong) ARGS(`xdrid, ulp, ret') -int *xdrid, *ret; -unsigned long *ulp; -{ - *ret = xdr_u_long(xdridptr[*xdrid], ulp); - cnt += sizeof(unsigned long); -} - -void -FUNCTION(xdrfushort) ARGS(`xdrid, usp, ret') -int *xdrid, *ret; -unsigned short *usp; -{ - *ret = xdr_u_short(xdridptr[*xdrid], usp); - cnt += sizeof(unsigned short); -} - -void -FUNCTION(xdrf3dfcoord) ARGS(`xdrid, fp, size, precision, ret') -int *xdrid, *ret; -float *fp; -int *size; -float *precision; -{ - *ret = xdr3dfcoord(xdridptr[*xdrid], fp, size, precision); -} - -void -FUNCTION(xdrfstring) ARGS(`xdrid, STRING_ARG(sp), maxsize, ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -int *maxsize; -{ - char *tsp; - - tsp = (char*) malloc(((STRING_LEN(sp)) + 1) * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, *maxsize+1, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int) *maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += *maxsize; - free(tsp); -} - -void -FUNCTION(xdrfwrapstring) ARGS(`xdrid, STRING_ARG(sp), ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -{ - char *tsp; - int maxsize; - maxsize = (STRING_LEN(sp)) + 1; - tsp = (char*) malloc(maxsize * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, maxsize, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int)maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += maxsize; - free(tsp); -} - -void -FUNCTION(xdrfopaque) ARGS(`xdrid, cp, ccnt, ret') -int *xdrid, *ret; -caddr_t *cp; -int *ccnt; -{ - *ret = xdr_opaque(xdridptr[*xdrid], (caddr_t)*cp, (u_int)*ccnt); - cnt += *ccnt; -} - -void -FUNCTION(xdrfsetpos) ARGS(`xdrid, pos, ret') -int *xdrid, *ret; -int *pos; -{ - *ret = xdr_setpos(xdridptr[*xdrid], (u_int) *pos); -} - -void -FUNCTION(xdrf) ARGS(`xdrid, pos') -int *xdrid, *pos; -{ - *pos = xdr_getpos(xdridptr[*xdrid]); -} - -void -FUNCTION(xdrfvector) ARGS(`xdrid, cp, size, elproc, ret') -int *xdrid, *ret; -char *cp; -int *size; -FUNCTION(xdrfproc) elproc; -{ - int lcnt; - cnt = 0; - for (lcnt = 0; lcnt < *size; lcnt++) { - elproc(xdrid, (cp+cnt) , ret); - } -} - - -void -FUNCTION(xdrfclose) ARGS(`xdrid, ret') -int *xdrid; -int *ret; -{ - *ret = xdrclose(xdridptr[*xdrid]); - cnt = 0; -} - -void -FUNCTION(xdrfopen) ARGS(`xdrid, STRING_ARG(fp), STRING_ARG(mode), ret') -int *xdrid; -STRING_ARG_DECL(fp); -STRING_ARG_DECL(mode); -int *ret; -{ - char fname[512]; - char fmode[3]; - - if (ftocstr(fname, sizeof(fname), STRING_PTR(fp), STRING_LEN(fp))) { - *ret = 0; - } - if (ftocstr(fmode, sizeof(fmode), STRING_PTR(mode), - STRING_LEN(mode))) { - *ret = 0; - } - - *xdrid = xdropen(NULL, fname, fmode); - if (*xdrid == 0) - *ret = 0; - else - *ret = 1; -} - -/*___________________________________________________________________________ - | - | what follows are the C routines for opening, closing xdr streams - | and the routine to read/write compressed coordinates together - | with some routines to assist in this task (those are marked - | static and cannot be called from user programs) -*/ -#define MAXABS INT_MAX-2 - -#ifndef MIN -#define MIN(x,y) ((x) < (y) ? (x):(y)) -#endif -#ifndef MAX -#define MAX(x,y) ((x) > (y) ? (x):(y)) -#endif -#ifndef SQR -#define SQR(x) ((x)*(x)) -#endif -static int magicints[] = { - 0, 0, 0, 0, 0, 0, 0, 0, 0, - 8, 10, 12, 16, 20, 25, 32, 40, 50, 64, - 80, 101, 128, 161, 203, 256, 322, 406, 512, 645, - 812, 1024, 1290, 1625, 2048, 2580, 3250, 4096, 5060, 6501, - 8192, 10321, 13003, 16384, 20642, 26007, 32768, 41285, 52015, 65536, - 82570, 104031, 131072, 165140, 208063, 262144, 330280, 416127, 524287, 660561, - 832255, 1048576, 1321122, 1664510, 2097152, 2642245, 3329021, 4194304, 5284491, 6658042, - 8388607, 10568983, 13316085, 16777216 }; - -#define FIRSTIDX 9 -/* note that magicints[FIRSTIDX-1] == 0 */ -#define LASTIDX (sizeof(magicints) / sizeof(*magicints)) - - -/*__________________________________________________________________________ - | - | xdropen - open xdr file - | - | This versions differs from xdrstdio_create, because I need to know - | the state of the file (read or write) so I can use xdr3dfcoord - | in eigther read or write mode, and the file descriptor - | so I can close the file (something xdr_destroy doesn't do). - | -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type) { - static int init_done = 0; - enum xdr_op lmode; - const char *type1; - int xdrid; - - if (init_done == 0) { - for (xdrid = 1; xdrid < MAXID; xdrid++) { - xdridptr[xdrid] = NULL; - } - init_done = 1; - } - xdrid = 1; - while (xdrid < MAXID && xdridptr[xdrid] != NULL) { - xdrid++; - } - if (xdrid == MAXID) { - return 0; - } - if (*type == 'w' || *type == 'W') { - type = "w+"; - type1 = "a+"; - lmode = XDR_ENCODE; - } else { - type = "r"; - type1 = "r"; - lmode = XDR_DECODE; - } - xdrfiles[xdrid] = fopen(filename, type1); - if (xdrfiles[xdrid] == NULL) { - xdrs = NULL; - return 0; - } - xdrmodes[xdrid] = *type; - /* next test isn't usefull in the case of C language - * but is used for the Fortran interface - * (C users are expected to pass the address of an already allocated - * XDR staructure) - */ - if (xdrs == NULL) { - xdridptr[xdrid] = (XDR *) malloc(sizeof(XDR)); - xdrstdio_create(xdridptr[xdrid], xdrfiles[xdrid], lmode); - } else { - xdridptr[xdrid] = xdrs; - xdrstdio_create(xdrs, xdrfiles[xdrid], lmode); - } - return xdrid; -} - -/*_________________________________________________________________________ - | - | xdrclose - close a xdr file - | - | This will flush the xdr buffers, and destroy the xdr stream. - | It also closes the associated file descriptor (this is *not* - | done by xdr_destroy). - | -*/ - -int xdrclose(XDR *xdrs) { - int xdrid; - - if (xdrs == NULL) { - fprintf(stderr, "xdrclose: passed a NULL pointer\n"); - exit(1); - } - for (xdrid = 1; xdrid < MAXID; xdrid++) { - if (xdridptr[xdrid] == xdrs) { - - xdr_destroy(xdrs); - fclose(xdrfiles[xdrid]); - xdridptr[xdrid] = NULL; - return 1; - } - } - fprintf(stderr, "xdrclose: no such open xdr file\n"); - exit(1); - -} - -/*____________________________________________________________________________ - | - | sendbits - encode num into buf using the specified number of bits - | - | This routines appends the value of num to the bits already present in - | the array buf. You need to give it the number of bits to use and you - | better make sure that this number of bits is enough to hold the value - | Also num must be positive. - | -*/ - -static void sendbits(int buf[], int num_of_bits, int num) { - - unsigned int cnt, lastbyte; - int lastbits; - unsigned char * cbuf; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = (unsigned int) buf[0]; - lastbits = buf[1]; - lastbyte =(unsigned int) buf[2]; - while (num_of_bits >= 8) { - lastbyte = (lastbyte << 8) | ((num >> (num_of_bits -8)) /* & 0xff*/); - cbuf[cnt++] = lastbyte >> lastbits; - num_of_bits -= 8; - } - if (num_of_bits > 0) { - lastbyte = (lastbyte << num_of_bits) | num; - lastbits += num_of_bits; - if (lastbits >= 8) { - lastbits -= 8; - cbuf[cnt++] = lastbyte >> lastbits; - } - } - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - if (lastbits>0) { - cbuf[cnt] = lastbyte << (8 - lastbits); - } -} - -/*_________________________________________________________________________ - | - | sizeofint - calculate bitsize of an integer - | - | return the number of bits needed to store an integer with given max size - | -*/ - -static int sizeofint(const int size) { - unsigned int num = 1; - int num_of_bits = 0; - - while (size >= num && num_of_bits < 32) { - num_of_bits++; - num <<= 1; - } - return num_of_bits; -} - -/*___________________________________________________________________________ - | - | sizeofints - calculate 'bitsize' of compressed ints - | - | given the number of small unsigned integers and the maximum value - | return the number of bits needed to read or write them with the - | routines receiveints and sendints. You need this parameter when - | calling these routines. Note that for many calls I can use - | the variable 'smallidx' which is exactly the number of bits, and - | So I don't need to call 'sizeofints for those calls. -*/ - -static int sizeofints( const int num_of_ints, unsigned int sizes[]) { - int i, num; - unsigned int num_of_bytes, num_of_bits, bytes[32], bytecnt, tmp; - num_of_bytes = 1; - bytes[0] = 1; - num_of_bits = 0; - for (i=0; i < num_of_ints; i++) { - tmp = 0; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - num = 1; - num_of_bytes--; - while (bytes[num_of_bytes] >= num) { - num_of_bits++; - num *= 2; - } - return num_of_bits + num_of_bytes * 8; - -} - -/*____________________________________________________________________________ - | - | sendints - send a small set of small integers in compressed format - | - | this routine is used internally by xdr3dfcoord, to send a set of - | small integers to the buffer. - | Multiplication with fixed (specified maximum ) sizes is used to get - | to one big, multibyte integer. Allthough the routine could be - | modified to handle sizes bigger than 16777216, or more than just - | a few integers, this is not done, because the gain in compression - | isn't worth the effort. Note that overflowing the multiplication - | or the byte buffer (32 bytes) is unchecked and causes bad results. - | - */ - -static void sendints(int buf[], const int num_of_ints, const int num_of_bits, - unsigned int sizes[], unsigned int nums[]) { - - int i; - unsigned int bytes[32], num_of_bytes, bytecnt, tmp; - - tmp = nums[0]; - num_of_bytes = 0; - do { - bytes[num_of_bytes++] = tmp & 0xff; - tmp >>= 8; - } while (tmp != 0); - - for (i = 1; i < num_of_ints; i++) { - if (nums[i] >= sizes[i]) { - fprintf(stderr,"major breakdown in sendints num %d doesn't " - "match size %d\n", nums[i], sizes[i]); - exit(1); - } - /* use one step multiply */ - tmp = nums[i]; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - if (num_of_bits >= num_of_bytes * 8) { - for (i = 0; i < num_of_bytes; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits - num_of_bytes * 8, 0); - } else { - for (i = 0; i < num_of_bytes-1; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits- (num_of_bytes -1) * 8, bytes[i]); - } -} - - -/*___________________________________________________________________________ - | - | receivebits - decode number from buf using specified number of bits - | - | extract the number of bits from the array buf and construct an integer - | from it. Return that value. - | -*/ - -static int receivebits(int buf[], int num_of_bits) { - - int cnt, num; - unsigned int lastbits, lastbyte; - unsigned char * cbuf; - int mask = (1 << num_of_bits) -1; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = buf[0]; - lastbits = (unsigned int) buf[1]; - lastbyte = (unsigned int) buf[2]; - - num = 0; - while (num_of_bits >= 8) { - lastbyte = ( lastbyte << 8 ) | cbuf[cnt++]; - num |= (lastbyte >> lastbits) << (num_of_bits - 8); - num_of_bits -=8; - } - if (num_of_bits > 0) { - if (lastbits < num_of_bits) { - lastbits += 8; - lastbyte = (lastbyte << 8) | cbuf[cnt++]; - } - lastbits -= num_of_bits; - num |= (lastbyte >> lastbits) & ((1 << num_of_bits) -1); - } - num &= mask; - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - return num; -} - -/*____________________________________________________________________________ - | - | receiveints - decode 'small' integers from the buf array - | - | this routine is the inverse from sendints() and decodes the small integers - | written to buf by calculating the remainder and doing divisions with - | the given sizes[]. You need to specify the total number of bits to be - | used from buf in num_of_bits. - | -*/ - -static void receiveints(int buf[], const int num_of_ints, int num_of_bits, - unsigned int sizes[], int nums[]) { - int bytes[32]; - int i, j, num_of_bytes, p, num; - - bytes[1] = bytes[2] = bytes[3] = 0; - num_of_bytes = 0; - while (num_of_bits > 8) { - bytes[num_of_bytes++] = receivebits(buf, 8); - num_of_bits -= 8; - } - if (num_of_bits > 0) { - bytes[num_of_bytes++] = receivebits(buf, num_of_bits); - } - for (i = num_of_ints-1; i > 0; i--) { - num = 0; - for (j = num_of_bytes-1; j >=0; j--) { - num = (num << 8) | bytes[j]; - p = num / sizes[i]; - bytes[j] = p; - num = num - p * sizes[i]; - } - nums[i] = num; - } - nums[0] = bytes[0] | (bytes[1] << 8) | (bytes[2] << 16) | (bytes[3] << 24); -} - -/*____________________________________________________________________________ - | - | xdr3dfcoord - read or write compressed 3d coordinates to xdr file. - | - | this routine reads or writes (depending on how you opened the file with - | xdropen() ) a large number of 3d coordinates (stored in *fp). - | The number of coordinates triplets to write is given by *size. On - | read this number may be zero, in which case it reads as many as were written - | or it may specify the number if triplets to read (which should match the - | number written). - | Compression is achieved by first converting all floating numbers to integer - | using multiplication by *precision and rounding to the nearest integer. - | Then the minimum and maximum value are calculated to determine the range. - | The limited range of integers so found, is used to compress the coordinates. - | In addition the differences between succesive coordinates is calculated. - | If the difference happens to be 'small' then only the difference is saved, - | compressing the data even more. The notion of 'small' is changed dynamically - | and is enlarged or reduced whenever needed or possible. - | Extra compression is achieved in the case of GROMOS and coordinates of - | water molecules. GROMOS first writes out the Oxygen position, followed by - | the two hydrogens. In order to make the differences smaller (and thereby - | compression the data better) the order is changed into first one hydrogen - | then the oxygen, followed by the other hydrogen. This is rather special, but - | it shouldn't harm in the general case. - | - */ - -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) { - - - static int *ip = NULL; - static int oldsize; - static int *buf; - - int minint[3], maxint[3], mindiff, *lip, diff; - int lint1, lint2, lint3, oldlint1, oldlint2, oldlint3, smallidx; - int minidx, maxidx; - unsigned sizeint[3], sizesmall[3], bitsizeint[3], size3, *luip; - int flag, k; - int small, smaller, larger, i, is_small, is_smaller, run, prevrun; - float *lfp, lf; - int tmp, *thiscoord, prevcoord[3]; - unsigned int tmpcoord[30]; - - int bufsize, xdrid, lsize; - unsigned int bitsize; - float inv_precision; - int errval = 1; - - /* find out if xdrs is opened for reading or for writing */ - xdrid = 0; - while (xdridptr[xdrid] != xdrs) { - xdrid++; - if (xdrid >= MAXID) { - fprintf(stderr, "xdr error. no open xdr stream\n"); - exit (1); - } - } - if (xdrmodes[xdrid] == 'w') { - - /* xdrs is open for writing */ - - if (xdr_int(xdrs, size) == 0) - return 0; - size3 = *size * 3; - /* when the number of coordinates is small, don't try to compress; just - * write them as floats using xdr_vector - */ - if (*size <= 9 ) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - /* buf[0-2] are special and do not contain actual data */ - buf[0] = buf[1] = buf[2] = 0; - minint[0] = minint[1] = minint[2] = INT_MAX; - maxint[0] = maxint[1] = maxint[2] = INT_MIN; - prevrun = -1; - lfp = fp; - lip = ip; - mindiff = INT_MAX; - oldlint1 = oldlint2 = oldlint3 = 0; - while(lfp < fp + size3 ) { - /* find nearest integer */ - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint1 = lf; - if (lint1 < minint[0]) minint[0] = lint1; - if (lint1 > maxint[0]) maxint[0] = lint1; - *lip++ = lint1; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint2 = lf; - if (lint2 < minint[1]) minint[1] = lint2; - if (lint2 > maxint[1]) maxint[1] = lint2; - *lip++ = lint2; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint3 = lf; - if (lint3 < minint[2]) minint[2] = lint3; - if (lint3 > maxint[2]) maxint[2] = lint3; - *lip++ = lint3; - lfp++; - diff = abs(oldlint1-lint1)+abs(oldlint2-lint2)+abs(oldlint3-lint3); - if (diff < mindiff && lfp > fp + 3) - mindiff = diff; - oldlint1 = lint1; - oldlint2 = lint2; - oldlint3 = lint3; - } - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - if ((float)maxint[0] - (float)minint[0] >= MAXABS || - (float)maxint[1] - (float)minint[1] >= MAXABS || - (float)maxint[2] - (float)minint[2] >= MAXABS) { - /* turning value in unsigned by subtracting minint - * would cause overflow - */ - errval = 0; - } - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - lip = ip; - luip = (unsigned int *) ip; - smallidx = FIRSTIDX; - while (smallidx < LASTIDX && magicints[smallidx] < mindiff) { - smallidx++; - } - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - larger = magicints[maxidx] / 2; - i = 0; - while (i < *size) { - is_small = 0; - thiscoord = (int *)(luip) + i * 3; - if (smallidx < maxidx && i >= 1 && - abs(thiscoord[0] - prevcoord[0]) < larger && - abs(thiscoord[1] - prevcoord[1]) < larger && - abs(thiscoord[2] - prevcoord[2]) < larger) { - is_smaller = 1; - } else if (smallidx > minidx) { - is_smaller = -1; - } else { - is_smaller = 0; - } - if (i + 1 < *size) { - if (abs(thiscoord[0] - thiscoord[3]) < small && - abs(thiscoord[1] - thiscoord[4]) < small && - abs(thiscoord[2] - thiscoord[5]) < small) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = thiscoord[3]; - thiscoord[3] = tmp; - tmp = thiscoord[1]; thiscoord[1] = thiscoord[4]; - thiscoord[4] = tmp; - tmp = thiscoord[2]; thiscoord[2] = thiscoord[5]; - thiscoord[5] = tmp; - is_small = 1; - } - - } - tmpcoord[0] = thiscoord[0] - minint[0]; - tmpcoord[1] = thiscoord[1] - minint[1]; - tmpcoord[2] = thiscoord[2] - minint[2]; - if (bitsize == 0) { - sendbits(buf, bitsizeint[0], tmpcoord[0]); - sendbits(buf, bitsizeint[1], tmpcoord[1]); - sendbits(buf, bitsizeint[2], tmpcoord[2]); - } else { - sendints(buf, 3, bitsize, sizeint, tmpcoord); - } - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - thiscoord = thiscoord + 3; - i++; - - run = 0; - if (is_small == 0 && is_smaller == -1) - is_smaller = 0; - while (is_small && run < 8*3) { - if (is_smaller == -1 && ( - SQR(thiscoord[0] - prevcoord[0]) + - SQR(thiscoord[1] - prevcoord[1]) + - SQR(thiscoord[2] - prevcoord[2]) >= smaller * smaller)) { - is_smaller = 0; - } - - tmpcoord[run++] = thiscoord[0] - prevcoord[0] + small; - tmpcoord[run++] = thiscoord[1] - prevcoord[1] + small; - tmpcoord[run++] = thiscoord[2] - prevcoord[2] + small; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - i++; - thiscoord = thiscoord + 3; - is_small = 0; - if (i < *size && - abs(thiscoord[0] - prevcoord[0]) < small && - abs(thiscoord[1] - prevcoord[1]) < small && - abs(thiscoord[2] - prevcoord[2]) < small) { - is_small = 1; - } - } - if (run != prevrun || is_smaller != 0) { - prevrun = run; - sendbits(buf, 1, 1); /* flag the change in run-length */ - sendbits(buf, 5, run+is_smaller+1); - } else { - sendbits(buf, 1, 0); /* flag the fact that runlength did not change */ - } - for (k=0; k < run; k+=3) { - sendints(buf, 3, smallidx, sizesmall, &tmpcoord[k]); - } - if (is_smaller != 0) { - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - smaller = magicints[smallidx-1] / 2; - } else { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - } - } - if (buf[1] != 0) buf[0]++;; - xdr_int(xdrs, &(buf[0])); /* buf[0] holds the length in bytes */ - return errval * (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0])); - } else { - - /* xdrs is open for reading */ - - if (xdr_int(xdrs, &lsize) == 0) - return 0; - if (*size != 0 && lsize != *size) { - fprintf(stderr, "wrong number of coordinates in xdr3dfcoor; " - "%d arg vs %d in file", *size, lsize); - } - *size = lsize; - size3 = *size * 3; - if (*size <= 9) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - buf[0] = buf[1] = buf[2] = 0; - - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - larger = magicints[maxidx]; - - /* buf[0] holds the length in bytes */ - - if (xdr_int(xdrs, &(buf[0])) == 0) - return 0; - if (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0]) == 0) - return 0; - buf[0] = buf[1] = buf[2] = 0; - - lfp = fp; - inv_precision = 1.0 / * precision; - run = 0; - i = 0; - lip = ip; - while ( i < lsize ) { - thiscoord = (int *)(lip) + i * 3; - - if (bitsize == 0) { - thiscoord[0] = receivebits(buf, bitsizeint[0]); - thiscoord[1] = receivebits(buf, bitsizeint[1]); - thiscoord[2] = receivebits(buf, bitsizeint[2]); - } else { - receiveints(buf, 3, bitsize, sizeint, thiscoord); - } - - i++; - thiscoord[0] += minint[0]; - thiscoord[1] += minint[1]; - thiscoord[2] += minint[2]; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - - flag = receivebits(buf, 1); - is_smaller = 0; - if (flag == 1) { - run = receivebits(buf, 5); - is_smaller = run % 3; - run -= is_smaller; - is_smaller--; - } - if (run > 0) { - thiscoord += 3; - for (k = 0; k < run; k+=3) { - receiveints(buf, 3, smallidx, sizesmall, thiscoord); - i++; - thiscoord[0] += prevcoord[0] - small; - thiscoord[1] += prevcoord[1] - small; - thiscoord[2] += prevcoord[2] - small; - if (k == 0) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = prevcoord[0]; - prevcoord[0] = tmp; - tmp = thiscoord[1]; thiscoord[1] = prevcoord[1]; - prevcoord[1] = tmp; - tmp = thiscoord[2]; thiscoord[2] = prevcoord[2]; - prevcoord[2] = tmp; - *lfp++ = prevcoord[0] * inv_precision; - *lfp++ = prevcoord[1] * inv_precision; - *lfp++ = prevcoord[2] * inv_precision; - } else { - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - } - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - } else { - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - if (smallidx > FIRSTIDX) { - smaller = magicints[smallidx - 1] /2; - } else { - smaller = 0; - } - } else if (is_smaller > 0) { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - } - } - return 1; -} - - - diff --git a/source/wham/src-M/xdrf/libxdrf.m4.org b/source/wham/src-M/xdrf/libxdrf.m4.org deleted file mode 100644 index b14b374..0000000 --- a/source/wham/src-M/xdrf/libxdrf.m4.org +++ /dev/null @@ -1,1230 +0,0 @@ -/*____________________________________________________________________________ - | - | libxdrf - portable fortran interface to xdr. some xdr routines - | are C routines for compressed coordinates - | - | version 1.1 - | - | This collection of routines is intended to write and read - | data in a portable way to a file, so data written on one type - | of machine can be read back on a different type. - | - | all fortran routines use an integer 'xdrid', which is an id to the - | current xdr file, and is set by xdrfopen. - | most routines have in integer 'ret' which is the return value. - | The value of 'ret' is zero on failure, and most of the time one - | on succes. - | - | There are three routines useful for C users: - | xdropen(), xdrclose(), xdr3dfcoord(). - | The first two replace xdrstdio_create and xdr_destroy, and *must* be - | used when you plan to use xdr3dfcoord(). (they are also a bit - | easier to interface). For writing data other than compressed coordinates - | you should use the standard C xdr routines (see xdr man page) - | - | xdrfopen(xdrid, filename, mode, ret) - | character *(*) filename - | character *(*) mode - | - | this will open the file with the given filename (string) - | and the given mode, it returns an id in xdrid, which is - | to be used in all other calls to xdrf routines. - | mode is 'w' to create, or update an file, for all other - | values of mode the file is opened for reading - | - | you need to call xdrfclose to flush the output and close - | the file. - | Note that you should not use xdrstdio_create, which comes with the - | standard xdr library - | - | xdrfclose(xdrid, ret) - | flush the data to the file, and closes the file; - | You should not use xdr_destroy (which comes standard with - | the xdr libraries. - | - | xdrfbool(xdrid, bp, ret) - | integer pb - | - | This filter produces values of either 1 or 0 - | - | xdrfchar(xdrid, cp, ret) - | character cp - | - | filter that translate between characters and their xdr representation - | Note that the characters in not compressed and occupies 4 bytes. - | - | xdrfdouble(xdrid, dp, ret) - | double dp - | - | read/write a double. - | - | xdrffloat(xdrid, fp, ret) - | float fp - | - | read/write a float. - | - | xdrfint(xdrid, ip, ret) - | integer ip - | - | read/write integer. - | - | xdrflong(xdrid, lp, ret) - | integer lp - | - | this routine has a possible portablility problem due to 64 bits longs. - | - | xdrfshort(xdrid, sp, ret) - | integer *2 sp - | - | xdrfstring(xdrid, sp, maxsize, ret) - | character *(*) - | integer maxsize - | - | read/write a string, with maximum length given by maxsize - | - | xdrfwrapstring(xdris, sp, ret) - | character *(*) - | - | read/write a string (it is the same as xdrfstring accept that it finds - | the stringlength itself. - | - | xdrfvector(xdrid, cp, size, xdrfproc, ret) - | character *(*) - | integer size - | external xdrfproc - | - | read/write an array pointed to by cp, with number of elements - | defined by 'size'. the routine 'xdrfproc' is the name - | of one of the above routines to read/write data (like xdrfdouble) - | In contrast with the c-version you don't need to specify the - | byte size of an element. - | xdrfstring is not allowed here (it is in the c version) - | - | xdrf3dfcoord(xdrid, fp, size, precision, ret) - | real (*) fp - | real precision - | integer size - | - | this is *NOT* a standard xdr routine. I named it this way, because - | it invites people to use the other xdr routines. - | It is introduced to store specifically 3d coordinates of molecules - | (as found in molecular dynamics) and it writes it in a compressed way. - | It starts by multiplying all numbers by precision and - | rounding the result to integer. effectively converting - | all floating point numbers to fixed point. - | it uses an algorithm for compression that is optimized for - | molecular data, but could be used for other 3d coordinates - | as well. There is subtantial overhead involved, so call this - | routine only if you have a large number of coordinates to read/write - | - | ________________________________________________________________________ - | - | Below are the routines to be used by C programmers. Use the 'normal' - | xdr routines to write integers, floats, etc (see man xdr) - | - | int xdropen(XDR *xdrs, const char *filename, const char *type) - | This will open the file with the given filename and the - | given mode. You should pass it an allocated XDR struct - | in xdrs, to be used in all other calls to xdr routines. - | Mode is 'w' to create, or update an file, and for all - | other values of mode the file is opened for reading. - | You need to call xdrclose to flush the output and close - | the file. - | - | Note that you should not use xdrstdio_create, which - | comes with the standard xdr library. - | - | int xdrclose(XDR *xdrs) - | Flush the data to the file, and close the file; - | You should not use xdr_destroy (which comes standard - | with the xdr libraries). - | - | int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) - | This is \fInot\fR a standard xdr routine. I named it this - | way, because it invites people to use the other xdr - | routines. - | - | (c) 1995 Frans van Hoesel, hoesel@chem.rug.nl -*/ - - -#include -#include -#include -#include -#include -#include -#include -#include "xdrf.h" - -int ftocstr(char *, int, char *, int); -int ctofstr(char *, int, char *); - -#define MAXID 20 -static FILE *xdrfiles[MAXID]; -static XDR *xdridptr[MAXID]; -static char xdrmodes[MAXID]; -static unsigned int cnt; - -typedef void (* FUNCTION(xdrfproc)) (int *, void *, int *); - -void -FUNCTION(xdrfbool) ARGS(`xdrid, pb, ret') -int *xdrid, *ret; -int *pb; -{ - *ret = xdr_bool(xdridptr[*xdrid], (bool_t *) pb); - cnt += sizeof(int); -} - -void -FUNCTION(xdrfchar) ARGS(`xdrid, cp, ret') -int *xdrid, *ret; -char *cp; -{ - *ret = xdr_char(xdridptr[*xdrid], cp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfdouble) ARGS(`xdrid, dp, ret') -int *xdrid, *ret; -double *dp; -{ - *ret = xdr_double(xdridptr[*xdrid], dp); - cnt += sizeof(double); -} - -void -FUNCTION(xdrffloat) ARGS(`xdrid, fp, ret') -int *xdrid, *ret; -float *fp; -{ - *ret = xdr_float(xdridptr[*xdrid], fp); - cnt += sizeof(float); -} - -void -FUNCTION(xdrfint) ARGS(`xdrid, ip, ret') -int *xdrid, *ret; -int *ip; -{ - *ret = xdr_int(xdridptr[*xdrid], ip); - cnt += sizeof(int); -} - -void -FUNCTION(xdrflong) ARGS(`xdrid, lp, ret') -int *xdrid, *ret; -long *lp; -{ - *ret = xdr_long(xdridptr[*xdrid], lp); - cnt += sizeof(long); -} - -void -FUNCTION(xdrfshort) ARGS(`xdrid, sp, ret') -int *xdrid, *ret; -short *sp; -{ - *ret = xdr_short(xdridptr[*xdrid], sp); - cnt += sizeof(sp); -} - -void -FUNCTION(xdrfuchar) ARGS(`xdrid, ucp, ret') -int *xdrid, *ret; -char *ucp; -{ - *ret = xdr_u_char(xdridptr[*xdrid], ucp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfulong) ARGS(`xdrid, ulp, ret') -int *xdrid, *ret; -unsigned long *ulp; -{ - *ret = xdr_u_long(xdridptr[*xdrid], ulp); - cnt += sizeof(unsigned long); -} - -void -FUNCTION(xdrfushort) ARGS(`xdrid, usp, ret') -int *xdrid, *ret; -unsigned short *usp; -{ - *ret = xdr_u_short(xdridptr[*xdrid], usp); - cnt += sizeof(unsigned short); -} - -void -FUNCTION(xdrf3dfcoord) ARGS(`xdrid, fp, size, precision, ret') -int *xdrid, *ret; -float *fp; -int *size; -float *precision; -{ - *ret = xdr3dfcoord(xdridptr[*xdrid], fp, size, precision); -} - -void -FUNCTION(xdrfstring) ARGS(`xdrid, STRING_ARG(sp), maxsize, ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -int *maxsize; -{ - char *tsp; - - tsp = (char*) malloc(((STRING_LEN(sp)) + 1) * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, *maxsize+1, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int) *maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += *maxsize; - free(tsp); -} - -void -FUNCTION(xdrfwrapstring) ARGS(`xdrid, STRING_ARG(sp), ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -{ - char *tsp; - int maxsize; - maxsize = (STRING_LEN(sp)) + 1; - tsp = (char*) malloc(maxsize * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, maxsize, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int)maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += maxsize; - free(tsp); -} - -void -FUNCTION(xdrfopaque) ARGS(`xdrid, cp, ccnt, ret') -int *xdrid, *ret; -caddr_t *cp; -int *ccnt; -{ - *ret = xdr_opaque(xdridptr[*xdrid], (caddr_t)*cp, (u_int)*ccnt); - cnt += *ccnt; -} - -void -FUNCTION(xdrfsetpos) ARGS(`xdrid, pos, ret') -int *xdrid, *ret; -int *pos; -{ - *ret = xdr_setpos(xdridptr[*xdrid], (u_int) *pos); -} - -void -FUNCTION(xdrf) ARGS(`xdrid, pos') -int *xdrid, *pos; -{ - *pos = xdr_getpos(xdridptr[*xdrid]); -} - -void -FUNCTION(xdrfvector) ARGS(`xdrid, cp, size, elproc, ret') -int *xdrid, *ret; -char *cp; -int *size; -FUNCTION(xdrfproc) elproc; -{ - int lcnt; - cnt = 0; - for (lcnt = 0; lcnt < *size; lcnt++) { - elproc(xdrid, (cp+cnt) , ret); - } -} - - -void -FUNCTION(xdrfclose) ARGS(`xdrid, ret') -int *xdrid; -int *ret; -{ - *ret = xdrclose(xdridptr[*xdrid]); - cnt = 0; -} - -void -FUNCTION(xdrfopen) ARGS(`xdrid, STRING_ARG(fp), STRING_ARG(mode), ret') -int *xdrid; -STRING_ARG_DECL(fp); -STRING_ARG_DECL(mode); -int *ret; -{ - char fname[512]; - char fmode[3]; - - if (ftocstr(fname, sizeof(fname), STRING_PTR(fp), STRING_LEN(fp))) { - *ret = 0; - } - if (ftocstr(fmode, sizeof(fmode), STRING_PTR(mode), - STRING_LEN(mode))) { - *ret = 0; - } - - *xdrid = xdropen(NULL, fname, fmode); - if (*xdrid == 0) - *ret = 0; - else - *ret = 1; -} - -/*___________________________________________________________________________ - | - | what follows are the C routines for opening, closing xdr streams - | and the routine to read/write compressed coordinates together - | with some routines to assist in this task (those are marked - | static and cannot be called from user programs) -*/ -#define MAXABS INT_MAX-2 - -#ifndef MIN -#define MIN(x,y) ((x) < (y) ? (x):(y)) -#endif -#ifndef MAX -#define MAX(x,y) ((x) > (y) ? (x):(y)) -#endif -#ifndef SQR -#define SQR(x) ((x)*(x)) -#endif -static int magicints[] = { - 0, 0, 0, 0, 0, 0, 0, 0, 0, - 8, 10, 12, 16, 20, 25, 32, 40, 50, 64, - 80, 101, 128, 161, 203, 256, 322, 406, 512, 645, - 812, 1024, 1290, 1625, 2048, 2580, 3250, 4096, 5060, 6501, - 8192, 10321, 13003, 16384, 20642, 26007, 32768, 41285, 52015, 65536, - 82570, 104031, 131072, 165140, 208063, 262144, 330280, 416127, 524287, 660561, - 832255, 1048576, 1321122, 1664510, 2097152, 2642245, 3329021, 4194304, 5284491, 6658042, - 8388607, 10568983, 13316085, 16777216 }; - -#define FIRSTIDX 9 -/* note that magicints[FIRSTIDX-1] == 0 */ -#define LASTIDX (sizeof(magicints) / sizeof(*magicints)) - - -/*__________________________________________________________________________ - | - | xdropen - open xdr file - | - | This versions differs from xdrstdio_create, because I need to know - | the state of the file (read or write) so I can use xdr3dfcoord - | in eigther read or write mode, and the file descriptor - | so I can close the file (something xdr_destroy doesn't do). - | -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type) { - static int init_done = 0; - enum xdr_op lmode; - int xdrid; - - if (init_done == 0) { - for (xdrid = 1; xdrid < MAXID; xdrid++) { - xdridptr[xdrid] = NULL; - } - init_done = 1; - } - xdrid = 1; - while (xdrid < MAXID && xdridptr[xdrid] != NULL) { - xdrid++; - } - if (xdrid == MAXID) { - return 0; - } - if (*type == 'w' || *type == 'W') { - type = "w+"; - lmode = XDR_ENCODE; - } else { - type = "r"; - lmode = XDR_DECODE; - } - xdrfiles[xdrid] = fopen(filename, type); - if (xdrfiles[xdrid] == NULL) { - xdrs = NULL; - return 0; - } - xdrmodes[xdrid] = *type; - /* next test isn't usefull in the case of C language - * but is used for the Fortran interface - * (C users are expected to pass the address of an already allocated - * XDR staructure) - */ - if (xdrs == NULL) { - xdridptr[xdrid] = (XDR *) malloc(sizeof(XDR)); - xdrstdio_create(xdridptr[xdrid], xdrfiles[xdrid], lmode); - } else { - xdridptr[xdrid] = xdrs; - xdrstdio_create(xdrs, xdrfiles[xdrid], lmode); - } - return xdrid; -} - -/*_________________________________________________________________________ - | - | xdrclose - close a xdr file - | - | This will flush the xdr buffers, and destroy the xdr stream. - | It also closes the associated file descriptor (this is *not* - | done by xdr_destroy). - | -*/ - -int xdrclose(XDR *xdrs) { - int xdrid; - - if (xdrs == NULL) { - fprintf(stderr, "xdrclose: passed a NULL pointer\n"); - exit(1); - } - for (xdrid = 1; xdrid < MAXID; xdrid++) { - if (xdridptr[xdrid] == xdrs) { - - xdr_destroy(xdrs); - fclose(xdrfiles[xdrid]); - xdridptr[xdrid] = NULL; - return 1; - } - } - fprintf(stderr, "xdrclose: no such open xdr file\n"); - exit(1); - -} - -/*____________________________________________________________________________ - | - | sendbits - encode num into buf using the specified number of bits - | - | This routines appends the value of num to the bits already present in - | the array buf. You need to give it the number of bits to use and you - | better make sure that this number of bits is enough to hold the value - | Also num must be positive. - | -*/ - -static void sendbits(int buf[], int num_of_bits, int num) { - - unsigned int cnt, lastbyte; - int lastbits; - unsigned char * cbuf; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = (unsigned int) buf[0]; - lastbits = buf[1]; - lastbyte =(unsigned int) buf[2]; - while (num_of_bits >= 8) { - lastbyte = (lastbyte << 8) | ((num >> (num_of_bits -8)) /* & 0xff*/); - cbuf[cnt++] = lastbyte >> lastbits; - num_of_bits -= 8; - } - if (num_of_bits > 0) { - lastbyte = (lastbyte << num_of_bits) | num; - lastbits += num_of_bits; - if (lastbits >= 8) { - lastbits -= 8; - cbuf[cnt++] = lastbyte >> lastbits; - } - } - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - if (lastbits>0) { - cbuf[cnt] = lastbyte << (8 - lastbits); - } -} - -/*_________________________________________________________________________ - | - | sizeofint - calculate bitsize of an integer - | - | return the number of bits needed to store an integer with given max size - | -*/ - -static int sizeofint(const int size) { - unsigned int num = 1; - int num_of_bits = 0; - - while (size >= num && num_of_bits < 32) { - num_of_bits++; - num <<= 1; - } - return num_of_bits; -} - -/*___________________________________________________________________________ - | - | sizeofints - calculate 'bitsize' of compressed ints - | - | given the number of small unsigned integers and the maximum value - | return the number of bits needed to read or write them with the - | routines receiveints and sendints. You need this parameter when - | calling these routines. Note that for many calls I can use - | the variable 'smallidx' which is exactly the number of bits, and - | So I don't need to call 'sizeofints for those calls. -*/ - -static int sizeofints( const int num_of_ints, unsigned int sizes[]) { - int i, num; - unsigned int num_of_bytes, num_of_bits, bytes[32], bytecnt, tmp; - num_of_bytes = 1; - bytes[0] = 1; - num_of_bits = 0; - for (i=0; i < num_of_ints; i++) { - tmp = 0; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - num = 1; - num_of_bytes--; - while (bytes[num_of_bytes] >= num) { - num_of_bits++; - num *= 2; - } - return num_of_bits + num_of_bytes * 8; - -} - -/*____________________________________________________________________________ - | - | sendints - send a small set of small integers in compressed format - | - | this routine is used internally by xdr3dfcoord, to send a set of - | small integers to the buffer. - | Multiplication with fixed (specified maximum ) sizes is used to get - | to one big, multibyte integer. Allthough the routine could be - | modified to handle sizes bigger than 16777216, or more than just - | a few integers, this is not done, because the gain in compression - | isn't worth the effort. Note that overflowing the multiplication - | or the byte buffer (32 bytes) is unchecked and causes bad results. - | - */ - -static void sendints(int buf[], const int num_of_ints, const int num_of_bits, - unsigned int sizes[], unsigned int nums[]) { - - int i; - unsigned int bytes[32], num_of_bytes, bytecnt, tmp; - - tmp = nums[0]; - num_of_bytes = 0; - do { - bytes[num_of_bytes++] = tmp & 0xff; - tmp >>= 8; - } while (tmp != 0); - - for (i = 1; i < num_of_ints; i++) { - if (nums[i] >= sizes[i]) { - fprintf(stderr,"major breakdown in sendints num %d doesn't " - "match size %d\n", nums[i], sizes[i]); - exit(1); - } - /* use one step multiply */ - tmp = nums[i]; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - if (num_of_bits >= num_of_bytes * 8) { - for (i = 0; i < num_of_bytes; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits - num_of_bytes * 8, 0); - } else { - for (i = 0; i < num_of_bytes-1; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits- (num_of_bytes -1) * 8, bytes[i]); - } -} - - -/*___________________________________________________________________________ - | - | receivebits - decode number from buf using specified number of bits - | - | extract the number of bits from the array buf and construct an integer - | from it. Return that value. - | -*/ - -static int receivebits(int buf[], int num_of_bits) { - - int cnt, num; - unsigned int lastbits, lastbyte; - unsigned char * cbuf; - int mask = (1 << num_of_bits) -1; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = buf[0]; - lastbits = (unsigned int) buf[1]; - lastbyte = (unsigned int) buf[2]; - - num = 0; - while (num_of_bits >= 8) { - lastbyte = ( lastbyte << 8 ) | cbuf[cnt++]; - num |= (lastbyte >> lastbits) << (num_of_bits - 8); - num_of_bits -=8; - } - if (num_of_bits > 0) { - if (lastbits < num_of_bits) { - lastbits += 8; - lastbyte = (lastbyte << 8) | cbuf[cnt++]; - } - lastbits -= num_of_bits; - num |= (lastbyte >> lastbits) & ((1 << num_of_bits) -1); - } - num &= mask; - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - return num; -} - -/*____________________________________________________________________________ - | - | receiveints - decode 'small' integers from the buf array - | - | this routine is the inverse from sendints() and decodes the small integers - | written to buf by calculating the remainder and doing divisions with - | the given sizes[]. You need to specify the total number of bits to be - | used from buf in num_of_bits. - | -*/ - -static void receiveints(int buf[], const int num_of_ints, int num_of_bits, - unsigned int sizes[], int nums[]) { - int bytes[32]; - int i, j, num_of_bytes, p, num; - - bytes[1] = bytes[2] = bytes[3] = 0; - num_of_bytes = 0; - while (num_of_bits > 8) { - bytes[num_of_bytes++] = receivebits(buf, 8); - num_of_bits -= 8; - } - if (num_of_bits > 0) { - bytes[num_of_bytes++] = receivebits(buf, num_of_bits); - } - for (i = num_of_ints-1; i > 0; i--) { - num = 0; - for (j = num_of_bytes-1; j >=0; j--) { - num = (num << 8) | bytes[j]; - p = num / sizes[i]; - bytes[j] = p; - num = num - p * sizes[i]; - } - nums[i] = num; - } - nums[0] = bytes[0] | (bytes[1] << 8) | (bytes[2] << 16) | (bytes[3] << 24); -} - -/*____________________________________________________________________________ - | - | xdr3dfcoord - read or write compressed 3d coordinates to xdr file. - | - | this routine reads or writes (depending on how you opened the file with - | xdropen() ) a large number of 3d coordinates (stored in *fp). - | The number of coordinates triplets to write is given by *size. On - | read this number may be zero, in which case it reads as many as were written - | or it may specify the number if triplets to read (which should match the - | number written). - | Compression is achieved by first converting all floating numbers to integer - | using multiplication by *precision and rounding to the nearest integer. - | Then the minimum and maximum value are calculated to determine the range. - | The limited range of integers so found, is used to compress the coordinates. - | In addition the differences between succesive coordinates is calculated. - | If the difference happens to be 'small' then only the difference is saved, - | compressing the data even more. The notion of 'small' is changed dynamically - | and is enlarged or reduced whenever needed or possible. - | Extra compression is achieved in the case of GROMOS and coordinates of - | water molecules. GROMOS first writes out the Oxygen position, followed by - | the two hydrogens. In order to make the differences smaller (and thereby - | compression the data better) the order is changed into first one hydrogen - | then the oxygen, followed by the other hydrogen. This is rather special, but - | it shouldn't harm in the general case. - | - */ - -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) { - - - static int *ip = NULL; - static int oldsize; - static int *buf; - - int minint[3], maxint[3], mindiff, *lip, diff; - int lint1, lint2, lint3, oldlint1, oldlint2, oldlint3, smallidx; - int minidx, maxidx; - unsigned sizeint[3], sizesmall[3], bitsizeint[3], size3, *luip; - int flag, k; - int small, smaller, larger, i, is_small, is_smaller, run, prevrun; - float *lfp, lf; - int tmp, *thiscoord, prevcoord[3]; - unsigned int tmpcoord[30]; - - int bufsize, xdrid, lsize; - unsigned int bitsize; - float inv_precision; - int errval = 1; - - /* find out if xdrs is opened for reading or for writing */ - xdrid = 0; - while (xdridptr[xdrid] != xdrs) { - xdrid++; - if (xdrid >= MAXID) { - fprintf(stderr, "xdr error. no open xdr stream\n"); - exit (1); - } - } - if (xdrmodes[xdrid] == 'w') { - - /* xdrs is open for writing */ - - if (xdr_int(xdrs, size) == 0) - return 0; - size3 = *size * 3; - /* when the number of coordinates is small, don't try to compress; just - * write them as floats using xdr_vector - */ - if (*size <= 9 ) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - /* buf[0-2] are special and do not contain actual data */ - buf[0] = buf[1] = buf[2] = 0; - minint[0] = minint[1] = minint[2] = INT_MAX; - maxint[0] = maxint[1] = maxint[2] = INT_MIN; - prevrun = -1; - lfp = fp; - lip = ip; - mindiff = INT_MAX; - oldlint1 = oldlint2 = oldlint3 = 0; - while(lfp < fp + size3 ) { - /* find nearest integer */ - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint1 = lf; - if (lint1 < minint[0]) minint[0] = lint1; - if (lint1 > maxint[0]) maxint[0] = lint1; - *lip++ = lint1; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint2 = lf; - if (lint2 < minint[1]) minint[1] = lint2; - if (lint2 > maxint[1]) maxint[1] = lint2; - *lip++ = lint2; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint3 = lf; - if (lint3 < minint[2]) minint[2] = lint3; - if (lint3 > maxint[2]) maxint[2] = lint3; - *lip++ = lint3; - lfp++; - diff = abs(oldlint1-lint1)+abs(oldlint2-lint2)+abs(oldlint3-lint3); - if (diff < mindiff && lfp > fp + 3) - mindiff = diff; - oldlint1 = lint1; - oldlint2 = lint2; - oldlint3 = lint3; - } - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - if ((float)maxint[0] - (float)minint[0] >= MAXABS || - (float)maxint[1] - (float)minint[1] >= MAXABS || - (float)maxint[2] - (float)minint[2] >= MAXABS) { - /* turning value in unsigned by subtracting minint - * would cause overflow - */ - errval = 0; - } - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - lip = ip; - luip = (unsigned int *) ip; - smallidx = FIRSTIDX; - while (smallidx < LASTIDX && magicints[smallidx] < mindiff) { - smallidx++; - } - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - larger = magicints[maxidx] / 2; - i = 0; - while (i < *size) { - is_small = 0; - thiscoord = (int *)(luip) + i * 3; - if (smallidx < maxidx && i >= 1 && - abs(thiscoord[0] - prevcoord[0]) < larger && - abs(thiscoord[1] - prevcoord[1]) < larger && - abs(thiscoord[2] - prevcoord[2]) < larger) { - is_smaller = 1; - } else if (smallidx > minidx) { - is_smaller = -1; - } else { - is_smaller = 0; - } - if (i + 1 < *size) { - if (abs(thiscoord[0] - thiscoord[3]) < small && - abs(thiscoord[1] - thiscoord[4]) < small && - abs(thiscoord[2] - thiscoord[5]) < small) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = thiscoord[3]; - thiscoord[3] = tmp; - tmp = thiscoord[1]; thiscoord[1] = thiscoord[4]; - thiscoord[4] = tmp; - tmp = thiscoord[2]; thiscoord[2] = thiscoord[5]; - thiscoord[5] = tmp; - is_small = 1; - } - - } - tmpcoord[0] = thiscoord[0] - minint[0]; - tmpcoord[1] = thiscoord[1] - minint[1]; - tmpcoord[2] = thiscoord[2] - minint[2]; - if (bitsize == 0) { - sendbits(buf, bitsizeint[0], tmpcoord[0]); - sendbits(buf, bitsizeint[1], tmpcoord[1]); - sendbits(buf, bitsizeint[2], tmpcoord[2]); - } else { - sendints(buf, 3, bitsize, sizeint, tmpcoord); - } - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - thiscoord = thiscoord + 3; - i++; - - run = 0; - if (is_small == 0 && is_smaller == -1) - is_smaller = 0; - while (is_small && run < 8*3) { - if (is_smaller == -1 && ( - SQR(thiscoord[0] - prevcoord[0]) + - SQR(thiscoord[1] - prevcoord[1]) + - SQR(thiscoord[2] - prevcoord[2]) >= smaller * smaller)) { - is_smaller = 0; - } - - tmpcoord[run++] = thiscoord[0] - prevcoord[0] + small; - tmpcoord[run++] = thiscoord[1] - prevcoord[1] + small; - tmpcoord[run++] = thiscoord[2] - prevcoord[2] + small; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - i++; - thiscoord = thiscoord + 3; - is_small = 0; - if (i < *size && - abs(thiscoord[0] - prevcoord[0]) < small && - abs(thiscoord[1] - prevcoord[1]) < small && - abs(thiscoord[2] - prevcoord[2]) < small) { - is_small = 1; - } - } - if (run != prevrun || is_smaller != 0) { - prevrun = run; - sendbits(buf, 1, 1); /* flag the change in run-length */ - sendbits(buf, 5, run+is_smaller+1); - } else { - sendbits(buf, 1, 0); /* flag the fact that runlength did not change */ - } - for (k=0; k < run; k+=3) { - sendints(buf, 3, smallidx, sizesmall, &tmpcoord[k]); - } - if (is_smaller != 0) { - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - smaller = magicints[smallidx-1] / 2; - } else { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - } - } - if (buf[1] != 0) buf[0]++;; - xdr_int(xdrs, &(buf[0])); /* buf[0] holds the length in bytes */ - return errval * (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0])); - } else { - - /* xdrs is open for reading */ - - if (xdr_int(xdrs, &lsize) == 0) - return 0; - if (*size != 0 && lsize != *size) { - fprintf(stderr, "wrong number of coordinates in xdr3dfcoor; " - "%d arg vs %d in file", *size, lsize); - } - *size = lsize; - size3 = *size * 3; - if (*size <= 9) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - buf[0] = buf[1] = buf[2] = 0; - - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - larger = magicints[maxidx]; - - /* buf[0] holds the length in bytes */ - - if (xdr_int(xdrs, &(buf[0])) == 0) - return 0; - if (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0]) == 0) - return 0; - buf[0] = buf[1] = buf[2] = 0; - - lfp = fp; - inv_precision = 1.0 / * precision; - run = 0; - i = 0; - lip = ip; - while ( i < lsize ) { - thiscoord = (int *)(lip) + i * 3; - - if (bitsize == 0) { - thiscoord[0] = receivebits(buf, bitsizeint[0]); - thiscoord[1] = receivebits(buf, bitsizeint[1]); - thiscoord[2] = receivebits(buf, bitsizeint[2]); - } else { - receiveints(buf, 3, bitsize, sizeint, thiscoord); - } - - i++; - thiscoord[0] += minint[0]; - thiscoord[1] += minint[1]; - thiscoord[2] += minint[2]; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - - flag = receivebits(buf, 1); - is_smaller = 0; - if (flag == 1) { - run = receivebits(buf, 5); - is_smaller = run % 3; - run -= is_smaller; - is_smaller--; - } - if (run > 0) { - thiscoord += 3; - for (k = 0; k < run; k+=3) { - receiveints(buf, 3, smallidx, sizesmall, thiscoord); - i++; - thiscoord[0] += prevcoord[0] - small; - thiscoord[1] += prevcoord[1] - small; - thiscoord[2] += prevcoord[2] - small; - if (k == 0) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = prevcoord[0]; - prevcoord[0] = tmp; - tmp = thiscoord[1]; thiscoord[1] = prevcoord[1]; - prevcoord[1] = tmp; - tmp = thiscoord[2]; thiscoord[2] = prevcoord[2]; - prevcoord[2] = tmp; - *lfp++ = prevcoord[0] * inv_precision; - *lfp++ = prevcoord[1] * inv_precision; - *lfp++ = prevcoord[2] * inv_precision; - } else { - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - } - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - } else { - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - if (smallidx > FIRSTIDX) { - smaller = magicints[smallidx - 1] /2; - } else { - smaller = 0; - } - } else if (is_smaller > 0) { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - } - } - return 1; -} - - - diff --git a/source/wham/src-M/xdrf/libxdrf.m4~ b/source/wham/src-M/xdrf/libxdrf.m4~ deleted file mode 100644 index 9fd7f48..0000000 --- a/source/wham/src-M/xdrf/libxdrf.m4~ +++ /dev/null @@ -1,1232 +0,0 @@ -/*____________________________________________________________________________ - | - | libxdrf - portable fortran interface to xdr. some xdr routines - | are C routines for compressed coordinates - | - | version 1.1 - | - | This collection of routines is intended to write and read - | data in a portable way to a file, so data written on one type - | of machine can be read back on a different type. - | - | all fortran routines use an integer 'xdrid', which is an id to the - | current xdr file, and is set by xdrfopen. - | most routines have in integer 'ret' which is the return value. - | The value of 'ret' is zero on failure, and most of the time one - | on succes. - | - | There are three routines useful for C users: - | xdropen(), xdrclose(), xdr3dfcoord(). - | The first two replace xdrstdio_create and xdr_destroy, and *must* be - | used when you plan to use xdr3dfcoord(). (they are also a bit - | easier to interface). For writing data other than compressed coordinates - | you should use the standard C xdr routines (see xdr man page) - | - | xdrfopen(xdrid, filename, mode, ret) - | character *(*) filename - | character *(*) mode - | - | this will open the file with the given filename (string) - | and the given mode, it returns an id in xdrid, which is - | to be used in all other calls to xdrf routines. - | mode is 'w' to create, or update an file, for all other - | values of mode the file is opened for reading - | - | you need to call xdrfclose to flush the output and close - | the file. - | Note that you should not use xdrstdio_create, which comes with the - | standard xdr library - | - | xdrfclose(xdrid, ret) - | flush the data to the file, and closes the file; - | You should not use xdr_destroy (which comes standard with - | the xdr libraries. - | - | xdrfbool(xdrid, bp, ret) - | integer pb - | - | This filter produces values of either 1 or 0 - | - | xdrfchar(xdrid, cp, ret) - | character cp - | - | filter that translate between characters and their xdr representation - | Note that the characters in not compressed and occupies 4 bytes. - | - | xdrfdouble(xdrid, dp, ret) - | double dp - | - | read/write a double. - | - | xdrffloat(xdrid, fp, ret) - | float fp - | - | read/write a float. - | - | xdrfint(xdrid, ip, ret) - | integer ip - | - | read/write integer. - | - | xdrflong(xdrid, lp, ret) - | integer lp - | - | this routine has a possible portablility problem due to 64 bits longs. - | - | xdrfshort(xdrid, sp, ret) - | integer *2 sp - | - | xdrfstring(xdrid, sp, maxsize, ret) - | character *(*) - | integer maxsize - | - | read/write a string, with maximum length given by maxsize - | - | xdrfwrapstring(xdris, sp, ret) - | character *(*) - | - | read/write a string (it is the same as xdrfstring accept that it finds - | the stringlength itself. - | - | xdrfvector(xdrid, cp, size, xdrfproc, ret) - | character *(*) - | integer size - | external xdrfproc - | - | read/write an array pointed to by cp, with number of elements - | defined by 'size'. the routine 'xdrfproc' is the name - | of one of the above routines to read/write data (like xdrfdouble) - | In contrast with the c-version you don't need to specify the - | byte size of an element. - | xdrfstring is not allowed here (it is in the c version) - | - | xdrf3dfcoord(xdrid, fp, size, precision, ret) - | real (*) fp - | real precision - | integer size - | - | this is *NOT* a standard xdr routine. I named it this way, because - | it invites people to use the other xdr routines. - | It is introduced to store specifically 3d coordinates of molecules - | (as found in molecular dynamics) and it writes it in a compressed way. - | It starts by multiplying all numbers by precision and - | rounding the result to integer. effectively converting - | all floating point numbers to fixed point. - | it uses an algorithm for compression that is optimized for - | molecular data, but could be used for other 3d coordinates - | as well. There is subtantial overhead involved, so call this - | routine only if you have a large number of coordinates to read/write - | - | ________________________________________________________________________ - | - | Below are the routines to be used by C programmers. Use the 'normal' - | xdr routines to write integers, floats, etc (see man xdr) - | - | int xdropen(XDR *xdrs, const char *filename, const char *type) - | This will open the file with the given filename and the - | given mode. You should pass it an allocated XDR struct - | in xdrs, to be used in all other calls to xdr routines. - | Mode is 'w' to create, or update an file, and for all - | other values of mode the file is opened for reading. - | You need to call xdrclose to flush the output and close - | the file. - | - | Note that you should not use xdrstdio_create, which - | comes with the standard xdr library. - | - | int xdrclose(XDR *xdrs) - | Flush the data to the file, and close the file; - | You should not use xdr_destroy (which comes standard - | with the xdr libraries). - | - | int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) - | This is \fInot\fR a standard xdr routine. I named it this - | way, because it invites people to use the other xdr - | routines. - | - | (c) 1995 Frans van Hoesel, hoesel@chem.rug.nl -*/ - - -#include -#include -#include -#include -#include -#include -#include -#include "xdrf.h" - -int ftocstr(char *, int, char *, int); -int ctofstr(char *, int, char *); - -#define MAXID 20 -static FILE *xdrfiles[MAXID]; -static XDR *xdridptr[MAXID]; -static char xdrmodes[MAXID]; -static unsigned int cnt; - -typedef void (* FUNCTION(xdrfproc)) (int *, void *, int *); - -void -FUNCTION(xdrfbool) ARGS(`xdrid, pb, ret') -int *xdrid, *ret; -int *pb; -{ - *ret = xdr_bool(xdridptr[*xdrid], (bool_t *) pb); - cnt += sizeof(int); -} - -void -FUNCTION(xdrfchar) ARGS(`xdrid, cp, ret') -int *xdrid, *ret; -char *cp; -{ - *ret = xdr_char(xdridptr[*xdrid], cp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfdouble) ARGS(`xdrid, dp, ret') -int *xdrid, *ret; -double *dp; -{ - *ret = xdr_double(xdridptr[*xdrid], dp); - cnt += sizeof(double); -} - -void -FUNCTION(xdrffloat) ARGS(`xdrid, fp, ret') -int *xdrid, *ret; -float *fp; -{ - *ret = xdr_float(xdridptr[*xdrid], fp); - cnt += sizeof(float); -} - -void -FUNCTION(xdrfint) ARGS(`xdrid, ip, ret') -int *xdrid, *ret; -int *ip; -{ - *ret = xdr_int(xdridptr[*xdrid], ip); - cnt += sizeof(int); -} - -void -FUNCTION(xdrflong) ARGS(`xdrid, lp, ret') -int *xdrid, *ret; -long *lp; -{ - *ret = xdr_long(xdridptr[*xdrid], lp); - cnt += sizeof(long); -} - -void -FUNCTION(xdrfshort) ARGS(`xdrid, sp, ret') -int *xdrid, *ret; -short *sp; -{ - *ret = xdr_short(xdridptr[*xdrid], sp); - cnt += sizeof(sp); -} - -void -FUNCTION(xdrfuchar) ARGS(`xdrid, ucp, ret') -int *xdrid, *ret; -char *ucp; -{ - *ret = xdr_u_char(xdridptr[*xdrid], ucp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfulong) ARGS(`xdrid, ulp, ret') -int *xdrid, *ret; -unsigned long *ulp; -{ - *ret = xdr_u_long(xdridptr[*xdrid], ulp); - cnt += sizeof(unsigned long); -} - -void -FUNCTION(xdrfushort) ARGS(`xdrid, usp, ret') -int *xdrid, *ret; -unsigned short *usp; -{ - *ret = xdr_u_short(xdridptr[*xdrid], usp); - cnt += sizeof(unsigned short); -} - -void -FUNCTION(xdrf3dfcoord) ARGS(`xdrid, fp, size, precision, ret') -int *xdrid, *ret; -float *fp; -int *size; -float *precision; -{ - *ret = xdr3dfcoord(xdridptr[*xdrid], fp, size, precision); -} - -void -FUNCTION(xdrfstring) ARGS(`xdrid, STRING_ARG(sp), maxsize, ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -int *maxsize; -{ - char *tsp; - - tsp = (char*) malloc(((STRING_LEN(sp)) + 1) * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, *maxsize+1, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int) *maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += *maxsize; - free(tsp); -} - -void -FUNCTION(xdrfwrapstring) ARGS(`xdrid, STRING_ARG(sp), ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -{ - char *tsp; - int maxsize; - maxsize = (STRING_LEN(sp)) + 1; - tsp = (char*) malloc(maxsize * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, maxsize, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int)maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += maxsize; - free(tsp); -} - -void -FUNCTION(xdrfopaque) ARGS(`xdrid, cp, ccnt, ret') -int *xdrid, *ret; -caddr_t *cp; -int *ccnt; -{ - *ret = xdr_opaque(xdridptr[*xdrid], (caddr_t)*cp, (u_int)*ccnt); - cnt += *ccnt; -} - -void -FUNCTION(xdrfsetpos) ARGS(`xdrid, pos, ret') -int *xdrid, *ret; -int *pos; -{ - *ret = xdr_setpos(xdridptr[*xdrid], (u_int) *pos); -} - -void -FUNCTION(xdrf) ARGS(`xdrid, pos') -int *xdrid, *pos; -{ - *pos = xdr_getpos(xdridptr[*xdrid]); -} - -void -FUNCTION(xdrfvector) ARGS(`xdrid, cp, size, elproc, ret') -int *xdrid, *ret; -char *cp; -int *size; -FUNCTION(xdrfproc) elproc; -{ - int lcnt; - cnt = 0; - for (lcnt = 0; lcnt < *size; lcnt++) { - elproc(xdrid, (cp+cnt) , ret); - } -} - - -void -FUNCTION(xdrfclose) ARGS(`xdrid, ret') -int *xdrid; -int *ret; -{ - *ret = xdrclose(xdridptr[*xdrid]); - cnt = 0; -} - -void -FUNCTION(xdrfopen) ARGS(`xdrid, STRING_ARG(fp), STRING_ARG(mode), ret') -int *xdrid; -STRING_ARG_DECL(fp); -STRING_ARG_DECL(mode); -int *ret; -{ - char fname[512]; - char fmode[3]; - - if (ftocstr(fname, sizeof(fname), STRING_PTR(fp), STRING_LEN(fp))) { - *ret = 0; - } - if (ftocstr(fmode, sizeof(fmode), STRING_PTR(mode), - STRING_LEN(mode))) { - *ret = 0; - } - - *xdrid = xdropen(NULL, fname, fmode); - if (*xdrid == 0) - *ret = 0; - else - *ret = 1; -} - -/*___________________________________________________________________________ - | - | what follows are the C routines for opening, closing xdr streams - | and the routine to read/write compressed coordinates together - | with some routines to assist in this task (those are marked - | static and cannot be called from user programs) -*/ -#define MAXABS INT_MAX-2 - -#ifndef MIN -#define MIN(x,y) ((x) < (y) ? (x):(y)) -#endif -#ifndef MAX -#define MAX(x,y) ((x) > (y) ? (x):(y)) -#endif -#ifndef SQR -#define SQR(x) ((x)*(x)) -#endif -static int magicints[] = { - 0, 0, 0, 0, 0, 0, 0, 0, 0, - 8, 10, 12, 16, 20, 25, 32, 40, 50, 64, - 80, 101, 128, 161, 203, 256, 322, 406, 512, 645, - 812, 1024, 1290, 1625, 2048, 2580, 3250, 4096, 5060, 6501, - 8192, 10321, 13003, 16384, 20642, 26007, 32768, 41285, 52015, 65536, - 82570, 104031, 131072, 165140, 208063, 262144, 330280, 416127, 524287, 660561, - 832255, 1048576, 1321122, 1664510, 2097152, 2642245, 3329021, 4194304, 5284491, 6658042, - 8388607, 10568983, 13316085, 16777216 }; - -#define FIRSTIDX 9 -/* note that magicints[FIRSTIDX-1] == 0 */ -#define LASTIDX (sizeof(magicints) / sizeof(*magicints)) - - -/*__________________________________________________________________________ - | - | xdropen - open xdr file - | - | This versions differs from xdrstdio_create, because I need to know - | the state of the file (read or write) so I can use xdr3dfcoord - | in eigther read or write mode, and the file descriptor - | so I can close the file (something xdr_destroy doesn't do). - | -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type) { - static int init_done = 0; - enum xdr_op lmode; - const char *type1; - int xdrid; - - if (init_done == 0) { - for (xdrid = 1; xdrid < MAXID; xdrid++) { - xdridptr[xdrid] = NULL; - } - init_done = 1; - } - xdrid = 1; - while (xdrid < MAXID && xdridptr[xdrid] != NULL) { - xdrid++; - } - if (xdrid == MAXID) { - return 0; - } - if (*type == 'w' || *type == 'W') { - type = "w+"; - type1 = "a+"; - lmode = XDR_ENCODE; - } else { - type = "r"; - lmode = XDR_DECODE; - } - xdrfiles[xdrid] = fopen(filename, type1); - if (xdrfiles[xdrid] == NULL) { - xdrs = NULL; - return 0; - } - xdrmodes[xdrid] = *type; - /* next test isn't usefull in the case of C language - * but is used for the Fortran interface - * (C users are expected to pass the address of an already allocated - * XDR staructure) - */ - if (xdrs == NULL) { - xdridptr[xdrid] = (XDR *) malloc(sizeof(XDR)); - xdrstdio_create(xdridptr[xdrid], xdrfiles[xdrid], lmode); - } else { - xdridptr[xdrid] = xdrs; - xdrstdio_create(xdrs, xdrfiles[xdrid], lmode); - } - return xdrid; -} - -/*_________________________________________________________________________ - | - | xdrclose - close a xdr file - | - | This will flush the xdr buffers, and destroy the xdr stream. - | It also closes the associated file descriptor (this is *not* - | done by xdr_destroy). - | -*/ - -int xdrclose(XDR *xdrs) { - int xdrid; - - if (xdrs == NULL) { - fprintf(stderr, "xdrclose: passed a NULL pointer\n"); - exit(1); - } - for (xdrid = 1; xdrid < MAXID; xdrid++) { - if (xdridptr[xdrid] == xdrs) { - - xdr_destroy(xdrs); - fclose(xdrfiles[xdrid]); - xdridptr[xdrid] = NULL; - return 1; - } - } - fprintf(stderr, "xdrclose: no such open xdr file\n"); - exit(1); - -} - -/*____________________________________________________________________________ - | - | sendbits - encode num into buf using the specified number of bits - | - | This routines appends the value of num to the bits already present in - | the array buf. You need to give it the number of bits to use and you - | better make sure that this number of bits is enough to hold the value - | Also num must be positive. - | -*/ - -static void sendbits(int buf[], int num_of_bits, int num) { - - unsigned int cnt, lastbyte; - int lastbits; - unsigned char * cbuf; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = (unsigned int) buf[0]; - lastbits = buf[1]; - lastbyte =(unsigned int) buf[2]; - while (num_of_bits >= 8) { - lastbyte = (lastbyte << 8) | ((num >> (num_of_bits -8)) /* & 0xff*/); - cbuf[cnt++] = lastbyte >> lastbits; - num_of_bits -= 8; - } - if (num_of_bits > 0) { - lastbyte = (lastbyte << num_of_bits) | num; - lastbits += num_of_bits; - if (lastbits >= 8) { - lastbits -= 8; - cbuf[cnt++] = lastbyte >> lastbits; - } - } - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - if (lastbits>0) { - cbuf[cnt] = lastbyte << (8 - lastbits); - } -} - -/*_________________________________________________________________________ - | - | sizeofint - calculate bitsize of an integer - | - | return the number of bits needed to store an integer with given max size - | -*/ - -static int sizeofint(const int size) { - unsigned int num = 1; - int num_of_bits = 0; - - while (size >= num && num_of_bits < 32) { - num_of_bits++; - num <<= 1; - } - return num_of_bits; -} - -/*___________________________________________________________________________ - | - | sizeofints - calculate 'bitsize' of compressed ints - | - | given the number of small unsigned integers and the maximum value - | return the number of bits needed to read or write them with the - | routines receiveints and sendints. You need this parameter when - | calling these routines. Note that for many calls I can use - | the variable 'smallidx' which is exactly the number of bits, and - | So I don't need to call 'sizeofints for those calls. -*/ - -static int sizeofints( const int num_of_ints, unsigned int sizes[]) { - int i, num; - unsigned int num_of_bytes, num_of_bits, bytes[32], bytecnt, tmp; - num_of_bytes = 1; - bytes[0] = 1; - num_of_bits = 0; - for (i=0; i < num_of_ints; i++) { - tmp = 0; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - num = 1; - num_of_bytes--; - while (bytes[num_of_bytes] >= num) { - num_of_bits++; - num *= 2; - } - return num_of_bits + num_of_bytes * 8; - -} - -/*____________________________________________________________________________ - | - | sendints - send a small set of small integers in compressed format - | - | this routine is used internally by xdr3dfcoord, to send a set of - | small integers to the buffer. - | Multiplication with fixed (specified maximum ) sizes is used to get - | to one big, multibyte integer. Allthough the routine could be - | modified to handle sizes bigger than 16777216, or more than just - | a few integers, this is not done, because the gain in compression - | isn't worth the effort. Note that overflowing the multiplication - | or the byte buffer (32 bytes) is unchecked and causes bad results. - | - */ - -static void sendints(int buf[], const int num_of_ints, const int num_of_bits, - unsigned int sizes[], unsigned int nums[]) { - - int i; - unsigned int bytes[32], num_of_bytes, bytecnt, tmp; - - tmp = nums[0]; - num_of_bytes = 0; - do { - bytes[num_of_bytes++] = tmp & 0xff; - tmp >>= 8; - } while (tmp != 0); - - for (i = 1; i < num_of_ints; i++) { - if (nums[i] >= sizes[i]) { - fprintf(stderr,"major breakdown in sendints num %d doesn't " - "match size %d\n", nums[i], sizes[i]); - exit(1); - } - /* use one step multiply */ - tmp = nums[i]; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - if (num_of_bits >= num_of_bytes * 8) { - for (i = 0; i < num_of_bytes; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits - num_of_bytes * 8, 0); - } else { - for (i = 0; i < num_of_bytes-1; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits- (num_of_bytes -1) * 8, bytes[i]); - } -} - - -/*___________________________________________________________________________ - | - | receivebits - decode number from buf using specified number of bits - | - | extract the number of bits from the array buf and construct an integer - | from it. Return that value. - | -*/ - -static int receivebits(int buf[], int num_of_bits) { - - int cnt, num; - unsigned int lastbits, lastbyte; - unsigned char * cbuf; - int mask = (1 << num_of_bits) -1; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = buf[0]; - lastbits = (unsigned int) buf[1]; - lastbyte = (unsigned int) buf[2]; - - num = 0; - while (num_of_bits >= 8) { - lastbyte = ( lastbyte << 8 ) | cbuf[cnt++]; - num |= (lastbyte >> lastbits) << (num_of_bits - 8); - num_of_bits -=8; - } - if (num_of_bits > 0) { - if (lastbits < num_of_bits) { - lastbits += 8; - lastbyte = (lastbyte << 8) | cbuf[cnt++]; - } - lastbits -= num_of_bits; - num |= (lastbyte >> lastbits) & ((1 << num_of_bits) -1); - } - num &= mask; - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - return num; -} - -/*____________________________________________________________________________ - | - | receiveints - decode 'small' integers from the buf array - | - | this routine is the inverse from sendints() and decodes the small integers - | written to buf by calculating the remainder and doing divisions with - | the given sizes[]. You need to specify the total number of bits to be - | used from buf in num_of_bits. - | -*/ - -static void receiveints(int buf[], const int num_of_ints, int num_of_bits, - unsigned int sizes[], int nums[]) { - int bytes[32]; - int i, j, num_of_bytes, p, num; - - bytes[1] = bytes[2] = bytes[3] = 0; - num_of_bytes = 0; - while (num_of_bits > 8) { - bytes[num_of_bytes++] = receivebits(buf, 8); - num_of_bits -= 8; - } - if (num_of_bits > 0) { - bytes[num_of_bytes++] = receivebits(buf, num_of_bits); - } - for (i = num_of_ints-1; i > 0; i--) { - num = 0; - for (j = num_of_bytes-1; j >=0; j--) { - num = (num << 8) | bytes[j]; - p = num / sizes[i]; - bytes[j] = p; - num = num - p * sizes[i]; - } - nums[i] = num; - } - nums[0] = bytes[0] | (bytes[1] << 8) | (bytes[2] << 16) | (bytes[3] << 24); -} - -/*____________________________________________________________________________ - | - | xdr3dfcoord - read or write compressed 3d coordinates to xdr file. - | - | this routine reads or writes (depending on how you opened the file with - | xdropen() ) a large number of 3d coordinates (stored in *fp). - | The number of coordinates triplets to write is given by *size. On - | read this number may be zero, in which case it reads as many as were written - | or it may specify the number if triplets to read (which should match the - | number written). - | Compression is achieved by first converting all floating numbers to integer - | using multiplication by *precision and rounding to the nearest integer. - | Then the minimum and maximum value are calculated to determine the range. - | The limited range of integers so found, is used to compress the coordinates. - | In addition the differences between succesive coordinates is calculated. - | If the difference happens to be 'small' then only the difference is saved, - | compressing the data even more. The notion of 'small' is changed dynamically - | and is enlarged or reduced whenever needed or possible. - | Extra compression is achieved in the case of GROMOS and coordinates of - | water molecules. GROMOS first writes out the Oxygen position, followed by - | the two hydrogens. In order to make the differences smaller (and thereby - | compression the data better) the order is changed into first one hydrogen - | then the oxygen, followed by the other hydrogen. This is rather special, but - | it shouldn't harm in the general case. - | - */ - -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) { - - - static int *ip = NULL; - static int oldsize; - static int *buf; - - int minint[3], maxint[3], mindiff, *lip, diff; - int lint1, lint2, lint3, oldlint1, oldlint2, oldlint3, smallidx; - int minidx, maxidx; - unsigned sizeint[3], sizesmall[3], bitsizeint[3], size3, *luip; - int flag, k; - int small, smaller, larger, i, is_small, is_smaller, run, prevrun; - float *lfp, lf; - int tmp, *thiscoord, prevcoord[3]; - unsigned int tmpcoord[30]; - - int bufsize, xdrid, lsize; - unsigned int bitsize; - float inv_precision; - int errval = 1; - - /* find out if xdrs is opened for reading or for writing */ - xdrid = 0; - while (xdridptr[xdrid] != xdrs) { - xdrid++; - if (xdrid >= MAXID) { - fprintf(stderr, "xdr error. no open xdr stream\n"); - exit (1); - } - } - if (xdrmodes[xdrid] == 'w') { - - /* xdrs is open for writing */ - - if (xdr_int(xdrs, size) == 0) - return 0; - size3 = *size * 3; - /* when the number of coordinates is small, don't try to compress; just - * write them as floats using xdr_vector - */ - if (*size <= 9 ) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - /* buf[0-2] are special and do not contain actual data */ - buf[0] = buf[1] = buf[2] = 0; - minint[0] = minint[1] = minint[2] = INT_MAX; - maxint[0] = maxint[1] = maxint[2] = INT_MIN; - prevrun = -1; - lfp = fp; - lip = ip; - mindiff = INT_MAX; - oldlint1 = oldlint2 = oldlint3 = 0; - while(lfp < fp + size3 ) { - /* find nearest integer */ - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint1 = lf; - if (lint1 < minint[0]) minint[0] = lint1; - if (lint1 > maxint[0]) maxint[0] = lint1; - *lip++ = lint1; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint2 = lf; - if (lint2 < minint[1]) minint[1] = lint2; - if (lint2 > maxint[1]) maxint[1] = lint2; - *lip++ = lint2; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint3 = lf; - if (lint3 < minint[2]) minint[2] = lint3; - if (lint3 > maxint[2]) maxint[2] = lint3; - *lip++ = lint3; - lfp++; - diff = abs(oldlint1-lint1)+abs(oldlint2-lint2)+abs(oldlint3-lint3); - if (diff < mindiff && lfp > fp + 3) - mindiff = diff; - oldlint1 = lint1; - oldlint2 = lint2; - oldlint3 = lint3; - } - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - if ((float)maxint[0] - (float)minint[0] >= MAXABS || - (float)maxint[1] - (float)minint[1] >= MAXABS || - (float)maxint[2] - (float)minint[2] >= MAXABS) { - /* turning value in unsigned by subtracting minint - * would cause overflow - */ - errval = 0; - } - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - lip = ip; - luip = (unsigned int *) ip; - smallidx = FIRSTIDX; - while (smallidx < LASTIDX && magicints[smallidx] < mindiff) { - smallidx++; - } - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - larger = magicints[maxidx] / 2; - i = 0; - while (i < *size) { - is_small = 0; - thiscoord = (int *)(luip) + i * 3; - if (smallidx < maxidx && i >= 1 && - abs(thiscoord[0] - prevcoord[0]) < larger && - abs(thiscoord[1] - prevcoord[1]) < larger && - abs(thiscoord[2] - prevcoord[2]) < larger) { - is_smaller = 1; - } else if (smallidx > minidx) { - is_smaller = -1; - } else { - is_smaller = 0; - } - if (i + 1 < *size) { - if (abs(thiscoord[0] - thiscoord[3]) < small && - abs(thiscoord[1] - thiscoord[4]) < small && - abs(thiscoord[2] - thiscoord[5]) < small) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = thiscoord[3]; - thiscoord[3] = tmp; - tmp = thiscoord[1]; thiscoord[1] = thiscoord[4]; - thiscoord[4] = tmp; - tmp = thiscoord[2]; thiscoord[2] = thiscoord[5]; - thiscoord[5] = tmp; - is_small = 1; - } - - } - tmpcoord[0] = thiscoord[0] - minint[0]; - tmpcoord[1] = thiscoord[1] - minint[1]; - tmpcoord[2] = thiscoord[2] - minint[2]; - if (bitsize == 0) { - sendbits(buf, bitsizeint[0], tmpcoord[0]); - sendbits(buf, bitsizeint[1], tmpcoord[1]); - sendbits(buf, bitsizeint[2], tmpcoord[2]); - } else { - sendints(buf, 3, bitsize, sizeint, tmpcoord); - } - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - thiscoord = thiscoord + 3; - i++; - - run = 0; - if (is_small == 0 && is_smaller == -1) - is_smaller = 0; - while (is_small && run < 8*3) { - if (is_smaller == -1 && ( - SQR(thiscoord[0] - prevcoord[0]) + - SQR(thiscoord[1] - prevcoord[1]) + - SQR(thiscoord[2] - prevcoord[2]) >= smaller * smaller)) { - is_smaller = 0; - } - - tmpcoord[run++] = thiscoord[0] - prevcoord[0] + small; - tmpcoord[run++] = thiscoord[1] - prevcoord[1] + small; - tmpcoord[run++] = thiscoord[2] - prevcoord[2] + small; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - i++; - thiscoord = thiscoord + 3; - is_small = 0; - if (i < *size && - abs(thiscoord[0] - prevcoord[0]) < small && - abs(thiscoord[1] - prevcoord[1]) < small && - abs(thiscoord[2] - prevcoord[2]) < small) { - is_small = 1; - } - } - if (run != prevrun || is_smaller != 0) { - prevrun = run; - sendbits(buf, 1, 1); /* flag the change in run-length */ - sendbits(buf, 5, run+is_smaller+1); - } else { - sendbits(buf, 1, 0); /* flag the fact that runlength did not change */ - } - for (k=0; k < run; k+=3) { - sendints(buf, 3, smallidx, sizesmall, &tmpcoord[k]); - } - if (is_smaller != 0) { - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - smaller = magicints[smallidx-1] / 2; - } else { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - } - } - if (buf[1] != 0) buf[0]++;; - xdr_int(xdrs, &(buf[0])); /* buf[0] holds the length in bytes */ - return errval * (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0])); - } else { - - /* xdrs is open for reading */ - - if (xdr_int(xdrs, &lsize) == 0) - return 0; - if (*size != 0 && lsize != *size) { - fprintf(stderr, "wrong number of coordinates in xdr3dfcoor; " - "%d arg vs %d in file", *size, lsize); - } - *size = lsize; - size3 = *size * 3; - if (*size <= 9) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - buf[0] = buf[1] = buf[2] = 0; - - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - larger = magicints[maxidx]; - - /* buf[0] holds the length in bytes */ - - if (xdr_int(xdrs, &(buf[0])) == 0) - return 0; - if (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0]) == 0) - return 0; - buf[0] = buf[1] = buf[2] = 0; - - lfp = fp; - inv_precision = 1.0 / * precision; - run = 0; - i = 0; - lip = ip; - while ( i < lsize ) { - thiscoord = (int *)(lip) + i * 3; - - if (bitsize == 0) { - thiscoord[0] = receivebits(buf, bitsizeint[0]); - thiscoord[1] = receivebits(buf, bitsizeint[1]); - thiscoord[2] = receivebits(buf, bitsizeint[2]); - } else { - receiveints(buf, 3, bitsize, sizeint, thiscoord); - } - - i++; - thiscoord[0] += minint[0]; - thiscoord[1] += minint[1]; - thiscoord[2] += minint[2]; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - - flag = receivebits(buf, 1); - is_smaller = 0; - if (flag == 1) { - run = receivebits(buf, 5); - is_smaller = run % 3; - run -= is_smaller; - is_smaller--; - } - if (run > 0) { - thiscoord += 3; - for (k = 0; k < run; k+=3) { - receiveints(buf, 3, smallidx, sizesmall, thiscoord); - i++; - thiscoord[0] += prevcoord[0] - small; - thiscoord[1] += prevcoord[1] - small; - thiscoord[2] += prevcoord[2] - small; - if (k == 0) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = prevcoord[0]; - prevcoord[0] = tmp; - tmp = thiscoord[1]; thiscoord[1] = prevcoord[1]; - prevcoord[1] = tmp; - tmp = thiscoord[2]; thiscoord[2] = prevcoord[2]; - prevcoord[2] = tmp; - *lfp++ = prevcoord[0] * inv_precision; - *lfp++ = prevcoord[1] * inv_precision; - *lfp++ = prevcoord[2] * inv_precision; - } else { - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - } - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - } else { - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - if (smallidx > FIRSTIDX) { - smaller = magicints[smallidx - 1] /2; - } else { - smaller = 0; - } - } else if (is_smaller > 0) { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - } - } - return 1; -} - - - diff --git a/source/wham/src-M/xdrf/libxdrf.o b/source/wham/src-M/xdrf/libxdrf.o deleted file mode 100644 index 2b501fa..0000000 Binary files a/source/wham/src-M/xdrf/libxdrf.o and /dev/null differ diff --git a/source/wham/src-M/xdrf/underscore.m4 b/source/wham/src-M/xdrf/underscore.m4 deleted file mode 100644 index 4d620a0..0000000 --- a/source/wham/src-M/xdrf/underscore.m4 +++ /dev/null @@ -1,19 +0,0 @@ -divert(-1) -undefine(`len') -# -# append an underscore to FORTRAN function names -# -define(`FUNCTION',`$1_') -# -# FORTRAN character strings are passed as follows: -# a pointer to the base of the string is passed in the normal -# argument list, and the length is passed by value as an extra -# argument, after all of the other arguments. -# -define(`ARGS',`($1`'undivert(1))') -define(`SAVE',`divert(1)$1`'divert(0)') -define(`STRING_ARG',`$1_ptr`'SAVE(`, $1_len')') -define(`STRING_ARG_DECL',`char * $1_ptr; int $1_len') -define(`STRING_LEN',`$1_len') -define(`STRING_PTR',`$1_ptr') -divert(0) diff --git a/source/wham/src-M/xdrf/xdrf.h b/source/wham/src-M/xdrf/xdrf.h deleted file mode 100644 index dedf5a2..0000000 --- a/source/wham/src-M/xdrf/xdrf.h +++ /dev/null @@ -1,10 +0,0 @@ -/*_________________________________________________________________ - | - | xdrf.h - include file for C routines that want to use the - | functions below. -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type); -int xdrclose(XDR *xdrs) ; -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) ; -