Program g08ahfe ! G08AHF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g08ahf, g08ajf, g08akf, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: p, pexact, u, unor Integer :: ifail, liwrk, lwrk, lwrk1, lwrk2, & lwrk3, mn, n1, n2, nsum Logical :: ties Character (1) :: tail ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: ranks(:), wrk(:), x(:), y(:) Integer, Allocatable :: iwrk(:) ! .. Intrinsic Procedures .. Intrinsic :: int, max, min ! .. Executable Statements .. Write (nout,*) 'G08AHF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read in problem size Read (nin,*) n1, n2, tail ! Calculate sizes of various workspaces nsum = n1 + n2 mn = min(n1,n2) ! Workspace for G08AHF lwrk1 = nsum ! Workspace for G08AJF lwrk2 = int(n1*n2/2) + 1 ! Workspace for G08AKF lwrk3 = mn + mn*(mn+1)*nsum - mn*(mn+1)*(2*mn+1)/3 + 1 liwrk = 2*nsum + 2 lwrk = max(lwrk1,lwrk2,lwrk3) Allocate (x(n1),y(n2),ranks(nsum),wrk(lwrk),iwrk(liwrk)) ! Read in data Read (nin,*) x(1:n1) Read (nin,*) y(1:n2) ! Display title Write (nout,*) 'Mann-Whitney U test' Write (nout,*) ! Display input data Write (nout,99999) 'Sample size of group 1 = ', n1 Write (nout,99999) 'Sample size of group 2 = ', n2 Write (nout,*) Write (nout,*) 'Data values' Write (nout,*) Write (nout,99998) ' Group 1 ', x(1:n1) Write (nout,*) Write (nout,99998) ' Group 2 ', y(1:n2) ! Perform test ifail = 0 Call g08ahf(n1,x,n2,y,tail,u,unor,p,ties,ranks,wrk,ifail) ! Calculate exact probabilities If (.Not. ties) Then ifail = 0 Call g08ajf(n1,n2,tail,u,pexact,wrk,lwrk,ifail) Else ifail = 0 Call g08akf(n1,n2,tail,ranks,u,pexact,wrk,lwrk,iwrk,ifail) End If ! Display results Write (nout,*) Write (nout,99997) 'Test statistic = ', u Write (nout,99997) 'Normal Statistic = ', unor Write (nout,99997) 'Approx. tail probability = ', p Write (nout,*) If (ties) Then Write (nout,*) 'There are ties in the pooled sample' Else Write (nout,*) 'There are no ties in the pooled sample' End If Write (nout,*) Write (nout,99997) 'Exact tail probability = ', pexact 99999 Format (1X,A,I5) 99998 Format (1X,A,8F5.1,2(/14X,8F5.1)) 99997 Format (1X,A,F10.4) End Program g08ahfe