Project

General

Profile

fortranpatch.diff

fortran patch. - Sander Pronk, 07/22/2010 02:15 PM

View differences:

src/gmxlib/libxdrf.c
64 64

  
65 65

  
66 66

  
67
#ifndef GMX_THREADS
67

  
68

  
69
#ifdef GMX_FORTRAN
68 70

  
69 71
/* NOTE: DO NOT USE THESE ANYWHERE IN GROMACS ITSELF. 
70 72
   These are necessary for the backward-compatile io routines for 3d party
......
74 76
static XDR *xdridptr[MAXID];
75 77
static char xdrmodes[MAXID];
76 78
static unsigned int cnt;
79
#ifdef GMX_THREADS
80
/* we need this because of the global variables above for FORTRAN binding. 
81
   The I/O operations are going to be slow. */
82
static tMPI_Thread_mutex_t xdr_fortran_mutex=TMPI_THREAD_MUTEX_INITIALIZER;
83
#endif
77 84

  
85
static void xdr_fortran_lock(void)
86
{
87
#ifdef GMX_THREADS
88
    tMPI_Thread_mutex_lock(&xdr_fortran_mutex);
78 89
#endif
90
}
91
static void xdr_fortran_unlock(void)
92
{
93
#ifdef GMX_THREADS
94
    tMPI_Thread_mutex_unlock(&xdr_fortran_mutex);
95
#endif
96
}
79 97

  
80
#ifdef GMX_FORTRAN
81 98

  
82 99

  
83 100
/* the open&close prototypes */
84
int xdropen(XDR *xdrs, const char *filename, const char *type);
85
int xdrclose(XDR *xdrs);
101
static int xdropen(XDR *xdrs, const char *filename, const char *type);
102
static int xdrclose(XDR *xdrs);
86 103

  
87 104
typedef void (* F77_FUNC(xdrfproc,XDRFPROC))(int *, void *, int *);
88 105

  
......
124 141
void
125 142
F77_FUNC(xdrfbool,XDRFBOOL)(int *xdrid, int *pb, int *ret) 
126 143
{
144
        xdr_fortran_lock();
127 145
	*ret = xdr_bool(xdridptr[*xdrid], pb);
128 146
	cnt += XDR_INT_SIZE;
147
        xdr_fortran_unlock();
129 148
}
130 149

  
131 150
void
132 151
F77_FUNC(xdrfchar,XDRFCHAR)(int *xdrid, char *cp, int *ret)
133 152
{
153
        xdr_fortran_lock();
134 154
	*ret = xdr_char(xdridptr[*xdrid], cp);
135 155
	cnt += sizeof(char);
156
        xdr_fortran_unlock();
136 157
}
137 158

  
138 159
void
139 160
F77_FUNC(xdrfdouble,XDRFDOUBLE)(int *xdrid, double *dp, int *ret)
140 161
{
162
        xdr_fortran_lock();
141 163
	*ret = xdr_double(xdridptr[*xdrid], dp);
142 164
	cnt += sizeof(double);
165
        xdr_fortran_unlock();
143 166
}
144 167

  
145 168
void
146 169
F77_FUNC(xdrffloat,XDRFFLOAT)(int *xdrid, float *fp, int *ret)
147 170
{
171
        xdr_fortran_lock();
148 172
	*ret = xdr_float(xdridptr[*xdrid], fp);
149 173
	cnt += sizeof(float);
174
        xdr_fortran_unlock();
150 175
}
151 176

  
152 177
void
153 178
F77_FUNC(xdrfint,XDRFINT)(int *xdrid, int *ip, int *ret)
154 179
{
180
        xdr_fortran_lock();
155 181
	*ret = xdr_int(xdridptr[*xdrid], ip);
156 182
	cnt += XDR_INT_SIZE;
183
        xdr_fortran_unlock();
157 184
}
158 185

  
159 186
F77_FUNC(xdrfshort,XDRFSHORT)(int *xdrid, short *sp, int *ret)
160 187
{
188
        xdr_fortran_lock();
161 189
	*ret = xdr_short(xdridptr[*xdrid], sp);
162 190
  	cnt += sizeof(sp);
191
        xdr_fortran_unlock();
163 192
}
164 193

  
165 194
void
166 195
F77_FUNC(xdrfuchar,XDRFUCHAR)(int *xdrid, unsigned char *ucp, int *ret)
167 196
{
197
        xdr_fortran_lock();
168 198
	*ret = xdr_u_char(xdridptr[*xdrid], (u_char *)ucp);
169 199
	cnt += sizeof(char);
200
        xdr_fortran_unlock();
170 201
}
171 202

  
172 203

  
173 204
void
174 205
F77_FUNC(xdrfushort,XDRFUSHORT)(int *xdrid, unsigned short *usp, int *ret)
175 206
{
207
        xdr_fortran_lock();
176 208
	*ret = xdr_u_short(xdridptr[*xdrid], (unsigned short *)usp);
177 209
	cnt += sizeof(unsigned short);
210
        xdr_fortran_unlock();
178 211
}
179 212

  
180 213
void 
181 214
F77_FUNC(xdrf3dfcoord,XDRF3DFCOORD)(int *xdrid, float *fp, int *size, float *precision, int *ret)
182 215
{
216
        xdr_fortran_lock();
183 217
	*ret = xdr3dfcoord(xdridptr[*xdrid], fp, size, precision);
218
        xdr_fortran_unlock();
184 219
}
185 220

  
186 221
void
......
189 224
{
190 225
	char *tsp;
191 226

  
227
        xdr_fortran_lock();
192 228
	tsp = (char*) malloc((size_t)(((sp_len) + 1) * sizeof(char)));
193 229
	if (tsp == NULL) {
194 230
	    *ret = -1;
......
197 233
	if (ftocstr(tsp, *maxsize+1, sp_ptr, sp_len)) {
198 234
	    *ret = -1;
199 235
	    free(tsp);
236
            xdr_fortran_unlock();
200 237
	    return;
201 238
	}
202 239
        *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (unsigned int) *maxsize);
203 240
	ctofstr( sp_ptr, sp_len , tsp);
204 241
	cnt += *maxsize;
205 242
	free(tsp);
243
        xdr_fortran_unlock();
206 244
}
207 245

  
208 246
void
......
211 249
{
212 250
	char *tsp;
213 251
	int maxsize;
252

  
253
        xdr_fortran_lock();
214 254
	maxsize = (sp_len) + 1;
215 255
	tsp = (char*) malloc((size_t)(maxsize * sizeof(char)));
216 256
	if (tsp == NULL) {
217 257
	    *ret = -1;
218 258
	    return;
259
            xdr_fortran_unlock();
219 260
	}
220 261
	if (ftocstr(tsp, maxsize, sp_ptr, sp_len)) {
221 262
	    *ret = -1;
222 263
	    free(tsp);
223 264
	    return;
265
            xdr_fortran_unlock();
224 266
	}
225 267
	*ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int)maxsize);
