psblas2-dev:

Changelog
 base/internals/Makefile
 base/internals/avltree.c
 base/internals/avltree.h
 base/internals/psi_bld_tmphalo.f90
 base/internals/psi_fnd_owner.f90
 base/internals/psi_idx_cnv.f90
 base/internals/psi_idx_ins_cnv.f90
 base/internals/srcht.c
 base/modules/Makefile
 base/modules/psb_avl_mod.f90
 base/modules/psb_desc_type.f90
 base/tools/psb_cd_inloc.f90
 base/tools/psb_cdals.f90
 base/tools/psb_cdalv.f90
 base/tools/psb_cdins.f90
 base/tools/psb_icdasb.F90


Merged AVL changes.
psblas3-type-indexed
Salvatore Filippone 17 years ago
parent 44cffb0d36
commit d616b83f6f

@ -1,6 +1,14 @@
Changelog. A lot less detailed than usual, at least for past
history.
2008/03/27: Merged the experimental branch for implementing the AVL tree
data structure in Fortran instead of relying on C and passing
functions around to perform comparisons. There seems to be
some performance advantage, although not very large.
2008/03/25: Merged in changes from the 2.2-maint branch re: error
messages, performance bug in psi_idx_ins_cnv.
2008/02/26: New psb_linmap_init, psb_linmap_ins, psb_linmap_asb for a
general linear operator mapping among index spaces.

@ -6,7 +6,7 @@ FOBJS = psi_compute_size.o psi_crea_bnd_elem.o psi_crea_index.o \
psi_ldsc_pre_halo.o psi_bld_tmphalo.o psi_bld_hash.o\
psi_sort_dl.o psi_idx_cnv.o psi_idx_ins_cnv.o psi_fnd_owner.o
FOBJS2 = psi_exist_ovr_elem.o psi_list_search.o srtlist.o
COBJS = avltree.o srcht.o
#COBJS = avltree.o srcht.o
MPFOBJS = psi_dswapdata.o psi_dswaptran.o psi_iswapdata.o \
psi_iswaptran.o psi_desc_index.o \

