diff --git a/src/comm/psb_dscatter.f90 b/src/comm/psb_dscatter.f90 index 1aacf727..d9cf3276 100644 --- a/src/comm/psb_dscatter.f90 +++ b/src/comm/psb_dscatter.f90 @@ -171,7 +171,13 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,& end if ! root has to gather size information - allocate(displ(nprow),all_dim(nprow)) + allocate(displ(nprow),all_dim(nprow),stat=info) + if(info.ne.0) then + info=4010 + ch_err='Allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if call mpi_gather(nrow,1,mpi_integer,all_dim,& & nprow,mpi_integer,rootrank,icomm,info) @@ -180,7 +186,14 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,& ! root has to gather loc_glob from each process if(myrow.eq.root) then - allocate(l_t_g_all(sum(all_dim)),scatterv(sum(all_dim))) + allocate(l_t_g_all(sum(all_dim)),scatterv(sum(all_dim)),stat=info) + if(info.ne.0) then + info=4010 + ch_err='Allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if call mpi_gatherv(desc_a%loc_to_glob,nrow,& diff --git a/src/internals/psi_compute_size.f90 b/src/internals/psi_compute_size.f90 index 0d33eefd..335ce53e 100644 --- a/src/internals/psi_compute_size.f90 +++ b/src/internals/psi_compute_size.f90 @@ -15,7 +15,7 @@ subroutine psi_compute_size(desc_data,& ! ...local array... integer :: exch(2) integer :: int_err(5) - integer, pointer :: counter_recv(:), counter_dl(:) + integer, allocatable :: counter_recv(:), counter_dl(:) ! ...parameters logical, parameter :: debug=.false. @@ -40,7 +40,12 @@ subroutine psi_compute_size(desc_data,& endif np=nprow - allocate(counter_dl(0:np-1),counter_recv(0:np-1)) + allocate(counter_dl(0:np-1),counter_recv(0:np-1),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + ! ..initialize counters... do i=0,np-1 counter_recv(i)=0 diff --git a/src/internals/psi_crea_bnd_elem.f90 b/src/internals/psi_crea_bnd_elem.f90 index 9fab9ed3..b7f0a8f4 100644 --- a/src/internals/psi_crea_bnd_elem.f90 +++ b/src/internals/psi_crea_bnd_elem.f90 @@ -50,7 +50,12 @@ subroutine psi_crea_bnd_elem(desc_a,info) j = 0 endif - allocate(desc_a%bnd_elem(j+1)) + allocate(desc_a%bnd_elem(j+1),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + if (.false.) then desc_a%bnd_elem(1) = j desc_a%bnd_elem(2:j+1) = work(1:j) diff --git a/src/internals/psi_crea_index.f90 b/src/internals/psi_crea_index.f90 index 72e61c23..11918f17 100644 --- a/src/internals/psi_crea_index.f90 +++ b/src/internals/psi_crea_index.f90 @@ -77,7 +77,12 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info) ! the number of processors becomes very high dl_lda=np+1 - allocate(dep_list(max(1,dl_lda),0:np),length_dl(0:np)) + allocate(dep_list(max(1,dl_lda),0:np),length_dl(0:np),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + ! ...extract dependence list (ordered list of identifer process ! which every process must communcate with... if (debug) write(*,*) 'crea_halo: calling extract_dep_list' diff --git a/src/internals/psi_extrct_dl.f b/src/internals/psi_extrct_dl.f index d0372edb..8985d561 100644 --- a/src/internals/psi_extrct_dl.f +++ b/src/internals/psi_extrct_dl.f @@ -222,7 +222,8 @@ c$$$ + i, i, -ione ,-ione,-ione) if (.true.) then call igsum2d(icontxt,'all',' ',np+1,1,length_dl,np+1,-1,-1) call blacs_get(icontxt,10,icomm ) - allocate(itmp(dl_lda)) + allocate(itmp(dl_lda),stat=info) + if (info /= 0) goto 9999 itmp(1:dl_lda) = dep_list(1:dl_lda,me) call mpi_allgather(itmp,dl_lda,mpi_integer, + dep_list,dl_lda,mpi_integer,icomm,info) diff --git a/src/prec/psb_dbldaggrmat.f90 b/src/prec/psb_dbldaggrmat.f90 index b98131bd..4fde248e 100644 --- a/src/prec/psb_dbldaggrmat.f90 +++ b/src/prec/psb_dbldaggrmat.f90 @@ -317,7 +317,7 @@ contains name='smooth_aggregate' if(psb_get_errstatus().ne.0) return - info=0 + info=0 call psb_erractionsave(err_act) icontxt = desc_a%matrix_data(psb_ctxt_) @@ -338,6 +338,10 @@ contains ntaggr = sum(p%nlaggr) allocate(nzbr(np), idisp(np),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if naggrm1 = sum(p%nlaggr(1:myprow)) @@ -371,9 +375,10 @@ contains ! nrow: local rows. ! allocate(p%dorig(nrow),stat=info) - if (info/=0) then - write(0,*) 'Error from allocation',info - endif + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if ! Get diagonal D call psb_spgtdiag(a,p%dorig,info) @@ -662,7 +667,11 @@ contains nzbg = bg%infoa(psb_nnz_) nzl = bg%infoa(psb_nnz_) - allocate(ivall(ntaggr)) + allocate(ivall(ntaggr),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if i = 1 do ip=1,nprows diff --git a/src/prec/psb_dcslu.f90 b/src/prec/psb_dcslu.f90 index fd10579b..b399b09d 100644 --- a/src/prec/psb_dcslu.f90 +++ b/src/prec/psb_dcslu.f90 @@ -132,7 +132,11 @@ subroutine psb_dcslu(a,desc_a,p,upd,info) endif if (.not.associated(p%av)) then - allocate(p%av(bp_ilu_avsz)) + allocate(p%av(bp_ilu_avsz),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if endif do k=1,size(p%av) call psb_nullify_sp(p%av(k)) @@ -169,6 +173,11 @@ subroutine psb_dcslu(a,desc_a,p,upd,info) endif if (.not.associated(p%d)) then allocate(p%d(n_row),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + endif @@ -319,7 +328,7 @@ contains character(len=20) :: name, ch_err if(psb_get_errstatus().ne.0) return - info=0 + info=0 name='apply_renum' call psb_erractionsave(err_act) @@ -343,7 +352,12 @@ contains ! nnr = p%desc_data%matrix_data(psb_n_row_) - allocate(p%perm(nnr),p%invperm(nnr),itmp2(nnr)) + allocate(p%perm(nnr),p%invperm(nnr),itmp2(nnr),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + do k=1,nnr itmp2(k) = p%desc_data%loc_to_glob(k) enddo @@ -359,8 +373,12 @@ contains ! Build ATMP with new numbering. - allocate(itmp(max(8,atmp%m+2,nztmp+2)),rtmp(atmp%m)) - + allocate(itmp(max(8,atmp%m+2,nztmp+2)),rtmp(atmp%m),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + j = 1 atmp%ia2(1) = 1 do i=1, atmp%m @@ -480,7 +498,12 @@ contains goto 9999 end if - allocate(itmp(max(8,atmp%m+2,nztmp+2))) + allocate(itmp(max(8,atmp%m+2,nztmp+2)),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + itmp(1:8) = 0 ! write(0,*) me,' Renumbering: Calling Metis' ! call blacs_barrier(icontxt,'All') @@ -512,7 +535,11 @@ contains ! Build ATMP with new numbering. - allocate(itmp2(max(8,atmp%m+2,nztmp+2)),rtmp(atmp%m)) + allocate(itmp2(max(8,atmp%m+2,nztmp+2)),rtmp(atmp%m),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if j = 1 atmp%ia2(1) = 1 diff --git a/src/prec/psb_dprec.f90 b/src/prec/psb_dprec.f90 index 7b7befe6..adf5e856 100644 --- a/src/prec/psb_dprec.f90 +++ b/src/prec/psb_dprec.f90 @@ -68,7 +68,12 @@ subroutine psb_dprecaply(prec,x,y,desc_data,info,trans, work) if (present(work)) then work_ => work else - allocate(work_(4*desc_data%matrix_data(psb_n_col_))) + allocate(work_(4*desc_data%matrix_data(psb_n_col_)),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + end if if (.not.(associated(prec%baseprecv))) then @@ -235,15 +240,29 @@ subroutine psb_dbaseprcaply(prec,x,beta,y,desc_data,trans,work,info) aux => work(3*isz+1:) else if ((4*isz) <= size(work)) then aux => work(1:) - allocate(ww(isz),tx(isz),ty(isz)) + allocate(ww(isz),tx(isz),ty(isz),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if else if ((3*isz) <= size(work)) then ww => work(1:isz) tx => work(isz+1:2*isz) ty => work(2*isz+1:3*isz) - allocate(aux(4*isz)) + allocate(aux(4*isz),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + else allocate(ww(isz),tx(isz),ty(isz),& - &aux(4*isz)) + &aux(4*isz),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + endif if (debug) write(0,*)' vdiag: ',prec%d(:) @@ -416,10 +435,19 @@ subroutine psb_dbjacaply(prec,x,beta,y,desc_data,trans,work,info) if ((4*n_col+n_col) <= size(work)) then aux => work(n_col+1:) else - allocate(aux(4*n_col)) + allocate(aux(4*n_col),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + endif else - allocate(ww(n_col),aux(4*n_col)) + allocate(ww(n_col),aux(4*n_col),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if endif @@ -509,7 +537,12 @@ subroutine psb_dbjacaply(prec,x,beta,y,desc_data,trans,work,info) goto 9999 endif - allocate(tx(n_col),ty(n_col)) + allocate(tx(n_col),ty(n_col),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + tx = zero ty = zero select case(prec%iprcparm(f_type_)) @@ -684,7 +717,12 @@ subroutine psb_dmlprcaply(baseprecv,x,beta,y,desc_data,trans,work,info) nr2l = baseprecv(2)%desc_data%matrix_data(psb_n_col_) nrg = baseprecv(2)%desc_data%matrix_data(psb_n_row_) - allocate(t2l(nr2l),w2l(nr2l)) + allocate(t2l(nr2l),w2l(nr2l),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + t2l(:) = zero w2l(:) = zero @@ -693,7 +731,12 @@ subroutine psb_dmlprcaply(baseprecv,x,beta,y,desc_data,trans,work,info) ! Smoothed aggregation ! allocate(tx(max(n_row,n_col)),ty(max(n_row,n_col)),& - & tz(max(n_row,n_col))) + & tz(max(n_row,n_col)),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + tx(1:desc_data%matrix_data(psb_n_row_)) = x(1:desc_data%matrix_data(psb_n_row_)) tx(desc_data%matrix_data(psb_n_row_)+1:max(n_row,n_col)) = zero ty(desc_data%matrix_data(psb_n_row_)+1:max(n_row,n_col)) = zero @@ -770,7 +813,12 @@ subroutine psb_dmlprcaply(baseprecv,x,beta,y,desc_data,trans,work,info) n_col = baseprecv(1)%desc_data%matrix_data(psb_n_col_) nr2l = baseprecv(2)%desc_data%matrix_data(psb_n_col_) nrg = baseprecv(2)%desc_data%matrix_data(psb_n_row_) - allocate(t2l(nr2l),w2l(nr2l),tx(n_col),ty(n_col)) + allocate(t2l(nr2l),w2l(nr2l),tx(n_col),ty(n_col),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + t2l(:) = zero w2l(:) = zero @@ -788,7 +836,12 @@ subroutine psb_dmlprcaply(baseprecv,x,beta,y,desc_data,trans,work,info) ! ! Smoothed aggregation ! - allocate(tz(max(n_row,n_col))) + allocate(tz(max(n_row,n_col)),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + if (baseprecv(2)%iprcparm(glb_smth_) >0) then call psb_halo(tx,desc_data,info,work=work) @@ -859,7 +912,12 @@ subroutine psb_dmlprcaply(baseprecv,x,beta,y,desc_data,trans,work,info) n_col = baseprecv(1)%desc_data%matrix_data(psb_n_col_) nr2l = baseprecv(2)%desc_data%matrix_data(psb_n_col_) nrg = baseprecv(2)%desc_data%matrix_data(psb_n_row_) - allocate(t2l(nr2l),w2l(nr2l),tx(n_col),ty(n_col),tty(n_col)) + allocate(t2l(nr2l),w2l(nr2l),tx(n_col),ty(n_col),tty(n_col),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + t2l(:) = zero w2l(:) = zero @@ -878,7 +936,12 @@ subroutine psb_dmlprcaply(baseprecv,x,beta,y,desc_data,trans,work,info) if(info /=0) goto 9999 if (ismth /= no_smth_) then - allocate(tz(max(n_row,n_col))) + allocate(tz(max(n_row,n_col)),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + if (baseprecv(2)%iprcparm(glb_smth_) >0) then call psb_halo(tx,desc_data,info,work=work) @@ -943,7 +1006,12 @@ subroutine psb_dmlprcaply(baseprecv,x,beta,y,desc_data,trans,work,info) n_col = baseprecv(1)%desc_data%matrix_data(psb_n_col_) nr2l = baseprecv(2)%desc_data%matrix_data(psb_n_col_) nrg = baseprecv(2)%desc_data%matrix_data(psb_n_row_) - allocate(t2l(nr2l),w2l(nr2l),tx(n_col),ty(n_col),tty(n_col)) + allocate(t2l(nr2l),w2l(nr2l),tx(n_col),ty(n_col),tty(n_col),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + t2l(:) = zero w2l(:) = zero tx(:) = zero @@ -1091,7 +1159,12 @@ subroutine psb_dprecaply1(prec,x,desc_data,info,trans) trans_='N' end if - allocate(ww(size(x)),w1(size(x))) + allocate(ww(size(x)),w1(size(x)),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + call psb_dprecaply(prec,x,ww,desc_data,info,trans_,w1) if(info /=0) goto 9999 x(:) = ww(:) diff --git a/src/prec/psb_dprecbld.f90 b/src/prec/psb_dprecbld.f90 index 7d075fa8..509f888d 100644 --- a/src/prec/psb_dprecbld.f90 +++ b/src/prec/psb_dprecbld.f90 @@ -109,7 +109,12 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd) call psb_check_def(p%baseprecv(1)%iprcparm(p_type_),'base_prec',& & diagsc_,is_legal_base_prec) - allocate(p%baseprecv(1)%desc_data) + allocate(p%baseprecv(1)%desc_data,stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + call psb_nullify_desc(p%baseprecv(1)%desc_data) select case(p%baseprecv(1)%iprcparm(p_type_)) @@ -169,7 +174,12 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd) endif if (debug) then - allocate(gd(mglob)) + allocate(gd(mglob),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + call psb_gather(gd, p%baseprecv(1)%d, desc_a, info, iroot=iroot) if(info /= 0) then info=4010 @@ -269,7 +279,12 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd) & pre_smooth_,is_legal_ml_smooth_pos) call psb_check_def(p%baseprecv(2)%iprcparm(f_type_),'fact',f_ilu_n_,is_legal_ml_fact) - allocate(p%baseprecv(2)%desc_data) + allocate(p%baseprecv(2)%desc_data,stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + call psb_nullify_desc(p%baseprecv(2)%desc_data) select case(p%baseprecv(2)%iprcparm(f_type_)) @@ -728,8 +743,12 @@ subroutine psb_mlprec_bld(a,desc_a,p,info) call psb_erractionsave(err_act) p%aorig => a - allocate(p%av(smth_avsz)) - + allocate(p%av(smth_avsz),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + do i=1, smth_avsz call psb_nullify_sp(p%av(i)) call psb_spall(0,0,p%av(i),1,info) @@ -770,7 +789,11 @@ subroutine psb_mlprec_bld(a,desc_a,p,info) goto 9999 end if - allocate(p%d(nrg)) + allocate(p%d(nrg),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if select case(p%iprcparm(f_type_)) case(f_ilu_n_,f_ilu_e_) diff --git a/src/prec/psb_dprecset.f90 b/src/prec/psb_dprecset.f90 index bcf9f8fe..833bf255 100644 --- a/src/prec/psb_dprecset.f90 +++ b/src/prec/psb_dprecset.f90 @@ -1,3 +1,4 @@ + subroutine psb_dprecset(p,ptype,iv,rs,rv,info) use psb_serial_mod @@ -30,7 +31,7 @@ subroutine psb_dprecset(p,ptype,iv,rs,rv,info) endif end if - select case(toupper(ptype)) + select case(toupper(ptype(1:len_trim(ptype)))) case ('NONE','NOPREC') p%baseprecv(1)%iprcparm(p_type_) = noprec_ p%baseprecv(1)%iprcparm(f_type_) = f_none_ @@ -85,7 +86,10 @@ subroutine psb_dprecset(p,ptype,iv,rs,rv,info) select case (size(p%baseprecv)) case(1) ! Reallocate - allocate(bpv(2)) + allocate(bpv(2),stat=err) + if (err/=0) then + write(0,*)'Precset Memory Failure 2l:1',err + endif bpv(1) = p%baseprecv(1) call psb_nullify_baseprec(bpv(2)) deallocate(p%baseprecv) diff --git a/src/prec/psb_dsplu.f90 b/src/prec/psb_dsplu.f90 index e2912c85..252296da 100644 --- a/src/prec/psb_dsplu.f90 +++ b/src/prec/psb_dsplu.f90 @@ -33,7 +33,12 @@ subroutine psb_dsplu(a,l,u,d,info,blck) if (present(blck)) then blck_ => blck else - allocate(blck_) + allocate(blck_,stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + call psb_nullify_sp(blck_) ! Why do we need this? Who knows.... call psb_spall(0,0,blck_,1,info) if(info.ne.0) then diff --git a/src/serial/psb_dipcoo2csr.f90 b/src/serial/psb_dipcoo2csr.f90 index 421f6f66..f43c9bba 100644 --- a/src/serial/psb_dipcoo2csr.f90 +++ b/src/serial/psb_dipcoo2csr.f90 @@ -42,7 +42,12 @@ subroutine psb_dipcoo2csr(a,info,rwshr) call psb_fixcoo(a,info) nr = a%m nza = a%infoa(psb_nnz_) - allocate(iaux(nr+1)) + allocate(iaux(nr+1),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + if(debug) write(0,*)'DIPCOO2CSR: out of fixcoo',nza,nr,size(a%ia2),size(iaux) itemp => a%ia1 diff --git a/src/tools/psb_descasb.f90 b/src/tools/psb_descasb.f90 index 80855906..b667e0ac 100644 --- a/src/tools/psb_descasb.f90 +++ b/src/tools/psb_descasb.f90 @@ -83,7 +83,11 @@ Subroutine psb_descasb(n_ovr,desc_p,desc_a,a,& lwork=5*(5*np+2)*np+10 Allocate(works(lworks),workr(lworkr),t_halo_in(3*Size(desc_p%halo_index)),& & t_halo_out(Size(desc_p%halo_index)), work(lwork),& - & length_dl(np+1),dep_list(dl_lda*np),temp(lworkr)) + & length_dl(np+1),dep_list(dl_lda*np),temp(lworkr),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if call psb_spall(blk,max(lworks,lworkr),info) @@ -97,7 +101,12 @@ Subroutine psb_descasb(n_ovr,desc_p,desc_a,a,& blk%fida='COO' halo => desc_a%halo_index - Allocate(tmp_ovr_idx(l_tmp_ovr_idx),tmp_halo(l_tmp_halo)) + Allocate(tmp_ovr_idx(l_tmp_ovr_idx),tmp_halo(l_tmp_halo),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + desc_p%ovrlap_elem(:) = -1 tmp_ovr_idx(:) = -1 tmp_halo(:) = -1 diff --git a/src/tools/psb_dscall.f90 b/src/tools/psb_dscall.f90 index 6f9058ec..17c03447 100644 --- a/src/tools/psb_dscall.f90 +++ b/src/tools/psb_dscall.f90 @@ -250,6 +250,11 @@ subroutine psb_dscall(m, n, parts, icontxt, desc_a, info) loc_col=int((psb_colrow_+1.d0)*loc_row)+1 allocate(desc_a%loc_to_glob(loc_col),& &desc_a%lprm(1),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + call psb_realloc(1, desc_a%lprm, info) call psb_realloc(loc_col, desc_a%loc_to_glob, info) if (info /= no_err) then