226 268
	ctofstr( sp_ptr, sp_len, tsp);
227 269
	cnt += maxsize;
228 270
	free(tsp);
271
        xdr_fortran_unlock();
229 272
}
230 273

  
231 274
void
232 275
F77_FUNC(xdrfopaque,XDRFOPAQUE)(int *xdrid, caddr_t *cp, int *ccnt, int *ret)
233 276
{
277
        xdr_fortran_lock();
234 278
	*ret = xdr_opaque(xdridptr[*xdrid], (caddr_t)*cp, (u_int)*ccnt);
235 279
	cnt += *ccnt;
280
        xdr_fortran_unlock();
236 281
}
237 282

  
238 283
void
239 284
F77_FUNC(xdrfsetpos,XDRFSETPOS)(int *xdrid, int *pos, int *ret)
240 285
{
286
        xdr_fortran_lock();
241 287
	*ret = xdr_setpos(xdridptr[*xdrid], (u_int) *pos);
288
        xdr_fortran_unlock();
242 289
}
243 290

  
244 291

  
245 292
void
246 293
F77_FUNC(xdrf,XDRF)(int *xdrid, int *pos)
247 294
{
295
        xdr_fortran_lock();
248 296
	*pos = xdr_getpos(xdridptr[*xdrid]);
297
        xdr_fortran_unlock();
249 298
}
250 299

  
251 300
void
......
253 302
{
254 303
	int lcnt;
255 304
	cnt = 0;
305
        xdr_fortran_lock();
256 306
	for (lcnt = 0; lcnt < *size; lcnt++) {
257 307
		elproc(xdrid, (cp+cnt) , ret);
258 308
	}
309
        xdr_fortran_unlock();
259 310
}
260 311

  
261 312

  
262 313
void
263 314
F77_FUNC(xdrfclose,XDRFCLOSE)(int *xdrid, int *ret)
264 315
{
316
        xdr_fortran_lock();
265 317
	*ret = xdrclose(xdridptr[*xdrid]);
266 318
	cnt = 0;
319
        xdr_fortran_unlock();
267 320
}
268 321

  
269 322
void
......
273 326
	char fname[512];