@ -1,822 +0,0 @@
/*
* Parallel Sparse BLAS version 2.2
* (C) Copyright 2006/2007/2008
* Salvatore Filippone University of Rome Tor Vergata
* Alfredo Buttari University of Rome Tor Vergata
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions, and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. The name of the PSBLAS group or the names of its contributors may
* not be used to endorse or promote products derived from this
* software without specific written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
* TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
* BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
* CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
* SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
* INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
* CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*
*/
/*****************************************************************/
/* */
/* avltree.c: balanced AVL tree search and insertion */
/* written by: Salvatore Filippone */
/* */
/* Last updated: Mar 09 2004 */
/* */
/* Referrences: [1] D. E. Knuth */
/* The Art of Computer Programming */
/* Vol. 3: Sorting and Searching, sec. 6.2.3 */
/* Addison-Wesley */
/* */
/* General description: */
/* */
/* Build and maintain a balanced binary search tree with */
/* arbitrary keys. The user is responsible for providing */
/* compare functions operating on the keys themselves. */
/* Key pointers are stored into nodes that are managed */
/* by the subroutine calls; the user should never examine */
/* nodes directly. */
/* The nodes for user items are allocated in batches, */
/* and the batches are kept as a doubly linked list. */
/* */
/* Data types: */
/* AVLTree: structure containing pointers to the list */
/* of node batches and to the root of the binary tree */
/* structure */
/* */
/* AVLNode: binary tree node, containing link pointers */
/* a reserved field, and a pointer to user data */
/* */
/* */
/* User callable functions: */
/* */
/* AVLTreePtr GetAVLTree() */
/* Purpose: allocate a new tree; */
/* Function value: a fresh AVL tree pointer; */
/* returns NULL in case of a memory failure*/
/* */
/* */
/* int AVLTreeReInit(AVLTreePtr Tree) */
/* Purpose: reinitialize an existing AVL Tree, reusing */
/* node batches already allocated. */
/* Input: 1. Tree */
/* A pointer to an existing tree structure */
/* Function value: 0 Normal termination */
/* -1 Invalid input pointer */
/* -3 Memory allocation failure */
/* */
/* AVLNodePtr AVLTreeSearch(AVLTreePtr Tree, void *key, */
/* int (*comp)(void*, void*)) */
/* Purpose: search an existing AVL Tree for a key */
/* Input: 1. Tree */
/* A valid pointer to a Tree */
/* 2. key */
/* The item being searched for */
/* 3. comp */
/* A comparison function: */
/* a<b => comp(a,b)<0 */
/* a==b => comp(a,b)=0 */
/* a>b => comp(a,b)>0 */
/* The function is always invoked as: */
/* comp(user_key,tree_key); */
/* */
/* */
/* Function value: NULL: input error or item not found */
/* valid pointer: pointer to a node */
/* containing the key */
/* */
/* int AVLTreeInsert(AVLTreePtr Tree, void *key, */
/* int (*comp)(void*,void*), */
/* void (*update)(void*,void*,void*), */
/* void *data) */
/* Purpose: Insert an item into an existing (possibly */
/* empty) tree. */
/* */
/* Input: 1. Tree */
/* The (existing) tree */
/* 2. key */
/* The (new) item to be inserted */
/* 3. comp */
/* comparison function (as in AVLTreeSearch) */
/* 4. update */
/* A user provided function to be called when */
/* the key is already present in the tree */
/* with the calling sequence: */
/* update(new_key,existing_key) */
/* enables the user to specify an arbitrary */
/* update procedure. */
/* */
/* */
/* */
/* AVLNodePtr AVLTreeUserInsert(AVLTreePtr Tree, void *key, */
/* int (*comp)(void*,void*)) */
/* */
/* Purpose: Insert an item into an existing (possibly */
/* empty) tree; returns a pointer to a node */
/* containing the item, even when that node */
/* was already existing; does no update */
/* */
/* Input: 1. Tree */
/* The (existing) tree */
/* 2. key */
/* The (new) item to be inserted */
/* 3. comp */
/* comparison function (as in AVLTreeSearch) */
/* */
/* Function value: Valid pointer: pointer to a node */
/* containing the item (possibly */
/* was already there) */
/* NULL input error or memory failure */
/* */
/* */
/* int HowManyKeys(AVLTreePtr Tree) */
/* Purpose: how many keys does Tree contain? */
/* Function value: >=0 */
/* */
/* */
/* void AVLTreeInorderTraverse(AVLTreePtr Tree, */
/* void (*func)( void*, void*), void *data) */
/* */
/* Purpose: visit the nodes of the binary tree in their */
/* natural order, performing an arbitrary */
/* task upon visit. */
/* Input: 1. Tree */
/* A tree pointer */
/* 2. func */
/* A function performing a user specified */
/* task on each node; the fuction is invoked as */
/* func( key,data) */
/* where data is parm. 3 */
/* 3. data */
/* Auxiliary data to be passed to func upon */
/* each visit */
/* */
/* int AVLTreeInorderTraverseWithDelims(AVLTreePtr Tree, */
/* void *first, void *last, int (*comp)(void*,void*) */
/* void (*func)( void*, void*), void *data) */
/* */
/* Purpose: visit the nodes of the binary tree in their */
/* natural order, performing an arbitrary */
/* task upon visit, but only on nodes */
/* with their key within a specified range. */
/* */
/* Input: 1. Tree */
/* A tree pointer */
/* 2. first */
/* Visit nodes with first <= node->key */
/* 3. last */
/* Visit nodes with node->key <= last */
/* 4. comp */
/* comparison function (as in AVLTreeSearch) */
/* 5. func */
/* A function performing a user specified */
/* task on each node; the fuction is invoked as */
/* func( key,data) */
/* where data is parm. 3 */
/* 6. data */
/* Auxiliary data to be passed to func upon */
/* each visit */
/* Function value: total number of nodes visited (>=0) */
/* */
/* */
/* */
/* void AVLTreeFree(AVLTreePtr Tree, void (*ffree)(void*)) */
/* Purpose: free up tree data storage */
/* Does NOT free the Tree pointer itself, */
/* rather all the structures that it points to */
/* Input: 1. Tree */
/* A tree pointer */
/* 2. ffree */
/* A user specified function invoked on each */
/* key pointer contained in the tree to free */
/* its memory (if necessary). Can be NULL. */
/* */
/* */
/*****************************************************************/
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include "avltree.h"
#define POOLSIZE 1024
#define MAXSTACK 64
#define MAX(a,b) ((a)>=(b) ? (a) : (b))
typedef struct avltvect {
AVLNode pool[POOLSIZE];
int avail;
AVLTVectPtr previous, next;
} AVLTVect;
int HowManyItems(AVLTreePtr Tree)
{
if (Tree==NULL) {
return(0);
} else {
return(Tree->nnodes);
}
}
AVLTreePtr GetAVLTree()
{
AVLTreePtr tree;
if ((tree=(AVLTreePtr) malloc(sizeof(AVLTree)))!=NULL){
memset(tree,'\0',sizeof(AVLTree));
AVLTreeInit(tree);
}
return(tree);
}
int AVLTreeInit(AVLTreePtr Tree)
{
/* AVLTVectPtr current; */
if (Tree==NULL) {
fprintf(stderr,"Cannot initialize a NULL Tree pointer\n");
return(-1);
}
if (Tree->first!=NULL) {
fprintf(stderr,"Cannot initialize a nonempty Tree: call AVLTreeFree first\n");
return(-2);
}
/* if ((current=(AVLTVectPtr)malloc(sizeof(AVLTVect)))==NULL) { */
/* fprintf(stderr,"Memory allocation failure\n"); */
/* return(-3); */
/* } */
/* memset(current,'\0',sizeof(AVLTVect)); */
Tree->first=Tree->current=NULL;
Tree->nnodes=0;
Tree->root=NULL;
return(0);
}
int AVLTreeReInit(AVLTreePtr Tree)
{
AVLTVectPtr current /* , next */ ;
if (Tree==NULL) {
fprintf(stderr,"Cannot ReInitialize a NULL Tree pointer\n");
return(-1);
}
if (Tree->first!=NULL) {
current=Tree->first;
while (current!=NULL) {
current->avail=0;
memset(current->pool,'\0',POOLSIZE*sizeof(AVLNode));
current=current->next;
}
} else {
if ((current=(AVLTVectPtr)malloc(sizeof(AVLTVect)))==NULL) {
fprintf(stderr,"Memory allocation failure\n");
return(-3);
}
current->avail=0;
current->previous=current->next=NULL;
Tree->first=current;
}
Tree->current=Tree->first;
Tree->nnodes=0;
Tree->root=NULL;
return(0);
}
AVLNodePtr AVLTreeSearch(AVLTreePtr Tree, void *key,
int (*comp)(void *, void *))
{
AVLNodePtr current;
int icmp;
if (Tree==NULL) return(NULL);
current = Tree->root;
#ifdef PROFILE
Tree->nsteps=0;
#endif
while (current != NULL) {
icmp = (*comp)(key,current->key);
#ifdef PROFILE
Tree->nsteps +=1;
#endif
if (icmp<0) {
current = current->llink;
} else if (icmp==0){
return(current);
} else if (icmp>0) {
current = current->rlink;
}
}
return(current);
}
void AVLTreeInorderTraverse(AVLTreePtr Tree, void (*func)(void *, void *),
void *data)
{
int lev;
AVLNodePtr root;
AVLNodePtr stack[MAXSTACK+2];
int choice[MAXSTACK+2];
root=Tree->root;
if (root == NULL) return;
lev=0;
stack[lev] = root;
choice[lev] = -1;
while (lev>=0) {
if (stack[lev]==NULL) {
lev--;
} else {
if (choice[lev]==-1) {
stack[lev+1] = stack[lev]->llink;
choice[lev+1] = -1;
choice[lev] += 1;
lev++;
} else if (choice[lev]==0) {
(*func)(stack[lev]->key,data);
stack[lev+1] = stack[lev]->rlink;
choice[lev+1] = -1;
choice[lev] += 1;
lev++;
} else {
lev--;
}
}
}
}
int AVLTreeInorderTraverseWithDelims(AVLTreePtr Tree, void *first, void *last,
int (*comp)(void*, void*),
void (*func)(void *, void *),
void *data)
{
AVLNodePtr root, current;
int lev, nvisit, icmp;
AVLNodePtr stack[MAXSTACK+2];
int choice[MAXSTACK+2];
root=Tree->root;
if (root == NULL) return(0);
nvisit=0;
lev=0;
current = root;
while (current != NULL) {
stack[lev] = current;
icmp = (*comp)(first,current->key);
if (icmp<=0) {
choice[lev]=0;
current = current->llink;
} else if (icmp>0) {
current = current->rlink;
choice[lev]=1;
}
lev++;
}
lev--;
while (lev>=0) {
if (stack[lev]==NULL) {
lev--;
} else {
if (choice[lev]==-1) {
stack[lev+1] = stack[lev]->llink;
choice[lev+1] = -1;
choice[lev] += 1;
lev++;
} else if (choice[lev]==0) {
if (((*comp)(last,stack[lev]->key))<0) {
lev--;
} else {
(*func)(stack[lev]->key,data);
nvisit++;
stack[lev+1] = stack[lev]->rlink;
choice[lev+1] = -1;
choice[lev] += 1;
lev++;
}
} else {
lev--;
}
}
}
return(nvisit);
}
void AVLTreePreorderTraverse(AVLTreePtr Tree, void (*func)(void *, void *),
void *data)
{
AVLNodePtr root;
int lev;
AVLNodePtr stack[MAXSTACK+2];
int choice[MAXSTACK+2];
root=Tree->root;
if (root == NULL) return;
lev=0;
stack[lev] = root;
choice[lev] = -1;
while (lev>=0) {
if (stack[lev]==NULL) {
lev--;
} else {
if (choice[lev]==-1) {
(*func)(stack[lev]->key,data);
stack[lev+1] = stack[lev]->llink;
choice[lev+1] = -1;
choice[lev] += 1;
lev++;
} else if (choice[lev]==0) {
stack[lev+1] = stack[lev]->rlink;
choice[lev+1] = -1;
choice[lev] += 1;
lev++;
} else {
lev--;
}
}
}
}
void AVLTreeFree(AVLTreePtr Tree, void (*ffree)(void *))
{
AVLTVectPtr current, next;
int i;
if (Tree == NULL) return;
current=Tree->first;
while (current != NULL) {
next=current->next;
if (*ffree != NULL) {
for (i=0; i<current->avail; i++)
(*ffree)((current->pool[i]).key);
}
free(current);
current=next;
}
Tree->nnodes=0;
Tree->first=Tree->current=NULL;
return;
}
AVLNodePtr GetAVLNode(AVLTreePtr Tree)
{
AVLTVectPtr current, new;
AVLNodePtr newnode;
if (Tree==NULL) {
return(NULL);
}
if ((current=Tree->current)==NULL) {
if ((current=(AVLTVectPtr)malloc(sizeof(AVLTVect)))==NULL) {
fprintf(stderr,"Memory allocation failure\n");
return(NULL);
}
memset(current,'\0',sizeof(AVLTVect));
Tree->first=Tree->current=current;
}
while ((current->avail>=POOLSIZE)&&(current->next!=NULL))
current=current->next;
if (current->avail<POOLSIZE) {
newnode=&(current->pool[current->avail]);
current->avail += 1;
} else {
if ((new=(AVLTVectPtr)malloc(sizeof(AVLTVect)))==NULL) {
fprintf(stderr,"Memory allocation failure\n");
return(NULL);
}
memset(new,'\0',sizeof(AVLTVect));
newnode=&(new->pool[0]);
new->avail = 1;
current->next=new;
new->previous=current;
new->next=NULL;
Tree->current=new;
}
return(newnode);
}
int AVLTreeInsert(AVLTreePtr Tree, void *key,int (*comp)(void *, void *),
void (*update)(void *, void *, void *), void *data)
{
AVLNodePtr root, t, s, p, q, r;
int search, bal, icmp;
if (Tree==NULL) {
fprintf(stderr,"Fatal error: null tree pointer\n");
return(-1);
}
if ((root = Tree->root) == NULL) {
if ((t=GetAVLNode(Tree))==NULL) {
return(-2);
}
t->key = key;
t->rlink=t->llink=NULL;
t->bal=0;
Tree->root = t;
Tree->nnodes=1;
return(0);
}
t = NULL;
s = root;
p = root;
search=1;
while (search) {
icmp = (*comp)(key,p->key);
if (icmp<0) {
if ((q=p->llink)==NULL) {
if ((q=GetAVLNode(Tree))==NULL) {
return(-2);
}
p->llink=q;
search=0;
} else {
if (q->bal != 0) {
t=p;
s=q;
}
}
} else if (icmp == 0) {
(*update)(key,p->key,data);
return(1);
} else {
if ((q=p->rlink)==NULL) {
if ((q=GetAVLNode(Tree))==NULL) {
return(-2);
}
p->rlink=q;
search=0;
} else {
if (q->bal != 0) {
t=p;
s=q;
}
}
}
p=q;
}
q->key=key;
q->llink=q->rlink=NULL;
q->bal=0;
Tree->nnodes += 1;
if ((*comp)(key,s->key)<0) {
r=p=s->llink;
} else {
r=p=s->rlink;
}
while (p!=q) {
if ((*comp)(key,p->key)<0) {
p->bal=-1;
p = p->llink;
} else {
p->bal=1;
p=p->rlink;
}
}
if ((*comp)(key,s->key)<0) {
bal=-1;
} else {
bal=1;
}
if (s->bal == 0) {
s->bal=bal;
return (0);
} else if (s->bal == -bal) {
s->bal=0;
return (0);
} else if (s->bal == bal) {
if (r->bal == bal) {
/* single rotation */
p=r;
if (bal>0) {
s->rlink=r->llink;
r->llink=s;
} else {
s->llink=r->rlink;
r->rlink=s;
}
s->bal=r->bal=0;
} else if (r->bal == -bal) {
/* double rotation */
if (bal>0) {
p=r->llink;
r->llink=p->rlink;
p->rlink=r;
s->rlink=p->llink;
p->llink=s;
} else {
p=r->rlink;
r->rlink=p->llink;
p->llink=r;
s->llink=p->rlink;
p->rlink=s;
}
if (p->bal == bal) {
s->bal=-bal;
r->bal=0;
} else if (p->bal==0) {
s->bal=r->bal=0;
} else {
r->bal=bal;
s->bal=0;
}
p->bal=0;
}
if (t==NULL) {
root=p;
} else {
if (t->rlink==s) {
t->rlink=p;
} else {
t->llink=p;
}
}
Tree->root=root;
return(0);
}
return(0);
}
AVLNodePtr AVLTreeUserInsert(AVLTreePtr Tree, void *key,
int (*comp)(void *, void *))
{
AVLNodePtr root, t, s, p, q, r;
int search, bal, icmp;
if (Tree==NULL) {
fprintf(stderr,"Fatal error: null tree pointer\n");
return(NULL);
}
if ((root = Tree->root) == NULL) {
if ((t=GetAVLNode(Tree))==NULL) {
return(NULL);
}
t->key = key;
t->rlink=t->llink=NULL;
t->bal=0;
Tree->root = t;
Tree->nnodes=1;
return(t);
}
t = NULL;
s = root;
p = root;
search=1;
while (search) {
icmp = (*comp)(key,p->key);
if (icmp<0) {
if ((q=p->llink)==(AVLNodePtr) NULL) {
if ((q=GetAVLNode(Tree))==NULL) {
return(NULL);
}
p->llink=q;
search=0;
} else {
if (q->bal != 0) {
t=p;
s=q;
}
}
} else if (icmp == 0) {
return(p);
} else {
if ((q=p->rlink)==NULL) {
if ((q=GetAVLNode(Tree))==NULL) {
return(NULL);
}
p->rlink=q;
search=0;
} else {
if (q->bal != 0) {
t=p;
s=q;
}
}
}
p=q;
}
q->key=key;
q->llink=q->rlink=NULL;
q->bal=0;
Tree->nnodes += 1;
if ((*comp)(key,s->key)<0) {
r=p=s->llink;
} else {
r=p=s->rlink;
}
while (p!=q) {
if ((*comp)(key,p->key)<0) {
p->bal=-1;
p = p->llink;
} else {
p->bal=1;
p=p->rlink;
}
}
if ((*comp)(key,s->key)<0) {
bal=-1;
} else {
bal=1;
}
if (s->bal == 0) {
s->bal=bal;
return (q);
} else if (s->bal == -bal) {
s->bal=0;
return (q);
} else if (s->bal == bal) {
if (r->bal == bal) {
/* single rotation */
p=r;
if (bal>0) {
s->rlink=r->llink;
r->llink=s;
} else {
s->llink=r->rlink;
r->rlink=s;
}
s->bal=r->bal=0;
} else if (r->bal == -bal) {
/* double rotation */
if (bal>0) {
p=r->llink;
r->llink=p->rlink;
p->rlink=r;
s->rlink=p->llink;
p->llink=s;
} else {
p=r->rlink;
r->rlink=p->llink;
p->llink=r;
s->llink=p->rlink;
p->rlink=s;
}
if (p->bal == bal) {
s->bal=-bal;
r->bal=0;
} else if (p->bal==0) {
s->bal=r->bal=0;
} else {
r->bal=bal;
s->bal=0;
}
p->bal=0;
}
if (t==NULL) {
root=p;
} else {
if (t->rlink==s) {
t->rlink=p;
} else {
t->llink=p;
}
}
Tree->root=root;
return(q);
}
return(q);
}

