Scribd Logo
Upload

Welcome to Scribd!

  • 122 views

    Avg PDF

    Uploaded by

    Samuel Alexander Marchant
    This is a command-line Fortran95 program(its code) i wrote around 2005 to try a nibble of the stuff(Fortran). It delivers simple mean or median or mode(by percentage band gather) on an array of numbers fed in at the command line.

    Copyright:

    Attribution Non-Commercial (BY-NC)
    Download as PDF, TXT or read online from Scribd

    Avg PDF

    Uploaded by

    Samuel Alexander Marchant
    122 views4 pages
    This is a command-line Fortran95 program(its code) i wrote around 2005 to try a nibble of the stuff(Fortran). It delivers simple mean or median or mode(by percentage band gather) on an array of numbers fed in at the command line.

    Original Title

    avg.pdf

    Copyright

    © Attribution Non-Commercial (BY-NC)

    Available Formats

    PDF, TXT or read online from Scribd

    Did you find this document useful?

    Is this content inappropriate?

    This is a command-line Fortran95 program(its code) i wrote around 2005 to try a nibble of the stuff(Fortran). It delivers simple mean or median or mode(by percentage band gather) on an array of numbers fed in at the command line.

    Copyright:

    Attribution Non-Commercial (BY-NC)
    Download as PDF, TXT or read online from Scribd
    Download as pdf or txt
    122 views4 pages

    Avg PDF

    Uploaded by

    Samuel Alexander Marchant
    This is a command-line Fortran95 program(its code) i wrote around 2005 to try a nibble of the stuff(Fortran). It delivers simple mean or median or mode(by percentage band gather) on an array of numbers fed in at the command line.

    Copyright:

    Attribution Non-Commercial (BY-NC)
    Download as PDF, TXT or read online from Scribd
    Download as pdf or txt
    of 4

    MODULE arrset

    REAL, DIMENSION(:),ALLOCATABLE :: set


    END MODULE
    PROGRAM AVG
    USE arrset
    IMPLICIT NONE
    ! ====================== WARNING = avg.f95 written by mr S.A.Marchant (www.nicephotog.net)
    20/3/2005
    ! ====================== WARNING = CLEAN OUT VAR LISTS OF USELESS USE VARS
    ! ====================== WARNING = CHECK MEDIAN LOOP COUNT AND TERMINATION(note
    array length -1)
    ! ====================== WARNING = DO WHILE S NEED COUNTERS ++
    INTEGER avtyp,lp,inpparr,arrlen,istor,imean,acout,act,xnxt,xa,xen,xben,xswp !user prompt entry,
    REAL media,trtot,tot,mean,stor,tcls,cls ! divisor , median , transfer var for total ,total,mean,loop swap var
    divis,qset,incount
    PRINT *,'INPUT THE INTEGER NUMBER OF THE QUANTITY OF RESULTS ' ! file handle input
    choice to do
    READ *, arrlen
    ALLOCATE(set(1:arrlen))
    ! ======================
    !en=arrlen+1
    PRINT *,'YOU MUST USE A FLOTING POINT NUMBER - ENTER INTEGERS WITH A DECIMAL POINT'
    PRINT *,'AND ONE TRAILING ZERO(MINIMUM)'
    DO lp = 1 , arrlen
    PRINT *,'ENTER THIS SINGULAR RECORD',lp ,' OF THE RESULT SET TO programme ARRAY'
    READ *, set(lp)
    END DO
    !print *,'set is ',set
    ! ======================
    tot=0
    DO lp = 1 , arrlen
    trtot=set(lp)+tot
    tot=trtot
    END DO
    mean = tot/arrlen
    ! ======================
    PRINT *,'FOR MEAN ENTER 1'
    PRINT *,'FOR MEDIAN ENTER 2'
    PRINT *,'FOR MODE ENTER 3'
    READ *, avtyp
    ! ======================START MAIN
    IF(avtyp==1) THEN
    !MEAN
    PRINT *,'MEAN IS', mean
    PRINT *,'ARRAY ',arrlen,' UNITS LENGTH'
    acout=1
    act=arrlen+1
    do while(act/=acout)
    PRINT *, set(acout)
    acout=acout+1
    end do
    print *,'END ARRAY'
    ! ====================================================END MEAN
    ELSE IF(avtyp==2) THEN
    !==== xnxt,xa,xen,xben,xswp
    xnxt=1
    xa=1 !index
    xen=arrlen ! assosciate next index
    xben=arrlen+1
    DO WHILE(xa/=xen)
    xnxt=xnxt+1
    if(xnxt/=xben)then
    !
    IF(set(xa) > set(xnxt))THEN
    xswp=set(xnxt)
    set(xnxt)=set(xa)
    set(xa)=xswp
    xnxt=xa
    ELSE IF(set(xa) == set(xnxt))THEN
    ! empty statement
    ELSE
    ! empty statement
    END IF
    !
    else
    xa=xa+1
    xnxt=xa
    end if
    END DO
    !MEDIAN use case range:with results (mean:set(lp))
    cls=mean+mean ! keeps above
    DO lp = 1 , arrlen
    stor=set(lp)
    if(stor < mean)then
    tcls=mean-stor
    else if(stor > mean)then
    tcls=stor-mean
    else
    ! ======================empty statement
    end if
    !==========
    istor = stor
    imean = mean
    if(istor==imean)then
    media=stor
    else if(tcls < cls)then
    cls=tcls
    media=stor
    else
    ! empty statement
    end if
    END DO
    PRINT *,'(NEAREST TO MEAN) MEDIAN VALUE IS ',media
    PRINT *,'mean is: ',mean
    PRINT *,'ARRAY ',arrlen,' UNITS LENGTH'
    acout=1
    act=arrlen+1
    do while(act/=acout)
    PRINT *, set(acout)
    acout=acout+1
    end do
    print *,'END ARRAY'
    ! ====================================================END MEDIAN
    ELSE IF(avtyp==3) THEN
    !Mode - the most common value for the predictor.
    !http://www.thearling.com/text/dmtechniques/dmtechniques.htm
    ! do a "SYNTHETIC MODE" % OF SAMPLES CLOSEST TOGETHER
    PRINT *,'ENTER ACCEPTABLE PERCENTAGE OF DEVIATION OF RESULTS AS INTEGER'
    PRINT *,'THE LARGEST RESULT IS USED AS THE GAUGE AND'
    PRINT *,'FRACTIONALY IS 100%(Handle)'
    READ *, inpparr
    CALL modal(set,arrlen,inpparr)
    ELSE
    PRINT *,'CANNOT RECOGNISE CHOICE'
    END IF
    ! ====================================================START SUBROUTINE
    CONTAINS
    SUBROUTINE modal(fset,lenum,inpp)
    IMPLICIT NONE
    REAL span,smp,spoo,parram,tstm,swp
    INTEGER nxt,stp,smplq,adsmp,nstp,a,lenum,inpp,en,cout,ct,ben
    REAL fset(lenum)
    nxt=1
    a=1 !index
    en=lenum ! assosciate next index
    ben=lenum+1
    ! ====================== SORT ARRAY ORDER TO LOWEST-(0)THROUGH HIGHEST-(LEN)
    DO WHILE(a/=en)
    nxt=nxt+1
    if(nxt/=ben)then
    !
    IF(fset(a) > fset(nxt))THEN
    swp=fset(nxt)
    fset(nxt)=fset(a)
    fset(a)=swp
    nxt=a
    ELSE IF(fset(a) == fset(nxt))THEN
    ! empty statement
    ELSE
    ! empty statement
    END IF
    !
    else
    a=a+1
    nxt=a
    end if
    END DO
    ! ====================== build specified parameter sample
    !above 50%of total qty in param bounds of sizing e.g. 3%
    smp = lenum/2 ! 50% approx minimum number for sample
    smplq = smp
    IF(smplq < 5)THEN
    adsmp = 0
    ELSE
    adsmp = 2
    END IF
    smp = smp+adsmp
    span = fset(lenum)-fset(1) ! result bounds
    spoo = span/100 ! 1%
    parram = inpp*spoo ! sample band width param setting size
    stp=1
    en=lenum+1
    DO
    nstp=stp+smp
    if(nstp > lenum)then
    PRINT *,'NO MODE GAINABLE FROM PARAMETER SETTINGS PERCENTAGE'
    cout=1
    ct=lenum+1
    print *,'ARRAY ',lenum,' UNITS LENGTH'
    do while(ct/=cout)
    print *, fset(cout)
    cout=cout+1
    end do
    EXIT
    else
    tstm = fset(nstp)-fset(stp)
    end if
    ! breadth sample now to be compared to specified gauge
    IF(tstm < parram)THEN
    print *,'(50%+group)MODE FOUND IN RANGE OF ',fset(stp),' TO ',fset(nstp)
    print *,'ARRAY ',lenum,' UNITS LENGTH'
    cout=1
    ct=lenum+1
    do while(ct/=cout)
    print *, fset(cout)
    cout=cout+1
    end do
    print *,'END ARRAY'
    print *,'ACCEPTED SAMPLE SET QUANTITY IS ', smp
    print *,'ACCEPTED SAMPLE DEVIATION IS ', inpp ,' PERCENT AND ',parram ,' SECTION SIZE UNIT'
    nstp=lenum+1
    EXIT
    ELSE
    stp=stp+1
    END IF
    END DO
    !
    END SUBROUTINE modal
    !
    END PROGRAM AVG

    You might also like