+++ /dev/null
-#
-# This file is part of the GROMACS molecular simulation package.
-#
-# Copyright (c) 2012, by the GROMACS development team, led by
-# David van der Spoel, Berk Hess, Erik Lindahl, and including many
-# others, as listed in the AUTHORS file in the top-level source
-# directory and at http://www.gromacs.org.
-#
-# GROMACS 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.
-#
-# GROMACS 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 GROMACS; if not, see
-# http://www.gnu.org/licenses, or write to the Free Software Foundation,
-# Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-#
-# If you want to redistribute modifications to GROMACS, please
-# consider that scientific software is very special. Version
-# control is crucial - bugs must be traceable. We will be happy to
-# consider code for inclusion in the official distribution, but
-# derived work must not be called official GROMACS. Details are found
-# in the README & COPYING files - if they are missing, get the
-# official version at http://www.gromacs.org.
-#
-# To help us fund GROMACS development, we humbly ask that you cite
-# the research papers on the package. Check out http://www.gromacs.org.
-#
-# FortranCInterface.cmake
-#
-# This file defines the function create_fortran_c_interface.
-# this function is used to create a configured header file
-# that contains a mapping from C to a Fortran function using
-# the correct name mangling scheme as defined by the current
-# fortran compiler.
-#
-# The function tages a list of functions and the name of
-# a header file to configure.
-#
-# This file also defines some helper functions that are used
-# to detect the fortran name mangling scheme used by the
-# current Fortran compiler.
-# test_fortran_mangling - test a single fortran mangling
-# discover_fortran_mangling - loop over all combos of fortran
-# name mangling and call test_fortran_mangling until one of them
-# works.
-# discover_fortran_module_mangling - try different types of
-# fortran modle name mangling to find one that works
-#
-#
-#
-# this function tests a single fortran mangling.
-# CODE - test code to try should define a subroutine called "sub"
-# PREFIX - string to put in front of sub
-# POSTFIX - string to put after sub
-# ISUPPER - if TRUE then sub will be called as SUB
-# DOC - string used in status checking Fortran ${DOC} linkage
-# SUB - the name of the SUB to call
-# RESULT place to store result TRUE if this linkage works, FALSE
-# if not.
-#
-function(test_fortran_mangling CODE PREFIX ISUPPER POSTFIX DOC SUB RESULT)
- if(ISUPPER)
- string(TOUPPER "${SUB}" sub)
- else(ISUPPER)
- string(TOLOWER "${SUB}" sub)
- endif(ISUPPER)
- set(FUNCTION "${PREFIX}${sub}${POSTFIX}")
- # create a fortran file with sub called sub
- #
- set(TMP_DIR
- "${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/CheckFortranLink")
- file(REMOVE_RECURSE "${TMP_DIR}")
- file(WRITE "${TMP_DIR}/test.f" "${CODE}" )
- message(STATUS "checking Fortran ${DOC} linkage: ${FUNCTION}")
- file(WRITE "${TMP_DIR}/ctof.c"
- "
- extern ${FUNCTION}();
- int main() { ${FUNCTION}(); return 0;}
- "
- )
- file(WRITE "${TMP_DIR}/CMakeLists.txt"
- "
- project(testf C Fortran)
- add_library(flib test.f)
- add_executable(ctof ctof.c)
- target_link_libraries(ctof flib)
- "
- )
- set(FORTRAN_NAME_MANGLE_TEST FALSE)
- try_compile(FORTRAN_NAME_MANGLE_TEST "${TMP_DIR}" "${TMP_DIR}"
- testf
- OUTPUT_VARIABLE output)
- if(FORTRAN_NAME_MANGLE_TEST)
- set(${RESULT} TRUE PARENT_SCOPE)
- else()
- set(${RESULT} FALSE PARENT_SCOPE)
- endif()
-endfunction(test_fortran_mangling)
-
-# this function discovers the name mangling scheme used
-# for functions in a fortran module.
-function(discover_fortran_module_mangling prefix suffix found)
- set(CODE
- "
- module test_interface
- interface dummy
- module procedure sub
- end interface
- contains
- subroutine sub
- end subroutine
- end module test_interface
- ")
- set(worked FALSE)
- foreach(interface
- "test_interface$"
- "TEST_INTERFACE_mp_"
- "_test_interface__"
- "__test_interface__"
- "__test_interface_NMOD_"
- "__test_interface_MOD_")
- test_fortran_mangling("${CODE}" "${interface}"
- ${FORTRAN_C_MANGLING_UPPERCASE} "" "module" "sub" worked)
- if(worked)
- # if this is the upper case module match then
- # lower case it for the extraction of pre and post strings
- if("${interface}" MATCHES "TEST_INTERFACE")
- string(TOLOWER "${interface}" interface)
- endif()
- string(REGEX REPLACE "(.*)test_interface(.*)" "\\1" pre "${interface}")
- string(REGEX REPLACE "(.*)test_interface(.*)" "\\2" post "${interface}")
- set(${prefix} "${pre}" PARENT_SCOPE)
- set(${suffix} "${post}" PARENT_SCOPE)
- set(${found} TRUE PARENT_SCOPE)
- return()
- endif(worked)
- endforeach(interface)
- if(NOT worked)
- message(STATUS "Failed to find C binding to Fortran module functions.")
- set(${prefix} "BROKEN_C_FORTRAN_MODULE_BINDING" PARENT_SCOPE)
- set(${suffix} "BROKEN_C_FORTRAN_MODULE_BINDING" PARENT_SCOPE)
- set(${found} FALSE PARENT_SCOPE)
- endif(NOT worked)
-endfunction(discover_fortran_module_mangling)
-
-
-function(discover_fortran_mangling prefix isupper suffix extra_under_score
- found )
- set(CODE
- "
- subroutine sub
- end subroutine sub
- ")
- foreach(post "_" "")
- foreach(isup FALSE TRUE)
- foreach(pre "" "_" "__")
- set(worked FALSE)
- test_fortran_mangling("${CODE}" "${pre}" ${isup}
- "${post}" "function" sub worked )
- if(worked)
- message(STATUS "found Fortran function linkage")
- set(${isupper} "${isup}" PARENT_SCOPE)
- set(${prefix} "${pre}" PARENT_SCOPE)
- set(${suffix} "${post}" PARENT_SCOPE)
- set(${found} TRUE PARENT_SCOPE)
- set(CODE
- "
- subroutine my_sub
- end subroutine my_sub
- ")
- set(worked FALSE)
- test_fortran_mangling("${CODE}" "${pre}" ${isup}
- "${post}" "function with _ " my_sub worked )
- if(worked)
- set(${extra_under_score} FALSE PARENT_SCOPE)
- else(worked)
- test_fortran_mangling("${CODE}" "${pre}" ${isup}
- "${post}_" "function with _ " my_sub worked )
- if(worked)
- set(${extra_under_score} TRUE PARENT_SCOPE)
- endif(worked)
- endif(worked)
- return()
- endif()
- endforeach()
- endforeach()
- endforeach()
- set(${found} FALSE PARENT_SCOPE)
-endfunction(discover_fortran_mangling)
-
-function(create_fortran_c_interface NAMESPACE FUNCTIONS HEADER)
- if(NOT FORTRAN_C_MANGLING_FOUND)
- # find regular fortran function mangling
- discover_fortran_mangling(prefix isupper suffix extra_under found)
- if(NOT found)
- message(SEND_ERROR "Could not find fortran c name mangling.")
- return()
- endif(NOT found)
- # find fortran module function mangling
- set(FORTRAN_C_PREFIX "${prefix}" CACHE INTERNAL
- "PREFIX for Fortran to c name mangling")
- set(FORTRAN_C_SUFFIX "${suffix}" CACHE INTERNAL
- "SUFFIX for Fortran to c name mangling")
- set(FORTRAN_C_MANGLING_UPPERCASE ${isupper} CACHE INTERNAL
- "Was fortran to c mangling found" )
- set(FORTRAN_C_MANGLING_EXTRA_UNDERSCORE ${extra_under} CACHE INTERNAL
- "If a function has a _ in the name does the compiler append an extra _" )
- set(FORTRAN_C_MANGLING_FOUND TRUE CACHE INTERNAL
- "Was fortran to c mangling found" )
- set(prefix )
- set(suffix )
- set(found FALSE)
- # only try this if the compiler is F90 compatible
- if(CMAKE_Fortran_COMPILER_SUPPORTS_F90)
- discover_fortran_module_mangling(prefix suffix found)
- endif(CMAKE_Fortran_COMPILER_SUPPORTS_F90)
- if(found)
- message(STATUS "found Fortran module linkage")
- else(found)
- message(STATUS "Failed to find Fortran module linkage")
- endif(found)
- set(FORTRAN_C_MODULE_PREFIX "${prefix}" CACHE INTERNAL
- "PREFIX for Fortran to c name mangling")
- set(FORTRAN_C_MODULE_SUFFIX "${suffix}" CACHE INTERNAL
- "SUFFIX for Fortran to c name mangling")
- set(FORTRAN_C_MODULE_MANGLING_FOUND ${found} CACHE INTERNAL
- "Was for Fortran to c name mangling found for modules")
- endif(NOT FORTRAN_C_MANGLING_FOUND)
- foreach(f ${${FUNCTIONS}})
- if(FORTRAN_C_MANGLING_UPPERCASE)
- string(TOUPPER "${f}" fcase)
- else()
- string(TOLOWER "${f}" fcase)
- endif()
- if("${f}" MATCHES ":")
- string(REGEX REPLACE "(.*):(.*)" "\\1" module "${f}")
- string(REGEX REPLACE "(.*):(.*)" "\\2" function "${f}")
- string(REGEX REPLACE "(.*):(.*)" "\\1" module_case "${fcase}")
- string(REGEX REPLACE "(.*):(.*)" "\\2" function_case "${fcase}")
- set(HEADER_CONTENT "${HEADER_CONTENT}
-#define ${NAMESPACE}${module}_${function} ${FORTRAN_C_MODULE_PREFIX}${module_case}${FORTRAN_C_MODULE_SUFFIX}${function_case}
-")
- else("${f}" MATCHES ":")
- set(function "${FORTRAN_C_PREFIX}${fcase}${FORTRAN_C_SUFFIX}")
- if("${f}" MATCHES "_" AND FORTRAN_C_MANGLING_EXTRA_UNDERSCORE)
- set(function "${function}_")
- endif("${f}" MATCHES "_" AND FORTRAN_C_MANGLING_EXTRA_UNDERSCORE)
- set(HEADER_CONTENT "${HEADER_CONTENT}
-#define ${NAMESPACE}${f} ${function}
-")
- endif("${f}" MATCHES ":")
- endforeach(f)
- configure_file(
- "${CMAKE_ROOT}/Modules/FortranCInterface.h.in"
- ${HEADER} @ONLY)
- message(STATUS "created ${HEADER}")
-endfunction()
-
PATTERN "cmake*" EXCLUDE
PATTERN "*~" EXCLUDE
PATTERN "*.cmakein" EXCLUDE
+ REGEX "gmx_(arpack|blas|lapack).h$" EXCLUDE
)
* have been made thread-safe by using extra workspace arrays.
*/
-#ifndef F77_FUNC
-#define F77_FUNC(name,NAME) name ## _
-#endif
-
/*! \brief Implicitly Restarted Arnoldi Iteration, double precision.
*
}
#endif
-#ifndef F77_FUNC
-#define F77_FUNC(name,NAME) name ## _
-#endif
-
-
/* Double precision versions */
double
F77_FUNC(dasum,DASUM)(int *n, double *dx, int *incx);
#undef toupper
#endif
-#ifndef F77_FUNC
-#define F77_FUNC(name,NAME) name ## _
-#endif
-
-
-
/* Double precision */
void
#include "swindirect.h"
#endif
+/* default name mangling maybe wrong on exotic plattforms */
+#define F77_FUNC(name,NAME) name ## _
+
/* Define if we have pipes */
#cmakedefine HAVE_PIPES
unsigned int fracttab[4096]; /*!< Mantissa lookup table */
};
-#ifndef F77_FUNC
-/*! \brief Macro for Fortran name-mangling
- *
- * Use Fortran name mangling from autoconf macros if defined,
- * or lowercase+underscore by default. Since there is no easy way to convert
- * between lower and upper case in macros, you should call fortran routines
- * as F77_FUNC(routine,ROUTINE)(param1,param2,...)
- */
-#define F77_FUNC(name,NAME) name ## _
-#endif
-
-
struct gmx_invsqrtdata
F77_FUNC(gmxinvsqrtdata,GMXINVSQRTDATA) =
#include "gmx_arpack.h"
-/* Default Fortran name mangling */
-#ifndef F77_FUNC
-#define F77_FUNC(name,NAME) name ## _
-#endif
-
-
-
static void
F77_FUNC(dstqrb,DSTQRB)(int * n,
double * d__,
};
-#ifdef GMX_FORTRAN
-
-/* NOTE: DO NOT USE THESE ANYWHERE IN GROMACS ITSELF.
- These are necessary for the backward-compatile io routines for 3d party
- tools */
-#define MAXID 256
-static FILE *xdrfiles[MAXID];
-static XDR *xdridptr[MAXID];
-static char xdrmodes[MAXID];
-static unsigned int cnt;
-#ifdef GMX_THREAD_MPI
-/* we need this because of the global variables above for FORTRAN binding.
- The I/O operations are going to be slow. */
-static tMPI_Thread_mutex_t xdr_fortran_mutex=TMPI_THREAD_MUTEX_INITIALIZER;
-#endif
-
-static void xdr_fortran_lock(void)
-{
-#ifdef GMX_THREAD_MPI
- tMPI_Thread_mutex_lock(&xdr_fortran_mutex);
-#endif
-}
-static void xdr_fortran_unlock(void)
-{
-#ifdef GMX_THREAD_MPI
- tMPI_Thread_mutex_unlock(&xdr_fortran_mutex);
-#endif
-}
-
-
-
-/* the open&close prototypes */
-static int xdropen(XDR *xdrs, const char *filename, const char *type);
-static int xdrclose(XDR *xdrs);
-
-typedef void (* F77_FUNC(xdrfproc,XDRFPROC))(int *, void *, int *);
-
-int ftocstr(char *ds, int dl, char *ss, int sl)
- /* dst, src ptrs */
- /* dst max len */
- /* src len */
-{
- char *p;
-
- p = ss + sl;
- while ( --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(char *ds, int dl, char *ss)
- /* dest space */
- /* max dest length */
- /* src string (0-term) */
-{
- while (dl && *ss) {
- *ds++ = *ss++;
- dl--;
- }
- while (dl--)
- *ds++ = ' ';
- return 0;
-}
-
-void
-F77_FUNC(xdrfbool,XDRFBOOL)(int *xdrid, int *pb, int *ret)
-{
- xdr_fortran_lock();
- *ret = xdr_bool(xdridptr[*xdrid], pb);
- cnt += XDR_INT_SIZE;
- xdr_fortran_unlock();
-}
-
-void
-F77_FUNC(xdrfchar,XDRFCHAR)(int *xdrid, char *cp, int *ret)
-{
- xdr_fortran_lock();
- *ret = xdr_char(xdridptr[*xdrid], cp);
- cnt += sizeof(char);
- xdr_fortran_unlock();
-}
-
-void
-F77_FUNC(xdrfdouble,XDRFDOUBLE)(int *xdrid, double *dp, int *ret)
-{
- xdr_fortran_lock();
- *ret = xdr_double(xdridptr[*xdrid], dp);
- cnt += sizeof(double);
- xdr_fortran_unlock();
-}
-
-void
-F77_FUNC(xdrffloat,XDRFFLOAT)(int *xdrid, float *fp, int *ret)
-{
- xdr_fortran_lock();
- *ret = xdr_float(xdridptr[*xdrid], fp);
- cnt += sizeof(float);
- xdr_fortran_unlock();
-}
-
-void
-F77_FUNC(xdrfint,XDRFINT)(int *xdrid, int *ip, int *ret)
-{
- xdr_fortran_lock();
- *ret = xdr_int(xdridptr[*xdrid], ip);
- cnt += XDR_INT_SIZE;
- xdr_fortran_unlock();
-}
-
-void
-F77_FUNC(xdrfshort,XDRFSHORT)(int *xdrid, short *sp, int *ret)
-{
- xdr_fortran_lock();
- *ret = xdr_short(xdridptr[*xdrid], sp);
- cnt += sizeof(sp);
- xdr_fortran_unlock();
-}
-
-void
-F77_FUNC(xdrfuchar,XDRFUCHAR)(int *xdrid, unsigned char *ucp, int *ret)
-{
- xdr_fortran_lock();
- *ret = xdr_u_char(xdridptr[*xdrid], (u_char *)ucp);
- cnt += sizeof(char);
- xdr_fortran_unlock();
-}
-
-
-void
-F77_FUNC(xdrfushort,XDRFUSHORT)(int *xdrid, unsigned short *usp, int *ret)
-{
- xdr_fortran_lock();
- *ret = xdr_u_short(xdridptr[*xdrid], (unsigned short *)usp);
- cnt += sizeof(unsigned short);
- xdr_fortran_unlock();
-}
-
-void
-F77_FUNC(xdrf3dfcoord,XDRF3DFCOORD)(int *xdrid, float *fp, int *size, float *precision, int *ret)
-{
- xdr_fortran_lock();
- *ret = xdr3dfcoord(xdridptr[*xdrid], fp, size, precision);
- xdr_fortran_unlock();
-}
-
-void
-F77_FUNC(xdrfstring,XDRFSTRING)(int *xdrid, char * sp_ptr,
- int *maxsize, int *ret, int sp_len)
-{
- char *tsp;
-
- xdr_fortran_lock();
- tsp = (char*) malloc((size_t)(((sp_len) + 1) * sizeof(char)));
- if (tsp == NULL) {
- *ret = -1;
- return;
- }
- if (ftocstr(tsp, *maxsize+1, sp_ptr, sp_len)) {
- *ret = -1;
- free(tsp);
- xdr_fortran_unlock();
- return;
- }
- *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (unsigned int) *maxsize);
- ctofstr( sp_ptr, sp_len , tsp);
- cnt += *maxsize;
- free(tsp);
- xdr_fortran_unlock();
-}
-
-void
-F77_FUNC(xdrfwrapstring,XDRFWRAPSTRING)(int *xdrid, char *sp_ptr,
- int *ret, int sp_len)
-{
- char *tsp;
- int maxsize;
-
- xdr_fortran_lock();
- maxsize = (sp_len) + 1;
- tsp = (char*) malloc((size_t)(maxsize * sizeof(char)));
- if (tsp == NULL) {
- *ret = -1;
- return;
- xdr_fortran_unlock();
- }
- if (ftocstr(tsp, maxsize, sp_ptr, sp_len)) {
- *ret = -1;
- free(tsp);
- return;
- xdr_fortran_unlock();
- }
- *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int)maxsize);
- ctofstr( sp_ptr, sp_len, tsp);
- cnt += maxsize;
- free(tsp);
- xdr_fortran_unlock();
-}
-
-void
-F77_FUNC(xdrfopaque,XDRFOPAQUE)(int *xdrid, caddr_t *cp, int *ccnt, int *ret)
-{
- xdr_fortran_lock();
- *ret = xdr_opaque(xdridptr[*xdrid], (caddr_t)*cp, (u_int)*ccnt);
- cnt += *ccnt;
- xdr_fortran_unlock();
-}
-
-void
-F77_FUNC(xdrfsetpos,XDRFSETPOS)(int *xdrid, int *pos, int *ret)
-{
- xdr_fortran_lock();
- *ret = xdr_setpos(xdridptr[*xdrid], (u_int) *pos);
- xdr_fortran_unlock();
-}
-
-
-void
-F77_FUNC(xdrf,XDRF)(int *xdrid, int *pos)
-{
- xdr_fortran_lock();
- *pos = xdr_getpos(xdridptr[*xdrid]);
- xdr_fortran_unlock();
-}
-
-void
-F77_FUNC(xdrfvector,XDRFVECTOR)(int *xdrid, char *cp, int *size, F77_FUNC(xdrfproc,XDRFPROC) elproc, int *ret)
-{
- int lcnt;
- cnt = 0;
- xdr_fortran_lock();
- for (lcnt = 0; lcnt < *size; lcnt++) {
- elproc(xdrid, (cp+cnt) , ret);
- }
- xdr_fortran_unlock();
-}
-
-
-void
-F77_FUNC(xdrfclose,XDRFCLOSE)(int *xdrid, int *ret)
-{
- xdr_fortran_lock();
- *ret = xdrclose(xdridptr[*xdrid]);
- cnt = 0;
- xdr_fortran_unlock();
-}
-
-void
-F77_FUNC(xdrfopen,XDRFOPEN)(int *xdrid, char *fp_ptr, char *mode_ptr,
- int *ret, int fp_len, int mode_len)
-{
- char fname[512];
- char fmode[3];
-
- xdr_fortran_lock();
- 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;
- xdr_fortran_unlock();
-}
-
-/*__________________________________________________________________________
- |
- | xdropen - open xdr file
- |
- | This versions differs from xdrstdio_create, because I need to know
- | the state of the file (read or write) and the file descriptor
- | so I can close the file (something xdr_destroy doesn't do).
- |
- | It assumes xdr_fortran_mutex is locked.
- |
- | NOTE: THIS FUNCTION IS NOW OBSOLETE AND ONLY PROVIDED FOR BACKWARD
- | COMPATIBILITY OF 3D PARTY TOOLS. IT SHOULD NOT BE USED ANYWHERE
- | IN GROMACS ITSELF.
-*/
-
-int xdropen(XDR *xdrs, const char *filename, const char *type) {
- static int init_done = 0;
- enum xdr_op lmode;
- int xdrid;
- char newtype[5];
-
-
-#ifdef GMX_THREAD_MPI
- if (!tMPI_Thread_mutex_trylock( &xdr_fortran_mutex ))
- {
- tMPI_Thread_mutex_unlock( &xdr_fortran_mutex );
- gmx_incons("xdropen called without locked mutex. NEVER call this function.");
- }
-#endif
-
- 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')
- {
- xdrmodes[xdrid] = 'w';
- strcpy(newtype, "wb+");
- lmode = XDR_ENCODE;
- }
- else if (*type == 'a' || *type == 'A')
- {
- xdrmodes[xdrid] = 'a';
- strcpy(newtype, "ab+");
- lmode = XDR_ENCODE;
- }
- else if (gmx_strncasecmp(type, "r+", 2) == 0)
- {
- xdrmodes[xdrid] = 'a';
- strcpy(newtype, "rb+");
- lmode = XDR_ENCODE;
- }
- else
- {
- xdrmodes[xdrid] = 'r';
- strcpy(newtype, "rb");
- lmode = XDR_DECODE;
- }
- xdrfiles[xdrid] = fopen(filename, newtype);
-
- if (xdrfiles[xdrid] == NULL) {
- xdrs = NULL;
- return 0;
- }
-
- /* next test isn't useful 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((size_t)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).
- |
- | It assumes xdr_fortran_mutex is locked.
- |
- | NOTE: THIS FUNCTION IS NOW OBSOLETE AND ONLY PROVIDED FOR BACKWARD
- | COMPATIBILITY OF 3D PARTY TOOLS. IT SHOULD NOT BE USED ANYWHERE
- | IN GROMACS ITSELF.
-*/
-
-int xdrclose(XDR *xdrs) {
- int xdrid;
- int rc = 0;
-
-#ifdef GMX_THREAD_MPI
- if (!tMPI_Thread_mutex_trylock( &xdr_fortran_mutex ))
- {
- tMPI_Thread_mutex_unlock( &xdr_fortran_mutex );
- gmx_incons("xdropen called without locked mutex. NEVER call this function");
- }
-#endif
-
- if (xdrs == NULL) {
- fprintf(stderr, "xdrclose: passed a NULL pointer\n");
- exit(1);
- }
- for (xdrid = 1; xdrid < MAXID && rc==0; xdrid++) {
- if (xdridptr[xdrid] == xdrs) {
-
- xdr_destroy(xdrs);
- rc = fclose(xdrfiles[xdrid]);
- xdridptr[xdrid] = NULL;
- return !rc; /* xdr routines return 0 when ok */
- }
- }
- fprintf(stderr, "xdrclose: no such open xdr file\n");
- exit(1);
-
- /* to make some compilers happy: */
- return 0;
-}
-
-#endif /* GMX_FORTRAN */
-
-
/*___________________________________________________________________________
|
| what follows are the C routine to read/write compressed coordinates together
/* mopac interface routines */
-#ifndef F77_FUNC
-#define F77_FUNC(name,NAME) name ## _
-#endif
-
-
void
F77_FUNC(inigms,IMIGMS)(void);
/* mopac interface routines */
-
-#ifndef F77_FUNC
-#define F77_FUNC(name,NAME) name ## _
-#endif
-
-
void
F77_FUNC(domldt,DOMLDT)(int *nrqmat, int labels[], char keywords[]);
#include "sparsematrix.h"
#include "eigensolver.h"
-#ifndef F77_FUNC
-#define F77_FUNC(name,NAME) name ## _
-#endif
-
#include "gmx_lapack.h"
#include "gmx_arpack.h"
biod.pnpi.spb.ru / alexxy / gromacs.git / commitdiff