@ -1,71 +0,0 @@
/*
* Parallel Sparse BLAS version 2.2
* (C) Copyright 2006/2007/2008
* Salvatore Filippone University of Rome Tor Vergata
* Alfredo Buttari University of Rome Tor Vergata
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions, and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. The name of the PSBLAS group or the names of its contributors may
* not be used to endorse or promote products derived from this
* software without specific written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
* TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
* BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
* CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
* SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
* INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
* CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*
*/
/* Type definitions for balanced AVL tree search and insertion */
/* See avltree.c for a full definition of the subroutines */
/* */
typedef struct avlnode *AVLNodePtr;
typedef struct avlnode {
AVLNodePtr llink,rlink;
int bal;
void *key;
} AVLNode;
typedef struct avltvect *AVLTVectPtr;
typedef struct avltree *AVLTreePtr;
typedef struct avltree {
AVLTVectPtr first, current;
AVLNodePtr root;
int nnodes;
#ifdef PROFILE
int nsteps;
#endif
} AVLTree;
AVLNodePtr AVLTreeSearch(AVLTreePtr, void *, int (*)(void *, void *));
AVLNodePtr GetAVLNode(AVLTreePtr);
int AVLTreeInit(AVLTreePtr);
int AVLTreeReInit(AVLTreePtr);
AVLTreePtr GetAVLTree();
int AVLTreeInsert(AVLTreePtr, void *, int (*)(void *, void *),
void (*)(void *, void *, void *), void *);
AVLNodePtr AVLTreeUserInsert(AVLTreePtr, void *, int (*)(void *, void *));
void AVLTreeInorderTraverse(AVLTreePtr, void (*)(void *, void *), void *);
void AVLTreePreorderTraverse(AVLTreePtr, void (*)(void *, void *), void *);
void AVLTreeFree(AVLTreePtr, void (*)(void *));
int HowManyItems(AVLTreePtr);
int AVLTreeInorderTraverseWithDelims(AVLTreePtr,void*, void*, int (*)(void*,void*),
void (*)(void *, void *), void *);

@ -103,6 +103,15 @@ subroutine psi_bld_tmphalo(desc,info)
end do
call psi_fnd_owner(nh,helem,hproc,desc,info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='fnd_owner')
goto 9999
endif
if (nh > size(hproc)) then
info=4010
call psb_errpush(4010,name,a_err='nh > size(hproc)')
goto 9999
end if
allocate(tmphl((3*((n_col-n_row)+1)+1)),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')

@ -146,6 +146,7 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
! Fifth, we extract the answers for our local query, and shift back the
! process indices to 0-based.
call psb_realloc(nv,iprc,info)
ih = hidx(me+1)
do i=1, hsz(me+1)

@ -204,6 +204,7 @@ subroutine psi_idx_cnv2(nv,idxin,idxout,desc,info,mask,owned)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_avl_mod
use psi_mod, psb_protect_name => psi_idx_cnv2
implicit none
integer, intent(in) :: nv, idxin(:)
@ -214,7 +215,7 @@ subroutine psi_idx_cnv2(nv,idxin,idxout,desc,info,mask,owned)
logical, intent(in), optional :: owned
integer :: i,ictxt,mglob, nglob
integer :: np, me
integer :: nrow,ncol, ip, err_act,lip
integer :: nrow,ncol, ip, err_act,lip, lipf
integer, parameter :: relocsz=200
character(len=20) :: name
logical, pointer :: mask_(:)
@ -300,7 +301,7 @@ subroutine psi_idx_cnv2(nv,idxin,idxout,desc,info,mask,owned)
idxout(i) = -1
cycle
endif
call SearchKeyVal(desc%ptree,ip,lip,info)
call SearchKey(desc%avltree,ip,lip,info)
if (owned_) then
if (lip<=nrow) then
idxout(i) = lip

@ -204,6 +204,7 @@ subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_avl_mod
use psi_mod
implicit none
integer, intent(in) :: nv, idxin(:)
@ -213,7 +214,7 @@ subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask)
logical, intent(in), optional, target :: mask(:)
integer :: i,ictxt,k,mglob, nglob
integer :: np, me, isize
integer :: pnt_halo,nrow,ncol, nh, ip, err_act,lip,nxt
integer :: pnt_halo,nrow,ncol, nh, ip, err_act,lip,nxt,lipf
logical :: pnt_h_ok
integer, parameter :: relocsz=200
character(len=20) :: name,ch_err
@ -285,7 +286,7 @@ subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask)
endif
nxt = ncol + 1
call SearchInsKeyVal(desc%ptree,ip,nxt,lip,info)
call SearchInsKey(desc%avltree,ip,lip,nxt,info)
if (info >=0) then
if (nxt == lip) then
ncol = nxt
@ -310,6 +311,7 @@ subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask)
goto 9999
end if
idxout(i) = lip
info = 0
else
idxout(i) = -1
end if

