listout Subroutine

public subroutine listout(icurve_lists, icurve_expanded, inums_out, ierr)

NAME

listout(3f) - [M_strings:NUMERIC] expand a list of numbers where negative
numbers denote range ends (1 -10 means 1 thru 10)

(LICENSE:PD)

SYNOPSIS

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

DESCRIPTION

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].

OPTIONS

icurve_lists(:)      input array

RETURNS

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

EXAMPLE

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

AUTHOR

John S. Urban

LICENSE

Public Domain

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: icurve_lists(:)
integer, intent(out) :: icurve_expanded(:)
integer, intent(out) :: inums_out
integer, intent(out) :: ierr

Contents

Source Code


Source Code

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