mirror of https://gitlab.com/QEF/q-e.git
Cleanup, removal of unused C subroutines
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@13602 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz
parent
f3be636b49
commit
36bad8b03a
|
|
@ -6,20 +6,24 @@
|
|||
! or http://www.gnu.org/copyleft/gpl.txt .
|
||||
!
|
||||
!
|
||||
! ... This module contains functions nd variables used to check if the code
|
||||
! ... should be smoothly stopped. In order to use this module, function
|
||||
! ... This module contains functions and variables used to check whether the
|
||||
! ... code should be smoothly stopped. In order to use this module, function
|
||||
! ... check_stop_init must be called (only once) at the beginning of the calc.
|
||||
! ... Function check_stop_now returns .TRUE. if either the user has created
|
||||
! ... an "exit" file, or if the elapsed wall time is larger than max_seconds,
|
||||
! ... or if these conditions have been met in a provious call of check_stop_now.
|
||||
! ... or if these conditions have been met in a previous call of check_stop_now.
|
||||
! ... Moreover, function check_stop_now removes the exit file and sets variable
|
||||
! ... stopped_by_user to .true..
|
||||
!
|
||||
! ... Uses routine f_wall defined in module mytime, returning time in seconds
|
||||
! ... since the Epoch ( 00:00:00 1/1/1970 )
|
||||
!
|
||||
!------------------------------------------------------------------------------!
|
||||
MODULE check_stop
|
||||
!------------------------------------------------------------------------------!
|
||||
!
|
||||
USE kinds
|
||||
USE mytime, ONLY: f_wall
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
|
|
@ -30,21 +34,16 @@ MODULE check_stop
|
|||
LOGICAL :: stopped_by_user = .FALSE.
|
||||
LOGICAL, PRIVATE :: tinit = .FALSE.
|
||||
!
|
||||
INTERFACE
|
||||
FUNCTION cclock ( ) BIND(C,name="cclock") RESULT(t)
|
||||
USE ISO_C_BINDING
|
||||
REAL(kind=c_double) :: t
|
||||
END FUNCTION cclock
|
||||
END INTERFACE
|
||||
CONTAINS
|
||||
!
|
||||
! ... internal procedures
|
||||
!
|
||||
!-----------------------------------------------------------------------
|
||||
SUBROUTINE check_stop_init()
|
||||
!!!SUBROUTINE check_stop_init( max_seconds_ )
|
||||
SUBROUTINE check_stop_init( )
|
||||
!-----------------------------------------------------------------------
|
||||
!
|
||||
USE input_parameters, ONLY : max_seconds_ => max_seconds
|
||||
USE input_parameters, ONLY : max_seconds_ => max_seconds
|
||||
USE io_global, ONLY : stdout
|
||||
USE io_files, ONLY : prefix, exit_file
|
||||
#if defined(__TRAP_SIGUSR1) || defined(__TERMINATE_GRACEFULLY)
|
||||
|
|
@ -52,6 +51,7 @@ MODULE check_stop
|
|||
#endif
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!!!INTEGER, INTENT(IN), OPTIONAL :: max_seconds_
|
||||
!
|
||||
IF ( tinit ) &
|
||||
WRITE( UNIT = stdout, &
|
||||
|
|
@ -62,8 +62,9 @@ MODULE check_stop
|
|||
exit_file = TRIM( prefix ) // '.EXIT'
|
||||
!
|
||||
IF ( max_seconds_ > 0.0_DP ) max_seconds = max_seconds_
|
||||
!!! IF ( PRESENT(max_seconds_) ) max_seconds = max_seconds_
|
||||
!
|
||||
init_second = cclock()
|
||||
init_second = f_wall()
|
||||
tinit = .TRUE.
|
||||
!
|
||||
#if defined(__TRAP_SIGUSR1) || defined(__TERMINATE_GRACEFULLY)
|
||||
|
|
@ -100,9 +101,6 @@ MODULE check_stop
|
|||
RETURN
|
||||
END IF
|
||||
!
|
||||
! ... cclock is a C function returning the elapsed solar
|
||||
! ... time in seconds since the Epoch ( 00:00:00 1/1/1970 )
|
||||
!
|
||||
IF ( .NOT. tinit ) &
|
||||
CALL errore( 'check_stop_now', 'check_stop not initialized', 1 )
|
||||
!
|
||||
|
|
@ -138,7 +136,7 @@ MODULE check_stop
|
|||
CLOSE( UNIT = iunexit, STATUS = 'DELETE' )
|
||||
!
|
||||
ELSE
|
||||
seconds = cclock() - init_second
|
||||
seconds = f_wall() - init_second
|
||||
check_stop_now = ( seconds > max_seconds )
|
||||
END IF
|
||||
!
|
||||
|
|
|
|||
|
|
@ -52,14 +52,14 @@ MODULE mytime
|
|||
INTEGER :: trace_depth = 0
|
||||
#endif
|
||||
INTERFACE
|
||||
FUNCTION cclock ( ) BIND(C,name="cclock") RESULT(t)
|
||||
FUNCTION f_wall ( ) BIND(C,name="cclock") RESULT(t)
|
||||
USE ISO_C_BINDING
|
||||
REAL(kind=c_double) :: t
|
||||
END FUNCTION cclock
|
||||
FUNCTION scnds ( ) BIND(C,name="scnds") RESULT(t)
|
||||
END FUNCTION f_wall
|
||||
FUNCTION f_tcpu ( ) BIND(C,name="scnds") RESULT(t)
|
||||
USE ISO_C_BINDING
|
||||
REAL(kind=c_double) :: t
|
||||
END FUNCTION scnds
|
||||
END FUNCTION f_tcpu
|
||||
END INTERFACE
|
||||
CONTAINS
|
||||
!
|
||||
|
|
@ -110,7 +110,7 @@ SUBROUTINE start_clock( label )
|
|||
USE mytime, ONLY : trace_depth
|
||||
#endif
|
||||
USE mytime, ONLY : nclock, clock_label, notrunning, no, maxclock, &
|
||||
t0cpu, t0wall, cclock, scnds
|
||||
t0cpu, t0wall, f_wall, f_tcpu
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
|
|
@ -141,8 +141,8 @@ SUBROUTINE start_clock( label )
|
|||
! WRITE( stdout, '("start_clock: clock # ",I2," for ",A12, &
|
||||
! & " already started")' ) n, label_
|
||||
ELSE
|
||||
t0cpu(n) = scnds()
|
||||
t0wall(n) = cclock()
|
||||
t0cpu(n) = f_tcpu()
|
||||
t0wall(n)= f_wall()
|
||||
ENDIF
|
||||
!
|
||||
RETURN
|
||||
|
|
@ -161,8 +161,8 @@ SUBROUTINE start_clock( label )
|
|||
!
|
||||
nclock = nclock + 1
|
||||
clock_label(nclock) = label_
|
||||
t0cpu(nclock) = scnds()
|
||||
t0wall(nclock) = cclock()
|
||||
t0cpu(nclock) = f_tcpu()
|
||||
t0wall(nclock) = f_wall()
|
||||
!
|
||||
ENDIF
|
||||
!
|
||||
|
|
@ -181,7 +181,7 @@ SUBROUTINE stop_clock( label )
|
|||
USE mytime, ONLY : trace_depth
|
||||
#endif
|
||||
USE mytime, ONLY : no, nclock, clock_label, cputime, walltime, &
|
||||
notrunning, called, t0cpu, t0wall, cclock, scnds
|
||||
notrunning, called, t0cpu, t0wall, f_wall, f_tcpu
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
|
|
@ -215,8 +215,8 @@ SUBROUTINE stop_clock( label )
|
|||
!
|
||||
ELSE
|
||||
!
|
||||
cputime(n) = cputime(n) + scnds() - t0cpu(n)
|
||||
walltime(n) = walltime(n) + cclock() - t0wall(n)
|
||||
cputime(n) = cputime(n) + f_tcpu() - t0cpu(n)
|
||||
walltime(n) = walltime(n)+ f_wall() - t0wall(n)
|
||||
t0cpu(n) = notrunning
|
||||
t0wall(n) = notrunning
|
||||
called(n) = called(n) + 1
|
||||
|
|
@ -292,7 +292,7 @@ SUBROUTINE print_this_clock( n )
|
|||
USE kinds, ONLY : DP
|
||||
USE io_global, ONLY : stdout
|
||||
USE mytime, ONLY : clock_label, cputime, walltime, &
|
||||
notrunning, called, t0cpu, t0wall, cclock, scnds
|
||||
notrunning, called, t0cpu, t0wall, f_wall, f_tcpu
|
||||
!
|
||||
! ... See comments below about parallel case
|
||||
!
|
||||
|
|
@ -317,8 +317,8 @@ SUBROUTINE print_this_clock( n )
|
|||
!
|
||||
! ... clock not stopped, print the current value of the cpu time
|
||||
!
|
||||
elapsed_cpu_time = cputime(n) + scnds() - t0cpu(n)
|
||||
elapsed_wall_time = walltime(n) + cclock() - t0wall(n)
|
||||
elapsed_cpu_time = cputime(n) + f_tcpu() - t0cpu(n)
|
||||
elapsed_wall_time = walltime(n)+ f_wall() - t0wall(n)
|
||||
called(n) = called(n) + 1
|
||||
!
|
||||
ENDIF
|
||||
|
|
@ -433,7 +433,7 @@ FUNCTION get_clock( label )
|
|||
!
|
||||
USE kinds, ONLY : DP
|
||||
USE mytime, ONLY : no, nclock, clock_label, walltime, &
|
||||
notrunning, t0wall, t0cpu, cclock
|
||||
notrunning, t0wall, t0cpu, f_wall
|
||||
!
|
||||
! ... See comments in subroutine print_this_clock about parallel case
|
||||
!
|
||||
|
|
@ -450,7 +450,7 @@ FUNCTION get_clock( label )
|
|||
!
|
||||
IF ( label == clock_label(1) ) THEN
|
||||
!
|
||||
get_clock = cclock()
|
||||
get_clock = f_wall()
|
||||
!
|
||||
ELSE
|
||||
!
|
||||
|
|
@ -472,7 +472,7 @@ FUNCTION get_clock( label )
|
|||
!
|
||||
ELSE
|
||||
!
|
||||
get_clock = walltime(n) + cclock() - t0wall(n)
|
||||
get_clock = walltime(n) + f_wall() - t0wall(n)
|
||||
!
|
||||
ENDIF
|
||||
!
|
||||
|
|
|
|||
|
|
@ -9,7 +9,6 @@ c_mkdir.o \
|
|||
copy.o \
|
||||
cptimer.o \
|
||||
eval_infix.o \
|
||||
indici.o \
|
||||
md5.o \
|
||||
md5_from_file.o \
|
||||
memstat.o \
|
||||
|
|
|
|||
182
clib/indici.c
182
clib/indici.c
|
|
@ -1,182 +0,0 @@
|
|||
/*
|
||||
Copyright (C) 2002 FPMD group
|
||||
This file is distributed under the terms of the
|
||||
GNU General Public License. See the file `License'
|
||||
in the root directory of the present distribution,
|
||||
or http://www.gnu.org/copyleft/gpl.txt .
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
#include "c_defs.h"
|
||||
|
||||
#define MAX_INDEX 32768
|
||||
|
||||
struct Index { unsigned char i[8]; } ;
|
||||
|
||||
static struct Index * P_Index;
|
||||
static int * P_IndexIndex;
|
||||
|
||||
static struct Index * LN;
|
||||
static int * IG;
|
||||
static int LN_SIZE;
|
||||
|
||||
int IndexCmp( struct Index * A, struct Index * B)
|
||||
{
|
||||
int i;
|
||||
|
||||
for(i = 7; i>=0 ; i--) {
|
||||
if(A->i[i] > B->i[i] ) {
|
||||
return +1;
|
||||
}
|
||||
else if(A->i[i] < B->i[i]) {
|
||||
return -1;
|
||||
}
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
int index_comp(unsigned i,unsigned j)
|
||||
{
|
||||
int cmp;
|
||||
cmp = IndexCmp(P_Index + i, P_Index + j);
|
||||
if ( cmp > 0 ) return 1;
|
||||
else if ( cmp == 0 ) return 0;
|
||||
return -1;
|
||||
}
|
||||
|
||||
int index_swap(unsigned i,unsigned j)
|
||||
{
|
||||
static struct Index tmp;
|
||||
static int itmp;
|
||||
|
||||
tmp = P_Index[j] ;
|
||||
P_Index[j] = P_Index[i] ;
|
||||
P_Index[i] = tmp ;
|
||||
|
||||
itmp = P_IndexIndex[j] ;
|
||||
P_IndexIndex[j] = P_IndexIndex[i] ;
|
||||
P_IndexIndex[i] = itmp ;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
int IndexSort(struct Index * A, int * IndexIndex, int n)
|
||||
{
|
||||
void Qsort(unsigned n,int (*comp)(),int (*swap)());
|
||||
P_Index = A;
|
||||
P_IndexIndex = IndexIndex;
|
||||
Qsort((unsigned)n,index_comp,index_swap);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
int IndexSet( struct Index * A, int I1, int I2, int I3 )
|
||||
{
|
||||
unsigned int himask = 0xFF00;
|
||||
unsigned int lomask = 0x00FF;
|
||||
|
||||
if(abs(I1)>=MAX_INDEX || abs(I2)>=MAX_INDEX || abs(I3)>=MAX_INDEX ) {
|
||||
return -1;
|
||||
}
|
||||
|
||||
if(I1<0) I1 += MAX_INDEX;
|
||||
if(I2<0) I2 += MAX_INDEX;
|
||||
if(I3<0) I3 += MAX_INDEX;
|
||||
|
||||
|
||||
A->i[7] = (unsigned char ) 0;
|
||||
A->i[6] = (unsigned char ) 0;
|
||||
A->i[5] = (unsigned char ) ((himask & (unsigned int) I1)>>8);
|
||||
A->i[4] = (unsigned char ) ( lomask & (unsigned int) I1);
|
||||
A->i[3] = (unsigned char ) ((himask & (unsigned int) I2)>>8);
|
||||
A->i[2] = (unsigned char ) ( lomask & (unsigned int) I2);
|
||||
A->i[1] = (unsigned char ) ((himask & (unsigned int) I3)>>8);
|
||||
A->i[0] = (unsigned char ) ( lomask & (unsigned int) I3);
|
||||
return 0;
|
||||
}
|
||||
|
||||
int IndexShow(struct Index A)
|
||||
{
|
||||
int i;
|
||||
for(i=7;i>=0;i--) printf("%2x",A.i[i]);
|
||||
printf("\n");
|
||||
return 0;
|
||||
}
|
||||
|
||||
int IndexFind(struct Index * A, int n, struct Index * B)
|
||||
{
|
||||
int lb, ub, i, cmp;
|
||||
|
||||
lb = 0;
|
||||
ub = n-1;
|
||||
i = lb;
|
||||
|
||||
while(lb<(ub-1)) {
|
||||
i = lb + (ub - lb)/2;
|
||||
cmp = IndexCmp(B,&A[i]);
|
||||
if(cmp>0) {
|
||||
lb = i;
|
||||
} else if(cmp<0) {
|
||||
ub = i;
|
||||
} else {
|
||||
ub = lb = i;
|
||||
}
|
||||
}
|
||||
if(lb<ub) {
|
||||
cmp = IndexCmp(B,&A[lb]);
|
||||
if(cmp) {
|
||||
i = ub;
|
||||
} else {
|
||||
i = lb;
|
||||
}
|
||||
}
|
||||
|
||||
if ( IndexCmp(B,&A[i]) ) return -1;
|
||||
|
||||
return i;
|
||||
}
|
||||
|
||||
void F77_FUNC_(ln_alloc,LN_ALLOC)(int * LN_DIM)
|
||||
{
|
||||
LN_SIZE = * LN_DIM;
|
||||
LN = ( struct Index *) malloc ( LN_SIZE * sizeof( struct Index ));
|
||||
IG = ( int *) malloc ( LN_SIZE * sizeof( int ));
|
||||
}
|
||||
|
||||
void F77_FUNC_(ln_dealloc,LN_DEALLOC)(void )
|
||||
{
|
||||
free((void *)LN);
|
||||
free((void *)IG);
|
||||
}
|
||||
|
||||
void F77_FUNC_(ln_set,LN_SET)(int * IRI1, int * IRI2, int * IRI3, int * ig)
|
||||
{
|
||||
if( *ig<1 || *ig > LN_SIZE) {
|
||||
exit(*ig);
|
||||
}
|
||||
IndexSet( &LN[*ig-1], *IRI1, *IRI2, *IRI3 );
|
||||
IG[*ig-1] = *ig;
|
||||
|
||||
}
|
||||
|
||||
int F77_FUNC_(ln_activate,LN_ACTIVATE)()
|
||||
{
|
||||
IndexSort(LN,IG,LN_SIZE);
|
||||
return 0;
|
||||
}
|
||||
|
||||
int F77_FUNC_(ln_ind,LN_IND)(int * IRI1, int * IRI2, int * IRI3)
|
||||
{
|
||||
static struct Index B;
|
||||
static int ib;
|
||||
|
||||
IndexSet(&B,*IRI1,*IRI2,*IRI3);
|
||||
ib = IndexFind(LN,LN_SIZE,&B);
|
||||
if(ib>=0) return IG[ib];
|
||||
return -1;
|
||||
}
|
||||
Loading…
Reference in New Issue