@ -1,446 +0,0 @@
/*
* Parallel Sparse BLAS version 2.2
* (C) Copyright 2006/2007/2008
* Salvatore Filippone University of Rome Tor Vergata
* Alfredo Buttari University of Rome Tor Vergata
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions, and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. The name of the PSBLAS group or the names of its contributors may
* not be used to endorse or promote products derived from this
* software without specific written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
* TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
* BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
* CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
* SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
* INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
* CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*
*/
/*****************************************************************/
/* */
/* srcht.c : specialized insert/search for (key,val) integer */
/* pairs. Written by: Salvatore Filippone */
/* */
/* Last updated: Mar 09 2004 */
/* */
/* Uses: avltree */
/* */
/* Data types: */
/* */
/* KeyType: struct with two integer fields, key and val. */
/* */
/* */
/* User callable functions: */
/* */
/* void InitPairSearchTree(int *iret) */
/* Purpose: initialize a search structure; */
/* Function value: 0: OK */
/* -1: failure */
/* */
/* */
/* void SearchInsKeyVal(int *key, int *val, int *res, */
/* int *iret) */
/* Purpose: Search for a key, insert it if not present. */
/* */
/* Input: 1. key */
/* Key to be searched for. */
/* 2. val */
/* Value to form a (key,val) pair to be */
/* inserted if key not already present. */
/* Output: 3. res */
/* The val part of the pair with key; if the */
/* key was freshly inserted then res=val */
/* Function value: 0 Normal termination */
/* 1 Key was already present. */
/* -1 Invalid input pointer */
/* -3 Memory allocation failure */
/* */
/* */
/* void FreePairSearchTree() */
/* Purpose: free up tree data storage */
/* */
/* */
/*****************************************************************/
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include "avltree.h"
#define POOLSIZE 4096
#define CACHESIZE 16
#ifdef LowerUnderscore
#define InitPairSearchTree initpairsearchtree_
#define FreePairSearchTree freepairsearchtree_
#define ClonePairSearchTree clonepairsearchtree_
#define SizeofPairSearchTree sizeofpairsearchtree_
#define SearchInsKeyVal searchinskeyval_
#define SearchKeyVal searchkeyval_
#define NPairs npairs_
#endif
#ifdef LowerDoubleUnderscore
#define InitPairSearchTree initpairsearchtree_
#define FreePairSearchTree freepairsearchtree_
#define ClonePairSearchTree clonepairsearchtree_
#define SizeofPairSearchTree sizeofpairsearchtree_
#define SearchInsKeyVal searchinskeyval_
#define SearchKeyVal searchkeyval_
#define NPairs npairs_
#endif
#ifdef LowerCase
#define InitPairSearchTree initpairsearchtree
#define FreePairSearchTree freepairsearchtree
#define ClonePairSearchTree clonepairsearchtree
#define SizeofPairSearchTree sizeofpairsearchtree
#define SearchInsKeyVal searchinskeyval
#define SearchKeyVal searchkeyval
#define NPairs npairs
#endif
#ifdef UpperUnderscore
#define InitPairSearchTree INITPAIRSEARCHTREE_
#define FreePairSearchTree FREEPAIRSEARCHTREE_
#define ClonePairSearchTree CLONEPAIRSEARCHTREE_
#define SizeofPairSearchTree SIZEOFPAIRSEARCHTREE_
#define SearchInsKeyVal SEARCHINSKEYVAL_
#define SearchKeyVal SEARCHKEYVAL_
#define NPairs NPAIRS_
#endif
#ifdef UpperDoubleUnderscore
#define InitPairSearchTree INITPAIRSEARCHTREE_
#define FreePairSearchTree FREEPAIRSEARCHTREE_
#define ClonePairSearchTree CLONEPAIRSEARCHTREE_
#define SizeofPairSearchTree SIZEOFPAIRSEARCHTREE_
#define SearchInsKeyVal SEARCHINSKEYVAL_
#define SearchKeyVal SEARCHKEYVAL_
#define NPairs NPAIRS_
#endif
#ifdef UpperCase
#define InitPairSearchTree INITPAIRSEARCHTREE
#define FreePairSearchTree FREEPAIRSEARCHTREE
#define ClonePairSearchTree CLONEPAIRSEARCHTREE
#define SizeofPairSearchTree SIZEOFPAIRSEARCHTREE
#define SearchInsKeyVal SEARCHINSKEYVAL
#define SearchKeyVal SEARCHKEYVAL
#define NPairs NPAIRS
#endif
typedef struct keypair *KeyPairPtr;
typedef struct keypair {
int key,val;
} KeyPair;
typedef struct pairvect *PairVectPtr;
typedef struct pairvect {
KeyPair pool[POOLSIZE];
int avail;
PairVectPtr previous, next;
} PairVect;
typedef struct pairtree *PairTreePtr;
typedef struct pairtree {
int retval;
int cache[2][CACHESIZE], cpnt;
PairVectPtr PairPoolRoot,PairPoolCrt;
AVLTreePtr tree;
} PairTree;
#ifdef Ptr64Bits
typedef long long fptr;
#else
typedef int fptr; /* 32-bit by default */
#endif
/* fptr *f_factors, */
/* *f_factors = (fptr) LUfactors; */
/* static int retval; */
/* static PairVectPtr PairPoolRoot=NULL,PairPoolCrt=NULL; */
/* static AVLTreePtr tree=NULL; */
int CompareKeys(void *key1, void *key2)
{
if (((KeyPairPtr) key1)->key < ((KeyPairPtr) key2)->key){
return(-1);
} else if (((KeyPairPtr)key1)->key == ((KeyPairPtr)key2)->key){
return(0);
} else {
return(1);
}
}
void InitPairSearchTree(fptr *ftree, int *iret)
{
int i;
PairTreePtr PTree;
*iret = 0;
if ((PTree = malloc(sizeof(PairTree)))==NULL) {
*iret=-1; return;
}
PTree->retval=0;
for (i=0; i<CACHESIZE; i++) {
PTree->cache[0][i]=PTree->cache[1][i] = -1;
}
PTree->cpnt=0;
if ((PTree->tree = GetAVLTree())==NULL) {
*iret=-1; return;
}
if ((PTree->PairPoolRoot=(PairVectPtr)malloc(sizeof(PairVect)))==NULL) {
*iret=-3; return;
} else {
PTree->PairPoolRoot->avail=0;
PTree->PairPoolRoot->previous=PTree->PairPoolRoot->next=NULL;
PTree->PairPoolCrt=PTree->PairPoolRoot;
}
*ftree = (fptr) PTree;
return;
}
int NPairs(fptr *ftree)
{
PairTreePtr PTree;
PTree = (PairTreePtr) *ftree;
return(HowManyItems(PTree->tree));
}
void KeyUpdate( void *key1, void *key2, void *data)
{
*((int *) data)=((KeyPairPtr) key2)->val;
}
int SizeofPairSearchTree(fptr *ftree)
{
PairTreePtr PTree;
PairVectPtr current,next;
int sz;
PTree = (PairTreePtr) *ftree;
sz = 0;
if (PTree==NULL) return(sz);
current=PTree->PairPoolRoot;
while (current != NULL) {
sz += sizeof(PairVect);
next=current->next;
current=next;
}
return(sz);
}
void FreePairSearchTree(fptr *ftree)
{
PairTreePtr PTree;
PairVectPtr current,next;
PTree = (PairTreePtr) *ftree;
AVLTreeFree(PTree->tree,NULL);
current=PTree->PairPoolRoot;
while (current != NULL) {
next=current->next;
free(current);
current=next;
}
free(PTree->tree);
free(PTree);
*ftree = (fptr) NULL;
return;
}
int AdvanceKeyPair(PairVectPtr current)
{
if (current!=NULL) {
current->avail +=1;
return(current->avail);
}
return(-1);
}
KeyPairPtr GetKeyPair(PairVectPtr *current)
{
PairVectPtr new, crt;
KeyPairPtr newnode;
crt=*current;
if (crt==NULL) {
return(NULL);
}
if (crt->avail<POOLSIZE) {
newnode=&(crt->pool[crt->avail]);
} else {
if ((new=(PairVectPtr)malloc(sizeof(PairVect)))==NULL) {
fprintf(stderr,"Memory allocation failure\n");
return(NULL);
}
memset(new,'\0',sizeof(PairVect));
newnode=&(new->pool[0]);
crt->next=new;
new->previous=crt;
new->next=NULL;
*current=new;
}
return(newnode);
}
/* */
/* void SearchInsKeyVal(int *key, int *val, int *res, */
/* int *iret) */
/* Purpose: Search for a key, insert it if not present. */
/* */
/* Input: 1. key */
/* Key to be searched for. */
/* 2. val */
/* Value to form a (key,val) pair to be */
/* inserted if key not already present. */
/* Output: 3. res */
/* The val part of the pair with key; if the */
/* key was freshly inserted then res=val */
/* Function value: 0 Normal termination */
/* -1 Invalid input pointer */
/* -3 Memory allocation failure */
/* */
void SearchInsKeyVal(fptr *ftree, int *key, int *val, int *res, int *iret)
{
PairTreePtr PTree;
KeyPairPtr node;
int info,i;
PTree = (PairTreePtr) *ftree;
node = GetKeyPair(&(PTree->PairPoolCrt));
node->key = *key;
node->val = *val;
if ((i=PTree->cpnt)<CACHESIZE) {
PTree->cache[0][i] = *key;
PTree->cache[1][i] = *val;
PTree->cpnt=i+1;
}
info = AVLTreeInsert(PTree->tree,node,CompareKeys,KeyUpdate,&(PTree->retval));
*iret = info;
if (info==0) {
*res = node->val;
AdvanceKeyPair(PTree->PairPoolCrt);
} else if (info == 1) {
*res = PTree->retval;
}
}
#define USECACHE 0
void SearchKeyVal(fptr *ftree, int *key, int *res, int *iret)
{
PairTreePtr PTree;
KeyPair node;
AVLNodePtr noderes;
KeyPairPtr result;
#if USECACHE
int i,sv[2];
int info;
#endif
*iret = 0;
PTree = (PairTreePtr) *ftree;
#if USECACHE
for (i=0; i<CACHESIZE; i++) {
if (PTree->cache[0][i] == *key) {
*res=PTree->cache[1][i];
sv[0]=PTree->cache[0][i];
sv[1]=PTree->cache[1][i];
PTree->cache[0][i]=PTree->cache[0][0];
PTree->cache[1][i]=PTree->cache[1][0];
PTree->cache[0][0]=sv[0];
PTree->cache[1][0]=sv[1];
return;
}
}
#endif
node.key=*key;
if ((noderes = AVLTreeSearch(PTree->tree,&node,CompareKeys))==NULL) {
*res = -1;
*iret = 0;
} else {
result = (KeyPairPtr) noderes->key;
*res = result->val;
#if USECACHE
for (i=CACHESIZE-1; i>0; i--) {
PTree->cache[0][i]=PTree->cache[0][i-1];
PTree->cache[0][i]=PTree->cache[1][i-1];
}
PTree->cache[0][0]=*key;
PTree->cache[1][0]=result->val;
#endif
}
#ifdef PROFILE
*iret = 1;
*iret = PTree->tree->nsteps;
#endif
return;
}
void PairTreeVisit(AVLNodePtr current, PairTreePtr PTree)
{
KeyPairPtr node,inode;
int info;
if (current==NULL) return;
inode = (KeyPairPtr) current->key;
node = GetKeyPair(&(PTree->PairPoolCrt));
node->key = inode->key;
node->val = inode->val;
info = AVLTreeInsert(PTree->tree,node,CompareKeys,KeyUpdate,&(PTree->retval));
if (info==0) {
AdvanceKeyPair(PTree->PairPoolCrt);
}
PairTreeVisit(current->llink,PTree);
PairTreeVisit(current->rlink,PTree);
}
void ClonePairSearchTree(fptr *ftreein, fptr *ftreeout)
{
PairTreePtr PTreein, PTreeout;
int i;
PTreein = (PairTreePtr) *ftreein;
if (PTreein == NULL) {
*ftreeout = (fptr) NULL;
return;
}
InitPairSearchTree(ftreeout,&i);
PTreeout = (PairTreePtr) *ftreeout;
PairTreeVisit(PTreein->tree->root,PTreeout);
}

