fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

mld2p4-2:

Browse Source 
mlprec/impl/level/mld_c_base_onelev_csetc.f90
 mlprec/impl/level/mld_c_base_onelev_cseti.F90
 mlprec/impl/level/mld_c_base_onelev_csetr.f90
 mlprec/impl/level/mld_c_base_onelev_setc.f90
 mlprec/impl/level/mld_c_base_onelev_seti.F90
 mlprec/impl/level/mld_c_base_onelev_setr.f90
 mlprec/impl/level/mld_c_base_onelev_setsm.F90
 mlprec/impl/level/mld_c_base_onelev_setsv.F90
 mlprec/impl/level/mld_d_base_onelev_csetc.f90
 mlprec/impl/level/mld_d_base_onelev_cseti.F90
 mlprec/impl/level/mld_d_base_onelev_csetr.f90
 mlprec/impl/level/mld_d_base_onelev_setc.f90
 mlprec/impl/level/mld_d_base_onelev_seti.F90
 mlprec/impl/level/mld_d_base_onelev_setr.f90
 mlprec/impl/level/mld_d_base_onelev_setsm.F90
 mlprec/impl/level/mld_d_base_onelev_setsv.F90
 mlprec/impl/level/mld_s_base_onelev_csetc.f90
 mlprec/impl/level/mld_s_base_onelev_cseti.F90
 mlprec/impl/level/mld_s_base_onelev_csetr.f90
 mlprec/impl/level/mld_s_base_onelev_setc.f90
 mlprec/impl/level/mld_s_base_onelev_seti.F90
 mlprec/impl/level/mld_s_base_onelev_setr.f90
 mlprec/impl/level/mld_s_base_onelev_setsm.F90
 mlprec/impl/level/mld_s_base_onelev_setsv.F90
 mlprec/impl/level/mld_z_base_onelev_csetc.f90
 mlprec/impl/level/mld_z_base_onelev_cseti.F90
 mlprec/impl/level/mld_z_base_onelev_csetr.f90
 mlprec/impl/level/mld_z_base_onelev_setc.f90
 mlprec/impl/level/mld_z_base_onelev_seti.F90
 mlprec/impl/level/mld_z_base_onelev_setr.f90
 mlprec/impl/level/mld_z_base_onelev_setsm.F90
 mlprec/impl/level/mld_z_base_onelev_setsv.F90
 mlprec/mld_base_prec_type.F90

Renamed mld_XX_smooth into mld_smooth_XX_, merge from fixprec.
stopcriterion
Salvatore Filippone 8 years ago
parent a28f9ff872
commit 4304f1e2c9
33 changed files with 259 additions and 259 deletions
Show Stats Download Patch File Download Diff File

12
mlprec/impl/level/mld_c_base_onelev_csetc.f90
Unescape Escape View File

@ -67,23 +67,23 @@ subroutine mld_c_base_onelev_csetc(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

24
mlprec/impl/level/mld_c_base_onelev_cseti.F90
Unescape Escape View File

@ -86,14 +86,14 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
select case (psb_toupper(what))
@ -126,10 +126,10 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos)
! Do nothing and hope for the best :)
!
end select
if ((ipos_==mld_pre_smooth_).or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_).or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default()
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm2a)) call lv%sm2a%default()
end if
@ -151,10 +151,10 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_c_ilu_solver_mold,info,pos=pos)
if (info == 0) then
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info)
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if
end if
@ -174,9 +174,9 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos)
case ('SMOOTHER_SWEEPS')
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) &
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_pre = val
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) &
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_post = val
case ('ML_CYCLE')
@ -210,12 +210,12 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos)
lv%parms%coarse_solve = val
case default
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

12
mlprec/impl/level/mld_c_base_onelev_csetr.f90
Unescape Escape View File