274 327
	char fmode[3];
275 328

  
329
        xdr_fortran_lock();
276 330
	if (ftocstr(fname, sizeof(fname), fp_ptr, fp_len)) {
277 331
		*ret = 0;
278 332
	}
......
286 340
		*ret = 0;
287 341
	else 
288 342
		*ret = 1;	
343
        xdr_fortran_unlock();
289 344
}
290
#endif /* GMX_FORTRAN */
291 345

  
292
#ifndef GMX_THREADS
293 346
/*__________________________________________________________________________
294 347
 |
295 348
 | xdropen - open xdr file
......
298 351
 | the state of the file (read or write)  and the file descriptor
299 352
 | so I can close the file (something xdr_destroy doesn't do).
300 353
 |
354
 | It assumes xdr_fortran_mutex is locked.
355
 |
301 356
 | NOTE: THIS FUNCTION IS NOW OBSOLETE AND ONLY PROVIDED FOR BACKWARD
302 357
 |       COMPATIBILITY OF 3D PARTY TOOLS. IT SHOULD NOT BE USED ANYWHERE 
303 358
 |       IN GROMACS ITSELF. 
......
308 363
    enum xdr_op lmode;
309 364
    int xdrid;
310 365
    char newtype[5];
311
	
366

  
367
    if (!tMPI_Thread_mutex_islocked( &xdr_fortran_mutex ))  
368
        gmx_incons("xdropen called without locked mutex. NEVER call this function");
369

  
312 370
    if (init_done == 0) {
313 371
	for (xdrid = 1; xdrid < MAXID; xdrid++) {
314 372
	    xdridptr[xdrid] = NULL;
......
375 433
 | It also closes the associated file descriptor (this is *not*
376 434
 | done by xdr_destroy).
377 435
 |
436
 | It assumes xdr_fortran_mutex is locked.
437
 |
378 438
 | NOTE: THIS FUNCTION IS NOW OBSOLETE AND ONLY PROVIDED FOR BACKWARD
379 439
 |       COMPATIBILITY OF 3D PARTY TOOLS. IT SHOULD NOT BE USED ANYWHERE 
380 440
 |       IN GROMACS ITSELF. 
......
384 444
    int xdrid;
385 445
    int rc = 0;
386 446

  
447
    if (!tMPI_Thread_mutex_islocked( &xdr_fortran_mutex ))  
448
        gmx_incons("xdropen called without locked mutex. NEVER call this function");
449

  
387 450
    if (xdrs == NULL) {
388 451
	fprintf(stderr, "xdrclose: passed a NULL pointer\n");
389 452
	exit(1);
......
404 467
    return 0;    
405 468
}
406 469

  
407
#endif
470
#endif /* GMX_FORTRAN */
408 471

  
409 472

  
410 473
/*___________________________________________________________________________