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

Cosmetic adjustments to COO and BSRCH

Browse Source
omp-threadsafe
sfilippone 2 years ago
parent 739dc78a75
commit 494e29dd2e
8 changed files with 60 additions and 76 deletions
Show Stats Download Patch File Download Diff File

11
base/serial/impl/psb_c_coo_impl.F90
Unescape Escape View File

@ -3669,7 +3669,7 @@ subroutine psb_c_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
integer(psb_ipk_), allocatable :: ias(:),jas(:), ix2(:) integer(psb_ipk_), allocatable :: ias(:),jas(:), ix2(:)
complex(psb_spk_), allocatable :: vs(:) complex(psb_spk_), allocatable :: vs(:)
integer(psb_ipk_) :: nza, nzl,iret integer(psb_ipk_) :: nza, nzl,iret
integer(psb_ipk_) :: i,j, irw, icl, err_act, ip,is, imx, k, ii integer(psb_ipk_) :: i,j, irw, icl, err_act, ip,is, imx, k, ii, i1, i2
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name = 'psb_fixcoo' character(len=20) :: name = 'psb_fixcoo'
logical :: srt_inp, use_buffers logical :: srt_inp, use_buffers
@ -3759,7 +3759,7 @@ subroutine psb_c_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
!$OMP PARALLEL default(none) & !$OMP PARALLEL default(none) &
!$OMP shared(t0,t1,idxaux,ia,ja,val,ias,jas,vs,nthreads,sum,nr,nc,nzin,iaux,kaux,dupl,err) & !$OMP shared(t0,t1,idxaux,ia,ja,val,ias,jas,vs,nthreads,sum,nr,nc,nzin,iaux,kaux,dupl,err) &
!$OMP private(s,i,j,k,ithread,idxstart,idxend,work,nxt_val,old_val,saved_elem, & !$OMP private(s,i,j,k,ithread,idxstart,idxend,work,nxt_val,old_val,saved_elem, &
!$OMP first_elem,last_elem,nzl,iret,act_row) reduction(max: info) !$OMP first_elem,last_elem,nzl,iret,act_row,i1,i2) reduction(max: info)
!$OMP SINGLE !$OMP SINGLE
nthreads = omp_get_num_threads() nthreads = omp_get_num_threads()
@ -3783,7 +3783,7 @@ subroutine psb_c_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
call psi_exscan(nr+1,iaux,info,shift=ione) call psi_exscan(nr+1,iaux,info,shift=ione)
!$OMP BARRIER !$OMP BARRIER
!$OMP SINGLE !$OMP SINGLE
t0 = omp_get_wtime() !t0 = omp_get_wtime()
!$OMP END SINGLE !$OMP END SINGLE
! ------------------ Sorting and buffers ------------------- ! ------------------ Sorting and buffers -------------------
@ -3793,7 +3793,6 @@ subroutine psb_c_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
do j=idxstart,idxend do j=idxstart,idxend
idxaux(j) = iaux(j) idxaux(j) = iaux(j)
end do end do
! Here we sort data inside the auxiliary buffers ! Here we sort data inside the auxiliary buffers
do i=1,nzin do i=1,nzin
act_row = ia(i) act_row = ia(i)
@ -3807,8 +3806,8 @@ subroutine psb_c_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
!$OMP BARRIER !$OMP BARRIER
!$OMP SINGLE !$OMP SINGLE
t1 = omp_get_wtime() !t1 = omp_get_wtime()
write(0,*) 'Srt&Cpy :',t1-t0 !write(0,*) ithread,'Srt&Cpy :',t1-t0
!$OMP END SINGLE !$OMP END SINGLE
! Let's sort column indices and values. After that we will store ! Let's sort column indices and values. After that we will store
! the number of unique values in 'kaux' ! the number of unique values in 'kaux'

11
base/serial/impl/psb_d_coo_impl.F90
Unescape Escape View File

