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

*** empty log message ***

Browse Source
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent d6195df8ac
commit 2e326204e8
1 changed files with 87 additions and 115 deletions
Show Stats Download Patch File Download Diff File

202
test/Fileread/getp.f90
Unescape Escape View File

@ -28,106 +28,89 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
MODULE GETP Module getp
use psb_sparse_mod use psb_sparse_mod
PUBLIC GET_PARMS public get_parms
PUBLIC PR_USAGE public pr_usage
CONTAINS contains
! !
! Get iteration parameters from the command line ! Get iteration parameters from the command line
! !
SUBROUTINE GET_PARMS(ICTXT,MTRX_FILE,RHS_FILE,CMETHD,IPART,& subroutine get_parms(ictxt,mtrx_file,rhs_file,cmethd,ipart,&
& AFMT,ISTOPC,ITMAX,ITRACE,NOVR,IPREC,EPS) & afmt,istopc,itmax,itrace,novr,iprec,eps)
integer :: ictxt integer :: ictxt
Character*40 :: CMETHD, MTRX_FILE, RHS_FILE character*40 :: cmethd, mtrx_file, rhs_file
Integer :: IRET, ISTOPC,ITMAX,ITRACE,IPART,IPREC,NOVR integer :: iret, istopc,itmax,itrace,ipart,iprec,novr
Character*40 :: CHARBUF character*40 :: charbuf
real(kind(1.d0)) :: eps real(kind(1.d0)) :: eps
character :: afmt*5 character :: afmt*5
INTEGER :: IARGC, NP, IAM integer :: np, iam
EXTERNAL IARGC integer :: inparms(40), ip
INTEGER :: INPARMS(40), IP
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
IF (IAM==0) THEN if (iam==0) then
! Read Input Parameters ! Read Input Parameters
READ(*,*) IP read(*,*) ip
IF (IP.GE.3) THEN if (ip >= 3) then
READ(*,*) MTRX_FILE read(*,*) mtrx_file
READ(*,*) RHS_FILE read(*,*) rhs_file
READ(*,*) CMETHD read(*,*) cmethd
READ(*,*) AFMT read(*,*) afmt
! Convert strings in array
DO I = 1, LEN(MTRX_FILE)
INPARMS(I) = IACHAR(MTRX_FILE(I:I))
END DO
! Broadcast parameters to all processors
call psb_bcast(ictxt,inparms(1:40))
! Convert strings in array call psb_bcast(ictxt,mtrx_file)
DO I = 1, LEN(CMETHD) call psb_bcast(ictxt,rhs_file)
INPARMS(I) = IACHAR(CMETHD(I:I)) call psb_bcast(ictxt,cmethd)
END DO call psb_bcast(ictxt,afmt)
! Broadcast parameters to all processors
call psb_bcast(ictxt,inparms(1:40))
DO I = 1, LEN(AFMT) read(*,*) ipart
INPARMS(I) = IACHAR(AFMT(I:I)) if (ip >= 5) then
END DO read(*,*) istopc
! Broadcast parameters to all processors else
call psb_bcast(ictxt,inparms(1:40)) istopc=1
endif
READ(*,*) IPART if (ip >= 6) then
IF (IP.GE.5) THEN read(*,*) itmax
READ(*,*) ISTOPC else
ELSE itmax=500
ISTOPC=1 endif
ENDIF if (ip >= 7) then
IF (IP.GE.6) THEN read(*,*) itrace
READ(*,*) ITMAX else
ELSE itrace=-1
ITMAX=500 endif
ENDIF if (ip >= 8) then
IF (IP.GE.7) THEN read(*,*) iprec
READ(*,*) ITRACE else
ELSE iprec=0
ITRACE=-1 endif
ENDIF if (ip >= 9) then
IF (IP.GE.8) THEN read(*,*) novr
READ(*,*) IPREC else
ELSE novr = 1
IPREC=0 endif
ENDIF if (ip >= 10) then
IF (IP.GE.9) THEN read(*,*) eps
READ(*,*) NOVR else
ELSE eps=1.d-6
NOVR = 1 endif
ENDIF inparms(1) = ipart
IF (IP.GE.10) THEN inparms(2) = istopc
READ(*,*) EPS inparms(3) = itmax
ELSE inparms(4) = itrace
EPS=1.D-6 inparms(5) = iprec
ENDIF inparms(6) = novr
! Broadcast parameters to all processors
INPARMS(1) = IPART
INPARMS(2) = ISTOPC
INPARMS(3) = ITMAX
INPARMS(4) = ITRACE
INPARMS(5) = IPREC
INPARMS(6) = NOVR
call psb_bcast(ictxt,inparms(1:6)) call psb_bcast(ictxt,inparms(1:6))
call psb_bcast(ictxt,eps) call psb_bcast(ictxt,eps)
write(*,'("Solving matrix : ",a40)')mtrx_file write(*,'("Solving matrix : ",a40)') mtrx_file
write(*,'("Number of processors : ",i3)')np write(*,'("Number of processors : ",i3)') np
write(*,'("Data distribution : ",i2)')ipart write(*,'("Data distribution : ",i2)') ipart
write(*,'("Preconditioner : ",i2)')iprec write(*,'("Preconditioner : ",i2)') iprec
if(iprec.gt.2) write(*,'("Overlapping levels : ",i2)')novr if(iprec.gt.2) write(*,'("Overlapping levels : ",i2)')novr
write(*,'("Iterative method : ",a40)')cmethd write(*,'("Iterative method : ",a40)') cmethd
write(*,'("Storage format : ",a3)')afmt(1:3) write(*,'("Storage format : ",a3)') afmt(1:3)
write(*,'(" ")') write(*,'(" ")')
else else
call pr_usage(0) call pr_usage(0)
@ -136,24 +119,12 @@ CONTAINS
end if end if
else else
! Receive Parameters ! Receive Parameters
call psb_bcast(ictxt,inparms(1:40)) call psb_bcast(ictxt,mtrx_file)
call psb_bcast(ictxt,rhs_file)
do i = 1, 40 call psb_bcast(ictxt,cmethd)
mtrx_file(i:i) = achar(inparms(i)) call psb_bcast(ictxt,afmt)
end do
call psb_bcast(ictxt,inparms(1:40))
DO I = 1, 40
CMETHD(I:I) = ACHAR(INPARMS(I))
END DO
call psb_bcast(ictxt,inparms(1:40))
DO I = 1, LEN(AFMT)
AFMT(I:I) = ACHAR(INPARMS(I))
END DO
call psb_bcast(ictxt,inparms(1:6)) call psb_bcast(ictxt,inparms(1:6))
ipart = inparms(1) ipart = inparms(1)
istopc = inparms(2) istopc = inparms(2)
itmax = inparms(3) itmax = inparms(3)
@ -164,21 +135,22 @@ CONTAINS
end if end if
END SUBROUTINE GET_PARMS end subroutine get_parms
SUBROUTINE PR_USAGE(IOUT)
INTEGER IOUT subroutine pr_usage(iout)
WRITE(IOUT, *) ' Number of parameters is incorrect!' integer iout
WRITE(IOUT, *) ' Use: hb_sample mtrx_file methd prec [ptype & write(iout, *) ' Number of parameters is incorrect!'
write(iout, *) ' Use: hb_sample mtrx_file methd prec [ptype &
&itmax istopc itrace]' &itmax istopc itrace]'
WRITE(IOUT, *) ' Where:' write(iout, *) ' Where:'
WRITE(IOUT, *) ' mtrx_file is stored in HB format' write(iout, *) ' mtrx_file is stored in HB format'
WRITE(IOUT, *) ' methd may be: CGSTAB ' write(iout, *) ' methd may be: CGSTAB '
WRITE(IOUT, *) ' ptype Partition strategy default 0' write(iout, *) ' ptype Partition strategy default 0'
WRITE(IOUT, *) ' 0: BLOCK partition ' write(iout, *) ' 0: BLOCK partition '
WRITE(IOUT, *) ' itmax Max iterations [500] ' write(iout, *) ' itmax Max iterations [500] '
WRITE(IOUT, *) ' istopc Stopping criterion [1] ' write(iout, *) ' istopc Stopping criterion [1] '
WRITE(IOUT, *) ' itrace 0 (no tracing, default) or ' write(iout, *) ' itrace 0 (no tracing, default) or '
WRITE(IOUT, *) ' >= 0 do tracing every ITRACE' write(iout, *) ' >= 0 do tracing every ITRACE'
WRITE(IOUT, *) ' iterations ' write(iout, *) ' iterations '
END SUBROUTINE PR_USAGE end subroutine pr_usage
END MODULE GETP end module getp

Write Preview
Loading…
Cancel
Save