@ -72,22 +72,22 @@ subroutine mld_c_base_onelev_csetr(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

12
mlprec/impl/level/mld_c_base_onelev_setc.f90
Unescape Escape View File

@ -67,22 +67,22 @@ subroutine mld_c_base_onelev_setc(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

24
mlprec/impl/level/mld_c_base_onelev_seti.F90
Unescape Escape View File

@ -85,14 +85,14 @@ subroutine mld_c_base_onelev_seti(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
select case (what)
@ -127,10 +127,10 @@ subroutine mld_c_base_onelev_seti(lv,what,val,info,pos)
! Do nothing and hope for the best :)
!
end select
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default()
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%default()
end if
@ -152,10 +152,10 @@ subroutine mld_c_base_onelev_seti(lv,what,val,info,pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_c_ilu_solver_mold,info,pos=pos)
if (info == 0) then
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info)
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if
end if
@ -174,9 +174,9 @@ subroutine mld_c_base_onelev_seti(lv,what,val,info,pos)
end select
case (mld_smoother_sweeps_)
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) &
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_pre = val
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) &
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_post = val
case (mld_ml_cycle_)
@ -211,12 +211,12 @@ subroutine mld_c_base_onelev_seti(lv,what,val,info,pos)
case default
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

12
mlprec/impl/level/mld_c_base_onelev_setr.f90
Unescape Escape View File

@ -72,23 +72,23 @@ subroutine mld_c_base_onelev_setr(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

16
mlprec/impl/level/mld_c_base_onelev_setsm.F90
Unescape Escape View File

@ -59,17 +59,17 @@ subroutine mld_c_base_onelev_setsm(lev,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if (ipos_ == mld_both_smooth_) then
if (ipos_ == mld_smooth_both_) then
if (allocated(lev%sm2a)) then
call lev%sm2a%free(info)
deallocate(lev%sm2a, stat=info)
@ -78,7 +78,7 @@ subroutine mld_c_base_onelev_setsm(lev,val,info,pos)
end if
select case(ipos_)
case(mld_pre_smooth_, mld_both_smooth_)
case(mld_smooth_pre_, mld_smooth_both_)
if (allocated(lev%sm)) then
if (.not.same_type_as(lev%sm,val)) then
call lev%sm%free(info)
@ -93,8 +93,8 @@ subroutine mld_c_base_onelev_setsm(lev,val,info,pos)
#endif
end if
call lev%sm%default()
if (ipos_ == mld_both_smooth_) lev%sm2 => lev%sm
case(mld_post_smooth_)
if (ipos_ == mld_smooth_both_) lev%sm2 => lev%sm
case(mld_smooth_post_)
if (allocated(lev%sm2a)) then
if (.not.same_type_as(lev%sm2a,val)) then
call lev%sm2a%free(info)

16
mlprec/impl/level/mld_c_base_onelev_setsv.F90
Unescape Escape View File

@ -59,17 +59,17 @@ subroutine mld_c_base_onelev_setsv(lev,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_ == mld_pre_smooth_).or.(ipos_ == mld_both_smooth_)) then
if ((ipos_ == mld_smooth_pre_).or.(ipos_ == mld_smooth_both_)) then
if (allocated(lev%sm)) then
if (allocated(lev%sm%sv)) then
if (.not.same_type_as(lev%sm%sv,val)) then
@ -105,14 +105,14 @@ subroutine mld_c_base_onelev_setsv(lev,val,info,pos)
end if
!
! If POS was not specified and therefore we have mld_both_smooth_
! If POS was not specified and therefore we have mld_smooth_both_
! we need to update sm2a *only* if it was already allocated,
! otherwise it is not needed (since we have just fixed %sm in the
! pre section).
!
if ((ipos_ == mld_post_smooth_).or. &
((ipos_ == mld_both_smooth_).and.(allocated(lev%sm2a)))) then
if ((ipos_ == mld_smooth_post_).or. &
((ipos_ == mld_smooth_both_).and.(allocated(lev%sm2a)))) then
if (allocated(lev%sm2a)) then

12
mlprec/impl/level/mld_d_base_onelev_csetc.f90
Unescape Escape View File

@ -67,23 +67,23 @@ subroutine mld_d_base_onelev_csetc(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

24
mlprec/impl/level/mld_d_base_onelev_cseti.F90
Unescape Escape View File

@ -98,14 +98,14 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
select case (psb_toupper(what))
@ -138,10 +138,10 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos)
! Do nothing and hope for the best :)
!
end select
if ((ipos_==mld_pre_smooth_).or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_).or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default()
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm2a)) call lv%sm2a%default()
end if
@ -163,10 +163,10 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_d_ilu_solver_mold,info,pos=pos)
if (info == 0) then
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info)
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if
end if
@ -194,9 +194,9 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos)
case ('SMOOTHER_SWEEPS')
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) &
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_pre = val
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) &
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_post = val
case ('ML_CYCLE')
@ -230,12 +230,12 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos)
lv%parms%coarse_solve = val
case default
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