@ -2,7 +2,7 @@ include ../../Make.inc
MODULES = psb_realloc_mod.o psb_string_mod.o psb_spmat_type.o \
psb_desc_type.o psb_spsb_mod.o psb_sort_mod.o\
psb_serial_mod.o psb_tools_mod.o \
psb_serial_mod.o psb_tools_mod.o psb_avl_mod.o\
psb_error_mod.o psb_const_mod.o psb_inter_desc_type.o \
psb_comm_mod.o psb_psblas_mod.o psi_serial_mod.o psi_mod.o \
psb_check_mod.o psb_gps_mod.o
@ -29,7 +29,7 @@ psb_error_mod.o: psb_const_mod.o
psb_penv_mod.o: psb_const_mod.o psb_error_mod.o psb_realloc_mod.o
psi_serial_mod.o: psb_const_mod.o psb_realloc_mod.o
psi_mod.o: psb_penv_mod.o psb_error_mod.o psb_desc_type.o psb_const_mod.o psi_serial_mod.o
psb_desc_type.o: psb_const_mod.o psb_error_mod.o psb_penv_mod.o psb_realloc_mod.o
psb_desc_type.o: psb_const_mod.o psb_error_mod.o psb_penv_mod.o psb_realloc_mod.o psb_avl_mod.o
psb_inter_desc_type.o: psb_desc_type.o psb_spmat_type.o psb_error_mod.o psb_serial_mod.o psb_comm_mod.o
psb_check_mod.o: psb_desc_type.o
psb_serial_mod.o: psb_spmat_type.o psb_string_mod.o psb_sort_mod.o psi_serial_mod.o

