SUBROUTINE DP2CHS(Y1,Y2,X1,X2,MAXNXT, 1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR) C C PURPOSE--COMPUTE A 2-SAMPLE CHI-SQUARE TEST C THAT 2 SAMPLES ARE FROM THE SAME DISTRIBUTION C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--98/12 C ORIGINAL VERSION--DECEMBER 1998. C UPDATED --MARCH 2006. SUPPORT FOR DIFFERENT DEFAULT C BINNING ALGORITHMS C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ICASPL CHARACTER*4 IBUGA2 CHARACTER*4 IBUGA3 CHARACTER*4 IBUGQ CHARACTER*4 ISUBRO CHARACTER*4 IFOUND CHARACTER*4 IERROR C CHARACTER*4 IHWUSE CHARACTER*4 MESSAG CHARACTER*4 ICASEQ CHARACTER*4 IDATSW CHARACTER*4 IHLEFT CHARACTER*4 IHLEF2 CHARACTER*4 IHRIGH CHARACTER*4 IHRIG2 CHARACTER*4 IHR2GH CHARACTER*4 IHR2G2 CHARACTER*4 IERRO4 C CHARACTER*4 IH CHARACTER*4 IH2 CHARACTER*4 ISUBN0 C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C C--------------------------------------------------------------------- C INCLUDE 'DPCOPA.INC' C DIMENSION Y1(*) DIMENSION Y2(*) DIMENSION X1(*) DIMENSION X2(*) DIMENSION ZX1(MAXOBV) DIMENSION ZX2(MAXOBV) DIMENSION ZY1(MAXOBV) DIMENSION ZY2(MAXOBV) DIMENSION XTEMP(MAXOBV) INCLUDE 'DPCOZZ.INC' EQUIVALENCE (GARBAG(IGARB1),ZY1(1)) EQUIVALENCE (GARBAG(IGARB2),ZY2(1)) EQUIVALENCE (GARBAG(IGARB3),ZX1(1)) EQUIVALENCE (GARBAG(IGARB4),ZX2(1)) EQUIVALENCE (GARBAG(IGARB5),XTEMP(1)) C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOHK.INC' INCLUDE 'DPCODA.INC' INCLUDE 'DPCOSU.INC' INCLUDE 'DPCOST.INC' INCLUDE 'DPCOS2.INC' INCLUDE 'DPCOHO.INC' INCLUDE 'DPCOMC.INC' INCLUDE 'DPCOF2.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IERROR='NO' C ISUBN1='DP2C' ISUBN2='CH ' C MAXCP1=MAXCOL+1 MAXCP2=MAXCOL+2 MAXCP3=MAXCOL+3 MAXCP4=MAXCOL+4 MAXCP5=MAXCOL+5 MAXCP6=MAXCOL+6 C MAXV2=3 MINN2=3 C ICOLR=0 C C ****************************************** C ** TREAT THE CHI-SQUARE 2 SAMPLE CASE ** C ****************************************** C IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS')THEN WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DP2CHS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)ICASPL 52 FORMAT('ICASPL = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IBUGA2,IBUGA3,IBUGQ 53 FORMAT('IBUGA2,IBUGA3,IBUGQ = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') ENDIF C C *************************** C ** STEP 1-- ** C ** EXTRACT THE COMMAND ** C *************************** C ISTEPN='1' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C C RECOGNIZE THE FOLLOWING FORMS FOR THE COMMAND: C CHI SQUARE 2 SAMPLE TEST Y1 Y2 C CHISQUARE 2 SAMPLE TEST Y1 Y2 C CHI SQUARE TWO SAMPLE TEST Y1 Y2 C CHISQUARE TWO SAMPLE TEST Y1 Y2 C 2 SAMPLE CHI SQUARE TEST Y1 Y2 C 2 SAMPLE CHISQUARE TEST Y1 Y2 C TWO SAMPLE CHI SQUARE TEST Y1 Y2 C TWO SAMPLE CHISQUARE TEST Y1 Y2 C THE WORD TEST IS OPTIONAL. IN ADDITION, FOR PRE-BINNED DATA, C THERE CAN BE AN X VARIABLE AT THE END. C IF(ICOM.EQ.'CHI')THEN IF(NUMARG.GE.3.AND.IHARG(1).EQ.'SQUA'.AND. 1 IHARG(2).EQ.'2'.AND.IHARG(3).EQ.'SAMP')THEN ISHIFT=3 GOTO112 ELSEIF(NUMARG.GE.3.AND.IHARG(1).EQ.'SQUA'.AND. 1 IHARG(2).EQ.'TWO'.AND.IHARG(3).EQ.'SAMP')THEN ISHIFT=3 GOTO112 ENDIF ELSEIF(ICOM.EQ.'CHIS')THEN IF(NUMARG.GE.2.AND.IHARG(1).EQ.'2'.AND.IHARG(2).EQ.'SAMP')THEN ISHIFT=2 GOTO112 ELSEIF(NUMARG.GE.2.AND.IHARG(1).EQ.'TWO'.AND. 1 IHARG(2).EQ.'SAMP')THEN ISHIFT=2 GOTO112 ENDIF ELSEIF(ICOM.EQ.'2'.OR.ICOM.EQ.'TWO')THEN IF(NUMARG.GE.3.AND.IHARG(1).EQ.'SAMP'.AND. 1 IHARG(2).EQ.'CHI'.AND.IHARG(3).EQ.'SQUA')THEN ISHIFT=3 GOTO112 ELSEIF(NUMARG.GE.2.AND.IHARG(1).EQ.'SAMP'.AND. 1 IHARG(2).EQ.'CHIS')THEN ISHIFT=2 GOTO112 ENDIF ENDIF C C ----------NO MATCH FOUND---------- C ICASPL=' ' IFOUND='NO' GOTO9000 C 112 CONTINUE ICASPL='2CHS' CALL ADJUST(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG) IFOUND='YES' IF(IHARG(1).EQ.'TEST')THEN ISHIFT=1 CALL ADJUST(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG) ENDIF GOTO190 C 190 CONTINUE C C ******************************************************* C ** STEP 2-- ** C ** CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS. ** C ******************************************************* C ISTEPN='2' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C MINNA=1 MAXNA=100 CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C C ******************************************** C ** STEP 3-- ** C ** CHECK THE VALIDITY OF ARGUMENT 1 ** C ** (THIS WILL BE THE RESPONSE VARIABLE) ** C ******************************************** C ISTEPN='3' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IHLEFT=IHARG(1) IHLEF2=IHARG2(1) IHWUSE='V' MESSAG='YES' CALL CHECKN(IHLEFT,IHLEF2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR) IF(IERROR.EQ.'YES')GOTO9000 ICOLL=IVALUE(ILOCV) NLEFT=IN(ILOCV) IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS') 1WRITE(ICOUT,211)IHLEFT,IHLEF2,ICOLL,NLEFT 211 FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,A4,I8,I8) IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS')CALL DPWRST('XXX','BUG ') C C ******************************************************* C ** STEP 4-- ** C ** CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT) C ** FOR THE RESPONSE VARIABLE IS POSITIVE. ** C ******************************************************* C ISTEPN='4' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NLEFT.GE.MINN2)GOTO390 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,311) 311 FORMAT('***** ERROR IN DP2CHS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,312)IHLEFT,IHLEF2 312 FORMAT(' THE INPUT NUMBER OF OBSERVATIONS ', 1'IN VARIABLE ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,313) 313 FORMAT(' (FOR WHICH A CHI-SQUARE 2 SAMPLE TEST WAS TO ', 1'HAVE BEEN FORMED)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,315)MINN2 315 FORMAT(' MUST BE ',I8,' OR LARGER; SUCH WAS NOT THE ', 1'CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,317) 317 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)THEN WRITE(ICOUT,318)(IANS(I),I=1,MIN(80,IWIDTH)) 318 FORMAT(80A1) CALL DPWRST('XXX','BUG ') ENDIF IERROR='YES' GOTO9000 C 390 CONTINUE C C ***************************************** C ** STEP 5-- ** C ** CHECK TO SEE THE TYPE SUBCASE ** C ** (BASED ON THE QUALIFIER)-- ** C ** 1) UNQUALIFIED (THAT IS, FULL); ** C ** 2) SUBSET/EXCEPT; OR ** C ** 3) FOR. ** C ***************************************** C ISTEPN='5' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICASEQ='FULL' ILOCQ=NUMARG+1 IF(NUMARG.LT.1)GOTO480 DO400J=1,NUMARG J1=J IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET ') GOTO410 IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT ') GOTO410 IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.' ') GOTO420 400 CONTINUE GOTO490 410 CONTINUE ICASEQ='SUBS' ILOCQ=J1 GOTO490 420 CONTINUE ICASEQ='FOR' ILOCQ=J1 GOTO490 C 480 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,481) 481 FORMAT('***** INTERNAL ERROR IN DP2CHS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,482) 482 FORMAT(' AT BRANCH POINT 481--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,483) 483 FORMAT(' NUMARG LESS THAN 1 EVEN THOUGH') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,484) 484 FORMAT(' NUMARG HAD PREVIOUSLY PASSED THIS TEST') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,485)NUMARG 485 FORMAT(' ONCE ALREADY. VALUE OF NUMARG = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,486) 486 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,487)(IANS(I),I=1,IWIDTH) 487 FORMAT(' ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 490 CONTINUE IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'2CHS')GOTO495 WRITE(ICOUT,491)NUMARG,ILOCQ,ICASEQ 491 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4) CALL DPWRST('XXX','BUG ') 495 CONTINUE C C ****************************************************** C ** STEP 6-- ** C ** CHECK FOR REQUIRED SECOND ARGUMENT AND ** C ** OPTIONAL THIRD ARGUMENT. ** C ****************************************************** C ISTEPN='6' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C NUMV2=ILOCQ-1 IDATSW='RAW' IF(NUMV2.EQ.2)IDATSW='RAW' IF(NUMV2.EQ.2)GOTO509 IF(NUMV2.EQ.3)IDATSW='FREQ' IF(NUMV2.EQ.3)GOTO509 GOTO550 C 509 CONTINUE IHRIGH=IHARG(2) IHRIG2=IHARG2(2) IHWUSE='V' MESSAG='YES' CALL CHECKN(IHRIGH,IHRIG2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR) IF(IERROR.EQ.'YES')GOTO9000 ICOLR=IVALUE(ILOCV) NRIGHT=IN(ILOCV) IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS') 1WRITE(ICOUT,511)IHRIGH,IHRIG2,ICOLR,NRIGHT 511 FORMAT('IHRIGH,IHRIG2,ICOLR,NRIGHT = ',A4,2X,A4,I8,I8) IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS')CALL DPWRST('XXX','BUG ') 510 CONTINUE C IF(NUMV2.GT.2)GOTO519 GOTO570 C 519 CONTINUE IHR2GH=IHARG(3) IHR2G2=IHARG2(3) IHWUSE='V' MESSAG='YES' CALL CHECKN(IHR2GH,IHR2G2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR) IF(IERROR.EQ.'YES')GOTO9000 ICOL3=IVALUE(ILOCV) NRIGH2=IN(ILOCV) IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS') 1WRITE(ICOUT,521)IHR2GH,IHR2G2,ICOL3,NRIGH2 521 FORMAT('IHR2GH,IHR2G2,ICOL3,NRIGH2 = ',A4,2X,A4,I8,I8) IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS')CALL DPWRST('XXX','BUG ') 530 CONTINUE C GOTO570 C C 550 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,551) 551 FORMAT('***** ERROR IN DP2CHS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,552) 552 FORMAT(' FOR A CHI-SQUARE 2 SAMPLE TEST, ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,558) 558 FORMAT(' THE NUMBER OF VARIABLES MUST BE EITHER 2 OR 3 ;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,560) 560 FORMAT(' SUCH WAS NOT THE CASE HERE; THE SPECIFIED NUMBER') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,562)NUMV2 562 FORMAT(' OF VARIABLES WAS ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,563) 563 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)THEN WRITE(ICOUT,564)(IANS(I),I=1,MIN(IWIDTH,80)) 564 FORMAT(80A1) CALL DPWRST('XXX','BUG ') ENDIF IERROR='YES' GOTO9000 C 570 CONTINUE IF(NUMV2.NE.3)GOTO590 IF((NLEFT.NE.NRIGHT).OR.(NLEFT.NE.NRIGH2))THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,571) 571 FORMAT('***** ERROR IN DP2CHS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,572) 572 FORMAT(' FOR A CHI-SQUARE 2 SAMPLE TEST, WHEN HAVE 3 ', 1'VARIABLES SPECIFIED') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,579) 579 FORMAT(' THE NUMBER OF ELEMENTS IN THE 3 VARIABLES MUST ', 1'BE THE SAME;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,582) 582 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,584)IHLEFT,IHLEF2,NLEFT 584 FORMAT(' THE FIRST VARIABLE, ',A4,A4,', HAS ',I8, 1' ELEMENTS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,586)IHRIGH,IHRIG2,NRIGHT 586 FORMAT(' THE SECOND VARIABLE, ',A4,A4,', HAS ',I8, 1' ELEMENTS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,588)IHR2GH,IHR2G2,NRIGH2 588 FORMAT(' THE THIRD VARIABLE, ',A4,A4,', HAS ',I8, 1' ELEMENTS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,589) 589 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)THEN WRITE(ICOUT,592)(IANS(I),I=1,MIN(80,IWIDTH)) 592 FORMAT(80A1) CALL DPWRST('XXX','BUG ') ENDIF IERROR='YES' GOTO9000 ENDIF C 590 CONTINUE C C ***************************************** C ** STEP 7-- ** C ** BRANCH TO THE APPROPRIATE SUBCASE; ** C ** (BASED ON THE QUALIFIER) ** C ** THEN FORM THE RESPONSE VARIABLE ** C ** AND THE FACTORS ** C ** AND CARRY OUT THE PLOTS. ** C ***************************************** C ISTEPN='7' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IMAX=MAX(NLEFT,NRIGHT) IF(NUMV2.EQ.3)IMAX=MAX(IMAX,NRIGH2) IF(ICASEQ.EQ.'FULL')GOTO610 IF(ICASEQ.EQ.'SUBS')GOTO620 IF(ICASEQ.EQ.'FOR')GOTO630 C 610 CONTINUE DO615I=1,IMAX ISUB(I)=1 615 CONTINUE NQ=IMAX GOTO650 C 620 CONTINUE NIOLD=IMAX CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4) NQ=NIOLD GOTO650 C 630 CONTINUE NIOLD=IMAX CALL DPFOR(NIOLD,NFOR,IROW1,IROWN, 1NLOCAL,ILOCS,NS,IBUGQ,IERROR) NQ=NFOR GOTO650 C 650 CONTINUE J=0 IF(NQ.LT.NLEFT)IMAX=NQ N1=0 N2=0 N3=0 DO660I=1,IMAX IF(ISUB(I).EQ.0)GOTO660 J=J+1 C IF(NUMV2.GE.1.AND.I.LE.NLEFT)THEN N1=N1+1 IJ=MAXN*(ICOLL-1)+I IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ) IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I) IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I) IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I) IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I) IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I) IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I) ENDIF C IF(NUMV2.GE.2.AND.I.LE.NRIGHT)THEN N2=N2+1 IJ=MAXN*(ICOLR-1)+I IF(ICOLR.LE.MAXCOL)Y2(J)=V(IJ) IF(ICOLR.EQ.MAXCP1)Y2(J)=PRED(I) IF(ICOLR.EQ.MAXCP2)Y2(J)=RES(I) IF(ICOLR.EQ.MAXCP3)Y2(J)=YPLOT(I) IF(ICOLR.EQ.MAXCP4)Y2(J)=XPLOT(I) IF(ICOLR.EQ.MAXCP5)Y2(J)=X2PLOT(I) IF(ICOLR.EQ.MAXCP6)Y2(J)=TAGPLO(I) ENDIF C IF(NUMV2.GE.3.AND.I.LE.NRIGH2)THEN N3=N3+1 IJ=MAXN*(ICOL3-1)+I IF(ICOL3.LE.MAXCOL)X1(J)=V(IJ) IF(ICOL3.EQ.MAXCP1)X1(J)=PRED(I) IF(ICOL3.EQ.MAXCP2)X1(J)=RES(I) IF(ICOL3.EQ.MAXCP3)X1(J)=YPLOT(I) IF(ICOL3.EQ.MAXCP4)X1(J)=XPLOT(I) IF(ICOL3.EQ.MAXCP5)X1(J)=X2PLOT(I) IF(ICOL3.EQ.MAXCP6)X1(J)=TAGPLO(I) ENDIF C 660 CONTINUE C C ***************************************************** C ** STEP 9-- ** C ** COMPUTE THE CHI-SQUARE 2 SAMPLE ** C ** TEST ** C ***************************************************** C ISTEPN='9' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'2CHS')GOTO5190 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5111) 5111 FORMAT('***** FROM THE MIDDLE OF DP2CHS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5112)ICASPL,NUMV2,N1,N2,N3,IDATSW 5112 FORMAT('ICASPL,NUMV2,N1,N2,N3,IDATSW = ',A4,I8,2X,3I8,2X,A4) CALL DPWRST('XXX','BUG ') DO5116I=1,N1 WRITE(ICOUT,5117)I,Y1(I),Y2(I),X1(I) 5117 FORMAT('I,Y1(I),Y2(I),X1(I) = ',I8,3E15.7) CALL DPWRST('XXX','BUG ') 5116 CONTINUE 5190 CONTINUE C CLWID=CLWIDT(1) XSTART=CLLIMI(1) XSTOP=CLLIMI(2) C CALL DP2CH2(Y1,Y2,X1,X2,N1,N2,N3,ICASPL,IDATSW,IRHSTG, 1CLWID,XSTART,XSTOP, 1XTEMP,IHSTCW,MAXOBV, 1STATVA,STATCD,STATNU,CUTU90,CUTU95,CUTU99, 1ZY1,ZY2,ZX1,ZX2,NFREQ,IBUGA3,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C C *************************************** C ** STEP 7-- ** C ** UPDATE INTERNAL DATAPLOT TABLES ** C *************************************** C ISTEPN='7' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ISUBN0='DPCH' C IH='STAT' IH2='VAL ' VALUE0=STATVA CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='STAT' IH2='NU ' VALUE0=STATNU CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='STAT' IH2='CDF ' VALUE0=STATCD CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTU' IH2='PP90' VALUE0=CUTU90 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTU' IH2='PP95' VALUE0=CUTU95 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTU' IH2='PP99' VALUE0=CUTU99 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'2CHS')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DP2CHS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IFOUND,IERROR 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)NFREQ,ICASPL 9013 FORMAT('NFREQ,ICASPL = ',I8,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DP2CH2(Y1,Y2,X1,X2,N1,N2,N3,ICASPL,IDATSW,IRHSTG, 1CLWID,XSTART,XSTOP, 1XTEMP,IHSTCW,MAXOBV, 1STATVA,STATCD,STATNU,CUTH90,CUTH95,CUTH99, 1ZY1,ZY2,ZX1,ZX2,M2,IBUGA3,IERROR) C C PURPOSE--COMPUTE A 2-SAMPLE CHI-SQUARE TEST C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--98/11 C ORIGINAL VERSION--DECEMBER 1998. C UPDATED --MARCH 2006. SUPPORT FOR DIFFERENT DEFAULT C BINNING ALGORITHMS C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ICASPL CHARACTER*4 IDATSW CHARACTER*4 IRHSTG CHARACTER*4 IHSTCW CHARACTER*4 IBUGA3 CHARACTER*4 IERROR C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C CHARACTER*4 IWRIT2 C CHARACTER*4 IRELAT C CHARACTER*6 ICONC1 CHARACTER*6 ICONC2 CHARACTER*6 ICONC3 C DOUBLE PRECISION DSUM1 DOUBLE PRECISION DTEMP1 DOUBLE PRECISION DTEMP2 DOUBLE PRECISION DTEMP3 DOUBLE PRECISION DFACT1 DOUBLE PRECISION DFACT2 C C--------------------------------------------------------------------- C DIMENSION Y1(*) DIMENSION Y2(*) DIMENSION X1(*) DIMENSION X2(*) DIMENSION ZY1(*) DIMENSION ZY2(*) DIMENSION ZX1(*) DIMENSION ZX2(*) DIMENSION XTEMP(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C C ISUBN1='DP2C' ISUBN2='H2 ' C IRELAT='OFF' IERROR='NO' C C ******************************************** C ** STEP 1-- ** C ** CHECK THE INPUT ARGUMENTS FOR ERRORS ** C ******************************************** C NMIN=MIN(N1,N2) IF(IDATSW.EQ.'FREQ')NMIN=MIN(NMIN,N3) C IF(NMIN.LT.2)THEN WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,31) 31 FORMAT('***** ERROR IN DP2CH2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,32) 32 FORMAT(' THE NUMBER OF OBSERVATIONS FOR EACH VARIABLE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,33) 33 FORMAT(' MUST BE AT LEAST 1;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,34)N1 34 FORMAT(' THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 = ',I6) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,35)N2 35 FORMAT(' THE NUMBER OF OBSERVATIONS FOR VARIABLE 2 = ',I6) CALL DPWRST('XXX','BUG ') IF(IDATSW.EQ.'FREQ')THEN WRITE(ICOUT,36)N3 36 FORMAT(' THE NUMBER OF OBSERVATIONS FOR VARIABLE 3 = ',I6) CALL DPWRST('XXX','BUG ') ENDIF WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 ENDIF C IF(IBUGA3.EQ.'OFF')GOTO80 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,71) 71 FORMAT('***** AT THE BEGINNING OF DP2CH2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,72)ICASPL,IDATSW,N1,N2,N3 72 FORMAT('ICASPL,IDATSW,N1,N2,N3 = ',A4,2X,A4,2X,4I8) CALL DPWRST('XXX','BUG ') DO85I=1,N1 WRITE(ICOUT,86)I,Y1(I),Y2(I),X1(I),X2(I) 86 FORMAT('I,Y1(I),Y2(I),X1(I),X2(I) = ',I8,4E12.5) CALL DPWRST('XXX','BUG ') 85 CONTINUE 80 CONTINUE C C ************************************** C ** STEP 4-- ** C ** IF DATA NOT ALREADY BINNED, THEN** C ** BIN THE DATA ** C ************************************** C IF(IDATSW.EQ.'RAW')THEN CLWID2=CLWID DXSTAR=XSTART DXSTOP=XSTOP IF(CLWID.NE.CPUMIN.AND.XSTART.NE.CPUMIN.AND. 1 XSTOP.NE.CPUMAX)GOTO200 IWRIT2='OFF' CALL MEAN(Y1,N1,IWRIT2,YMEAN1,IBUGA3,IERROR) CALL SD(Y1,N1,IWRIT2,YSD1,IBUGA3,IERROR) CALL MEAN(Y2,N2,IWRIT2,YMEAN2,IBUGA3,IERROR) CALL SD(Y2,N2,IWRIT2,YSD2,IBUGA3,IERROR) IF(CLWID.EQ.CPUMIN)THEN DCLWID=MIN(0.3*YSD1,0.3*YSD2) ENDIF IF(XSTART.EQ.CPUMIN)THEN DXSTAR=MIN(YMEAN1-6.0*YSD1,YMEAN2-6.0*YSD2) ENDIF IF(XSTOP.EQ.CPUMAX)THEN DXSTOP=MIN(YMEAN1+6.0*YSD1,YMEAN2+6.0*YSD2) ENDIF 200 CONTINUE C AN1=REAL(N1) CALL DPBIN(Y1,N1,IRELAT,DCLWID,DXSTAR,DXSTOP,IRHSTG, 1 XTEMP,MAXOBV,IHSTCW, 1 ZY1,ZX1,M2,IBUGA3,IERROR) IF(IERROR.EQ.'YES')GOTO9000 CALL SORTC(ZX1,ZY1,M2,ZX1,ZY1) AN2=REAL(N2) CALL DPBIN(Y2,N2,IRELAT,DCLWID,DXSTAR,DXSTOP,IRHSTG, 1 XTEMP,MAXOBV,IHSTCW, 1 ZY2,ZX2,M2,IBUGA3,IERROR) IF(IERROR.EQ.'YES')GOTO9000 CALL SORTC(ZX2,ZY2,M2,ZX2,ZY2) ELSEIF(IDATSW.EQ.'FREQ')THEN AN1=0.0 AN2=0.0 DO1009I=1,N1 AN1=AN1+Y1(I) AN2=AN2+Y2(I) ZY1(I)=Y1(I) ZY2(I)=Y2(I) ZX1(I)=X1(I) ZX2(I)=X1(I) 1009 CONTINUE CALL SORTC(ZX1,ZY1,M2,ZX2,ZY1) CALL SORTC(ZX1,ZY2,M2,ZX1,ZY2) M2=N1 ENDIF C C **************************************** C ** STEP 4.1-- ** C ** COMPUTE CHI-SQUARE TEST STATISTIC ** C ** EXPECTED ** C **************************************** C 1100 CONTINUE C DSUM1=0.0D0 DFACT1=DBLE(SQRT(AN2/AN1)) DFACT2=DBLE(SQRT(AN1/AN2)) NCELLS=0 DO1199I=1,M2 IF(ZY1(I).EQ.0.0 .AND. ZY2(I).EQ.0.0)GOTO1199 NCELLS=NCELLS+1 DTEMP1=DBLE(ZY1(I)) DTEMP2=DBLE(ZY2(I)) DTEMP3=(DFACT1*DTEMP1 - DFACT2*DTEMP2)**2/(DTEMP1+DTEMP2) DSUM1=DSUM1 + DTEMP3 1199 CONTINUE C STAT=REAL(DSUM1) IDF=NCELLS IF(N1.EQ.N2)IDF=IDF-1 C CALL CHSCDF(STAT,IDF,CDF) C ICONC1='REJECT' ICONC2='REJECT' ICONC3='REJECT' C STATVA=STAT STATCD=CDF STATNU=IDF CALL CHSPPF(.90,IDF,CUTH90) CALL CHSPPF(.95,IDF,CUTH95) CALL CHSPPF(.99,IDF,CUTH99) C IF(STATVA.LE.CUTH90)ICONC1='ACCEPT' IF(STATVA.LE.CUTH95)ICONC2='ACCEPT' IF(STATVA.LE.CUTH99)ICONC3='ACCEPT' C C ******************************* C ** STEP 32-- ** C ** WRITE OUT EVERYTHING ** C ** FOR A CHI-SQUARED TEST ** C ******************************* C ISTEPN='32' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IPRINT.EQ.'OFF')GOTO3290 WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,3211) 3211 FORMAT( 1' CHI-SQUARED TWO SAMPLE TEST') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,3212) 3212 FORMAT( 1'NULL HYPOTHESIS H0: TWO SAMPLES COME FROM THE SAME ', 1'(UNSPECIFIED)') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,3213) 3213 FORMAT( 1' DISTRIBUTION') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,3214) 3214 FORMAT( 1'ALTERNATE HYPOTHESIS HA: TWO SAMPLES COME FROM DIFFERENT ', 1'DISTRIBUTIONS') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,3220) 3220 FORMAT('SAMPLE:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,3221)INT(AN1+0.1) 3221 FORMAT(3X,'NUMBER OF OBSERVATIONS FOR SAMPLE 1 = ',I8) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,3222)INT(AN2+0.1) 3222 FORMAT(3X,'NUMBER OF OBSERVATIONS FOR SAMPLE 2 = ',I8) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,3223)NCELLS 3223 FORMAT(3X,'NUMBER OF NON-EMPTY CELLS = ',I8) CALL DPWRST('XXX','WRIT') IF(IDATSW.EQ.'RAW')THEN WRITE(ICOUT,3224)DCLWID 3224 FORMAT(3X,'CLASS WIDTH FOR BINS = ',E15.7) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,3225)DXSTAR 3225 FORMAT(3X,'CLASS LOWER FOR BINS = ',E15.7) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,3226)DXSTOP 3226 FORMAT(3X,'CLASS UPPER FOR BINS = ',E15.7) CALL DPWRST('XXX','WRIT') ENDIF WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,3240) 3240 FORMAT('TEST:') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,3242)STAT 3242 FORMAT('CHI-SQUARED TEST STATISTIC = ',G15.7) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,3243)IDF 3243 FORMAT(3X,'DEGREES OF FREEDOM = ',I8) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,3244)CDF 3244 FORMAT(3X,'CHI-SQUARED CDF VALUE = ',F11.6) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') C CCCCC WRITE(ICOUT,3251) C3251 FORMAT('ALPHA = 0.10') CCCCC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,3253) 3253 FORMAT(' ALPHA LEVEL CUTOFF CONCLUSION') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,3255)CUTH90,ICONC1 3255 FORMAT(' 10%',5X,F10.5,15X,A6,' H0') CALL DPWRST('XXX','WRIT') C CCCCC WRITE(ICOUT,3261) C3261 FORMAT('ALPHA = 0.05') CCCCC CALL DPWRST('XXX','WRIT') CCCCC WRITE(ICOUT,3263) C3263 FORMAT(' ALPHA LEVEL CUTOFF CONCLUSION') CCCCC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,3265)CUTH95,ICONC2 3265 FORMAT(' 5%',5X,F10.5,15X,A6,' H0') CALL DPWRST('XXX','WRIT') C CCCCC C3271 FORMAT('ALPHA = 0.01') CCCCC CALL DPWRST('XXX','WRIT') CCCCC WRITE(ICOUT,3273) C3273 FORMAT(' ALPHA LEVEL CUTOFF CONCLUSION') CCCCC CALL DPWRST('XXX','WRIT') WRITE(ICOUT,3275)CUTH99,ICONC3 3275 FORMAT(' 1%',5X,F10.5,15X,A6,' H0') CALL DPWRST('XXX','WRIT') C 3290 CONTINUE GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGA3.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DP2CH2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)ICASPL,IDATSW,M2,IERROR 9012 FORMAT('ICASPL,IDATSW,M2,IERROR = ',A4,2X,A4,I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)N1 9014 FORMAT('N1 = ',I8) CALL DPWRST('XXX','BUG ') DO9020I=1,M2 WRITE(ICOUT,9021)I,ZY1(I),ZY2(I),ZX1(I),ZX2(I) 9021 FORMAT('I,ZY1(I),ZY2(I),ZX1(I),ZX2(I) = ',I8,4E15.7) CALL DPWRST('XXX','BUG ') 9020 CONTINUE 9090 CONTINUE C RETURN END SUBROUTINE DP1KST(Y1,YOBS,YEXP,MAXNXT, 1ICAPSW, 1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR) C C PURPOSE--COMPUTE A KOLMOGOROV-SMIRNOV GOODNESS OF FIT ANALYSIS C FOR ONE OF THE FOLLOWING DISTRIBUTIONS-- C 1 ) UNIFORM C 2 ) NORMAL C 3 ) LOGISTIC C 4 ) DOUBLE EXPONENTIAL C 5 ) CAUCHY C 6 ) TUKEY LAMBDA C 7 ) LOGNORMAL C 8 ) HALFNORMAL C 9 ) T C 10) CHI-SQUARE C 11) F C 12) EXPONENTIAL C 13) GAMMA C 14) BETA C 15) WEIBULL---MIN & MAX C 16) EXTREME VALUE TYPE 1 (GUMBEL)--MIN & MAX C 17) EXTREME VALUE TYPE 2 (FRECHET)--MIN & MAX C 18) PARETO C 19) NEGATIVE BINOMIAL C 20) SEMI-CIRCULAR C 21) TRIANGULAR C 22) INVERSE GAUUSIAN C 23) WALD C 24) RECIPROCAL INVERSE GAUUSIAN C 25) FAILURE TIME C 26) GENERALIZED PARETO C 27) NON-CENTRAL T C 28) NON-CENTRAL F C 29) NON-CENTRAL KOLMOGOROV-SMIRNOV C 30) NON-CENTRAL BETA C 31) DOUBLY NON-CENTRAL T C 32) DOUBLY NON-CENTRAL F C 33) VON-MISES C 34) POWER NORMAL C 35) POWER LOGNORMAL C 36) COSINE C 37) ALPHA C 38) POWER FUNCTION C 39) CHI C 40) LOG LOGISTIC C 41) GENERALIZED GAMMA C 42) ANGLIT C 43) ARCSIN C 44) FOLDED NORMAL C 45) TRUNCATED NORMAL C 46) LOG GAMMA C 47) HYPERBOLIC SECANT C 48) GOMPERTZ C 49) PARETO SECOND KIND C 50) DOUBLE WEIBULL C 51) WRAPPED-UP CAUCHY C 52) EXPONENTIATED WEIBULL C 53) TRUNCATED EXPONENTIAL C 54) GENERALIZED LOGISTIC C 55) EXPONENTIAL POWER C 56) DOUBLE GAMMA C 57) MIELKE'S BETA-KAPPA C 58) FOLDED CAUCHY C 59) BETA BINOMIAL C 60) BETA PASCAL C 61) GENERALIZED EXPONENTIAL C 62) RECIPROCAL C 63) NORMAL MIXTURE C 64) INVERTED GAMMA C 65) INVERTED WEIBULL C 66) LOG DOUBLE EXPONENTIAL C 67) GENERALIZED TUKEY-LAMBDA C 68) JOHNSON SU C 69) JOHNSON SB C 70) GEOMETRIC EXTREME EXPONENTIAL C 71) TWO-SIDE POWER C 72) BIWEIBULL C 73) LANDAU C 74) ERROR C 75) TRAPEZOID C 76) GENERALIZED TRAPEZOID C 77) FOLDED T C 78) SLASH C 79) SKEWED NORMAL C 80) SKEWED T C 81) INVERTED BETA C 82) GOMPERTZ-MAKEHAM C 83) GENERALIZED INVERSE GAUSSIAN C 84) GENERALIZED F C 85) G-H C 86) LOG-SKEW-NORMAL C 87) LOG-SKEW-T C 88) HALF-LOGISTIC C 89) GENERALIZED HALF-LOGISTIC C 90) SKEWED DOUBLE EXPONENTIAL C 91) ASYMMETRIC DOUBLE EXPONENTIAL C 92) MAXWELL C 93) RAYLEIGH C 94) GENERALIZED ASYMMETRIC DOUBLE EXPONENTIAL C 95) MCLEISH C 96) BESSEL I FUNCTION C 97) BESSEL K FUNCTION (NOT WORKING YET) C 98) GENERALIZED MCLEISH C 99) HYPERBOLIC (NOT WORKING YET) C 100) GENERALIZED LOGISTIC TYPE 5 C 101) GENERALIZED LOGISTIC TYPE 2 C 102) GENERALIZED LOGISTIC TYPE 3 C 104) GENERALIZED LOGISTIC TYPE 4 C 105) WAKEBY C 106) BETA-NORMAL C 107) ASYMMETRIC LOG DOUBLE EXPONENTIAL C 108) LOG BETA C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--98/11 C ORIGINAL VERSION--NOVEMBER 1998. C UPDATED --OCTOBER 2001. C UPDATED --NOVEMBER 2001. GEOMETRIC EXTREME EXPONENTIAL C UPDATED --MAY 2002. TWO-SIDED POWER C UPDATED --MAY 2002. BIWEIBULL C UPDATED --APRIL 2003. LANDAU C UPDATED --MAY 2003. ERROR (=EXPONENTIAL POWER) C UPDATED --JUNE 2003. TRAPEZOID C UPDATED --OCTOBER 2003. SUPPORT FOR HTML AND LATEX C UPDATED --NOVEMBER 2003. FOLDED T C UPDATED --DECEMBER 2003. MU PARAMETER FOR INVERSE C GAUSSIAN, RECIPROCAL INVERSE C GAUSSIAN C UPDATED --DECEMBER 2003. SLASH, SKEW NORMAL, C SKEW T, INVERTED BETA, C GOMPERTZ-MAKEHAM, G-H C UPDATED --MARCH 2004. LOG-SKEW-NORMAL C UPDATED --MARCH 2004. LOG-SKEW-T C UPDATED --JUNE 2004. SKEW-DOUBLE EXPONENTIAL C UPDATED --JUNE 2004. ASYMMETRIC DOUBLE EXPONENTIAL C UPDATED --JUNE 2004. MAXWELL, RAYLEIGH C UPDATED --AUGUST 2004. GENERALIZED INVERSE GAUSSIAN C UPDATED --AUGUST 2004. GENERALIZED ASYMMETRIC LAPLACE C UPDATED --AUGUST 2004. MCLEISH C UPDATED --AUGUST 2004. BESSEL I-FUNCTION C UPDATED --AUGUST 2004. BESSEL K-FUNCTION C UPDATED --SEPTEMBER 2004. GENERALIZED MCLEISH C UPDATED --SEPTEMBER 2004. HYPERBOLIC C UPDATED --OCTOBER 2004. SUPPORT FOR CENSORED DATA C UPDATED --DECEMBER 2004. CLARIFY SHAPE PARAMETERS FOR C PARETO PARETO SECOND KIND C UPDATED --FEBRUARY 2006. GENERALIZED LOGISTIC TYPE 5 C UPDATED --FEBRUARY 2006. WAKEBY C UPDATED --FEBRUARY 2006. FMKL PARAMETERIZATION FOR C GENERALIZED TUKEY-LAMBDA C UPDATED --MARCH 2006. BETA-NORMAL C UPDATED --MARCH 2006. GENERALIZED LOGISTIC TYPE 2 C UPDATED --MARCH 2006. GENERALIZED LOGISTIC TYPE 3 C UPDATED --MARCH 2006. GENERALIZED LOGISTIC TYPE 4 C UPDATED --MARCH 2006. ASYMMETRIC LOG DOUBLE C EXPONENTIAL C UPDATED --AUGUST 2006. LOG BETA C UPDATED --OCTOBER 2006. FRACTIONAL DEGREES OF C FREEDOM FOR T DISTRIBUTION C UPDATED --OCTOBER 2006. SHAPE PARAMETER FOR SEMI-CIRCULAR C DISTRIBUTION C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ICASPL CHARACTER*4 ICAPSW CHARACTER*4 IBUGA2 CHARACTER*4 IBUGA3 CHARACTER*4 IBUGQ CHARACTER*4 ISUBRO CHARACTER*4 IFOUND CHARACTER*4 IERROR C CHARACTER*4 IHWUSE CHARACTER*4 MESSAG CHARACTER*4 ICASEQ CHARACTER*4 IDATSW CHARACTER*4 IHP CHARACTER*4 IHP2 CHARACTER*4 IHLEFT CHARACTER*4 IHLEF2 CHARACTER*4 IHRIGH CHARACTER*4 IHRIG2 CHARACTER*4 IERRO4 C CHARACTER*4 IWRIT2 CHARACTER*4 LOWLTY CHARACTER*4 UPPLTY CHARACTER*4 ICENSO CHARACTER*30 IDIST C CHARACTER*4 IH CHARACTER*4 IH2 CHARACTER*4 ISUBN0 C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C REAL KSLOC REAL KSSCAL C REAL LOC2 C PARAMETER (NUMCHS=201) CHARACTER*4 INAME(NUMCHS,4) CHARACTER*4 INCASE(NUMCHS) C C--------------------------------------------------------------------- C DIMENSION Y1(*) DIMENSION YOBS(*) DIMENSION YEXP(*) C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' C INCLUDE 'DPCOZZ.INC' INCLUDE 'DPCOHK.INC' INCLUDE 'DPCODA.INC' INCLUDE 'DPCOSU.INC' INCLUDE 'DPCOST.INC' INCLUDE 'DPCOS2.INC' INCLUDE 'DPCOHO.INC' INCLUDE 'DPCOMC.INC' INCLUDE 'DPCOF2.INC' C DIMENSION CENSOR(MAXOBV) DIMENSION XTEMP1(MAXOBV) C EQUIVALENCE (CENSOR(1),GARBAG(IGARB1)) EQUIVALENCE (XTEMP1(1),GARBAG(IGARB2)) C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C AUGUST 1998. MAKE SEARCH TABLE DRIVEN C DATA INCASE(1)/'UNPP'/ DATA (INAME(1,J),J=1,4)/'UNIF',' ',' ',' '/ DATA INCASE(2)/'UNPP'/ DATA (INAME(2,J),J=1,4)/'RECT',' ',' ',' '/ DATA INCASE(3)/'NMPP'/ DATA (INAME(3,J),J=1,4)/'NORM','MIXT',' ',' '/ DATA INCASE(4)/'NMPP'/ DATA (INAME(4,J),J=1,4)/'GAUS','MIXT',' ',' '/ DATA INCASE(5)/'NOPP'/ DATA (INAME(5,J),J=1,4)/'NORM',' ',' ',' '/ DATA INCASE(6)/'NOPP'/ DATA (INAME(6,J),J=1,4)/'GAUS',' ',' ',' '/ DATA INCASE(7)/'LOPP'/ DATA (INAME(7,J),J=1,4)/'LOGI',' ',' ',' '/ DATA INCASE(8)/'DEPP'/ DATA (INAME(8,J),J=1,4)/'DOUB','EXPO',' ',' '/ DATA INCASE(9)/'DEPP'/ DATA (INAME(9,J),J=1,4)/'LAPL',' ',' ',' '/ DATA INCASE(10)/'CAPP'/ DATA (INAME(10,J),J=1,4)/'CAUC',' ',' ',' '/ DATA INCASE(11)/'LAPP'/ DATA (INAME(11,J),J=1,4)/'TUKE','LAMB',' ',' '/ DATA INCASE(12)/'LAPP'/ DATA (INAME(12,J),J=1,4)/'TUKE',' ',' ',' '/ DATA INCASE(13)/'LAPP'/ DATA (INAME(13,J),J=1,4)/'LAMB',' ',' ',' '/ DATA INCASE(14)/'LNPP'/ DATA (INAME(14,J),J=1,4)/'LOG ','NORM',' ',' '/ DATA INCASE(15)/'LNPP'/ DATA (INAME(15,J),J=1,4)/'LOGN',' ',' ',' '/ DATA INCASE(16)/'HNPP'/ DATA (INAME(16,J),J=1,4)/'HALF','NORM',' ',' '/ DATA INCASE(17)/'HNPP'/ DATA (INAME(17,J),J=1,4)/'HALF',' ',' ',' '/ DATA INCASE(18)/'TPP'/ DATA (INAME(18,J),J=1,4)/'T ',' ',' ',' '/ DATA INCASE(19)/'TPP'/ DATA (INAME(19,J),J=1,4)/'STUD','T ',' ',' '/ DATA INCASE(20)/'CSPP'/ DATA (INAME(20,J),J=1,4)/'CHIS',' ',' ',' '/ DATA INCASE(21)/'CSPP'/ DATA (INAME(21,J),J=1,4)/'CHI ','SQUA',' ',' '/ DATA INCASE(22)/'FPP'/ DATA (INAME(22,J),J=1,4)/'F ',' ',' ',' '/ DATA INCASE(23)/'FPP'/ DATA (INAME(23,J),J=1,4)/'SNED','F ',' ',' '/ DATA INCASE(24)/'EXPP'/ DATA (INAME(24,J),J=1,4)/'EXPO',' ',' ',' '/ DATA INCASE(25)/'EXPP'/ DATA (INAME(25,J),J=1,4)/'NEGA','EXPO',' ',' '/ DATA INCASE(26)/'GAPP'/ DATA (INAME(26,J),J=1,4)/'GAMM',' ',' ',' '/ DATA INCASE(27)/'BNPP'/ DATA (INAME(27,J),J=1,4)/'BETA','NORM',' ',' '/ DATA INCASE(28)/'WEPP'/ DATA (INAME(28,J),J=1,4)/'WEIB',' ',' ',' '/ DATA INCASE(29)/'E1PP'/ DATA (INAME(29,J),J=1,4)/'EXTR','VALU','TYPE','1 '/ DATA INCASE(30)/'E1PP'/ DATA (INAME(30,J),J=1,4)/'EXTR','VALU','TYPE','I '/ DATA INCASE(31)/'E1PP'/ DATA (INAME(31,J),J=1,4)/'EV1 ',' ',' ',' '/ DATA INCASE(32)/'E1PP'/ DATA (INAME(32,J),J=1,4)/'EVI ',' ',' ',' '/ DATA INCASE(33)/'E1PP'/ DATA (INAME(33,J),J=1,4)/'GUMB',' ',' ',' '/ DATA INCASE(34)/'E2PP'/ DATA (INAME(34,J),J=1,4)/'EXTR','VALU','TYPE','2 '/ DATA INCASE(35)/'E2PP'/ DATA (INAME(35,J),J=1,4)/'EXTR','VALU','TYPE','II '/ DATA INCASE(36)/'E2PP'/ DATA (INAME(36,J),J=1,4)/'EVII',' ',' ',' '/ DATA INCASE(37)/'E2PP'/ DATA (INAME(37,J),J=1,4)/'EV2 ',' ',' ',' '/ DATA INCASE(38)/'E2PP'/ DATA (INAME(38,J),J=1,4)/'FREC',' ',' ',' '/ DATA INCASE(39)/'PAPP'/ DATA (INAME(39,J),J=1,4)/'PARE',' ',' ',' '/ DATA INCASE(40)/'BIPP'/ CCCCC DATA (INAME(40,J),J=1,4)/'BINO',' ',' ',' '/ DATA (INAME(40,J),J=1,4)/' ',' ',' ',' '/ DATA INCASE(41)/'GEPP'/ CCCCC DATA (INAME(41,J),J=1,4)/'GEOM',' ',' ',' '/ DATA (INAME(41,J),J=1,4)/' ',' ',' ',' '/ DATA INCASE(42)/'POPP'/ CCCCC DATA (INAME(42,J),J=1,4)/'POIS',' ',' ',' '/ DATA (INAME(42,J),J=1,4)/' ',' ',' ',' '/ DATA INCASE(43)/'NBPP'/ CCCCC DATA (INAME(43,J),J=1,4)/'NEGA','BINO',' ',' '/ DATA (INAME(43,J),J=1,4)/'NEGA','BINO',' ',' '/ DATA INCASE(44)/'SEPP'/ DATA (INAME(44,J),J=1,4)/'SEMI','CIRC',' ',' '/ DATA INCASE(45)/'SEPP'/ DATA (INAME(45,J),J=1,4)/'SEMI',' ',' ',' '/ DATA INCASE(46)/'TRPP'/ DATA (INAME(46,J),J=1,4)/'TRIA',' ',' ',' '/ DATA INCASE(47)/'IGPP'/ DATA (INAME(47,J),J=1,4)/'INVE','GAUS',' ',' '/ DATA INCASE(48)/'IGPP'/ DATA (INAME(48,J),J=1,4)/'IG ',' ',' ',' '/ DATA INCASE(49)/'WAPP'/ DATA (INAME(49,J),J=1,4)/'WALD',' ',' ',' '/ DATA INCASE(50)/'RIPP'/ DATA (INAME(50,J),J=1,4)/'RIG ',' ',' ',' '/ DATA INCASE(51)/'RIPP'/ DATA (INAME(51,J),J=1,4)/'TWEE',' ',' ',' '/ DATA INCASE(52)/'RIPP'/ DATA (INAME(52,J),J=1,4)/'RECI','INVE','GAUS',' '/ DATA INCASE(53)/'FLPP'/ DATA (INAME(53,J),J=1,4)/'FATI','LIFE',' ',' '/ DATA INCASE(54)/'FLPP'/ DATA (INAME(54,J),J=1,4)/'FL ',' ',' ',' '/ DATA INCASE(55)/'FLPP'/ DATA (INAME(55,J),J=1,4)/'BIRN','SAUN',' ',' '/ DATA INCASE(56)/'FLPP'/ DATA (INAME(56,J),J=1,4)/'SAUN','BIRN',' ',' '/ DATA INCASE(57)/'GPPP'/ DATA (INAME(57,J),J=1,4)/'GENE','PARE',' ',' '/ DATA INCASE(58)/'GPPP'/ DATA (INAME(58,J),J=1,4)/'GEP ',' ',' ',' '/ DATA INCASE(59)/'GPPP'/ DATA (INAME(59,J),J=1,4)/'GP ',' ',' ',' '/ DATA INCASE(60)/'DUPP'/ CCCCC DATA (INAME(60,J),J=1,4)/'DISC','UNIF',' ',' '/ DATA (INAME(60,J),J=1,4)/'DISC','UNIF',' ',' '/ DATA INCASE(61)/'NTPP'/ DATA (INAME(61,J),J=1,4)/'NONC','T ',' ',' '/ DATA INCASE(62)/'NTPP'/ DATA (INAME(62,J),J=1,4)/'NON-','T ',' ',' '/ DATA INCASE(63)/'NTPP'/ DATA (INAME(63,J),J=1,4)/'NON ','CENT','T ',' '/ DATA INCASE(64)/'NFPP'/ DATA (INAME(64,J),J=1,4)/'NONC','F ',' ',' '/ DATA INCASE(65)/'NFPP'/ DATA (INAME(65,J),J=1,4)/'NON-','F ',' ',' '/ DATA INCASE(66)/'NFPP'/ DATA (INAME(66,J),J=1,4)/'NON ','CENT','F ',' '/ DATA INCASE(67)/'NCBP'/ DATA (INAME(67,J),J=1,4)/'NONC','BETA',' ',' '/ DATA INCASE(68)/'NCBP'/ DATA (INAME(68,J),J=1,4)/'NON-','BETA',' ',' '/ DATA INCASE(69)/'NCBP'/ DATA (INAME(69,J),J=1,4)/'NON ','CENT','BETA',' '/ DATA INCASE(70)/'NCPP'/ DATA (INAME(70,J),J=1,4)/'NON ','CENT','CHIS',' '/ DATA INCASE(71)/'NCPP'/ DATA (INAME(71,J),J=1,4)/'NON ','CENT','CHI-',' '/ DATA INCASE(72)/'NCPP'/ DATA (INAME(72,J),J=1,4)/'NONC','CHI ','SQUA',' '/ DATA INCASE(73)/'NCPP'/ DATA (INAME(73,J),J=1,4)/'NON-','CHI ','SQUA',' '/ DATA INCASE(74)/'NCPP'/ DATA (INAME(74,J),J=1,4)/'NONC','CHI-',' ',' '/ DATA INCASE(75)/'NCPP'/ DATA (INAME(75,J),J=1,4)/'NON-','CHI-',' ',' '/ DATA INCASE(76)/'NCPP'/ DATA (INAME(76,J),J=1,4)/'NONC','CHIS',' ',' '/ DATA INCASE(77)/'NCPP'/ DATA (INAME(77,J),J=1,4)/'NON-','CHIS','CHIS',' '/ DATA INCASE(78)/'DNCF'/ DATA (INAME(78,J),J=1,4)/'DOUB','NONC','F ',' '/ DATA INCASE(79)/'DNCF'/ DATA (INAME(79,J),J=1,4)/'DOUB','NON-','F ',' '/ DATA INCASE(80)/'DNCT'/ DATA (INAME(80,J),J=1,4)/'DOUB','NONC','T ',' '/ DATA INCASE(81)/'DNCT'/ DATA (INAME(81,J),J=1,4)/'DOUB','NON-','T ',' '/ DATA INCASE(82)/'HYPP'/ CCCCC DATA (INAME(82,J),J=1,4)/'HYPE',' ',' ',' '/ DATA (INAME(82,J),J=1,4)/' ',' ',' ',' '/ DATA INCASE(83)/'HYPP'/ CCCCC DATA (INAME(83,J),J=1,4)/'HYPE','GEO ',' ',' '/ DATA (INAME(83,J),J=1,4)/' ',' ',' ',' '/ DATA INCASE(84)/'VMPP'/ DATA (INAME(84,J),J=1,4)/'VON ','MISE',' ',' '/ DATA INCASE(85)/'VMPP'/ DATA (INAME(85,J),J=1,4)/'VONM',' ',' ',' '/ DATA INCASE(86)/'VMPP'/ DATA (INAME(86,J),J=1,4)/'VON-',' ',' ',' '/ DATA INCASE(87)/'PNPP'/ DATA (INAME(87,J),J=1,4)/'POWE','NORM',' ',' '/ DATA INCASE(88)/'PLPP'/ DATA (INAME(88,J),J=1,4)/'POWE','LOGN',' ',' '/ DATA INCASE(89)/'PLPP'/ DATA (INAME(89,J),J=1,4)/'POWE','LGNO',' ',' '/ DATA INCASE(90)/'PLPP'/ DATA (INAME(90,J),J=1,4)/'POWE','LOG-',' ',' '/ DATA INCASE(91)/'COPP'/ DATA (INAME(91,J),J=1,4)/'COSI',' ',' ',' '/ DATA INCASE(92)/'ALPP'/ DATA (INAME(92,J),J=1,4)/'ALPH',' ',' ',' '/ DATA INCASE(93)/'PEPP'/ DATA (INAME(93,J),J=1,4)/'POWE','EXPO',' ',' '/ DATA INCASE(94)/'PFPP'/ DATA (INAME(94,J),J=1,4)/'POWE','FUNC',' ',' '/ DATA INCASE(95)/'CHPP'/ DATA (INAME(95,J),J=1,4)/'CHI ',' ',' ',' '/ DATA INCASE(96)/'DLPP'/ CCCCC DATA (INAME(96,J),J=1,4)/'LOGA','SERI',' ',' '/ DATA (INAME(96,J),J=1,4)/' ',' ',' ',' '/ DATA INCASE(97)/'LLPP'/ DATA (INAME(97,J),J=1,4)/'LOG ','LOGI',' ',' '/ DATA INCASE(98)/'LLPP'/ DATA (INAME(98,J),J=1,4)/'LOG-','LOGI',' ',' '/ DATA INCASE(99)/'LLPP'/ DATA (INAME(99,J),J=1,4)/'LOGL',' ',' ',' '/ DATA INCASE(100)/'GGPP'/ DATA (INAME(100,J),J=1,4)/'GENE','GAMM',' ',' '/ DATA INCASE(101)/'GIPP'/ DATA (INAME(101,J),J=1,4)/'INVE','GAMM',' ',' '/ DATA INCASE(102)/'WRPP'/ CCCCC DATA (INAME(102,J),J=1,4)/'WARI',' ',' ',' '/ DATA (INAME(102,J),J=1,4)/' ',' ',' ',' '/ DATA INCASE(103)/'WRPP'/ CCCCC DATA (INAME(103,J),J=1,4)/'YULE',' ',' ',' '/ DATA (INAME(103,J),J=1,4)/' ',' ',' ',' '/ DATA INCASE(104)/'ANPP'/ DATA (INAME(104,J),J=1,4)/'ANGL',' ',' ',' '/ DATA INCASE(105)/'ARPP'/ DATA (INAME(105,J),J=1,4)/'ARSE',' ',' ',' '/ DATA INCASE(106)/'FNPP'/ DATA (INAME(106,J),J=1,4)/'FOLD','NORM',' ',' '/ DATA INCASE(107)/'TNPP'/ DATA (INAME(107,J),J=1,4)/'TRUN','NORM',' ',' '/ DATA INCASE(108)/'LGPP'/ DATA (INAME(108,J),J=1,4)/'LOG ','GAMM',' ',' '/ DATA INCASE(109)/'HSPP'/ DATA (INAME(109,J),J=1,4)/'HYPE','SECA',' ',' '/ DATA INCASE(110)/'GOPP'/ DATA (INAME(110,J),J=1,4)/'GOMP',' ',' ',' '/ DATA INCASE(111)/'HLPP'/ DATA (INAME(111,J),J=1,4)/'HALF','LOGI',' ',' '/ DATA INCASE(112)/'GVPP'/ DATA (INAME(112,J),J=1,4)/'GENE','EXTR','VALU',' '/ DATA INCASE(113)/'GVPP'/ DATA (INAME(113,J),J=1,4)/'GEV ',' ',' ',' '/ DATA INCASE(114)/'HCPP'/ DATA (INAME(114,J),J=1,4)/'HALF','CAUC',' ',' '/ DATA INCASE(115)/'P2PP'/ DATA (INAME(115,J),J=1,4)/'PARE','SECO','KIND',' '/ DATA INCASE(116)/'P2PP'/ DATA (INAME(116,J),J=1,4)/'PARE','TYPE','2 ',' '/ DATA INCASE(117)/'P2PP'/ DATA (INAME(117,J),J=1,4)/'PARE','TYPE','II ',' '/ DATA INCASE(118)/'DWPP'/ DATA (INAME(118,J),J=1,4)/'DOUB','WEIB',' ',' '/ DATA INCASE(119)/'EWPP'/ DATA (INAME(119,J),J=1,4)/'EXPO','WEIB',' ',' '/ DATA INCASE(120)/'TEPP'/ DATA (INAME(120,J),J=1,4)/'TRUN','EXPO',' ',' '/ DATA INCASE(121)/'WCPP'/ DATA (INAME(121,J),J=1,4)/'WRAP','CAUC',' ',' '/ DATA INCASE(122)/'WKPP'/ DATA (INAME(122,J),J=1,4)/'WAKE',' ',' ',' '/ DATA INCASE(123)/'PEPP'/ DATA (INAME(123,J),J=1,4)/'EXPO','POWE',' ',' '/ DATA INCASE(124)/'DGPP'/ DATA (INAME(124,J),J=1,4)/'DOUB','GAMM',' ',' '/ DATA INCASE(125)/'KAPP'/ DATA (INAME(125,J),J=1,4)/'BETA','KAPP',' ',' '/ DATA INCASE(126)/'KAPP'/ DATA (INAME(126,J),J=1,4)/'MIEL','BETA','KAPP',' '/ DATA INCASE(127)/'FCPP'/ DATA (INAME(127,J),J=1,4)/'FOLD','CAUC',' ',' '/ DATA INCASE(128)/'BBPP'/ DATA (INAME(128,J),J=1,4)/'BETA','BINO',' ',' '/ DATA INCASE(129)/'BRPP'/ DATA (INAME(129,J),J=1,4)/'BRAD',' ',' ',' '/ DATA INCASE(130)/'GXPP'/ DATA (INAME(130,J),J=1,4)/'GENE','EXPO',' ',' '/ DATA INCASE(131)/'REPP'/ DATA (INAME(131,J),J=1,4)/'RECI',' ',' ',' '/ DATA INCASE(132)/'IWPP'/ DATA (INAME(132,J),J=1,4)/'INVE','WEIB',' ',' '/ DATA INCASE(133)/'LXPP'/ DATA (INAME(133,J),J=1,4)/'LOG ','DOUB','EXPO',' '/ DATA INCASE(134)/'LDPP'/ DATA (INAME(134,J),J=1,4)/'GENE','TUKE','LAMB',' '/ DATA INCASE(135)/'JBPP'/ DATA (INAME(135,J),J=1,4)/'JOHN','SB ',' ',' '/ DATA INCASE(136)/'JUPP'/ DATA (INAME(136,J),J=1,4)/'JOHN','SU ',' ',' '/ DATA INCASE(137)/'EEPP'/ DATA (INAME(137,J),J=1,4)/'GEOM','EXTR','EXPO',' '/ DATA INCASE(138)/'TSPP'/ DATA (INAME(138,J),J=1,4)/'TWO ','SIDE','POWE',' '/ DATA INCASE(139)/'BWPP'/ DATA (INAME(139,J),J=1,4)/'BIWE',' ',' ',' '/ DATA INCASE(140)/'BWPP'/ DATA (INAME(140,J),J=1,4)/'BI ','WEIB',' ',' '/ DATA INCASE(141)/'LUPP'/ DATA (INAME(141,J),J=1,4)/'LAND',' ',' ',' '/ DATA INCASE(142)/'ERPP'/ DATA (INAME(142,J),J=1,4)/'ERRO',' ',' ',' '/ DATA INCASE(143)/'ERPP'/ DATA (INAME(143,J),J=1,4)/'SUBB',' ',' ',' '/ DATA INCASE(144)/'PFPP'/ DATA (INAME(144,J),J=1,4)/'POWE',' ',' ',' '/ DATA INCASE(145)/'TZPP'/ DATA (INAME(145,J),J=1,4)/'TRAP',' ',' ',' '/ DATA INCASE(146)/'GTPP'/ DATA (INAME(146,J),J=1,4)/'GENE','TRAP',' ',' '/ DATA INCASE(147)/'FTPP'/ DATA (INAME(147,J),J=1,4)/'FOLD','T ',' ',' '/ DATA INCASE(148)/'SNPP'/ DATA (INAME(148,J),J=1,4)/'SKEW','NORM',' ',' '/ DATA INCASE(149)/'STPP'/ DATA (INAME(149,J),J=1,4)/'SKEW','T ',' ',' '/ DATA INCASE(150)/'SLPP'/ DATA (INAME(150,J),J=1,4)/'SLAS',' ',' ',' '/ DATA INCASE(151)/'IBPP'/ DATA (INAME(151,J),J=1,4)/'INVE','BETA',' ',' '/ DATA INCASE(152)/'GMPP'/ DATA (INAME(152,J),J=1,4)/'GOMP','MAKE',' ',' '/ DATA INCASE(153)/'GIGP'/ DATA (INAME(153,J),J=1,4)/'GENE','INVE','GAUS',' '/ DATA INCASE(154)/'GFPP'/ DATA (INAME(154,J),J=1,4)/'GENE','F ',' ',' '/ DATA INCASE(155)/'GHPP'/ DATA (INAME(155,J),J=1,4)/'G-H ',' ',' ',' '/ DATA INCASE(156)/'GHPP'/ DATA (INAME(156,J),J=1,4)/'GH ',' ',' ',' '/ DATA INCASE(157)/'GHPP'/ DATA (INAME(157,J),J=1,4)/'G ','H ',' ',' '/ DATA INCASE(158)/'GHPP'/ DATA (INAME(158,J),J=1,4)/'G ','AND ','H ',' '/ DATA INCASE(159)/'LZPP'/ DATA (INAME(159,J),J=1,4)/'LOG ','SKEW','NORM',' '/ DATA INCASE(160)/'LTPP'/ DATA (INAME(160,J),J=1,4)/'LOG ','SKEW','T ',' '/ DATA INCASE(161)/'GZPP'/ DATA (INAME(161,J),J=1,4)/'GENE','HALF','LOGI',' '/ DATA INCASE(162)/'ASPP'/ DATA (INAME(162,J),J=1,4)/'ARCS',' ',' ',' '/ DATA INCASE(163)/'PZPP'/ CCCCC DATA (INAME(163,J),J=1,4)/'POLY',' ',' ',' '/ DATA INCASE(164)/'SDPP'/ DATA (INAME(164,J),J=1,4)/'SKEW','DOUB','EXPO',' '/ DATA INCASE(165)/'SDPP'/ DATA (INAME(165,J),J=1,4)/'SKEW','LAPL',' ',' '/ DATA INCASE(166)/'ADPP'/ DATA (INAME(166,J),J=1,4)/'ASYM','DOUB','EXPO',' '/ DATA INCASE(167)/'ADPP'/ DATA (INAME(167,J),J=1,4)/'ASYM','LAPL',' ',' '/ DATA INCASE(168)/'MXPP'/ DATA (INAME(168,J),J=1,4)/'MAXW',' ',' ',' '/ DATA INCASE(169)/'RAPP'/ DATA (INAME(169,J),J=1,4)/'RAYL',' ',' ',' '/ DATA INCASE(170)/'GALP'/ DATA (INAME(170,J),J=1,4)/'GENE','ASYM','DOUB','EXPO'/ DATA INCASE(171)/'GALP'/ DATA (INAME(171,J),J=1,4)/'GENE','ASYM','LAPL',' '/ DATA INCASE(172)/'MCPP'/ DATA (INAME(172,J),J=1,4)/'MCLE',' ',' ',' '/ DATA INCASE(173)/'BEIP'/ DATA (INAME(173,J),J=1,4)/'BESS','I ','FUNC',' '/ DATA INCASE(174)/'BEIP'/ DATA (INAME(174,J),J=1,4)/'BESS','I ',' ',' '/ DATA INCASE(175)/'BEKP'/ DATA (INAME(175,J),J=1,4)/'BESS','K ','FUNC',' '/ DATA INCASE(176)/'BEKP'/ DATA (INAME(176,J),J=1,4)/'BESS','K ',' ',' '/ DATA INCASE(177)/'GMCP'/ DATA (INAME(177,J),J=1,4)/'GENE','MCLE',' ',' '/ DATA INCASE(178)/'G5PP'/ DATA (INAME(178,J),J=1,4)/'GENE','LOGI','TYPE','5 '/ DATA INCASE(179)/'G5PP'/ DATA (INAME(179,J),J=1,4)/'GENE','LOGI','TYPE','V '/ DATA INCASE(180)/'G5PP'/ DATA (INAME(180,J),J=1,4)/'GENE','LOGI','HOSK',' '/ DATA INCASE(181)/'G5PP'/ DATA (INAME(181,J),J=1,4)/'HOSK','GENE','LOGI',' '/ DATA INCASE(182)/'G5PP'/ DATA (INAME(182,J),J=1,4)/'TYPE','5 ','GENE','LOGI'/ DATA INCASE(183)/'G5PP'/ DATA (INAME(183,J),J=1,4)/'TYPE','V ','GENE','LOGI'/ DATA INCASE(184)/'G2PP'/ DATA (INAME(184,J),J=1,4)/'GENE','LOGI','TYPE','2 '/ DATA INCASE(185)/'G2PP'/ DATA (INAME(185,J),J=1,4)/'GENE','LOGI','TYPE','II '/ DATA INCASE(186)/'G2PP'/ DATA (INAME(186,J),J=1,4)/'TYPE','2 ','GENE','LOGI'/ DATA INCASE(187)/'G2PP'/ DATA (INAME(187,J),J=1,4)/'TYPE','II ','GENE','LOGI'/ DATA INCASE(188)/'G3PP'/ DATA (INAME(188,J),J=1,4)/'GENE','LOGI','TYPE','3 '/ DATA INCASE(189)/'G3PP'/ DATA (INAME(189,J),J=1,4)/'GENE','LOGI','TYPE','III '/ DATA INCASE(190)/'G3PP'/ DATA (INAME(190,J),J=1,4)/'TYPE','3 ','GENE','LOGI'/ DATA INCASE(191)/'G3PP'/ DATA (INAME(191,J),J=1,4)/'TYPE','III ','GENE','LOGI'/ DATA INCASE(192)/'G4PP'/ DATA (INAME(192,J),J=1,4)/'GENE','LOGI','TYPE','4 '/ DATA INCASE(193)/'G4PP'/ DATA (INAME(193,J),J=1,4)/'GENE','LOGI','TYPE','IV '/ DATA INCASE(194)/'G4PP'/ DATA (INAME(194,J),J=1,4)/'TYPE','4 ','GENE','LOGI'/ DATA INCASE(195)/'G4PP'/ DATA (INAME(195,J),J=1,4)/'TYPE','IV ','GENE','LOGI'/ DATA INCASE(196)/'GLPP'/ DATA (INAME(196,J),J=1,4)/'GENE','LOGI',' ',' '/ DATA INCASE(197)/'BEPP'/ DATA (INAME(197,J),J=1,4)/'BETA',' ',' ',' '/ DATA INCASE(198)/'LXPP'/ DATA (INAME(198,J),J=1,4)/'LOG ','LAPL',' ',' '/ DATA INCASE(199)/'AXPP'/ DATA (INAME(199,J),J=1,4)/'ASYM','LOG ','DOUB','EXPO'/ DATA INCASE(200)/'AXPP'/ DATA (INAME(200,J),J=1,4)/'ASYM','LOG ','LAPL',' '/ DATA INCASE(201)/'LBPP'/ DATA (INAME(201,J),J=1,4)/'LOG ','BETA',' ',' '/ C C-----START POINT--------------------------------------------- C IERROR='NO' IDIST=' ' C ISUBN1='DP1K' ISUBN2='ST ' ICENSO='OFF' C MAXCP1=MAXCOL+1 MAXCP2=MAXCOL+2 MAXCP3=MAXCOL+3 MAXCP4=MAXCOL+4 MAXCP5=MAXCOL+5 MAXCP6=MAXCOL+6 C MAXV2=2 MINN2=3 C ICOLR=0 C C ******************************************************* C ** TREAT THE KOLMOGOROV-SMIRNOV GOODNESS OF FIT CASE * C ******************************************************* C IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST')THEN WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DP1KST--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)ICASPL 52 FORMAT('ICASPL = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IBUGA2,IBUGA3,IBUGQ 53 FORMAT('IBUGA2,IBUGA3,IBUGQ = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') ENDIF C C *************************** C ** STEP 1-- ** C ** EXTRACT THE COMMAND ** C *************************** C ISTEPN='1' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) DO100I=1,NUMCHS IROW=I IF(INAME(I,1).NE.ICOM)GOTO100 DO102J=1,4 IF(INAME(I,J).NE.' ')GOTO102 ITEMP=J-1 GOTO104 102 CONTINUE ITEMP=4 104 CONTINUE ILASTC=0 IF(ITEMP.GT.1)THEN DO108J=2,ITEMP IF(INAME(I,J).NE.IHARG(J-1))GOTO100 108 CONTINUE ILASTC=ITEMP-1 ENDIF I1=ILASTC+1 I2=ILASTC+2 I3=ILASTC+3 I4=ILASTC+4 I5=ILASTC+5 I6=ILASTC+6 C IF(IHARG(I1).EQ.'CENS')THEN ICENSO='ON' ISHIFT=1 CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG, 1 IBUGA2,IERROR) ENDIF C IF(IHARG(I1).EQ.'KOLM'.AND.IHARG(I2).EQ.'SMIR'.AND. 1 IHARG(I3).EQ.'GOOD'.AND.IHARG(I4).EQ.'OF '.AND. 1 IHARG(I5).EQ.'FIT '.AND.IHARG(I6).EQ.'TEST')THEN ILASTC=I6 GOTO112 END IF IF(IHARG(I1).EQ.'KOLM'.AND.IHARG(I2).EQ.'SMIR'.AND. 1 IHARG(I3).EQ.'GOOD'.AND.IHARG(I4).EQ.'OF '.AND. 1 IHARG(I5).EQ.'FIT ')THEN ILASTC=I5 GOTO112 END IF IF(IHARG(I1).EQ.'KOLM'.AND.IHARG(I2).EQ.'GOOD'.AND. 1 IHARG(I3).EQ.'OF '.AND.IHARG(I4).EQ.'FIT '.AND. 1 IHARG(I5).EQ.'TEST')THEN ILASTC=I5 GOTO112 END IF IF(IHARG(I1).EQ.'KOLM'.AND.IHARG(I2).EQ.'GOOD'.AND. 1 IHARG(I3).EQ.'OF '.AND.IHARG(I4).EQ.'FIT ')THEN ILASTC=I4 GOTO112 END IF IF(IHARG(I1).EQ.'KOLM'.AND.IHARG(I2).EQ.'SMIR'.AND. 1 IHARG(I3).EQ.'TEST')THEN ILASTC=I3 GOTO112 END IF IF(IHARG(I1).EQ.'KOLM'.AND.IHARG(I2).EQ.'TEST')THEN ILASTC=I2 GOTO112 END IF C CCCCC ICASPL=' ' CCCCC IFOUND='NO' CCCCC GOTO9000 100 CONTINUE C C ----------NO MATCH FOUND---------- C ICASPL=' ' IFOUND='NO' GOTO9000 C 112 CONTINUE ICASPL=INCASE(IROW) CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG) IFOUND='YES' GOTO190 C 190 CONTINUE C C ******************************************************* C ** STEP 2-- ** C ** CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS. ** C ******************************************************* C ISTEPN='2' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C MINNA=1 MAXNA=100 CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C C ******************************************** C ** STEP 3-- ** C ** CHECK THE VALIDITY OF ARGUMENT 1 ** C ** (THIS WILL BE THE RESPONSE VARIABLE) ** C ******************************************** C ISTEPN='3' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IHLEFT=IHARG(1) IHLEF2=IHARG2(1) IHWUSE='V' MESSAG='YES' CALL CHECKN(IHLEFT,IHLEF2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR) IF(IERROR.EQ.'YES')GOTO9000 ICOLL=IVALUE(ILOCV) NLEFT=IN(ILOCV) IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'ON')THEN WRITE(ICOUT,211)IHLEFT,IHLEF2,ICOLL,NLEFT 211 FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,A4,I8,I8) CALL DPWRST('XXX','BUG ') ENDIF C C ******************************************************* C ** STEP 4-- ** C ** CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT) C ** FOR THE RESPONSE VARIABLE IS POSITIVE. ** C ******************************************************* C ISTEPN='4' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NLEFT.LT.MINN2)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,311) 311 FORMAT('***** ERROR IN KOLMOGOROV-SMIRNOV GOODNESS OF FIT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,312)IHLEFT,IHLEF2 312 FORMAT(' THE INPUT NUMBER OF OBSERVATIONS ', 1 'IN VARIABLE ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,313) 313 FORMAT(' FOR WHICH A KOLMOGOROV-SMIRNOV GOODNESS OF FIT ', 1 'TEST') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,314)MINN2 314 FORMAT(' WAS TO HAVE BEEN PERFORMED MUST BE ',I8,' OR ', 1 'LARGER;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,316) 316 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,317) 317 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)THEN WRITE(ICOUT,318)(IANS(I),I=1,MIN(80,IWIDTH)) 318 FORMAT(80A1) CALL DPWRST('XXX','BUG ') ENDIF IERROR='YES' GOTO9000 ENDIF C C ******************************************** C ** STEP 3B-- ** C ** CHECK THE VALIDITY OF ARGUMENT 2 ** C ** IF ARGUMENT 2 NOT FOUND OR IS NOT A ** C ** VARIABLE, ASSUME UNCENSORED CASE. ** C ******************************************** C ISTEPN='3B' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NUMARG.GE.2)THEN IHRIGH=IHARG(2) IHRIG2=IHARG2(2) IHWUSE='V' MESSAG='NO' CALL CHECKN(IHRIGH,IHRIG2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR) IF(IERROR.EQ.'YES')THEN ICENSO='OFF' ELSE ICENSO='ON' ICOLR=IVALUE(ILOCV) NRIGHT=IN(ILOCV) IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'1KST')THEN WRITE(ICOUT,321)IHRIGH,IHRIG2,ICOLR,NRIGHT 321 FORMAT('IHRIGH,IHRIG2,ICOLR,NRIGHT = ',A4,A4,I8,I8) CALL DPWRST('XXX','BUG ') ENDIF ENDIF ELSE ICENSO='OFF' ENDIF C C ******************************************************* C ** STEP 4B- ** C ** CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NRIGHT) C ** FOR THE SECOND RESPONSE VARIABLE IS POSITIVE. ** C ******************************************************* C ISTEPN='4B' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICENSO.EQ.'ON' .AND. NRIGHT.LT.MINN2)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,361) 361 FORMAT('***** ERROR IN KOLMOGOROV-SMIRNOV GOODNESS OF FIT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,362)IHRIGH,IHRIG2 362 FORMAT(' THE INPUT NUMBER OF OBSERVATIONS ', 1 'IN VARIABLE ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,363) 363 FORMAT(' FOR WHICH A KOLMOGOROV-SMIRNOV GOODNESS OF FIT ', 1 'TEST') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,364)MINN2 364 FORMAT(' WAS TO HAVE BEEN PERFORMED MUST BE ',I8,' OR ', 1 'LARGER;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,366) 366 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,367) 367 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)THEN WRITE(ICOUT,368)(IANS(I),I=1,MIN(80,IWIDTH)) 368 FORMAT(80A1) CALL DPWRST('XXX','BUG ') ENDIF IERROR='YES' GOTO9000 ENDIF C IF(ICENSO.EQ.'ON' .AND. NRIGHT.NE.NLEFT)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,371) 371 FORMAT('***** ERROR IN KOLMOGOROV-SMIRNOV GOODNESS OF FIT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,372)IHLEFT,IHLEF2 372 FORMAT(' THE INPUT NUMBER OF OBSERVATIONS ', 1 'IN VARIABLE ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,373)IHRIGH,IHRIG2 373 FORMAT(' DOES NOT MATCH') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,374)IHRIGH,IHRIG2 374 FORMAT(' THE INPUT NUMBER OF OBSERVATIONS ', 1 'IN VARIABLE ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,377) 377 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)THEN WRITE(ICOUT,378)(IANS(I),I=1,MIN(80,IWIDTH)) 378 FORMAT(80A1) CALL DPWRST('XXX','BUG ') ENDIF IERROR='YES' GOTO9000 ENDIF C C ***************************************** C ** STEP 5-- ** C ** CHECK TO SEE THE TYPE SUBCASE ** C ** (BASED ON THE QUALIFIER)-- ** C ** 1) UNQUALIFIED (THAT IS, FULL); ** C ** 2) SUBSET/EXCEPT; OR ** C ** 3) FOR. ** C ***************************************** C ISTEPN='5' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICASEQ='FULL' ILOCQ=NUMARG+1 IF(NUMARG.LT.1)GOTO480 DO400J=1,NUMARG J1=J IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET ') GOTO410 IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT ') GOTO410 IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.' ') GOTO420 400 CONTINUE GOTO490 410 CONTINUE ICASEQ='SUBS' ILOCQ=J1 GOTO490 420 CONTINUE ICASEQ='FOR' ILOCQ=J1 GOTO490 C 480 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,481) 481 FORMAT('***** INTERNAL ERROR IN KOLMOGOROV-SMIRNOV GOODNESS OF ', 1 'FIT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,482) 482 FORMAT(' AT BRANCH POINT 481--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,483) 483 FORMAT(' NUMARG LESS THAN 1 EVEN THOUGH') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,484) 484 FORMAT(' NUMARG HAD PREVIOUSLY PASSED THIS TEST') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,485)NUMARG 485 FORMAT(' ONCE ALREADY. VALUE OF NUMARG = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,486) 486 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)THEN WRITE(ICOUT,487)(IANS(I),I=1,IWIDTH) 487 FORMAT(' ',80A1) CALL DPWRST('XXX','BUG ') ENDIF IERROR='YES' GOTO9000 C 490 CONTINUE IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'1KST')THEN WRITE(ICOUT,491)NUMARG,ILOCQ,ICASEQ 491 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4) CALL DPWRST('XXX','BUG ') ENDIF C C ****************************************************** C ** STEP 6-- ** C ** IF THERE ARE MORE THAN TWO RESPONSE VARIABLES, ** C ** THIS IS AN ERROR CONDITION. ** C ****************************************************** C ISTEPN='6' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C NUMV2=ILOCQ-1 IDATSW='RAW' C IF(NUMV2.GT.MAXV2)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,551) 551 FORMAT('***** ERROR IN KOLMOGOROV-SMIRNOV GOODNESS OF FIT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,552) 552 FORMAT(' FOR A ... KOLMOGOROV-SMIRNOV GOODNESS OF FIT ', 1 'TEST, ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,558) 558 FORMAT(' THE NUMBER OF VARIABLES MUST BE EITHER ONE OR ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,560) 560 FORMAT(' TWO; SUCH WAS NOT THE CASE HERE;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,561)NUMV2 561 FORMAT(' THE SPECIFIED NUMBER OF VARIABLES WAS ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,563) 563 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)THEN WRITE(ICOUT,564)(IANS(I),I=1,MIN(IWIDTH,80)) 564 FORMAT(80A1) CALL DPWRST('XXX','BUG ') ENDIF IERROR='YES' GOTO9000 ENDIF C C ***************************************** C ** STEP 7-- ** C ** BRANCH TO THE APPROPRIATE SUBCASE; ** C ** (BASED ON THE QUALIFIER) ** C ** THEN FORM THE RESPONSE VARIABLE ** C ** AND THE FACTORS ** C ** AND CARRY OUT THE PLOTS. ** C ***************************************** C ISTEPN='7' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICASEQ.EQ.'FULL')GOTO610 IF(ICASEQ.EQ.'SUBS')GOTO620 IF(ICASEQ.EQ.'FOR')GOTO630 C 610 CONTINUE DO615I=1,NLEFT ISUB(I)=1 615 CONTINUE NQ=NLEFT GOTO650 C 620 CONTINUE NIOLD=NLEFT CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4) NQ=NIOLD GOTO650 C 630 CONTINUE NIOLD=NLEFT CALL DPFOR(NIOLD,NFOR,IROW1,IROWN, 1NLOCAL,ILOCS,NS,IBUGQ,IERROR) NQ=NFOR GOTO650 C 650 CONTINUE J=0 IMAX=NLEFT IF(NQ.LT.NLEFT)IMAX=NQ DO660I=1,IMAX IF(ISUB(I).EQ.0)GOTO660 J=J+1 C IJ=MAXN*(ICOLL-1)+I IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ) IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I) IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I) IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I) IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I) IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I) IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I) IF(NUMV2.LE.1)GOTO660 C IJ=MAXN*(ICOLR-1)+I IF(ICOLR.LE.MAXCOL)CENSOR(J)=V(IJ) IF(ICOLR.EQ.MAXCP1)CENSOR(J)=PRED(I) IF(ICOLR.EQ.MAXCP2)CENSOR(J)=RES(I) IF(ICOLR.EQ.MAXCP3)CENSOR(J)=YPLOT(I) IF(ICOLR.EQ.MAXCP4)CENSOR(J)=XPLOT(I) IF(ICOLR.EQ.MAXCP5)CENSOR(J)=X2PLOT(I) IF(ICOLR.EQ.MAXCP6)CENSOR(J)=TAGPLO(I) C 660 CONTINUE NLOCAL=J C CCCCC OCTOBER 2004. FOR CENSORED CASE, CHECK THAT CENSOR VARIABLE CCCCC CONTAINS TWO DISTINCT VALUES, SET TO 1 AND 0. C IF(ICENSO.EQ.'ON'.AND.NUMV2.EQ.2)THEN IWRIT2='OFF' CALL DISTIN(CENSOR,NLOCAL,IWRIT2,XTEMP1,NDIST,IBUGA2,IERROR) IF(NDIST.EQ.1)THEN DO1102I=1,NLOCAL CENSOR(I)=1.0 1102 CONTINUE ELSEIF(NDIST.EQ.2)THEN IF(XTEMP1(1).EQ.1.0 .OR. XTEMP1(2).EQ.1.0)THEN DO1103I=1,NLOCAL IF(CENSOR(I).NE.1.0)CENSOR(I)=0.0 1103 CONTINUE ELSE ATEMP1=MIN(XTEMP1(1),XTEMP1(2)) ATEMP2=MAX(XTEMP1(1),XTEMP1(2)) DO1108I=1,NLOCAL IF(CENSOR(I).EQ.ATEMP1)CENSOR(I)=1.0 IF(CENSOR(I).EQ.ATEMP2)CENSOR(I)=0.0 1108 CONTINUE ENDIF ELSE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1104) 1104 FORMAT('***** ERROR IN KOLMOGOROV-SMIRNOV GOODNESS OF FIT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1105)IHRIGH,IHRIG2 1105 FORMAT(' FOR CENSORED DATA, THE CENSORING VARIABLE (', 1 A4,A4,')') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1106) 1106 FORMAT(' SHOULD CONTAIN AT MOST TWO DISTINCT VALUES.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1107)NDIST 1107 FORMAT(' ',I8,' DISTINCT VALUES FOUND.') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 ENDIF ENDIF C C *********************************************** C ** STEP 8-- ** C ** FOR THOSE DISTRIBUTIONS REQUIRING THEM, ** C ** DETERMINE IF THE ANALYST ** C ** HAS SPECIFIED PARAMETER VALUES ** C *********************************************** C ISTEPN='8' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICASPL.EQ.'LAPP')THEN IDIST='LAMBDA' IHP='LAMB' IHP2='DA ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST, 1 ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'TPP')THEN IDIST='T' IHP='NU ' IHP2=' ' CCCCC ILOWLM=1 CCCCC IUPPLM=I1MACH(9) CCCCC LOWLTY='>= ' CCCCC UPPLTY='<= ' CCCCC CALL PARCHI(IHP,IHP2,IDIST,NU,ILOWLM,IUPPLM,LOWLTY,UPPLTY, CCCCC1 ISUBN1,ISUBN2,IERROR) ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST, 1 ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'CSPP')THEN IDIST='CHI-SQUARED' IHP='NU ' IHP2=' ' ILOWLM=1 IUPPLM=I1MACH(9) LOWLTY='>= ' UPPLTY='<= ' CALL PARCHI(IHP,IHP2,IDIST,NU,ILOWLM,IUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'FPP')THEN IDIST='F ' IHP='NU1 ' IHP2=' ' ILOWLM=1 IUPPLM=I1MACH(9) LOWLTY='>= ' UPPLTY='<= ' CALL PARCHI(IHP,IHP2,IDIST,NU1,ILOWLM,IUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='NU2 ' IHP2=' ' CALL PARCHI(IHP,IHP2,IDIST,NU2,ILOWLM,IUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) GOTO4999 ENDIF IF(ICASPL.EQ.'GAPP')THEN IDIST='GAMMA' IHP='GAMM' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'BEPP')THEN IDIST='BETA' IHP='ALPH' IHP2='A ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='BETA' IHP2=' ' CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) GOTO4999 ENDIF IF(ICASPL.EQ.'BNPP')THEN IDIST='BETA-NORMAL' IHP='ALPH' IHP2='A ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='BETA' IHP2=' ' CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) GOTO4999 ENDIF IF(ICASPL.EQ.'WEPP')THEN IDIST='WEIBULL' IHP='GAMM' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'E2PP')THEN IDIST='EXTREME VALUE TYPE 2' IHP='GAMM' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'PAPP')THEN IDIST='PARETO' IHP='GAMM' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='A ' IHP2=' ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN A=1.0 ELSE A=VALUE(ILOCP) ENDIF C GOTO4999 ENDIF IF(ICASPL.EQ.'BIPP')THEN IDIST='BINOMIAL' IHP='N ' IHP2=' ' ILOWLM=1 IUPPLM=I1MACH(9) LOWLTY='>= ' UPPLTY='<= ' CALL PARCHI(IHP,IHP2,IDIST,N,ILOWLM,IUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='P ' IHP2=' ' ALOWLM=0.0 AUPPLM=1.0 LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'GEPP')THEN IDIST='GEOMETRIC' IHP='P ' IHP2=' ' ALOWLM=0.0 AUPPLM=1.0 LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'POPP')THEN IDIST='POISSON' IHP='LAMB' IHP2='DA ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'NBPP')THEN IDIST='NEGATIVE BINOMIAL' IHP='K ' IHP2=' ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,AK,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='P ' IHP2=' ' ALOWLM=0.0 AUPPLM=1.0 LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'IGPP')THEN IDIST='INVERSE GAUSSIAN' IHP='GAMM' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='MU ' IHP2=' ' IDIST='INVERSE GAUSSIAN' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,AMU,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')THEN AMU=1.0 ENDIF GOTO4999 ENDIF IF(ICASPL.EQ.'WAPP')THEN IDIST='WALD' IHP='GAMM' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'RIPP')THEN IDIST='RECIRPOCAL INVERSE GAUSSIAN' IHP='GAMM' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='MU ' IHP2=' ' IDIST='RECIPROCAL INVERSE GAUSSIAN' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,AMU,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')THEN AMU=1.0 ENDIF GOTO4999 ENDIF IF(ICASPL.EQ.'FLPP')THEN IDIST='FATIGUE LIFE' IHP='GAMM' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'GPPP')THEN IDIST='GENERALIZED PARETO' IHP='GAMM' IHP2='A ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'TRPP')THEN IDIST='TRIANGULAR' IHP='C ' IHP2=' ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST,C,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')THEN C=0.0 ENDIF GOTO4999 ENDIF IF(ICASPL.EQ.'DUPP')THEN IDIST='DISCRETE UNIFORM' IHP='N ' IHP2=' ' ILOWLM=1 IUPPLM=I1MACH(9) LOWLTY='>= ' UPPLTY='<= ' CALL PARCHI(IHP,IHP2,IDIST,NDUN,ILOWLM,IUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'NCBP')THEN IDIST='NON-CENTRAL BETA' IHP='ALPH' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='BETA' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='LAMB' IHP2='DA ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'NCPP')THEN IDIST='NON-CENTRAL CHI-SQUARE' IHP='NU ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='LAMB' IHP2='DA ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'NFPP')THEN IDIST='NON-CENTRAL F' IHP='NU1 ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ANU1,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='NU2 ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ANU2,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='LAMB' IHP2='DA ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'NTPP')THEN IDIST='NON-CENTRAL T' IHP='NU ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='LAMB' IHP2='DA ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'DNCF')THEN IDIST='DOUBLY NON-CENTRAL F' IHP='NU1 ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ANU1,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='NU2 ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ANU2,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='LAMB' IHP2='DA1 ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALAMB1,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='LAMB' IHP2='DA2 ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALAMB2,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'DNCT')THEN IDIST='DOUBLY NON-CENTRAL T' IHP='NU ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='LAMB' IHP2='DA1 ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALAMB1,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='LAMB' IHP2='DA2 ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALAMB2,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'HYPP')THEN IDIST='HYPERGEOMETRIC' IHP='M ' IHP2=' ' ILOWLM=1 IUPPLM=I1MACH(9) LOWLTY='>= ' UPPLTY='<= ' CALL PARCHI(IHP,IHP2,IDIST,MPAR,ILOWLM,IUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='N ' IHP2=' ' ILOWLM=1 IUPPLM=MPAR LOWLTY='>= ' UPPLTY='<= ' CALL PARCHI(IHP,IHP2,IDIST,NPAR,ILOWLM,IUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='K ' IHP2=' ' ILOWLM=1 IUPPLM=MPAR LOWLTY='>= ' UPPLTY='<= ' CALL PARCHI(IHP,IHP2,IDIST,K,ILOWLM,IUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'VMPP')THEN IDIST='VON MISES' IHP='B ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,B,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'PNPP')THEN IDIST='POWER NORMAL' IHP='P ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'PLPP')THEN IDIST='POWER LOG-NORMAL' IHP='P ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='SD ' IHP2=' ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES'.OR.VALUE(ILOCP).LE.0.0)THEN SD=1.0 ELSE SD=VALUE(ILOCP) ENDIF GOTO4999 ENDIF IF(ICASPL.EQ.'ALPP')THEN IDIST='ALPHA' IHP='ALPH' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='BETA' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'LNPP')THEN IHP='SIGM' IHP2='A ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES'.OR.VALUE(ILOCP).LE.0.0)THEN SIGMA=1.0 ELSE SIGMA=VALUE(ILOCP) ENDIF GOTO4999 ENDIF IF(ICASPL.EQ.'PFPP')THEN IDIST='POWER FUNCTION' IHP='C ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,C,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'CHPP')THEN IDIST='CHI' IHP='NU ' IHP2=' ' IDIST='CHI' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'DLPP')THEN IDIST='LOGARITMIC SERIES' IHP='THET' IHP2='A ' ALOWLM=0. AUPPLM=1.0 LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST,THETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'LLPP')THEN IDIST='LOG-LOGISTIC' IHP='DELT' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,DELTA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'GGPP')THEN IDIST='GENERALIZED GAMMA' IHP='ALPH' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='C ' IHP2=' ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,C,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IF(C.NE.0.0)GOTO4829 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4821) 4821 FORMAT('***** ERROR IN KOLMOGOROV-SMIRNOV GOODNESS OF FIT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4822) 4822 FORMAT(' THE SPECIFIED SHAPE PARAMETER C') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4823) 4823 FORMAT(' FOR THE GENERALIZED GAMMA DISTRIBUTION') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4824) 4824 FORMAT(' CANNOT BE EQUAL TO 0;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4825) 4825 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4826)C 4826 FORMAT(' THE SPECIFIED VALUE OF C = ',E15.7) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 4829 CONTINUE GOTO4999 ENDIF IF(ICASPL.EQ.'WRPP')THEN IDIST='WARING' IHP='C ' IHP2=' ' ALOWLM=1.0 AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,C,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='A ' IHP2=' ' IHWUSE='P' MESSAG='NO ' CALL CHECKN(IHP,IHP2,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN A=1.0 ELSE A=VALUE(ILOCP) ENDIF C IF(A.LT.1.0)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4911) 4911 FORMAT('***** ERROR IN KOLMOGOROV-SMIRNOV GOODNESS OF FIT--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4912) 4912 FORMAT(' THE SPECIFIED SHAPE PARAMETER A FOR THE WARING ', 1'DISTRIBUTION') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4913) 4913 FORMAT(' MUST BE GREATER THAN OR EQUAL TO 1 ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4914) 4914 FORMAT(' FOR THE KOLMOGOROV-SMIRNOV GOODNESS OF FIT;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4915) 4915 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4916)A 4916 FORMAT(' THE SPECIFIED VALUE OF A = ',E15.7) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 ENDIF GOTO4999 ENDIF IF(ICASPL.EQ.'FNPP')THEN IDIST='FOLDED NORMAL' IHP='MU ' IHP2=' ' IHWUSE='P' MESSAG='NO ' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN AM=0.0 ELSE AM=VALUE(ILOCP) ENDIF C IHP='SD ' IHP2=' ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES'.OR.VALUE(ILOCP).LE.0.0)THEN SD=1.0 ELSE SD=VALUE(ILOCP) ENDIF GOTO4999 ENDIF IF(ICASPL.EQ.'TNPP')THEN IDIST='TRUNCATED NORMAL' IHP='A ' IHP2=' ' IHWUSE='P' MESSAG='NO ' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN A=-99.9 ELSE A=VALUE(ILOCP) ENDIF C IHP='B ' IHP2=' ' IHWUSE='P' MESSAG='NO ' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN B=-99.9 ELSE B=VALUE(ILOCP) ENDIF C IHP='M ' IHP2=' ' IHWUSE='P' MESSAG='NO ' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN AM=0.0 ELSE AM=VALUE(ILOCP) ENDIF C IHP='SD ' IHP2=' ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES'.OR.VALUE(ILOCP).LE.0.0)THEN SD=1.0 ELSE SD=VALUE(ILOCP) ENDIF GOTO4999 ENDIF IF(ICASPL.EQ.'LGPP')THEN IDIST='LOG-GAMMA' IHP='GAMM' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'GOPP')THEN IDIST='GOMPERTZ' IHP='C ' IHP2=' ' ALOWLM=1. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,C,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='B ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,B,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'GVPP')THEN IDIST='GENERALIZED EXTREME VALUE' IHP='GAMM' IHP2='A ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'GZPP')THEN IDIST='GENERALIZED HALF-LOGISTIC' IHP='GAMM' IHP2='A ' ALOWLM=0.0 AUPPLM=5.0 LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'P2PP')THEN IDIST='PARETO TYPE 2' IHP='GAMM' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='A ' IHP2=' ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN A=1.0 ELSE A=VALUE(ILOCP) ENDIF GOTO4999 ENDIF IF(ICASPL.EQ.'DWPP')THEN IDIST='DOUBLE WEIBULL' IHP='GAMM' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'WCPP')THEN IDIST='WRAPPED CAUCHY' IHP='P ' IHP2=' ' ALOWLM=0. AUPPLM=1. LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'EWPP')THEN IDIST='EXPONENTIATED WEIBULL' IHP='GAMM' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='THET' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,THETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'TEPP')THEN IDIST='TRUNCATED EXPONENTIAL' IHP='X0 ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,X0,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='M ' IHP2=' ' IHWUSE='P' MESSAG='NO ' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN AM=0.0 ELSE AM=VALUE(ILOCP) ENDIF C IHP='SD ' IHP2=' ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES'.OR.VALUE(ILOCP).LE.0.0)THEN SD=1.0 ELSE SD=VALUE(ILOCP) ENDIF GOTO4999 ENDIF IF(ICASPL.EQ.'GLPP')THEN IDIST='GENERALIZED LOGISTIC' IHP='ALPH' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'G2PP')THEN IDIST='GENERALIZED LOGISTIC TYPE 2' IHP='ALPH' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'G3PP')THEN IDIST='GENERALIZED LOGISTIC TYPE 3' IHP='ALPH' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'G4PP')THEN IDIST='GENERALIZED LOGISTIC TYPE 4' IHP='P ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='Q ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,Q,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'G5PP')THEN IDIST='GENERALIZED LOGISTIC TYPE 5 (HOSKING)' C IHP='ALPH' IHP2='A ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF C IF(ICASPL.EQ.'WAKE')THEN IDIST='WAKEBY' C IHP='GAMM' IHP2='A ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C IHP='BETA' IHP2=' ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C IHP='DELT' IHP2='A ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,DELTA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'PEPP')THEN IDIST='EXPONENTIAL POWER' IHP='ALPH' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C IHP='BETA' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'DGPP')THEN IDIST='DOUBLE GAMMA' IHP='GAMM' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'KAPP')THEN IDIST='MIELKE BETA-KAPPA' IHP='BETA' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='THET' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,THETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='K ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'FCPP')THEN IDIST='FOLDED CAUCHY' IHP='M ' IHP2=' ' IHWUSE='P' MESSAG='NO ' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN AM=0.0 ELSE AM=VALUE(ILOCP) ENDIF C IHP='SD ' IHP2=' ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES'.OR.VALUE(ILOCP).LE.0.0)THEN SD=1.0 ELSE SD=VALUE(ILOCP) ENDIF GOTO4999 ENDIF IF(ICASPL.EQ.'BBPP')THEN IDIST='BETA-BINOMIAL' IHP='ALPH' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='BETA' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='N ' IHP2=' ' ILOWLM=0 IUPPLM=I1MACH(9) LOWLTY='> ' UPPLTY='<= ' CALL PARCHI(IHP,IHP2,IDIST,NU,ILOWLM,IUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'BRPP')THEN IDIST='BRADFORD' IHP='BETA' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'GXPP')THEN IDIST='GENERALIZED EXPONENTIAL' IHP='LAMB' IHP2='DA1 ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALAMB1,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='LAMB' IHP2='DA2 ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALAMB2,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='S ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'REPP')THEN IDIST='RECIPROCAL' IHP='B ' IHP2=' ' ALOWLM=1. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,B,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'NMPP')THEN IDIST='NORMAL MIXTURE' IHP='U1 ' IHP2=' ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,U1,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='U2 ' IHP2=' ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,U2,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='SD1 ' IHP2=' ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,SD1,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='SD2 ' IHP2=' ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,SD2,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='P ' IHP2=' ' ALOWLM=0.0 AUPPLM=1.0 LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'GIPP')THEN IDIST='INVERTED GAMMA' IHP='GAMM' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'IWPP')THEN IDIST='INVERTED WEIBULL' IHP='GAMM' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'LXPP')THEN IDIST='LOG DOUBLE EXPONENTIAL' IHP='ALPH' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST, 1 ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'LBPP')THEN IDIST='LOG-BETA' IHP='ALPH' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='BETA' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='C ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,YLOWLM,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='D ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,YUPPLM,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF C IF(ICASPL.EQ.'AXPP')THEN IDIST='ASYMMETRIC LOG DOUBLE EXPONENTIAL' IHP='ALPH' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST, 1 ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='BETA' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST, 1 BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'JUPP')THEN IDIST='JOHNSON SU' IHP='ALPH' IHP2='A1 ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST, 1 ALPHA1,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='ALPH' IHP2='A2 ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST, 1 ALPHA2,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'JBPP')THEN IDIST='JOHNSON SB' IHP='ALPH' IHP2='A1 ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST, 1 ALPHA1,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='ALPH' IHP2='A2 ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST, 1 ALPHA2,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'LDPP')THEN IDIST='GENERALIZED TUKEY-LAMBDA' IHP='LAMB' IHP2='DA3 ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST, 1 ALAMB3,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='LAMB' IHP2='DA4 ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST, 1 ALAMB4,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) CCCCC IWRITE='OFF' CCCCC ZSCALE=1.0 CCCCC CALL GLDCHK(ALAMB3,ALAMB4,ALOWER,AUPPER,IFLAG,ISIGN,IWRITE) CCCCC IF(ISIGN.LT.0)ZSCALE=-1.0 IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'EEPP')THEN IDIST='GEOMETRIC EXTREME EXPONENTIAL' IHP='GAMM' IHP2='A ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'TSPP')THEN IDIST='TWO-SIDED POWER' IHP='THET' IHP2='A ' ALOWLM=0. AUPPLM=1.0 LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,THETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='N ' IHP2=' ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'BWPP')THEN IDIST='BIWEIBULL' IHP='SCAL' IHP2='E1 ' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,SCALE1,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='SCAL' IHP2='E2 ' IDIST='BIWEIBULL' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,SCALE2,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='GAMM' IHP2='A1 ' IDIST='BIWEIBULL' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA1,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='GAMM' IHP2='A2 ' IDIST='BIWEIBULL' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA2,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='LOC2' IHP2=' ' IDIST='BIWEIBULL' ALOWLM=0. AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,LOC2,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'ERPP')THEN IDIST='ERROR' IHP='ALPH' IHP2='A ' ALOWLM=1.0 AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF IF(ICASPL.EQ.'TZPP')THEN IDIST='TRAPEZOID' IHP='A ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 A=VALUE(ILOCP) C IHP='B ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 B=VALUE(ILOCP) C IHP='C ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C=VALUE(ILOCP) C IHP='D ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 DZ=VALUE(ILOCP) C IF(A.GE.B .OR. B.GE.C .OR. C.GE.DZ)THEN WRITE(ICOUT,7312) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7313) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7314) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7316)A,B,C,DZ CALL DPWRST('XXX','BUG ') PDF=0.0 GOTO9000 ENDIF 7312 FORMAT( 1'***** FATAL ERROR--FOR THE TRAPEZOID DISTRIBUTION, THE FOUR') 7313 FORMAT( 1' SHAPE PARAMETERS (A, B, C, D) MUST SATISFY') 7314 FORMAT( 1' A < B < C < D') 7316 FORMAT( 1' A, B, C, D = ',4E15.7) C ENDIF C IF(ICASPL.EQ.'GTPP')THEN IDIST='GENERALIZED TRAPEZOID' IHP='A ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 A=VALUE(ILOCP) C IHP='B ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 B=VALUE(ILOCP) C IHP='C ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C=VALUE(ILOCP) C IHP='D ' IHP2=' ' IHWUSE='P' MESSAG='YES' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')GOTO9000 DZ=VALUE(ILOCP) C IHP='ALPH' IHP2='A ' IDIST='GENERALIZED TRAPEZOID' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C IHP='NU1 ' IHP2=' ' IDIST='GENERALIZED TRAPEZOID' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ANU1,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C IHP='NU3 ' IHP2=' ' IDIST='GENERALIZED TRAPEZOID' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ANU3,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C IF(A.GE.B .OR. B.GE.C .OR. C.GE.DZ)THEN WRITE(ICOUT,7322) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7323) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7324) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7326)A,B,C,DZ CALL DPWRST('XXX','BUG ') PDF=0.0 GOTO9000 ENDIF 7322 FORMAT( 1'***** FATAL ERROR--FOR THE GENERALZIED TRAPEZOID DISTRIBUTION,') 7323 FORMAT( 1' THE FOUR SHAPE PARAMETERS (A, B, C, D) MUST SATISFY') 7324 FORMAT( 1' A < B < C < D') 7326 FORMAT( 1' A, B, C, D = ',4E15.7) C ENDIF C IF(ICASPL.EQ.'FTPP')THEN IDIST='FOLDED T' IHP='NU ' IHP2=' ' ILOWLM=1 IUPPLM=I1MACH(9) LOWLTY='>= ' UPPLTY='<= ' CALL PARCHI(IHP,IHP2,IDIST,NU,ILOWLM,IUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF C IF(ICASPL.EQ.'SNPP')THEN IDIST='SKEWED NORMAL' IHP='LAMB' IHP2='DA ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF C IF(ICASPL.EQ.'STPP')THEN IDIST='SKEWED T' IHP='NU ' IHP2=' ' ILOWLM=1 IUPPLM=I1MACH(9) LOWLTY='>= ' UPPLTY='<= ' CALL PARCHI(IHP,IHP2,IDIST,NU,ILOWLM,IUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C IHP='LAMB' IHP2='DA ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF C IF(ICASPL.EQ.'IBPP')THEN IDIST='INVERTED BETA' IHP='ALPH' IHP2='A ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='BETA' IHP2=' ' CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) GOTO4999 ENDIF C IF(ICASPL.EQ.'GMPP')THEN IF(IMAKDF.EQ.'DLMF')THEN IDIST='GOMPERTZ-MAKEHAM' IHP='XI ' IHP2=' ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,XI,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='LAMB' IHP2='DA ' CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) LOWLTY='>= ' IHP='THET' IHP2='A ' CALL PARCHR(IHP,IHP2,IDIST,THETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) ELSEIF(IMAKDF.EQ.'MEEK')THEN IDIST='GOMPERTZ-MAKEHAM' IHP='GAMM' IHP2='A ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 LOWLTY='>= ' IHP='LAMB' IHP2='DA ' CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) LOWLTY='> ' IHP='K ' IHP2=' ' CALL PARCHR(IHP,IHP2,IDIST,AK,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) ELSE IDIST='GOMPERTZ-MAKEHAM' IHP='ETA ' IHP2=' ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ETA,ALOWLM,AUPPLM, 1 LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' IHP='ZETA' IHP2=' ' CALL PARCHR(IHP,IHP2,IDIST,ZETA,ALOWLM,AUPPLM, 1 LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) ENDIF GOTO4999 ENDIF C IF(ICASPL.EQ.'GIGP')THEN IDIST='GENERALIZED INVERSE GAUSSIAN' IHP='CHI ' IHP2=' ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,CHI,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='LAMB' IHP2='DA ' CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IHP='THET' IHP2='A ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST,THETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) GOTO4999 ENDIF C IF(ICASPL.EQ.'GHPP')THEN IDIST='G-H' IHP='G ' IHP2=' ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='>= ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,G,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 ALOWLM=0.0 IHP='H ' IHP2=' ' CALL PARCHR(IHP,IHP2,IDIST,H,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) GOTO4999 ENDIF C IF(ICASPL.EQ.'LZPP')THEN IDIST='LOG SKEWED NORMAL' IHP='LAMB' IHP2='DA ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C IHP='SD ' IHP2=' ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST,SD,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF C IF(ICASPL.EQ.'LTPP')THEN IDIST='LOG SKEWED T' IHP='NU ' IHP2=' ' ILOWLM=1 IUPPLM=I1MACH(9) LOWLTY='>= ' UPPLTY='<= ' CALL PARCHI(IHP,IHP2,IDIST,NU,ILOWLM,IUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C IHP='LAMB' IHP2='DA ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C IHP='SD ' IHP2=' ' IDIST='LOG SKEWED T' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST,SD,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF C IF(ICASPL.EQ.'SDPP')THEN IDIST='SKEWED DOUBLE EXPONENTIAL' IHP='LAMB' IHP2='DA ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF C IF(ICASPL.EQ.'ADPP')THEN IDIST='ASYMMETRIC DOUBLE EXPONENTIAL' IF(IADEDF.EQ.'K')THEN IHP='K ' IHP2=' ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST,AK,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ELSE IHP='MU ' IHP2=' ' ALOWLM=CPUMIN AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST,AMU,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF ENDIF C IF(ICASPL.EQ.'MXPP')THEN IDIST='MAXWELL' IHP='SIGM' IHP2='A ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST,SIGMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF C IF(ICASPL.EQ.'GALP')THEN IDIST='GENERALIZED ASYMMETRIC DOUBLE EXPONENTIAL' IF(IADEDF.EQ.'K')THEN IHP='K ' IHP2=' ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST,AK,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 IHP='TAU ' IHP2=' ' CALL PARCHR(IHP,IHP2,IDIST,TAU,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 ELSE IHP='MU ' IHP2=' ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST,AMU,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 ENDIF GOTO4999 ENDIF C IF(ICASPL.EQ.'MCPP')THEN IDIST='MCLEISH' IHP='ALPH' IHP2='A ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF C IF(ICASPL.EQ.'GMCP')THEN IDIST='GENERALIZED MCLEISH' IHP='ALPH' IHP2='A ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C IHP='A ' IHP2=' ' ALOWLM=-1.0 AUPPLM=1.0 LOWLTY='> ' UPPLTY='< ' CALL PARCHR(IHP,IHP2,IDIST,A,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF C IF(ICASPL.EQ.'BEIP' .OR. ICASPL.EQ.'BEKP')THEN IDIST='BESSEL I-FUNCTION' IF(ICASPL.EQ.'BEKP')IDIST='BESSEL K-FUNCTION' IF(IBEIDF.EQ.'1')THEN IHP='SIGM' IHP2='A1SQ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,SD1,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C IHP='SIGM' IHP2='A2SQ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,SD2,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C IHP='NU ' IHP2=' ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ELSE IHP='B ' IHP2=' ' ALOWLM=0.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,B,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C IHP='C ' IHP2=' ' ALOWLM=1.0 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,C,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C IHP='M ' IHP2=' ' ALOWLM=0.5 AUPPLM=CPUMAX LOWLTY='> ' UPPLTY='<= ' CALL PARCHR(IHP,IHP2,IDIST,AM,ALOWLM,AUPPLM,LOWLTY,UPPLTY, 1 ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 GOTO4999 ENDIF ENDIF C CCCCC IF(ICASPL.EQ.'SEPP')THEN CCCCC IDIST='SEMI-CIRCULAR' CCCCC IHP='R ' CCCCC IHP2=' ' CCCCC ALOWLM=0.0 CCCCC AUPPLM=CPUMAX CCCCC LOWLTY='> ' CCCCC UPPLTY='< ' CCCCC CALL PARCHR(IHP,IHP2,IDIST, CCCCC1 SIGMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY, CCCCC1 ISUBN1,ISUBN2,IERROR) CCCCC IF(IERROR.EQ.'YES')GOTO9000 CCCCC GOTO4999 CCCCC ENDIF C 4999 CONTINUE C C LOCATION AND SCALE FOR ALL DISTRIBUTIONS C IHP='KSLO' IHP2='C ' IHWUSE='P' MESSAG='NO ' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN KSLOC=0.0 ELSE KSLOC=VALUE(ILOCP) ENDIF C IHP='KSSC' IHP2='ALE ' IHWUSE='P' MESSAG='NO ' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN AKSCAL=1.0 ELSE AKSCAL=VALUE(ILOCP) ENDIF IF(AKSCAL.LE.0.0)AKSCAL=1.0 C C ***************************************************** C ** STEP 9-- ** C ** COMPUTE THE KOLMOGOROV-SMIRNOV GOODNESS OF FIT ** C ** TEST ** C ***************************************************** C ISTEPN='9' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'1KST')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5111) 5111 FORMAT('***** FROM THE MIDDLE OF DP1KST--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5112)ICASPL,NUMV2,NLOCAL,IDATSW 5112 FORMAT('ICASPL,NUMV2,NLOCAL,IDATSW = ',A4,I8,2X,I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5113)ALAMBA,NU,NU1,NU2 5113 FORMAT('ALAMBA,NU,NU1,NU2 = ',E15.7,I8,I8,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5114)GAMMA,ALPHA,BETA,NPAR,P,K 5114 FORMAT('GAMMA,ALPHA,BETA,NPAR,P,K = ',3E15.7,I8,E15.7,I8) CALL DPWRST('XXX','BUG ') DO5116I=1,NLOCAL WRITE(ICOUT,5117)I,Y1(I),CENSOR(I) 5117 FORMAT('I,Y1(I) = ',I8,2E15.7) CALL DPWRST('XXX','BUG ') 5116 CONTINUE ENDIF C IWRIT2='ON' C CALL DP1KS2(Y1,NLOCAL,ICASPL, 1CENSOR,ICENSO, 1ALAMBA,NU,NU1,NU2,GAMMA,ALPHA,BETA,NPAR,P,K,MINMAX, 1ANU,ANU1,ANU2,NDUN,C,ALAMB1,ALAMB2,MPAR,B,SD,THETA,DELTA,A,AM,X0, 1U1,SD1,U2,SD2,DZ, 1ALAMB3,ALAMB4,ALPHA1,ALPHA2, CCCCC MAY 2002: ADD FOLLOWING LINE 1SCALE1,GAMMA1,LOC2,SCALE2,GAMMA2, 1AMU,XI,CHI,G,H,AK,SIGMA, 1ETA,ZETA,TAU,Q, 1YLOWLM,YUPPLM, 1KSLOC,AKSCAL, 1STATVA,CUTU90,CUTU95,CUTU99, 1ICAPSW,ICAPTY, 1IWRIT2,IADEDF,IGEPDF,IMAKDF,IBEIDF, 1ILGADF,ISKNDF,IGLDDF, 1YOBS,YEXP,N2,IBUGA3,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C C *************************************** C ** STEP 7-- ** C ** UPDATE INTERNAL DATAPLOT TABLES ** C *************************************** C ISTEPN='7' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ISUBN0='DP1K' C IH='STAT' IH2='VAL ' VALUE0=STATVA CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTU' IH2='PP90' VALUE0=CUTU90 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTU' IH2='PP95' VALUE0=CUTU95 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTU' IH2='PP99' VALUE0=CUTU99 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'1KST')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DP1KST--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IFOUND,IERROR 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)NS,ICASPL 9013 FORMAT('NS,ICASPL = ',I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)ALAMBA,NU,NU1,NU2 9014 FORMAT('ALAMBA,NU,NU1,NU2 = ',E15.7,I8,I8,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)GAMMA,ALPHA,BETA,NPAR,P,K 9015 FORMAT('GAMMA,ALPHA,BETA,NPAR,P,K = ',3E15.7,I8,E15.7,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)MINMAX 9016 FORMAT('MINMAX = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9017)ALPHA,BETA 9017 FORMAT('ALPHA,BETA = ',2E15.7) CALL DPWRST('XXX','BUG ') ENDIF C RETURN END SUBROUTINE DP1KS2(Y,N,ICASPL, 1CENSOR,ICENSO, 1ALAMBA,NU,NU1,NU2,GAMMA,ALPHA,BETA,NPAR,P,K,MINMAX, 1ANU,ANU1,ANU2,NDUN,C,ALAMB1,ALAMB2,MPAR,B,SD,THETA, 1DELTA,A,AM,X0, 1U1,SD1,U2,SD2,DZ, 1ALAMB3,ALAMB4,ALPHA1,ALPHA2, CCCCC MAY 2002: ADD FOLLOWING LINE 1ASCAL1,GAMMA1,ALOC2,ASCAL2,GAMMA2, 1AMU,XI,CHI,G,H,AK,SIGMA, 1ETA,ZETA,TAU,Q, 1YLOWLM,YUPPLM, 1KSLOC,KSSCAL, 1STATVA,CDF1,CDF2,CDF3, 1ICAPSW,ICAPTY, 1IWRIT2,IADEDF,IGEPDF,IMAKDF,IBEIDF, 1ILGADF,ISKNDF,IGLDDF, 1Y2,X2,N2,IBUGA3,IERROR) C C PURPOSE--COMPUTE A KOLMOGOROV-SMIRNOV GOODNESS OF FIT TEST C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--98/11 C ORIGINAL VERSION--NOVEMBER 1998. C UPDATED --OCTOBER 2001. C UPDATED --NOVEMBER 2001. GEOMETRIC EXTREME EXPONENTIAL C UPDATED --MAY 2002. TWO-SIDED POWER C UPDATED --MAY 2002. BIWEIBULL C UPDATED --APRIL 2003. LANDAU C UPDATED --MAY 2003. ERROR (= EXPONENTIAL POWER) C UPDATED --JUNE 2003. TRAPEZOID C UPDATED --OCTOBER 2003. ADD SUPPORT FOR HTML, LATEX OUTPUT C UPDATED --NOVEMBER 2003. FOLDED T C UPDATED --DECEMBER 2003. SUPPORT FOR MU PARAMETER FOR C INVERSE GAUSSIAN C UPDATED --DECEMBER 2003. SKEWED NORMAL, SKEWED T, C SLASH, INVERTED BETA, C GOMPERTZ-MAKEHAM, G-H C UPDATED --MARCH 2004. LOG SKEWED NORMAL C LOG SKEWED T C UPDATED --JUNE 2004. SKEWED DOUBLE EXPONENTIAL C UPDATED --JUNE 2004. ASYMMETRIC DOUBLE EXPONENTIAL C UPDATED --JUNE 2004. MAXWELL, RAYLEIGH C UPDATED --JULY 2004. ALTERNATE DEFINITION FOR C GOMPERTZ-MAKEHAM C UPDATED --AUGUST 2004. GENERALIZED ASYMMETRIC C DOUBLE EXPONENTIAL C UPDATED --AUGUST 2004. MCLEISH C UPDATED --AUGUST 2004. BESSEL I-FUNCTION C UPDATED --SEPTEMBER 2004. GENERALIZED MCLEISH C UPDATED --OCTOBER 2004. SUPPORT FOR CENSORED DATA C (BASE ON KAPLAN-MEIER EMPIRICAL C CDF) C UPDATED --JULY 2005. CALL LIST TO LGACDF AND SNCDF C UPDATED --FEBRUARY 2006. GENERALIZED LOGISTIC TYPE 5 C UPDATED --FEBRUARY 2006. WAKEBY C UPDATED --FEBRUARY 2006. FMKL PARAMETERIZATION FOR C GENERALIZED TUKEY LAMBDA C UPDATED --MARCH 2006. BETA-NORMAL C UPDATED --MARCH 2006. GENERALIZED LOGISTIC TYPE 2 C UPDATED --MARCH 2006. GENERALIZED LOGISTIC TYPE 3 C UPDATED --MARCH 2006. GENERALIZED LOGISTIC TYPE 4 C UPDATED --MARCH 2006. ASYMMETRIC LOG DOUBLE C EXPONENTIAL C UPDATED --AUGUST 2006. LOG BETA C UPDATED --OCTOBER 2006. SHAPE PARAMETER FOR SEMCDF C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C LOGICAL POINT C CHARACTER*4 ICASPL CHARACTER*4 ICAPSW CHARACTER*4 ICAPTY CHARACTER*4 IBUGA3 CHARACTER*4 IWRITE CHARACTER*4 IWRIT2 CHARACTER*4 ICENSO CHARACTER*4 IADEDF CHARACTER*4 IGEPDF CHARACTER*4 IMAKDF CHARACTER*4 IBEIDF CHARACTER*4 ILGADF CHARACTER*4 ISKNDF CHARACTER*4 IGLDDF CHARACTER*4 IERROR C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C CHARACTER*4 IRELAT CHARACTER*1 IBASLC C CHARACTER*6 ICONC1 CHARACTER*6 ICONC2 CHARACTER*6 ICONC3 CHARACTER*50 IDIST C REAL KSLOC REAL KSSCAL C DOUBLE PRECISION DM DOUBLE PRECISION DTEMP1 DOUBLE PRECISION DTEMP2 DOUBLE PRECISION DOUT1 DOUBLE PRECISION DN DOUBLE PRECISION DCURR DOUBLE PRECISION DCORR DOUBLE PRECISION DPROD DOUBLE PRECISION CDFGLO DOUBLE PRECISION CDFWAK DOUBLE PRECISION XPAR(5) C C--------------------------------------------------------------------- C DIMENSION Y(*) DIMENSION Y2(*) DIMENSION X2(*) DIMENSION CENSOR(*) C REAL CV90(40) REAL CV95(40) REAL CV99(40) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C DATA CV90/ 1 0.950,0.776,0.636,0.565,0.509,0.468,0.436,0.410,0.387,0.369, 1 0.352,0.338,0.325,0.314,0.304,0.295,0.286,0.279,0.271,0.265, 1 0.259,0.253,0.247,0.242,0.238,0.233,0.229,0.225,0.221,0.218, 1 0.214,0.211,0.208,0.205,0.202,0.199,0.196,0.194,0.191,0.189/ DATA CV95/ 1 0.975,0.842,0.708,0.624,0.563,0.519,0.483,0.454,0.430,0.409, 1 0.391,0.375,0.361,0.349,0.338,0.327,0.318,0.309,0.301,0.294, 1 0.287,0.281,0.275,0.269,0.264,0.259,0.254,0.250,0.246,0.242, 1 0.238,0.234,0.231,0.227,0.224,0.221,0.218,0.215,0.213,0.210/ DATA CV99/ 1 0.995,0.929,0.829,0.734,0.669,0.617,0.576,0.542,0.513,0.489, 1 0.468,0.449,0.432,0.418,0.404,0.392,0.381,0.371,0.361,0.352, 1 0.344,0.337,0.330,0.323,0.317,0.311,0.305,0.300,0.295,0.290, 1 0.285,0.281,0.277,0.273,0.269,0.265,0.262,0.258,0.255,0.252/ C C-----START POINT----------------------------------------------------- C C ISUBN1='DP1K' ISUBN2='S2 ' C IRELAT='OFF' IERROR='NO' C C ******************************************** C ** STEP 1-- ** C ** CHECK THE INPUT ARGUMENTS FOR ERRORS ** C ******************************************** C IF(N.GE.1)GOTO39 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,31) 31 FORMAT('***** ERROR IN DP1KS2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,32) 32 FORMAT(' THE NUMBER OF OBSERVATIONS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,33) 33 FORMAT(' MUST BE AT LEAST 1;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,34)N 34 FORMAT(' THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 39 CONTINUE C IF(N.GE.2)GOTO49 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,46) 46 FORMAT('***** ERROR IN DP1KS2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,47) 47 FORMAT(' THE NUMBER OF OBSERVATIONS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,48) 48 FORMAT(' WAS EXACTLY EQUAL TO 1.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 49 CONTINUE C HOLD=Y(1) DO60I=1,N IF(Y(I).NE.HOLD)GOTO69 60 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61) 61 FORMAT('***** ERROR IN DP1KS2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,62) 62 FORMAT(' ALL INPUT VERTICAL AXIS ELEMENTS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,63)HOLD 63 FORMAT(' ARE IDENTICALLY EQUAL TO ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 69 CONTINUE C IF(IBUGA3.EQ.'OFF')GOTO80 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,71) 71 FORMAT('***** AT THE BEGINNING OF DP1KS2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,72)ICASPL,N 72 FORMAT('ICASPL,N, = ',A4,2X,2X,I8,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,73)ALAMBA,NU,NU1,NU2 73 FORMAT('ALAMBA,NU,NU1,NU2 = ',E15.7,I8,I8,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,74)GAMMA,ALPHA,BETA,NPAR,P,K 74 FORMAT('GAMMA,ALPHA,BETA,NPAR,P,K = ',3E15.7,I8,E15.7,I8) CALL DPWRST('XXX','BUG ') CCCCC THE FOLLOWING 2 LINES WERE ADDED MAY 1993 WRITE(ICOUT,75)MINMAX 75 FORMAT('MINMAX = ',I8) CALL DPWRST('XXX','BUG ') IF(N.LE.0)GOTO80 DO85I=1,N WRITE(ICOUT,86)I,Y(I),CENSOR(I) 86 FORMAT('I,Y(I),CENSOR(I) = ',I8,3E12.5) CALL DPWRST('XXX','BUG ') 85 CONTINUE 80 CONTINUE C C ************************************** C ** STEP 4-- ** C ** COMPUTE THE EMPIRICAL CDF ** C ** FUNCTION ** C ************************************** C C FOR K-S TEST, ONLY UNBINNED DATA SUPPORTED. C IF(ICENSO.EQ.'ON')THEN CALL SORTC(Y,CENSOR,N,Y,CENSOR) XMIN=Y(1) XMAX=Y(N) DN=DBLE(N) J=1 X2(J)=0.0 Y2(J)=1.0 DPROD=1.0D0 DCORR=(DN + 0.7D0)/(DN + 0.4D0) IR=0 DO100I=1,N IF(ABS(CENSOR(I)).LT.0.5)GOTO100 IR=IR+1 J=J+1 X2(J)=Y(I) Y2(J)=Y2(J-1) J=J+1 DCURR=(DN - DBLE(I) + 0.7D0)/(DN - DBLE(I) + 1.7D0) DPROD=DPROD*DCURR X2(J)=Y(I) Y2(J)=REAL(DCORR*DPROD) 100 CONTINUE N2=J J=0 DO110I=N2,1,-1 J=J+1 CENSOR(J)=Y2(I) 110 CONTINUE DO120I=1,N2 Y2(I)=CENSOR(I) 120 CONTINUE ELSE CALL SORT(Y,N,Y) XMIN=Y(1) XMAX=Y(N) J=1 X2(J)=Y(1) Y2(J)=0.0 J=2 X2(J)=Y(1) Y2(J)=1.0/REAL(N) DO200I=2,N J=J+1 X2(J)=Y(I) Y2(J)=REAL(I-1)/REAL(N) J=J+1 X2(J)=Y(I) Y2(J)=REAL(I)/REAL(N) 200 CONTINUE N2=J ENDIF C IF(IBUGA3.EQ.'ON')THEN WRITE(ICOUT,281)ICENSO,N2 281 FORMAT('ICENSO,N2 = ',A4,I8) CALL DPWRST('XXX','BUG ') DO285I=1,N2 WRITE(ICOUT,286)I,Y2(I),X2(I) 286 FORMAT('I,Y2(I),X2(I) = ',I8,2E12.5) CALL DPWRST('XXX','BUG ') 285 CONTINUE ENDIF C C ************************************************ C ** STEP 4.1-- ** C ** COMPUTE KOLMOGOROV-SMIRNOV OBSERVED AND ** C ** EXPECTED ** C ************************************************ C 1100 CONTINUE C DM=0.0D0 DO1199I=1,N2 C XL=X2(I) C IF(ICASPL.EQ.'UNPP')GOTO1110 IF(ICASPL.EQ.'NOPP')GOTO1120 IF(ICASPL.EQ.'LOPP')GOTO1130 IF(ICASPL.EQ.'DEPP')GOTO1140 IF(ICASPL.EQ.'CAPP')GOTO1150 IF(ICASPL.EQ.'LAPP')GOTO1160 IF(ICASPL.EQ.'LNPP')GOTO1170 IF(ICASPL.EQ.'HNPP')GOTO1180 IF(ICASPL.EQ.'TPP')GOTO1190 IF(ICASPL.EQ.'CSPP')GOTO1200 IF(ICASPL.EQ.'FPP')GOTO1210 IF(ICASPL.EQ.'EXPP')GOTO1220 IF(ICASPL.EQ.'GAPP')GOTO1230 IF(ICASPL.EQ.'BEPP')GOTO1240 IF(ICASPL.EQ.'WEPP')GOTO1250 IF(ICASPL.EQ.'E1PP')GOTO1260 IF(ICASPL.EQ.'E2PP')GOTO1270 IF(ICASPL.EQ.'PAPP')GOTO1280 IF(ICASPL.EQ.'BIPP')GOTO1290 IF(ICASPL.EQ.'GEPP')GOTO1300 IF(ICASPL.EQ.'POPP')GOTO1310 IF(ICASPL.EQ.'NBPP')GOTO1320 IF(ICASPL.EQ.'SEPP')GOTO1330 IF(ICASPL.EQ.'TRPP')GOTO1340 IF(ICASPL.EQ.'IGPP')GOTO1350 IF(ICASPL.EQ.'WAPP')GOTO1360 IF(ICASPL.EQ.'RIPP')GOTO1370 IF(ICASPL.EQ.'FLPP')GOTO1380 IF(ICASPL.EQ.'GPPP')GOTO1390 IF(ICASPL.EQ.'DUPP')GOTO1400 IF(ICASPL.EQ.'NTPP')GOTO1410 IF(ICASPL.EQ.'NYPP')GOTO1410 IF(ICASPL.EQ.'NFPP')GOTO1420 IF(ICASPL.EQ.'NCPP')GOTO1430 IF(ICASPL.EQ.'NXPP')GOTO1430 IF(ICASPL.EQ.'NCBP')GOTO1440 IF(ICASPL.EQ.'DNCT')GOTO1450 IF(ICASPL.EQ.'DNCF')GOTO1460 IF(ICASPL.EQ.'HYPP')GOTO1470 IF(ICASPL.EQ.'VMPP')GOTO1480 IF(ICASPL.EQ.'PNPP')GOTO1490 IF(ICASPL.EQ.'PLPP')GOTO1500 IF(ICASPL.EQ.'ALPP')GOTO1510 IF(ICASPL.EQ.'COPP')GOTO1520 IF(ICASPL.EQ.'PFPP')GOTO1530 IF(ICASPL.EQ.'CHPP')GOTO1540 IF(ICASPL.EQ.'DLPP')GOTO1550 IF(ICASPL.EQ.'LLPP')GOTO1560 IF(ICASPL.EQ.'GGPP')GOTO1570 IF(ICASPL.EQ.'WRPP')GOTO1580 IF(ICASPL.EQ.'ANPP')GOTO1590 IF(ICASPL.EQ.'ARPP')GOTO1600 IF(ICASPL.EQ.'FNPP')GOTO1610 IF(ICASPL.EQ.'TNPP')GOTO1620 IF(ICASPL.EQ.'LGPP')GOTO1630 IF(ICASPL.EQ.'HSPP')GOTO1640 IF(ICASPL.EQ.'GOPP')GOTO1650 IF(ICASPL.EQ.'HCPP')GOTO1660 IF(ICASPL.EQ.'HLPP')THEN IDIST='HALF LOGISTIC' GAMMA=-1.0 GOTO1670 ENDIF IF(ICASPL.EQ.'GZPP')THEN IDIST='GENERALIZED HALF LOGISTIC' GOTO1670 ENDIF IF(ICASPL.EQ.'GVPP')GOTO1680 IF(ICASPL.EQ.'P2PP')GOTO1690 IF(ICASPL.EQ.'DWPP')GOTO1700 IF(ICASPL.EQ.'WCPP')GOTO1710 IF(ICASPL.EQ.'EWPP')GOTO1720 IF(ICASPL.EQ.'TEPP')GOTO1730 IF(ICASPL.EQ.'TXPP')GOTO1730 IF(ICASPL.EQ.'GLPP')GOTO1740 IF(ICASPL.EQ.'PEPP')GOTO1750 IF(ICASPL.EQ.'DGPP')GOTO1760 IF(ICASPL.EQ.'KAPP')GOTO1770 IF(ICASPL.EQ.'FCPP')GOTO1780 IF(ICASPL.EQ.'BBPP')GOTO1790 IF(ICASPL.EQ.'BRPP')GOTO1800 IF(ICASPL.EQ.'GXPP')GOTO1810 IF(ICASPL.EQ.'REPP')GOTO1820 IF(ICASPL.EQ.'NMPP')GOTO1830 IF(ICASPL.EQ.'GIPP')GOTO1840 IF(ICASPL.EQ.'IWPP')GOTO1850 IF(ICASPL.EQ.'LXPP')GOTO1860 IF(ICASPL.EQ.'LDPP')GOTO1870 IF(ICASPL.EQ.'JBPP')GOTO1880 IF(ICASPL.EQ.'JUPP')GOTO1890 IF(ICASPL.EQ.'EEPP')GOTO1900 IF(ICASPL.EQ.'TSPP')GOTO1910 IF(ICASPL.EQ.'BWPP')GOTO1920 IF(ICASPL.EQ.'LUPP')GOTO1930 IF(ICASPL.EQ.'ERPP')GOTO1940 IF(ICASPL.EQ.'TZPP')GOTO1950 IF(ICASPL.EQ.'GTPP')GOTO1960 IF(ICASPL.EQ.'FTPP')GOTO1970 IF(ICASPL.EQ.'SLPP')GOTO1980 IF(ICASPL.EQ.'SNPP')GOTO1990 IF(ICASPL.EQ.'STPP')GOTO2000 IF(ICASPL.EQ.'IBPP')GOTO2010 IF(ICASPL.EQ.'GMPP')GOTO2020 IF(ICASPL.EQ.'GIGP')GOTO2030 IF(ICASPL.EQ.'GFPP')GOTO2040 IF(ICASPL.EQ.'GHPP')GOTO2050 IF(ICASPL.EQ.'LZPP')GOTO2060 IF(ICASPL.EQ.'LTPP')GOTO2070 IF(ICASPL.EQ.'ASPP')GOTO2080 IF(ICASPL.EQ.'SDPP')GOTO2090 IF(ICASPL.EQ.'ADPP')GOTO2100 IF(ICASPL.EQ.'MXPP')GOTO2110 IF(ICASPL.EQ.'RAPP')GOTO2120 IF(ICASPL.EQ.'GALP')GOTO2130 IF(ICASPL.EQ.'MCPP')GOTO2140 IF(ICASPL.EQ.'BEIP')GOTO2150 IF(ICASPL.EQ.'BEKP')GOTO2160 IF(ICASPL.EQ.'GMCP')GOTO2170 IF(ICASPL.EQ.'G5PP')GOTO2180 IF(ICASPL.EQ.'WKPP')GOTO2190 IF(ICASPL.EQ.'BNPP')GOTO2200 IF(ICASPL.EQ.'G2PP')GOTO2210 IF(ICASPL.EQ.'G3PP')GOTO2220 IF(ICASPL.EQ.'G4PP')GOTO2230 IF(ICASPL.EQ.'AXPP')GOTO2240 IF(ICASPL.EQ.'LBPP')GOTO2250 C WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1011) 1011 FORMAT('***** ERROR DP1KS2--UNKNOWN DISTRIBUTION') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 1110 CONTINUE IDIST='UNIFORM' ZSCALE=KSSCAL-KSLOC XL=(XL-KSLOC)/ZSCALE CALL UNICDF(XL,XOUT1) GOTO2990 C 1120 CONTINUE IDIST='NORMAL' XL=(XL-KSLOC)/KSSCAL CALL NORCDF(XL,XOUT1) GOTO2990 C 1130 CONTINUE IDIST='LOGISTIC' XL=(XL-KSLOC)/KSSCAL CALL LOGCDF(XL,XOUT1) GOTO2990 C 1140 CONTINUE IDIST='DOUBLE EXPONENTIAL' XL=(XL-KSLOC)/KSSCAL CALL DEXCDF(XL,XOUT1) GOTO2990 C 1150 CONTINUE IDIST='CAUCHY' XL=(XL-KSLOC)/KSSCAL CALL CAUCDF(XL,XOUT1) GOTO2990 C 1160 CONTINUE IDIST='TUKEY-LAMBDA' XL=(XL-KSLOC)/KSSCAL CALL LAMCDF(XL,ALAMBA,XOUT1) GOTO2990 C 1170 CONTINUE IDIST='LOG-NORMAL' XL=(XL-KSLOC)/KSSCAL CALL LGNCDF(XL,SIGMA,XOUT1) GOTO2990 C 1180 CONTINUE IDIST='HALF-NORMAL' XL=(XL-KSLOC)/KSSCAL CALL HFNCDF(XL,XOUT1) GOTO2990 C 1190 CONTINUE IDIST='T' XL=(XL-KSLOC)/KSSCAL CCCCC CALL TCDF(XL,NU,XOUT1) CALL TCDF(XL,ANU,XOUT1) GOTO2990 C 1200 CONTINUE IDIST='CHI-SQUARE' XL=(XL-KSLOC)/KSSCAL CALL CHSCDF(XL,NU,XOUT1) GOTO2990 C 1210 CONTINUE IDIST='F' XL=(XL-KSLOC)/KSSCAL CALL FCDF(XL,NU1,NU2,XOUT1) GOTO2990 C 1220 CONTINUE IDIST='EXPONENTIAL' XL=(XL-KSLOC)/KSSCAL CALL EXPCDF(XL,XOUT1) GOTO2990 C 1230 CONTINUE IDIST='GAMMA' XL=(XL-KSLOC)/KSSCAL CALL GAMCDF(XL,GAMMA,XOUT1) GOTO2990 C 1240 CONTINUE IDIST='BETA' ZSCALE=KSSCAL-KSLOC XL=(XL-KSLOC)/ZSCALE CALL BETCDF(XL,ALPHA,BETA,XOUT1) GOTO2990 C 1250 CONTINUE IDIST='WEIBULL' XL=(XL-KSLOC)/KSSCAL CALL WEICDF(XL,GAMMA,MINMAX,XOUT1) GOTO2990 C 1260 CONTINUE IDIST='EXTREME VALUE TYPE 1' XL=(XL-KSLOC)/KSSCAL CALL EV1CDF(XL,MINMAX,XOUT1) GOTO2990 C 1270 CONTINUE IDIST='EXTREME VALUE TYPE 2' XL=(XL-KSLOC)/KSSCAL CALL EV2CDF(XL,GAMMA,MINMAX,XOUT1) GOTO2990 C 1280 CONTINUE IDIST='PARETO' ZLOC=A IF(ZLOC.GT.XMIN)ZLOC=XMIN XL=(XL-KSLOC)/KSSCAL CALL PARCDF(XL,GAMMA,ZLOC,XOUT1) GOTO2990 C 1290 CONTINUE IDIST='BINOMIAL' CALL BINCDF(XL,P,NPAR,XOUT1) GOTO2990 C 1300 CONTINUE IDIST='GEOMETRIC' CALL GEOCDF(XL,P,XOUT1) GOTO2990 C 1310 CONTINUE IDIST='POISSON' IF(ALAMBA.LE.60.0)THEN CALL POICDF(XL,ALAMBA,XOUT1) ELSE SQRTAL=SQRT(ALAMBA) CALL NORCDF(XL,XOUT1) XOUT1=ALAMBA+SQRTAL*XOUT1 ENDIF GOTO2990 C 1320 CONTINUE IDIST='NEGATIVE BINOMIAL' CALL NBCDF(XL,P,AK,XOUT1) GOTO2990 C 1330 CONTINUE IDIST='SEMI-CIRCULAR' XL=XL-KSLOC CALL SEMCDF(XL,KSSCAL,XOUT1) GOTO2990 C 1340 CONTINUE IDIST='TRIANGULAR' IF(KSLOC.EQ.0.0 .AND. KSSCAL.EQ.1.0)THEN ZLOWLM=-1.0 ZUPPLM=1.0 ELSE ZLOWLM=KSLOC ZUPPLM=KSSCAL ENDIF CALL TRICDF(XL,C,ZLOWLM,ZUPPLM,XOUT1) GOTO2990 C 1350 CONTINUE IDIST='INVERSE GAUSSIAN' XL=(XL-KSLOC)/KSSCAL CALL IGCDF(XL,GAMMA,AMU,XOUT1) GOTO2990 C 1360 CONTINUE IDIST='WALD' XL=(XL-KSLOC)/KSSCAL CALL WALCDF(XL,GAMMA,XOUT1) GOTO2990 C 1370 CONTINUE IDIST='RECIPROCAL INVERSE GAUSSIAN' XL=(XL-KSLOC)/KSSCAL CALL RIGCDF(XL,GAMMA,AMU,XOUT1) GOTO2990 C 1380 CONTINUE IDIST='FATIGUE LIFE' XL=(XL-KSLOC)/KSSCAL CALL FLCDF(XL,GAMMA,XOUT1) GOTO2990 C 1390 CONTINUE IDIST='GENERALIZED PARETO' XL=(XL-KSLOC)/KSSCAL CALL GEPCDF(XL,GAMMA,MINMAX,IGEPDF,XOUT1) GOTO2990 C 1400 CONTINUE IDIST='DISCRETE UNIFORM' CALL DISCDF(XL,NDUN,XOUT1) GOTO2990 C 1410 CONTINUE IDIST='NON-CENTRAL T' XL=(XL-KSLOC)/KSSCAL CALL NCTCDF(XL,ANU,ALAMBA,XOUT1) GOTO2990 C 1420 CONTINUE IDIST='NON-CENTRAL F' XL=(XL-KSLOC)/KSSCAL CALL NCFCDF(XL,ANU1,ANU2,ALAMBA,XOUT1) GOTO2990 C 1430 CONTINUE IDIST='NON-CENTRAL CHI-SQUARE' XL=(XL-KSLOC)/KSSCAL CALL NCCCDF(XL,ANU,ALAMBA,XOUT1) GOTO2990 C 1440 CONTINUE IDIST='NON-CENTRAL BETA' XL=(XL-KSLOC)/KSSCAL CALL NCBCDF(XL,ALPHA,BETA,ALAMBA,XOUT1) GOTO2990 C 1450 CONTINUE IDIST='DOUBLY NON-CENTRAL T' XL=(XL-KSLOC)/KSSCAL CALL DNTCDF(XL,ANU,ALAMB1,ALAMB2,XOUT1) GOTO2990 C 1460 CONTINUE IDIST='DOUBLY NON-CENTRAL F' XL=(XL-KSLOC)/KSSCAL CALL DNFCDF(XL,ANU1,ANU2,ALAMB1,ALAMB2,XOUT1) GOTO2990 C 1470 CONTINUE IDIST='HYPERGEOMETRIC' POINT=.FALSE. CALL HYPCDF(XL,K,NPAR,MPAR,POINT,XOUT1) GOTO2990 C 1480 CONTINUE IDIST='VON MISES' XL=(XL-KSLOC)/KSSCAL CALL VONCDF(XL,B,XOUT1) GOTO2990 C 1490 CONTINUE IDIST='POWER NORMAL' XL=(XL-KSLOC)/KSSCAL CCCCC CALL PNRCDF(XL,P,SD,XOUT1) CALL PNRCDF(XL,P,XOUT1) GOTO2990 C 1500 CONTINUE IDIST='POWER LOG-NORMAL' XL=(XL-KSLOC)/KSSCAL CALL PLNCDF(XL,P,SD,XOUT1) GOTO2990 C 1510 CONTINUE IDIST='ALPHA' XL=(XL-KSLOC)/KSSCAL CALL ALPCDF(XL,ALPHA,BETA,XOUT1) GOTO2990 C 1520 CONTINUE IDIST='COSINE' XL=(XL-KSLOC)/KSSCAL CALL COSCDF(XL,XOUT1) GOTO2990 C 1530 CONTINUE IDIST='POWER' XL=(XL-KSLOC)/KSSCAL CALL POWCDF(XL,C,XOUT1) GOTO2990 C 1540 CONTINUE IDIST='CHI' XL=(XL-KSLOC)/KSSCAL CALL CHCDF(XL,ANU,XOUT1) GOTO2990 C 1550 CONTINUE IDIST='LOGARITHMIC SERIES' CALL DLGCDF(XL,THETA,XOUT1) GOTO2990 C 1560 CONTINUE IDIST='LOG LOGISTIC' XL=(XL-KSLOC)/KSSCAL CALL LLGCDF(XL,DELTA,XOUT1) GOTO2990 C 1570 CONTINUE IDIST='GENERALIZED GAMMA' XL=(XL-KSLOC)/KSSCAL CALL GGDCDF(XL,ALPHA,C,XOUT1) GOTO2990 C 1580 CONTINUE IDIST='WARING' CALL WARCDF(XL,C,A,XOUT1,'NOTR') GOTO2990 C 1590 CONTINUE IDIST='ANGLIT' XL=(XL-KSLOC)/KSSCAL CALL ANGCDF(XL,XOUT1) GOTO2990 C 1600 CONTINUE IDIST='ARCSINE' XL=(XL-KSLOC)/KSSCAL CALL ARSCDF(XL,XOUT1) GOTO2990 C 1610 CONTINUE IDIST='FOLDED NORMAL' XL=(XL-KSLOC)/KSSCAL CALL FNRCDF(XL,AM,SD,XOUT1) GOTO2990 C 1620 CONTINUE IDIST='TRUNCATED NORMAL' XL=(XL-KSLOC)/KSSCAL CALL TNRCDF(XL,A,B,AM,SD,XOUT1) GOTO2990 C 1630 CONTINUE IDIST='LOG GAMMA' XL=(XL-KSLOC)/KSSCAL CALL LGACDF(XL,GAMMA,ILGADF,XOUT1) GOTO2990 C 1640 CONTINUE IDIST='HYPERBOLIC SECANT' XL=(XL-KSLOC)/KSSCAL CALL HSECDF(XL,XOUT1) GOTO2990 C 1650 CONTINUE IDIST='GOMPERTZ' XL=(XL-KSLOC)/KSSCAL CALL GOMCDF(XL,C,B,XOUT1) GOTO2990 C 1660 CONTINUE IDIST='HALF CAUCHY' XL=(XL-KSLOC)/KSSCAL CALL HFCCDF(XL,XOUT1) GOTO2990 C 1670 CONTINUE IDIST='HALF LOGISTIC' XL=(XL-KSLOC)/KSSCAL CALL HFLCDF(XL,GAMMA,XOUT1) GOTO2990 C 1680 CONTINUE IDIST='GENERALIZED EXTREME VALUE' XL=(XL-KSLOC)/KSSCAL CALL GEVCDF(XL,GAMMA,MINMAX,XOUT1) GOTO2990 C 1690 CONTINUE IDIST='PARETO OF THE SECOND KIND' ZLOC=A IF(ZLOC.LE.XMIN)ZLOC=A XL=(XL-KSLOC)/KSSCAL c write(18,*)'a,gamma,xmin,zloc=',a,gamma,xmin,zloc c write(18,*)'xl,ksloc,kssca=',xl,ksloc,ksscal CALL PA2CDF(XL,GAMMA,ZLOC,XOUT1) GOTO2990 C 1700 CONTINUE IDIST='DOUBLE WEIBULL' XL=(XL-KSLOC)/KSSCAL CALL DWECDF(XL,GAMMA,XOUT1) GOTO2990 C 1710 CONTINUE IDIST='WRAPPED CAUCHY' ZLOC=1.0 IF(KSLOC.NE.0.0)ZLOC=KSLOC XL=(XL-ZLOC)/KSSCAL CALL WCACDF(XL,P,XOUT1) GOTO2990 C 1720 CONTINUE IDIST='EXPONENTIATED WEIBULL' XL=(XL-KSLOC)/KSSCAL IARG1=1 CALL EWECDF(XL,GAMMA,THETA,IARG1,XOUT1) CALL EWECDF(XU,GAMMA,THETA,IARG1,XOUT2) GOTO2990 C 1730 CONTINUE IDIST='TRUNCATED EXPONENTIAL' XL=(XL-KSLOC)/KSSCAL CALL TNECDF(XL,X0,AM,SD,XOUT1) GOTO2990 C 1740 CONTINUE IDIST='GENERALIZED LOGISTIC' XL=(XL-KSLOC)/KSSCAL CALL GLOCDF(XL,ALPHA,XOUT1) GOTO2990 C 1750 CONTINUE IDIST='POWER EXPONENTIAL' XL=(XL-KSLOC)/KSSCAL CALL PEXCDF(XL,ALPHA,BETA,XOUT1) GOTO2990 C 1760 CONTINUE IDIST='DOUBLE GAMMA' XL=(XL-KSLOC)/KSSCAL CALL DGACDF(XL,GAMMA,XOUT1) GOTO2990 C 1770 CONTINUE IDIST='MEILKE BETA-KAPPA' XL=(XL-KSLOC)/KSSCAL CALL KAPCDF(XL,ANU,BETA,THETA,XOUT1) GOTO2990 C 1780 CONTINUE IDIST='FOLDED CAUCHY' XL=(XL-KSLOC)/KSSCAL CALL FCACDF(XL,AM,SD,XOUT1) GOTO2990 C 1790 CONTINUE IDIST='BETA BINOMIAL' CALL BBNCDF(XL,ALPHA,BETA,NU,XOUT1) GOTO2990 C 1800 CONTINUE IDIST='BRADFORD' XL=(XL-KSLOC)/KSSCAL CALL BRACDF(XL,BETA,XOUT1) GOTO2990 C 1810 CONTINUE IDIST='GENERALIZED EXPONENTIAL' XL=(XL-KSLOC)/KSSCAL CALL GEXCDF(XL,ALAMB1,ALAMB2,GAMMA,XOUT1) GOTO2990 C 1820 CONTINUE IDIST='RECIPROCAL' XL=(XL-KSLOC)/KSSCAL CALL RECCDF(XL,B,XOUT1) GOTO2990 C 1830 CONTINUE IDIST='MIXTURE OF 2 NORMALS' XL=(XL-KSLOC)/KSSCAL CALL NMXCDF(XL,U1,SD1,U2,SD2,P,XOUT1) GOTO2990 C 1840 CONTINUE IDIST='INVERTED GAMMA' XL=(XL-KSLOC)/KSSCAL CALL IGACDF(XL,GAMMA,XOUT1) GOTO2990 C 1850 CONTINUE IDIST='INVERTED WEIBULL' XL=(XL-KSLOC)/KSSCAL CALL IWECDF(XL,GAMMA,XOUT1) GOTO2990 C 1860 CONTINUE IDIST='LOG DOUBLE EXPONENTIAL' XL=(XL-KSLOC)/KSSCAL CALL LDECDF(XL,ALPHA,XOUT1) GOTO2990 C 1870 CONTINUE IDIST='GENERALIZED TUKEY-LAMBDA' XL=(XL-KSLOC)/KSSCAL CALL GLDCDF(DBLE(XL),DBLE(ALAMB3),DBLE(ALAMB4), 1 DOUT1,IGLDDF,IWRITE) XOUT1=REAL(DOUT1) GOTO2990 C 1880 CONTINUE IDIST='JOHNSON SB' XL=(XL-KSLOC)/KSSCAL CALL JSBCDF(XL,ALPHA1,ALPHA2,XOUT1) GOTO2990 C 1890 CONTINUE IDIST='JOHNSON SU' XL=(XL-KSLOC)/KSSCAL CALL JSUCDF(XL,ALPHA1,ALPHA2,XOUT1) GOTO2990 C 1900 CONTINUE IDIST='GEOMETRIC EXTREME EXPONENTIAL' XL=(XL-KSLOC)/KSSCAL CALL GEECDF(XL,GAMMA,XOUT1) GOTO2990 C 1910 CONTINUE IDIST='TWO-SIDED POWER' XL=(XL-KSLOC)/KSSCAL CALL TSPCDF(XL,THETA,ANU,XOUT1) GOTO2990 C 1920 CONTINUE IDIST='BIWEIBULL' XL=(XL-KSLOC)/KSSCAL CALL BWECDF(XL,ASCAL1,GAMMA1,ALOC2,ASCAL2,GAMMA2,XOUT1,DTEMP1) GOTO2990 C 1930 CONTINUE IDIST='LANDAU' XL=(XL-KSLOC)/KSSCAL DTEMP1=LANCDF(DBLE(XL)) XOUT1=REAL(DTEMP1) GOTO2990 C 1940 CONTINUE IDIST='ERROR (= EXPONENTIAL POWER)' XL=(XL-KSLOC)/KSSCAL CALL ERRCDF(XL,ALPHA,XOUT1) GOTO2990 C 1950 CONTINUE IDIST='TRAPEZOID' XL=(XL-KSLOC)/KSSCAL CALL TRACDF(XL,A,B,C,DZ,XOUT1) GOTO2990 C 1960 CONTINUE IDIST='GENERALIZED TRAPEZOID' XL=(XL-KSLOC)/KSSCAL CALL GTRCDF(XL,A,B,C,DZ,ANU1,ANU3,ALPHA,XOUT1) GOTO2990 C 1970 CONTINUE IDIST='FOLDED T' XL=(XL-KSLOC)/KSSCAL CALL FTCDF(XL,NU,XOUT1) GOTO2990 C 1980 CONTINUE IDIST='SLASH' XL=(XL-KSLOC)/KSSCAL CALL SLACDF(XL,XOUT1) GOTO2990 C 1990 CONTINUE IDIST='SKEWED NORMAL' XL=(XL-KSLOC)/KSSCAL CALL SNCDF(XL,ALAMBA,ISKNDF,XOUT1) GOTO2990 C 2000 CONTINUE IDIST='SKEWED T' XL=(XL-KSLOC)/KSSCAL CALL STCDF(XL,NU,ALAMBA,XOUT1) GOTO2990 C 2010 CONTINUE IDIST='INVERTED BETA' XL=(XL-KSLOC)/KSSCAL CALL IBCDF(XL,ALPHA,BETA,XOUT1) GOTO2990 C 2020 CONTINUE IDIST='GOMPERTZ-MAKEHAM' XL=(XL-KSLOC)/KSSCAL IF(IMAKDF.EQ.'DLMF')THEN CALL MAKCDF(XL,XI,ALAMB,THETA,XOUT1) ELSEIF(IMAKDF.EQ.'MEEK')THEN XI=GAMMA/AK THETA=ALAMB/GAMMA ALAMB=AK CALL MAKCDF(XL,XI,ALAMB,THETA,XOUT1) ELSEIF(IMAKDF.EQ.'REPA')THEN CALL MA2CDF(XL,ZETA,ETA,XOUT1) ENDIF GOTO2990 C 2030 CONTINUE IDIST='GENERALIZED INVERSE GAUSIAN' XL=(XL-KSLOC)/KSSCAL CALL GIGCDF(DBLE(XL),DBLE(CHI),DBLE(ALAMBA),DBLE(THETA),DOUT1) XOUT1=DOUT1 GOTO2990 C 2040 CONTINUE IDIST='GENERALIZED F' XL=(XL-KSLOC)/KSSCAL CCCCC CALL GFCDF(XL,ALPHA,BETA,XOUT1) GOTO2990 C 2050 CONTINUE IDIST='G-H' XL=(XL-KSLOC)/KSSCAL CALL GHCDF(XL,G,H,XOUT1) GOTO2990 C 2060 CONTINUE IDIST='LOG SKEWED NORMAL' XL=(XL-KSLOC)/KSSCAL CALL LSNCDF(XL,ALAMBA,SD,XOUT1) GOTO2990 C 2070 CONTINUE IDIST='LOG SKEWED T' XL=(XL-KSLOC)/KSSCAL CALL LSTCDF(XL,NU,ALAMBA,SD,XOUT1) GOTO2990 C 2080 CONTINUE IDIST='ARCSIN' XL=(XL-KSLOC)/KSSCAL CALL ARSCDF(XL,XOUT1) GOTO2990 C 2090 CONTINUE IDIST='SKEWED DOUBLE EXPONENTIAL' XL=(XL-KSLOC)/KSSCAL CALL SDECDF(XL,ALAMBA,XOUT1) GOTO2990 C 2100 CONTINUE IDIST='ASYMMETRIC DOUBLE EXPONENTIAL' XL=(XL-KSLOC)/KSSCAL IF(IADEDF.EQ.'K')THEN CALL ADECDF(XL,AK,IADEDF,XOUT1) ELSE CALL ADECDF(XL,AMU,IADEDF,XOUT1) ENDIF GOTO2990 C 2110 CONTINUE IDIST='MAXWELL' XL=(XL-KSLOC)/KSSCAL CALL MAXCDF(XL,SIGMA,XOUT1) GOTO2990 C 2120 CONTINUE IDIST='RAYLEIGH' XL=(XL-KSLOC)/KSSCAL CALL RAYCDF(XL,XOUT1) GOTO2990 C 2130 CONTINUE IDIST='GENERALIZED ASYMMETRIC LAPLACE' XL=(XL-KSLOC)/KSSCAL CALL GALCDF(DBLE(XL),DBLE(AK),DBLE(TAU),IADEDF,DOUT1) XOUT1=DOUT1 GOTO2990 C 2140 CONTINUE IDIST='MCLEISH' XL=(XL-KSLOC)/KSSCAL CALL MCLCDF(DBLE(XL),DBLE(ALPHA),DOUT1) XOUT1=DOUT1 GOTO2990 C 2150 CONTINUE IDIST='BESSEL I-FUNCTION' XL=(XL-KSLOC)/KSSCAL IF(IBEIDF.EQ.'1')THEN CALL BEICDF(DBLE(XL),DBLE(SD1),DBLE(SD2),DBLE(ANU),IBEIDF, 1 DOUT1) ELSE CALL BEICDF(DBLE(XL),DBLE(B),DBLE(C),DBLE(AM),IBEIDF, 1 DOUT1) ENDIF XOUT1=DOUT1 GOTO2990 C 2160 CONTINUE IDIST='BESSEL K-FUNCTION' XL=(XL-KSLOC)/KSSCAL CCCCC CALL BEKCDF(DBLE(XL),DBLE(SD1),DBLE(SD2),DBLE(ANU),DOUT1) XOUT1=DOUT1 GOTO2990 C 2170 CONTINUE IDIST='GENERALIZED MCLEISH' XL=(XL-KSLOC)/KSSCAL CALL GMCCDF(DBLE(XL),DBLE(ALPHA),DBLE(A),DOUT1) XOUT1=DOUT1 GOTO2990 C 2180 CONTINUE IDIST='GENERALIZED LOGISTIC TYPE 5 (HOSKING)' CCCCC XL=(XL-KSLOC)/KSSCAL XPAR(1)=DBLE(KSLOC) XPAR(2)=DBLE(KSSCAL) XPAR(3)=DBLE(ALPHA) DOUT1=CDFGLO(DBLE(XL),XPAR) XOUT1=DOUT1 GOTO2990 C 2190 CONTINUE IDIST='WAKEBY' CCCCC XL=(XL-KSLOC)/KSSCAL XPAR(1)=DBLE(KSLOC) XPAR(2)=DBLE(KSSCAL) XPAR(3)=DBLE(BETA) XPAR(4)=DBLE(GAMMA) XPAR(5)=DBLE(DELTA) DOUT1=CDFWAK(DBLE(XL),XPAR) XOUT1=DOUT1 GOTO2990 C 2200 CONTINUE IDIST='BETA-NORMAL' XL=(XL-KSLOC)/KSSCAL CALL BNOCDF(DBLE(XL),DBLE(ALPHA),DBLE(BETA),DOUT1) XOUT1=DOUT1 GOTO2990 C 2210 CONTINUE IDIST='GENERALIZED LOGISTIC TYPE 2' XL=(XL-KSLOC)/KSSCAL CALL GL2CDF(DBLE(XL),DBLE(ALPHA),DOUT1) XOUT1=DOUT1 GOTO2990 C 2220 CONTINUE IDIST='GENERALIZED LOGISTIC TYPE 3' XL=(XL-KSLOC)/KSSCAL CALL GL3CDF(DBLE(XL),DBLE(ALPHA),DOUT1) XOUT1=DOUT1 GOTO2990 C 2230 CONTINUE IDIST='GENERALIZED LOGISTIC TYPE 4' XL=(XL-KSLOC)/KSSCAL CALL GL4CDF(DBLE(XL),DBLE(P),DBLE(Q),DOUT1) XOUT1=DOUT1 GOTO2990 C 2240 CONTINUE IDIST='ASYMMETRIC LOG DOUBLE EXPONENTIAL' XL=(XL-KSLOC)/KSSCAL CALL ALDCDF(DBLE(XL),DBLE(ALPHA),DBLE(BETA),DOUT1) XOUT1=REAL(DOUT1) GOTO2990 C 2250 CONTINUE IDIST='LOG BETA' XL=(XL-KSLOC)/KSSCAL CALL LBECDF(XL,ALPHA,BETA,YLOWLM,YUPPLM,XOUT1) GOTO2990 C 2990 CONTINUE C DTEMP1=DBLE(Y2(I)) DTEMP2=DBLE(XOUT1) DM=MAX(DABS(DTEMP1-DTEMP2),DM) C 1199 CONTINUE C STAT=REAL(DM) AN=REAL(N) C C COMPUTE CRITICAL VALUES FOR 0.90, 0.95, AND 0.99. C USE FUNCTION FOR N <=100, USE APPROXIMATION FOR N > 100. C C NOTE: 12/2003. REPLACE FOLLOWING WITH VALUES IN CONOVER C TABLE ("PRACTICAL NONPARAMETRIC STATISTICS", THIRD C EDITION, W. J. CONOVER, WILEY, 1999, TABLE A13 P. 547). C CCCCC IF(N.LE.5)THEN CCCCC CDF1=0.51 CCCCC CDF2=0.56 CCCCC CDF3=0.67 CCCCC ELSEIF(N.LE.10)THEN CCCCC CDF1=0.37 CCCCC CDF2=0.41 CCCCC CDF3=0.49 CCCCC ELSEIF(N.LE.15)THEN CCCCC CDF1=0.30 CCCCC CDF2=0.34 CCCCC CDF3=0.40 CCCCC ELSEIF(N.LE.20)THEN CCCCC CDF1=0.26 CCCCC CDF2=0.29 CCCCC CDF3=0.36 CCCCC ELSEIF(N.LE.25)THEN CCCCC CDF1=0.24 CCCCC CDF2=0.27 CCCCC CDF3=0.32 CCCCC ELSEIF(N.LE.30)THEN CCCCC CDF1=0.22 CCCCC CDF2=0.24 CCCCC CDF3=0.29 CCCCC ELSEIF(N.LE.35)THEN CCCCC CDF1=0.20 CCCCC CDF2=0.23 CCCCC CDF3=0.27 CCCCC ELSEIF(N.LE.40)THEN CCCCC CDF1=0.19 CCCCC CDF2=0.21 CCCCC CDF3=0.25 CCCCC ELSEIF(N.LE.45)THEN CCCCC CDF1=0.18 CCCCC CDF2=0.20 CCCCC CDF3=0.24 CCCCC ELSEIF(N.LE.50)THEN CCCCC CDF1=0.17 CCCCC CDF2=0.19 CCCCC CDF3=0.23 IF(N.LE.40)THEN CDF1=CV90(N) CDF2=CV95(N) CDF3=CV99(N) ELSE CDF1=1.22/SQRT(REAL(N)) CDF2=1.36/SQRT(REAL(N)) CDF3=1.63/SQRT(REAL(N)) AFACT=SQRT(AN + SQRT(AN/10.)) CDF1B=1.22/AFACT CDF2B=1.36/AFACT CDF3B=1.63/AFACT ENDIF CCCCC I'M NOT ABOUT THIS PKS2 ROUTINE FOR RETRIEVING THE EXACT K-S CCCCC CDF FOR A GIVEN VALUE OF D CCCCC IF(N.LE.100)THEN CCCCC CDFA=PKS2(N,STAT) CCCCC print *,'cdfa=',cdfa CCCCC CDFA=PKS2(N,SQRT(REAL(N))*STAT) CCCCC print *,'cdfb=',cdfb CCCCC CDFC=PKS(N,STAT) CCCCC print *,'cdfc=',cdfc CCCCC CDFD=PKS(N,SQRT(REAL(N))*STAT) CCCCC print *,'cdfa,cdfb,cdfc,cdfd=',cdfa,cdfb,cdfc,cdfd CCCCC ENDIF C ICONC1='REJECT' ICONC2='REJECT' ICONC3='REJECT' C IF(N.LE.40)THEN IF(STAT.LE.CDF1)ICONC1='ACCEPT' IF(STAT.LE.CDF2)ICONC2='ACCEPT' IF(STAT.LE.CDF3)ICONC3='ACCEPT' ELSE IF(STAT.LE.CDF1B)ICONC1='ACCEPT' IF(STAT.LE.CDF2B)ICONC2='ACCEPT' IF(STAT.LE.CDF3B)ICONC3='ACCEPT' ENDIF C STATVA=STAT STATCD=CDF2B C IF(IWRIT2.EQ.'OFF')GOTO9000 C C ************************************** C ** STEP 32-- ** C ** WRITE OUT EVERYTHING ** C ** FOR A KOLMOGOROV-SMIRNOV TEST ** C ************************************** C ISTEPN='32' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IPRINT.EQ.'ON')THEN IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN WRITE(ICOUT,5101) 5101 FORMAT('') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5107) 5107 FORMAT('') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5995) 5995 FORMAT('
') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5307) 5307 FORMAT('