listout(3f) - [M_strings:NUMERIC] expand a list of numbers where negative
numbers denote range ends (1 -10 means 1 thru 10)
(LICENSE:PD)
subroutine listout(icurve_lists,icurve_expanded,inums,ierr)
integer,intent(in) :: icurve_lists(:)
integer,intent(out) :: icurve_expanded(:)
integer,intent(out) :: inums
integer,intent(out) :: ierr
expand a list of whole numbers where negative numbers indicate a range.
So [10,-20] would be expanded to [10,11,12,13,14,15,16,17,18,19,20].
icurve_lists(:) input array
icurve_expanded(:) output array; assumed large enough to hold
returned list
inums number of icurve_expanded numbers on output
ierr zero if no error occurred
Sample program:
program demo_listout
use M_strings, only : listout
implicit none
integer,allocatable :: icurve_lists(:)
integer :: icurve_expanded(1000)
! icurve_lists is input array
integer :: inums
! icurve_expanded is output array
integer :: i
! number of icurve_lists values on input,
! number of icurve_expanded numbers on output
integer :: ierr
icurve_lists=[1, 20, -30, 101, 100, 99, 100, -120, 222, -200]
inums=size(icurve_lists)
call listout(icurve_lists,icurve_expanded,inums,ierr)
if(ierr == 0)then
write(*,'(i0)')(icurve_expanded(i),i=1,inums)
else
write(*,'(a,i0)')'error occurred in *listout* ',ierr
write(*,'(i0)')(icurve_expanded(i),i=1,inums)
endif
end program demo_listout
Results:
> 1 20 21 22 23
> 24 25 26 27 28
> 29 30 101 100 99
> 100 101 102 103 104
> 105 106 107 108 109
> 110 111 112 113 114
> 115 116 117 118 119
> 120 222 221 220 219
> 218 217 216 215 214
> 213 212 211 210 209
> 208 207 206 205 204
> 203 202 201 200
John S. Urban
Public Domain
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | icurve_lists(:) | |||
integer, | intent(out) | :: | icurve_expanded(:) | |||
integer, | intent(out) | :: | inums_out | |||
integer, | intent(out) | :: | ierr |
subroutine listout(icurve_lists,icurve_expanded,inums_out,ierr)
! ident_60="@(#) M_strings listout(3f) copy icurve_lists to icurve_expanded expanding negative numbers to ranges (1 -10 means 1 thru 10)"
! Created: 19971231
integer,intent(in) :: icurve_lists(:) ! input array
integer,intent(out) :: icurve_expanded(:) ! output array
integer,intent(out) :: inums_out ! number of icurve_expanded numbers on output
integer,intent(out) :: ierr ! status variable
character(len=80) :: temp1
integer :: i80, i90
integer :: imin, imax
integer :: idirection, icount
integer :: iin
integer :: inums_max
ierr=0
icurve_expanded=0 ! initialize output array
inums_out=0 ! initialize number of significant values in output array
inums_max=size(icurve_expanded)
if(inums_max == 0)then
ierr=-2
return
endif
iin=size(icurve_lists)
if(iin > 0)then
icurve_expanded(1)=icurve_lists(1)
endif
icount=2
do i90=2,iin
if(icurve_lists(i90) < 0)then
imax=abs(icurve_lists(i90))
imin=abs(icurve_lists(i90-1))
if(imin > imax)then
idirection=-1
imin=imin-1
elseif(imax > imin)then
idirection=1
imin=imin+1
else
idirection=1
endif
do i80=imin,imax,idirection
if(icount > inums_max) then
write(temp1,'(a,i5,a)')'*listout* only ',inums_max,' values allowed'
ierr=-1
call journal(temp1)
inums_out=icount-1
exit
endif
icurve_expanded(icount)=i80
icount=icount+1
enddo
else
icurve_expanded(icount)=icurve_lists(i90)
icount=icount+1
endif
enddo
inums_out=icount-1
end subroutine listout