@ -0,0 +1,618 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
module psb_item_mod
type psb_item_int2
integer :: key, val
end type psb_item_int2
interface psb_sizeof
module procedure psb_item_int2_size
end interface
contains
function psb_item_int2_size(node)
use psb_const_mod
type(psb_item_int2) :: node
psb_item_int2_size = psb_sizeof_int * 2
end function psb_item_int2_size
subroutine psb_print_item_key_val(iout,item)
integer, intent(in) :: iout
type(psb_item_int2), intent(in) :: item
write(iout,*) 'Value: ',item%key,item%val
call flush(iout)
end subroutine psb_print_item_key_val
end module psb_item_mod
module psb_avl_mod
use psb_item_mod
integer, parameter :: LeftHigh = -1, EqualHeight=0, RightHigh=1
integer, parameter :: AVLTreeDuplicate = -123, AVLTreeOK=0, &
& AVLTreeOutOfMemory=-512, AVLTreeFatalError=-1024
integer :: level,outlev
integer, parameter :: poolsize = 1024
type psb_treenode_int2
type(psb_item_int2) :: item
type(psb_treenode_int2), pointer :: left=>null(), right=>null()
integer :: balance
end type psb_treenode_int2
type psb_treevect_int2
type(psb_treenode_int2) :: pool(poolsize)
integer :: avail
type(psb_treevect_int2), pointer :: next=>null(), prev=>null()
end type psb_treevect_int2
type psb_tree_int2
type(psb_treevect_int2), pointer :: head=>null(), current=>null()
type(psb_treenode_int2), pointer :: root=>null()
integer :: nnodes
end type psb_tree_int2
interface psb_sizeof
module procedure psb_Sizeof_Tree_int2, psb_sizeof_node_int2
end interface
interface InitSearchTree
module procedure InitSearchTree_int2
end interface
interface FreeSearchTree
module procedure FreeSearchTree_int2
end interface
interface SearchKey
module procedure SearchKey_int2
end interface
interface SearchInsKey
module procedure SearchInsKey_int2
end interface
interface GetAVLTree
module procedure GetAVLTree_int2
end interface
interface CloneSearchTree
module procedure CloneSearchTree_int2
end interface
interface CloneAVLTree
module procedure CloneAVLTree_int2
end interface
interface GetAVLNode
module procedure GetAVLNode_int2
end interface
interface UnGetAVLNode
module procedure UnGetAVLNode_int2
end interface
interface VisitAVLTree
module procedure VisitAVLTree_int2, VisitAVLTreeNode_int2
end interface
interface VisitAVLTreeLev
module procedure VisitAVLTreeLev_int2, VisitAVLTreeNodeLev_int2
end interface
interface AVLTreeLeftBalance
module procedure AVLTreeLeftBalance_int2
end interface
interface AVLTreeRightBalance
module procedure AVLTreeRightBalance_int2
end interface
interface AVLTreeRotateLeft
module procedure AVLTreeRotateLeft_int2
end interface
interface AVLTreeRotateRight
module procedure AVLTreeRotateRight_int2
end interface
interface AVLSearchKey
module procedure AVLSearchKey_int2
end interface
interface AVLSearchInsKey
module procedure AVLSearchInsKey_int2
end interface
interface AVLSearchInsNode
module procedure AVLSearchInsNode_int2
end interface
contains
subroutine InitSearchTree_int2(tree, info)
type(psb_tree_int2), pointer :: tree
integer :: info
if (associated(tree)) then
call FreeSearchTree(tree,info)
end if
call GetAVLTree(tree,info)
end subroutine InitSearchTree_int2
subroutine CloneSearchTree_int2(treein, treeout)
type(psb_tree_int2), pointer :: treein,treeout
integer :: info
if (.not.associated(treein)) then
treeout => null()
return
endif
call GetAVLTree(treeout,info)
call CloneAVLTree(treein%root,treeout)
end subroutine CloneSearchTree_int2
subroutine CloneAVLTree_int2(root, tree)
type(psb_treenode_int2), pointer :: root
type(psb_tree_int2), pointer :: tree
integer :: info, key,val,next
if (.not.associated(root)) return
key = root%item%key
next = root%item%val
call SearchInsKey(tree,key,val,next,info)
call CloneAVLTree(root%left,tree)
call CloneAVLTree(root%right,tree)
end subroutine CloneAVLTree_int2
subroutine FreeSearchTree_int2(tree, info)
type(psb_tree_int2), pointer :: tree
integer :: info
type(psb_treevect_int2), pointer :: current,next
if (.not.associated(tree)) return
current => tree%head
do
if (.not.associated(current)) exit
next => current%next
deallocate(current,stat=info)
if (info /= 0) then
info = AVLTreeFatalError
return
end if
current => next
end do
deallocate(tree,stat=info)
if (info /= 0) then
info = AVLTreeFatalError
return
end if
end subroutine FreeSearchTree_int2
function psb_Sizeof_Tree_int2(tree)
use psb_const_mod
type(psb_tree_int2), pointer :: tree
integer :: psb_Sizeof_Tree_int2
integer :: val
type(psb_treevect_int2), pointer :: current,next
val = 0
if (associated(tree)) then
current => tree%head
do
if (.not.associated(current)) exit
val = val + 3*psb_sizeof_int + poolsize*psb_sizeof(current%pool(1))
current => current%next
end do
end if
psb_Sizeof_Tree_int2 = val
end function psb_Sizeof_Tree_int2
function psb_sizeof_node_int2(node)
use psb_const_mod
type(psb_treenode_int2) :: node
integer :: psb_sizeof_node_int2
integer :: val
psb_sizeof_node_int2 = 3*psb_sizeof_int + psb_sizeof(node%item)
end function psb_sizeof_node_int2
subroutine SearchKey_int2(tree,key,val,info)
type(psb_tree_int2), target :: tree
integer :: key,val,info
type(psb_item_int2), pointer :: retval
info = 0
call AVLSearchKey(tree,key,retval,info)
if (associated(retval)) then
val = retval%val
else
val = -1
end if
end subroutine SearchKey_int2
subroutine SearchInsKey_int2(tree,key,val, nextval,info)
type(psb_tree_int2), target :: tree
integer :: key,val,nextval,info
call AVLSearchInsKey(tree,key,val,nextval,info)
end subroutine SearchInsKey_int2
subroutine GetAVLTree_int2(tree, info)
type(psb_tree_int2), pointer :: tree
integer :: info
allocate(tree, stat=info)
if (info == 0) allocate(tree%head,stat=info)
if (info == 0) then
tree%current => tree%head
tree%head%avail = 0
tree%nnodes=0
end if
if (info /= 0) then
write(0,*) 'Failed allocation 1 GetAVLTree '
info = AVLTreeOutOfMemory
return
end if
end subroutine GetAVLTree_int2
subroutine VisitAVLTree_int2(tree, info,iout)
type(psb_tree_int2), pointer :: tree
integer :: info
integer, optional :: iout
info = 0
if (.not.associated(tree)) return
call VisitAVLTree(tree%root,iout)
end subroutine VisitAVLTree_int2
recursive subroutine VisitAVLTreeNode_int2(root,iout)
type(psb_treenode_int2), pointer :: root
integer, optional :: iout
integer :: info
if (.not.associated(root)) return
call VisitAVLTree(root%left,iout)
if (present(iout)) then
call psb_print_item_key_val(iout,root%item)
else
call psb_print_item_key_val(6,root%item)
end if
call VisitAVLTree(root%right,iout)
end subroutine VisitAVLTreeNode_int2
subroutine VisitAVLTreeLev_int2(tree, info)
type(psb_tree_int2), pointer :: tree
integer :: info
if (.not.associated(tree)) return
do outlev = 0, 3
write(6,*) 'Tree level : ',outlev
call VisitAVLTreeLev(tree%root,0)
end do
end subroutine VisitAVLTreeLev_int2
recursive subroutine VisitAVLTreeNodeLev_int2(root,level)
type(psb_treenode_int2), pointer :: root
integer :: info,level
if (.not.associated(root)) return
call VisitAVLTreeLev(root%left,level+1)
if (level == outlev) call psb_print_item_key_val(6,root%item)
call VisitAVLTreeLev(root%right,level+1)
end subroutine VisitAVLTreeNodeLev_int2
function GetAVLNode_int2(tree, info)
type(psb_tree_int2), target :: tree
type(psb_treenode_int2), pointer :: GetAVLNode_int2
integer :: info
type(psb_treevect_int2), pointer :: current, temp
GetAVLNode_int2 => null()
if (.not.associated(tree%current)) then
allocate(tree%head,stat=info)
if (info /= 0) then
info = AVLTreeOutOfMemory
return
end if
tree%current => tree%head
tree%current%avail = 0
end if
current => tree%current
do
if (current%avail < poolsize) exit
if (.not.(associated(current%next))) then
allocate(temp,stat=info)
if (info /= 0) then
info = AVLTreeOutOfMemory
return
end if
temp%avail = 0
temp%prev => current
current%next => temp
end if
current => current%next
end do
tree%current => current
current%avail = current%avail + 1
GetAVLNode_int2 => current%pool(current%avail)
end function GetAVLNode_int2
subroutine UnGetAVLNode_int2(tree, info)
type(psb_tree_int2), target :: tree
integer :: info
if (.not.associated(tree%current)) then
return
end if
if (tree%current%avail > 0) &
& tree%current%avail = tree%current%avail - 1
return
end subroutine UnGetAVLNode_int2
subroutine AVLSearchKey_int2(tree,key,retval,info)
type(psb_tree_int2), target :: tree
integer :: key,info
type(psb_item_int2), pointer :: retval
type(psb_treenode_int2), pointer :: root
retval => null()
root => tree%root
do
if (.not.associated(root)) exit
if (key < root%item%key) then
root => root%left
else if (key == root%item%key) then
retval => root%item
exit
else if (key > root%item%key) then
root => root%right
end if
end do
end subroutine AVLSearchKey_int2
subroutine AVLSearchInsKey_int2(tree,key,val,nextval,info)
type(psb_tree_int2), target :: tree
integer :: key,val,nextval,info
type(psb_treenode_int2), pointer :: itemp
logical :: taller
itemp => GetAVLNode(tree,info)
if (info /=0) then
return
end if
if (.not.associated(itemp)) then
info = -5
return
endif
itemp%item%key = key
itemp%item%val = nextval
itemp%left => null()
itemp%right => null()
call AVLSearchInsNode(tree%root,itemp,taller,info)
val = itemp%item%val
if (info == AVLTreeDuplicate) then
call UnGetAVLNode(tree,info)
!!$ write(0,*) 'From searchInsNode ',key,val,nextval
info = 0
return
else if (info == AVLTreeOK) then
tree%nnodes = tree%nnodes + 1
info = 0
return
else
write(0,*) 'Error from inner SearchInsNode '
endif
end subroutine AVLSearchInsKey_int2
recursive subroutine AVLSearchInsNode_int2(root,node,taller,info)
type(psb_treenode_int2), pointer :: root, node
integer :: info
logical :: taller
info = AVLTreeOK
taller = .false.
if (.not.associated(root)) then
root => node
node%balance = EqualHeight
node%left => null()
node%right => null()
taller = .true.
else if (node%item%key == root%item%key) then
!!$ write(0,*) 'SearchInsNode : found key',node%item%key,node%item%val,&
!!$ &root%item%key,root%item%val
info = AVLTreeDuplicate
node%item%val = root%item%val
return
else if (node%item%key < root%item%key) then
call AVLSearchInsNode(root%left,node,taller,info)
if (info == AVLTreeDuplicate) return
if (info == AVLTreeFatalError) return
if (taller) then
select case(root%balance)
case(LeftHigh)
call AVLTreeLeftBalance(root,taller)
case(EqualHeight)
root%balance = LeftHigh
case(RightHigh)
root%balance = EqualHeight
taller = .false.
case default
info = AVLTreeFatalError
end select
end if
else if (node%item%key > root%item%key) then
call AVLSearchInsNode(root%right,node,taller,info)
if (info == AVLTreeDuplicate) return
if (info == AVLTreeFatalError) return
if (taller) then
select case(root%balance)
case(LeftHigh)
root%balance = EqualHeight
taller = .false.
case(EqualHeight)
root%balance = RightHigh
case(RightHigh)
call AVLTreeRightBalance(root,taller)
case default
info = AVLTreeFatalError
end select
end if
end if
end subroutine AVLSearchInsNode_int2
recursive subroutine AVLTreeLeftBalance_int2(root,taller)
type(psb_treenode_int2), pointer :: root
logical :: taller
type(psb_treenode_int2), pointer :: rs, ls
ls => root%left
select case (ls%balance)
case(LeftHigh)
root%balance = EqualHeight
ls%balance = EqualHeight
call AVLTreeRotateRight(root)
taller = .false.
case(EqualHeight)
write(0,*) 'Warning: balancing and already balanced left tree? '
case(RightHigh)
rs => ls%right
select case(rs%balance)
case(LeftHigh)
root%balance = RightHigh
ls%balance = EqualHeight
case(EqualHeight)
root%balance = EqualHeight
ls%balance = EqualHeight
case(RightHigh)
root%balance = EqualHeight
ls%balance = LeftHigh
end select
rs%balance = EqualHeight
call AVLTreeRotateLeft(root%left)
call AVLTreeRotateRight(root)
taller = .false.
end select
end subroutine AVLTreeLeftBalance_int2
recursive subroutine AVLTreeRightBalance_int2(root,taller)
type(psb_treenode_int2), pointer :: root
logical :: taller
type(psb_treenode_int2), pointer :: rs, ls
rs => root%right
select case (rs%balance)
case(RightHigh)
root%balance = EqualHeight
rs%balance = EqualHeight
call AVLTreeRotateLeft(root)
taller = .false.
case(EqualHeight)
write(0,*) 'Warning: balancing and already balanced right tree? '
case(LeftHigh)
ls => rs%left
select case(ls%balance)
case(RightHigh)
root%balance = LeftHigh
rs%balance = EqualHeight
case(EqualHeight)
root%balance = EqualHeight
rs%balance = EqualHeight
case(LeftHigh)
root%balance = EqualHeight
rs%balance = RightHigh
end select
ls%balance = EqualHeight
call AVLTreeRotateRight(root%right)
call AVLTreeRotateLeft(root)
taller = .false.
end select
end subroutine AVLTreeRightBalance_int2
subroutine AVLTreeRotateLeft_int2(root)
type(psb_treenode_int2), pointer :: root
type(psb_treenode_int2), pointer :: temp
if (.not.associated(root)) then
return
endif
if (.not.associated(root%right)) then
return
endif
temp => root%right
root%right => temp%left
temp%left => root
root => temp
end subroutine AVLTreeRotateLeft_int2
subroutine AVLTreeRotateRight_int2(root)
type(psb_treenode_int2), pointer :: root
type(psb_treenode_int2), pointer :: temp
if (.not.associated(root)) then
return
endif
if (.not.associated(root%left)) then
return
endif
temp => root%left
root%left => temp%right
temp%right => root
root => temp
end subroutine AVLTreeRotateRight_int2
end module psb_avl_mod