12
mlprec/impl/level/mld_d_base_onelev_csetr.f90
Unescape Escape View File

@ -72,22 +72,22 @@ subroutine mld_d_base_onelev_csetr(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

12
mlprec/impl/level/mld_d_base_onelev_setc.f90
Unescape Escape View File

@ -67,22 +67,22 @@ subroutine mld_d_base_onelev_setc(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

24
mlprec/impl/level/mld_d_base_onelev_seti.F90
Unescape Escape View File

@ -97,14 +97,14 @@ subroutine mld_d_base_onelev_seti(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
select case (what)
@ -139,10 +139,10 @@ subroutine mld_d_base_onelev_seti(lv,what,val,info,pos)
! Do nothing and hope for the best :)
!
end select
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default()
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%default()
end if
@ -164,10 +164,10 @@ subroutine mld_d_base_onelev_seti(lv,what,val,info,pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_d_ilu_solver_mold,info,pos=pos)
if (info == 0) then
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info)
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if
end if
@ -194,9 +194,9 @@ subroutine mld_d_base_onelev_seti(lv,what,val,info,pos)
end select
case (mld_smoother_sweeps_)
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) &
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_pre = val
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) &
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_post = val
case (mld_ml_cycle_)
@ -231,12 +231,12 @@ subroutine mld_d_base_onelev_seti(lv,what,val,info,pos)
case default
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

12
mlprec/impl/level/mld_d_base_onelev_setr.f90
Unescape Escape View File

@ -72,23 +72,23 @@ subroutine mld_d_base_onelev_setr(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

16
mlprec/impl/level/mld_d_base_onelev_setsm.F90
Unescape Escape View File

@ -59,17 +59,17 @@ subroutine mld_d_base_onelev_setsm(lev,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if (ipos_ == mld_both_smooth_) then
if (ipos_ == mld_smooth_both_) then
if (allocated(lev%sm2a)) then
call lev%sm2a%free(info)
deallocate(lev%sm2a, stat=info)
@ -78,7 +78,7 @@ subroutine mld_d_base_onelev_setsm(lev,val,info,pos)
end if
select case(ipos_)
case(mld_pre_smooth_, mld_both_smooth_)
case(mld_smooth_pre_, mld_smooth_both_)
if (allocated(lev%sm)) then
if (.not.same_type_as(lev%sm,val)) then
call lev%sm%free(info)
@ -93,8 +93,8 @@ subroutine mld_d_base_onelev_setsm(lev,val,info,pos)
#endif
end if
call lev%sm%default()
if (ipos_ == mld_both_smooth_) lev%sm2 => lev%sm
case(mld_post_smooth_)
if (ipos_ == mld_smooth_both_) lev%sm2 => lev%sm
case(mld_smooth_post_)
if (allocated(lev%sm2a)) then
if (.not.same_type_as(lev%sm2a,val)) then
call lev%sm2a%free(info)

16
mlprec/impl/level/mld_d_base_onelev_setsv.F90
Unescape Escape View File

@ -59,17 +59,17 @@ subroutine mld_d_base_onelev_setsv(lev,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_ == mld_pre_smooth_).or.(ipos_ == mld_both_smooth_)) then
if ((ipos_ == mld_smooth_pre_).or.(ipos_ == mld_smooth_both_)) then
if (allocated(lev%sm)) then
if (allocated(lev%sm%sv)) then
if (.not.same_type_as(lev%sm%sv,val)) then
@ -105,14 +105,14 @@ subroutine mld_d_base_onelev_setsv(lev,val,info,pos)
end if
!
! If POS was not specified and therefore we have mld_both_smooth_
! If POS was not specified and therefore we have mld_smooth_both_
! we need to update sm2a *only* if it was already allocated,
! otherwise it is not needed (since we have just fixed %sm in the
! pre section).
!
if ((ipos_ == mld_post_smooth_).or. &
((ipos_ == mld_both_smooth_).and.(allocated(lev%sm2a)))) then
if ((ipos_ == mld_smooth_post_).or. &
((ipos_ == mld_smooth_both_).and.(allocated(lev%sm2a)))) then
if (allocated(lev%sm2a)) then

12
mlprec/impl/level/mld_s_base_onelev_csetc.f90
Unescape Escape View File

@ -67,23 +67,23 @@ subroutine mld_s_base_onelev_csetc(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

24
mlprec/impl/level/mld_s_base_onelev_cseti.F90
Unescape Escape View File

@ -86,14 +86,14 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
select case (psb_toupper(what))
@ -126,10 +126,10 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos)
! Do nothing and hope for the best :)
!
end select
if ((ipos_==mld_pre_smooth_).or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_).or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default()
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm2a)) call lv%sm2a%default()
end if
@ -151,10 +151,10 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_s_ilu_solver_mold,info,pos=pos)
if (info == 0) then
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info)
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if
end if
@ -174,9 +174,9 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos)
case ('SMOOTHER_SWEEPS')
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) &
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_pre = val
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) &
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_post = val
case ('ML_CYCLE')
@ -210,12 +210,12 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos)
lv%parms%coarse_solve = val
case default
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

