From d616b83f6fdb9bf4fae4df1fd15362b8c89baa1e Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 27 Mar 2008 14:48:42 +0000 Subject: [PATCH] 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. --- Changelog | 8 + base/internals/Makefile | 2 +- base/internals/avltree.c | 822 ----------------------------- base/internals/avltree.h | 71 --- base/internals/psi_bld_tmphalo.f90 | 9 + base/internals/psi_fnd_owner.f90 | 1 + base/internals/psi_idx_cnv.f90 | 5 +- base/internals/psi_idx_ins_cnv.f90 | 6 +- base/internals/srcht.c | 446 ---------------- base/modules/Makefile | 4 +- base/modules/psb_avl_mod.f90 | 618 ++++++++++++++++++++++ base/modules/psb_desc_type.f90 | 74 +-- base/tools/psb_cd_inloc.f90 | 6 +- base/tools/psb_cdals.f90 | 7 +- base/tools/psb_cdalv.f90 | 7 +- base/tools/psb_cdins.f90 | 2 - base/tools/psb_icdasb.F90 | 7 +- 17 files changed, 685 insertions(+), 1410 deletions(-) delete mode 100644 base/internals/avltree.c delete mode 100644 base/internals/avltree.h delete mode 100644 base/internals/srcht.c create mode 100644 base/modules/psb_avl_mod.f90 diff --git a/Changelog b/Changelog index e9a037d7..2c4f6abc 100644 --- a/Changelog +++ b/Changelog @@ -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. diff --git a/base/internals/Makefile b/base/internals/Makefile index c43b47ed..62ea18bf 100644 --- a/base/internals/Makefile +++ b/base/internals/Makefile @@ -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 \ diff --git a/base/internals/avltree.c b/base/internals/avltree.c deleted file mode 100644 index f99d6f21..00000000 --- a/base/internals/avltree.c +++ /dev/null @@ -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 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 -#include -#include -#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; iavail; 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->availpool[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); -} - diff --git a/base/internals/avltree.h b/base/internals/avltree.h deleted file mode 100644 index a8bcd74b..00000000 --- a/base/internals/avltree.h +++ /dev/null @@ -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 *); - - diff --git a/base/internals/psi_bld_tmphalo.f90 b/base/internals/psi_bld_tmphalo.f90 index 2ae3cef8..971a0599 100644 --- a/base/internals/psi_bld_tmphalo.f90 +++ b/base/internals/psi_bld_tmphalo.f90 @@ -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') diff --git a/base/internals/psi_fnd_owner.f90 b/base/internals/psi_fnd_owner.f90 index 3146d433..0c5a16aa 100644 --- a/base/internals/psi_fnd_owner.f90 +++ b/base/internals/psi_fnd_owner.f90 @@ -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) diff --git a/base/internals/psi_idx_cnv.f90 b/base/internals/psi_idx_cnv.f90 index dfb39514..94fe0382 100644 --- a/base/internals/psi_idx_cnv.f90 +++ b/base/internals/psi_idx_cnv.f90 @@ -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 diff --git a/base/internals/psi_idx_ins_cnv.f90 b/base/internals/psi_idx_ins_cnv.f90 index 30e1193a..c25d0c13 100644 --- a/base/internals/psi_idx_ins_cnv.f90 +++ b/base/internals/psi_idx_ins_cnv.f90 @@ -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 diff --git a/base/internals/srcht.c b/base/internals/srcht.c deleted file mode 100644 index 1e6bd694..00000000 --- a/base/internals/srcht.c +++ /dev/null @@ -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 -#include -#include -#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; icache[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->availpool[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)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; icache[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); -} diff --git a/base/modules/Makefile b/base/modules/Makefile index 60084561..b98dfdc6 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -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 diff --git a/base/modules/psb_avl_mod.f90 b/base/modules/psb_avl_mod.f90 new file mode 100644 index 00000000..5b8047f7 --- /dev/null +++ b/base/modules/psb_avl_mod.f90 @@ -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 diff --git a/base/modules/psb_desc_type.f90 b/base/modules/psb_desc_type.f90 index dbe7dd28..e82a41f2 100644 --- a/base/modules/psb_desc_type.f90 +++ b/base/modules/psb_desc_type.f90 @@ -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) diff --git a/base/tools/psb_cd_inloc.f90 b/base/tools/psb_cd_inloc.f90 index 65c183ad..3792afca 100644 --- a/base/tools/psb_cd_inloc.f90 +++ b/base/tools/psb_cd_inloc.f90 @@ -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 diff --git a/base/tools/psb_cdals.f90 b/base/tools/psb_cdals.f90 index b6fc5ec4..206babda 100644 --- a/base/tools/psb_cdals.f90 +++ b/base/tools/psb_cdals.f90 @@ -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 diff --git a/base/tools/psb_cdalv.f90 b/base/tools/psb_cdalv.f90 index 351d8ef7..8918ab97 100644 --- a/base/tools/psb_cdalv.f90 +++ b/base/tools/psb_cdalv.f90 @@ -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 diff --git a/base/tools/psb_cdins.f90 b/base/tools/psb_cdins.f90 index b4d7b0de..66d6bbf0 100644 --- a/base/tools/psb_cdins.f90 +++ b/base/tools/psb_cdins.f90 @@ -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 diff --git a/base/tools/psb_icdasb.F90 b/base/tools/psb_icdasb.F90 index bd52018c..6426e3fe 100644 --- a/base/tools/psb_icdasb.F90 +++ b/base/tools/psb_icdasb.F90 @@ -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)