@ -37,6 +37,7 @@
module psb_descriptor_type
use psb_const_mod
use psb_avl_mod
implicit none
@ -132,7 +133,7 @@ module psb_descriptor_type
!| integer, allocatable :: ovr_mst_idx(:)
!| integer, allocatable :: loc_to_glob(:)
!| integer, allocatable :: glob_to_loc (:)
!| integer, allocatable :: hashv(:), glb_lc(:,:), ptree(:)
!| integer, allocatable :: hashv(:), glb_lc(:,:)
!| integer, allocatable :: lprm(:)
!| integer, allocatable :: idx_space(:)
!| end type psb_desc_type
@ -157,7 +158,7 @@ module psb_descriptor_type
! and is only entered by the psb_cdrep call. Currently it is only
! used in the last level of some multilevel preconditioners.
!
! The LOC_TO_GLOB, GLOB_TO_LOC, GLB_LC, HASHV and PTREE arrays implement the
! The LOC_TO_GLOB, GLOB_TO_LOC, GLB_LC, HASHV and AVLTREE arrays implement the
! mapping between local and global indices, according to the following
! guidelines:
!
@ -195,7 +196,7 @@ module psb_descriptor_type
! array. In this case we only record the global indices that do have a
! local counterpart, so that the local storage will be proportional to
! N_COL. During the build phase we keep the known global indices in an
! AVL tree data structure whose pointer is stored in ptree(:), so that we
! AVL tree data structure whose pointer is stored in avltree, so that we
! can do both search and insertions in log time. At assembly time, we move
! the information into hashv(:) and glb_lc(:,:). The idea is that
! glb_lc(:,1) will hold sorted global indices, and glb_lc(:,2) the
@ -302,7 +303,8 @@ module psb_descriptor_type
integer, allocatable :: bnd_elem(:)
integer, allocatable :: loc_to_glob(:)
integer, allocatable :: glob_to_loc (:)
integer, allocatable :: hashv(:), glb_lc(:,:), ptree(:)
integer, allocatable :: hashv(:), glb_lc(:,:)
type(psb_tree_int2), pointer :: avltree => null()
integer, allocatable :: lprm(:)
integer, allocatable :: idx_space(:)
type(psb_desc_type), pointer :: base_desc => null()
@ -339,22 +341,10 @@ module psb_descriptor_type
interface psb_cdcpy
module procedure psb_cdcpy
!!$ subroutine psb_cdcpy(desc_in, desc_out, info)
!!$ use psb_descriptor_type
!!$ type(psb_desc_type), intent(in) :: desc_in
!!$ type(psb_desc_type), intent(out) :: desc_out
!!$ integer, intent(out) :: info
!!$ end subroutine psb_cdcpy
end interface
interface psb_cdtransfer
module procedure psb_cdtransfer
!!$ subroutine psb_cdtransfer(desc_in, desc_out, info)
!!$ use psb_descriptor_type
!!$ type(psb_desc_type), intent(inout) :: desc_in
!!$ type(psb_desc_type), intent(inout) :: desc_out
!!$ integer, intent(out) :: info
!!$ end subroutine psb_cdtransfer
end interface
interface psb_cd_reinit
@ -363,11 +353,6 @@ module psb_descriptor_type
interface psb_cdfree
module procedure psb_cdfree
!!$ subroutine psb_cdfree(desc_a,info)
!!$ use psb_descriptor_type
!!$ type(psb_desc_type), intent(inout) :: desc_a
!!$ integer, intent(out) :: info
!!$ end subroutine psb_cdfree
end interface
@ -394,14 +379,13 @@ contains
if (allocated(desc%ovrlap_index)) val = val + psb_sizeof_int*size(desc%ovrlap_index)
if (allocated(desc%ovrlap_elem)) val = val + psb_sizeof_int*size(desc%ovrlap_elem)
if (allocated(desc%ovr_mst_idx)) val = val + psb_sizeof_int*size(desc%ovr_mst_idx)
if (allocated(desc%loc_to_glob)) val = val + psb_sizeof_int*size(desc%loc_to_glob)
if (allocated(desc%loc_to_glob)) val = val + psb_sizeof_int*size(desc%loc_to_glob)
if (allocated(desc%glob_to_loc)) val = val + psb_sizeof_int*size(desc%glob_to_loc)
if (allocated(desc%hashv)) val = val + psb_sizeof_int*size(desc%hashv)
if (allocated(desc%glb_lc)) val = val + psb_sizeof_int*size(desc%glb_lc)
if (allocated(desc%lprm)) val = val + psb_sizeof_int*size(desc%lprm)
if (allocated(desc%idx_space)) val = val + psb_sizeof_int*size(desc%idx_space)
if (allocated(desc%ptree)) val = val + psb_sizeof_int*size(desc%ptree) +&
& SizeofPairSearchTree(desc%ptree)
if (associated(desc%avltree)) val = val + psb_sizeof(desc%avltree)
psb_cd_sizeof = val
end function psb_cd_sizeof
@ -435,13 +419,15 @@ contains
!
psb_cd_choose_large_state = &
& (m > psb_cd_get_large_threshold()) .and. &
& (np > 2)
& (np > 0)
end function psb_cd_choose_large_state
subroutine psb_nullify_desc(desc)
type(psb_desc_type), intent(inout) :: desc
! We have nothing left to do here.
! Perhaps we should delete this subroutine?
nullify(desc%avltree,desc%base_desc)
end subroutine psb_nullify_desc
logical function psb_is_ok_desc(desc)
@ -660,22 +646,18 @@ contains
end if
if (psb_is_large_desc(desc)) then
if (debug) write(0,*) me,'SET_BLD: alocating ptree'
if (.not.allocated(desc%ptree)) then
allocate(desc%ptree(2),stat=info)
if (info /= 0) then
info=4000
goto 9999
endif
call InitPairSearchTree(desc%ptree,info)
if (debug) write(0,*) me,'SET_BLD: alocating avltree'
if (.not.associated(desc%avltree)) then
call InitSearchTree(desc%avltree,info)
do idx=1, psb_cd_get_local_cols(desc)
gidx = desc%loc_to_glob(idx)
call SearchInsKeyVal(desc%ptree,gidx,idx,lidx,info)
call SearchInsKey(desc%avltree,gidx,lidx,idx,info)
if (lidx /= idx) then
write(0,*) 'Warning from cdset: mismatch in PTREE ',idx,lidx
write(0,*) 'Warning from cdset: mismatch in AVLTREE ',idx,lidx
endif
enddo
end if
end if
desc%matrix_data(psb_dec_type_) = psb_desc_bld_
@ -972,18 +954,15 @@ contains
end if
end if
if (allocated(desc_a%ptree)) then
call FreePairSearchTree(desc_a%ptree)
deallocate(desc_a%ptree,stat=info)
if (associated(desc_a%avltree)) then
call FreeSearchTree(desc_a%avltree,info)
if (info /= 0) then
info=2059
info=2060
call psb_errpush(info,name)
goto 9999
end if
end if
if (allocated(desc_a%idx_space)) then
deallocate(desc_a%idx_space,stat=info)
if (info /= 0) then
@ -1073,13 +1052,8 @@ contains
if (info == 0) call psb_safe_ab_cpy(desc_in%glb_lc,desc_out%glb_lc,info)
if (info == 0) then
if (allocated(desc_in%ptree)) then
allocate(desc_out%ptree(2),stat=info)
if (info /= 0) then
info=4000
goto 9999
endif
call ClonePairSearchTree(desc_in%ptree,desc_out%ptree)
if (associated(desc_in%avltree)) then
call CloneSearchTree(desc_in%avltree,desc_out%avltree)
end if
end if
@ -1178,9 +1152,9 @@ contains
& call psb_transfer( desc_in%hashv , desc_out%hashv , info)
if (info == 0) &
& call psb_transfer( desc_in%glb_lc , desc_out%glb_lc , info)
if (info == 0) &
& call psb_transfer( desc_in%ptree , desc_out%ptree , info)
desc_out%avltree => desc_in%avltree; nullify(desc_in%avltree)
if (info /= 0) then
info = 4010
call psb_errpush(info,name)