@ -3669,7 +3669,7 @@ subroutine psb_d_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
integer(psb_ipk_), allocatable :: ias(:),jas(:), ix2(:) integer(psb_ipk_), allocatable :: ias(:),jas(:), ix2(:)
real(psb_dpk_), allocatable :: vs(:) real(psb_dpk_), allocatable :: vs(:)
integer(psb_ipk_) :: nza, nzl,iret integer(psb_ipk_) :: nza, nzl,iret
integer(psb_ipk_) :: i,j, irw, icl, err_act, ip,is, imx, k, ii integer(psb_ipk_) :: i,j, irw, icl, err_act, ip,is, imx, k, ii, i1, i2
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name = 'psb_fixcoo' character(len=20) :: name = 'psb_fixcoo'
logical :: srt_inp, use_buffers logical :: srt_inp, use_buffers
@ -3759,7 +3759,7 @@ subroutine psb_d_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
!$OMP PARALLEL default(none) & !$OMP PARALLEL default(none) &
!$OMP shared(t0,t1,idxaux,ia,ja,val,ias,jas,vs,nthreads,sum,nr,nc,nzin,iaux,kaux,dupl,err) & !$OMP shared(t0,t1,idxaux,ia,ja,val,ias,jas,vs,nthreads,sum,nr,nc,nzin,iaux,kaux,dupl,err) &
!$OMP private(s,i,j,k,ithread,idxstart,idxend,work,nxt_val,old_val,saved_elem, & !$OMP private(s,i,j,k,ithread,idxstart,idxend,work,nxt_val,old_val,saved_elem, &
!$OMP first_elem,last_elem,nzl,iret,act_row) reduction(max: info) !$OMP first_elem,last_elem,nzl,iret,act_row,i1,i2) reduction(max: info)
!$OMP SINGLE !$OMP SINGLE
nthreads = omp_get_num_threads() nthreads = omp_get_num_threads()
@ -3783,7 +3783,7 @@ subroutine psb_d_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
call psi_exscan(nr+1,iaux,info,shift=ione) call psi_exscan(nr+1,iaux,info,shift=ione)
!$OMP BARRIER !$OMP BARRIER
!$OMP SINGLE !$OMP SINGLE
t0 = omp_get_wtime() !t0 = omp_get_wtime()
!$OMP END SINGLE !$OMP END SINGLE
! ------------------ Sorting and buffers ------------------- ! ------------------ Sorting and buffers -------------------
@ -3793,7 +3793,6 @@ subroutine psb_d_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
do j=idxstart,idxend do j=idxstart,idxend
idxaux(j) = iaux(j) idxaux(j) = iaux(j)
end do end do
! Here we sort data inside the auxiliary buffers ! Here we sort data inside the auxiliary buffers
do i=1,nzin do i=1,nzin
act_row = ia(i) act_row = ia(i)
@ -3807,8 +3806,8 @@ subroutine psb_d_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
!$OMP BARRIER !$OMP BARRIER
!$OMP SINGLE !$OMP SINGLE
t1 = omp_get_wtime() !t1 = omp_get_wtime()
write(0,*) 'Srt&Cpy :',t1-t0 !write(0,*) ithread,'Srt&Cpy :',t1-t0
!$OMP END SINGLE !$OMP END SINGLE
! Let's sort column indices and values. After that we will store ! Let's sort column indices and values. After that we will store
! the number of unique values in 'kaux' ! the number of unique values in 'kaux'

11
base/serial/impl/psb_s_coo_impl.F90
Unescape Escape View File

@ -3669,7 +3669,7 @@ subroutine psb_s_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
integer(psb_ipk_), allocatable :: ias(:),jas(:), ix2(:) integer(psb_ipk_), allocatable :: ias(:),jas(:), ix2(:)
real(psb_spk_), allocatable :: vs(:) real(psb_spk_), allocatable :: vs(:)
integer(psb_ipk_) :: nza, nzl,iret integer(psb_ipk_) :: nza, nzl,iret
integer(psb_ipk_) :: i,j, irw, icl, err_act, ip,is, imx, k, ii integer(psb_ipk_) :: i,j, irw, icl, err_act, ip,is, imx, k, ii, i1, i2
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name = 'psb_fixcoo' character(len=20) :: name = 'psb_fixcoo'
logical :: srt_inp, use_buffers logical :: srt_inp, use_buffers
@ -3759,7 +3759,7 @@ subroutine psb_s_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
!$OMP PARALLEL default(none) & !$OMP PARALLEL default(none) &
!$OMP shared(t0,t1,idxaux,ia,ja,val,ias,jas,vs,nthreads,sum,nr,nc,nzin,iaux,kaux,dupl,err) & !$OMP shared(t0,t1,idxaux,ia,ja,val,ias,jas,vs,nthreads,sum,nr,nc,nzin,iaux,kaux,dupl,err) &
!$OMP private(s,i,j,k,ithread,idxstart,idxend,work,nxt_val,old_val,saved_elem, & !$OMP private(s,i,j,k,ithread,idxstart,idxend,work,nxt_val,old_val,saved_elem, &
!$OMP first_elem,last_elem,nzl,iret,act_row) reduction(max: info) !$OMP first_elem,last_elem,nzl,iret,act_row,i1,i2) reduction(max: info)
!$OMP SINGLE !$OMP SINGLE
nthreads = omp_get_num_threads() nthreads = omp_get_num_threads()
@ -3783,7 +3783,7 @@ subroutine psb_s_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
call psi_exscan(nr+1,iaux,info,shift=ione) call psi_exscan(nr+1,iaux,info,shift=ione)
!$OMP BARRIER !$OMP BARRIER
!$OMP SINGLE !$OMP SINGLE
t0 = omp_get_wtime() !t0 = omp_get_wtime()
!$OMP END SINGLE !$OMP END SINGLE
! ------------------ Sorting and buffers ------------------- ! ------------------ Sorting and buffers -------------------
@ -3793,7 +3793,6 @@ subroutine psb_s_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
do j=idxstart,idxend do j=idxstart,idxend
idxaux(j) = iaux(j) idxaux(j) = iaux(j)
end do end do
! Here we sort data inside the auxiliary buffers ! Here we sort data inside the auxiliary buffers
do i=1,nzin do i=1,nzin
act_row = ia(i) act_row = ia(i)
@ -3807,8 +3806,8 @@ subroutine psb_s_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
!$OMP BARRIER !$OMP BARRIER
!$OMP SINGLE !$OMP SINGLE
t1 = omp_get_wtime() !t1 = omp_get_wtime()
write(0,*) 'Srt&Cpy :',t1-t0 !write(0,*) ithread,'Srt&Cpy :',t1-t0
!$OMP END SINGLE !$OMP END SINGLE
! Let's sort column indices and values. After that we will store ! Let's sort column indices and values. After that we will store
! the number of unique values in 'kaux' ! the number of unique values in 'kaux'