12
mlprec/impl/level/mld_s_base_onelev_csetr.f90
Unescape Escape View File

@ -72,22 +72,22 @@ subroutine mld_s_base_onelev_csetr(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

12
mlprec/impl/level/mld_s_base_onelev_setc.f90
Unescape Escape View File

@ -67,22 +67,22 @@ subroutine mld_s_base_onelev_setc(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

24
mlprec/impl/level/mld_s_base_onelev_seti.F90
Unescape Escape View File

@ -85,14 +85,14 @@ subroutine mld_s_base_onelev_seti(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
select case (what)
@ -127,10 +127,10 @@ subroutine mld_s_base_onelev_seti(lv,what,val,info,pos)
! Do nothing and hope for the best :)
!
end select
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default()
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%default()
end if
@ -152,10 +152,10 @@ subroutine mld_s_base_onelev_seti(lv,what,val,info,pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_s_ilu_solver_mold,info,pos=pos)
if (info == 0) then
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info)
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if
end if
@ -174,9 +174,9 @@ subroutine mld_s_base_onelev_seti(lv,what,val,info,pos)
end select
case (mld_smoother_sweeps_)
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) &
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_pre = val
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) &
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_post = val
case (mld_ml_cycle_)
@ -211,12 +211,12 @@ subroutine mld_s_base_onelev_seti(lv,what,val,info,pos)
case default
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

12
mlprec/impl/level/mld_s_base_onelev_setr.f90
Unescape Escape View File