@ -242,8 +242,8 @@ subroutine psb_cd_inloc(v, ictxt, desc, info)
loc_col = min(2*loc_row,m)
allocate(desc%loc_to_glob(loc_col), desc%lprm(1),&
& desc%ptree(2),stat=info)
if (info == 0) call InitPairSearchTree(desc%ptree,info)
& stat=info)
if (info == 0) call InitSearchTree(desc%avltree,info)
if (info /= 0) then
info=4025
int_err(1)=loc_col
@ -259,7 +259,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info)
if ((tmpgidx(i,1)-flag_) == me) then
k = k + 1
desc%loc_to_glob(k) = i
call SearchInsKeyVal(desc%ptree,i,k,glx,info)
call SearchInsKey(desc%avltree,i,glx,k,info)
endif
enddo
if (k /= loc_row) then

@ -51,6 +51,7 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
use psb_const_mod
use psi_mod
use psb_penv_mod
use psb_avl_mod
implicit None
include 'parts.fh'
!....Parameters...
@ -170,8 +171,8 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
loc_col = (m+np-1)/np
loc_col = min(2*loc_col,m)
allocate(desc%loc_to_glob(loc_col), desc%lprm(1),&
& desc%ptree(2),stat=info)
if (info == 0) call InitPairSearchTree(desc%ptree,info)
& stat=info)
if (info == 0) call InitSearchTree(desc%avltree,info)
if (info /= 0) then
info=4025
int_err(1)=loc_col
@ -234,7 +235,7 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
goto 9999
end if
desc%loc_to_glob(k) = i
call SearchInsKeyVal(desc%ptree,i,k,glx,info)
call SearchInsKey(desc%avltree,i,glx,k,info)
if (nprocs > 1) then
call psb_ensure_size((itmpov+3+nprocs),temp_ovrlap,info,pad=-1)
if (info /= 0) then

@ -50,6 +50,7 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag)
use psb_error_mod
use psi_mod
use psb_penv_mod
use psb_avl_mod
implicit None
!....Parameters...
Integer, intent(in) :: ictxt, v(:)
@ -212,8 +213,8 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag)
loc_col = min(2*loc_row,m)
allocate(desc%loc_to_glob(loc_col), desc%lprm(1),&
& desc%ptree(2),stat=info)
if (info == 0) call InitPairSearchTree(desc%ptree,info)
& stat=info)
if (info == 0) call InitSearchTree(desc%avltree,info)
if (info /= 0) then
info=4025
int_err(1)=loc_col
@ -229,7 +230,7 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag)
if ((v(i)-flag_) == me) then
k = k + 1
desc%loc_to_glob(k) = i
call SearchInsKeyVal(desc%ptree,i,k,glx,info)
call SearchInsKey(desc%avltree,i,glx,k,info)
endif
enddo

@ -124,8 +124,6 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla)
end if
if (present(ila).and.present(jla)) then
!!$ call psi_idx_cnv(nz,ia,ila,desc_a,info,owned=.true.)
!!$ call psi_idx_ins_cnv(nz,ja,jla,desc_a,info,mask=(ila(1:nz)>0))
call psi_idx_cnv(nz,ia,ila,desc_a,info,owned=.true.)
call psb_cdins(nz,ja,desc_a,info,jla=jla,mask=(ila(1:nz)>0))
else

@ -49,6 +49,7 @@ subroutine psb_icdasb(desc_a,info,ext_hv)
use psi_mod
use psb_error_mod
use psb_penv_mod
use psb_avl_mod
#ifdef MPI_MOD
use mpi
#endif
@ -109,6 +110,7 @@ subroutine psb_icdasb(desc_a,info,ext_hv)
& write(debug_unit, *) me,' ',trim(name),': start'
if (psb_is_bld_desc(desc_a)) then
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': Checking rows insertion'
! check if all local row are inserted
@ -157,9 +159,8 @@ subroutine psb_icdasb(desc_a,info,ext_hv)
end if
! Finally, cleanup the AVL tree of indices, if any, as it is
! only needed while in the build state.
if (allocated(desc_a%ptree)) then
call FreePairSearchTree(desc_a%ptree)
deallocate(desc_a%ptree,stat=info)
if (associated(desc_a%avltree)) then
call FreeSearchTree(desc_a%avltree,info)
if (info /= 0) then
info=2059
call psb_errpush(info,name)

Loading…
Cancel
Save