11
base/serial/impl/psb_z_coo_impl.F90
Unescape Escape View File

@ -3669,7 +3669,7 @@ subroutine psb_z_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
integer(psb_ipk_), allocatable :: ias(:),jas(:), ix2(:) integer(psb_ipk_), allocatable :: ias(:),jas(:), ix2(:)
complex(psb_dpk_), allocatable :: vs(:) complex(psb_dpk_), allocatable :: vs(:)
integer(psb_ipk_) :: nza, nzl,iret integer(psb_ipk_) :: nza, nzl,iret
integer(psb_ipk_) :: i,j, irw, icl, err_act, ip,is, imx, k, ii integer(psb_ipk_) :: i,j, irw, icl, err_act, ip,is, imx, k, ii, i1, i2
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name = 'psb_fixcoo' character(len=20) :: name = 'psb_fixcoo'
logical :: srt_inp, use_buffers logical :: srt_inp, use_buffers
@ -3759,7 +3759,7 @@ subroutine psb_z_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
!$OMP PARALLEL default(none) & !$OMP PARALLEL default(none) &
!$OMP shared(t0,t1,idxaux,ia,ja,val,ias,jas,vs,nthreads,sum,nr,nc,nzin,iaux,kaux,dupl,err) & !$OMP shared(t0,t1,idxaux,ia,ja,val,ias,jas,vs,nthreads,sum,nr,nc,nzin,iaux,kaux,dupl,err) &
!$OMP private(s,i,j,k,ithread,idxstart,idxend,work,nxt_val,old_val,saved_elem, & !$OMP private(s,i,j,k,ithread,idxstart,idxend,work,nxt_val,old_val,saved_elem, &
!$OMP first_elem,last_elem,nzl,iret,act_row) reduction(max: info) !$OMP first_elem,last_elem,nzl,iret,act_row,i1,i2) reduction(max: info)
!$OMP SINGLE !$OMP SINGLE
nthreads = omp_get_num_threads() nthreads = omp_get_num_threads()
@ -3783,7 +3783,7 @@ subroutine psb_z_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
call psi_exscan(nr+1,iaux,info,shift=ione) call psi_exscan(nr+1,iaux,info,shift=ione)
!$OMP BARRIER !$OMP BARRIER
!$OMP SINGLE !$OMP SINGLE
t0 = omp_get_wtime() !t0 = omp_get_wtime()
!$OMP END SINGLE !$OMP END SINGLE
! ------------------ Sorting and buffers ------------------- ! ------------------ Sorting and buffers -------------------
@ -3793,7 +3793,6 @@ subroutine psb_z_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
do j=idxstart,idxend do j=idxstart,idxend
idxaux(j) = iaux(j) idxaux(j) = iaux(j)
end do end do
! Here we sort data inside the auxiliary buffers ! Here we sort data inside the auxiliary buffers
do i=1,nzin do i=1,nzin
act_row = ia(i) act_row = ia(i)
@ -3807,8 +3806,8 @@ subroutine psb_z_fix_coo_inner_rowmajor(nr,nc,nzin,dupl,ia,ja,val,iaux,nzout,inf
!$OMP BARRIER !$OMP BARRIER
!$OMP SINGLE !$OMP SINGLE
t1 = omp_get_wtime() !t1 = omp_get_wtime()
write(0,*) 'Srt&Cpy :',t1-t0 !write(0,*) ithread,'Srt&Cpy :',t1-t0
!$OMP END SINGLE !$OMP END SINGLE
! Let's sort column indices and values. After that we will store ! Let's sort column indices and values. After that we will store
! the number of unique values in 'kaux' ! the number of unique values in 'kaux'

23
base/serial/sort/psb_d_qsort_impl.f90
Unescape Escape View File

@ -44,8 +44,8 @@ function psb_dbsrch(key,n,v,dir,find) result(ipos)
use psb_sort_mod, psb_protect_name => psb_dbsrch use psb_sort_mod, psb_protect_name => psb_dbsrch
implicit none implicit none
integer(psb_ipk_) :: ipos, n integer(psb_ipk_) :: ipos, n
real(psb_dpk_) :: key real(psb_dpk_) :: key
real(psb_dpk_) :: v(:) real(psb_dpk_) :: v(:)
integer(psb_ipk_), optional :: dir, find integer(psb_ipk_), optional :: dir, find
integer(psb_ipk_) :: lb, ub, m, i, k, dir_, find_ integer(psb_ipk_) :: lb, ub, m, i, k, dir_, find_
@ -95,40 +95,37 @@ real(psb_dpk_) :: v(:)
if ((m>n) .or. (m<1)) then if ((m>n) .or. (m<1)) then
m = n m = n
do while (m>=1) do while (m>=1)
if (v(m)<=key) then if (v(m)<=key) exit
ipos = m
exit
end if
m = m - 1 m = m - 1
end do end do
else else
do while (m<n) do while (m<n)
if (v(m)<=key) then if (v(m+1)<=key) then
m=m+1 m=m+1
else else
exit exit
end if end if
end do end do
end if end if
ipos = min(m,n)
case (psb_find_first_ge_ ) case (psb_find_first_ge_ )
if ((m>n) .or. (m<1)) then if ((m>n) .or. (m<1)) then
m = 1 m = 1
do while (m<=n) do while (m<=n)
if (v(m)>=key) then if (v(m)>=key) exit
ipos = m
exit
end if
m = m + 1 m = m + 1
end do end do
else else
do while (m>n) do while (m>1)
if (v(m)>=key) then if (v(m-1)>=key) then
m=m-1 m=m-1
else else
exit exit
end if end if
end do end do
end if end if
ipos = max(m,1)
case default case default
write(0,*) 'Wrong FIND' write(0,*) 'Wrong FIND'
end select end select

23
base/serial/sort/psb_e_qsort_impl.f90
Unescape Escape View File

@ -44,8 +44,8 @@ function psb_ebsrch(key,n,v,dir,find) result(ipos)
use psb_sort_mod, psb_protect_name => psb_ebsrch use psb_sort_mod, psb_protect_name => psb_ebsrch
implicit none implicit none
integer(psb_ipk_) :: ipos, n integer(psb_ipk_) :: ipos, n
integer(psb_epk_) :: key integer(psb_epk_) :: key
integer(psb_epk_) :: v(:) integer(psb_epk_) :: v(:)
integer(psb_ipk_), optional :: dir, find integer(psb_ipk_), optional :: dir, find
integer(psb_ipk_) :: lb, ub, m, i, k, dir_, find_ integer(psb_ipk_) :: lb, ub, m, i, k, dir_, find_
@ -95,40 +95,37 @@ integer(psb_epk_) :: v(:)
if ((m>n) .or. (m<1)) then if ((m>n) .or. (m<1)) then
m = n m = n
do while (m>=1) do while (m>=1)
if (v(m)<=key) then if (v(m)<=key) exit
ipos = m
exit
end if
m = m - 1 m = m - 1
end do end do
else else
do while (m<n) do while (m<n)
if (v(m)<=key) then if (v(m+1)<=key) then
m=m+1 m=m+1
else else
exit exit
end if end if
end do end do
end if end if
ipos = min(m,n)
case (psb_find_first_ge_ ) case (psb_find_first_ge_ )
if ((m>n) .or. (m<1)) then if ((m>n) .or. (m<1)) then
m = 1 m = 1
do while (m<=n) do while (m<=n)
if (v(m)>=key) then if (v(m)>=key) exit
ipos = m
exit
end if
m = m + 1 m = m + 1
end do end do
else else
do while (m>n) do while (m>1)
if (v(m)>=key) then if (v(m-1)>=key) then
m=m-1 m=m-1
else else
exit exit
end if end if
end do end do
end if end if
ipos = max(m,1)
case default case default
write(0,*) 'Wrong FIND' write(0,*) 'Wrong FIND'
end select end select

23
base/serial/sort/psb_m_qsort_impl.f90
Unescape Escape View File

@ -44,8 +44,8 @@ function psb_mbsrch(key,n,v,dir,find) result(ipos)
use psb_sort_mod, psb_protect_name => psb_mbsrch use psb_sort_mod, psb_protect_name => psb_mbsrch
implicit none implicit none
integer(psb_ipk_) :: ipos, n integer(psb_ipk_) :: ipos, n
integer(psb_mpk_) :: key integer(psb_mpk_) :: key
integer(psb_mpk_) :: v(:) integer(psb_mpk_) :: v(:)
integer(psb_ipk_), optional :: dir, find integer(psb_ipk_), optional :: dir, find
integer(psb_ipk_) :: lb, ub, m, i, k, dir_, find_ integer(psb_ipk_) :: lb, ub, m, i, k, dir_, find_
@ -95,40 +95,37 @@ integer(psb_mpk_) :: v(:)
if ((m>n) .or. (m<1)) then if ((m>n) .or. (m<1)) then
m = n m = n
do while (m>=1) do while (m>=1)
if (v(m)<=key) then if (v(m)<=key) exit
ipos = m
exit
end if
m = m - 1 m = m - 1
end do end do
else else
do while (m<n) do while (m<n)
if (v(m)<=key) then if (v(m+1)<=key) then
m=m+1 m=m+1
else else
exit exit
end if end if
end do end do
end if end if
ipos = min(m,n)
case (psb_find_first_ge_ ) case (psb_find_first_ge_ )
if ((m>n) .or. (m<1)) then if ((m>n) .or. (m<1)) then
m = 1 m = 1
do while (m<=n) do while (m<=n)
if (v(m)>=key) then if (v(m)>=key) exit
ipos = m
exit
end if
m = m + 1 m = m + 1
end do end do
else else
do while (m>n) do while (m>1)
if (v(m)>=key) then if (v(m-1)>=key) then
m=m-1 m=m-1
else else
exit exit
end if end if
end do end do
end if end if
ipos = max(m,1)
case default case default
write(0,*) 'Wrong FIND' write(0,*) 'Wrong FIND'
end select end select

23
base/serial/sort/psb_s_qsort_impl.f90
Unescape Escape View File

@ -44,8 +44,8 @@ function psb_sbsrch(key,n,v,dir,find) result(ipos)
use psb_sort_mod, psb_protect_name => psb_sbsrch use psb_sort_mod, psb_protect_name => psb_sbsrch
implicit none implicit none
integer(psb_ipk_) :: ipos, n integer(psb_ipk_) :: ipos, n
real(psb_spk_) :: key real(psb_spk_) :: key
real(psb_spk_) :: v(:) real(psb_spk_) :: v(:)
integer(psb_ipk_), optional :: dir, find integer(psb_ipk_), optional :: dir, find
integer(psb_ipk_) :: lb, ub, m, i, k, dir_, find_ integer(psb_ipk_) :: lb, ub, m, i, k, dir_, find_
@ -95,40 +95,37 @@ real(psb_spk_) :: v(:)
if ((m>n) .or. (m<1)) then if ((m>n) .or. (m<1)) then
m = n m = n
do while (m>=1) do while (m>=1)
if (v(m)<=key) then if (v(m)<=key) exit
ipos = m
exit
end if
m = m - 1 m = m - 1
end do end do
else else
do while (m<n) do while (m<n)
if (v(m)<=key) then if (v(m+1)<=key) then
m=m+1 m=m+1
else else
exit exit
end if end if
end do end do
end if end if
ipos = min(m,n)
case (psb_find_first_ge_ ) case (psb_find_first_ge_ )
if ((m>n) .or. (m<1)) then if ((m>n) .or. (m<1)) then
m = 1 m = 1
do while (m<=n) do while (m<=n)
if (v(m)>=key) then if (v(m)>=key) exit
ipos = m
exit
end if
m = m + 1 m = m + 1
end do end do
else else
do while (m>n) do while (m>1)
if (v(m)>=key) then if (v(m-1)>=key) then
m=m-1 m=m-1
else else
exit exit
end if end if
end do end do
end if end if
ipos = max(m,1)
case default case default
write(0,*) 'Wrong FIND' write(0,*) 'Wrong FIND'
end select end select

Write Preview
Loading…
Cancel
Save