@ -72,23 +72,23 @@ subroutine mld_s_base_onelev_setr(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

16
mlprec/impl/level/mld_s_base_onelev_setsm.F90
Unescape Escape View File

@ -59,17 +59,17 @@ subroutine mld_s_base_onelev_setsm(lev,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if (ipos_ == mld_both_smooth_) then
if (ipos_ == mld_smooth_both_) then
if (allocated(lev%sm2a)) then
call lev%sm2a%free(info)
deallocate(lev%sm2a, stat=info)
@ -78,7 +78,7 @@ subroutine mld_s_base_onelev_setsm(lev,val,info,pos)
end if
select case(ipos_)
case(mld_pre_smooth_, mld_both_smooth_)
case(mld_smooth_pre_, mld_smooth_both_)
if (allocated(lev%sm)) then
if (.not.same_type_as(lev%sm,val)) then
call lev%sm%free(info)
@ -93,8 +93,8 @@ subroutine mld_s_base_onelev_setsm(lev,val,info,pos)
#endif
end if
call lev%sm%default()
if (ipos_ == mld_both_smooth_) lev%sm2 => lev%sm
case(mld_post_smooth_)
if (ipos_ == mld_smooth_both_) lev%sm2 => lev%sm
case(mld_smooth_post_)
if (allocated(lev%sm2a)) then
if (.not.same_type_as(lev%sm2a,val)) then
call lev%sm2a%free(info)

16
mlprec/impl/level/mld_s_base_onelev_setsv.F90
Unescape Escape View File

@ -59,17 +59,17 @@ subroutine mld_s_base_onelev_setsv(lev,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_ == mld_pre_smooth_).or.(ipos_ == mld_both_smooth_)) then
if ((ipos_ == mld_smooth_pre_).or.(ipos_ == mld_smooth_both_)) then
if (allocated(lev%sm)) then
if (allocated(lev%sm%sv)) then
if (.not.same_type_as(lev%sm%sv,val)) then
@ -105,14 +105,14 @@ subroutine mld_s_base_onelev_setsv(lev,val,info,pos)
end if
!
! If POS was not specified and therefore we have mld_both_smooth_
! If POS was not specified and therefore we have mld_smooth_both_
! we need to update sm2a *only* if it was already allocated,
! otherwise it is not needed (since we have just fixed %sm in the
! pre section).
!
if ((ipos_ == mld_post_smooth_).or. &
((ipos_ == mld_both_smooth_).and.(allocated(lev%sm2a)))) then
if ((ipos_ == mld_smooth_post_).or. &
((ipos_ == mld_smooth_both_).and.(allocated(lev%sm2a)))) then
if (allocated(lev%sm2a)) then

12
mlprec/impl/level/mld_z_base_onelev_csetc.f90
Unescape Escape View File

@ -67,23 +67,23 @@ subroutine mld_z_base_onelev_csetc(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

24
mlprec/impl/level/mld_z_base_onelev_cseti.F90
Unescape Escape View File

@ -98,14 +98,14 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
select case (psb_toupper(what))
@ -138,10 +138,10 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos)
! Do nothing and hope for the best :)
!
end select
if ((ipos_==mld_pre_smooth_).or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_).or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default()
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm2a)) call lv%sm2a%default()
end if
@ -163,10 +163,10 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_z_ilu_solver_mold,info,pos=pos)
if (info == 0) then
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info)
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if
end if
@ -194,9 +194,9 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos)
case ('SMOOTHER_SWEEPS')
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) &
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_pre = val
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) &
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_post = val
case ('ML_CYCLE')
@ -230,12 +230,12 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos)
lv%parms%coarse_solve = val
case default
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

12
mlprec/impl/level/mld_z_base_onelev_csetr.f90
Unescape Escape View File

@ -72,22 +72,22 @@ subroutine mld_z_base_onelev_csetr(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

12
mlprec/impl/level/mld_z_base_onelev_setc.f90
Unescape Escape View File

@ -67,22 +67,22 @@ subroutine mld_z_base_onelev_setc(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

24
mlprec/impl/level/mld_z_base_onelev_seti.F90
Unescape Escape View File

@ -97,14 +97,14 @@ subroutine mld_z_base_onelev_seti(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
select case (what)
@ -139,10 +139,10 @@ subroutine mld_z_base_onelev_seti(lv,what,val,info,pos)
! Do nothing and hope for the best :)
!
end select
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default()
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%default()
end if
@ -164,10 +164,10 @@ subroutine mld_z_base_onelev_seti(lv,what,val,info,pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_z_ilu_solver_mold,info,pos=pos)
if (info == 0) then
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info)
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if
end if
@ -194,9 +194,9 @@ subroutine mld_z_base_onelev_seti(lv,what,val,info,pos)
end select
case (mld_smoother_sweeps_)
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) &
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_pre = val
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) &
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) &
& lv%parms%sweeps_post = val
case (mld_ml_cycle_)
@ -231,12 +231,12 @@ subroutine mld_z_base_onelev_seti(lv,what,val,info,pos)
case default
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

12
mlprec/impl/level/mld_z_base_onelev_setr.f90
Unescape Escape View File

@ -72,23 +72,23 @@ subroutine mld_z_base_onelev_setr(lv,what,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)
end if
end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if

16
mlprec/impl/level/mld_z_base_onelev_setsm.F90
Unescape Escape View File

@ -59,17 +59,17 @@ subroutine mld_z_base_onelev_setsm(lev,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if (ipos_ == mld_both_smooth_) then
if (ipos_ == mld_smooth_both_) then
if (allocated(lev%sm2a)) then
call lev%sm2a%free(info)
deallocate(lev%sm2a, stat=info)
@ -78,7 +78,7 @@ subroutine mld_z_base_onelev_setsm(lev,val,info,pos)
end if
select case(ipos_)
case(mld_pre_smooth_, mld_both_smooth_)
case(mld_smooth_pre_, mld_smooth_both_)
if (allocated(lev%sm)) then
if (.not.same_type_as(lev%sm,val)) then
call lev%sm%free(info)
@ -93,8 +93,8 @@ subroutine mld_z_base_onelev_setsm(lev,val,info,pos)
#endif
end if
call lev%sm%default()
if (ipos_ == mld_both_smooth_) lev%sm2 => lev%sm
case(mld_post_smooth_)
if (ipos_ == mld_smooth_both_) lev%sm2 => lev%sm
case(mld_smooth_post_)
if (allocated(lev%sm2a)) then
if (.not.same_type_as(lev%sm2a,val)) then
call lev%sm2a%free(info)

16
mlprec/impl/level/mld_z_base_onelev_setsv.F90
Unescape Escape View File

@ -59,17 +59,17 @@ subroutine mld_z_base_onelev_setsv(lev,val,info,pos)
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
ipos_ = mld_smooth_pre_
case('POST')
ipos_ = mld_post_smooth_
ipos_ = mld_smooth_post_
case default
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end select
else
ipos_ = mld_both_smooth_
ipos_ = mld_smooth_both_
end if
if ((ipos_ == mld_pre_smooth_).or.(ipos_ == mld_both_smooth_)) then
if ((ipos_ == mld_smooth_pre_).or.(ipos_ == mld_smooth_both_)) then
if (allocated(lev%sm)) then
if (allocated(lev%sm%sv)) then
if (.not.same_type_as(lev%sm%sv,val)) then
@ -105,14 +105,14 @@ subroutine mld_z_base_onelev_setsv(lev,val,info,pos)
end if
!
! If POS was not specified and therefore we have mld_both_smooth_
! If POS was not specified and therefore we have mld_smooth_both_
! we need to update sm2a *only* if it was already allocated,
! otherwise it is not needed (since we have just fixed %sm in the
! pre section).
!
if ((ipos_ == mld_post_smooth_).or. &
((ipos_ == mld_both_smooth_).and.(allocated(lev%sm2a)))) then
if ((ipos_ == mld_smooth_post_).or. &
((ipos_ == mld_smooth_both_).and.(allocated(lev%sm2a)))) then
if (allocated(lev%sm2a)) then

6
mlprec/mld_base_prec_type.F90
Unescape Escape View File

@ -175,9 +175,9 @@ module mld_base_prec_type
!
! Constants for pre/post signaling. Now only used internally
!
integer(psb_ipk_), parameter :: mld_pre_smooth_ = 1
integer(psb_ipk_), parameter :: mld_post_smooth_ = 2
integer(psb_ipk_), parameter :: mld_both_smooth_ = 3
integer(psb_ipk_), parameter :: mld_smooth_pre_ = 1
integer(psb_ipk_), parameter :: mld_smooth_post_ = 2
integer(psb_ipk_), parameter :: mld_smooth_both_ = 3
!
! This is a quick&dirty fix, but I have nothing better now...

Write Preview
Loading…
Cancel
Save