1      SUBROUTINE DPML1(Y,CENSOR,N,ICASPL,IFLAGD,IFLAG9,
2     1                 TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,YTEMP,
3     1                 DTEMP1,DTEMP2,DTEMP3,ITEMP1,MAXNXT,
4     1                 ALOC,ASCALE,ALOWLI,AUPPLI,
5     1                 SH1,SH2,SH3,SH4,
6     1                 SH5,SH6,SH7,
7     1                 YLOWLM,YUPPLM,A,B,MINMAX,ISEED,
8     1                 IADEDF,IGEPDF,IMAKDF,IBEIDF,
9     1                 ILGADF,ISKNDF,IGLDDF,IGOMDF,IGIGDF,
10     1                 IGEODF,IBGEDF,IGAUDF,
11     1                 ICENSO,IEXPBC,IWEIBC,ICENTY,IDFTTY,
12     1                 CLLIMI,CLWIDT,IHSTCW,IHSTOU,IRELAT,IRHSTG,
13     1                 IBUGA3,ISUBRO,IERROR)
14C
15C     PURPOSE--COMPUTE THE MAXIMUM LIKELIHOOD ESTIMATE FOR THE
16C              GIVEN SET OF POINTS.  THIS WILL BE USED BY THE
17C              "GOODNESS OF FIT", "BOOTSTRAP", AND POSSIBLY OTHER
18C              COMMANDS.  PUTTING THIS IN A DISTINCT SUBROUTINE
19C              IS TO REDUCE DUPLICATION OF CODE.  ALSO, WE ARE
20C              PRIMARILY INTERESTED IN THE POINT ESTIMATES OF THE
21C              PARAMETERS.
22C
23C              THIS ROUTINE HANDLES THE UNGROUPED DATA FOR EITHER
24C              THE UNCENSORED OR THE CENSORED CASE (CENSORING IS
25C              ONLY SUPPORTED FOR A SUBSET OF THE DISTRIBUTIONS).
26C              IF IFLAGD = 1, THEN DISCRETE DISTRIBUTIONS WILL
27C              BE SKIPPED.
28C
29C              IF THE MAXIMUM LIKELIHOOD ESTIMATES ARE NOT CURRENTLY
30C              AVAILABLE FOR THE SPECIFIED DISTRIBUTION, THEN IFLAG9
31C              WILL BE SET TO -99.
32C
33CCCCC          THE FOLLOWING ARE CURRENTLY SUPPORTED.
34C
35C              LOCATION/SCALE DISTRIBUTIONS:
36C                 1) NORMAL
37C                    NORMAL CENSORED
38C                 2) UNIFORM
39C                 3) LOGISTIC
40C                 4) DOUBLE EXPONENTIAL
41C                 5) CAUCHY
42C                 6) EXTREME VALUE TYPE 1 (GUMBEL)
43C                 7) SLASH
44C                 8) EXPONENTIAL (EITHER 1-PARAMETER OR 2-PARAMETER)
45C                    EXPONENTIAL CENSORED (EITHER 1-PARAMETER OR
46C                    2-PARAMETER)
47C                 9) FOLDED NORMAL
48C                10) RAYLEIGH
49C                11) MAXWELL
50C                12) HALF-NORMAL
51C                13) HALF-LOGISTIC
52C
53C              ONE SHAPE PARAMETER DISTRIBUTIONS:
54C                 1) 2-PARAMETER LOGNORMAL
55C                    2-PARAMETER LOGNORMAL CENSORED
56C                 2) 3-PARAMETER LOGNORMAL
57C                 3) 2-PARAMETER WEIBULL
58C                    2-PARAMETER WEIBULL CENSORED
59C                 4) 3-PARAMETER WEIBULL
60C                 5) GENERALIZED EXTREME VALUE
61C                 6) 2-PARAMETER FRECHET
62C                 7) 3-PARAMETER FRECHET
63C                 8) GENERALIZED PARETO
64C                 9) 2-PARAMETER INVERTED WEIBULL (= FRECHET MAXIMUM)
65C                    2-PARAMETER INVERTED WEIBULL CENSORED
66C                10) 3-PARAMETER INVERTED WEIBULL (= FRECHET MAXIMUM)
67C                11) 2-PARAMETER GAMMA
68C                    2-PARAMETER GAMMA CENSORED
69C                12) 3-PARAMETER GAMMA
70C                13) 2-PARAMETER INVERTED GAMMA
71C                    2-PARAMETER INVERTED GAMMA CENSORED
72C                14) 3-PARAMETER GAMMA
73C                15) 2-PARAMETER GEOMETRIC EXTREME EXPONENTIAL
74C                16) 2-PARAMETER FATIGUE LIFE
75C                17) 2-PARAMETER BURR TYPE 10
76C                18) 2-PARAMETER LOGISTIC EXPONENTIAL
77C                19) 2-PARAMETER VON MISES (LOCATION/SHAPE)
78C                20) 3-PARAMETER PEARSON TYPE 3 (L-MOMENTS ONLY)
79C                21) 3-PARAMETER GENERALIZED LOGISTIC TYPE 5
80C                    (L-MOMENTS ONLY)
81C                22) TRIANGULAR
82C                23) TOPP AND LEONE
83C                24) POWER AND REFLECTED POWER
84C                25) 2-PARAMETER ALPHA
85C                26) 2-PARAMETER EXPONENTIAL POWER
86C                    (NEEDS ALGORITHMIC WORK)
87C                27) 3-PARAMETER ASYMMETRIC LAPLACE
88C                28) PARETO
89C                29) TRUNCATED PARETO
90C                30) 2-PARAMETER BRITTLE FIBER WEIBULL
91C
92C              TWO SHAPE PARAMETER DISTRIBUTIONS:
93C                 1) 2-PARAMETER BETA
94C                 2) 4-PARAMETER BETA
95C                 3) KAPPA (L-MOMENTS)
96C                 4) BETA-NORMAL
97C                 5) TWO-SIDED POWER
98C                 6) REFLECTED GENERALIZED TOPP AND LEONE
99C                 7) 2-PARAMETER INVERSE GAUSSIAN
100C                 8) 3-PARAMETER INVERSE GAUSSIAN
101C                 9) FOLDED NORMAL
102C
103C                (NEED TO ADD: JOHNSON SB/SU)
104C
105C              THREE+ SHAPE PARAMETER DISTRIBUTIONS:
106C                 1) WAKEBY (L-MOMENTS)
107C                 2) NORMAL MIXTURE
108C
109C     WRITTEN BY--ALAN HECKERT
110C                 STATISTICAL ENGINEERING DIVISION
111C                 INFORMATION TECHNOLOGY LABORATORY
112C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
113C                 GAITHERSBURG, MD 20899-8980
114C                 PHONE--301-975-2899
115C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
116C           OF THE NATIONAL BUREAU OF STANDARDS.
117C     LANGUAGE--ANSI FORTRAN (1977)
118C     VERSION NUMBER--2009/10
119C     ORIGINAL VERSION--OCTOBER   2009.
120C     UPDATED         --JUNE      2011. FOR BRITTLE FIBER WEIBULL,
121C                                       SET SHAPE2 PARAMETER TO L
122C     UPDATED         --AUGUST    2011. WHEN ESTIMATION FAILS, SET
123C                                       ALL PARAMETERS TO CPUMIN
124C     UPDATED         --APRIL     2014. 3-PARAMETER LOGNORMAL
125C     UPDATED         --APRIL     2014. 3-PARAMETER GAMMA
126C     UPDATED         --APRIL     2014. 2-PARAMETER INVERSE GAUSSIAN
127C     UPDATED         --APRIL     2014. 3-PARAMETER INVERSE GAUSSIAN
128C     UPDATED         --OCTOBER   2014. 3-PARAMETER FRECHET
129C     UPDATED         --OCTOBER   2014. 3-PARAMETER GAMMA
130C     UPDATED         --DECEMBER  2014. IOPFLG FOR PROFILE LIKELIHOOD
131C                                       FOR WEIML8, LGNML8, GAMML8
132C
133C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
134C
135      LOGICAL MLFLAG
136C
137      CHARACTER*4 ICASPL
138      CHARACTER*4 IBUGA3
139      CHARACTER*4 ISUBRO
140      CHARACTER*4 IWRITE
141      CHARACTER*4 IADEDF
142      CHARACTER*4 IGEPDF
143      CHARACTER*4 IMAKDF
144      CHARACTER*4 IBEIDF
145      CHARACTER*4 ILGADF
146      CHARACTER*4 ISKNDF
147      CHARACTER*4 IGLDDF
148      CHARACTER*4 IGOMDF
149      CHARACTER*4 IGIGDF
150      CHARACTER*4 IGEODF
151      CHARACTER*4 IBGEDF
152      CHARACTER*4 IGAUDF
153      CHARACTER*4 IGUMBC
154      CHARACTER*4 IEXPBC
155      CHARACTER*4 IWEIBC
156      CHARACTER*4 ICENTY
157      CHARACTER*4 IDFTTY
158      CHARACTER*4 IHSTCW
159      CHARACTER*4 IHSTOU
160      CHARACTER*4 IRELAT
161      CHARACTER*4 IRHSTG
162      CHARACTER*4 IWEIFL
163      CHARACTER*4 IGAMFL
164      CHARACTER*4 ICASE2
165      CHARACTER*4 ICASE3
166      CHARACTER*7 ICASE4
167      CHARACTER*4 IGEPSV
168      CHARACTER*4 IGEVML
169      CHARACTER*4 IERROR
170C
171      CHARACTER*40 IDIST
172      CHARACTER*4 ICENSO
173      CHARACTER*4 ISUBN1
174      CHARACTER*4 ISUBN2
175      CHARACTER*4 MESSAG
176      CHARACTER*4 IHWUSE
177      CHARACTER*4 IHP
178      CHARACTER*4 IHP2
179      CHARACTER*4 IOPFLG
180      CHARACTER*4 IWEIML
181      CHARACTER*4 IWEIMM
182      CHARACTER*4 IWEIMO
183      CHARACTER*4 IWEIEP
184      CHARACTER*4 IWEILM
185C
186      REAL ALOC
187      REAL ASCALE
188C
189C---------------------------------------------------------------------
190C
191      DIMENSION Y(*)
192      DIMENSION CENSOR(*)
193      DIMENSION TEMP1(*)
194      DIMENSION TEMP2(*)
195      DIMENSION TEMP3(*)
196      DIMENSION TEMP4(*)
197      DIMENSION TEMP5(*)
198      DIMENSION YTEMP(*)
199C
200      REAL CLWIDT(*)
201      REAL CLLIMI(*)
202C
203      DOUBLE PRECISION DTEMP1(*)
204      DOUBLE PRECISION DTEMP2(*)
205      DOUBLE PRECISION DTEMP3(*)
206      DOUBLE PRECISION XMOM(5)
207      INTEGER   ITEMP1(*)
208C
209      PARAMETER (MAXALP=8)
210      REAL ALPHA(MAXALP)
211      REAL ALOWLO(MAXALP)
212      REAL AUPPLO(MAXALP)
213      REAL ALOWSC(MAXALP)
214      REAL AUPPSC(MAXALP)
215      REAL ALOWL2(MAXALP)
216      REAL AUPPL2(MAXALP)
217      REAL ALOWS2(MAXALP)
218      REAL AUPPS2(MAXALP)
219CCCCC REAL ALOSH1(MAXALP)
220CCCCC REAL AUPSH1(MAXALP)
221CCCCC REAL ALOSH2(MAXALP)
222CCCCC REAL AUPSH2(MAXALP)
223CCCCC REAL ALOSH3(MAXALP)
224CCCCC REAL AUPSH3(MAXALP)
225C
226      DOUBLE PRECISION VARCOV(3,3)
227CCCCC REAL COV(6)
228C
229      PARAMETER (KMAX=20)
230      REAL MIXPRO(KMAX)
231      REAL XMEANV(KMAX)
232      REAL XSDV(KMAX)
233C
234C-----COMMON----------------------------------------------------------
235C
236      INCLUDE 'DPCOPA.INC'
237      INCLUDE 'DPCOHK.INC'
238      INCLUDE 'DPCOP2.INC'
239C
240      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
241C
242C-----START POINT-----------------------------------------------------
243C
244C
245      ISUBN1='DPML'
246      ISUBN2='1   '
247      IERROR='NO'
248      IOPFLG='OFF'
249      IFLAG9=-99
250C
251      ICASE=0
252      ALOC=CPUMIN
253      ASCALE=CPUMIN
254      SH1=CPUMIN
255      SH2=CPUMIN
256      SH3=CPUMIN
257      SH4=CPUMIN
258      SH5=CPUMIN
259      SH6=CPUMIN
260      SH7=CPUMIN
261C
262      CLWIDT(1)=CPUMIN
263      CLWIDT(2)=CPUMIN
264      CLLIMI(1)=CPUMIN
265      CLLIMI(2)=CPUMIN
266      CLLIMI(3)=CPUMIN
267      CLLIMI(4)=CPUMIN
268C
269      IWRITE='OFF'
270      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
271      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
272      CALL STMOM3(Y,N,IWRITE,XSKEW,IBUGA3,IERROR)
273      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
274C
275C               ********************************************
276C               **  STEP 1--                              **
277C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
278C               ********************************************
279C
280      IF(N.LT.2)THEN
281        WRITE(ICOUT,999)
282  999   FORMAT(1X)
283        CALL DPWRST('XXX','BUG ')
284        WRITE(ICOUT,31)
285   31   FORMAT('***** ERROR IN DPML1--')
286        CALL DPWRST('XXX','BUG ')
287        WRITE(ICOUT,32)
288   32   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 2.')
289        CALL DPWRST('XXX','BUG ')
290        WRITE(ICOUT,34)N
291   34   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
292        CALL DPWRST('XXX','BUG ')
293        WRITE(ICOUT,999)
294        CALL DPWRST('XXX','BUG ')
295        IERROR='YES'
296        GOTO9000
297      ENDIF
298C
299      HOLD=Y(1)
300      DO60I=1,N
301        IF(Y(I).NE.HOLD)GOTO69
302   60 CONTINUE
303      WRITE(ICOUT,999)
304      CALL DPWRST('XXX','BUG ')
305      WRITE(ICOUT,31)
306      CALL DPWRST('XXX','BUG ')
307      WRITE(ICOUT,62)
308   62 FORMAT('      ALL ELEMENTS IN THE RESPONSE VARIABLE ARE ',
309     1       'IDENTICALLY EQUAL TO ',G15.7)
310      CALL DPWRST('XXX','BUG ')
311      WRITE(ICOUT,999)
312      CALL DPWRST('XXX','BUG ')
313      IERROR='YES'
314      GOTO9000
315C
316   69 CONTINUE
317C
318      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'PML1')THEN
319        WRITE(ICOUT,999)
320        CALL DPWRST('XXX','BUG ')
321        WRITE(ICOUT,71)
322   71   FORMAT('***** AT THE BEGINNING OF DPML1--')
323        CALL DPWRST('XXX','BUG ')
324        WRITE(ICOUT,72)ICASPL,N,MINMAX
325   72   FORMAT('ICASPL,N,MINMAX = ',A4,2X,2X,I8,I8)
326        CALL DPWRST('XXX','BUG ')
327        WRITE(ICOUT,75)IADEDF,IBEIDF,IBGEDF,IGEODF
328   75   FORMAT('IADEDF,IBEIDF,IBGEDF,IGEODF = ',3(A4,2X),A4)
329        CALL DPWRST('XXX','BUG ')
330        WRITE(ICOUT,77)IGIGDF,IGOMDF,ILGADF,IMAKDF
331   77   FORMAT('IGIGDF,IGOMDF,ILGADF,IMAKDF = ',3(A4,2X),A4)
332        CALL DPWRST('XXX','BUG ')
333        WRITE(ICOUT,79)IHSTOU,IRELAT,IRHSTG,ISKNDF,IGLDDF
334   79   FORMAT('IHSTOU,IRELAT,IRHSTG,ISKNDF,IGLDDF = ',4(A4,2X),A4)
335        CALL DPWRST('XXX','BUG ')
336        DO85I=1,N
337          WRITE(ICOUT,86)I,Y(I)
338   86     FORMAT('I,Y(I) = ',I8,G15.7)
339          CALL DPWRST('XXX','BUG ')
340   85   CONTINUE
341      ENDIF
342C
343C               ************************************************
344C               **  STEP 2.1--                                **
345C               **  COMPUTE ML FOR SPECIFIED DISTRIBUTIONS    **
346C               ************************************************
347C
348      IF(ICASPL.EQ.'UNIF')THEN
349        IFLAG9=1
350        CALL UNIML1(Y,N,
351     1              XMIN,XMAX,XMEAN,XSD,XRANG,XMIDR,
352     1              ALOWLI,AUPPLI,AHAT,HHAT,ALO2LI,AUP2LI,
353     1              ALOCMO,ASCAMO,ALOC,ASCALE,
354     1              ISUBRO,IBUGA3,IERROR)
355         IF(IDFTTY.EQ.'MOME')THEN
356           ALOC=ALOCMO
357           ASCALE=ASCAMO
358         ENDIF
359      ELSEIF(ICASPL.EQ.'NORM')THEN
360        IFLAG9=1
361        IF(ICENSO.EQ.'OFF')THEN
362          CALL NORML1(Y,N,ICASE,
363     1                ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,MAXALP,NUMOUT,
364     1                XMEAN,XSD,XVAR,XMIN,XMAX,XSDMEA,XSDSD,
365     1                ISUBRO,IBUGA3,IERROR)
366          ALOC=XMEAN
367          ASCALE=XSD
368          IF(ASCALE.LE.0.0)IERROR='YES'
369        ELSE
370          CALL NORML2(Y,CENSOR,N,IR,
371     1                TEMP1,DTEMP1,ITEMP1,MAXNXT,IOUNI2,
372     1                ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,MAXALP,NUMOUT,
373     1                XMEAN,XSD,XVAR,XMIN,XMAX,XSDMEA,XSDSD,
374     1                XCOV,TEMP2,
375     1                ISUBRO,IBUGA3,IERROR)
376          ALOC=XMEAN
377          ASCALE=XSD
378          IF(ASCALE.LE.0.0)IERROR='YES'
379        ENDIF
380C
381      ELSEIF(ICASPL.EQ.'LOGI')THEN
382        IFLAG9=1
383        CALL LOGML1(Y,N,MAXNXT,
384     1              DTEMP1,
385     1              XMEAN,XSD,XMIN,XMAX,
386     1              ALOC,ASCALE,
387     1              ISUBRO,IBUGA3,IERROR)
388C
389        IF(ASCALE.LE.0.0)IERROR='YES'
390      ELSEIF(ICASPL.EQ.'DEXP')THEN
391        IFLAG9=1
392        CALL DEXML1(Y,N,TEMP1,ICASE,MAXNXT,
393     1              ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,MAXALP,NUMOUT,
394     1              XMEAN,XMED,XSD,XMIN,XMAX,
395     1              ALOC,ASCALE,
396     1              ISUBRO,IBUGA3,IERROR)
397C
398        IF(ASCALE.LE.0.0)IERROR='YES'
399      ELSEIF(ICASPL.EQ.'CAUC')THEN
400        IFLAG9=1
401        CALL CAUML1(Y,N,TEMP1,TEMP2,DTEMP1,MAXNXT,
402     1              XMEAN,XMED,XSD,XMAD,XIQ,XMIN,XMAX,
403     1              ALOC,ASCALE,ALOCOS,ASCLOS,ALOWOS,SCAWOS,
404     1              ISUBRO,IBUGA3,IERROR)
405        IF(IDFTTY.EQ.'OS')THEN
406          ALOC=ALOCOS
407          ASCALE=ASCLOS
408        ELSEIF(IDFTTY.EQ.'WOS')THEN
409          ALOC=ALOWOS
410          ASCALE=SCAWOS
411        ENDIF
412        IF(ASCALE.LE.0.0)IERROR='YES'
413C
414      ELSEIF(ICASPL.EQ.'EV1 ')THEN
415        IFLAG9=1
416        IGUMBC='OFF'
417        CALL EV1ML1(Y,N,MINMAX,IGUMBC,ICASE,
418     1              DTEMP1,
419     1              ALOWLO,AUPPLO,ALOWSC,AUPPSC,
420     1              ALOWL2,AUPPL2,ALOWS2,AUPPS2,
421     1              ALPHA,MAXALP,NUMOUT,
422     1              XMEAN,XSD,XMIN,XMAX,
423     1              ALOCMO,ASCAMO,ALMOSE,ASMOSE,
424     1              ALOCML,ASCAML,ASC2ML,ALMLSE,ASMLSE,COVSE,
425     1              ISUBRO,IBUGA3,IERROR)
426        ALOC=ALOCML
427        ASCALE=ASCAML
428        IF(IDFTTY.EQ.'MOME')THEN
429          ALOC=ALOCMO
430          ASCALE=ASCAMO
431        ENDIF
432        IF(ASCALE.LE.0.0)IERROR='YES'
433C
434      ELSEIF(ICASPL.EQ.'1EXP' .OR. ICASPL.EQ.'EXPO')THEN
435        IFLAG9=1
436        ICASE2='1'
437        IF(ICASPL.EQ.'EXPO')ICASE2='2'
438C
439        IF(ICENSO.EQ.'ON')THEN
440          IHP='TEND'
441          IHP2='    '
442          IHWUSE='P'
443          MESSAG='NO'
444          CALL CHECKN(IHP,IHP2,IHWUSE,
445     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
446     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
447          TEND=0.0
448          IF(IERROR.EQ.'NO')TEND=VALUE(ILOCP)
449C
450          IF(ICENTY.EQ.'1')THEN
451            CALL EXPML2(Y,CENSOR,N,ICASPL,ICASE2,TEND,TEMP1,MAXNXT,
452     1                  XMEAN,XSD,XVAR,XMIN,XMAX,XSUM,
453     1                  ALOCML,ALOCSE,SCALML,SCALSE,
454     1                  IR,IM,AN,AR,AM,
455     1                  ISUBRO,IBUGA3,IERROR)
456          ELSEIF(ICENTY.EQ.'2')THEN
457            CALL EXPML3(Y,CENSOR,TEMP1,N,ICASPL,ICASE2,TEND,MAXNXT,
458     1                  XMEAN,XSD,XVAR,XMIN,XMAX,XSUM,
459     1                  ALOCML,ALOCSE,SCALML,SCALSE,
460     1                  IR,IM,AN,AR,AM,
461     1                  ISUBRO,IBUGA3,IERROR)
462          ENDIF
463        ELSE
464          CALL EXPML1(Y,N,ICASE2,IEXPBC,
465     1                ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,
466     1                MAXALP,NUMOUT,
467     1                XMEAN,XSD,XVAR,XMIN,XMAX,
468     1                ALOCML,ALOCSE,SCALML,SCALSE,
469     1                ALOCBC,ALOBSE,SCABML,SCABSE,
470     1                ISUBRO,IBUGA3,IERROR)
471        ENDIF
472        ALOC=ALOCML
473        ASCALE=SCALML
474        IF(IDFTTY.EQ.'BC')THEN
475          ALOC=ALOCBC
476          ASCALE=SCABML
477        ENDIF
478        IF(ASCALE.LE.0.0)IERROR='YES'
479C
480      ELSEIF(ICASPL.EQ.'SLAS')THEN
481        IFLAG9=1
482        CALL SLAML1(Y,N,MAXNXT,
483     1              TEMP1,TEMP2,TEMP3,DTEMP1,
484     1              XMEAN,XSD,XMIN,XMAX,XMED,XMAD,
485     1              ALOC,ASCALE,
486     1              ISUBRO,IBUGA3,IERROR)
487C
488      ELSEIF(ICASPL.EQ.'FNOR')THEN
489        IFLAG9=1
490        CALL FNRML1(Y,N,MAXNXT,
491     1              TEMP1,DTEMP1,
492     1              XMEAN,XSD,XVAR,XMIN,XMAX,
493     1              ALOC,ASCALE,
494     1              ISUBRO,IBUGA3,IERROR)
495C
496        IF(ASCALE.LE.0.0)IERROR='YES'
497        IF(IERROR.EQ.'YES')GOTO9000
498      ELSEIF(ICASPL.EQ.'RAYL')THEN
499        IFLAG9=1
500        ICASE2='2'
501        CALL RAYML1(Y,N,ICASE2,
502     1              DTEMP1,
503     1              XMEAN,XSD,XMIN,XMAX,
504     1              ALOCML,SCALML,SCALSE,
505     1              ALOCMM,SCALMM,SCA2SE,
506     1              ALOCMO,SCALMO,ALOCLM,SCALLM,ALOCPE,SCALPE,
507     1              ALOCSE,ALAMBA,ALAMSE,
508     1              ISUBRO,IBUGA3,IERROR)
509        IF(IDFTTY.EQ.'MMOM')THEN
510          ALOC=ALOCMM
511          ASCALE=SCALMM
512        ELSEIF(IDFTTY.EQ.'LMOM')THEN
513          ALOC=ALOCLM
514          ASCALE=SCALLM
515        ELSEIF(IDFTTY.EQ.'MOME')THEN
516          ALOC=ALOCMO
517          ASCALE=SCALMO
518        ELSEIF(IDFTTY.EQ.'PERC')THEN
519          ALOC=ALOCPE
520          ASCALE=SCALPE
521        ELSE
522          ALOC=ALOCML
523          ASCALE=SCALML
524        ENDIF
525        IF(ASCALE.LE.0.0)IERROR='YES'
526C
527      ELSEIF(ICASPL.EQ.'1RAY')THEN
528        IFLAG9=1
529        ICASE2='1'
530        CALL RAYML1(Y,N,ICASE2,
531     1              DTEMP1,
532     1              XMEAN,XSD,XMIN,XMAX,
533     1              ALOCML,SCALML,SCALSE,
534     1              ALOCMM,SCALMM,SCA2SE,
535     1              ALOCMO,SCALMO,ALOCLM,SCALLM,ALOCPE,SCALPE,
536     1              ALOCSE,ALAMBA,ALAMSE,
537     1              ISUBRO,IBUGA3,IERROR)
538        ALOC=CPUMIN
539        ASCALE=SCALML
540        IF(ASCALE.LE.0.0)IERROR='YES'
541C
542      ELSEIF(ICASPL.EQ.'MAXW' .OR. ICASPL.EQ.'MAX2')THEN
543        IFLAG9=1
544        ICASE2='2'
545        CALL MAXML1(Y,N,ICASE2,
546     1              DTEMP1,
547     1              XMEAN,XSD,XMIN,XMAX,
548     1              ALOCML,SCALML,SCALSE,
549     1              ALOCMO,SCALMO,
550     1              ISUBRO,IBUGA3,IERROR)
551        ALOC=ALOCMO
552        ASCALE=SCALMO
553        IF(IDFTTY.EQ.'MOME')THEN
554          ALOC=ALOCMO
555          ASCALE=SCALMO
556        ENDIF
557        IF(ASCALE.LE.0.0)IERROR='YES'
558C
559      ELSEIF(ICASPL.EQ.'1MAX')THEN
560        IFLAG9=1
561        ICASE2='1'
562        CALL MAXML1(Y,N,ICASE2,
563     1              DTEMP1,
564     1              XMEAN,XSD,XMIN,XMAX,
565     1              ALOCML,SCALML,SCALSE,
566     1              ALOCMO,SCALMO,
567     1              ISUBRO,IBUGA3,IERROR)
568        ALOC=CPUMIN
569        ASCALE=SCALML
570        IF(IDFTTY.EQ.'MOME')THEN
571          ASCALE=SCALMO
572        ENDIF
573        IF(ASCALE.LE.0.0)IERROR='YES'
574C
575      ELSEIF(ICASPL.EQ.'HNOR' .OR. ICASPL.EQ.'1HNO')THEN
576        IFLAG9=1
577        ICASE2='2'
578        IF(ICASPL.EQ.'1HNO')ICASE2='1'
579        CALL HFNML1(Y,N,ICASE2,
580     1              XMEAN,XSD,XMIN,XMAX,
581     1              ALOC,ASCALE,
582     1              ISUBRO,IBUGA3,IERROR)
583        IF(ASCALE.LE.0.0)IERROR='YES'
584C
585      ELSEIF(ICASPL.EQ.'HALO' .OR. ICASPL.EQ.'1HAL')THEN
586        IFLAG9=1
587        ICASE2='2'
588        IF(ICASPL.EQ.'1HAL')ICASE2='1'
589        CALL HFLML1(Y,N,ICASE2,
590     1              TEMP1,DTEMP1,
591     1              XMEAN,XSD,XMIN,XMAX,
592     1              ALOC,SCALML,SCALBC,SCALSE,
593     1              ISUBRO,IBUGA3,IERROR)
594        ASCALE=SCALML
595        IF(ASCALE.LE.0.0)IERROR='YES'
596C
597      ELSEIF(ICASPL.EQ.'WEIB')THEN
598        IFLAG9=1
599        IWEIBC='OFF'
600        IWEIFL='WEIB'
601        IF(ICENSO.EQ.'ON')THEN
602          CALL WEIML2(Y,CENSOR,N,IWEIBC,IWEIFL,MINMAX,MAXNXT,
603     1                ICASE3,ICASE4,IDIST,
604     1                TEMP1,DTEMP1,ITEMP1,
605     1                XMEAN,XSD,XVAR,XMIN,XMAX,
606     1                ZMEAN,ZSD,
607     1                SCALML,SCALSE,SHAPML,SHAPSE,
608     1                SHAPBC,SHABSE,COVSE,COVBSE,
609     1                IR,
610     1                ISUBRO,IBUGA3,IERROR)
611        ELSE
612          CALL WEIML1(Y,N,IWEIBC,IWEIFL,MINMAX,
613     1                TEMP1,DTEMP1,
614     1                XMEAN,XSD,XVAR,XMIN,XMAX,
615     1                ZMEAN,ZSD,
616     1                SCALML,SCALSE,SHAPML,SHAPSE,
617     1                SHABML,SHABSE,COVSE,COVBSE,
618     1                ISUBRO,IBUGA3,IERROR)
619        ENDIF
620        ALOC=CPUMIN
621        ASCALE=SCALML
622        SH1=SHAPML
623        IF(IDFTTY.EQ.'BC')THEN
624          SH1=SHABML
625        ENDIF
626        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
627C
628      ELSEIF(ICASPL.EQ.'3WEI')THEN
629        IFLAG9=1
630        IWEIFL='WEIB'
631        IWEIML='OFF'
632        IWEIMO='OFF'
633        IWEIMM='OFF'
634        IWEIEP='OFF'
635        IWEILM='OFF'
636        IF(IDFTTY.EQ.'MMOM')IWEIMM='ON'
637        IF(IDFTTY.EQ.'MOME')IWEIMO='ON'
638        IF(IDFTTY.EQ.'ML  ')IWEIML='ON'
639        IF(IDFTTY.EQ.'EPER')IWEIEP='ON'
640        IF(IDFTTY.EQ.'LMOM')IWEILM='ON'
641        IF(IDFTTY.EQ.'PROF')THEN
642          P3WEMI=0.0
643          CALL WEIML8(Y,N,ICASPL,IWEIBC,IWEIFL,MINMAX,MAXNXT,P3WEMI,
644     1                IOPFLG,
645     1                TEMP1,DTEMP1,TEMP2,
646     1                ALOC,ASCALE,SH1,
647     1                ISUBRO,IBUGA3,IERROR)
648        ELSE
649          CALL WEIML3(Y,N,IWEIFL,IWEIML,IWEIMM,IWEIMO,IWEIEP,IWEILM,
650     1                MINMAX,MAXNXT,ISEED,
651     1                TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,DTEMP1,
652     1                XMEAN,XSD,XVAR,XMIN,XMAX,XSKEW,
653     1                ZMEAN,ZSD,
654     1                ALOCPE,SCALPE,SHAPPE,
655     1                ALOCWB,SCALWB,SHAPWB,
656     1                ALOCMO,SCALMO,SHAPMO,
657     1                ALOCM2,SCALM2,SHAPM2,
658     1                ALOCML,SCALML,SHAPML,
659     1                ALOCLM,SCALLM,SHAPLM,
660     1                ALOCEP,SCALEP,SHAPEP,
661     1                ISUBRO,IBUGA3,IERROR)
662          IF(IDFTTY.EQ.'PERC')THEN
663            ALOC=ALOCPE
664            ASCALE=SCALPE
665            SH1=SHAPPE
666          ELSEIF(IDFTTY.EQ.'WBE')THEN
667            ALOC=ALOCWB
668            ASCALE=SCALWB
669            SH1=SHAPWB
670          ELSEIF(IDFTTY.EQ.'MMOM')THEN
671            ALOC=ALOCMO
672            ASCALE=SCALMO
673            SH1=SHAPMO
674          ELSEIF(IDFTTY.EQ.'MOME')THEN
675            ALOC=ALOCM2
676            ASCALE=SCALM2
677            SH1=SHAPM2
678          ELSEIF(IDFTTY.EQ.'LMOM')THEN
679            ALOC=ALOCLM
680            ASCALE=SCALLM
681            SH1=SHAPLM
682          ELSEIF(IDFTTY.EQ.'EPER')THEN
683            ALOC=ALOCEP
684            ASCALE=SCALEP
685            SH1=SHAPEP
686          ELSE
687            ALOC=ALOCML
688            ASCALE=SCALML
689            SH1=SHAPML
690          ENDIF
691          IERROR='NO'
692          IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
693        ENDIF
694C
695      ELSEIF(ICASPL.EQ.'IWEI')THEN
696        IWEIBC='OFF'
697        IWEIFL='IWEI'
698        IFLAG9=1
699        IF(ICENSO.EQ.'ON')THEN
700          CALL WEIML2(Y,CENSOR,N,IWEIBC,IWEIFL,MINMAX,MAXNXT,
701     1                ICASE3,ICASE4,IDIST,
702     1                TEMP1,DTEMP1,ITEMP1,
703     1                XMEAN,XSD,XVAR,XMIN,XMAX,
704     1                ZMEAN,ZSD,
705     1                SCALML,SCALSE,SHAPML,SHAPSE,
706     1                SHAPBC,SHABSE,COVSE,COVBSE,
707     1                IR,
708     1                ISUBRO,IBUGA3,IERROR)
709        ELSE
710          CALL WEIML1(Y,N,IWEIBC,IWEIFL,MINMAX,
711     1                TEMP1,DTEMP1,
712     1                XMEAN,XSD,XVAR,XMIN,XMAX,
713     1                ZMEAN,ZSD,
714     1                SCALML,SCALSE,SHAPML,SHAPSE,
715     1                SHABML,SHABSE,COVSE,COVBSE,
716     1                ISUBRO,IBUGA3,IERROR)
717        ENDIF
718        ALOC=CPUMIN
719        ASCALE=SCALML
720        SH1=SHAPML
721        IF(IDFTTY.EQ.'BC')THEN
722          SH1=SHABML
723        ENDIF
724        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
725C
726CCCCC ELSEIF(ICASPL.EQ.'3IWE')THEN
727CCCCC   IFLAG9=1
728CCCCC   IWEIFL='IWEI'
729CCCCC   IWEIML='OFF'
730CCCCC   IWEIMO='OFF'
731CCCCC   IWEIMM='OFF'
732CCCCC   IWEIEP='OFF'
733CCCCC   IWEILM='OFF'
734CCCCC   IF(IDFTTY.EQ.'MMOM')IWEIMM='ON'
735CCCCC   IF(IDFTTY.EQ.'MOME')IWEIMO='ON'
736CCCCC   IF(IDFTTY.EQ.'ML  ')IWEIML='ON'
737CCCCC   IF(IDFTTY.EQ.'EPER')IWEIEP='ON'
738CCCCC   IF(IDFTTY.EQ.'LMOM')IWEILM='ON'
739CCCCC   CALL WEIML3(Y,N,IWEIFL,IWEIML,IWEIMM,IWEIMO,IWEIEP,IWEILM,
740CCCCC1              MINMAX,MAXNXT,
741CCCCC1              TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,DTEMP1,
742CCCCC1              XMEAN,XSD,XVAR,XMIN,XMAX,XSKEW,
743CCCCC1              ZMEAN,ZSD,
744CCCCC1              ALOCPE,SCALPE,SHAPPE,
745CCCCC1              ALOCWB,SCALWB,SHAPWB,
746CCCCC1              ALOCMO,SCALMO,SHAPMO,
747CCCCC1              ALOCM2,SCALM2,SHAPM2,
748CCCCC1              ALOCML,SCALML,SHAPML,
749CCCCC1              ALOCLM,SCALLM,SHAPLM,
750CCCCC1              ALOCEP,SCALEP,SHAPEP,
751CCCCC1              ISUBRO,IBUGA3,IERROR)
752CCCCC   IF(IDFTTY.EQ.'PERC')THEN
753CCCCC     ALOC=ALOCPE
754CCCCC     ASCALE=SCALPE
755CCCCC     SH1=SHAPPE
756CCCCC   ELSEIF(IDFTTY.EQ.'WBE')THEN
757CCCCC     ALOC=ALOCWB
758CCCCC     ASCALE=SCALWB
759CCCCC     SH1=SHAPWB
760CCCCC   ELSEIF(IDFTTY.EQ.'MMOM')THEN
761CCCCC     ALOC=ALOCMO
762CCCCC     ASCALE=SCALMO
763CCCCC     SH1=SHAPMO
764CCCCC   ELSEIF(IDFTTY.EQ.'MOME')THEN
765CCCCC     ALOC=ALOCM2
766CCCCC     ASCALE=SCALM2
767CCCCC     SH1=SHAPM2
768CCCCC   ELSEIF(IDFTTY.EQ.'LMOM')THEN
769CCCCC     ALOC=ALOCLM
770CCCCC     ASCALE=SCALLM
771CCCCC     SH1=SHAPLM
772CCCCC   ELSEIF(IDFTTY.EQ.'EPER')THEN
773CCCCC     ALOC=ALOCEP
774CCCCC     ASCALE=SCALEP
775CCCCC     SH1=SHAPEP
776CCCCC   ELSE
777CCCCC     ALOC=ALOCML
778CCCCC     ASCALE=SCALML
779CCCCC     SH1=SHAPML
780CCCCC   ENDIF
781CCCCC   IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
782C
783      ELSEIF(ICASPL.EQ.'BFWE')THEN
784        IFLAG9=1
785C
786        IHP='SHAP'
787        IHP2='ESV '
788        IHWUSE='P'
789        MESSAG='NO'
790        CALL CHECKN(IHP,IHP2,IHWUSE,
791     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
792     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
793        SHAPSV=CPUMIN
794        IF(IERROR.EQ.'NO')SHAPSV=VALUE(ILOCP)
795C
796        IHP='SCAL'
797        IHP2='ESV '
798        IHWUSE='P'
799        MESSAG='NO'
800        CALL CHECKN(IHP,IHP2,IHWUSE,
801     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
802     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
803        SCALSV=CPUMIN
804        IF(IERROR.EQ.'NO')SCALSV=VALUE(ILOCP)
805C
806        IHP='L   '
807        IHP2='    '
808        IHWUSE='P'
809        MESSAG='NO'
810        CALL CHECKN(IHP,IHP2,IHWUSE,
811     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
812     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
813        ALJUNK=1.0
814        IF(IERROR.EQ.'NO')ALJUNK=VALUE(ILOCP)
815        IF(ALJUNK.LE.0.0)THEN
816          ALJUNK=1.0
817        ENDIF
818        DO5341II=1,N
819          CENSOR(II)=ALJUNK
820 5341   CONTINUE
821C
822        CALL BFWML1(Y,CENSOR,N,MAXNXT,
823     1              TEMP1,TEMP2,DTEMP1,
824     1              XMEAN,XSD,XVAR,XMIN,XMAX,
825     1              SCALSV,SHAPSV,SCALML,SHAPML,
826     1              ISUBRO,IBUGA3,IERROR)
827C
828        ALOC=CPUMIN
829        ASCALE=SCALML
830        SH1=SHAPML
831        SH2=ALJUNK
832        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
833C
834      ELSEIF(ICASPL.EQ.'LOGN')THEN
835        IFLAG9=1
836        CALL LGNML1(Y,N,MAXNXT,
837     1              TEMP1,
838     1              XMEAN,XMED,XSD,XVAR,XMIN,XMAX,XMEANL,XSDL,
839     1              SCALML,SCALSE,SHAPML,SHAPSE,UHATML,UHATSE,
840     1              ISUBRO,IBUGA3,IERROR)
841        ALOC=CPUMIN
842        ASCALE=SCALML
843        SH1=SHAPML
844        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
845C
846      ELSEIF(ICASPL.EQ.'3LGN')THEN
847        IFLAG9=1
848C
849        IF(IDFTTY.EQ.'MMOM' .OR. IDFTTY.EQ.'MOME')THEN
850C
851          CALL LGNMO1(XMEAN,XSD,XMIN,XSKEW,N,PSTAMV,
852     1                ALOCMO,SCALMO,SHAPMO,UHATMO,
853     1                ALOCMM,SCALMM,SHAPMM,UHATMM,
854     1                ISUBRO,IBUGA3,IERROR)
855          IF(IDFTTY.EQ.'MMOM')THEN
856            ALOC=ALOCMM
857            ASCALE=SCALMM
858            SH1=SHAPMM
859          ELSEIF(IDFTTY.EQ.'MOME')THEN
860            ALOC=ALOCMO
861            ASCALE=SCALMO
862            SH1=SHAPMO
863          ENDIF
864        ELSE
865           IF(IDFTTY.EQ.'PROF')THEN
866             CALL LGNML8(Y,N,MAXNXT,P3LNMI,IOPFLG,
867     1                   TEMP1,TEMP2,
868     1                   ALOC,ASCALE,SH1,
869     1                   ISUBRO,IBUGA3,IERROR)
870              UHATML=LOG(ASCALE)
871           ELSE
872             CALL LGNML3(Y,N,DTEMP1,
873     1                   XMEAN,XSD,XVAR,XMIN,XMAX,XSKEW,
874     1                   ALOC,ASCALE,SH1,UHATML,
875     1                   ISUBRO,IBUGA3,IERROR)
876           ENDIF
877        ENDIF
878C
879        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
880C
881      ELSEIF(ICASPL.EQ.'GAMM')THEN
882        IFLAG9=1
883        IGAMFL='GAMM'
884        IF(ICENSO.EQ.'OFF')THEN
885          CALL GAMML1(Y,N,IGAMFL,
886     1                TEMP1,DTEMP1,
887     1                XMEAN,XSD,XVAR,XMIN,XMAX,XGEOM,
888     1                ZMEAN,ZSD,ZGEOM,
889     1                SCALML,SCALSE,SHAPML,SHAPSE,COVSE,
890     1                SCALMO,SHAPMO,
891     1                SCALYE,SHAPYE,SCYEBC,SHYEBC,
892     1                ISUBRO,IBUGA3,IERROR)
893          ALOC=CPUMIN
894          ASCALE=SCALML
895          SH1=SHAPML
896          IF(IDFTTY.EQ.'MOME')THEN
897            ASCALE=SCALMO
898            SH1=SHAPMO
899          ELSEIF(IDFTTY.EQ.'YE  ')THEN
900            ASCALE=SCALYE
901            SH1=SHAPYE
902          ELSEIF(IDFTTY.EQ.'YEBC')THEN
903            ASCALE=SCYEBC
904            SH1=SHYEBC
905          ENDIF
906        ELSE
907          CALL GAMML2(Y,CENSOR,N,IGAMFL,MAXNXT,
908     1                ICASE3,IDIST,
909     1                TEMP1,TEMP2,TEMP3,DTEMP1,ITEMP1,
910     1                XMEANF,XSDF,XVARF,XMINF,XMAXF,XGEOMF,
911     1                XMEANC,XSDC,XVARC,XMINC,XMAXC,XGEOMC,
912     1                SCALMO,SHAPMO,
913     1                SCALML,SCALSE,SHAPML,SHAPSE,COVSE,
914     1                IR,ISE,
915     1                ISUBRO,IBUGA3,IERROR)
916          ALOC=CPUMIN
917          ASCALE=SCALML
918          SH1=SHAPML
919          IF(IDFTTY.EQ.'MOME')THEN
920            ASCALE=SCALMO
921            SH1=SHAPMO
922          ENDIF
923        ENDIF
924        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
925C
926      ELSEIF(ICASPL.EQ.'3GAM')THEN
927        IFLAG9=1
928        IF(IDFTTY.EQ.'MOME' .OR. IDFTTY.EQ.'MMOM')THEN
929          CALL GAMMO1(XMEAN,XSD,XMIN,XSKEW,N,PSTAMV,
930     1                ALOCMO,SCALMO,SHAPMO,
931     1                ALOCMM,SCALMM,SHAPMM,
932     1                ISUBRO,IBUGA3,IERROR)
933          IF(IDFTTY.EQ.'MOME')THEN
934            ALOC=ALOCMO
935            ASCALE=SCALMO
936            SH1=SHAPMO
937          ELSEIF(IDFTTY.EQ.'MMOM')THEN
938            ALOC=ALOCMM
939            ASCALE=SCALMM
940            SH1=SHAPMM
941          ENDIF
942        ELSE
943          CALL GAMML3(Y,N,DTEMP1,
944     1                XMEAN,XSD,XVAR,XMIN,XMAX,XSKEW,
945     1                ALOC,ASCALE,SH1,
946     1                ISUBRO,IBUGA3,IERROR)
947        ENDIF
948      ELSEIF(ICASPL.EQ.'IGAM')THEN
949        IGAMFL='IGAM'
950        IFLAG9=1
951        IF(ICENSO.EQ.'OFF')THEN
952          CALL GAMML1(Y,N,IGAMFL,
953     1                TEMP1,DTEMP1,
954     1                XMEAN,XSD,XVAR,XMIN,XMAX,XGEOM,
955     1                ZMEAN,ZSD,ZGEOM,
956     1                SCALML,SCALSE,SHAPML,SHAPSE,COVSE,
957     1                SCALMO,SHAPMO,
958     1                SCALYE,SHAPYE,SCYEBC,SHYEBC,
959     1                ISUBRO,IBUGA3,IERROR)
960          ALOC=CPUMIN
961          ASCALE=SCALML
962          SH1=SHAPML
963          IF(IDFTTY.EQ.'MOME')THEN
964            ASCALE=SCALMO
965            SH1=SHAPMO
966          ELSEIF(IDFTTY.EQ.'YE  ')THEN
967            ASCALE=SCALYE
968            SH1=SHAPYE
969          ELSEIF(IDFTTY.EQ.'YEBC')THEN
970            ASCALE=SCYEBC
971            SH1=SHYEBC
972          ENDIF
973        ELSE
974          CALL GAMML2(Y,CENSOR,N,IGAMFL,MAXNXT,
975     1                ICASE3,IDIST,
976     1                TEMP1,TEMP2,TEMP3,DTEMP1,ITEMP1,
977     1                XMEANF,XSDF,XVARF,XMINF,XMAXF,XGEOMF,
978     1                XMEANC,XSDC,XVARC,XMINC,XMAXC,XGEOMC,
979     1                SCALMO,SHAPMO,
980     1                SCALML,SCALSE,SHAPML,SHAPSE,COVSE,
981     1                IR,ISE,
982     1                ISUBRO,IBUGA3,IERROR)
983          ALOC=CPUMIN
984          ASCALE=SCALML
985          SH1=SHAPML
986          IF(IDFTTY.EQ.'MOME')THEN
987            ASCALE=SCALMO
988            SH1=SHAPMO
989          ENDIF
990        ENDIF
991        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
992C
993      ELSEIF(ICASPL.EQ.'INGA')THEN
994        IFLAG9=1
995        IWRITE='OFF'
996        CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
997        CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
998        IF(IDFTTY.EQ.'MOME')THEN
999          ALOC=CPUMIN
1000          ASCALE=CPUMIN
1001          SH2=XMEAN
1002          SIGMMO=XSD
1003          GAMMMO=SH2**3/SIGMMO**2
1004          IF(IGAUDF.EQ.'CHAN')THEN
1005            SH1=SIGMMO
1006          ELSE
1007            SH1=GAMMMO
1008          ENDIF
1009        ELSE
1010          ALOC=CPUMIN
1011          ASCALE=CPUMIN
1012          CALL IGML1(Y,N,PSTAMV,
1013     1               XMEAN,XSD,XMIN,XSKEW,
1014     1               ALOCML,AMUML,SIGMML,GAMMML,
1015     1               ISUBRO,IBUGA3,IERROR)
1016          SH2=XMEAN
1017          IF(IGAUDF.EQ.'CHAN')THEN
1018            SH1=SIGMML
1019          ELSE
1020            SH1=GAMMML
1021          ENDIF
1022        ENDIF
1023C
1024      ELSEIF(ICASPL.EQ.'3IGA')THEN
1025        IFLAG9=1
1026        IWRITE='OFF'
1027        CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
1028        CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
1029        CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
1030        CALL STMOM3(Y,N,IWRITE,XSKEW,IBUGA3,IERROR)
1031        IF(IDFTTY.EQ.'MOME' .OR. IDFTTY.EQ.'MMOM')THEN
1032          CALL IGMO1(XMEAN,XSD,XMIN,XSKEW,N,PSTAMV,
1033     1               ALOCMO,AMUMO,SIGMMO,GAMMMO,
1034     1               ALOCMM,AMUMM,SIGMMM,GAMMMM,
1035     1               ISUBRO,IBUGA3,IERROR)
1036          IF(IDFTTY.EQ.'MOME')THEN
1037            ALOC=ALOCMO
1038            ASCALE=CPUMIN
1039            IF(IGAUDF.EQ.'CHAN')THEN
1040              SH1=SIGMMO
1041            ELSE
1042              SH1=GAMMMO
1043            ENDIF
1044            SH2=AMUMO
1045          ELSE
1046            ALOC=ALOCMM
1047            ASCALE=CPUMIN
1048            SH1=SIGMMM
1049            SH2=AMUMM
1050          ENDIF
1051        ELSE
1052          CALL IGML1(Y,N,PSTAMV,
1053     1               XMEAN,XSD,XMIN,XSKEW,
1054     1               ALOCML,AMUML,SIGMML,GAMMML,
1055     1               ISUBRO,IBUGA3,IERROR)
1056          ALOC=ALOCML
1057          ASCALE=CPUMIN
1058          SH1=SIGMML
1059          IF(IGAUDF.EQ.'CHAN')THEN
1060            SH1=SIGMML
1061          ELSE
1062            SH1=GAMMML
1063          ENDIF
1064          SH2=AMUML
1065        ENDIF
1066C
1067      ELSEIF(ICASPL.EQ.'GEEX')THEN
1068        IFLAG9=1
1069        IHP='GAMM'
1070        IHP2='SV  '
1071        IHWUSE='P'
1072        MESSAG='NO'
1073        CALL CHECKN(IHP,IHP2,IHWUSE,
1074     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
1075     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
1076        SHAPSV=CPUMIN
1077        IF(IERROR.EQ.'NO')SHAPSV=VALUE(ILOCP)
1078C
1079        IHP='SCAL'
1080        IHP2='ESV '
1081        IHWUSE='P'
1082        MESSAG='NO'
1083        CALL CHECKN(IHP,IHP2,IHWUSE,
1084     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
1085     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
1086        SCALSV=CPUMIN
1087        IF(IERROR.EQ.'NO')SCALSV=VALUE(ILOCP)
1088C
1089        CALL GEEML1(Y,N,MAXNXT,
1090     1              TEMP1,TEMP2,TEMP3,DTEMP1,
1091     1              XMEAN,XSD,XVAR,XMIN,XMAX,
1092     1              SCALSV,SHAPSV,SCALML,SHAPML,
1093     1              ISUBRO,IBUGA3,IERROR)
1094        ALOC=CPUMIN
1095        ASCALE=SCALML
1096        SH1=SHAPML
1097        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
1098C
1099      ELSEIF(ICASPL.EQ.'FREC' .OR. ICASPL.EQ.'EV2 ')THEN
1100        IFLAG9=1
1101        CALL EV2ML1(Y,N,MINMAX,
1102     1              TEMP1,DTEMP1,
1103     1              XMEAN,XSD,XVAR,XMIN,XMAX,XLOGSD,XLOGSM,
1104     1              SCALML,SCALSE,SHAPML,SHAPSE,
1105     1              SHABML,SHABSE,COVSE,COVBSE,
1106     1              ISUBRO,IBUGA3,IERROR)
1107        ALOC=CPUMIN
1108        ASCALE=SCALML
1109        SH1=SHAPML
1110        IF(IDFTTY.EQ.'BC')THEN
1111          SH1=SHABML
1112        ENDIF
1113        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
1114C
1115      ELSEIF(ICASPL.EQ.'3FRE' .OR. ICASPL.EQ.'3EV2' .OR.
1116     1       ICASPL.EQ.'3IWE')THEN
1117        IFLAG9=1
1118        MINMX2=MINMAX
1119        IF(ICASPL.EQ.'3IWE')MINMX2=2
1120        IGEVML='OFF'
1121        IF(IDFTTY.EQ.'ML')IGEVML='ON'
1122        CALL EV2ML3(Y,N,MINMX2,MAXNXT,ISEED,IDFTTY,IGEVML,
1123     1              TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,DTEMP1,
1124     1              XMOM,NMOM,VARCOV,
1125     1              XMEAN,XSD,XVAR,XMIN,XMAX,XSKEW,
1126     1              ALOCML,SCALML,SHAPML,
1127     1              ALOCLM,SCALLM,SHAPLM,
1128     1              ALOCEP,SCALEP,SHAPEP,
1129     1              ISUBRO,IBUGA3,IERROR)
1130        IF(IDFTTY.EQ.'EPER')THEN
1131          ALOC=ALOCEP
1132          ASCALE=SCALEP
1133          SH1=SHAPEP
1134        ELSEIF(IDFTTY.EQ.'LMOM')THEN
1135          ALOC=ALOCLM
1136          ASCALE=SCALLM
1137          SH1=SHAPLM
1138        ELSEIF(IDFTTY.EQ.'ML')THEN
1139          ALOC=ALOCML
1140          ASCALE=SCALML
1141          SH1=SHAPML
1142        ELSE
1143          IF(SHAPLM.NE.CPUMIN)THEN
1144             ALOC=ALOCLM
1145             ASCALE=SCALLM
1146             SH1=SHAPLM
1147          ELSE
1148             ALOC=ALOCEP
1149             ASCALE=SCALEP
1150             SH1=SHAPEP
1151          ENDIF
1152        ENDIF
1153        IF(ASCALE.LE.0.0)IERROR='YES'
1154C
1155      ELSEIF(ICASPL.EQ.'FATL')THEN
1156        IFLAG9=1
1157        CALL FLML1(Y,N,MAXNXT,
1158     1             TEMP1,DTEMP1,
1159     1             XMEAN,XSD,XVAR,XMIN,XMAX,
1160     1             SCALML,SHAPML,SCALMO,SHAPMO,
1161     1             ISUBRO,IBUGA3,IERROR)
1162        ALOC=CPUMIN
1163        ASCALE=SCALML
1164        SH1=SHAPML
1165        IF(IDFTTY.EQ.'MOME')THEN
1166          ASCALE=SCALMO
1167          SH1=SHAPMO
1168        ENDIF
1169        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
1170C
1171      ELSEIF(ICASPL.EQ.'GEV ')THEN
1172        IFLAG9=1
1173        MLFLAG=.TRUE.
1174        IGEVML='OFF'
1175        IF(IDFTTY.EQ.'ML')IGEVML='ON'
1176        CALL GEVML1(Y,N,MAXNXT,MINMAX,ICASPL,MLFLAG,IGEPDF,
1177     1              ISEED,IDFTTY,IGEVML,
1178     1              TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,
1179     1              DTEMP1,XMOM,NMOM,VARCOV,
1180     1              XMEAN,XSD,XVAR,XMIN,XMAX,
1181     1              ALOCLM,SCALLM,SHAPLM,
1182     1              ALOCEP,SCALEP,SHAPEP,
1183     1              ALOCML,SCALML,SHAPML,
1184     1              ISUBRO,IBUGA3,IERROR)
1185        IF(IDFTTY.EQ.'EPER')THEN
1186          ALOC=ALOCEP
1187          ASCALE=SCALEP
1188          SH1=SHAPEP
1189        ELSEIF(IDFTTY.EQ.'LMOM')THEN
1190          ALOC=ALOCLM
1191          ASCALE=SCALLM
1192          SH1=SHAPLM
1193        ELSEIF(IDFTTY.EQ.'ML')THEN
1194          ALOC=ALOCML
1195          ASCALE=SCALML
1196          SH1=SHAPML
1197        ELSE
1198          IF(SHAPLM.NE.CPUMIN)THEN
1199             ALOC=ALOCLM
1200             ASCALE=SCALLM
1201             SH1=SHAPLM
1202          ELSE
1203             ALOC=ALOCEP
1204             ASCALE=SCALEP
1205             SH1=SHAPEP
1206          ENDIF
1207        ENDIF
1208        IF(ASCALE.LE.0.0)IERROR='YES'
1209C
1210      ELSEIF(ICASPL.EQ.'GPAR')THEN
1211        IGEPSV='EPER'
1212        IFLAG9=1
1213        MLFLAG=.TRUE.
1214        CALL GEPML1(Y,N,MAXNXT,MINMAX,ICASPL,IGEPDF,IGEPSV,IDFTTY,
1215     1              GAMMSV,SCALSV,ISEED,THRESH,
1216     1              TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,YTEMP,
1217     1              DTEMP1,XMOM,NMOM,
1218     1              XMEAN,XSD,XVAR,XMIN,XMAX,
1219     1              ALOCMO,SCALMO,SHAPMO,
1220     1              ALOCLM,SCALLM,SHAPLM,
1221     1              ALOCEP,SCALEP,SHAPEP,
1222     1              ALOCML,SCALML,SHAPML,MLFLA2,
1223     1              NUSE,ZMEAN,ZVAR,ZSD,ALOC2,
1224     1              VARMM1,VARMM2,COVMOM,
1225     1              VARML1,VARML2,COVML,
1226     1              ISUBRO,IBUGA3,IERROR)
1227        IF(IDFTTY.EQ.'EPER')THEN
1228          ALOC=ALOCEP
1229          ASCALE=SCALEP
1230          SH1=SHAPEP
1231        ELSEIF(IDFTTY.EQ.'LMOM')THEN
1232          ALOC=ALOCLM
1233          ASCALE=SCALLM
1234          SH1=SHAPLM
1235        ELSEIF(IDFTTY.EQ.'MOME')THEN
1236          ALOC=ALOCMO
1237          ASCALE=SCALMO
1238          SH1=SHAPMO
1239        ELSE
1240          ALOC=ALOCML
1241          ASCALE=SCALML
1242          SH1=SHAPML
1243        ENDIF
1244        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
1245C
1246      ELSEIF(ICASPL.EQ.'BU10')THEN
1247        IFLAG9=1
1248C
1249        IHP='RSV '
1250        IHP2='    '
1251        IHWUSE='P'
1252        MESSAG='NO'
1253        CALL CHECKN(IHP,IHP2,IHWUSE,
1254     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
1255     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
1256        SHAPSV=CPUMIN
1257        IF(IERROR.EQ.'NO')SHAPSV=VALUE(ILOCP)
1258C
1259        IHP='SCAL'
1260        IHP2='ESV '
1261        IHWUSE='P'
1262        MESSAG='NO'
1263        CALL CHECKN(IHP,IHP2,IHWUSE,
1264     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
1265     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
1266        SCALSV=CPUMIN
1267        IF(IERROR.EQ.'NO')SCALSV=VALUE(ILOCP)
1268C
1269        CALL B10ML1(Y,N,MAXNXT,
1270     1              TEMP1,TEMP2,TEMP3,DTEMP1,
1271     1              XMEAN,XSD,XVAR,XMIN,XMAX,
1272     1              SCALSV,SHAPSV,SCALML,SHAPML,
1273     1              ISUBRO,IBUGA3,IERROR)
1274        ALOC=CPUMIN
1275        ASCALE=SCALML
1276        SH1=SHAPML
1277        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
1278C
1279      ELSEIF(ICASPL.EQ.'LEXP')THEN
1280        IFLAG9=1
1281C
1282        IHP='ALPH'
1283        IHP2='ASV '
1284        IHWUSE='P'
1285        MESSAG='NO'
1286        CALL CHECKN(IHP,IHP2,IHWUSE,
1287     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
1288     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
1289        SCALSV=CPUMIN
1290        IF(IERROR.EQ.'NO')SCALSV=VALUE(ILOCP)
1291C
1292        IHP='BETA'
1293        IHP2='SV  '
1294        IHWUSE='P'
1295        MESSAG='NO'
1296        CALL CHECKN(IHP,IHP2,IHWUSE,
1297     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
1298     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
1299        SHAPSV=CPUMIN
1300        IF(IERROR.EQ.'NO')SHAPSV=VALUE(ILOCP)
1301C
1302        CALL LEXML1(Y,N,MAXNXT,
1303     1              TEMP1,DTEMP1,
1304     1              XMEAN,XSD,XVAR,XMIN,XMAX,XSUM,
1305     1              SCALSV,SHAPSV,SCALML,SHAPML,
1306     1              ISUBRO,IBUGA3,IERROR)
1307        ALOC=CPUMIN
1308        ASCALE=SCALML
1309        SH1=SHAPML
1310        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
1311C
1312      ELSEIF(ICASPL.EQ.'PEA3')THEN
1313        IFLAG9=1
1314        CALL PE3ML1(Y,N,
1315     1              DTEMP1,XMOM,NMOM,
1316     1              XMEAN,XSD,XVAR,XMIN,XMAX,
1317     1              ALOC,ASCALE,SH1,
1318     1              ISUBRO,IBUGA3,IERROR)
1319        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
1320        IF(IERROR.EQ.'YES')GOTO9000
1321C
1322      ELSEIF(ICASPL.EQ.'G5LO')THEN
1323        IFLAG9=1
1324        CALL GL5ML1(Y,N,
1325     1              DTEMP1,XMOM,NMOM,
1326     1              XMEAN,XSD,XVAR,XMIN,XMAX,
1327     1              ALOC,ASCALE,SH1,
1328     1              ISUBRO,IBUGA3,IERROR)
1329        IF(IERROR.EQ.'YES')GOTO9000
1330        IF(ASCALE.LE.0.0)IERROR='YES'
1331C
1332      ELSEIF(ICASPL.EQ.'KAPP')THEN
1333        IFLAG9=1
1334        CALL KAPML1(Y,N,
1335     1              DTEMP1,XMOM,NMOM,
1336     1              XMEAN,XSD,XVAR,XMIN,XMAX,
1337     1              ALOC,ASCALE,SH1,SH2,
1338     1              ISUBRO,IBUGA3,IERROR)
1339        IF(ASCALE.LE.0.0)IERROR='YES'
1340        IF(IERROR.EQ.'YES')GOTO9000
1341C
1342      ELSEIF(ICASPL.EQ.'BNOR')THEN
1343        IFLAG9=1
1344C
1345        IHP='ALPH'
1346        IHP2='ASV '
1347        IHWUSE='P'
1348        MESSAG='NO'
1349        CALL CHECKN(IHP,IHP2,IHWUSE,
1350     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
1351     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
1352        ALPHSV=CPUMIN
1353        IF(IERROR.EQ.'NO')ALPHSV=VALUE(ILOCP)
1354C
1355        IHP='BETA'
1356        IHP2='SV  '
1357        IHWUSE='P'
1358        MESSAG='NO'
1359        CALL CHECKN(IHP,IHP2,IHWUSE,
1360     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
1361     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
1362        BETASV=CPUMIN
1363        IF(IERROR.EQ.'NO')BETASV=VALUE(ILOCP)
1364C
1365        IHP='MUSV'
1366        IHP2='    '
1367        IHWUSE='P'
1368        MESSAG='NO'
1369        CALL CHECKN(IHP,IHP2,IHWUSE,
1370     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
1371     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
1372        AMUSV=CPUMIN
1373        IF(IERROR.EQ.'NO')AMUSV=VALUE(ILOCP)
1374C
1375        IHP='SIGM'
1376        IHP2='ASV '
1377        IHWUSE='P'
1378        MESSAG='NO'
1379        CALL CHECKN(IHP,IHP2,IHWUSE,
1380     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
1381     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
1382        SIGMSV=CPUMIN
1383        IF(IERROR.EQ.'NO')SIGMSV=VALUE(ILOCP)
1384C
1385        CALL BNOML1(Y,N,MAXNXT,DTEMP1,
1386     1              XMEAN,XSD,XVAR,XMIN,XMAX,
1387     1              AMUSV,SIGMSV,ALPHSV,BETASV,
1388     1              ALOCML,ASCALE,SH1,SH2,
1389     1              ISUBRO,IBUGA3,IERROR)
1390        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0 .OR. SH2.LE.0.0)IERROR='YES'
1391        IF(IERROR.EQ.'YES')GOTO9000
1392C
1393      ELSEIF(ICASPL.EQ.'PEXP')THEN
1394        IFLAG9=1
1395        IHP='BETA'
1396        IHP2='SV  '
1397        IHWUSE='P'
1398        MESSAG='NO'
1399        CALL CHECKN(IHP,IHP2,IHWUSE,
1400     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
1401     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
1402        BETASV=CPUMIN
1403        IF(IERROR.EQ.'NO')BETASV=VALUE(ILOCP)
1404C
1405        IHP='SCAL'
1406        IHP2='ESV '
1407        IHWUSE='P'
1408        MESSAG='NO'
1409        CALL CHECKN(IHP,IHP2,IHWUSE,
1410     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
1411     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
1412        SCALSV=CPUMIN
1413        IF(IERROR.EQ.'NO')SCALSV=VALUE(ILOCP)
1414C
1415        CALL PEXML1(Y,N,BETASV,SCALSV,MAXNXT,
1416     1             TEMP1,TEMP2,TEMP3,DTEMP1,
1417     1             XMEAN,XSD,XVAR,XMIN,XMAX,
1418     1             SH1,ASCALE,
1419     1             ISUBRO,IBUGA3,IERROR)
1420        ALOC=CPUMIN
1421        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
1422C
1423      ELSEIF(ICASPL.EQ.'ALPH')THEN
1424        IFLAG9=1
1425        IHP='ALPH'
1426        IHP2='ASV '
1427        IHWUSE='P'
1428        MESSAG='NO'
1429        CALL CHECKN(IHP,IHP2,IHWUSE,
1430     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
1431     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
1432        ALPHSV=CPUMIN
1433        IF(IERROR.EQ.'NO')ALPHSV=VALUE(ILOCP)
1434C
1435        IHP='SCAL'
1436        IHP2='ESV '
1437        IHWUSE='P'
1438        MESSAG='NO'
1439        CALL CHECKN(IHP,IHP2,IHWUSE,
1440     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
1441     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
1442        SCALSV=CPUMIN
1443        IF(IERROR.EQ.'NO')SCALSV=VALUE(ILOCP)
1444C
1445        CALL ALPML1(Y,N,ALPHSV,SCALSV,MAXNXT,
1446     1              TEMP1,TEMP2,TEMP3,DTEMP1,
1447     1              XMEAN,XSD,XVAR,XMIN,XMAX,
1448     1              ALPHMO,SCALMO,ALPHML,SCALML,
1449     1              ISUBRO,IBUGA3,IERROR)
1450        ALOC=CPUMIN
1451        ASCALE=SCALML
1452        SH1=SCALML
1453        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
1454C
1455      ELSEIF(ICASPL.EQ.'ADEX')THEN
1456        IFLAG9=1
1457        CALL ADEML1(Y,N,MAXNXT,
1458     1              TEMP1,DTEMP1,DTEMP2,DTEMP3,
1459     1              XMEAN,XMED,XSD,XVAR,XMIN,XMAX,
1460     1              ALOC,ASCALE,SH1,
1461     1              ISUBRO,IBUGA3,IERROR)
1462        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
1463        IF(SH1.EQ.CPUMIN)IERROR='YES'
1464C
1465      ELSEIF(ICASPL.EQ.'PARE')THEN
1466        IFLAG9=1
1467C
1468        CALL PARML1(Y,N,
1469     1              DTEMP1,
1470     1              XMEAN,XSD,XMIN,XMAX,
1471     1              AMOM,SHAPMO,
1472     1              AMM,SHAPMM,
1473     1              AML,SHAPML,AMLSE,SHAPSE,
1474     1              ISUBRO,IBUGA3,IERROR)
1475C
1476        SH1=AML
1477        SH2=SHAPML
1478        IF(IDFTTY.EQ.'MOME')THEN
1479          SH1=AMOM
1480          SH2=SHAPMO
1481        ELSEIF(IDFTTY.EQ.'MMOM')THEN
1482          SH1=AMM
1483          SH2=SHAPMM
1484        ENDIF
1485        IF(SH2.LE.0.0)IERROR='YES'
1486C
1487      ELSEIF(ICASPL.EQ.'TPAR')THEN
1488        IFLAG9=1
1489C
1490        IHP='R   '
1491        IHP2='    '
1492        IHWUSE='P'
1493        MESSAG='NO'
1494        CALL CHECKN(IHP,IHP2,IHWUSE,
1495     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
1496     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
1497        IF(IERROR.EQ.'NO')THEN
1498          AR=VALUE(ILOCP)
1499        ELSE
1500          AR=-1.0
1501        ENDIF
1502        IR=INT(AR)
1503C
1504        CALL TNPML1(Y,N,IR,DTEMP1,
1505     1              XMEAN,XSD,XMIN,XMAX,
1506     1              AML,ANUML,GAMMML,
1507     1              ISUBRO,IBUGA3,IERROR)
1508C
1509        SH1=AML
1510        SH2=ANUML
1511        SH3=GAMMML
1512        IF(SH3.LE.0.0)IERROR='YES'
1513C
1514      ELSEIF(ICASPL.EQ.'WAKE')THEN
1515        IFLAG9=1
1516        CALL WAKML1(Y,N,
1517     1              DTEMP1,XMOM,NMOM,
1518     1              XMEAN,XSD,XVAR,XMIN,XMAX,
1519     1              ALOC,ASCALE,SH1,SH2,SH3,
1520     1              ISUBRO,IBUGA3,IERROR)
1521        IF(IERROR.EQ.'YES')GOTO9000
1522C
1523      ELSEIF(ICASPL.EQ.'TRIA')THEN
1524        IFLAG9=1
1525        CALL TRIML1(Y,N,MAXNXT,
1526     1              TEMP1,TEMP2,DTEMP1,
1527     1              XMIN,XMAX,XMEAN,XSD,
1528     1              A,B,ALOWQN,AUPPQN,
1529     1              AQUANT,BQUANT,
1530     1              AML,BML,CML,
1531     1              ISUBRO,IBUGA3,IERROR)
1532        ALOC=AML
1533        ASCALE=BML
1534        SH1=CML
1535C
1536      ELSEIF(ICASPL.EQ.'TOPL')THEN
1537        IFLAG9=1
1538        IF(YLOWLM.NE.CPUMIN .AND. YUPPLM.NE.CPUMIN)THEN
1539          ZMIN=YLOWLM
1540          ZMAX=YUPPLM
1541        ELSE
1542          ZMIN=CPUMIN
1543          ZMAX=CPUMIN
1544        ENDIF
1545        CALL TOPML1(Y,N,ZMIN,ZMAX,
1546     1              XMIN,XMAX,XMEAN,XSD,
1547     1              SH1,ZLOC,ZSCALE,
1548     1              ISUBRO,IBUGA3,IERROR)
1549        ALOC=ZLOC
1550        ASCALE=ZLOC + ZSCALE
1551        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0)IERROR='YES'
1552C
1553      ELSEIF(ICASPL.EQ.'POWF')THEN
1554        IFLAG9=1
1555        ICASE2='POWE'
1556        IF(YLOWLM.NE.CPUMIN .AND. YUPPLM.NE.CPUMIN)THEN
1557          ZMIN=YLOWLM
1558          ZMAX=YUPPLM
1559        ELSE
1560          ZMIN=CPUMIN
1561          ZMAX=CPUMIN
1562        ENDIF
1563        CALL POWML1(Y,N,ICASE2,
1564     1              XMIN,XMAX,XMEAN,XSD,
1565     1              SHAPMO,SHAPML,ZMIN,ZMAX,
1566     1              ISUBRO,IBUGA3,IERROR)
1567        ALOC=ZMIN
1568        ASCALE=ZMAX
1569        SH1=SHAPML
1570        IF(SH1.LE.0.0)IERROR='YES'
1571C
1572      ELSEIF(ICASPL.EQ.'RPOW')THEN
1573        IFLAG9=1
1574        ICASE2='RPOW'
1575        IF(YLOWLM.NE.CPUMIN .AND. YUPPLM.NE.CPUMIN)THEN
1576          ZMIN=YLOWLM
1577          ZMAX=YUPPLM
1578        ELSE
1579          ZMIN=CPUMIN
1580          ZMAX=CPUMIN
1581        ENDIF
1582        CALL POWML1(Y,N,ICASE2,
1583     1              XMIN,XMAX,XMEAN,XSD,
1584     1              SHAPMO,SHAPML,ZMIN,ZMAX,
1585     1              ISUBRO,IBUGA3,IERROR)
1586        ALOC=ZMIN
1587        ASCALE=ZMAX
1588        SH1=SHAPML
1589        IF(SH1.LE.0.0)IERROR='YES'
1590C
1591      ELSEIF(ICASPL.EQ.'BETA')THEN
1592        IFLAG9=1
1593C
1594        IHP='BETA'
1595        IHP2='LL  '
1596        IHWUSE='P'
1597        MESSAG='NO'
1598        CALL CHECKN(IHP,IHP2,IHWUSE,
1599     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
1600     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
1601        AUSER=CPUMIN
1602        IF(IERROR.EQ.'NO')AUSER=VALUE(ILOCP)
1603C
1604        IHP='BETA'
1605        IHP2='UL  '
1606        IHWUSE='P'
1607        MESSAG='NO'
1608        CALL CHECKN(IHP,IHP2,IHWUSE,
1609     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
1610     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
1611        BUSER=CPUMIN
1612        IF(IERROR.EQ.'NO')AUSER=VALUE(ILOCP)
1613C
1614        IF(AUSER.EQ.CPUMIN .OR. BUSER.EQ.CPUMIN)THEN
1615          IF(YLOWLM.NE.CPUMIN .AND. YUPPLM.NE.CPUMIN)THEN
1616            AUSER=YLOWLM
1617            BUSER=YUPPLM
1618          ELSE
1619            AUSER=CPUMIN
1620            BUSER=CPUMIN
1621          ENDIF
1622        ENDIF
1623C
1624        CALL BETML1(Y,N,DTEMP1,MAXNXT,AUSER,BUSER,
1625     1              XMIN,XMAX,XMEAN,XSD,XVAR,
1626     1              A,B,
1627     1              ALPHMO,BETAMO,
1628     1              ALPHML,BETAML,
1629     1              ISUBRO,IBUGA3,IERROR)
1630         SH1=ALPHML
1631         SH2=BETAML
1632         ALOC=A
1633         ASCALE=B
1634         IF(IDFTTY.EQ.'MOME')THEN
1635           SH1=ALPHMO
1636           SH2=BETAMO
1637         ENDIF
1638        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0 .OR. SH2.LE.0.0)IERROR='YES'
1639C
1640      ELSEIF(ICASPL.EQ.'4BET')THEN
1641        IFLAG9=1
1642C
1643        CALL BETML4(Y,N,DTEMP1,MAXNXT,
1644     1              XMIN,XMAX,XMEAN,XSD,XVAR,
1645     1              AMOM,BMOM,ALPHMO,BETAMO,
1646     1              AML,BML,ALPHML,BETAML,IMLFLG,
1647     1              ISUBRO,IBUGA3,IERROR)
1648        SH1=ALPHML
1649        SH2=BETAML
1650        ALOC=AML
1651        ASCALE=BML
1652        IF(IDFTTY.EQ.'MOME')THEN
1653          SH1=ALPHMO
1654          SH2=BETAMO
1655          ALOC=AMOM
1656          ASCALE=BMOM
1657        ENDIF
1658        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0 .OR. SH2.LE.0.0)IERROR='YES'
1659C
1660      ELSEIF(ICASPL.EQ.'TSPO')THEN
1661        IFLAG9=1
1662C
1663        CALL TSPML1(Y,N,TEMP1,TEMP2,TEMP3,TEMP4,DTEMP1,
1664     1              XMIN,XMAX,XMEAN,XSD,
1665     1              ALOC,ASCALE,SH1,SH2,
1666     1              ISUBRO,IBUGA3,IERROR)
1667        IF(ASCALE.LE.0.0 .OR. SH2.LE.0.0)IERROR='YES'
1668C
1669      ELSEIF(ICASPL.EQ.'RGTL')THEN
1670        IFLAG9=1
1671        NUMV=1
1672        ALPHSV=CPUMIN
1673C
1674        CALL RGTML1(Y,TEMP5,YTEMP,N,NUMV,MAXNXT,N,
1675     1              DTEMP1,TEMP1,TEMP2,TEMP3,TEMP4,
1676     1              XMIN,XMAX,XMEAN,XSD,
1677     1              ALPHSV,A,B,
1678     1              SH1,SH2,ALOC,ASCALE,
1679     1              ISUBRO,IBUGA3,IERROR)
1680        IF(ASCALE.LE.0.0 .OR. SH1.LE.0.0 .OR. SH2.LE.0.0)IERROR='YES'
1681C
1682      ELSEIF(ICASPL.EQ.'VONM')THEN
1683        IFLAG9=1
1684        CALL VONML1(Y,N,
1685     1              XMEAN,XSD,XVAR,XMIN,XMAX,
1686     1              ALOCML,SHAPML,
1687     1              ISUBRO,IBUGA3,IERROR)
1688        ALOC=ALOCML
1689        ASCALE=1.0
1690        SH1=SHAPML
1691        IF(SH1.LE.0.0)IERROR='YES'
1692C
1693C     NORMAL MIXTURE: CURRENTLY LIMIT IT TO THE 2-COMPONENT
1694C                     CASE.
1695C
1696      ELSEIF(ICASPL.EQ.'NORX')THEN
1697        IFLAG9=1
1698        NCOMP=2
1699        NVAR=1
1700        CALL NMXML1(Y,CENSOR,N,NVAR,YTEMP,TEMP1,N2,
1701     1              TEMP2,TEMP3,TEMP4,TEMP5,ITEMP1,MAXNXT,
1702     1              CLLIMI,CLWIDT,NCOMP,IHSTCW,
1703     1              MIXPRO,XMEANV,XSDV,KMAX,NTOT2,ALOGL,
1704     1              AMEAN,ASD,AMIN,AMAX,
1705     1              ISUBRO,IBUGA3,IERROR)
1706        SH1=XMEANV(1)
1707        SH2=XMEANV(2)
1708        SH3=XSDV(1)
1709        SH4=XSDV(2)
1710        SH5=MIXPRO(1)
1711        IF(IERROR.EQ.'YES')GOTO9000
1712C
1713      ELSE
1714CCCCC   WRITE(ICOUT,999)
1715CCCCC   CALL DPWRST('XXX','BUG ')
1716CCCCC   WRITE(ICOUT,31)
1717CCCCC   CALL DPWRST('XXX','BUG ')
1718CCCCC   WRITE(ICOUT,8011)ICASPL
1719C8011   FORMAT('      UNKNOWN DISTRIBUTION -- ',A40)
1720CCCCC   CALL DPWRST('XXX','BUG ')
1721        IERROR='YES'
1722        IFLAG9=-99
1723        GOTO9000
1724      ENDIF
1725C
1726      GOTO9000
1727C
1728C     SET AN ERROR FLAG TO INDICATE A DISCRETE DISTRIBUTION
1729C     IS NOT TO BE PROCESSED.
1730C
1731      IFLAGD=99
1732      GOTO9000
1733C
1734C               *****************
1735C               **  STEP 90--  **
1736C               **  EXIT       **
1737C               *****************
1738C
1739 9000 CONTINUE
1740C
1741      IF(IERROR.EQ.'YES')THEN
1742        ALOC=CPUMIN
1743        ASCALE=CPUMIN
1744        SH1=CPUMIN
1745        SH2=CPUMIN
1746        SH3=CPUMIN
1747        SH4=CPUMIN
1748        SH5=CPUMIN
1749        SH6=CPUMIN
1750        SH7=CPUMIN
1751      ENDIF
1752C
1753      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'PML1')THEN
1754        WRITE(ICOUT,999)
1755        CALL DPWRST('XXX','BUG ')
1756        WRITE(ICOUT,9011)
1757 9011   FORMAT('***** AT THE END       OF DPML1--')
1758        CALL DPWRST('XXX','BUG ')
1759        WRITE(ICOUT,9012)ICASPL,N,MINMAX,IERROR
1760 9012   FORMAT('ICASPL,N,MINMAX,IERROR = ',A4,2X,2I8,2X,A4)
1761        CALL DPWRST('XXX','BUG ')
1762        WRITE(ICOUT,9014)ALOC,ASCALE,SH1,SH2
1763 9014   FORMAT('ALOC,ASCALE,SH1,SH2 = ',4G15.7)
1764        CALL DPWRST('XXX','BUG ')
1765      ENDIF
1766C
1767      RETURN
1768      END
1769      SUBROUTINE DPMLAD(Y,N,MAXNXT,
1770     1                  TEMP1,ITEMP,DALPHA,DBETA,DH,
1771     1                  AKML,ALOCML,SCALML,
1772     1                  ICAPSW,ICAPTY,IFORSW,
1773     1                  ISUBRO,IBUGA3,IERROR)
1774C
1775C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
1776C              ESTIMATES FOR THE ASYMMETRIC DOUBLE EXPONENTIAL
1777C              DISTRIBUTION.
1778C     EXAMPLE--ASYMMETRIC DOUBLE EXPONENTIAL MAXIMUM LIKELIHOOD Y
1779C     REFERENCES--KOTZ, KOZUBOWSKI, AND PODGORSKI, "THE LAPLACE
1780C                 DISTRIBUTION AND GENERALIZATIONS: A REVISIT WITH
1781C                 APPLICATIONS TO COMMUNICATIONS, ECONOMICS,
1782C                 ENGINEERING, AND FINANCE", BIRKHAUSR, 2001,
1783C                 PP. 133-178.
1784C     WRITTEN BY--ALAN HECKERT
1785C                 STATISTICAL ENGINEERING DIVISION
1786C                 INFORMATION TECHNOLOGY LABORATORY
1787C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
1788C                 GAITHERSBURG, MD 20899-8980
1789C                 PHONE--301-975-2899
1790C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
1791C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
1792C     LANGUAGE--ANSI FORTRAN (1977)
1793C     VERSION NUMBER--2004/8
1794C     ORIGINAL VERSION--AUGUST    2004.
1795C     UPDATED         --JULY      2010. USE DPDTA1, DPDT8A TO
1796C                                       PRINT OUTPUT
1797C     UPDATED         --JULY      2010. EXTRACT POINT ESTIMATES
1798C                                       TO ADEML1
1799C
1800C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
1801C
1802      CHARACTER*4 ICAPSW
1803      CHARACTER*4 ICAPTY
1804      CHARACTER*4 IFORSW
1805      CHARACTER*4 ISUBRO
1806      CHARACTER*4 IBUGA3
1807      CHARACTER*4 IERROR
1808      CHARACTER*4 IWRITE
1809C
1810      CHARACTER*4 ISUBN1
1811      CHARACTER*4 ISUBN2
1812      CHARACTER*4 ISTEPN
1813C
1814C---------------------------------------------------------------------
1815C
1816      DIMENSION Y(*)
1817      DIMENSION TEMP1(*)
1818      DIMENSION ITEMP(*)
1819C
1820      DOUBLE PRECISION DALPHA(*)
1821      DOUBLE PRECISION DBETA(*)
1822      DOUBLE PRECISION DH(*)
1823C
1824      DIMENSION QP(1)
1825      DIMENSION FISH(3,3)
1826      DIMENSION COV(3,3)
1827C
1828      CHARACTER*4 IOP
1829C
1830      INCLUDE 'DPCOST.INC'
1831C
1832      PARAMETER (MAXROW=20)
1833      CHARACTER*60 ITITLE
1834      CHARACTER*60 ITITLZ
1835      CHARACTER*40 ITEXT(MAXROW)
1836      REAL         AVALUE(MAXROW)
1837      INTEGER      NCTEXT(MAXROW)
1838      INTEGER      IDIGIT(MAXROW)
1839      INTEGER      NTOT(MAXROW)
1840      LOGICAL IFRST
1841      LOGICAL ILAST
1842C
1843C---------------------------------------------------------------------
1844C
1845      INCLUDE 'DPCOP2.INC'
1846C
1847C-----START POINT-----------------------------------------------------
1848C
1849      ISUBN1='DPML'
1850      ISUBN2='AD  '
1851      IERROR='NO'
1852C
1853      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLAD')THEN
1854        WRITE(ICOUT,999)
1855  999   FORMAT(1X)
1856        CALL DPWRST('XXX','WRIT')
1857        WRITE(ICOUT,51)
1858   51   FORMAT('**** AT THE BEGINNING OF DPMLAD--')
1859        CALL DPWRST('XXX','WRIT')
1860        WRITE(ICOUT,52)IBUGA3,ISUBRO,N
1861   52   FORMAT('IBUGA3,ISUBRO,N = ',A4,2X,A4,2X,I8)
1862        CALL DPWRST('XXX','WRIT')
1863        DO56I=1,MIN(N,100)
1864          WRITE(ICOUT,57)I,Y(I)
1865   57     FORMAT('I,Y(I) = ',I8,G15.7)
1866          CALL DPWRST('XXX','WRIT')
1867   56   CONTINUE
1868      ENDIF
1869C
1870C               ********************************************
1871C               **  STEP 11--                             **
1872C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
1873C               ********************************************
1874C
1875      ISTEPN='11'
1876      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLAD')
1877     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1878C
1879      NPERC=0
1880      NMIN=4
1881      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
1882      IF(IERROR.EQ.'YES')GOTO9000
1883C
1884C               *********************************************
1885C               **  STEP 21--                              **
1886C               **  CARRY OUT CALCULATIONS                 **
1887C               **  FOR ASYMMETRIC DOUBLE EXPONENTIAL MLE  **
1888C               **  ESTIMATE (FULL SAMPLE CASE)            **
1889C               *********************************************
1890C
1891      ISTEPN='21'
1892      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLAD')
1893     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1894C
1895      IERROR='NO'
1896      IWRITE='OFF'
1897C
1898      CALL ADEML1(Y,N,MAXNXT,
1899     1            TEMP1,DALPHA,DBETA,DH,
1900     1            XMEAN,XMED,XSD,XVAR,XMIN,XMAX,
1901     1            ALOCML,SCALML,AKML,
1902     1            ISUBRO,IBUGA3,IERROR)
1903      IF(IERROR.EQ.'YES')GOTO9000
1904C
1905C  NOW COMPUTE THE FISHER INFORMATION MATRIX, THEN INVERT TO
1906C  OBTAIN THE ASYMPTOTIC VARIANCE-COVARIANCE MATRIX.  THEN WRITE
1907C  TO DPST1F.DAT.
1908C
1909      FISH(1,1)=2.0/(SCALML**2)
1910      FISH(1,2)=-SQRT(2.0)*2.0/(SCALML*(1.0+AKML**2))
1911      FISH(3,1)=0.0
1912      FISH(2,1)=FISH(1,2)
1913      FISH(2,2)=(1.0/(AKML**2)) + 4.0/((1.0+AKML**2)**2)
1914      FISH(2,3)=-(1.0-AKML**2)/(SCALML*AKML*(1.0+AKML**2))
1915      FISH(1,3)=FISH(3,1)
1916      FISH(3,2)=FISH(2,3)
1917      FISH(3,3)=1.0/(SCALML**2)
1918CCCCC print *,'fish(1,1) = ',fish(1,1)
1919CCCCC print *,'fish(2,2) = ',fish(2,2)
1920CCCCC print *,'fish(3,3) = ',fish(3,3)
1921CCCCC print *,'fish(1,2) = ',fish(1,2)
1922CCCCC print *,'fish(2,3) = ',fish(2,3)
1923CCCCC print *,'fish(3,1) = ',fish(3,1)
1924      CALL SGECO(FISH,3,3,ITEMP,RCOND,TEMP1)
1925      IJOB=1
1926      CALL SGEDI(FISH,3,3,ITEMP,TEMP1,TEMP1(MAXNXT/2),IJOB)
1927      DO2810J=1,3
1928        DO2815I=1,3
1929          COV(I,J)=FISH(I,J)
1930 2815   CONTINUE
1931 2810 CONTINUE
1932C
1933      IOP='OPEN'
1934      IFLAG1=1
1935      IFLAG2=0
1936      IFLAG3=0
1937      IFLAG4=0
1938      IFLAG5=0
1939      CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
1940     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
1941     1            IBUGA3,ISUBRO,IERROR)
1942      IF(IERROR.EQ.'YES')GOTO9000
1943C
1944      WRITE(IOUNI1,2905)
1945 2905 FORMAT(' THETA             K               SIGMA')
1946      DO2910I=1,3
1947        WRITE(IOUNI1,'(3(E15.7,2X))')COV(I,1),COV(I,2),COV(I,3)
1948 2910 CONTINUE
1949C
1950      IOP='CLOS'
1951      CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
1952     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
1953     1            IBUGA3,ISUBRO,IERROR)
1954C
1955      IF(IPRINT.EQ.'OFF')GOTO9000
1956C
1957      NUMDIG=7
1958      IF(IFORSW.EQ.'1')NUMDIG=1
1959      IF(IFORSW.EQ.'2')NUMDIG=2
1960      IF(IFORSW.EQ.'3')NUMDIG=3
1961      IF(IFORSW.EQ.'4')NUMDIG=4
1962      IF(IFORSW.EQ.'5')NUMDIG=5
1963      IF(IFORSW.EQ.'6')NUMDIG=6
1964      IF(IFORSW.EQ.'7')NUMDIG=7
1965      IF(IFORSW.EQ.'8')NUMDIG=8
1966      IF(IFORSW.EQ.'9')NUMDIG=9
1967      IF(IFORSW.EQ.'0')NUMDIG=0
1968      IF(IFORSW.EQ.'E')NUMDIG=-2
1969      IF(IFORSW.EQ.'-2')NUMDIG=-2
1970      IF(IFORSW.EQ.'-3')NUMDIG=-3
1971      IF(IFORSW.EQ.'-4')NUMDIG=-4
1972      IF(IFORSW.EQ.'-5')NUMDIG=-5
1973      IF(IFORSW.EQ.'-6')NUMDIG=-6
1974      IF(IFORSW.EQ.'-7')NUMDIG=-7
1975      IF(IFORSW.EQ.'-8')NUMDIG=-8
1976      IF(IFORSW.EQ.'-9')NUMDIG=-9
1977C
1978      ITITLE='Asymmetric Double Exponential Parameter Estimation'
1979      NCTITL=50
1980      ITITLZ=' '
1981      NCTITZ=0
1982      ICNT=1
1983      ITEXT(ICNT)='Summary Statistics:'
1984      NCTEXT(ICNT)=19
1985      AVALUE(ICNT)=0.0
1986      IDIGIT(ICNT)=-1
1987      ICNT=ICNT+1
1988      ITEXT(ICNT)='Number of Observations:'
1989      NCTEXT(ICNT)=23
1990      AVALUE(ICNT)=REAL(N)
1991      IDIGIT(ICNT)=0
1992      ICNT=ICNT+1
1993      ITEXT(ICNT)='Sample Mean:'
1994      NCTEXT(ICNT)=12
1995      AVALUE(ICNT)=XMEAN
1996      IDIGIT(ICNT)=NUMDIG
1997      ICNT=ICNT+1
1998      ITEXT(ICNT)='Sample Median:'
1999      NCTEXT(ICNT)=14
2000      AVALUE(ICNT)=XMED
2001      IDIGIT(ICNT)=NUMDIG
2002      ICNT=ICNT+1
2003      ITEXT(ICNT)='Sample Standard Deviation:'
2004      NCTEXT(ICNT)=26
2005      AVALUE(ICNT)=XSD
2006      IDIGIT(ICNT)=NUMDIG
2007      ICNT=ICNT+1
2008      ITEXT(ICNT)='Sample Minimum:'
2009      NCTEXT(ICNT)=15
2010      AVALUE(ICNT)=XMIN
2011      IDIGIT(ICNT)=NUMDIG
2012      ICNT=ICNT+1
2013      ITEXT(ICNT)='Sample Maximum:'
2014      NCTEXT(ICNT)=15
2015      AVALUE(ICNT)=XMAX
2016      IDIGIT(ICNT)=NUMDIG
2017      ICNT=ICNT+1
2018      ITEXT(ICNT)=' '
2019      NCTEXT(ICNT)=0
2020      AVALUE(ICNT)=0.0
2021      IDIGIT(ICNT)=-1
2022C
2023      ICNT=ICNT+1
2024      ITEXT(ICNT)='Maximum Likelihood:'
2025      NCTEXT(ICNT)=19
2026      AVALUE(ICNT)=0.0
2027      IDIGIT(ICNT)=-1
2028      ICNT=ICNT+1
2029      ITEXT(ICNT)='Estimate of Location (Theta):'
2030      NCTEXT(ICNT)=29
2031      AVALUE(ICNT)=ALOCML
2032      IDIGIT(ICNT)=NUMDIG
2033      ICNT=ICNT+1
2034      ITEXT(ICNT)='Estimate of Scale (Sigma):'
2035      NCTEXT(ICNT)=30
2036      AVALUE(ICNT)=SCALML
2037      IDIGIT(ICNT)=NUMDIG
2038      ICNT=ICNT+1
2039      ITEXT(ICNT)='Estimate of Shape (K):'
2040      NCTEXT(ICNT)=22
2041      AVALUE(ICNT)=AKML
2042      IDIGIT(ICNT)=NUMDIG
2043C
2044CCCCC ICNT=ICNT+1
2045CCCCC ITEXT(ICNT)='Log-likelihood:'
2046CCCCC NCTEXT(ICNT)=15
2047CCCCC AVALUE(ICNT)=ALIK
2048CCCCC IDIGIT(ICNT)=-7
2049CCCCC ICNT=ICNT+1
2050CCCCC ITEXT(ICNT)='AIC:'
2051CCCCC NCTEXT(ICNT)=4
2052CCCCC AVALUE(ICNT)=AIC
2053CCCCC IDIGIT(ICNT)=-7
2054CCCCC ICNT=ICNT+1
2055CCCCC ITEXT(ICNT)='AICc:'
2056CCCCC NCTEXT(ICNT)=5
2057CCCCC AVALUE(ICNT)=AICC
2058CCCCC IDIGIT(ICNT)=-7
2059CCCCC ICNT=ICNT+1
2060CCCCC ITEXT(ICNT)='BIC:'
2061CCCCC NCTEXT(ICNT)=4
2062CCCCC AVALUE(ICNT)=BIC
2063CCCCC IDIGIT(ICNT)=-7
2064C
2065      NUMROW=ICNT
2066      DO2320I=1,NUMROW
2067        NTOT(I)=15
2068 2320 CONTINUE
2069C
2070      IFRST=.FALSE.
2071      ILAST=.FALSE.
2072      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
2073     1            AVALUE,IDIGIT,
2074     1            NTOT,NUMROW,
2075     1            ICAPSW,ICAPTY,ILAST,IFRST,
2076     1            ISUBRO,IBUGA3,IERROR)
2077C
2078 9000 CONTINUE
2079      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLAD')THEN
2080        WRITE(ICOUT,999)
2081        CALL DPWRST('XXX','WRIT')
2082        WRITE(ICOUT,9011)
2083 9011   FORMAT('***** AT THE END       OF DPMLAD--')
2084        CALL DPWRST('XXX','WRIT')
2085        WRITE(ICOUT,9012)N,IBUGA3,IERROR
2086 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
2087        CALL DPWRST('XXX','WRIT')
2088      ENDIF
2089C
2090      RETURN
2091      END
2092      SUBROUTINE DPMLAE(Y,X,N,NVAR,
2093     1                  TEMP1,TEMP2,TEMP3,DTEMP1,
2094     1                  THETMO,PMOM,THETFR,PFR,THETF2,PF2,THETML,PML,
2095     1                  ICAPSW,ICAPTY,IFORSW,MAXNXT,
2096     1                  ISUBRO,IBUGA3,IERROR)
2097C
2098C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
2099C              ESTIMATES FOR THE POLYA-AEPPLI DISTRIBUTION.
2100C
2101C              THE MOMENT ESTIMATORS ARE:
2102C
2103C                  THETAHAT = 2*XBAR**2/(s**2+XBAR)
2104C                  PHAT     = (S**2 - XBAR)/(S**2 + XBAR)
2105C
2106C              THE MEAN AND ZERO FREQUENCY ESTIMATORS ARE:
2107C
2108C                  THETAHAT = LOG(f0/N)
2109C                  PHAT     = 1 - THETHAT/XBAR
2110C
2111C              THE FIRST TWO FREQUENCIES ESTIMATORS ARE:
2112C
2113C                  THETAHAT = -LOG(f0/N)
2114C                  PHAT     = -f1/{f0*LOG(f0/N)}
2115C
2116C              THE MAXIMUM LIKELIHOOD ESTIMATES ARE THE SOLUTION
2117C              THE FOLLOWING EQUATIONS:
2118C
2119C                  XBAR - THETAHAT/(1-PHAT) = 0
2120C                  XBAR - SUM[J=1 to N][fj*(J-1)*P(J-1)/(N*P(J))} = 0
2121C
2122C              WHERE P(J) = THE POLYA-AEPPLI PDF USING THE
2123C              ESTIMATED PARAMETERS.
2124C
2125C              THERE ARE TWO CASES:
2126C
2127C              1) ONE VARIABLE CASE: Y IS RAW DATA
2128C              2) TWO VARIABLE CASE: Y IS FREQUENCY, X IS CLASS
2129C                 MID-POINT.
2130C
2131C     EXAMPLE--POLYA-AEPPLI MAXIMUM LIKELIHOOD Y
2132C            --POLYA-AEPPLI MAXIMUM LIKELIHOOD Y X
2133C     REFERENCES--JOHNSON, KOTZ, AND KEMP (1992).  "UNIVARIATE
2134C                 DISCRETE DISTRIBUTIONS", SECOND EDITION,
2135C                 WILEY, PP. 378-382.
2136C     WRITTEN BY--ALAN HECKERT
2137C                 STATISTICAL ENGINEERING DIVISION
2138C                 INFORMATION TECHNOLOGY LABORATORY
2139C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
2140C                 GAITHERSBUG, MD 20899-8980
2141C                 PHONE--301-975-2899
2142C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
2143C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
2144C     LANGUAGE--ANSI FORTRAN (1977)
2145C     VERSION NUMBER--2006/6
2146C     ORIGINAL VERSION--JUNE      2006.
2147C     UPDATED         --APRIL     2011. USE DPDTA1 TO PRINT OUTPUT
2148C
2149C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-----------------
2150C
2151      CHARACTER*4 ICAPSW
2152      CHARACTER*4 ICAPTY
2153      CHARACTER*4 IFORSW
2154      CHARACTER*4 ISUBRO
2155      CHARACTER*4 IBUGA3
2156      CHARACTER*4 IERROR
2157C
2158      CHARACTER*4 IWRITE
2159      CHARACTER*4 ISUBN1
2160      CHARACTER*4 ISUBN2
2161      CHARACTER*4 ISTEPN
2162      CHARACTER*4 IRELAT
2163      CHARACTER*4 IRHSTG
2164C
2165      PARAMETER (MAXROW=50)
2166      CHARACTER*60 ITITLE
2167      CHARACTER*1  ITITLZ
2168      CHARACTER*40 IDIST
2169      CHARACTER*40 ITEXT(MAXROW)
2170      REAL         AVALUE(MAXROW)
2171      INTEGER      NCTEXT(MAXROW)
2172      INTEGER      IDIGIT(MAXROW)
2173      INTEGER      NTOT(MAXROW)
2174      LOGICAL      IFRST
2175      LOGICAL      ILAST
2176C
2177C-------------------------------------------------------------------
2178C
2179      DIMENSION Y(*)
2180      DIMENSION X(*)
2181      DIMENSION TEMP1(*)
2182      DIMENSION TEMP2(*)
2183      DIMENSION TEMP3(*)
2184      DOUBLE PRECISION DTEMP1(*)
2185C
2186      DOUBLE PRECISION TOL
2187      DOUBLE PRECISION XPAR(2)
2188      DOUBLE PRECISION FVEC(2)
2189C
2190      EXTERNAL PAPFUN
2191      DOUBLE PRECISION XBAR
2192      COMMON/PAPCOM/MAXRO2,NTOT2,XBAR
2193C
2194C-------------------------------------------------------------------
2195C
2196      INCLUDE 'DPCOP2.INC'
2197C
2198C-----START POINT---------------------------------------------------
2199C
2200      ISUBN1='DPML'
2201      ISUBN2='AE  '
2202      IERROR='NO'
2203      IWRITE='OFF'
2204C
2205      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLAE')THEN
2206        WRITE(ICOUT,999)
2207  999   FORMAT(1X)
2208        CALL DPWRST('XXX','WRIT')
2209        WRITE(ICOUT,51)
2210   51   FORMAT('**** AT THE BEGINNING OF DPMLAE--')
2211        CALL DPWRST('XXX','WRIT')
2212        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR
2213   52   FORMAT('IBUGA3,ISUBRO,N,NVAR = ',2(A4,2X),2I8)
2214        CALL DPWRST('XXX','WRIT')
2215        IF(NVAR.EQ.1)THEN
2216          DO56I=1,MIN(N,100)
2217            WRITE(ICOUT,57)I,Y(I)
2218   57       FORMAT('I,Y(I) = ',I8,G15.7)
2219            CALL DPWRST('XXX','WRIT')
2220   56     CONTINUE
2221        ELSE
2222          DO61I=1,N
2223            WRITE(ICOUT,62)I,X(I),Y(I)
2224   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
2225            CALL DPWRST('XXX','WRIT')
2226   61     CONTINUE
2227        ENDIF
2228      ENDIF
2229C
2230C               ********************************************
2231C               **  STEP 11--                             **
2232C               **  1) ROUND DATA TO INTEGER VALUES       **
2233C               **  2) COMPUTE SUMMARY STATISTICS         **
2234C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
2235C               **     INSUFFICIENT SAMPLE SIZE           **
2236C               ********************************************
2237C
2238      ISTEPN='11'
2239      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLAE')
2240     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2241C
2242      IDIST='POLYA-AEPPLI'
2243C
2244      NPERC=0
2245      MAXGRP=MAXNXT/2
2246      NMIN=2
2247      IF(NVAR.EQ.1)THEN
2248        DO1105I=1,N
2249          ITEMP=INT(Y(I)+0.5)
2250          Y(I)=REAL(ITEMP)
2251 1105   CONTINUE
2252        CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
2253        IF(IERROR.EQ.'YES')GOTO9000
2254C
2255        IFLAG=1
2256        CALL SUMRAW(Y,N,IDIST,IFLAG,
2257     1              XMEAN,XVAR,XSD,XMIN,XMAX,
2258     1              ISUBRO,IBUGA3,IERROR)
2259        IF(IERROR.EQ.'YES')GOTO9000
2260        NTOTZZ=N
2261C
2262C       NOW BIN THE DATA FOR USE BY THE ESTIMATION METHOD BELOW
2263C
2264        IRELAT='OFF'
2265        IRHSTG='OFF'
2266        XSTART=XMIN-0.5
2267        XSTOP=XMAX+0.5
2268        CLWID=1.0
2269        CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
2270     1              TEMP1,X,N2,IBUGA3,IERROR)
2271        ICNT=0
2272        DO1121I=1,N2
2273          IF(TEMP1(I).GT.0.0)THEN
2274            ICNT=ICNT+1
2275            Y(ICNT)=TEMP1(I)
2276            X(ICNT)=X(I)
2277          ENDIF
22781121    CONTINUE
2279        N2=ICNT
2280      ELSE
2281        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
2282     1              ISUBRO,IBUGA3,IERROR)
2283        IF(IERROR.EQ.'YES')GOTO9000
2284        IFLAG1=1
2285        IFLAG2=1
2286        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
2287     1              TEMP1,TEMP2,TEMP3,MAXNXT,
2288     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
2289     1              ISUBRO,IBUGA3,IERROR)
2290        ICNT=0
2291        DO1221I=1,N
2292          IF(Y(I).GT.0.0)THEN
2293            ICNT=ICNT+1
2294            Y(ICNT)=Y(I)
2295            X(ICNT)=X(I)
2296          ENDIF
22971221    CONTINUE
2298        N2=ICNT
2299      ENDIF
2300      IF(IERROR.EQ.'YES')GOTO9000
2301C
2302      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLAE')THEN
2303        WRITE(ICOUT,999)
2304        CALL DPWRST('XXX','WRIT')
2305        WRITE(ICOUT,1311)
2306 1311   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
2307        CALL DPWRST('XXX','WRIT')
2308        WRITE(ICOUT,1312)XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ
2309 1312   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ = ',5G15.7,I10)
2310        CALL DPWRST('XXX','WRIT')
2311      ENDIF
2312C
2313C               *********************************************
2314C               **  STEP 21--                              **
2315C               **  CARRY OUT CALCULATIONS                 **
2316C               **  FOR POLYA-AEPPLI MLE ESTIMATION        **
2317C               *********************************************
2318C
2319      ISTEPN='21'
2320      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLAE')
2321     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2322C
2323      IML=0
2324      IINDX=MAXNXT/2
2325      IF(N2.LE.IINDX)THEN
2326        IWD=0
2327        DO2290I=1,N2
2328          TEMP3(I)=Y(I)
2329          TEMP3(IINDX+I)=X(I)
2330 2290   CONTINUE
2331        IK=N2
2332      ELSE
2333        IML=1
2334      ENDIF
2335C
2336      F1=Y(1)
2337      F2=Y(2)
2338C
2339      THETMO=2.0*XMEAN**2/(XVAR+XMEAN)
2340      PMOM=(XVAR - XMEAN)/(XVAR + XMEAN)
2341      THETFR=-LOG(F1/REAL(NTOTZZ))
2342      PFR=1.0 - THETFR/XMEAN
2343      THETF2=-LOG(F1/REAL(NTOTZZ))
2344      PF2=-F2/(F1*LOG(F1/REAL(NTOTZZ)))
2345      THETML=THETMO
2346      PML=PMOM
2347C
2348      IF(IML.EQ.0)THEN
2349        IOPT=2
2350        TOL=1.0D-5
2351        NPAR=2
2352        NPRINT=-1
2353        INFO=0
2354        LWA=MAXNXT
2355        MAXRO2=MAXNXT
2356        NTOT2=NTOTZZ
2357C
2358        XBAR=DBLE(XMEAN)
2359        XPAR(1)=DBLE(THETML)
2360        XPAR(2)=DBLE(PML)
2361        CALL DNSQE(PAPFUN,JAC,IOPT,NPAR,XPAR,FVEC,TOL,NPRINT,INFO,
2362     1             DTEMP1,LWA,TEMP3,IK)
2363C
2364        THETML=REAL(XPAR(1))
2365        PML=REAL(XPAR(2))
2366      ENDIF
2367C
2368C               ***********************************************
2369C               **   STEP 42--                               **
2370C               **   WRITE OUT EVERYTHING                    **
2371C               **   FOR POLYA-AEPPLI MLE ESTIMATION         **
2372C               ***********************************************
2373C
2374      ISTEPN='42'
2375      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLAE')
2376     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2377C
2378C     PRINT SUMMARY STATISTICS TABLE
2379C
2380      NUMDIG=7
2381      IF(IFORSW.EQ.'1')NUMDIG=1
2382      IF(IFORSW.EQ.'2')NUMDIG=2
2383      IF(IFORSW.EQ.'3')NUMDIG=3
2384      IF(IFORSW.EQ.'4')NUMDIG=4
2385      IF(IFORSW.EQ.'5')NUMDIG=5
2386      IF(IFORSW.EQ.'6')NUMDIG=6
2387      IF(IFORSW.EQ.'7')NUMDIG=7
2388      IF(IFORSW.EQ.'8')NUMDIG=8
2389      IF(IFORSW.EQ.'9')NUMDIG=9
2390      IF(IFORSW.EQ.'0')NUMDIG=0
2391      IF(IFORSW.EQ.'E')NUMDIG=-2
2392      IF(IFORSW.EQ.'-2')NUMDIG=-2
2393      IF(IFORSW.EQ.'-3')NUMDIG=-3
2394      IF(IFORSW.EQ.'-4')NUMDIG=-4
2395      IF(IFORSW.EQ.'-5')NUMDIG=-5
2396      IF(IFORSW.EQ.'-6')NUMDIG=-6
2397      IF(IFORSW.EQ.'-7')NUMDIG=-7
2398      IF(IFORSW.EQ.'-8')NUMDIG=-8
2399      IF(IFORSW.EQ.'-9')NUMDIG=-9
2400C
2401      ITITLE='Polya-Aeppli Parameter Estimation'
2402      NCTITL=33
2403      ITITLZ=' '
2404      NCTITZ=0
2405C
2406      ICNT=1
2407      ITEXT(ICNT)='Summary Statistics:'
2408      NCTEXT(ICNT)=19
2409      AVALUE(ICNT)=0.0
2410      IDIGIT(ICNT)=-1
2411      ICNT=ICNT+1
2412      ITEXT(ICNT)='Number of Observations:'
2413      NCTEXT(ICNT)=23
2414      AVALUE(ICNT)=REAL(NTOTZZ)
2415      IDIGIT(ICNT)=0
2416      ICNT=ICNT+1
2417      ITEXT(ICNT)='Sample Mean:'
2418      NCTEXT(ICNT)=12
2419      AVALUE(ICNT)=XMEAN
2420      IDIGIT(ICNT)=NUMDIG
2421      ICNT=ICNT+1
2422      ITEXT(ICNT)='Sample Standard Deviation:'
2423      NCTEXT(ICNT)=26
2424      AVALUE(ICNT)=XSD
2425      IDIGIT(ICNT)=NUMDIG
2426      ICNT=ICNT+1
2427      ITEXT(ICNT)='Sample Minimum:'
2428      NCTEXT(ICNT)=15
2429      AVALUE(ICNT)=XMIN
2430      IDIGIT(ICNT)=NUMDIG
2431      ICNT=ICNT+1
2432      ITEXT(ICNT)='Sample Maximum:'
2433      NCTEXT(ICNT)=15
2434      AVALUE(ICNT)=XMAX
2435      IDIGIT(ICNT)=NUMDIG
2436      ICNT=ICNT+1
2437      ITEXT(ICNT)='Sample First Frequency:'
2438      NCTEXT(ICNT)=23
2439      AVALUE(ICNT)=F1
2440      IDIGIT(ICNT)=NUMDIG
2441      ICNT=ICNT+1
2442      ITEXT(ICNT)='Sample Second Frequency:'
2443      NCTEXT(ICNT)=24
2444      AVALUE(ICNT)=F2
2445      IDIGIT(ICNT)=NUMDIG
2446      ICNT=ICNT+1
2447      ITEXT(ICNT)=' '
2448      NCTEXT(ICNT)=0
2449      AVALUE(ICNT)=0.0
2450      IDIGIT(ICNT)=-1
2451C
2452      ICNT=ICNT+1
2453      ITEXT(ICNT)='Method of Moments:'
2454      NCTEXT(ICNT)=18
2455      AVALUE(ICNT)=0.0
2456      IDIGIT(ICNT)=-1
2457      ICNT=ICNT+1
2458      ITEXT(ICNT)='Estimate of Theta:'
2459      NCTEXT(ICNT)=18
2460      AVALUE(ICNT)=THETMO
2461      IDIGIT(ICNT)=NUMDIG
2462      ICNT=ICNT+1
2463      ITEXT(ICNT)='Estimate of P:'
2464      NCTEXT(ICNT)=14
2465      AVALUE(ICNT)=PMOM
2466      IDIGIT(ICNT)=NUMDIG
2467      ICNT=ICNT+1
2468      ITEXT(ICNT)=' '
2469      NCTEXT(ICNT)=0
2470      AVALUE(ICNT)=0.0
2471      IDIGIT(ICNT)=-1
2472C
2473      ICNT=ICNT+1
2474      ITEXT(ICNT)='Method of Zero Frequency and Mean:'
2475      NCTEXT(ICNT)=34
2476      AVALUE(ICNT)=0.0
2477      IDIGIT(ICNT)=-1
2478      ICNT=ICNT+1
2479      ITEXT(ICNT)='Estimate of Theta:'
2480      NCTEXT(ICNT)=18
2481      AVALUE(ICNT)=THETFR
2482      IDIGIT(ICNT)=NUMDIG
2483      ICNT=ICNT+1
2484      ITEXT(ICNT)='Estimate of P:'
2485      NCTEXT(ICNT)=14
2486      AVALUE(ICNT)=PFR
2487      IDIGIT(ICNT)=NUMDIG
2488      ICNT=ICNT+1
2489      ITEXT(ICNT)=' '
2490      NCTEXT(ICNT)=0
2491      AVALUE(ICNT)=0.0
2492      IDIGIT(ICNT)=-1
2493C
2494      ICNT=ICNT+1
2495      ITEXT(ICNT)='Method of First Two Frequencies:'
2496      NCTEXT(ICNT)=32
2497      AVALUE(ICNT)=0.0
2498      IDIGIT(ICNT)=-1
2499      ICNT=ICNT+1
2500      ITEXT(ICNT)='Estimate of Theta:'
2501      NCTEXT(ICNT)=18
2502      AVALUE(ICNT)=THETF2
2503      IDIGIT(ICNT)=NUMDIG
2504      ICNT=ICNT+1
2505      ITEXT(ICNT)='Estimate of P:'
2506      NCTEXT(ICNT)=14
2507      AVALUE(ICNT)=PF2
2508      IDIGIT(ICNT)=NUMDIG
2509      ICNT=ICNT+1
2510      ITEXT(ICNT)=' '
2511      NCTEXT(ICNT)=0
2512      AVALUE(ICNT)=0.0
2513      IDIGIT(ICNT)=-1
2514C
2515      ICNT=ICNT+1
2516      ITEXT(ICNT)='Method of Maximum Likelihood:'
2517      NCTEXT(ICNT)=29
2518      AVALUE(ICNT)=0.0
2519      IDIGIT(ICNT)=-1
2520      ICNT=ICNT+1
2521      ITEXT(ICNT)='Estimate of Theta:'
2522      NCTEXT(ICNT)=18
2523      AVALUE(ICNT)=THETML
2524      IDIGIT(ICNT)=NUMDIG
2525      ICNT=ICNT+1
2526      ITEXT(ICNT)='Estimate of P:'
2527      NCTEXT(ICNT)=14
2528      AVALUE(ICNT)=PML
2529      IDIGIT(ICNT)=NUMDIG
2530      ICNT=ICNT+1
2531      ITEXT(ICNT)=' '
2532      NCTEXT(ICNT)=0
2533      AVALUE(ICNT)=0.0
2534      IDIGIT(ICNT)=-1
2535C
2536      NUMROW=ICNT
2537      DO2310I=1,NUMROW
2538        NTOT(I)=15
2539 2310 CONTINUE
2540C
2541      IFRST=.TRUE.
2542      ILAST=.TRUE.
2543      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
2544     1            AVALUE,IDIGIT,
2545     1            NTOT,NUMROW,
2546     1            ICAPSW,ICAPTY,ILAST,IFRST,
2547     1            ISUBRO,IBUGA3,IERROR)
2548C
2549C               *****************
2550C               **  STEP 90--  **
2551C               **  EXIT       **
2552C               *****************
2553C
2554 9000 CONTINUE
2555      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLAE')THEN
2556        WRITE(ICOUT,999)
2557        CALL DPWRST('XXX','WRIT')
2558        WRITE(ICOUT,9011)
2559 9011   FORMAT('***** AT THE END       OF DPMLAE--')
2560        CALL DPWRST('XXX','WRIT')
2561        WRITE(ICOUT,9012)IERROR
2562 9012   FORMAT('IERROR = ',A4)
2563        CALL DPWRST('XXX','WRIT')
2564      ENDIF
2565C
2566      RETURN
2567      END
2568      SUBROUTINE DPMLAL(Y,N,MAXNXT,
2569     1                  TEMP1,TEMP2,DISPAR,DTEMP,ITEMP,
2570     1                  ALPHSV,SCALSV,
2571     1                  SCALML,ALPHML,SCALMO,ALPHMO,
2572     1                  ICAPSW,ICAPTY,IFORSW,
2573     1                  ISUBRO,IBUGA3,IERROR)
2574C
2575C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
2576C              FOR THE ALPHA DISTRIBUTION FOR THE FULL SAMPLE CASE.
2577C     EXAMPLE--ALPHA MAXIMUM LIKELIHOOD Y
2578C     REFERENCE--JOHNSON, KOTZ, AND BALAKRISHNAN (1994), "CONTINUOUS
2579C                UNIVARIATE DISTRIBUTIONS--VOLUME I", SECOND EDITION,
2580C                WILEY, P. 173.
2581C              --SALVIA (1985), "RELIABILITY APPLICATIONS OF THE
2582C                ALPHA DISTRIBUTION", IEEE TRANSACTIONS ON
2583C                RELIABILITY, VOL. R-34, NO. 3, PP. 251-252.
2584C     WRITTEN BY--ALAN HECKERT
2585C                 STATISTICAL ENGINEERING DIVISION
2586C                 INFORMATION TECHNOLOGY LABORATORY
2587C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
2588C                 GAITHERSBURG, MD 20899-8980
2589C                 PHONE--301-975-2899
2590C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
2591C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
2592C     LANGUAGE--ANSI FORTRAN (1977)
2593C     VERSION NUMBER--2007/12
2594C     ORIGINAL VERSION--DECEMBER  2007.
2595C     UPDATED         --JULY      2010. USE DPDTA1 TO PRINT OUTPUT
2596C     UPDATED         --JULY      2010. EXTRACT POINT ESTIMATES TO
2597C                                       ALPML1
2598C
2599C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
2600C
2601      CHARACTER*4 ICAPSW
2602      CHARACTER*4 ICAPTY
2603      CHARACTER*4 IFORSW
2604C
2605      CHARACTER*4 ISUBRO
2606      CHARACTER*4 IBUGA3
2607      CHARACTER*4 IERROR
2608      CHARACTER*4 IWRITE
2609C
2610      CHARACTER*4 ISUBN1
2611      CHARACTER*4 ISUBN2
2612      CHARACTER*4 ISTEPN
2613C
2614C---------------------------------------------------------------------
2615C
2616      DIMENSION Y(*)
2617      DIMENSION TEMP1(*)
2618      DIMENSION TEMP2(*)
2619      DIMENSION DISPAR(*)
2620      DOUBLE PRECISION DTEMP(*)
2621      INTEGER ITEMP(*)
2622      DIMENSION QP(1)
2623C
2624      INCLUDE 'DPCOST.INC'
2625C
2626      PARAMETER (MAXROW=20)
2627      CHARACTER*40 ITITLE
2628      CHARACTER*1  ITITLZ
2629      CHARACTER*40 ITEXT(MAXROW)
2630      REAL         AVALUE(MAXROW)
2631      INTEGER      NCTEXT(MAXROW)
2632      INTEGER      IDIGIT(MAXROW)
2633      INTEGER      NTOT(MAXROW)
2634      LOGICAL IFRST
2635      LOGICAL ILAST
2636C
2637C---------------------------------------------------------------------
2638C
2639      INCLUDE 'DPCOP2.INC'
2640C
2641C-----START POINT-----------------------------------------------------
2642C
2643      ISUBN1='DPML'
2644      ISUBN2='AL  '
2645      IERROR='NO'
2646C
2647      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLAL')THEN
2648        WRITE(ICOUT,999)
2649  999   FORMAT(1X)
2650        CALL DPWRST('XXX','WRIT')
2651        WRITE(ICOUT,51)
2652   51   FORMAT('**** AT THE BEGINNING OF DPMLAL--')
2653        CALL DPWRST('XXX','WRIT')
2654        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,MAXNXT,ITEMP(1)
2655   52   FORMAT('IBUGA3,ISUBRO,N,MAXNXT,ITEMP(1) = ',2(A4,2X),3I8)
2656        CALL DPWRST('XXX','WRIT')
2657        DO56I=1,MIN(N,100)
2658          WRITE(ICOUT,57)I,Y(I)
2659   57     FORMAT('I,Y(I) = ',I8,G15.7)
2660          CALL DPWRST('XXX','WRIT')
2661   56   CONTINUE
2662      ENDIF
2663C
2664C               ********************************************
2665C               **  STEP 11--                             **
2666C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
2667C               ********************************************
2668C
2669      ISTEPN='11'
2670      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLAL')
2671     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2672C
2673      NPERC=0
2674      NMIN=3
2675      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
2676      IF(IERROR.EQ.'YES')GOTO9000
2677C
2678C  COMPUTE SUMMARY STATISTICS.
2679C
2680      IERROR='NO'
2681      IWRITE='OFF'
2682C
2683      CALL ALPML1(Y,N,ALPHSV,SCALSV,MAXNXT,
2684     1            TEMP1,TEMP2,DISPAR,DTEMP,
2685     1            XMEAN,XSD,XVAR,XMIN,XMAX,
2686     1            ALPHMO,SCALMO,ALPHML,SCALML,
2687     1            ISUBRO,IBUGA3,IERROR)
2688C
2689C               *******************************************
2690C               **   STEP 42--                           **
2691C               **   WRITE OUT EVERYTHING                **
2692C               **   FOR ALPHA MLE ESTIMATE              **
2693C               *******************************************
2694C
2695      ISTEPN='42'
2696      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLAL')
2697     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2698C
2699      IF(IPRINT.EQ.'OFF')GOTO9000
2700C
2701      NUMDIG=7
2702      IF(IFORSW.EQ.'1')NUMDIG=1
2703      IF(IFORSW.EQ.'2')NUMDIG=2
2704      IF(IFORSW.EQ.'3')NUMDIG=3
2705      IF(IFORSW.EQ.'4')NUMDIG=4
2706      IF(IFORSW.EQ.'5')NUMDIG=5
2707      IF(IFORSW.EQ.'6')NUMDIG=6
2708      IF(IFORSW.EQ.'7')NUMDIG=7
2709      IF(IFORSW.EQ.'8')NUMDIG=8
2710      IF(IFORSW.EQ.'9')NUMDIG=9
2711      IF(IFORSW.EQ.'0')NUMDIG=0
2712      IF(IFORSW.EQ.'E')NUMDIG=-2
2713      IF(IFORSW.EQ.'-2')NUMDIG=-2
2714      IF(IFORSW.EQ.'-3')NUMDIG=-3
2715      IF(IFORSW.EQ.'-4')NUMDIG=-4
2716      IF(IFORSW.EQ.'-5')NUMDIG=-5
2717      IF(IFORSW.EQ.'-6')NUMDIG=-6
2718      IF(IFORSW.EQ.'-7')NUMDIG=-7
2719      IF(IFORSW.EQ.'-8')NUMDIG=-8
2720      IF(IFORSW.EQ.'-9')NUMDIG=-9
2721C
2722      ITITLE='Alpha Parameter Estimation'
2723      NCTITL=26
2724      ITITLZ=' '
2725      NCTITZ=0
2726      ICNT=1
2727      ITEXT(ICNT)='Summary Statistics:'
2728      NCTEXT(ICNT)=19
2729      AVALUE(ICNT)=0.0
2730      IDIGIT(ICNT)=-1
2731      ICNT=ICNT+1
2732      ITEXT(ICNT)='Number of Observations:'
2733      NCTEXT(ICNT)=23
2734      AVALUE(ICNT)=REAL(N)
2735      IDIGIT(ICNT)=0
2736      ICNT=ICNT+1
2737      ITEXT(ICNT)='Sample Mean:'
2738      NCTEXT(ICNT)=12
2739      AVALUE(ICNT)=XMEAN
2740      IDIGIT(ICNT)=NUMDIG
2741      ICNT=ICNT+1
2742      ITEXT(ICNT)='Sample Standard Deviation:'
2743      NCTEXT(ICNT)=26
2744      AVALUE(ICNT)=XSD
2745      IDIGIT(ICNT)=NUMDIG
2746      ICNT=ICNT+1
2747      ITEXT(ICNT)='Sample Minimum:'
2748      NCTEXT(ICNT)=15
2749      AVALUE(ICNT)=XMIN
2750      IDIGIT(ICNT)=NUMDIG
2751      ICNT=ICNT+1
2752      ITEXT(ICNT)='Sample Maximum:'
2753      NCTEXT(ICNT)=15
2754      AVALUE(ICNT)=XMAX
2755      IDIGIT(ICNT)=NUMDIG
2756      ICNT=ICNT+1
2757      ITEXT(ICNT)=' '
2758      NCTEXT(ICNT)=0
2759      AVALUE(ICNT)=0.0
2760      IDIGIT(ICNT)=-1
2761C
2762      ICNT=ICNT+1
2763      ITEXT(ICNT)='Moments:'
2764      NCTEXT(ICNT)=8
2765      AVALUE(ICNT)=0.0
2766      IDIGIT(ICNT)=-1
2767      ICNT=ICNT+1
2768      ITEXT(ICNT)='Estimate of Shape (Alpha):'
2769      NCTEXT(ICNT)=26
2770      AVALUE(ICNT)=ALPHMO
2771      IDIGIT(ICNT)=NUMDIG
2772      ICNT=ICNT+1
2773      ITEXT(ICNT)='Estimate of Scale (Beta):'
2774      NCTEXT(ICNT)=25
2775      AVALUE(ICNT)=SCALMO
2776      IDIGIT(ICNT)=NUMDIG
2777CCCCC ICNT=ICNT+1
2778CCCCC ITEXT(ICNT)='Log-likelihood:'
2779CCCCC NCTEXT(ICNT)=15
2780CCCCC AVALUE(ICNT)=ALIKMO
2781CCCCC IDIGIT(ICNT)=-7
2782CCCCC ICNT=ICNT+1
2783CCCCC ITEXT(ICNT)='AIC:'
2784CCCCC NCTEXT(ICNT)=4
2785CCCCC AVALUE(ICNT)=AICMO
2786CCCCC IDIGIT(ICNT)=-7
2787CCCCC ICNT=ICNT+1
2788CCCCC ITEXT(ICNT)='AICc:'
2789CCCCC NCTEXT(ICNT)=5
2790CCCCC AVALUE(ICNT)=AICCMO
2791CCCCC IDIGIT(ICNT)=-7
2792CCCCC ICNT=ICNT+1
2793CCCCC ITEXT(ICNT)='BIC:'
2794CCCCC NCTEXT(ICNT)=4
2795CCCCC AVALUE(ICNT)=BICMO
2796CCCCC IDIGIT(ICNT)=-7
2797      ICNT=ICNT+1
2798      ITEXT(ICNT)=' '
2799      NCTEXT(ICNT)=0
2800      AVALUE(ICNT)=0.0
2801      IDIGIT(ICNT)=-1
2802C
2803      ICNT=ICNT+1
2804      ITEXT(ICNT)='Maximum Likelihood:'
2805      NCTEXT(ICNT)=19
2806      AVALUE(ICNT)=0.0
2807      IDIGIT(ICNT)=-1
2808      ICNT=ICNT+1
2809      ITEXT(ICNT)='Estimate of Shape (Alpha):'
2810      NCTEXT(ICNT)=26
2811      AVALUE(ICNT)=ALPHML
2812      IDIGIT(ICNT)=NUMDIG
2813      ICNT=ICNT+1
2814      ITEXT(ICNT)='Estimate of Scale (Beta):'
2815      NCTEXT(ICNT)=25
2816      AVALUE(ICNT)=SCALML
2817      IDIGIT(ICNT)=NUMDIG
2818C
2819CCCCC ICNT=ICNT+1
2820CCCCC ITEXT(ICNT)='Log-likelihood:'
2821CCCCC NCTEXT(ICNT)=15
2822CCCCC AVALUE(ICNT)=ALIKML
2823CCCCC IDIGIT(ICNT)=-7
2824CCCCC ICNT=ICNT+1
2825CCCCC ITEXT(ICNT)='AIC:'
2826CCCCC NCTEXT(ICNT)=4
2827CCCCC AVALUE(ICNT)=AICML
2828CCCCC IDIGIT(ICNT)=-7
2829CCCCC ICNT=ICNT+1
2830CCCCC ITEXT(ICNT)='AICc:'
2831CCCCC NCTEXT(ICNT)=5
2832CCCCC AVALUE(ICNT)=AICCML
2833CCCCC IDIGIT(ICNT)=-7
2834CCCCC ICNT=ICNT+1
2835CCCCC ITEXT(ICNT)='BIC:'
2836CCCCC NCTEXT(ICNT)=4
2837CCCCC AVALUE(ICNT)=BICML
2838CCCCC IDIGIT(ICNT)=-7
2839C
2840      NUMROW=ICNT
2841      DO2320I=1,NUMROW
2842        NTOT(I)=15
2843 2320 CONTINUE
2844C
2845      IFRST=.FALSE.
2846      ILAST=.FALSE.
2847      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
2848     1            AVALUE,IDIGIT,
2849     1            NTOT,NUMROW,
2850     1            ICAPSW,ICAPTY,ILAST,IFRST,
2851     1            ISUBRO,IBUGA3,IERROR)
2852C
2853C               *****************
2854C               **  STEP 90--  **
2855C               **  EXIT       **
2856C               *****************
2857C
2858 9000 CONTINUE
2859      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLAL')THEN
2860        WRITE(ICOUT,999)
2861        CALL DPWRST('XXX','WRIT')
2862        WRITE(ICOUT,9011)
2863 9011   FORMAT('***** AT THE END       OF DPMLAL--')
2864        CALL DPWRST('XXX','WRIT')
2865        WRITE(ICOUT,9012)N,IBUGA3,IERROR
2866 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
2867        CALL DPWRST('XXX','WRIT')
2868        WRITE(ICOUT,9015)N
2869 9015   FORMAT('N = ',I8)
2870        CALL DPWRST('XXX','WRIT')
2871      ENDIF
2872C
2873      RETURN
2874      END
2875      SUBROUTINE DPMLBB(Y,X,N,NVAR,NTRIAL,
2876     1                  TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,
2877     1                  DTEMP1,DTEMP2,ITEMP1,ITEMP2,ITEMP3,MAXNXT,
2878     1                  AMUML,THETML,ALPHML,BETAML,
2879     1                  ICASAN,ICAPSW,ICAPTY,IFORSW,
2880     1                  ISUBRO,IBUGA3,IERROR)
2881C
2882C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
2883C              ESTIMATES FOR THE BETA-BINOMIAL DISTRIBUTION
2884C     EXAMPLE--BETA-BINOMIAL MAXIMUM LIKELIHOOD Y
2885C     REFERENCE--XX
2886C     WRITTEN BY--ALAN HECKERT
2887C                 STATISTICAL ENGINEERING DIVISION
2888C                 INFORMATION TECHNOLOGY LABORATORY
2889C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
2890C                 GAITHERSBUG, MD 20899-8980
2891C                 PHONE--301-975-2899
2892C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
2893C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
2894C     LANGUAGE--ANSI FORTRAN (1977)
2895C     VERSION NUMBER--2011/4
2896C     ORIGINAL VERSION--APRIL     2011. EXTRACTED AS DISTINCT
2897C                                       SUBROUTINE
2898C
2899C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
2900C
2901      CHARACTER*4 ICASAN
2902      CHARACTER*4 ICAPSW
2903      CHARACTER*4 ICAPTY
2904      CHARACTER*4 IFORSW
2905CCCCC CHARACTER*4 IBGEDF
2906      CHARACTER*4 ISUBRO
2907      CHARACTER*4 IBUGA3
2908      CHARACTER*4 IERROR
2909C
2910      CHARACTER*4 IWRITE
2911      CHARACTER*4 ISUBN1
2912      CHARACTER*4 ISUBN2
2913      CHARACTER*4 ISTEPN
2914C
2915C---------------------------------------------------------------------
2916C
2917      DIMENSION Y(*)
2918      DIMENSION X(*)
2919      DIMENSION TEMP1(*)
2920      DIMENSION TEMP2(*)
2921      DIMENSION TEMP3(*)
2922      DIMENSION TEMP4(*)
2923      DIMENSION TEMP5(*)
2924      DOUBLE PRECISION DTEMP1(*)
2925      DOUBLE PRECISION DTEMP2(*)
2926      INTEGER ITEMP1(*)
2927      INTEGER ITEMP2(*)
2928      INTEGER ITEMP3(*)
2929C
2930      PARAMETER (NUMALP=6)
2931      DIMENSION ALPHA(NUMALP)
2932      DIMENSION ALOWSC(NUMALP)
2933      DIMENSION AUPPSC(NUMALP)
2934      DIMENSION ALOWGA(NUMALP)
2935      DIMENSION AUPPGA(NUMALP)
2936C
2937CCCCC DOUBLE PRECISION DSUM1
2938CCCCC DOUBLE PRECISION DSUM2
2939      DOUBLE PRECISION CCRIT
2940      DOUBLE PRECISION DMEW
2941      DOUBLE PRECISION DTHETA
2942      DOUBLE PRECISION SEM
2943      DOUBLE PRECISION SETH
2944      DOUBLE PRECISION RNL
2945C
2946      PARAMETER (MAXROW=30)
2947      CHARACTER*60 ITITLE
2948      CHARACTER*1  ITITLZ
2949      CHARACTER*40 IDIST
2950      CHARACTER*40 ITEXT(MAXROW)
2951      REAL         AVALUE(MAXROW)
2952      INTEGER      NCTEXT(MAXROW)
2953      INTEGER      IDIGIT(MAXROW)
2954      INTEGER      NTOT(MAXROW)
2955      LOGICAL      IFRST
2956      LOGICAL      ILAST
2957C
2958C---------------------------------------------------------------------
2959C
2960      INCLUDE 'DPCOP2.INC'
2961C
2962C-----START POINT-----------------------------------------------------
2963C
2964      ISUBN1='DPML'
2965      ISUBN2='BB  '
2966      IERROR='NO'
2967      IWRITE='OFF'
2968C
2969      DO11I=1,NUMALP
2970        ALOWGA(I)=CPUMIN
2971        AUPPGA(I)=CPUMIN
2972        ALOWSC(I)=CPUMIN
2973        AUPPSC(I)=CPUMIN
2974   11 CONTINUE
2975       TEMP5(I)=0.0
2976C
2977      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBB')THEN
2978        WRITE(ICOUT,999)
2979  999   FORMAT(1X)
2980        CALL DPWRST('XXX','WRIT')
2981        WRITE(ICOUT,51)
2982   51   FORMAT('**** AT THE BEGINNING OF DPMLBB--')
2983        CALL DPWRST('XXX','WRIT')
2984        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR,THETML
2985   52   FORMAT('IBUGA3,ISUBRO,N,NVAR,THETML = ',2(A4,2X),2I8,G15.7)
2986        CALL DPWRST('XXX','WRIT')
2987        IF(NVAR.EQ.1)THEN
2988          DO56I=1,MIN(N,100)
2989            WRITE(ICOUT,57)I,Y(I)
2990   57       FORMAT('I,Y(I) = ',I8,G15.7)
2991            CALL DPWRST('XXX','WRIT')
2992   56     CONTINUE
2993        ELSE
2994          DO61I=1,N
2995            WRITE(ICOUT,62)I,X(I),Y(I)
2996   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
2997            CALL DPWRST('XXX','WRIT')
2998   61     CONTINUE
2999        ENDIF
3000      ENDIF
3001C
3002C               ********************************************
3003C               **  STEP 11--                             **
3004C               **  1) ROUND DATA TO INTEGER VALUES       **
3005C               **  2) COMPUTE SUMMARY STATISTICS         **
3006C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
3007C               **     INSUFFICIENT SAMPLE SIZE           **
3008C               ********************************************
3009C
3010      ISTEPN='11'
3011      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLBB')
3012     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3013C
3014      IDIST='BETA BINOMIAL'
3015C
3016      NPERC=0
3017      MAXGRP=MAXNXT
3018      NMIN=3
3019      IF(NVAR.EQ.1)THEN
3020        DO1105I=1,N
3021          ITEMP=INT(Y(I)+0.5)
3022          Y(I)=REAL(ITEMP)
3023 1105   CONTINUE
3024        CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
3025        IF(IERROR.EQ.'YES')GOTO9000
3026C
3027        IFLAG=1
3028        CALL SUMRAW(Y,N,IDIST,IFLAG,
3029     1              XMEAN,XVAR,XSD,XMIN,XMAX,
3030     1              ISUBRO,IBUGA3,IERROR)
3031        IF(IERROR.EQ.'YES')GOTO9000
3032        NTOTZZ=N
3033      ELSE
3034        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
3035     1              ISUBRO,IBUGA3,IERROR)
3036        IF(IERROR.EQ.'YES')GOTO9000
3037        IFLAG1=1
3038        IFLAG2=1
3039        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
3040     1              TEMP1,TEMP2,TEMP3,MAXNXT,
3041     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
3042     1              ISUBRO,IBUGA3,IERROR)
3043        CALL DPRAW(X,Y,N,IWRITE,MAXNXT,TEMP4,NTOTZZ,IBUGA3,IERROR)
3044C
3045C       COPY UNBINNED DATA TO Y
3046C
3047        DO1220I=1,NTOTZZ
3048          Y(I)=TEMP4(I)
30491220    CONTINUE
3050        N=NTOTZZ
3051      ENDIF
3052      IF(IERROR.EQ.'YES')GOTO9000
3053C
3054      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLBB')THEN
3055        WRITE(ICOUT,999)
3056        CALL DPWRST('XXX','WRIT')
3057        WRITE(ICOUT,1311)
3058 1311   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
3059        CALL DPWRST('XXX','WRIT')
3060        WRITE(ICOUT,1312)XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ
3061 1312   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ = ',5G15.7,I10)
3062        CALL DPWRST('XXX','WRIT')
3063      ENDIF
3064C
3065C               ***************************************************
3066C               **  STEP 21--                                    **
3067C               **  CARRY OUT CALCULATIONS                       **
3068C               **  FOR BETA-BINOMIAL MOMENT/MLE ESTIMATION      **
3069C               ***************************************************
3070C
3071      ISTEPN='21'
3072      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBB')
3073     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3074C
3075      DO4410J=1,N
3076        ITEMP1(J)=INT(Y(J)+0.5)
3077        ITEMP2(J)=NTRIAL
3078        DTEMP1(J)=0.0D0
3079        DTEMP2(J)=0.0D0
3080 4410 CONTINUE
3081C
3082      DO4430I=1,N
3083        IF(ITEMP1(I).GT.ITEMP2(I))THEN
3084          WRITE(ICOUT,999)
3085          CALL DPWRST('XXX','BUG ')
3086          IF(ICASAN.EQ.'BBML')THEN
3087            WRITE(ICOUT,4421)
3088 4421       FORMAT('***** ERROR: BETA-BINOMIAL MAXIMUM LIKEHOOD ',
3089     1             'ESTIMATION--')
3090          ELSE
3091            WRITE(ICOUT,4422)
3092 4422       FORMAT('***** ERROR: POLYA MAXIMUM LIKEHOOD ESTIMATION--')
3093          ENDIF
3094          CALL DPWRST('XXX','BUG ')
3095          WRITE(ICOUT,4423)I,ITEMP1(I)
3096 4423     FORMAT('        FOR ROW ',I8,', THE NUMBER OF SUCCESSES (',
3097     1           I8,') IS')
3098          CALL DPWRST('XXX','BUG ')
3099          WRITE(ICOUT,4425)ITEMP2(I)
3100 4425     FORMAT('        GREATER THAN THE NUMBER OF TRIALS (',I8,')')
3101          CALL DPWRST('XXX','BUG ')
3102          IERROR='YES'
3103          GOTO9000
3104        ELSEIF(ITEMP2(I).LE.0)THEN
3105          WRITE(ICOUT,999)
3106          CALL DPWRST('XXX','BUG ')
3107          IF(ICASAN.EQ.'BBML')THEN
3108            WRITE(ICOUT,4421)
3109          ELSE
3110            WRITE(ICOUT,4422)
3111          ENDIF
3112          CALL DPWRST('XXX','BUG ')
3113          WRITE(ICOUT,4438)I,ITEMP1(I)
3114 4438     FORMAT('        FOR ROW ',I8,', THE NUMBER OF TRIALS IS ',
3115     1           'NON-POSITIVE.')
3116          CALL DPWRST('XXX','BUG ')
3117        ENDIF
3118 4430 CONTINUE
3119C
3120      MRL=MAXNXT
3121      ITER=1000
3122      CCRIT=1.0D-4
3123      DMEW=0.0D0
3124      DTHETA=0.0D0
3125      SEM=0.0D0
3126      SETH=0.0D0
3127      RNL=0.0D0
3128      IFAULT=0
3129C
3130      CALL BBNML(NS1,ITEMP1,ITEMP2,DTEMP1,DTEMP2,ITEMP3,MRL,
3131     1          ITER,CCRIT,DMEW,DTHETA,SEM,SETH,RNL,IFAULT)
3132      IF(ICASAN.EQ.'PZML')THEN
3133        ALPHA=DMEW/DTHETA
3134        BETA=(1.0D0 - DMEW)/DTHETA
3135      ELSE
3136        BETA=DMEW/DTHETA
3137        ALPHA=(1.0D0 - DMEW)/DTHETA
3138      ENDIF
3139      AMUML=REAL(DMEW)
3140C
3141      IF(IFAULT.GE.1)THEN
3142        WRITE(ICOUT,999)
3143        CALL DPWRST('XXX','BUG ')
3144        IF(ICASAN.EQ.'BBML')THEN
3145          WRITE(ICOUT,4421)
3146        ELSE
3147          WRITE(ICOUT,4422)
3148        ENDIF
3149        CALL DPWRST('XXX','BUG ')
3150      ENDIF
3151C
3152      IF(IFAULT.EQ.1)THEN
3153        WRITE(ICOUT,1113)
3154 1113   FORMAT('        THE NUMBER OF OBSERVATIONS IS <= 1.')
3155        CALL DPWRST('XXX','BUG ')
3156        IERROR='YES'
3157        GOTO9000
3158      ELSEIF(IFAULT.EQ.2)THEN
3159        WRITE(ICOUT,1123)
3160 1123   FORMAT(
3161     1'      THE NUMBER OF SUCCESSES IS ZERO FOR ALL OBSERVATIONS.')
3162        CALL DPWRST('XXX','BUG ')
3163        IERROR='YES'
3164        GOTO9000
3165      ELSEIF(IFAULT.EQ.3)THEN
3166        WRITE(ICOUT,1133)
3167 1133   FORMAT('        THE NUMBER OF SUCCESSES IS EQUAL TO THE ',
3168     1         'NUMBER OF ')
3169        CALL DPWRST('XXX','BUG ')
3170        WRITE(ICOUT,1135)
3171 1135   FORMAT('        TRIALS FOR ALL OBSERVATIONS.')
3172        CALL DPWRST('XXX','BUG ')
3173        IERROR='YES'
3174        GOTO9000
3175      ELSEIF(IFAULT.EQ.4)THEN
3176        WRITE(ICOUT,1143)MAXNXT
3177 1143   FORMAT('        THE NUMBER OF SUCCESSES IS GREATER THAN ',I8)
3178        CALL DPWRST('XXX','BUG ')
3179        IERROR='YES'
3180        GOTO9000
3181      ELSEIF(IFAULT.EQ.5)THEN
3182        IERROR='YES'
3183        GOTO9000
3184      ELSEIF(IFAULT.EQ.6 .OR. IFAULT.EQ.8)THEN
3185        WRITE(ICOUT,1163)MAXNXT
3186 1163   FORMAT('        NUMERICAL DIFFICULTIES ENCOUNTERED.')
3187        CALL DPWRST('XXX','BUG ')
3188        IERROR='YES'
3189        GOTO9000
3190      ELSEIF(IFAULT.EQ.7)THEN
3191        WRITE(ICOUT,1173)ITER
3192 1173   FORMAT('        MAXIMUM NUMBER OF ITERATIONS, ',I8,
3193     1         ', EXCEEDED.')
3194        CALL DPWRST('XXX','BUG ')
3195        IERROR='YES'
3196        GOTO9000
3197      ENDIF
3198C
3199C               ***********************************************
3200C               **   STEP 42--                               **
3201C               **   WRITE OUT EVERYTHING                    **
3202C               **   FOR BETA-BINOMIAL MLE ESTIMATION        **
3203C               ***********************************************
3204C
3205      ISTEPN='42'
3206      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBB')
3207     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3208C
3209C     PRINT SUMMARY STATISTICS TABLE
3210C
3211      NUMDIG=7
3212      IF(IFORSW.EQ.'1')NUMDIG=1
3213      IF(IFORSW.EQ.'2')NUMDIG=2
3214      IF(IFORSW.EQ.'3')NUMDIG=3
3215      IF(IFORSW.EQ.'4')NUMDIG=4
3216      IF(IFORSW.EQ.'5')NUMDIG=5
3217      IF(IFORSW.EQ.'6')NUMDIG=6
3218      IF(IFORSW.EQ.'7')NUMDIG=7
3219      IF(IFORSW.EQ.'8')NUMDIG=8
3220      IF(IFORSW.EQ.'9')NUMDIG=9
3221      IF(IFORSW.EQ.'0')NUMDIG=0
3222      IF(IFORSW.EQ.'E')NUMDIG=-2
3223      IF(IFORSW.EQ.'-2')NUMDIG=-2
3224      IF(IFORSW.EQ.'-3')NUMDIG=-3
3225      IF(IFORSW.EQ.'-4')NUMDIG=-4
3226      IF(IFORSW.EQ.'-5')NUMDIG=-5
3227      IF(IFORSW.EQ.'-6')NUMDIG=-6
3228      IF(IFORSW.EQ.'-7')NUMDIG=-7
3229      IF(IFORSW.EQ.'-8')NUMDIG=-8
3230      IF(IFORSW.EQ.'-9')NUMDIG=-9
3231C
3232      ITITLE='Beta Binomial Parameter Estimation'
3233      NCTITL=34
3234      ITITLZ=' '
3235      NCTITZ=0
3236C
3237      ICNT=1
3238      ITEXT(ICNT)='Summary Statistics:'
3239      NCTEXT(ICNT)=19
3240      AVALUE(ICNT)=0.0
3241      IDIGIT(ICNT)=-1
3242      ICNT=ICNT+1
3243      ITEXT(ICNT)='Number of Observations:'
3244      NCTEXT(ICNT)=23
3245      AVALUE(ICNT)=REAL(NTOTZZ)
3246      IDIGIT(ICNT)=0
3247      ICNT=ICNT+1
3248      ITEXT(ICNT)='Sample Mean:'
3249      NCTEXT(ICNT)=12
3250      AVALUE(ICNT)=XMEAN
3251      IDIGIT(ICNT)=NUMDIG
3252      ICNT=ICNT+1
3253      ITEXT(ICNT)='Sample Standard Deviation:'
3254      NCTEXT(ICNT)=26
3255      AVALUE(ICNT)=XSD
3256      IDIGIT(ICNT)=NUMDIG
3257      ICNT=ICNT+1
3258      ITEXT(ICNT)='Sample Minimum:'
3259      NCTEXT(ICNT)=15
3260      AVALUE(ICNT)=XMIN
3261      IDIGIT(ICNT)=NUMDIG
3262      ICNT=ICNT+1
3263      ITEXT(ICNT)='Sample Maximum:'
3264      NCTEXT(ICNT)=15
3265      AVALUE(ICNT)=XMAX
3266      IDIGIT(ICNT)=NUMDIG
3267      ICNT=ICNT+1
3268      ITEXT(ICNT)=' '
3269      NCTEXT(ICNT)=0
3270      AVALUE(ICNT)=0.0
3271      IDIGIT(ICNT)=-1
3272C
3273      ICNT=ICNT+1
3274      ITEXT(ICNT)='Method of Maximum Likelihood:'
3275      NCTEXT(ICNT)=29
3276      AVALUE(ICNT)=0.0
3277      IDIGIT(ICNT)=-1
3278      ICNT=ICNT+1
3279      ITEXT(ICNT)='Estimate of Mu:'
3280      NCTEXT(ICNT)=15
3281      AVALUE(ICNT)=REAL(DMEW)
3282      IDIGIT(ICNT)=NUMDIG
3283      ICNT=ICNT+1
3284      ITEXT(ICNT)='Estimate of Theta:'
3285      NCTEXT(ICNT)=18
3286      AVALUE(ICNT)=REAL(DTHETA)
3287      IDIGIT(ICNT)=NUMDIG
3288      ICNT=ICNT+1
3289      ITEXT(ICNT)='Estimate of Alpha:'
3290      NCTEXT(ICNT)=18
3291      AVALUE(ICNT)=ALPHML
3292      IDIGIT(ICNT)=NUMDIG
3293      ICNT=ICNT+1
3294      ITEXT(ICNT)='Estimate of Beta:'
3295      NCTEXT(ICNT)=17
3296      AVALUE(ICNT)=BETAML
3297      IDIGIT(ICNT)=NUMDIG
3298      ICNT=ICNT+1
3299      ITEXT(ICNT)=' '
3300      NCTEXT(ICNT)=0
3301      AVALUE(ICNT)=0.0
3302      IDIGIT(ICNT)=-1
3303C
3304      NUMROW=ICNT
3305      DO2310I=1,NUMROW
3306        NTOT(I)=15
3307 2310 CONTINUE
3308C
3309      IFRST=.TRUE.
3310      ILAST=.TRUE.
3311      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
3312     1            AVALUE,IDIGIT,
3313     1            NTOT,NUMROW,
3314     1            ICAPSW,ICAPTY,ILAST,IFRST,
3315     1            ISUBRO,IBUGA3,IERROR)
3316C
3317C               *****************
3318C               **  STEP 90--  **
3319C               **  EXIT       **
3320C               *****************
3321C
3322 9000 CONTINUE
3323      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBB')THEN
3324        WRITE(ICOUT,999)
3325        CALL DPWRST('XXX','WRIT')
3326        WRITE(ICOUT,9011)
3327 9011   FORMAT('***** AT THE END       OF DPMLBB--')
3328        CALL DPWRST('XXX','WRIT')
3329        WRITE(ICOUT,9012)IERROR
3330 9012   FORMAT('IERROR = ',A4)
3331        CALL DPWRST('XXX','WRIT')
3332      ENDIF
3333C
3334      RETURN
3335      END
3336      SUBROUTINE DPMLBE(Y,N,XTEMP,DTEMP1,MAXNXT,
3337     1                  AUSER,BUSER,
3338     1                  A,B,ALPHMO,BETAMO,ALPHML,BETAML,
3339     1                  ALPHSE,BETASE,COVSE,
3340     1                  QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
3341     1                  IOUNI1,IOUNI2,ALPHAP,
3342     1                  ICAPSW,ICAPTY,IFORSW,
3343     1                  ISUBRO,IBUGA3,IERROR)
3344C
3345C     PURPOSE--THIS ROUTINE COMPUTES THE METHOD OF MOMENT AND
3346C              MAXIMUM LIKELIHOOD ESTIMATES FOR THE 2-PARAMETER
3347C              BETA DISTRIBUTION
3348C     EXAMPLE--BETA MLE Y
3349C     REFERENCES--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
3350C                 ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
3351C                 1999, CHAPTER 14.
3352C               --EVANS, HASTINGS, AND PEACOCK.  "STATISTICAL
3353C                 DISTRIBUTIONS", THIRD EDITION, WILEY, 2000,
3354C                 PP. 34-42.
3355C               --JOHNSON, KOTZ, AND BALAKRISHNAN.  "CONTINUOUS
3356C                 UNIVARIATE DISTRIBUTIONS, VOLUME II", SECOND
3357C                 EDITION, WILEY, 1994.
3358C     WRITTEN BY--ALAN HECKERT
3359C                 STATISTICAL ENGINEERING DIVISION
3360C                 INFORMATION TECHNOLOGY LABORATORY
3361C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
3362C                 GAITHERSBURG, MD 20899-8980
3363C                 PHONE--301-975-2899
3364C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
3365C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
3366C     LANGUAGE--ANSI FORTRAN (1977)
3367C     VERSION NUMBER--2003/11
3368C     ORIGINAL VERSION--NOVEMBER  2003.
3369C     UPDATED         --DECEMBER  2004. CONFIDENCE INTERVALS FOR
3370C                                       SHAPE PARAMETERS
3371C     UPDATED         --JULY      2005. SOME COSMETIC CHANGES TO THE
3372C                                       OUTPUT
3373C     UPDATED         --JULY      2010. USE DPDTA1, DPDTA8, DPDTA9
3374C                                       TO PRINT OUTPUT
3375C
3376C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
3377C
3378      CHARACTER*4 ICAPSW
3379      CHARACTER*4 ICAPTY
3380      CHARACTER*4 IFORSW
3381      CHARACTER*4 ISUBRO
3382      CHARACTER*4 IBUGA3
3383      CHARACTER*4 IERROR
3384      CHARACTER*4 IWRITE
3385C
3386      CHARACTER*4 ISUBN1
3387      CHARACTER*4 ISUBN2
3388      CHARACTER*4 ISTEPN
3389C
3390C---------------------------------------------------------------------
3391C
3392      DIMENSION Y(*)
3393      DIMENSION XTEMP(*)
3394      DOUBLE PRECISION DTEMP1(*)
3395C
3396      PARAMETER (NUMALP=8)
3397      DIMENSION ALPHA(NUMALP)
3398      DIMENSION ALO1SH(NUMALP)
3399      DIMENSION AUP1SH(NUMALP)
3400      DIMENSION ALO2SH(NUMALP)
3401      DIMENSION AUP2SH(NUMALP)
3402      DIMENSION AL1SH2(NUMALP)
3403      DIMENSION AU1SH2(NUMALP)
3404      DIMENSION AL2SH2(NUMALP)
3405      DIMENSION AU2SH2(NUMALP)
3406      DIMENSION ALOWLO(NUMALP)
3407      DIMENSION AUPPLO(NUMALP)
3408      DIMENSION ALOWSC(NUMALP)
3409      DIMENSION AUPPSC(NUMALP)
3410C
3411      DIMENSION QP(*)
3412      DIMENSION XQPHAT(*)
3413      DIMENSION XQPSE(*)
3414      DIMENSION XQPLCL(*)
3415      DIMENSION XQPUCL(*)
3416C
3417CCCCC DOUBLE PRECISION TOL
3418CCCCC DOUBLE PRECISION XPAR(2)
3419CCCCC DOUBLE PRECISION FVEC(2)
3420      DOUBLE PRECISION DAE
3421      DOUBLE PRECISION DRE
3422      DOUBLE PRECISION DXSTRT
3423      DOUBLE PRECISION DXLOW
3424      DOUBLE PRECISION DXUP
3425C
3426      DOUBLE PRECISION BETFU2
3427      EXTERNAL BETFU2
3428      DOUBLE PRECISION BETFU5
3429      EXTERNAL BETFU5
3430      REAL     BETFU7
3431      EXTERNAL BETFU7
3432      REAL     BETFU8
3433      EXTERNAL BETFU8
3434C
3435      DOUBLE PRECISION DLBETA
3436      EXTERNAL DLBETA
3437C
3438      DOUBLE PRECISION DANS(10)
3439      DOUBLE PRECISION DA
3440      DOUBLE PRECISION DB
3441      DOUBLE PRECISION DC
3442      DOUBLE PRECISION DALPHA
3443      DOUBLE PRECISION DBETA
3444      DOUBLE PRECISION DALPBE
3445      DOUBLE PRECISION DTERM1
3446      DOUBLE PRECISION DTERM2
3447      DOUBLE PRECISION DTERM3
3448CCCCC DOUBLE PRECISION DTERM4
3449C
3450      INCLUDE 'DPCOST.INC'
3451C
3452      PARAMETER (MAXROW=50)
3453      CHARACTER*60 ITITLE
3454      CHARACTER*60 ITITLZ
3455      CHARACTER*40 ITEXT(MAXROW)
3456      REAL         AVALUE(MAXROW)
3457      INTEGER      NCTEXT(MAXROW)
3458      INTEGER      IDIGIT(MAXROW)
3459      INTEGER      NTOT(MAXROW)
3460      LOGICAL IFRST
3461      LOGICAL ILAST
3462C
3463      CHARACTER*4 ILIKFL
3464      CHARACTER*4 ILOCFL
3465      CHARACTER*4 ISCAFL
3466      CHARACTER*8 ISHAP1
3467      CHARACTER*8 ISHAP2
3468C
3469C---------------------------------------------------------------------
3470C
3471      COMMON /BETMLE/ BETALL, BETAUL
3472C
3473      INTEGER N2
3474      DOUBLE PRECISION DSUM3
3475      DOUBLE PRECISION DSUM4
3476      DOUBLE PRECISION DLLAB
3477      DOUBLE PRECISION DK
3478      COMMON/BETCO9/DSUM3,DSUM4,DLLAB,DK,N2
3479C
3480      DOUBLE PRECISION DBETA2
3481      COMMON/BETCO2/DBETA2
3482C
3483      DOUBLE PRECISION DALPH2
3484      COMMON/BETCO5/DALPH2
3485C
3486      DOUBLE PRECISION DBETA3
3487      COMMON/BETCO3/DBETA3
3488C
3489      DOUBLE PRECISION DALPH3
3490      COMMON/BETCO4/DALPH3
3491C
3492      COMMON/BETCO7/P7,BETA3
3493      COMMON/BETCO8/P8,ALPHA3
3494C
3495      DOUBLE PRECISION DN
3496C
3497      INCLUDE 'DPCOP2.INC'
3498C
3499      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
3500C
3501C-----START POINT-----------------------------------------------------
3502C
3503      ISUBN1='DPML'
3504      ISUBN2='BE  '
3505      IERROR='NO'
3506C
3507      XTEMP(1)=0.0
3508C
3509      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBE')THEN
3510        WRITE(ICOUT,999)
3511  999   FORMAT(1X)
3512        CALL DPWRST('XXX','WRIT')
3513        WRITE(ICOUT,51)
3514   51   FORMAT('**** AT THE BEGINNING OF DPMLBE--')
3515        CALL DPWRST('XXX','WRIT')
3516        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,IOUNI2,AUSER,BUSER
3517   52   FORMAT('IBUGA3,ISUBRO,N,IOUNI2,AUSER,BUSER = ',
3518     1         2(A4,2X),2I8,2G15.7)
3519        CALL DPWRST('XXX','WRIT')
3520        DO56I=1,MIN(N,100)
3521          WRITE(ICOUT,57)I,Y(I)
3522   57     FORMAT('I,Y(I) = ',I8,E15.7)
3523          CALL DPWRST('XXX','WRIT')
3524   56   CONTINUE
3525      ENDIF
3526C
3527C               ********************************************
3528C               **  STEP 11--                             **
3529C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
3530C               ********************************************
3531C
3532      ISTEPN='11'
3533      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3534C
3535      NMIN=3
3536      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
3537      IF(IERROR.EQ.'YES')GOTO9000
3538C
3539C               *************************************
3540C               **  STEP 31--                      **
3541C               **  CARRY OUT CALCULATIONS         **
3542C               **  FOR BETA MOMENT/MLE ESTIMATION **
3543C               *************************************
3544C
3545      ISTEPN='41'
3546      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBE')
3547     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3548C
3549      IERROR='NO'
3550      IWRITE='OFF'
3551C
3552      CALL BETML1(Y,N,DTEMP1,MAXNXT,AUSER,BUSER,
3553     1            XMIN,XMAX,XMEAN,XSD,XVAR,
3554     1            A,B,
3555     1            ALPHMO,BETAMO,
3556     1            ALPHML,BETAML,
3557     1            ISUBRO,IBUGA3,IERROR)
3558      IF(IERROR.EQ.'YES')GOTO9000
3559C
3560      NP=2
3561      CALL BETLI1(Y,N,NP,
3562     1            A,B,ALPHMO,BETAMO,
3563     1            ALIKMO,AICMO,AICCMO,BICMO,
3564     1            ISUBRO,IBUGA3,IERROR)
3565C
3566      CALL BETLI1(Y,N,NP,
3567     1            A,B,ALPHML,BETAML,
3568     1            ALIKML,AICML,AICCML,BICML,
3569     1            ISUBRO,IBUGA3,IERROR)
3570C
3571C     CONFIDENCE INTERVALS FOR SHAPE PARAMETERS
3572C
3573      DN=DBLE(N)
3574      DALPHA=DBLE(ALPHML)
3575      DBETA=DBLE(BETAML)
3576      DALPBE=DBLE(ALPHML + BETAML)
3577C
3578      KODE=1
3579      NTEMP=1
3580      M=1
3581      NZ=0
3582C
3583      CALL DPSIFN(DALPHA,NTEMP,KODE,M,DANS,NZ,IERR)
3584      DA=DANS(1)
3585      IF(IERR.EQ.1)THEN
3586        WRITE(ICOUT,999)
3587        CALL DPWRST('XXX','WRIT')
3588        WRITE(ICOUT,1111)
3589 1111   FORMAT('****** ERROR IN BETA MAXIMUM LIKELIHOOD--')
3590        CALL DPWRST('XXX','WRIT')
3591        WRITE(ICOUT,3203)
3592 3203   FORMAT('      UNABLE TO COMPUTE TRIGAMMA FUNCTION.')
3593        CALL DPWRST('XXX','WRIT')
3594        IERROR='YES'
3595        GOTO9000
3596      ELSEIF(IERR.EQ.2)THEN
3597        WRITE(ICOUT,999)
3598        CALL DPWRST('XXX','WRIT')
3599        WRITE(ICOUT,1111)
3600        CALL DPWRST('XXX','WRIT')
3601        WRITE(ICOUT,3205)
3602 3205   FORMAT('      OVERFLOW IN COMPUTING THE TRIGAMMA FUNCTION.')
3603        CALL DPWRST('XXX','WRIT')
3604        IERROR='YES'
3605        GOTO9000
3606      ELSEIF(IERR.EQ.3)THEN
3607        WRITE(ICOUT,999)
3608        CALL DPWRST('XXX','WRIT')
3609        WRITE(ICOUT,1111)
3610        CALL DPWRST('XXX','WRIT')
3611        WRITE(ICOUT,3207)
3612 3207   FORMAT('      OVERFLOW IN COMPUTING THE TRIGAMMA FUNCTION.')
3613        CALL DPWRST('XXX','WRIT')
3614        IERROR='YES'
3615        GOTO9000
3616      ENDIF
3617C
3618      CALL DPSIFN(DBETA,NTEMP,KODE,M,DANS,NZ,IERR)
3619      DB=DANS(1)
3620      IF(IERR.EQ.1)THEN
3621        WRITE(ICOUT,999)
3622        CALL DPWRST('XXX','WRIT')
3623        WRITE(ICOUT,1111)
3624        CALL DPWRST('XXX','WRIT')
3625        WRITE(ICOUT,3203)
3626        CALL DPWRST('XXX','WRIT')
3627        IERROR='YES'
3628        GOTO9000
3629      ELSEIF(IERR.EQ.2)THEN
3630        WRITE(ICOUT,999)
3631        CALL DPWRST('XXX','WRIT')
3632        WRITE(ICOUT,1111)
3633        CALL DPWRST('XXX','WRIT')
3634        WRITE(ICOUT,3205)
3635        CALL DPWRST('XXX','WRIT')
3636        IERROR='YES'
3637        GOTO9000
3638      ELSEIF(IERR.EQ.3)THEN
3639        WRITE(ICOUT,999)
3640        CALL DPWRST('XXX','WRIT')
3641        WRITE(ICOUT,1111)
3642        CALL DPWRST('XXX','WRIT')
3643        WRITE(ICOUT,3207)
3644        CALL DPWRST('XXX','WRIT')
3645        IERROR='YES'
3646        GOTO9000
3647      ENDIF
3648C
3649      CALL DPSIFN(DALPBE,NTEMP,KODE,M,DANS,NZ,IERR)
3650      DC=DANS(1)
3651      IF(IERR.EQ.1)THEN
3652        WRITE(ICOUT,999)
3653        CALL DPWRST('XXX','WRIT')
3654        WRITE(ICOUT,1111)
3655        CALL DPWRST('XXX','WRIT')
3656        WRITE(ICOUT,3203)
3657        CALL DPWRST('XXX','WRIT')
3658        IERROR='YES'
3659        GOTO9000
3660      ELSEIF(IERR.EQ.2)THEN
3661        WRITE(ICOUT,999)
3662        CALL DPWRST('XXX','WRIT')
3663        WRITE(ICOUT,1111)
3664        CALL DPWRST('XXX','WRIT')
3665        WRITE(ICOUT,3205)
3666        CALL DPWRST('XXX','WRIT')
3667        IERROR='YES'
3668        GOTO9000
3669      ELSEIF(IERR.EQ.3)THEN
3670        WRITE(ICOUT,999)
3671        CALL DPWRST('XXX','WRIT')
3672        WRITE(ICOUT,1111)
3673        CALL DPWRST('XXX','WRIT')
3674        WRITE(ICOUT,3207)
3675        CALL DPWRST('XXX','WRIT')
3676        IERROR='YES'
3677        GOTO9000
3678      ENDIF
3679C
3680      DTERM1=1.0D0/(DN*(DA*DB - DC*(DA+DB)))
3681      DTERM2=DTERM1*(DB-DC)
3682      ALPHSE=REAL(DSQRT(DTERM2))
3683      DTERM2=DTERM1*(DA-DC)
3684      BETASE=REAL(DSQRT(DTERM2))
3685      DTERM2=DTERM1*DC
3686      COVSE=REAL(DSQRT(DTERM2))
3687C
3688      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBE')THEN
3689        WRITE(ICOUT,3301)DA,DB,DC
3690 3301   FORMAT('DA,DB,DC = ',3G15.7)
3691        CALL DPWRST('XXX','WRIT')
3692        WRITE(ICOUT,3302)ALPHSE,BETASE,COVSE
3693 3302   FORMAT('ALPHSE,BETASE,COVSE = ',3G15.7)
3694        CALL DPWRST('XXX','WRIT')
3695      ENDIF
3696C
3697      DO3310I=1,NUMALP
3698        ALP=ALPHA(I)
3699        P=1.0-(ALP/2.0)
3700        CALL NORPPF(P,PPF)
3701        ALO1SH(I)=ALPHML - PPF*ALPHSE
3702        AUP1SH(I)=ALPHML + PPF*ALPHSE
3703        ALO2SH(I)=BETAML - PPF*BETASE
3704        AUP2SH(I)=BETAML + PPF*BETASE
3705C
3706        IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBE')THEN
3707          WRITE(ICOUT,3311)I,ALO1SH(I),AUP1SH(I),ALO2SH(I),AUP2SH(I)
3708 3311     FORMAT('I,ALO1SH(I),AUP1SH(I),ALO2SH(I),AUP2SH(I) = ',
3709     1           I8,4G15.7)
3710          CALL DPWRST('XXX','WRIT')
3711        ENDIF
3712C
3713 3310 CONTINUE
3714C
3715      N2=N
3716      DA=DBLE(A)
3717      DB=DBLE(B)
3718      DALPH2=DBLE(ALPHML)
3719      DALPH3=DBLE(ALPHML)
3720      DBETA2=DBLE(BETAML)
3721      DBETA3=DBLE(BETAML)
3722      DSUM3=0.0D0
3723      DSUM4=0.0D0
3724      DO3320I=1,N
3725        DTEMP1(I)=DBLE(Y(I))
3726        DSUM3=DSUM3 + DLOG(DBLE(Y(I)) - DA)
3727        DSUM4=DSUM4 + DLOG(DB - DBLE(Y(I)))
3728 3320 CONTINUE
3729      DSUM3=DSUM3/(DN*(DB - DA))
3730      DSUM4=DSUM4/(DN*(DB - DA))
3731C
3732      DTERM1=-DN*DLBETA(DALPH2,DBETA2)
3733      DTERM2=DN*(DALPH2-1.0D0)*DSUM3
3734      DTERM3=DN*(DBETA2-1.0D0)*DSUM4
3735      DLLAB=DTERM1 + DTERM2 + DTERM3
3736C
3737      DAE=1.D-7
3738      DRE=1.D-7
3739      NUTEMP=1
3740C
3741      DO3410I=1,NUMALP
3742        ALP=ALPHA(I)
3743        CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
3744        DK=DBLE(APPF)
3745C
3746        DXSTRT=DBLE(ALO1SH(I))
3747        DXLOW=DXSTRT/5.0D0
3748        DXUP=DBLE(ALPHML)
3749        CALL DFZER2(BETFU2,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP1)
3750        AL1SH2(I)=REAL(DXLOW)
3751C
3752        DXSTRT=DBLE(AUP1SH(I))
3753        DXUP=DXSTRT*5.0D0
3754        DXLOW=DBLE(ALPHML)
3755        CALL DFZER2(BETFU2,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP1)
3756        AU1SH2(I)=REAL(DXLOW)
3757C
3758        DXSTRT=DBLE(ALO2SH(I))
3759        DXLOW=DXSTRT/5.0D0
3760        DXUP=DBLE(BETAML)
3761        CALL DFZER2(BETFU5,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP1)
3762        AL2SH2(I)=REAL(DXLOW)
3763C
3764        DXSTRT=DBLE(AUP2SH(I))
3765        DXUP=DXSTRT*5.0D0
3766        DXLOW=DBLE(BETAML)
3767        CALL DFZER2(BETFU5,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP1)
3768        AU2SH2(I)=REAL(DXLOW)
3769C
3770 3410 CONTINUE
3771C
3772C  CONFIDENCE INTERVALS FOR SELECTED PERCENTILES.
3773C
3774C  1. STANDARD ERROR USES TECHNIQUE DEMONSTRATED IN EXAMPLE 14.3
3775C     (PP. 256-257) OF BURY.  THIS IS BASED ON PROPOGATION OF ERROR.
3776C
3777C  2. CONFIDENCE INTERVAL IS THEN GENERATED USING NORMAL
3778C     APPROXIMATION (EXAMPLE 14.3 OF BURY).
3779C
3780      IF(NPERC.GE.1)THEN
3781C
3782        ALPHL=ALPHAP/2.0
3783        ALPHU=1.0 - ALPHAP/2.0
3784        CALL NORPPF(ALPHU,Z95)
3785C
3786        ALPHA3=ALPHML
3787        BETA3=BETAML
3788        IORD=1
3789        EPS=0.001
3790        ACCUR=0.0
3791C
3792        WRITE(IOUNI1,3531)
3793        WRITE(IOUNI1,3532)
3794        DO3529I=1,NPERC
3795          QPTEMP=QP(I)/100.0
3796          CALL BETPPF(QPTEMP,ALPHML,BETAML,APPF)
3797          XQPHAT(I)=APPF
3798C
3799          P7=QPTEMP
3800          P8=QPTEMP
3801C
3802          IFAIL=0
3803C
3804          ALPHAT = ALPHML
3805          ALPHMN = 0.0001
3806          ALPHMX = ALPHML + 10.0
3807          CALL DIFF(IORD,ALPHAT,ALPHMN,ALPHMX,BETFU7,EPS,ACCUR,
3808     1              D1,ERROR,IFAIL)
3809C
3810          IF(IFAIL.EQ.1)THEN
3811            WRITE(ICOUT,999)
3812            CALL DPWRST('XXX','BUG ')
3813            WRITE(ICOUT,3501)
3814 3501       FORMAT('***** WARNING IN NUMERICAL DERIVATIVE FOR BETA ',
3815     1             'MAXIMUM LIKELIHOOD PERCENTILES.')
3816            CALL DPWRST('XXX','BUG ')
3817            WRITE(ICOUT,3503)
3818 3503       FORMAT('      THE ESTIMATED ERROR IN THE RESULT ',
3819     1             'EXCEEDS THE')
3820            CALL DPWRST('XXX','BUG ')
3821            WRITE(ICOUT,3505)
3822 3505       FORMAT('      REQUESTED ERROR, BUT THE MOST ACCURATE ',
3823     1             'RESULT')
3824            CALL DPWRST('XXX','BUG ')
3825            WRITE(ICOUT,3507)
3826 3507       FORMAT('      POSSIBLE HAS BEEN RETURNED.')
3827            CALL DPWRST('XXX','BUG ')
3828          ELSEIF(IFAIL.EQ.2)THEN
3829            WRITE(ICOUT,999)
3830            CALL DPWRST('XXX','BUG ')
3831            WRITE(ICOUT,3511)
3832 3511       FORMAT('***** ERROR IN NUMERICAL DERIVATIVE FOR BETA ',
3833     1             'MAXIMUM LIKELIHOOD PERCENTILES.')
3834            CALL DPWRST('XXX','BUG ')
3835            WRITE(ICOUT,3513)
3836 3513       FORMAT('      ERROR IN THE INPUT TO THE DIFF ROUTINE.')
3837            CALL DPWRST('XXX','BUG ')
3838            WRITE(ICOUT,3515)
3839 3515       FORMAT('      NO PERCENTILES WILL BE GENERATED.')
3840            CALL DPWRST('XXX','BUG ')
3841            NPERC=0
3842          ELSEIF(IFAIL.EQ.3)THEN
3843            WRITE(ICOUT,999)
3844            CALL DPWRST('XXX','BUG ')
3845            WRITE(ICOUT,3511)
3846            CALL DPWRST('XXX','BUG ')
3847            WRITE(ICOUT,3523)
3848 3523       FORMAT('      THE INTERVAL FOR DIFFERENTIATION, (',G15.7,
3849     1             ',',G15.7,')')
3850            CALL DPWRST('XXX','BUG ')
3851            WRITE(ICOUT,3525)
3852 3525       FORMAT('      IS TOO SMALL.')
3853            CALL DPWRST('XXX','BUG ')
3854            WRITE(ICOUT,3515)
3855            CALL DPWRST('XXX','BUG ')
3856            D1=0.0
3857            NPERC=0
3858          ENDIF
3859C
3860          BETAT = BETAML
3861          BETAMN = 0.0001
3862          BETAMX = BETAML + 10.0
3863          CALL DIFF(IORD,BETAT,BETAMN,BETAMX,BETFU8,EPS,ACCUR,
3864     1              D2,ERROR,IFAIL)
3865C
3866          IF(IFAIL.EQ.1)THEN
3867            WRITE(ICOUT,999)
3868            CALL DPWRST('XXX','BUG ')
3869            WRITE(ICOUT,3501)
3870            CALL DPWRST('XXX','BUG ')
3871            WRITE(ICOUT,3503)
3872            CALL DPWRST('XXX','BUG ')
3873            WRITE(ICOUT,3505)
3874            CALL DPWRST('XXX','BUG ')
3875            WRITE(ICOUT,3507)
3876            CALL DPWRST('XXX','BUG ')
3877          ELSEIF(IFAIL.EQ.2)THEN
3878            WRITE(ICOUT,999)
3879            CALL DPWRST('XXX','BUG ')
3880            WRITE(ICOUT,3511)
3881            CALL DPWRST('XXX','BUG ')
3882            WRITE(ICOUT,3513)
3883            CALL DPWRST('XXX','BUG ')
3884            WRITE(ICOUT,3515)
3885            CALL DPWRST('XXX','BUG ')
3886            NPERC=0
3887          ELSEIF(IFAIL.EQ.3)THEN
3888            WRITE(ICOUT,999)
3889            CALL DPWRST('XXX','BUG ')
3890            WRITE(ICOUT,3511)
3891            CALL DPWRST('XXX','BUG ')
3892            WRITE(ICOUT,3523)
3893            CALL DPWRST('XXX','BUG ')
3894            WRITE(ICOUT,3525)
3895            CALL DPWRST('XXX','BUG ')
3896            WRITE(ICOUT,3515)
3897            CALL DPWRST('XXX','BUG ')
3898            D2=0.0
3899            NPERC=0
3900          ENDIF
3901          V11=ALPHSE**2
3902          V22=BETASE**2
3903          V21=COVSE
3904          V12=V21
3905          TERM11=(D1*ALPHSE)**2
3906          TERM22=(D2*BETASE)**2
3907          TERM12=2.0*D2*D1*COVSE**2
3908          SEXQP=TERM11+TERM12+TERM22
3909          IF(SEXQP.GE.0.0)THEN
3910            SEXQP=SQRT(SEXQP)
3911          ELSE
3912            SEXQP=0.0
3913          ENDIF
3914          XQPSE(I)=SEXQP
3915          XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
3916          XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
3917          WRITE(IOUNI1,'(5E15.7)')
3918     1         QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
3919 3529   CONTINUE
3920 3531   FORMAT(15X,'       POINT     ','   STANDARD   ',
3921     1         '     LOWER     ',
3922     1         '     UPPER')
3923 3532   FORMAT('    PERCENTILE ','     ESTIMATE   ',
3924     1         '     ERRROR     ',
3925     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
3926      ENDIF
3927C               *********************************
3928C               **   STEP 42--                 **
3929C               **   WRITE OUT EVERYTHING      **
3930C               **   FOR BETA MLE ESTIMATION   **
3931C               **********************************
3932C
3933      ISTEPN='42'
3934      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3935C
3936C     PRINT SUMMARY STATISTICS TABLE
3937C
3938      IF(IPRINT.EQ.'OFF')GOTO9000
3939C
3940      NUMDIG=7
3941      IF(IFORSW.EQ.'1')NUMDIG=1
3942      IF(IFORSW.EQ.'2')NUMDIG=2
3943      IF(IFORSW.EQ.'3')NUMDIG=3
3944      IF(IFORSW.EQ.'4')NUMDIG=4
3945      IF(IFORSW.EQ.'5')NUMDIG=5
3946      IF(IFORSW.EQ.'6')NUMDIG=6
3947      IF(IFORSW.EQ.'7')NUMDIG=7
3948      IF(IFORSW.EQ.'8')NUMDIG=8
3949      IF(IFORSW.EQ.'9')NUMDIG=9
3950      IF(IFORSW.EQ.'0')NUMDIG=0
3951      IF(IFORSW.EQ.'E')NUMDIG=-2
3952      IF(IFORSW.EQ.'-2')NUMDIG=-2
3953      IF(IFORSW.EQ.'-3')NUMDIG=-3
3954      IF(IFORSW.EQ.'-4')NUMDIG=-4
3955      IF(IFORSW.EQ.'-5')NUMDIG=-5
3956      IF(IFORSW.EQ.'-6')NUMDIG=-6
3957      IF(IFORSW.EQ.'-7')NUMDIG=-7
3958      IF(IFORSW.EQ.'-8')NUMDIG=-8
3959      IF(IFORSW.EQ.'-9')NUMDIG=-9
3960C
3961      ITITLE='Two-Parameter Beta Parameter Estimation:'
3962      NCTITL=40
3963      ITITLZ='Full Sample Case'
3964      NCTITZ=16
3965      ITEXT(1)='Summary Statistics:'
3966      NCTEXT(1)=19
3967      AVALUE(1)=0.0
3968      IDIGIT(1)=0
3969      ITEXT(2)='Number of Observations:'
3970      NCTEXT(2)=23
3971      AVALUE(2)=REAL(N)
3972      IDIGIT(2)=0
3973      ITEXT(3)='Sample Mean:'
3974      NCTEXT(3)=12
3975      AVALUE(3)=XMEAN
3976      IDIGIT(3)=NUMDIG
3977      ITEXT(4)='Sample Standard Deviation:'
3978      NCTEXT(4)=26
3979      AVALUE(4)=XSD
3980      IDIGIT(4)=NUMDIG
3981      ITEXT(5)='Sample Minimum:'
3982      NCTEXT(5)=15
3983      AVALUE(5)=XMIN
3984      IDIGIT(5)=NUMDIG
3985      ITEXT(6)='Sample Maximum:'
3986      NCTEXT(6)=15
3987      AVALUE(6)=XMAX
3988      IDIGIT(6)=NUMDIG
3989      ICNT=6
3990      IF(AUSER.NE.CPUMIN)THEN
3991        ICNT=ICNT+1
3992        ITEXT(ICNT)='User Specified Lower Limit:'
3993        NCTEXT(ICNT)=27
3994        AVALUE(ICNT)=AUSER
3995        IDIGIT(ICNT)=NUMDIG
3996      ENDIF
3997      IF(BUSER.NE.CPUMIN)THEN
3998        ICNT=ICNT+1
3999        ITEXT(ICNT)='User Specified Upper Limit:'
4000        NCTEXT(ICNT)=27
4001        AVALUE(ICNT)=BUSER
4002        IDIGIT(ICNT)=NUMDIG
4003      ENDIF
4004      ICNT=ICNT+1
4005      ITEXT(ICNT)=' '
4006      NCTEXT(ICNT)=0
4007      AVALUE(ICNT)=0.0
4008      IDIGIT(ICNT)=-1
4009C
4010      ICNT=ICNT+1
4011      ITEXT(ICNT)='Moments:'
4012      NCTEXT(ICNT)=8
4013      AVALUE(ICNT)=0.0
4014      IDIGIT(ICNT)=-1
4015      ICNT=ICNT+1
4016      ITEXT(ICNT)='Estimate of Alpha:'
4017      NCTEXT(ICNT)=18
4018      AVALUE(ICNT)=ALPHMO
4019      IDIGIT(ICNT)=NUMDIG
4020      ICNT=ICNT+1
4021      ITEXT(ICNT)='Estimate of Beta:'
4022      NCTEXT(ICNT)=17
4023      AVALUE(ICNT)=BETAMO
4024      IDIGIT(ICNT)=NUMDIG
4025C
4026      IF(ALIKMO.NE.CPUMIN)THEN
4027        ICNT=ICNT+1
4028        ITEXT(ICNT)='Log-likelihood:'
4029        NCTEXT(ICNT)=15
4030        AVALUE(ICNT)=ALIKMO
4031        IDIGIT(ICNT)=-7
4032        ICNT=ICNT+1
4033        ITEXT(ICNT)='AIC:'
4034        NCTEXT(ICNT)=4
4035        AVALUE(ICNT)=AICMO
4036        IDIGIT(ICNT)=-7
4037        ICNT=ICNT+1
4038        ITEXT(ICNT)='AICc:'
4039        NCTEXT(ICNT)=5
4040        AVALUE(ICNT)=AICCMO
4041        IDIGIT(ICNT)=-7
4042        ICNT=ICNT+1
4043        ITEXT(ICNT)='BIC:'
4044        NCTEXT(ICNT)=4
4045        AVALUE(ICNT)=BICMO
4046        IDIGIT(ICNT)=-7
4047      ENDIF
4048      ICNT=ICNT+1
4049      ITEXT(ICNT)=' '
4050      NCTEXT(ICNT)=0
4051      AVALUE(ICNT)=0.0
4052      IDIGIT(ICNT)=-1
4053C
4054      ICNT=ICNT+1
4055      ITEXT(ICNT)='Maximum Likelihood:'
4056      NCTEXT(ICNT)=19
4057      AVALUE(ICNT)=0.0
4058      IDIGIT(ICNT)=-1
4059      ICNT=ICNT+1
4060      ITEXT(ICNT)='Estimate of Alpha:'
4061      NCTEXT(ICNT)=18
4062      AVALUE(ICNT)=ALPHML
4063      IDIGIT(ICNT)=NUMDIG
4064      ICNT=ICNT+1
4065      ITEXT(ICNT)='Standard Error of Alpha:'
4066      NCTEXT(ICNT)=24
4067      AVALUE(ICNT)=ALPHSE
4068      IDIGIT(ICNT)=NUMDIG
4069      ICNT=ICNT+1
4070      ITEXT(ICNT)='Estimate of Beta:'
4071      NCTEXT(ICNT)=17
4072      AVALUE(ICNT)=BETAML
4073      IDIGIT(ICNT)=NUMDIG
4074      ICNT=ICNT+1
4075      ITEXT(ICNT)='Standard Error of Beta:'
4076      NCTEXT(ICNT)=23
4077      AVALUE(ICNT)=BETASE
4078      IDIGIT(ICNT)=NUMDIG
4079      ICNT=ICNT+1
4080      ITEXT(ICNT)='Covariance:'
4081      NCTEXT(ICNT)=11
4082      AVALUE(ICNT)=COVSE
4083      IDIGIT(ICNT)=NUMDIG
4084      IF(ALIKML.NE.CPUMIN)THEN
4085        ICNT=ICNT+1
4086        ITEXT(ICNT)='Log-likelihood:'
4087        NCTEXT(ICNT)=15
4088        AVALUE(ICNT)=ALIKML
4089        IDIGIT(ICNT)=-7
4090        ICNT=ICNT+1
4091        ITEXT(ICNT)='AIC:'
4092        NCTEXT(ICNT)=4
4093        AVALUE(ICNT)=AICML
4094        IDIGIT(ICNT)=-7
4095        ICNT=ICNT+1
4096        ITEXT(ICNT)='AICc:'
4097        NCTEXT(ICNT)=5
4098        AVALUE(ICNT)=AICCML
4099        IDIGIT(ICNT)=-7
4100        ICNT=ICNT+1
4101        ITEXT(ICNT)='BIC:'
4102        NCTEXT(ICNT)=4
4103        AVALUE(ICNT)=BICML
4104        IDIGIT(ICNT)=-7
4105      ENDIF
4106C
4107      ICNT=ICNT+1
4108      ITEXT(ICNT)=' '
4109      NCTEXT(ICNT)=0
4110      AVALUE(ICNT)=0.0
4111      IDIGIT(ICNT)=-1
4112C
4113      NUMROW=ICNT
4114      DO2320I=1,NUMROW
4115        NTOT(I)=15
4116 2320 CONTINUE
4117C
4118      IFRST=.TRUE.
4119      ILAST=.TRUE.
4120      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
4121     1            AVALUE,IDIGIT,
4122     1            NTOT,NUMROW,
4123     1            ICAPSW,ICAPTY,ILAST,IFRST,
4124     1            ISUBRO,IBUGA3,IERROR)
4125C
4126      ILIKFL='ON'
4127      ILOCFL='OFF'
4128      ISCAFL='OFF'
4129      ISHAP1='Alpha'
4130      NCSHA1=5
4131      ISHAP2='Beta'
4132      NCSHA2=4
4133      CALL DPDT8A(ALOWLO,AUPPLO,ALOWSC,AUPPSC,
4134     1            ALO1SH,AUP1SH,AL1SH2,AU1SH2,
4135     1            ALO2SH,AUP2SH,AL2SH2,AU2SH2,
4136     1            ALPHA,NUMALP,
4137     1            ICAPSW,ICAPTY,NUMDIG,
4138     1            ILOCFL,ISCAFL,ILIKFL,
4139     1            ISHAP1,NCSHA1,ISHAP2,NCSHA2,
4140     1            ISUBRO,IBUGA3,IERROR)
4141C
4142      IF(NPERC.GT.1)THEN
4143        ILIKFL='OFF'
4144        CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
4145     1              ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
4146     1              ISUBRO,IBUGA3,IERROR)
4147      ENDIF
4148C
4149C               *****************
4150C               **  STEP 90--  **
4151C               **  EXIT       **
4152C               *****************
4153C
4154 9000 CONTINUE
4155      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLBE')GOTO9090
4156      WRITE(ICOUT,999)
4157      CALL DPWRST('XXX','WRIT')
4158      WRITE(ICOUT,9011)
4159 9011 FORMAT('***** AT THE END       OF DPMLBE--')
4160      CALL DPWRST('XXX','WRIT')
4161      WRITE(ICOUT,9012)N,IBUGA3,IERROR
4162 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
4163      CALL DPWRST('XXX','WRIT')
4164      WRITE(ICOUT,9015)N
4165 9015 FORMAT('N = ',I8)
4166      CALL DPWRST('XXX','WRIT')
4167 9090 CONTINUE
4168C
4169      RETURN
4170      END
4171      SUBROUTINE DPMLB4(Y,N,
4172     1                  XTEMP,DTEMP1,MAXNXT,
4173     1                  AMOM,BMOM,ALPHMO,BETAMO,
4174     1                  AML,BML,ALPHML,BETAML,ICONF,
4175     1                  QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
4176     1                  IOUNI1,IOUNI2,ALPHAP,
4177     1                  ICAPSW,ICAPTY,IFORSW,MLFLAG,
4178     1                  ISUBRO,IBUGA3,IERROR)
4179C
4180C     PURPOSE--THIS ROUTINE COMPUTES THE METHOD OF MOMENT AND
4181C              MAXIMUM LIKELIHOOD ESTIMATES FOR THE FOUR-PARAMETER
4182C              BETA DISTRIBUTION
4183C     EXAMPLE--BETA FOUR PARAMETER MLE Y
4184C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
4185C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
4186C                1999, CHAPTER 14.
4187C     WRITTEN BY--ALAN HECKERT
4188C                 STATISTICAL ENGINEERING DIVISION
4189C                 INFORMATION TECHNOLOGY LABORATORY
4190C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
4191C                 GAITHERSBURG, MD 20899-8980
4192C                 PHONE--301-975-2899
4193C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
4194C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
4195C     LANGUAGE--ANSI FORTRAN (1977)
4196C     VERSION NUMBER--2007/6
4197C     ORIGINAL VERSION--JUNE      2007.
4198C     UPDATED         --JULY      2010. USE DPDTA1 TO PRINT OUTPUT
4199C     UPDATED         --JULY      2010. EXTRACT POINT ESTIMATES TO
4200C                                       BETML4
4201C
4202C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
4203C
4204      CHARACTER*4 ICAPSW
4205      CHARACTER*4 ICAPTY
4206      CHARACTER*4 IFORSW
4207      CHARACTER*4 ISUBRO
4208      CHARACTER*4 IBUGA3
4209      CHARACTER*4 IERROR
4210C
4211      CHARACTER*4 IWRITE
4212C
4213      CHARACTER*4 ISUBN1
4214      CHARACTER*4 ISUBN2
4215      CHARACTER*4 ISTEPN
4216C
4217C---------------------------------------------------------------------
4218C
4219      DIMENSION Y(*)
4220      DIMENSION XTEMP(*)
4221      DOUBLE PRECISION DTEMP1(*)
4222C
4223      PARAMETER (NUMALP=8)
4224CCCCC DIMENSION ALPHA(NUMALP)
4225CCCCC DIMENSION ALOWAL(NUMALP)
4226CCCCC DIMENSION AUPPAL(NUMALP)
4227CCCCC DIMENSION ALOWBE(NUMALP)
4228CCCCC DIMENSION AUPPBE(NUMALP)
4229CCCCC DIMENSION ALOWA2(NUMALP)
4230CCCCC DIMENSION AUPPA2(NUMALP)
4231CCCCC DIMENSION ALOWB2(NUMALP)
4232CCCCC DIMENSION AUPPB2(NUMALP)
4233C
4234      DIMENSION QP(*)
4235      DIMENSION XQPHAT(*)
4236      DIMENSION XQPSE(*)
4237      DIMENSION XQPLCL(*)
4238      DIMENSION XQPUCL(*)
4239C
4240CCCCC DOUBLE PRECISION TOL
4241CCCCC DOUBLE PRECISION XPAR(2)
4242CCCCC DOUBLE PRECISION FVEC(2)
4243CCCCC DOUBLE PRECISION DAE
4244CCCCC DOUBLE PRECISION DRE
4245CCCCC DOUBLE PRECISION DXSTRT
4246CCCCC DOUBLE PRECISION DXLOW
4247CCCCC DOUBLE PRECISION DXUP
4248C
4249      DOUBLE PRECISION BE4FUN
4250      EXTERNAL BE4FUN
4251      DOUBLE PRECISION BE4FU2
4252      EXTERNAL BE4FU2
4253C
4254CCCCC DOUBLE PRECISION DANS(10)
4255CCCCC DOUBLE PRECISION DA
4256CCCCC DOUBLE PRECISION DB
4257CCCCC DOUBLE PRECISION DC
4258CCCCC DOUBLE PRECISION DALPHA
4259CCCCC DOUBLE PRECISION DBETA
4260CCCCC DOUBLE PRECISION DALPBE
4261CCCCC DOUBLE PRECISION DTERM1
4262CCCCC DOUBLE PRECISION DTERM2
4263CCCCC DOUBLE PRECISION DTERM3
4264CCCCC DOUBLE PRECISION DTERM4
4265CCCCC DOUBLE PRECISION DTERM5
4266CCCCC DOUBLE PRECISION DTERM6
4267CCCCC DOUBLE PRECISION DTERM7
4268CCCCC DOUBLE PRECISION DTERM8
4269CCCCC DOUBLE PRECISION DSUM1
4270CCCCC DOUBLE PRECISION DSUM2
4271CCCCC DOUBLE PRECISION DSUM3
4272CCCCC DOUBLE PRECISION DSUM4
4273C
4274C---------------------------------------------------------------------
4275C
4276CCCCC DOUBLE PRECISION DM1
4277CCCCC DOUBLE PRECISION DM2
4278CCCCC DOUBLE PRECISION DM3
4279CCCCC DOUBLE PRECISION DM4
4280C
4281CCCCC DOUBLE PRECISION DM1P
4282      DOUBLE PRECISION DM2P
4283      DOUBLE PRECISION DM3P
4284      DOUBLE PRECISION DM4P
4285      COMMON /BET4ML/ DM2P, DM3P, DM4P
4286C
4287      DOUBLE PRECISION SIGMA
4288      DOUBLE PRECISION S5
4289      DOUBLE PRECISION S6
4290      DOUBLE PRECISION S7
4291      DOUBLE PRECISION S8
4292      DOUBLE PRECISION DXMIN
4293      DOUBLE PRECISION DXMAX
4294      COMMON /BET4M2/ S5, S6, S7, S8, SIGMA, DXMIN, DXMAX
4295C
4296CCCCC DOUBLE PRECISION DN
4297C
4298      PARAMETER (MAXROW=30)
4299      CHARACTER*60 ITITLE
4300      CHARACTER*60 ITITLZ
4301      CHARACTER*50 ITEXT(MAXROW)
4302      REAL         AVALUE(MAXROW)
4303      INTEGER      NCTEXT(MAXROW)
4304      INTEGER      IDIGIT(MAXROW)
4305      INTEGER      NTOT(MAXROW)
4306      LOGICAL IFRST
4307      LOGICAL ILAST
4308C
4309      INCLUDE 'DPCOP2.INC'
4310C
4311CCCCC DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
4312C
4313C-----START POINT-----------------------------------------------------
4314C
4315      ISUBN1='DPML'
4316      ISUBN2='B4  '
4317      IERROR='NO'
4318C
4319      XTEMP(1)=0.0
4320CCCCC DO11I=1,NUMALP
4321CCCCC   ALOWAL(I)=CPUMIN
4322CCCCC   AUPPAL(I)=CPUMIN
4323CCC11 CONTINUE
4324C
4325      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLB4')THEN
4326        WRITE(ICOUT,999)
4327  999   FORMAT(1X)
4328        CALL DPWRST('XXX','WRIT')
4329        WRITE(ICOUT,51)
4330   51   FORMAT('**** AT THE BEGINNING OF DPMLB4--')
4331        CALL DPWRST('XXX','WRIT')
4332        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,ALPHAP
4333   52   FORMAT('IBUGA3,ISUBRO,N,ALPHAP = ',2(A4,2X),I8,G15.7)
4334        CALL DPWRST('XXX','WRIT')
4335        WRITE(ICOUT,53)IOUNI1,IOUNI2,ICONF
4336   53   FORMAT('IOUNI1,IOUNI2,ICONF = ',3I8)
4337        CALL DPWRST('XXX','WRIT')
4338        DO56I=1,MIN(N,100)
4339          WRITE(ICOUT,57)I,Y(I)
4340   57     FORMAT('I,Y(I) = ',I8,G15.7)
4341          CALL DPWRST('XXX','WRIT')
4342   56   CONTINUE
4343        DO66I=1,8
4344          WRITE(ICOUT,67)I,QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I),XQPSE(I)
4345   67     FORMAT('I,QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I),XQPSE(I) = ',
4346     1           I8,5G15.7)
4347          CALL DPWRST('XXX','WRIT')
4348   66   CONTINUE
4349      ENDIF
4350C
4351C               ********************************************
4352C               **  STEP 11--                             **
4353C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
4354C               ********************************************
4355C
4356      ISTEPN='11'
4357      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLB4')
4358     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4359C
4360      NMIN=5
4361      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
4362      IF(IERROR.EQ.'YES')GOTO9000
4363C
4364C               *************************************
4365C               **  STEP 31--                      **
4366C               **  CARRY OUT CALCULATIONS         **
4367C               **  FOR BETA MOMENT/MLE ESTIMATION **
4368C               *************************************
4369C
4370      ISTEPN='31'
4371      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLB4')
4372     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4373C
4374      IERROR='NO'
4375      IWRITE='OFF'
4376C
4377      CALL BETML4(Y,N,DTEMP1,MAXNXT,
4378     1            XMIN,XMAX,XMEAN,XSD,XVAR,
4379     1            AMOM,BMOM,ALPHMO,BETAMO,
4380     1            AML,BML,ALPHML,BETAML,MLFLAG,
4381     1            ISUBRO,IBUGA3,IERROR)
4382C
4383      NP=4
4384      CALL BETLI1(Y,N,NP,
4385     1            AMOM,BMOM,ALPHMO,BETAMO,
4386     1            ALIKMO,AICMO,AICCMO,BICMO,
4387     1            ISUBRO,IBUGA3,IERROR)
4388C
4389      IF(MLFLAG.EQ.0)THEN
4390        CALL BETLI1(Y,N,NP,
4391     1              AML,BML,ALPHML,BETAML,
4392     1              ALIKML,AICML,AICCML,BICML,
4393     1              ISUBRO,IBUGA3,IERROR)
4394      ELSE
4395        ALIKML=CPUMIN
4396        AICML=CPUMIN
4397        AICCML=CPUMIN
4398        BICML=CPUMIN
4399      ENDIF
4400C
4401C               *********************************
4402C               **   STEP 42--                 **
4403C               **   WRITE OUT EVERYTHING      **
4404C               **   FOR BETA MLE ESTIMATION   **
4405C               **********************************
4406C
4407      ISTEPN='42'
4408      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLB4')
4409     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4410C
4411      IF(IPRINT.EQ.'OFF')GOTO9000
4412C
4413      NUMDIG=7
4414      IF(IFORSW.EQ.'1')NUMDIG=1
4415      IF(IFORSW.EQ.'2')NUMDIG=2
4416      IF(IFORSW.EQ.'3')NUMDIG=3
4417      IF(IFORSW.EQ.'4')NUMDIG=4
4418      IF(IFORSW.EQ.'5')NUMDIG=5
4419      IF(IFORSW.EQ.'6')NUMDIG=6
4420      IF(IFORSW.EQ.'7')NUMDIG=7
4421      IF(IFORSW.EQ.'8')NUMDIG=8
4422      IF(IFORSW.EQ.'9')NUMDIG=9
4423      IF(IFORSW.EQ.'0')NUMDIG=0
4424      IF(IFORSW.EQ.'E')NUMDIG=-2
4425      IF(IFORSW.EQ.'-2')NUMDIG=-2
4426      IF(IFORSW.EQ.'-3')NUMDIG=-3
4427      IF(IFORSW.EQ.'-4')NUMDIG=-4
4428      IF(IFORSW.EQ.'-5')NUMDIG=-5
4429      IF(IFORSW.EQ.'-6')NUMDIG=-6
4430      IF(IFORSW.EQ.'-7')NUMDIG=-7
4431      IF(IFORSW.EQ.'-8')NUMDIG=-8
4432      IF(IFORSW.EQ.'-9')NUMDIG=-9
4433C
4434      ITITLE='4-Parameter Beta Parameter Estimation:'
4435      NCTITL=38
4436      ITITLZ='Full Sample Case'
4437      NCTITZ=16
4438      ICNT=1
4439      ITEXT(ICNT)='Summary Statistics:'
4440      NCTEXT(ICNT)=19
4441      AVALUE(ICNT)=0.0
4442      IDIGIT(ICNT)=-1
4443      ICNT=ICNT+1
4444      ITEXT(ICNT)='Number of Observations:'
4445      NCTEXT(ICNT)=23
4446      AVALUE(ICNT)=REAL(N)
4447      IDIGIT(ICNT)=0
4448      ICNT=ICNT+1
4449      ITEXT(ICNT)='Sample Mean:'
4450      NCTEXT(ICNT)=12
4451      AVALUE(ICNT)=XMEAN
4452      IDIGIT(ICNT)=NUMDIG
4453      ICNT=ICNT+1
4454      ITEXT(ICNT)='Sample Standard Deviation:'
4455      NCTEXT(ICNT)=26
4456      AVALUE(ICNT)=XSD
4457      IDIGIT(ICNT)=NUMDIG
4458      ICNT=ICNT+1
4459      ITEXT(ICNT)='Sample Minimum:'
4460      NCTEXT(ICNT)=15
4461      AVALUE(ICNT)=XMIN
4462      IDIGIT(ICNT)=NUMDIG
4463      ICNT=ICNT+1
4464      ITEXT(ICNT)='Sample Maximum:'
4465      NCTEXT(ICNT)=15
4466      AVALUE(ICNT)=XMAX
4467      IDIGIT(ICNT)=NUMDIG
4468      ICNT=ICNT+1
4469      ITEXT(ICNT)=' '
4470      NCTEXT(ICNT)=0
4471      AVALUE(ICNT)=0.0
4472      IDIGIT(ICNT)=-1
4473C
4474      ICNT=ICNT+1
4475      ITEXT(ICNT)='Method of Moments:'
4476      NCTEXT(ICNT)=18
4477      AVALUE(ICNT)=0.0
4478      IDIGIT(ICNT)=-1
4479      ICNT=ICNT+1
4480      ITEXT(ICNT)='Estimate of Lower Limit:'
4481      NCTEXT(ICNT)=24
4482      AVALUE(ICNT)=AMOM
4483      IDIGIT(ICNT)=NUMDIG
4484      ICNT=ICNT+1
4485      ITEXT(ICNT)='Estimate of Upper Limit:'
4486      NCTEXT(ICNT)=24
4487      AVALUE(ICNT)=BMOM
4488      IDIGIT(ICNT)=NUMDIG
4489      ICNT=ICNT+1
4490      ITEXT(ICNT)='Estimate of Shape Parameter Alpha:'
4491      NCTEXT(ICNT)=34
4492      AVALUE(ICNT)=ALPHMO
4493      IDIGIT(ICNT)=NUMDIG
4494      ICNT=ICNT+1
4495      ITEXT(ICNT)='Estimate of Shape Parameter Beta:'
4496      NCTEXT(ICNT)=33
4497      AVALUE(ICNT)=BETAMO
4498      IDIGIT(ICNT)=NUMDIG
4499C
4500      IF(ALIKMO.NE.CPUMIN)THEN
4501        ICNT=ICNT+1
4502        ITEXT(ICNT)='Log-likelihood:'
4503        NCTEXT(ICNT)=15
4504        AVALUE(ICNT)=ALIKMO
4505        IDIGIT(ICNT)=-7
4506        ICNT=ICNT+1
4507        ITEXT(ICNT)='AIC:'
4508        NCTEXT(ICNT)=4
4509        AVALUE(ICNT)=AICMO
4510        IDIGIT(ICNT)=-7
4511        ICNT=ICNT+1
4512        ITEXT(ICNT)='AICc:'
4513        NCTEXT(ICNT)=5
4514        AVALUE(ICNT)=AICCMO
4515        IDIGIT(ICNT)=-7
4516        ICNT=ICNT+1
4517        ITEXT(ICNT)='BIC:'
4518        NCTEXT(ICNT)=4
4519        AVALUE(ICNT)=BICMO
4520        IDIGIT(ICNT)=-7
4521      ENDIF
4522      ICNT=ICNT+1
4523      ITEXT(ICNT)=' '
4524      NCTEXT(ICNT)=0
4525      AVALUE(ICNT)=0.0
4526      IDIGIT(ICNT)=-1
4527C
4528      IF(MLFLAG.EQ.0)THEN
4529        ICNT=ICNT+1
4530        ITEXT(ICNT)='Maximum Likelihood:'
4531        NCTEXT(ICNT)=19
4532        AVALUE(ICNT)=0.0
4533        IDIGIT(ICNT)=-1
4534        ICNT=ICNT+1
4535        ITEXT(ICNT)='Estimate of Lower Limit:'
4536        NCTEXT(ICNT)=24
4537        AVALUE(ICNT)=AML
4538        IDIGIT(ICNT)=NUMDIG
4539        ICNT=ICNT+1
4540        ITEXT(ICNT)='Estimate of Upper Limit:'
4541        NCTEXT(ICNT)=24
4542        AVALUE(ICNT)=BML
4543        IDIGIT(ICNT)=NUMDIG
4544        ICNT=ICNT+1
4545        ITEXT(ICNT)='Estimate of Shape Parameter Alpha:'
4546        NCTEXT(ICNT)=34
4547        AVALUE(ICNT)=ALPHML
4548        IDIGIT(ICNT)=NUMDIG
4549        ICNT=ICNT+1
4550        ITEXT(ICNT)='Estimate of Shape Parameter Beta:'
4551        NCTEXT(ICNT)=33
4552        AVALUE(ICNT)=BETAML
4553        IDIGIT(ICNT)=NUMDIG
4554C
4555        IF(ALIKML.NE.CPUMIN)THEN
4556          ICNT=ICNT+1
4557          ITEXT(ICNT)='Log-likelihood:'
4558          NCTEXT(ICNT)=15
4559          AVALUE(ICNT)=ALIKML
4560          IDIGIT(ICNT)=-7
4561          ICNT=ICNT+1
4562          ITEXT(ICNT)='AIC:'
4563          NCTEXT(ICNT)=4
4564          AVALUE(ICNT)=AICML
4565          IDIGIT(ICNT)=-7
4566          ICNT=ICNT+1
4567          ITEXT(ICNT)='AICc:'
4568          NCTEXT(ICNT)=5
4569          AVALUE(ICNT)=AICCML
4570          IDIGIT(ICNT)=-7
4571          ICNT=ICNT+1
4572          ITEXT(ICNT)='BIC:'
4573          NCTEXT(ICNT)=4
4574          AVALUE(ICNT)=BICML
4575          IDIGIT(ICNT)=-7
4576        ENDIF
4577        ICNT=ICNT+1
4578        ITEXT(ICNT)=' '
4579        NCTEXT(ICNT)=0
4580        AVALUE(ICNT)=0.0
4581        IDIGIT(ICNT)=-1
4582C
4583      ELSE
4584        ICNT=ICNT+1
4585        ITEXT(ICNT)='Unable to Compute Maximum Likelihood Estimates'
4586        NCTEXT(ICNT)=47
4587        AVALUE(ICNT)=0.0
4588        IDIGIT(ICNT)=-1
4589      ENDIF
4590C
4591      NUMROW=ICNT
4592      DO2320I=1,NUMROW
4593        NTOT(I)=15
4594 2320 CONTINUE
4595C
4596      IFRST=.TRUE.
4597      ILAST=.TRUE.
4598      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
4599     1            AVALUE,IDIGIT,
4600     1            NTOT,NUMROW,
4601     1            ICAPSW,ICAPTY,ILAST,IFRST,
4602     1            ISUBRO,IBUGA3,IERROR)
4603C
4604C               *****************
4605C               **  STEP 90--  **
4606C               **  EXIT       **
4607C               *****************
4608C
4609 9000 CONTINUE
4610      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLB4')GOTO9090
4611      WRITE(ICOUT,999)
4612      CALL DPWRST('XXX','WRIT')
4613      WRITE(ICOUT,9011)
4614 9011 FORMAT('***** AT THE END       OF DPMLB4--')
4615      CALL DPWRST('XXX','WRIT')
4616      WRITE(ICOUT,9012)N,IBUGA3,IERROR
4617 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
4618      CALL DPWRST('XXX','WRIT')
4619      WRITE(ICOUT,9015)N
4620 9015 FORMAT('N = ',I8)
4621      CALL DPWRST('XXX','WRIT')
4622 9090 CONTINUE
4623C
4624      RETURN
4625      END
4626      SUBROUTINE DPMLBF(Y,N,
4627     1                  XTEMP,DTEMP,ITEMP,MAXNXT,
4628     1                  ALPHSV,BETASV,RSV,
4629     1                  ALPHML,BETAML,RML,
4630     1                  ICAPSW,ICAPTY,IFORSW,
4631     1                  ISUBRO,IBUGA3,IERROR)
4632C
4633C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
4634C              ESTIMATES FOR THE BRITTLE FRACTURE DISTRIBUTION
4635C              FOR THE FULL SAMPLE CASE.
4636C     NOTE--THE MAXIMIUM LIKELIHOOD ESTIMATES FOR BETA AND R ARE
4637C           THE SOLUTION TO THE FOLLOWING EQUATIONS:
4638C
4639C           0 = (ANUM/ADEN) + SUM[i=1 to N][1/(r*X(i)**2 + BETA) -
4640C               SUM[i=1 to N][X(i)**2]
4641C
4642C               ANUM = N*SUM[i=1 TO N][X(i)**2**(2*R-2)*
4643C                      EXP(-BETA/X(i)**2)
4644C               ADEN = SUM[i=1 TO N][X(i)**(2*R)*EXP(-BETA/X(i)**2)]
4645C
4646C           0 = 2*SUM[i=1 TO N][LOG(X(i))] +
4647C               SUM[i=1 TO N][1/(R + BETA/X(i)**2)] - (ANUM/ADEN)
4648C
4649C               ANUM = 2*SUM[i=1 TO N][LOG(X(i))*X(i)**(2*R)*
4650C                      EXP(-BETA/X(i)**2)]
4651C               ADEN = SUM[i=1 TO N][X(i)**(2*R)*EXP(-BETA/X(i)**2)]
4652C
4653C           ONCE WE HAVE SOLVED FOR BETA AND R, THE ESTIMATE OF
4654C           ALPHA IS THEN
4655C
4656C           ALPHAHAT = N/{SUM[i=1 TO N][X(i)**(2*R)*
4657C                      EXP(-BETA/X(i)**2)]
4658C
4659C     EXAMPLE--BRITTLE FRACTURE MAXIMUM LIKELIHOOD Y
4660C     REFERENCES--BLACK, DURHAM, AND PADGETT (1990), "PARAMETER
4661C                 ESTIMATION FOR A NEW DISTRIBUTION FOR THE STRENGTH
4662C                 OF BRITTLE FIBERS: A SIMULATION STUDY",
4663C                 COMMUNICATIONS IN STATISTICS--SIMULATION AND
4664C                 COMPUTATION, VOL. 19, PP. 809-825
4665C     WRITTEN BY--ALAN HECKERT
4666C                 STATISTICAL ENGINEERING DIVISION
4667C                 INFORMATION TECHNOLOGY LABORATORY
4668C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
4669C                 GAITHERSBURG, MD 20899-8980
4670C                 PHONE--301-975-2899
4671C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
4672C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
4673C     LANGUAGE--ANSI FORTRAN (1977)
4674C     VERSION NUMBER--2008/2
4675C     ORIGINAL VERSION--FEBRUARY  2008.
4676C
4677C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
4678C
4679      CHARACTER*4 ICAPSW
4680      CHARACTER*4 ICAPTY
4681      CHARACTER*4 IFORSW
4682C
4683      CHARACTER*4 ISUBRO
4684      CHARACTER*4 IBUGA3
4685      CHARACTER*4 IERROR
4686      CHARACTER*4 IWRITE
4687      CHARACTER*4 ISUBN1
4688      CHARACTER*4 ISUBN2
4689      CHARACTER*4 ISTEPN
4690C
4691      CHARACTER*40 IDIST
4692      PARAMETER (MAXROW=30)
4693      CHARACTER*60 ITITLE
4694      CHARACTER*60 ITITLZ
4695      CHARACTER*40 ITEXT(MAXROW)
4696      REAL         AVALUE(MAXROW)
4697      INTEGER      NCTEXT(MAXROW)
4698      INTEGER      IDIGIT(MAXROW)
4699      INTEGER      NTOT(MAXROW)
4700      LOGICAL IFRST
4701      LOGICAL ILAST
4702C
4703C---------------------------------------------------------------------
4704C
4705      DIMENSION Y(*)
4706      DIMENSION XTEMP(*)
4707      DOUBLE PRECISION DTEMP(*)
4708      INTEGER ITEMP(*)
4709C
4710      EXTERNAL BFRFUN
4711C
4712      DOUBLE PRECISION DSUM
4713      DOUBLE PRECISION DX
4714      DOUBLE PRECISION DN
4715      DOUBLE PRECISION DBETA
4716      DOUBLE PRECISION DR
4717C
4718      DOUBLE PRECISION TOL
4719      DOUBLE PRECISION XPAR(2)
4720      DOUBLE PRECISION FVEC(2)
4721C
4722C---------------------------------------------------------------------
4723C
4724      INCLUDE 'DPCOP2.INC'
4725C
4726C-----START POINT-----------------------------------------------------
4727C
4728      ISUBN1='DPML'
4729      ISUBN2='BF  '
4730      IERROR='NO'
4731      IWRITE='OFF'
4732C
4733      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBF')THEN
4734        WRITE(ICOUT,999)
4735  999   FORMAT(1X)
4736        CALL DPWRST('XXX','WRIT')
4737        WRITE(ICOUT,51)
4738   51   FORMAT('**** AT THE BEGINNING OF DPMLBF--')
4739        CALL DPWRST('XXX','WRIT')
4740        WRITE(ICOUT,52)IBUGA3,MAXNXT,ITEMP(1)
4741   52   FORMAT('IBUGA3,MAXNXT,ITEMP(1) = ',A4,2X,2I8)
4742        CALL DPWRST('XXX','WRIT')
4743        WRITE(ICOUT,55)N,ALPHSV,BETASV,RSV
4744   55   FORMAT('N,ALPHSV,BETASV,RSV = ',I8,3G15.7)
4745        CALL DPWRST('XXX','WRIT')
4746        DO56I=1,MIN(N,100)
4747          WRITE(ICOUT,57)I,Y(I)
4748   57     FORMAT('I,Y(I) = ',I8,G15.7)
4749          CALL DPWRST('XXX','WRIT')
4750   56   CONTINUE
4751      ENDIF
4752C
4753C               ********************************************
4754C               **  STEP 11--                             **
4755C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
4756C               ********************************************
4757C
4758      ISTEPN='11'
4759      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBF')
4760     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4761C
4762      NMIN=5
4763      NPERC=0
4764      CALL CKDIST(Y,N,NMIN,XTEMP,NPERC,ISUBRO,IBUGA3,IERROR)
4765      IF(IERROR.EQ.'YES')GOTO9000
4766C
4767      IDIST='BRITTLE FRACTURE'
4768      IFLAG=1
4769      CALL SUMRAW(Y,N,IDIST,IFLAG,
4770     1            XMEAN,XVAR,XSD,XMIN,XMAX,
4771     1            ISUBRO,IBUGA3,IERROR)
4772      IF(IERROR.EQ.'YES')GOTO9000
4773C
4774C               *************************************
4775C               **  STEP 21--                      **
4776C               **  CARRY OUT CALCULATIONS         **
4777C               **  FOR BRITTLE FRACTURE MLE       **
4778C               **  ESTIMATE (FULL SAMPLE CASE)    **
4779C               *************************************
4780C
4781      ISTEPN='21'
4782      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBF')
4783     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4784C
4785      IF(BETASV.GT.0.0)THEN
4786        XPAR(1)=DBLE(BETASV)
4787      ELSE
4788        XPAR(1)=1.0D0
4789      ENDIF
4790      IF(RSV.GT.0.0)THEN
4791        XPAR(2)=DBLE(RSV)
4792      ELSE
4793        XPAR(2)=1.0D0
4794      ENDIF
4795C
4796      DN=DBLE(N)
4797C
4798C               *************************************
4799C               **  STEP 22--                      **
4800C               **  COMPUTE THE MAXIMUM            **
4801C               **  LIKELIHOOD ESTIMATES.          **
4802C               *************************************
4803C
4804C
4805      IOPT=2
4806      TOL=1.0D-6
4807      NVAR=2
4808      NPRINT=-1
4809      INFO=0
4810      LWA=MAXNXT
4811      CALL DNSQE(BFRFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
4812     1           DTEMP,MAXNXT,Y,N)
4813C
4814      DBETA=XPAR(1)
4815      DR=XPAR(2)
4816      DSUM=0.0D0
4817      DO2210I=1,N
4818        DX=DBLE(Y(I))
4819        DSUM=DSUM + DX**(2.0D0*DR)*DEXP(-DBETA/DX**2)
4820 2210 CONTINUE
4821      ALPHML=REAL(DN/DSUM)
4822      BETAML=REAL(XPAR(1))
4823      RML=REAL(XPAR(2))
4824C
4825C               **********************************************
4826C               **   STEP 42--                              **
4827C               **   WRITE OUT EVERYTHING                   **
4828C               **   FOR BRITTLE FRACTURE MLE ESTIMATE      **
4829C               **********************************************
4830C
4831      ISTEPN='42'
4832      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBF')
4833     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4834C
4835C     PRINT SUMMARY STATISTICS TABLE
4836C
4837      NUMDIG=7
4838      IF(IFORSW.EQ.'1')NUMDIG=1
4839      IF(IFORSW.EQ.'2')NUMDIG=2
4840      IF(IFORSW.EQ.'3')NUMDIG=3
4841      IF(IFORSW.EQ.'4')NUMDIG=4
4842      IF(IFORSW.EQ.'5')NUMDIG=5
4843      IF(IFORSW.EQ.'6')NUMDIG=6
4844      IF(IFORSW.EQ.'7')NUMDIG=7
4845      IF(IFORSW.EQ.'8')NUMDIG=8
4846      IF(IFORSW.EQ.'9')NUMDIG=9
4847      IF(IFORSW.EQ.'0')NUMDIG=0
4848      IF(IFORSW.EQ.'E')NUMDIG=-2
4849      IF(IFORSW.EQ.'-2')NUMDIG=-2
4850      IF(IFORSW.EQ.'-3')NUMDIG=-3
4851      IF(IFORSW.EQ.'-4')NUMDIG=-4
4852      IF(IFORSW.EQ.'-5')NUMDIG=-5
4853      IF(IFORSW.EQ.'-6')NUMDIG=-6
4854      IF(IFORSW.EQ.'-7')NUMDIG=-7
4855      IF(IFORSW.EQ.'-8')NUMDIG=-8
4856      IF(IFORSW.EQ.'-9')NUMDIG=-9
4857C
4858      ITITLE='Brittle Fracture Parameter Estimation: Full Sample Case'
4859      NCTITL=55
4860      ITITLZ=' '
4861      NCTITZ=0
4862C
4863      ICNT=1
4864      ITEXT(ICNT)='Summary Statistics:'
4865      NCTEXT(ICNT)=19
4866      AVALUE(ICNT)=0.0
4867      IDIGIT(ICNT)=-1
4868      ICNT=ICNT+1
4869      ITEXT(ICNT)='Number of Observations:'
4870      NCTEXT(ICNT)=23
4871      AVALUE(ICNT)=REAL(N)
4872      IDIGIT(ICNT)=0
4873      ICNT=ICNT+1
4874      ITEXT(ICNT)='Sample Mean:'
4875      NCTEXT(ICNT)=12
4876      AVALUE(ICNT)=XMEAN
4877      IDIGIT(ICNT)=NUMDIG
4878      ICNT=ICNT+1
4879      ITEXT(ICNT)='Sample Standard Deviation:'
4880      NCTEXT(ICNT)=26
4881      AVALUE(ICNT)=XSD
4882      IDIGIT(ICNT)=NUMDIG
4883      ICNT=ICNT+1
4884      ITEXT(ICNT)='Sample Minimum:'
4885      NCTEXT(ICNT)=15
4886      AVALUE(ICNT)=XMIN
4887      IDIGIT(ICNT)=NUMDIG
4888      ICNT=ICNT+1
4889      ITEXT(ICNT)='Sample Maximum:'
4890      NCTEXT(ICNT)=15
4891      AVALUE(ICNT)=XMAX
4892      IDIGIT(ICNT)=NUMDIG
4893      ICNT=ICNT+1
4894      ITEXT(ICNT)=' '
4895      NCTEXT(ICNT)=0
4896      AVALUE(ICNT)=0.0
4897      IDIGIT(ICNT)=-1
4898C
4899      ICNT=ICNT+1
4900      ITEXT(ICNT)='Maximum Likelihood Method:'
4901      NCTEXT(ICNT)=26
4902      AVALUE(ICNT)=0.0
4903      IDIGIT(ICNT)=-1
4904      ICNT=ICNT+1
4905      ITEXT(ICNT)='Estimate of Alpha:'
4906      NCTEXT(ICNT)=18
4907      AVALUE(ICNT)=ALPHML
4908      IDIGIT(ICNT)=NUMDIG
4909      ICNT=ICNT+1
4910      ITEXT(ICNT)='Estimate of Beta:'
4911      NCTEXT(ICNT)=17
4912      AVALUE(ICNT)=BETAML
4913      IDIGIT(ICNT)=NUMDIG
4914      ICNT=ICNT+1
4915      ITEXT(ICNT)='Estimate of R:'
4916      NCTEXT(ICNT)=14
4917      AVALUE(ICNT)=RML
4918      IDIGIT(ICNT)=NUMDIG
4919C
4920      NUMROW=ICNT
4921      DO2310I=1,NUMROW
4922        NTOT(I)=15
4923 2310 CONTINUE
4924C
4925      IFRST=.TRUE.
4926      ILAST=.TRUE.
4927      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
4928     1            AVALUE,IDIGIT,
4929     1            NTOT,NUMROW,
4930     1            ICAPSW,ICAPTY,ILAST,IFRST,
4931     1            ISUBRO,IBUGA3,IERROR)
4932C
4933C               *****************
4934C               **  STEP 90--  **
4935C               **  EXIT       **
4936C               *****************
4937C
4938 9000 CONTINUE
4939      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBF')THEN
4940        WRITE(ICOUT,999)
4941        CALL DPWRST('XXX','WRIT')
4942        WRITE(ICOUT,9011)
4943 9011   FORMAT('***** AT THE END       OF DPMLBF--')
4944        CALL DPWRST('XXX','WRIT')
4945        WRITE(ICOUT,9012)IERROR
4946 9012   FORMAT('IERROR = ',A4)
4947        CALL DPWRST('XXX','WRIT')
4948      ENDIF
4949C
4950      RETURN
4951      END
4952      SUBROUTINE DPMLBG(Y,X,N,NVAR,
4953     1                  TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,
4954     1                  DTEMP1,MAXNXT,
4955     1                  THETML,PIML,ALPHML,BETAML,
4956     1                  THETFR,PIFR,ALPHFR,BETAFR,
4957     1                  ICAPSW,ICAPTY,IFORSW,
4958     1                  IBGEDF,IOUNI1,IOUNI2,ISEED,ALPHAP,
4959     1                  ISUBRO,IBUGA3,IERROR)
4960C
4961C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
4962C              ESTIMATES FOR THE BETA-GEOMETRIC DISTRIBUTION
4963C     EXAMPLE--BETA-GEOMETRIC MAXIMUM LIKELIHOOD Y
4964C     REFERENCE--SUDHIR R. PAUL (2004).  "APPLICATIONS OF THE
4965C                BETA DISTRIBUTION" in "HANDBOOK OF THE BETA
4966C                DISTRIBUTION", EDITED BY GUPTA AND NADARAJAH,
4967C                MARCEL-DEKKER, PP.431-436.
4968C              --J. O. Irwin (1963), "Mathematcs in Medical and
4969C                Biological Statistics", Journal of the Royal
4970C                Statistical Society, A, pp. 1-44.
4971C     WRITTEN BY--ALAN HECKERT
4972C                 STATISTICAL ENGINEERING DIVISION
4973C                 INFORMATION TECHNOLOGY LABORATORY
4974C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
4975C                 GAITHERSBUG, MD 20899-8980
4976C                 PHONE--301-975-2899
4977C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
4978C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
4979C     LANGUAGE--ANSI FORTRAN (1977)
4980C     VERSION NUMBER--2006/5
4981C     ORIGINAL VERSION--MAY       2006.
4982C     UPDATED         --JUNE      2006. ADD FIRST FREQUENCY AND
4983C                                       SAMPLE MEAN ESTIMATE
4984C     UPDATED         --JUNE      2006. SUPPORT FOR GROUPED DATA
4985C     UPDATED         --APRIL     2011. USE DPDTA1 TO PRINT THE
4986C                                       OUTPUT
4987C
4988C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
4989C
4990      CHARACTER*4 ICAPSW
4991      CHARACTER*4 ICAPTY
4992      CHARACTER*4 IFORSW
4993      CHARACTER*4 IBGEDF
4994      CHARACTER*4 ISUBRO
4995      CHARACTER*4 IBUGA3
4996      CHARACTER*4 IERROR
4997C
4998      CHARACTER*4 IWRITE
4999      CHARACTER*4 IRELAT
5000      CHARACTER*4 IRHSTG
5001      CHARACTER*4 ISUBN1
5002      CHARACTER*4 ISUBN2
5003      CHARACTER*4 ISTEPN
5004C
5005C---------------------------------------------------------------------
5006C
5007      DIMENSION Y(*)
5008      DIMENSION X(*)
5009      DIMENSION TEMP1(*)
5010      DIMENSION TEMP2(*)
5011      DIMENSION TEMP3(*)
5012      DIMENSION TEMP4(*)
5013      DIMENSION TEMP5(*)
5014      DOUBLE PRECISION DTEMP1(*)
5015C
5016      PARAMETER (NUMALP=8)
5017CCCCC DIMENSION ALPHA(NUMALP)
5018CCCCC DIMENSION ALOWSC(NUMALP)
5019CCCCC DIMENSION AUPPSC(NUMALP)
5020CCCCC DIMENSION ALOWGA(NUMALP)
5021CCCCC DIMENSION AUPPGA(NUMALP)
5022C
5023      DOUBLE PRECISION TOL
5024      DOUBLE PRECISION XPAR(2)
5025      DOUBLE PRECISION FVEC(2)
5026CCCCC DOUBLE PRECISION G
5027CCCCC DOUBLE PRECISION T3
5028CCCCC DOUBLE PRECISION DT1
5029CCCCC DOUBLE PRECISION DT2
5030      DOUBLE PRECISION DTERM1
5031CCCCC DOUBLE PRECISION DG
5032CCCCC DOUBLE PRECISION DS
5033CCCCC DOUBLE PRECISION DQP
5034C
5035      DOUBLE PRECISION DSUM1
5036      DOUBLE PRECISION DSUM2
5037      DOUBLE PRECISION DSUM3
5038      DOUBLE PRECISION DSUM4
5039      DOUBLE PRECISION DTERM2
5040      DOUBLE PRECISION DTERM3
5041      DOUBLE PRECISION DNUM
5042      DOUBLE PRECISION DN
5043      DOUBLE PRECISION D11
5044      DOUBLE PRECISION D22
5045      DOUBLE PRECISION D12
5046C
5047      EXTERNAL BGEFUN
5048C
5049      PARAMETER (MAXROW=30)
5050      CHARACTER*60 ITITLE
5051      CHARACTER*1  ITITLZ
5052      CHARACTER*40 IDIST
5053      CHARACTER*40 ITEXT(MAXROW)
5054      REAL         AVALUE(MAXROW)
5055      INTEGER      NCTEXT(MAXROW)
5056      INTEGER      IDIGIT(MAXROW)
5057      INTEGER      NTOT(MAXROW)
5058      LOGICAL      IFRST
5059      LOGICAL      ILAST
5060C
5061      PARAMETER(NUMCLI=5)
5062      PARAMETER(MAXLIN=3)
5063C
5064C---------------------------------------------------------------------
5065C
5066      INCLUDE 'DPCOP2.INC'
5067C
5068CCCCC DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
5069C
5070C-----START POINT-----------------------------------------------------
5071C
5072      ISUBN1='DPML'
5073      ISUBN2='BG  '
5074      IERROR='NO'
5075      IWRITE='OFF'
5076C
5077      VARTHE=CPUMIN
5078      VARPI=CPUMIN
5079C
5080      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBG')THEN
5081        WRITE(ICOUT,999)
5082  999   FORMAT(1X)
5083        CALL DPWRST('XXX','WRIT')
5084        WRITE(ICOUT,51)
5085   51   FORMAT('**** AT THE BEGINNING OF DPMLBG--')
5086        CALL DPWRST('XXX','WRIT')
5087        WRITE(ICOUT,52)IBUGA3,ISUBRO,IBGEDF
5088   52   FORMAT('IBUGA3,ISUBRO,IBGEDF = ',3(A4,2X))
5089        CALL DPWRST('XXX','WRIT')
5090        WRITE(ICOUT,53)N,NVAR,IOUNI1,IOUNI2,ISEED,ALPHAP
5091   53   FORMAT('N,NVAR,IOUNI1,IOUNI2,ISEED,ALPHAP = ',5I8,G15.7)
5092        CALL DPWRST('XXX','WRIT')
5093        IF(NVAR.EQ.1)THEN
5094          DO56I=1,MIN(N,100)
5095            WRITE(ICOUT,57)I,Y(I)
5096   57       FORMAT('I,Y(I) = ',I8,G15.7)
5097            CALL DPWRST('XXX','WRIT')
5098   56     CONTINUE
5099        ELSE
5100          DO61I=1,N
5101            WRITE(ICOUT,62)I,X(I),Y(I)
5102   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
5103            CALL DPWRST('XXX','WRIT')
5104   61     CONTINUE
5105        ENDIF
5106      ENDIF
5107C
5108C               ********************************************
5109C               **  STEP 11--                             **
5110C               **  1) ROUND DATA TO INTEGER VALUES       **
5111C               **  2) COMPUTE SUMMARY STATISTICS         **
5112C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
5113C               **     INSUFFICIENT SAMPLE SIZE           **
5114C               ********************************************
5115C
5116      ISTEPN='11'
5117      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLBG')
5118     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
5119C
5120      IDIST='BETA GEOMETRIC'
5121C
5122      NPERC=0
5123      MAXGRP=MAXNXT
5124      NMIN=3
5125      IF(NVAR.EQ.1)THEN
5126        DO1105I=1,N
5127          ITEMP=INT(Y(I)+0.5)
5128          Y(I)=REAL(ITEMP)
5129 1105   CONTINUE
5130        CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
5131        IF(IERROR.EQ.'YES')GOTO9000
5132C
5133        IFLAG=1
5134        CALL SUMRAW(Y,N,IDIST,IFLAG,
5135     1              XMEAN,XVAR,XSD,XMIN,XMAX,
5136     1              ISUBRO,IBUGA3,IERROR)
5137        IF(IERROR.EQ.'YES')GOTO9000
5138        NTOTZZ=N
5139C
5140C       NOW BIN THE DATA FOR USE BY THE ESTIMATION METHOD BELOW
5141C
5142        IRELAT='OFF'
5143        IRHSTG='OFF'
5144        XSTART=XMIN-0.5
5145        XSTOP=XMAX+0.5
5146        CLWID=1.0
5147        CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
5148     1              TEMP5,X,N2,IBUGA3,IERROR)
5149        ICNT=0
5150        DO1121I=1,N2
5151          IF(TEMP5(I).GT.0.0)THEN
5152            ICNT=ICNT+1
5153            TEMP5(ICNT)=TEMP5(I)
5154            X(ICNT)=X(I)
5155          ENDIF
51561121    CONTINUE
5157        N2=ICNT
5158      ELSE
5159        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
5160     1              ISUBRO,IBUGA3,IERROR)
5161        IF(IERROR.EQ.'YES')GOTO9000
5162        IFLAG1=1
5163        IFLAG2=1
5164        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
5165     1              TEMP1,TEMP2,TEMP3,MAXNXT,
5166     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
5167     1              ISUBRO,IBUGA3,IERROR)
5168        CALL DPRAW(X,Y,N,IWRITE,MAXNXT,TEMP4,NTOTZZ,IBUGA3,IERROR)
5169C
5170C       SAVE FREQUENCIES IN TEMP5
5171C
5172        ICNT=0
5173        DO1220I=1,N
5174          IF(Y(I).GT.0.0)THEN
5175            ICNT=ICNT+1
5176            TEMP5(ICNT)=Y(I)
5177            X(ICNT)=X(I)
5178          ENDIF
51791220    CONTINUE
5180        N2=ICNT
5181C
5182        DO1221I=1,NTOTZZ
5183          Y(I)=TEMP4(I)
51841221    CONTINUE
5185        N=NTOTZZ
5186      ENDIF
5187      IF(IERROR.EQ.'YES')GOTO9000
5188C
5189      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLBG')THEN
5190        WRITE(ICOUT,999)
5191        CALL DPWRST('XXX','WRIT')
5192        WRITE(ICOUT,1311)
5193 1311   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
5194        CALL DPWRST('XXX','WRIT')
5195        WRITE(ICOUT,1312)XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ
5196 1312   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ = ',5G15.7,I10)
5197        CALL DPWRST('XXX','WRIT')
5198      ENDIF
5199C
5200C               ***************************************************
5201C               **  STEP 21--                                    **
5202C               **  CARRY OUT CALCULATIONS                       **
5203C               **  FOR BETA-GEOMETRIC MOMENT/MLE ESTIMATION     **
5204C               ***************************************************
5205C
5206      ISTEPN='21'
5207      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBG')
5208     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
5209C
5210C
5211C     COMPUTE THE FIRST FREQUENCY AND SAMPLE MEAN ESTIMATES
5212C
5213      P1=TEMP5(1)/REAL(NTOTZZ)
5214      Q1=1.0-P1
5215      TERM1=1.0/Q1
5216      TERM2=(1.0/Q1) - (1.0/XMEAN) - 1.0
5217      IF(TERM2.EQ.0.0)THEN
5218        ALPHFR=0.0
5219        BETAFR=0.0
5220        PIFR=0.0
5221        THETFR=0.0
5222      ELSE
5223        AHAT=TERM1/TERM2
5224        CHAT=1.0/TERM2
5225        IF(CHAT.GT.AHAT)THEN
5226          BETAFR=AHAT
5227          ALPHFR=CHAT-AHAT
5228        ELSE
5229          BETAFR=CHAT
5230          ALPHFR=AHAT-CHAT
5231        ENDIF
5232        PIFR=ALPHFR/(ALPHFR+BETAFR)
5233        THETFR=1.0/(ALPHFR+BETAFR)
5234      ENDIF
5235C
5236      DO2111I=1,MAXNXT
5237        DTEMP1(I)=0.0D0
5238 2111 CONTINUE
5239C
5240      IOPT=2
5241      TOL=1.0D-5
5242      NPAR=2
5243      NPRINT=-1
5244      INFO=0
5245      LWA=MAXNXT
5246      IF(PIFR.GT.0.0)THEN
5247        XPAR(2)=PIFR
5248      ELSE
5249        XPAR(2)=0.5D0
5250      ENDIF
5251      IF(THETFR.GT.0.0)THEN
5252        XPAR(1)=THETFR
5253      ELSE
5254        XPAR(1)=0.5D0
5255      ENDIF
5256      CALL DNSQE(BGEFUN,JAC,IOPT,NPAR,XPAR,FVEC,TOL,NPRINT,INFO,
5257     1           DTEMP1,MAXNXT,Y,N)
5258C
5259      THETML=REAL(XPAR(1))
5260      PIML=REAL(XPAR(2))
5261      ALPHML=PIML/THETML
5262      BETAML=(1.0-PIML)/THETML
5263      MLFLAG=0
5264      IF(INFO.EQ.0)MLFLAG=1
5265      IF(INFO.EQ.2)MLFLAG=1
5266      IF(INFO.EQ.4)MLFLAG=1
5267C
5268      IF(MLFLAG.EQ.0)THEN
5269C
5270        IF(NPERC.GE.1)THEN
5271C
5272        ENDIF
5273C
5274        DSUM1=0.0D0
5275        DSUM2=0.0D0
5276        DSUM3=0.0D0
5277        DSUM4=0.0D0
5278        DN=DBLE(N)
5279        DTERM1=DN/DBLE(PIML**2)
5280        NTERMS=5000
5281C
5282        DO2410IR=2,NTERMS
5283          IRTEMP=IR-1
5284          CALL BGECDF(REAL(IRTEMP),ALPHML,BETAML,CDF)
5285          DNUM=1.0D0 - DBLE(CDF)
5286          DTERM2=(1.0D0 - DBLE(PIML) + DBLE(IR-2)*DBLE(THETML))**2
5287          DTERM3=(1.0D0 + DBLE(IR-2)*DBLE(THETML))**2
5288          IF(IR.GE.2)THEN
5289            DSUM1=DSUM1 + DNUM/DTERM2
5290            DSUM4=DSUM4 + DBLE(IR-1)**2*DNUM/DTERM3
5291          ENDIF
5292          IF(IR.GE.3)THEN
5293            DSUM2=DSUM2 + DBLE(IR-2)*DNUM/DTERM2
5294            DSUM3=DSUM3 + DBLE(IR-2)**2*DNUM/DTERM2
5295          ENDIF
5296 2410   CONTINUE
5297        D11=REAL(DTERM1 + DN*DSUM1)
5298        D22=REAL(DN*(DSUM3 + DSUM4))
5299        D12=REAL(-DN*DSUM2)
5300        VARPI=REAL(D22/(D11*D22-D12**2))
5301        VARTHE=REAL(D11/(D11*D22-D12**2))
5302C
5303      ELSE
5304      ENDIF
5305C
5306C
5307C               ***********************************************
5308C               **   STEP 42--                               **
5309C               **   WRITE OUT EVERYTHING                    **
5310C               **   FOR BETA-GEOMETRIC MLE ESTIMATION       **
5311C               ***********************************************
5312C
5313      ISTEPN='42'
5314      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBG')
5315     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
5316C
5317C     PRINT SUMMARY STATISTICS TABLE
5318C
5319      NUMDIG=7
5320      IF(IFORSW.EQ.'1')NUMDIG=1
5321      IF(IFORSW.EQ.'2')NUMDIG=2
5322      IF(IFORSW.EQ.'3')NUMDIG=3
5323      IF(IFORSW.EQ.'4')NUMDIG=4
5324      IF(IFORSW.EQ.'5')NUMDIG=5
5325      IF(IFORSW.EQ.'6')NUMDIG=6
5326      IF(IFORSW.EQ.'7')NUMDIG=7
5327      IF(IFORSW.EQ.'8')NUMDIG=8
5328      IF(IFORSW.EQ.'9')NUMDIG=9
5329      IF(IFORSW.EQ.'0')NUMDIG=0
5330      IF(IFORSW.EQ.'E')NUMDIG=-2
5331      IF(IFORSW.EQ.'-2')NUMDIG=-2
5332      IF(IFORSW.EQ.'-3')NUMDIG=-3
5333      IF(IFORSW.EQ.'-4')NUMDIG=-4
5334      IF(IFORSW.EQ.'-5')NUMDIG=-5
5335      IF(IFORSW.EQ.'-6')NUMDIG=-6
5336      IF(IFORSW.EQ.'-7')NUMDIG=-7
5337      IF(IFORSW.EQ.'-8')NUMDIG=-8
5338      IF(IFORSW.EQ.'-9')NUMDIG=-9
5339C
5340      ITITLE='Beta Geometric Parameter Estimation'
5341      NCTITL=35
5342      ITITLZ=' '
5343      NCTITZ=0
5344C
5345      ICNT=1
5346      ITEXT(ICNT)='Summary Statistics:'
5347      NCTEXT(ICNT)=19
5348      AVALUE(ICNT)=0.0
5349      IDIGIT(ICNT)=-1
5350      ICNT=ICNT+1
5351      ITEXT(ICNT)='Number of Observations:'
5352      NCTEXT(ICNT)=23
5353      AVALUE(ICNT)=REAL(NTOTZZ)
5354      IDIGIT(ICNT)=0
5355      ICNT=ICNT+1
5356      ITEXT(ICNT)='Sample Mean:'
5357      NCTEXT(ICNT)=12
5358      AVALUE(ICNT)=XMEAN
5359      IDIGIT(ICNT)=NUMDIG
5360      ICNT=ICNT+1
5361      ITEXT(ICNT)='Sample Standard Deviation:'
5362      NCTEXT(ICNT)=26
5363      AVALUE(ICNT)=XSD
5364      IDIGIT(ICNT)=NUMDIG
5365      ICNT=ICNT+1
5366      ITEXT(ICNT)='Sample Minimum:'
5367      NCTEXT(ICNT)=15
5368      AVALUE(ICNT)=XMIN
5369      IDIGIT(ICNT)=NUMDIG
5370      ICNT=ICNT+1
5371      ITEXT(ICNT)='Sample Maximum:'
5372      NCTEXT(ICNT)=15
5373      AVALUE(ICNT)=XMAX
5374      IDIGIT(ICNT)=NUMDIG
5375      ICNT=ICNT+1
5376      ITEXT(ICNT)='Sample First Frequency:'
5377      NCTEXT(ICNT)=23
5378      AVALUE(ICNT)=P1
5379      IDIGIT(ICNT)=NUMDIG
5380      ICNT=ICNT+1
5381      ITEXT(ICNT)=' '
5382      NCTEXT(ICNT)=0
5383      AVALUE(ICNT)=0.0
5384      IDIGIT(ICNT)=-1
5385C
5386      ICNT=ICNT+1
5387      ITEXT(ICNT)='Method of First Frequency:'
5388      NCTEXT(ICNT)=26
5389      AVALUE(ICNT)=0.0
5390      IDIGIT(ICNT)=-1
5391      ICNT=ICNT+1
5392      ITEXT(ICNT)='Estimate of Theta:'
5393      NCTEXT(ICNT)=18
5394      AVALUE(ICNT)=THETFR
5395      IDIGIT(ICNT)=NUMDIG
5396      ICNT=ICNT+1
5397      ITEXT(ICNT)='Estimate of Pi:'
5398      NCTEXT(ICNT)=15
5399      AVALUE(ICNT)=PIFR
5400      IDIGIT(ICNT)=NUMDIG
5401      ICNT=ICNT+1
5402      ITEXT(ICNT)='Estimate of Alpha:'
5403      NCTEXT(ICNT)=18
5404      AVALUE(ICNT)=ALPHFR
5405      IDIGIT(ICNT)=NUMDIG
5406      ICNT=ICNT+1
5407      ITEXT(ICNT)='Estimate of Beta:'
5408      NCTEXT(ICNT)=17
5409      AVALUE(ICNT)=BETAFR
5410      IDIGIT(ICNT)=NUMDIG
5411      ICNT=ICNT+1
5412      ITEXT(ICNT)=' '
5413      NCTEXT(ICNT)=0
5414      AVALUE(ICNT)=0.0
5415      IDIGIT(ICNT)=-1
5416C
5417      ICNT=ICNT+1
5418      ITEXT(ICNT)='Method of Maximum Likelihood:'
5419      NCTEXT(ICNT)=29
5420      AVALUE(ICNT)=0.0
5421      IDIGIT(ICNT)=-1
5422      ICNT=ICNT+1
5423      ITEXT(ICNT)='Estimate of Theta:'
5424      NCTEXT(ICNT)=18
5425      AVALUE(ICNT)=THETML
5426      IDIGIT(ICNT)=NUMDIG
5427      ICNT=ICNT+1
5428      ITEXT(ICNT)='Estimate of Pi:'
5429      NCTEXT(ICNT)=15
5430      AVALUE(ICNT)=PIML
5431      IDIGIT(ICNT)=NUMDIG
5432      ICNT=ICNT+1
5433      ITEXT(ICNT)='Estimate of Alpha:'
5434      NCTEXT(ICNT)=18
5435      AVALUE(ICNT)=ALPHML
5436      IDIGIT(ICNT)=NUMDIG
5437      ICNT=ICNT+1
5438      ITEXT(ICNT)='Estimate of Beta:'
5439      NCTEXT(ICNT)=17
5440      AVALUE(ICNT)=BETAML
5441      IDIGIT(ICNT)=NUMDIG
5442      ICNT=ICNT+1
5443      ITEXT(ICNT)='Approximate Standard Error of Theta:'
5444      NCTEXT(ICNT)=36
5445      AVALUE(ICNT)=SQRT(VARTHE)
5446      IDIGIT(ICNT)=NUMDIG
5447      ICNT=ICNT+1
5448      ITEXT(ICNT)='Approximate Standard Error of Pi:'
5449      NCTEXT(ICNT)=33
5450      AVALUE(ICNT)=SQRT(VARPI)
5451      IDIGIT(ICNT)=NUMDIG
5452      ICNT=ICNT+1
5453      ITEXT(ICNT)=' '
5454      NCTEXT(ICNT)=0
5455      AVALUE(ICNT)=0.0
5456      IDIGIT(ICNT)=-1
5457C
5458      NUMROW=ICNT
5459      DO2310I=1,NUMROW
5460        NTOT(I)=15
5461 2310 CONTINUE
5462C
5463      IFRST=.TRUE.
5464      ILAST=.TRUE.
5465      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
5466     1            AVALUE,IDIGIT,
5467     1            NTOT,NUMROW,
5468     1            ICAPSW,ICAPTY,ILAST,IFRST,
5469     1            ISUBRO,IBUGA3,IERROR)
5470C
5471C               *****************
5472C               **  STEP 90--  **
5473C               **  EXIT       **
5474C               *****************
5475C
5476 9000 CONTINUE
5477      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBG')THEN
5478        WRITE(ICOUT,999)
5479        CALL DPWRST('XXX','WRIT')
5480        WRITE(ICOUT,9011)
5481 9011   FORMAT('***** AT THE END       OF DPMLBG--')
5482        CALL DPWRST('XXX','WRIT')
5483        WRITE(ICOUT,9012)IERROR
5484 9012   FORMAT('IERROR = ',A4)
5485        CALL DPWRST('XXX','WRIT')
5486      ENDIF
5487C
5488      RETURN
5489      END
5490      SUBROUTINE DPMLBI(Y,X,N,NTRIAL,NVAR,
5491     1                  TEMP1,TEMP2,TEMP3,MAXNXT,
5492     1                  P,PCC,PLCL,PUCL,PSD,PSDCC,
5493     1                  ICAPSW,ICAPTY,IFORSW,IBINME,
5494     1                  IBINCC,PBINTH,IOUNI1,
5495     1                  ISUBRO,IBUGA3,IERROR)
5496C
5497C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
5498C              ESTIMATES FOR BINOMIAL DISTRIBUTION
5499C     EXAMPLE--BINOMIAL MAXIMUM LIKELIHOOD Y
5500C     REFERENCES--AGRESTI AND COULL (1998), "APPROXIMATE IS BETTER THAN
5501C                 "EXACT" FOR INTERVAL ESTIMATION OF BINOMIAL
5502C                 PROPORTIONS", AMERICAN STATISTICIAN, 52, 119-126.
5503C               --BROWN, CAI, AND DASGUPTA (2001), "INTERVAL ESTIMATION
5504C                 FOR A BINOMIAL PROPORTION", STATISTICAL SCIENCE,
5505C                 VOL. 16, NO. 2, PP. 101-133.
5506C     WRITTEN BY--ALAN HECKERT
5507C                 STATISTICAL ENGINEERING DIVISION
5508C                 INFORMATION TECHNOLOGY LABORATORY
5509C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
5510C                 GAITHERSBURG, MD 20899-8980
5511C                 PHONE--301-975-2899
5512C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
5513C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
5514C     LANGUAGE--ANSI FORTRAN (1977)
5515C     VERSION NUMBER--98/5
5516C     ORIGINAL VERSION--MAY       1998.
5517C     UPDATED         --MARCH     2004. SUPPORT FOR HTML, LATEX
5518C     UPDATED         --MARCH     2004. CONFIDENCE INTERVAL FOR P
5519C     UPDATED         --MARCH     2004. SUPPORT FOR USER-SPECIFIED
5520C                                       VALUE FOR N (NTRIAL)
5521C     UPDATED         --AUGUST    2005. REFORMAT OUTPUT FOR
5522C                                       CONSISTENCY WITH OTHER ML
5523C                                       ROUTINES
5524C     UPDATED         --AUGUST    2005. IMPROVED CONFIDENCE INTERVALS
5525C                                       FOR P
5526C     UPDATED         --FEBRUARY  2007. FOLLOWING CHANGES:
5527C                                       1) ADDITIONAL ALPHA LEVELS
5528C                                       2) WRITE CONFIDENCE LIMTIS
5529C                                          TO FILE
5530C                                       3) OPTIONAL CONTINUITY
5531C                                          CORRECTION.  NOTE THAT
5532C                                          THIS SHOULD NOT BE APPLIED
5533C                                          TO AGRESTI-COUL.
5534C                                       4) SAVE ADDITIONAL PARAMETERS
5535C                                       5) SET LIMIT FOR CHOOSING
5536C                                          EXACT INTERVAL OR NORMAL
5537C                                          APPROXIMATION
5538C     UPDATED         --APRIL     2007. FOR EXACT LOWER BOUND, DO
5539C                                       NOT USE CONTINUITY CORRECTED
5540C                                       ESTIMATE OF P
5541C     UPDATED         --APRIL     2011. USE DPDTA1 AND DPDTA4 TO PRINT
5542C                                       OUTPUT
5543C     UPDATED         --MARCH     2014. SUPPORT FOR ALTERNATIVE INTERVALS.
5544C
5545C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
5546C
5547      CHARACTER*4 ICAPSW
5548      CHARACTER*4 ICAPTY
5549      CHARACTER*4 IFORSW
5550      CHARACTER*4 IBINME
5551      CHARACTER*4 IBINCC
5552      CHARACTER*4 ISUBRO
5553      CHARACTER*4 IBUGA3
5554      CHARACTER*4 IERROR
5555C
5556      CHARACTER*4 IWRITE
5557      CHARACTER*4 ISUBN1
5558      CHARACTER*4 ISUBN2
5559      CHARACTER*4 ISTEPN
5560C
5561      REAL LCL
5562      REAL UCL
5563C
5564C---------------------------------------------------------------------
5565C
5566      DIMENSION Y(*)
5567      DIMENSION X(*)
5568      DIMENSION TEMP1(*)
5569      DIMENSION TEMP2(*)
5570      DIMENSION TEMP3(*)
5571C
5572      PARAMETER (NUMALP=8)
5573      DIMENSION ALPHA(NUMALP)
5574      DIMENSION ALOWAC(NUMALP)
5575      DIMENSION AUPPAC(NUMALP)
5576      DIMENSION ALOWNO(NUMALP)
5577      DIMENSION AUPPNO(NUMALP)
5578C
5579      REAL BINFUN
5580      EXTERNAL BINFUN
5581      COMMON/BINCOM/XSUCC,CONST,NTEMP
5582C
5583      PARAMETER (MAXROW=20)
5584      CHARACTER*60 ITITLE
5585      CHARACTER*60 ITITLZ
5586      CHARACTER*60 ITITL9
5587      CHARACTER*40 IDIST
5588      CHARACTER*40 ITEXT(MAXROW)
5589      CHARACTER*4  ALIGN(MAXROW)
5590      CHARACTER*4  VALIGN(MAXROW)
5591      REAL         AVALUE(MAXROW)
5592      INTEGER      NCTEXT(MAXROW)
5593      INTEGER      IDIGIT(MAXROW)
5594      INTEGER      NTOT(MAXROW)
5595      LOGICAL      IFRST
5596      LOGICAL      ILAST
5597C
5598      PARAMETER(NUMCLI=5)
5599      PARAMETER(MAXLIN=3)
5600      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
5601      INTEGER      NCTIT2(MAXLIN,NUMCLI)
5602      INTEGER      IWHTML(NUMCLI+1)
5603      INTEGER      IWRTF(NUMCLI)
5604      REAL         AMAT(NUMALP,NUMCLI)
5605C
5606C---------------------------------------------------------------------
5607C
5608      INCLUDE 'DPCOP2.INC'
5609C
5610CCCCC DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01,  0.001/
5611      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
5612C
5613C-----START POINT-----------------------------------------------------
5614C
5615      ISUBN1='DPML'
5616      ISUBN2='BI  '
5617      IERROR='NO'
5618      IWRITE='OFF'
5619C
5620      PLCL=CPUMIN
5621      PUCL=CPUMIN
5622C
5623      IF(PBINTH.GE.1.0)THEN
5624        PTHRES=INT(PBINTH+0.5)
5625      ELSE
5626        PTHRES=30.0
5627      ENDIF
5628C
5629      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBI')THEN
5630        WRITE(ICOUT,999)
5631  999   FORMAT(1X)
5632        CALL DPWRST('XXX','WRIT')
5633        WRITE(ICOUT,51)
5634   51   FORMAT('**** AT THE BEGINNING OF DPMLBI--')
5635        CALL DPWRST('XXX','WRIT')
5636        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR,IOUNI1,PTHRES
5637   52   FORMAT('IBUGA3,ISUBRO,N,NVAR,IOUNI1,PTHRES = ',
5638     1         2(A4,2X),3I8,G15.7)
5639        CALL DPWRST('XXX','WRIT')
5640        IF(NVAR.EQ.1)THEN
5641          DO56I=1,MIN(N,100)
5642            WRITE(ICOUT,57)I,Y(I)
5643   57       FORMAT('I,Y(I) = ',I8,G15.7)
5644            CALL DPWRST('XXX','WRIT')
5645   56     CONTINUE
5646        ELSE
5647          DO61I=1,N
5648            WRITE(ICOUT,62)I,X(I),Y(I)
5649   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
5650            CALL DPWRST('XXX','WRIT')
5651   61     CONTINUE
5652        ENDIF
5653       ENDIF
5654C
5655C               ********************************************
5656C               **  STEP 11--                             **
5657C               **  1) ROUND DATA TO INTEGER VALUES       **
5658C               **  2) COMPUTE SUMMARY STATISTICS         **
5659C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
5660C               **     INSUFFICIENT SAMPLE SIZE           **
5661C               **  4) FOR RAW DATA CASE, BIN THE DATA.   **
5662C               ********************************************
5663C
5664      ISTEPN='11'
5665      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLBI')
5666     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
5667C
5668      IDIST='BINOMIAL'
5669C
5670      NPERC=0
5671      MAXGRP=MAXNXT/2
5672      NMIN=2
5673      IF(NVAR.EQ.1)THEN
5674        DO1105I=1,N
5675          ITEMP=INT(Y(I)+0.5)
5676          Y(I)=REAL(ITEMP)
5677 1105   CONTINUE
5678        CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
5679        IF(IERROR.EQ.'YES')GOTO9000
5680C
5681C       BINOMIAL HAS ADDITIONAL CHECK:
5682C
5683C           1) IF NTRIAL = 1, THEN ONLY 0 OR 1 VALUES ALLOWED
5684C
5685C           2) IF NTRIAL > 1, THEN NTRIAL IS THE MAXIMUM VALUE
5686C              ALLOWED.
5687C
5688        CALL DISTIN(Y,N,IWRITE,TEMP1,NDIST,IBUGA3,IERROR)
5689        IF(NTRIAL.GT.1)THEN
5690          DO2105I=1,N
5691            ITEMP=INT(Y(I)+0.5)
5692            Y(I)=REAL(ITEMP)
5693            IF(Y(I).LT.0.0 .OR. Y(I).GT.NTRIAL)THEN
5694              WRITE(ICOUT,999)
5695              CALL DPWRST('XXX','WRIT')
5696              WRITE(ICOUT,2111)
5697 2111         FORMAT('***** ERROR FROM BINOMIAL MAXIMUM LIKELIHOOD--')
5698              CALL DPWRST('XXX','WRIT')
5699              WRITE(ICOUT,2113)I,NTRIAL
5700 2113         FORMAT('      ROW ',I8,' IS LESS THAN ZERO OR GREATER ',
5701     1               'THAN ',I8,' (= NUMBER OF TRIALS)')
5702              CALL DPWRST('XXX','WRIT')
5703              IERROR='YES'
5704              GOTO9000
5705            ENDIF
5706 2105     CONTINUE
5707        ELSE
5708          IF(NDIST.GT.2)THEN
5709            WRITE(ICOUT,999)
5710            CALL DPWRST('XXX','WRIT')
5711            WRITE(ICOUT,2111)
5712            CALL DPWRST('XXX','WRIT')
5713            WRITE(ICOUT,2118)NDIST
5714 2118       FORMAT('      FOR BINOMIAL CASE WITH 1 TRIAL, MORE THAN ',
5715     1             'TWO DISTINCT VALUES DETECTED.')
5716            CALL DPWRST('XXX','WRIT')
5717            IERROR='YES'
5718            GOTO9000
5719          ELSEIF(NDIST.EQ.1)THEN
5720            DO2130I=1,N
5721              IF(Y(I).LE.0.5)THEN
5722                Y(I)=0.0
5723              ELSE
5724                Y(I)=1.0
5725              ENDIF
5726 2130       CONTINUE
5727          ELSE
5728            HOLD1=TEMP1(1)
5729            HOLD2=TEMP1(2)
5730            IF(HOLD1.LT.HOLD2)THEN
5731              XMIN=HOLD1
5732              XMAX=HOLD2
5733            ELSE
5734              XMAX=HOLD1
5735              XMIN=HOLD2
5736            ENDIF
5737            DO2120I=1,N
5738              IF(Y(I).EQ.XMAX)THEN
5739                Y(I)=1.0
5740              ELSE
5741                Y(I)=0.0
5742              ENDIF
5743 2120       CONTINUE
5744          ENDIF
5745        ENDIF
5746C
5747        CALL SORT(Y,N,Y)
5748        IFLAG=1
5749        CALL SUMRAW(Y,N,IDIST,IFLAG,
5750     1              XMEAN,XVAR,XSD,XMIN,XMAX,
5751     1              ISUBRO,IBUGA3,IERROR)
5752        CALL SUMDP(Y,N,IWRITE,XSUM,IBUGA3,IERROR)
5753        IF(IERROR.EQ.'YES')GOTO9000
5754        NTOTZZ=N
5755      ELSE
5756        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
5757     1              ISUBRO,IBUGA3,IERROR)
5758        IF(IERROR.EQ.'YES')GOTO9000
5759C
5760C       COMPUTE XSUM AND CHECK THAT X(I) VALUE NOT GREATER
5761C       THAN NTRIAL VALUE
5762C
5763        XSUM=0.0
5764        DO2211I=1,N
5765          ITEMP=INT(Y(I)+0.5)
5766          Y(I)=REAL(ITEMP)
5767          ITEMP=INT(X(I)+0.5)
5768          X(I)=REAL(ITEMP)
5769          IF(X(I).LT.0.0 .OR. X(I).GT.NTRIAL)THEN
5770            WRITE(ICOUT,999)
5771            CALL DPWRST('XXX','WRIT')
5772            WRITE(ICOUT,2111)
5773            CALL DPWRST('XXX','WRIT')
5774            WRITE(ICOUT,2113)I,NTRIAL
5775            CALL DPWRST('XXX','WRIT')
5776            IERROR='YES'
5777            GOTO9000
5778          ENDIF
5779          XSUM=XSUM + Y(I)*X(I)
57802211    CONTINUE
5781        N2=N
5782        IFLAG1=1
5783        IFLAG2=1
5784        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
5785     1              TEMP1,TEMP2,TEMP3,MAXNXT,
5786     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
5787     1              ISUBRO,IBUGA3,IERROR)
5788        IF(IERROR.EQ.'YES')GOTO9000
5789      ENDIF
5790C
5791      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLBI')THEN
5792        WRITE(ICOUT,999)
5793        CALL DPWRST('XXX','WRIT')
5794        WRITE(ICOUT,1151)
5795 1151   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
5796        CALL DPWRST('XXX','WRIT')
5797        WRITE(ICOUT,1152)XMEAN,XVAR,XSD,XMIN,XMAX,XSUM
5798 1152   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX,XSUM = ',6G15.7)
5799        CALL DPWRST('XXX','WRIT')
5800      ENDIF
5801C
5802C               *******************************
5803C               **  STEP 41--                **
5804C               **  CARRY OUT CALCULATIONS   **
5805C               **  FOR BINOMIAL MLE ESTIMATE**
5806C               *******************************
5807C
5808      ISTEPN='21'
5809      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLBI')
5810     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
5811C
5812C     NOTE: COMPUTE P AND PSD BOTH WITH AND WITHOUT
5813C           CONTINUITY CORRECTION.  NOTE THAT THE SD
5814C           FORMULA USES N (RATHER THAN N+1) IN THE
5815C           DENOMINATOR FOR BOTH THE UNCORRECTED AND
5816C           THE CORRECTED CASES.
5817C
5818      IF(NTRIAL.GT.1)THEN
5819        AN=REAL(NTOTZZ)*REAL(NTRIAL)
5820        P=XSUM/(REAL(NTOTZZ)*REAL(NTRIAL))
5821        Q=1.0-P
5822        PSD=SQRT(P*Q/AN)
5823        PCC=(XSUM+0.5)/(REAL(NTOTZZ)*REAL(NTRIAL)+1.0)
5824        ANCC=AN+1.0
5825        QCC=1.0-PCC
5826        PSDCC=SQRT(PCC*QCC/AN)
5827      ELSE
5828        AN=REAL(NTOTZZ)
5829        P=XSUM/REAL(NTOTZZ)
5830        Q=1.0-P
5831        PSD=SQRT(P*Q/AN)
5832        ANCC=AN+1.0
5833        PCC=(XSUM+0.5)/ANCC
5834        QCC=1.0-PCC
5835        PSDCC=SQRT(PCC*QCC/AN)
5836      ENDIF
5837C
5838      NTEMP=N*NTRIAL
5839      XSUCC=XSUM
5840      AE=1.E-6
5841      RE=1.E-6
5842      IFLAG=0
5843C
5844      DO2210I=1,NUMALP
5845C
5846        ALP=ALPHA(I)
5847        P1=ALP/2.0
5848        P2=1.0-(ALP/2.0)
5849C
5850C       GENERATE THE AGRESTI-COULL INTERVALS: THESE DO NOT
5851C       REQUIRE CONTINUITY CORRECTION.
5852C
5853C
5854C       NOTE 2014/03: NOTE THAT WHAT WE ARE CALLING "AGRESTI-COULL" IS
5855C                     NOW COMNONLY REFERRED TO AS THE "WILSON" INTERVAL.
5856C                     WHAT IS TYPICALLY CALLED AGRESTI-COULL IN THE
5857C                     LITERATURE IS WHAT THE AGRESTI-COULL PAPER REFERRED
5858C                     TO AS THE "ADJUSTED WALD".  THE BROWN, CAI, AND
5859C                     DASGUPTA PAPER PERFORMED A DETAILED ANALYSIS OF
5860C                     VARIOUS BINOMIAL APPROXIMATIONS.  THEY RECOMMEND
5861C                     THAT FOR N < 40, EITHER THE WILSON OR A BAYESIAN
5862C                     METHOD BASED ON JEFFREYS PRIORS BE USED.  FOR
5863C                     N > 40, THESE 3 METHODS HAVE COMPARABLE PERFORMANCE.
5864C
5865C                     IN DATAPLOT, YOU CAN SPECIFY THE DESIRED METHOD WITH
5866C                     THE COMMAND
5867C
5868C                     SET BINOMIAL METHOD <WILSON/ADJUSTED WALD/JEFFREYS>
5869C
5870        IF(IBINME.EQ.'WILS')THEN
5871          CALL NORPPF(P2,ZALPHA)
5872          TERM1=ZALPHA*ZALPHA/(2.0*AN)
5873          TERM2=ZALPHA*SQRT((P*Q/AN) + ZALPHA*ZALPHA/(4.0*AN*AN))
5874          TERM3=1.0 + ZALPHA*ZALPHA/AN
5875          UCL=(P + TERM1 + TERM2)/TERM3
5876          LCL=(P + TERM1 - TERM2)/TERM3
5877C
5878C       ADJUSTED WALD METHOD:
5879C
5880        ELSEIF(IBINME.EQ.'WALD')THEN
5881          CALL NORPPF(P2,ZALPHA)
5882          AK2=ZALPHA**2
5883          AX=AN*P
5884          IX=INT(AX+0.5)
5885          AX=REAL(IX) + (AK2/2.0)
5886          ANTEMP=AN + (AK2/2.0)
5887          PTEMP=AX/ANTEMP
5888          LCL=PTEMP - ZALPHA*SQRT(PTEMP*(1.0-PTEMP))/SQRT(ANTEMP)
5889          UCL=PTEMP + ZALPHA*SQRT(PTEMP*(1.0-PTEMP))/SQRT(ANTEMP)
5890        ELSEIF(IBINME.EQ.'JEFF')THEN
5891          AX=AN*P
5892          IX=INT(AX+0.5)
5893          AX=REAL(IX)
5894          ALPHAT=AX+0.5
5895          BETAT=AN-AX+0.5
5896          CALL BETPPF(P1,ALPHAT,BETAT,LCL)
5897          CALL BETPPF(P2,ALPHAT,BETAT,UCL)
5898        ENDIF
5899C
5900        IF(UCL.GT.1.0)UCL=1.0
5901        IF(LCL.LT.0.0)LCL=0.0
5902        ALOWAC(I)=LCL
5903        AUPPAC(I)=UCL
5904C
5905C       FOR NUMBER OF SUCCESSES >= 30, GENERATE NORMAL APPROXIMATION INTERVALS
5906C       FOR NUMBER OF SUCCESSES <  30, GENERATE EXACT INTERVALS
5907C
5908C       FEBRUARY 2007: 1) MAKE THRESHOLD USER SETTABLE.
5909C                      2) USER OPTION ON WHETHER TO USE CORRECTED
5910C                         OR UNCORRECTED INTERVALS.
5911C       APRIL    2007: 1) FOR EXACT BOUND, ALWAYS USE ESTIMATE OF
5912C                         P WITHOUT THE CONTINUITY CORRECTION.
5913C
5914        IF(XSUCC.GE.PTHRES)THEN
5915          CALL NORPPF(P2,ZALPHA)
5916          IF(IBINCC.EQ.'OFF')THEN
5917            UCL=P + ZALPHA*SQRT(P*Q/AN)
5918            LCL=P - ZALPHA*SQRT(P*Q/AN)
5919          ELSE
5920            UCL=PCC + ZALPHA*SQRT(PCC*QCC/AN)
5921            LCL=PCC - ZALPHA*SQRT(PCC*QCC/AN)
5922          ENDIF
5923          IF(UCL.GT.1.0)UCL=1.0
5924          IF(LCL.LT.0.0)LCL=0.0
5925          ALOWNO(I)=LCL
5926          AUPPNO(I)=UCL
5927        ELSE
5928          CONST=P2
5929          PHAT=P
5930          PLOWLI=0.0
5931          PUPPLI=PHAT
5932          XSUCC=XSUM-1.0
5933          IF(XSUCC.LE.0)XSUCC=0.0
5934          IF(PHAT.LE.0.0)THEN
5935            ALOWNO(I)=0.0
5936          ELSE
5937            CALL FZERO(BINFUN,PLOWLI,PUPPLI,PHAT,RE,AE,IFLAG)
5938            IF(PLOWLI.GT.PHAT)THEN
5939              ALOWNO(I)=0.0
5940            ELSE
5941              ALOWNO(I)=PLOWLI
5942            ENDIF
5943            IF(ALOWNO(I).LT.0.0)ALOWNO(I)=0.0
5944          IF(IFLAG.EQ.2)THEN
5945C
5946            WRITE(ICOUT,999)
5947            CALL DPWRST('XXX','BUG ')
5948            WRITE(ICOUT,2311)
5949 2311       FORMAT('***** WARNING FROM BINOMIAL MAXIMUM LIKELIHOOD--')
5950            CALL DPWRST('XXX','BUG ')
5951            WRITE(ICOUT,2313)
5952 2313       FORMAT('      ESTIMATE OF LOWER CONFIDENCE VALUE FOR P ',
5953     1             'MAY NOT BE COMPUTED TO DESIRED TOLERANCE.')
5954            CALL DPWRST('XXX','BUG ')
5955          ELSEIF(IFLAG.EQ.3)THEN
5956            WRITE(ICOUT,999)
5957            CALL DPWRST('XXX','BUG ')
5958            WRITE(ICOUT,2311)
5959            CALL DPWRST('XXX','BUG ')
5960            WRITE(ICOUT,2223)
5961 2223       FORMAT('      ESTIMATE OF LOWER CONFIDENCE VALUE FOR P ',
5962     1             'MAY BE NEAR A SINGULAR POINT.')
5963            CALL DPWRST('XXX','BUG ')
5964          ELSEIF(IFLAG.EQ.4)THEN
5965CCCCC       WRITE(ICOUT,999)
5966CCCCC       CALL DPWRST('XXX','BUG ')
5967CCCCC       WRITE(ICOUT,2211)
5968CCCCC       CALL DPWRST('XXX','BUG ')
5969CCCCC       WRITE(ICOUT,2233)
5970C2233       FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
5971CCCCC       CALL DPWRST('XXX','BUG ')
5972          ELSEIF(IFLAG.EQ.5)THEN
5973            WRITE(ICOUT,999)
5974            CALL DPWRST('XXX','BUG ')
5975            WRITE(ICOUT,2311)
5976            CALL DPWRST('XXX','BUG ')
5977            WRITE(ICOUT,2343)
5978 2343       FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
5979            CALL DPWRST('XXX','BUG ')
5980          ENDIF
5981          ENDIF
5982C
5983          IFLAG=0
5984          CONST=P1
5985          PHAT=P
5986          PLOWLI=PHAT
5987          PUPPLI=1.0
5988          XSUCC=XSUM
5989          IF(XSUCC.LE.0.0)XSUCC=0.0
5990          IF(PHAT.GE.1.0)THEN
5991            AUPPNO(I)=1.0
5992          ELSE
5993            CALL FZERO(BINFUN,PLOWLI,PUPPLI,PHAT,RE,AE,IFLAG)
5994            IF(PLOWLI.LT.PHAT)THEN
5995              AUPPNO(I)=PUPPLI
5996            ELSE
5997              AUPPNO(I)=PLOWLI
5998            ENDIF
5999            IF(AUPPNO(I).GT.1.0)AUPPNO(I)=1.0
6000          IF(IFLAG.EQ.2)THEN
6001C
6002            WRITE(ICOUT,999)
6003            CALL DPWRST('XXX','BUG ')
6004            WRITE(ICOUT,2311)
6005            CALL DPWRST('XXX','BUG ')
6006            WRITE(ICOUT,2263)
6007 2263       FORMAT('      ESTIMATE OF UPPER CONFIDENCE VALUE FOR P ',
6008     1             'MAY NOT BE COMPUTED TO DESIRED TOLERANCE.')
6009            CALL DPWRST('XXX','BUG ')
6010          ELSEIF(IFLAG.EQ.3)THEN
6011            WRITE(ICOUT,999)
6012            CALL DPWRST('XXX','BUG ')
6013            WRITE(ICOUT,2311)
6014            CALL DPWRST('XXX','BUG ')
6015            WRITE(ICOUT,2273)
6016 2273       FORMAT('      ESTIMATE OF UPPER CONFIDENCE VALUE FOR P ',
6017     1             'MAY BE NEAR A SINGULAR POINT.')
6018            CALL DPWRST('XXX','BUG ')
6019          ELSEIF(IFLAG.EQ.4)THEN
6020CCCCC       WRITE(ICOUT,999)
6021CCCCC       CALL DPWRST('XXX','BUG ')
6022CCCCC       WRITE(ICOUT,2311)
6023CCCCC       CALL DPWRST('XXX','BUG ')
6024CCCCC       WRITE(ICOUT,2233)
6025C2233       FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
6026CCCCC       CALL DPWRST('XXX','BUG ')
6027          ELSEIF(IFLAG.EQ.5)THEN
6028            WRITE(ICOUT,999)
6029            CALL DPWRST('XXX','BUG ')
6030            WRITE(ICOUT,2311)
6031            CALL DPWRST('XXX','BUG ')
6032            WRITE(ICOUT,2283)
6033 2283       FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
6034            CALL DPWRST('XXX','BUG ')
6035          ENDIF
6036          ENDIF
6037C
6038        ENDIF
6039C
6040 2210 CONTINUE
6041C
6042C               *********************************
6043C               **   STEP 42--                 **
6044C               **   WRITE OUT EVERYTHING      **
6045C               **   FOR BINOMIAL MLE ESTIMATE **
6046C               **********************************
6047C
6048      ISTEPN='42'
6049      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLBI')
6050     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6051C
6052C     PRINT SUMMARY STATISTICS TABLE
6053C
6054      NUMDIG=7
6055      IF(IFORSW.EQ.'1')NUMDIG=1
6056      IF(IFORSW.EQ.'2')NUMDIG=2
6057      IF(IFORSW.EQ.'3')NUMDIG=3
6058      IF(IFORSW.EQ.'4')NUMDIG=4
6059      IF(IFORSW.EQ.'5')NUMDIG=5
6060      IF(IFORSW.EQ.'6')NUMDIG=6
6061      IF(IFORSW.EQ.'7')NUMDIG=7
6062      IF(IFORSW.EQ.'8')NUMDIG=8
6063      IF(IFORSW.EQ.'9')NUMDIG=9
6064      IF(IFORSW.EQ.'0')NUMDIG=0
6065      IF(IFORSW.EQ.'E')NUMDIG=-2
6066      IF(IFORSW.EQ.'-2')NUMDIG=-2
6067      IF(IFORSW.EQ.'-3')NUMDIG=-3
6068      IF(IFORSW.EQ.'-4')NUMDIG=-4
6069      IF(IFORSW.EQ.'-5')NUMDIG=-5
6070      IF(IFORSW.EQ.'-6')NUMDIG=-6
6071      IF(IFORSW.EQ.'-7')NUMDIG=-7
6072      IF(IFORSW.EQ.'-8')NUMDIG=-8
6073      IF(IFORSW.EQ.'-9')NUMDIG=-9
6074C
6075      ITITLE='Binomial Parameter Estimation'
6076      NCTITL=29
6077      ITITLZ=' '
6078      NCTITZ=0
6079C
6080      ICNT=1
6081      ITEXT(ICNT)='Summary Statistics:'
6082      NCTEXT(ICNT)=19
6083      AVALUE(ICNT)=0.0
6084      IDIGIT(ICNT)=-1
6085      ICNT=ICNT+1
6086      ITEXT(ICNT)='Number of Observations:'
6087      NCTEXT(ICNT)=23
6088      AVALUE(ICNT)=REAL(NTOTZZ)
6089      IDIGIT(ICNT)=0
6090      ICNT=ICNT+1
6091      ITEXT(ICNT)='Number of Trials:'
6092      NCTEXT(ICNT)=17
6093      AVALUE(ICNT)=REAL(NTRIAL)
6094      IDIGIT(ICNT)=0
6095      ICNT=ICNT+1
6096      ITEXT(ICNT)='Number of Successes:'
6097      NCTEXT(ICNT)=20
6098      AVALUE(ICNT)=XSUM
6099      IDIGIT(ICNT)=0
6100      ICNT=ICNT+1
6101      ITEXT(ICNT)='Sample Mean:'
6102      NCTEXT(ICNT)=12
6103      AVALUE(ICNT)=XMEAN
6104      IDIGIT(ICNT)=NUMDIG
6105      ICNT=ICNT+1
6106      ITEXT(ICNT)='Sample Standard Deviation:'
6107      NCTEXT(ICNT)=26
6108      AVALUE(ICNT)=XSD
6109      IDIGIT(ICNT)=NUMDIG
6110      ICNT=ICNT+1
6111      ITEXT(ICNT)='Sample Minimum:'
6112      NCTEXT(ICNT)=15
6113      AVALUE(ICNT)=XMIN
6114      IDIGIT(ICNT)=NUMDIG
6115      ICNT=ICNT+1
6116      ITEXT(ICNT)='Sample Maximum:'
6117      NCTEXT(ICNT)=15
6118      AVALUE(ICNT)=XMAX
6119      IDIGIT(ICNT)=NUMDIG
6120      ICNT=ICNT+1
6121      ITEXT(ICNT)='Binomal SD (= SQRT(P*Q/N) (Uncorrected):'
6122      NCTEXT(ICNT)=40
6123      AVALUE(ICNT)=PSD
6124      IDIGIT(ICNT)=NUMDIG
6125      ICNT=ICNT+1
6126      ITEXT(ICNT)='Binomal SD (with Continuity Correction):'
6127      NCTEXT(ICNT)=40
6128      AVALUE(ICNT)=PSDCC
6129      IDIGIT(ICNT)=NUMDIG
6130      ICNT=ICNT+1
6131      ITEXT(ICNT)=' '
6132      NCTEXT(ICNT)=0
6133      AVALUE(ICNT)=0.0
6134      IDIGIT(ICNT)=-1
6135C
6136      ICNT=ICNT+1
6137      ITEXT(ICNT)='Method of Maximum Likelihood:'
6138      NCTEXT(ICNT)=29
6139      AVALUE(ICNT)=0.0
6140      IDIGIT(ICNT)=-1
6141      ICNT=ICNT+1
6142      ITEXT(ICNT)='Estimate of P (Uncorrected):'
6143      NCTEXT(ICNT)=28
6144      AVALUE(ICNT)=P
6145      IDIGIT(ICNT)=NUMDIG
6146      ICNT=ICNT+1
6147      ITEXT(ICNT)='Estimate of P (Continuity Correction):'
6148      NCTEXT(ICNT)=38
6149      AVALUE(ICNT)=PCC
6150      IDIGIT(ICNT)=NUMDIG
6151C
6152      NUMROW=ICNT
6153      DO2410I=1,NUMROW
6154        NTOT(I)=15
6155 2410 CONTINUE
6156C
6157      IFRST=.TRUE.
6158      ILAST=.TRUE.
6159      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
6160     1            AVALUE,IDIGIT,
6161     1            NTOT,NUMROW,
6162     1            ICAPSW,ICAPTY,ILAST,IFRST,
6163     1            ISUBRO,IBUGA3,IERROR)
6164C
6165      ITITL9='Confidence Interval for Probability of Success Parameter'
6166      NCTIT9=59
6167      IF(IBINCC.EQ.'ON')THEN
6168        ITITLE='Continuity Correction for Normal/Exact Intervals'
6169        NCTITL=48
6170      ELSE
6171        ITITLE='No Continuity Correction for Normal/Exact Intervals'
6172        NCTITL=51
6173      ENDIF
6174C
6175      NUMLIN=3
6176      NUMCOL=5
6177      DO2510J=1,NUMCLI
6178        DO2520I=1,NUMLIN
6179          ITITL2(I,J)=' '
6180          NCTIT2(I,J)=0
6181 2520   CONTINUE
6182 2510 CONTINUE
6183C
6184      ITITL2(2,1)='Confidence'
6185      ITITL2(3,1)='Value (%)'
6186      NCTIT2(2,1)=10
6187      NCTIT2(3,1)=9
6188C
6189      ITITL2(1,2)='Exact'
6190      ITITL2(2,2)='Lower'
6191      ITITL2(3,2)='Limit'
6192      NCTIT2(1,2)=5
6193      NCTIT2(2,2)=5
6194      NCTIT2(3,2)=5
6195C
6196      ITITL2(1,3)='Interval'
6197      ITITL2(2,3)='Upper'
6198      ITITL2(3,3)='Limit'
6199      NCTIT2(1,3)=8
6200      NCTIT2(2,3)=5
6201      NCTIT2(3,3)=5
6202C
6203      ITITL2(1,4)='Agresti-Coull'
6204      ITITL2(2,4)='Lower'
6205      ITITL2(3,4)='Limit'
6206      NCTIT2(1,4)=13
6207      NCTIT2(2,4)=5
6208      NCTIT2(3,4)=5
6209C
6210      ITITL2(1,5)='Approximation'
6211      ITITL2(2,5)='Upper'
6212      ITITL2(3,5)='Limit'
6213      NCTIT2(1,5)=13
6214      NCTIT2(2,5)=5
6215      NCTIT2(3,5)=5
6216C
6217      IF(XSUM.GE.PTHRES)THEN
6218        ITITL2(1,2)='Normal'
6219        NCTIT2(1,2)=6
6220        ITITL2(1,3)='Approximation'
6221        NCTIT2(1,3)=13
6222      ENDIF
6223C
6224      NMAX=0
6225      DO2321I=1,NUMCOL
6226        VALIGN(I)='b'
6227        ALIGN(I)='r'
6228        NTOT(I)=15
6229        NMAX=NMAX+NTOT(I)
6230        IDIGIT(I)=NUMDIG
6231 2321 CONTINUE
6232      IDIGIT(1)=3
6233      DO2323I=1,NUMALP
6234        NCTEXT(I)=0
6235        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
6236        AMAT(I,2)=ALOWNO(I)
6237        AMAT(I,3)=AUPPNO(I)
6238        AMAT(I,4)=ALOWAC(I)
6239        AMAT(I,5)=AUPPAC(I)
6240 2323 CONTINUE
6241      IWHTML(1)=100
6242      IWHTML(2)=150
6243      IWHTML(3)=150
6244      IWHTML(4)=150
6245      IWHTML(5)=150
6246      IWHTML(6)=150
6247      IWRTF(1)=1600
6248      IWRTF(2)=IWRTF(1)+1800
6249      IWRTF(3)=IWRTF(2)+1800
6250      IWRTF(4)=IWRTF(3)+1800
6251      IWRTF(5)=IWRTF(4)+1800
6252      IFRST=.TRUE.
6253      ILAST=.TRUE.
6254C
6255      CALL DPDTA2(ITITL9,NCTIT9,
6256     1            ITITLE,NCTITL,ITITL2,NCTIT2,
6257     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
6258     1            ITEXT,NCTEXT,AMAT,NUMALP,NUMALP,
6259     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
6260     1            ICAPSW,ICAPTY,IFRST,ILAST,
6261     1            ISUBRO,IBUGA3,IERROR)
6262C
6263C               *****************
6264C               **  STEP 90--  **
6265C               **  EXIT       **
6266C               *****************
6267C
6268 9000 CONTINUE
6269      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBI')THEN
6270        WRITE(ICOUT,999)
6271        CALL DPWRST('XXX','WRIT')
6272        WRITE(ICOUT,9011)
6273 9011   FORMAT('***** AT THE END       OF DPMLBI--')
6274        CALL DPWRST('XXX','WRIT')
6275        WRITE(ICOUT,9012)IERROR
6276 9012   FORMAT('IERROR = ',A4)
6277        CALL DPWRST('XXX','WRIT')
6278      ENDIF
6279C
6280      RETURN
6281      END
6282      SUBROUTINE DPMLBN(Y,N,
6283     1                  XTEMP,DTEMP1,MAXNXT,
6284     1                  AMUSV,SIGMSV,ALPHSV,BETASV,
6285     1                  AMUML,SIGMML,ALPHML,BETAML,
6286     1                  ICAPSW,ICAPTY,IFORSW,
6287     1                  ISUBRO,IBUGA3,IERROR)
6288C
6289C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
6290C              ESTIMATES FOR THE BETA NORMAL DISTRIBUTION.
6291C     EXAMPLE--BETA NORMAL MLE Y
6292C     REFERENCE--EUGENE, LEE, AND FAMOYE (2002), "BETA-NORMAL
6293C                DISTRIBUTION AND ITS APPLICATIONS", COMMUNICATIONS
6294C                IN STATISTICS--THEORY AND METHODS, 31(4),
6295C                PP. 497-512.
6296C     WRITTEN BY--ALAN HECKERT
6297C                 STATISTICAL ENGINEERING DIVISION
6298C                 INFORMATION TECHNOLOGY LABORATORY
6299C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
6300C                 GAITHERSBURG, MD 20899-8980
6301C                 PHONE--301-975-2899
6302C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
6303C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
6304C     LANGUAGE--ANSI FORTRAN (1977)
6305C     VERSION NUMBER--2007/6
6306C     ORIGINAL VERSION--JUNE      2007.
6307C     UPDATED         --JULY      2010. USE DPDTA1 TO PRINT OUTPUT
6308C     UPDATED         --JULY      2010. EXTRACT POINT ESTIMATES TO
6309C                                       BNOML1
6310C
6311C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
6312C
6313      CHARACTER*4 ICAPSW
6314      CHARACTER*4 ICAPTY
6315      CHARACTER*4 IFORSW
6316      CHARACTER*4 ISUBRO
6317      CHARACTER*4 IBUGA3
6318      CHARACTER*4 IERROR
6319      CHARACTER*4 IWRITE
6320C
6321      CHARACTER*4 ISUBN1
6322      CHARACTER*4 ISUBN2
6323      CHARACTER*4 ISTEPN
6324C
6325C---------------------------------------------------------------------
6326C
6327      DIMENSION Y(*)
6328      DIMENSION XTEMP(*)
6329      DOUBLE PRECISION DTEMP1(*)
6330C
6331      DIMENSION QP(1)
6332C
6333      PARAMETER (MAXROW=20)
6334      CHARACTER*50 ITITLE
6335      CHARACTER*16 ITITLZ
6336      CHARACTER*50 ITEXT(MAXROW)
6337      REAL         AVALUE(MAXROW)
6338      INTEGER      NCTEXT(MAXROW)
6339      INTEGER      IDIGIT(MAXROW)
6340      INTEGER      NTOT(MAXROW)
6341      LOGICAL IFRST
6342      LOGICAL ILAST
6343C
6344      INCLUDE 'DPCOP2.INC'
6345C
6346C-----START POINT-----------------------------------------------------
6347C
6348      ISUBN1='DPML'
6349      ISUBN2='BN  '
6350      IERROR='NO'
6351C
6352      XTEMP(1)=0.0
6353C
6354      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBN')THEN
6355        WRITE(ICOUT,999)
6356  999   FORMAT(1X)
6357        CALL DPWRST('XXX','WRIT')
6358        WRITE(ICOUT,51)
6359   51   FORMAT('**** AT THE BEGINNING OF DPMLBN--')
6360        CALL DPWRST('XXX','WRIT')
6361        WRITE(ICOUT,52)IBUGA3,ISUBRO,N
6362   52   FORMAT('IBUGA3,ISUBRO,N = ',A4,2X,A4,2X,I8)
6363        CALL DPWRST('XXX','WRIT')
6364        DO56I=1,MIN(N,100)
6365          WRITE(ICOUT,57)I,Y(I)
6366   57     FORMAT('I,Y(I) = ',I8,E15.7)
6367          CALL DPWRST('XXX','WRIT')
6368   56   CONTINUE
6369      ENDIF
6370C
6371C               ********************************************
6372C               **  STEP 11--                             **
6373C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
6374C               ********************************************
6375C
6376      ISTEPN='11'
6377      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBN')
6378     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6379C
6380      NPERC=0
6381      NMIN=5
6382      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
6383      IF(IERROR.EQ.'YES')GOTO9000
6384C
6385C               *************************************
6386C               **  STEP 31--                      **
6387C               **  CARRY OUT CALCULATIONS         **
6388C               **  FOR BETA NORMAL MLE ESTIMATION **
6389C               *************************************
6390C
6391      ISTEPN='31'
6392      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBN')
6393     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6394C
6395      IERROR='NO'
6396      IWRITE='OFF'
6397C
6398      CALL BNOML1(Y,N,MAXNXT,DTEMP1,
6399     1            XMEAN,XSD,XVAR,XMIN,XMAX,
6400     1            AMUSV,SIGMSV,ALPHSV,BETASV,
6401     1            AMUML,SIGMML,ALPHML,BETAML,
6402     1            ISUBRO,IBUGA3,IERROR)
6403C
6404C               ****************************************
6405C               **   STEP 42--                        **
6406C               **   WRITE OUT EVERYTHING             **
6407C               **   FOR BETA NORMAL MLE ESTIMATION   **
6408C               ****************************************
6409C
6410      ISTEPN='42'
6411      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBN')
6412     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6413C
6414      IF(IPRINT.EQ.'OFF')GOTO9000
6415C
6416      NUMDIG=7
6417      IF(IFORSW.EQ.'1')NUMDIG=1
6418      IF(IFORSW.EQ.'2')NUMDIG=2
6419      IF(IFORSW.EQ.'3')NUMDIG=3
6420      IF(IFORSW.EQ.'4')NUMDIG=4
6421      IF(IFORSW.EQ.'5')NUMDIG=5
6422      IF(IFORSW.EQ.'6')NUMDIG=6
6423      IF(IFORSW.EQ.'7')NUMDIG=7
6424      IF(IFORSW.EQ.'8')NUMDIG=8
6425      IF(IFORSW.EQ.'9')NUMDIG=9
6426      IF(IFORSW.EQ.'0')NUMDIG=0
6427      IF(IFORSW.EQ.'E')NUMDIG=-2
6428      IF(IFORSW.EQ.'-2')NUMDIG=-2
6429      IF(IFORSW.EQ.'-3')NUMDIG=-3
6430      IF(IFORSW.EQ.'-4')NUMDIG=-4
6431      IF(IFORSW.EQ.'-5')NUMDIG=-5
6432      IF(IFORSW.EQ.'-6')NUMDIG=-6
6433      IF(IFORSW.EQ.'-7')NUMDIG=-7
6434      IF(IFORSW.EQ.'-8')NUMDIG=-8
6435      IF(IFORSW.EQ.'-9')NUMDIG=-9
6436C
6437      ITITLE='Beta-Normal Parameter Estimation:'
6438      NCTITL=33
6439      ITITLZ='Full Sample Case'
6440      NCTITZ=16
6441      ICNT=1
6442      ITEXT(ICNT)='Summary Statistics:'
6443      NCTEXT(ICNT)=19
6444      AVALUE(ICNT)=0.0
6445      IDIGIT(ICNT)=-1
6446      ICNT=ICNT+1
6447      ITEXT(ICNT)='Number of Observations:'
6448      NCTEXT(ICNT)=23
6449      AVALUE(ICNT)=REAL(N)
6450      IDIGIT(ICNT)=0
6451      ICNT=ICNT+1
6452      ITEXT(ICNT)='Sample Mean:'
6453      NCTEXT(ICNT)=12
6454      AVALUE(ICNT)=XMEAN
6455      IDIGIT(ICNT)=NUMDIG
6456      ICNT=ICNT+1
6457      ITEXT(ICNT)='Sample Standard Deviation:'
6458      NCTEXT(ICNT)=26
6459      AVALUE(ICNT)=XSD
6460      IDIGIT(ICNT)=NUMDIG
6461      ICNT=ICNT+1
6462      ITEXT(ICNT)='Sample Minimum:'
6463      NCTEXT(ICNT)=15
6464      AVALUE(ICNT)=XMIN
6465      IDIGIT(ICNT)=NUMDIG
6466      ICNT=ICNT+1
6467      ITEXT(ICNT)='Sample Maximum:'
6468      NCTEXT(ICNT)=15
6469      AVALUE(ICNT)=XMAX
6470      IDIGIT(ICNT)=NUMDIG
6471      ICNT=ICNT+1
6472      ITEXT(ICNT)=' '
6473      NCTEXT(ICNT)=0
6474      AVALUE(ICNT)=0.0
6475      IDIGIT(ICNT)=-1
6476C
6477      ICNT=ICNT+1
6478      ITEXT(ICNT)='Maximum Likelihood:'
6479      NCTEXT(ICNT)=19
6480      AVALUE(ICNT)=0.0
6481      IDIGIT(ICNT)=-1
6482      ICNT=ICNT+1
6483      ITEXT(ICNT)='Estimate of Location:'
6484      NCTEXT(ICNT)=21
6485      AVALUE(ICNT)=AMUML
6486      IDIGIT(ICNT)=NUMDIG
6487      ICNT=ICNT+1
6488      ITEXT(ICNT)='Estimate of Scale:'
6489      NCTEXT(ICNT)=18
6490      AVALUE(ICNT)=SIGMML
6491      IDIGIT(ICNT)=NUMDIG
6492      ICNT=ICNT+1
6493      ITEXT(ICNT)='Estimate of Shape Parameter Alpha:'
6494      NCTEXT(ICNT)=34
6495      AVALUE(ICNT)=ALPHML
6496      IDIGIT(ICNT)=NUMDIG
6497      ICNT=ICNT+1
6498      ITEXT(ICNT)='Estimate of Shape Parameter Beta:'
6499      NCTEXT(ICNT)=33
6500      AVALUE(ICNT)=BETAML
6501      IDIGIT(ICNT)=NUMDIG
6502      ICNT=ICNT+1
6503      ITEXT(ICNT)=' '
6504      NCTEXT(ICNT)=0
6505      AVALUE(ICNT)=0.0
6506      IDIGIT(ICNT)=-1
6507C
6508CCCCC ICNT=ICNT+1
6509CCCCC ITEXT(ICNT)='Log-likelihood:'
6510CCCCC NCTEXT(ICNT)=15
6511CCCCC AVALUE(ICNT)=ALIK
6512CCCCC IDIGIT(ICNT)=-7
6513CCCCC ICNT=ICNT+1
6514CCCCC ITEXT(ICNT)='AIC:'
6515CCCCC NCTEXT(ICNT)=4
6516CCCCC AVALUE(ICNT)=AIC
6517CCCCC IDIGIT(ICNT)=-7
6518CCCCC ICNT=ICNT+1
6519CCCCC ITEXT(ICNT)='AICc:'
6520CCCCC NCTEXT(ICNT)=5
6521CCCCC AVALUE(ICNT)=AICC
6522CCCCC IDIGIT(ICNT)=-7
6523CCCCC ICNT=ICNT+1
6524CCCCC ITEXT(ICNT)='BIC:'
6525CCCCC NCTEXT(ICNT)=4
6526CCCCC AVALUE(ICNT)=BIC
6527CCCCC IDIGIT(ICNT)=-7
6528C
6529      NUMROW=ICNT
6530      DO2320I=1,NUMROW
6531        NTOT(I)=15
6532 2320 CONTINUE
6533C
6534      IFRST=.TRUE.
6535      ILAST=.TRUE.
6536      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
6537     1            AVALUE,IDIGIT,
6538     1            NTOT,NUMROW,
6539     1            ICAPSW,ICAPTY,ILAST,IFRST,
6540     1            ISUBRO,IBUGA3,IERROR)
6541C
6542C               *****************
6543C               **  STEP 90--  **
6544C               **  EXIT       **
6545C               *****************
6546C
6547 9000 CONTINUE
6548      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBN')THEN
6549        WRITE(ICOUT,999)
6550        CALL DPWRST('XXX','WRIT')
6551        WRITE(ICOUT,9011)
6552 9011   FORMAT('***** AT THE END       OF DPMLBN--')
6553        CALL DPWRST('XXX','WRIT')
6554        WRITE(ICOUT,9012)N,IBUGA3,IERROR
6555 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
6556        CALL DPWRST('XXX','WRIT')
6557        WRITE(ICOUT,9015)N
6558 9015   FORMAT('N = ',I8)
6559        CALL DPWRST('XXX','WRIT')
6560      ENDIF
6561C
6562      RETURN
6563      END
6564      SUBROUTINE DPMLBT(Y,X,N,NVAR,
6565     1                  TEMP1,TEMP2,TEMP3,MAXNXT,
6566     1                  AKHAT,ALAMHT,
6567     1                  AIC,AICC,BIC,
6568     1                  ICAPSW,ICAPTY,IFORSW,
6569     1                  ISUBRO,IBUGA3,IERROR)
6570C
6571C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
6572C              ESTIMATES FOR THE BOREL-TANNER DISTRIBUTION.
6573C              THE MAXIMUM LIKELIHOOD ESTIMATES ARE:
6574C
6575C              1) USE THE MINIMUM VALUE AS THE ESTIMATE OF
6576C                 K.
6577C
6578C              2) THEN USE
6579C
6580C                   (XMEAN - K)/XMEAN
6581C
6582C                 AS THE ESTIMATE OF LAMBDA.  NOTE THAT THIS
6583C                 IS BOTH THE MOMENT AND MAXIMUM LIKELIHOOD
6584C                 ESTIMATE.
6585C
6586C              THERE ARE TWO CASES:
6587C
6588C              1) ONE VARIABLE CASE: Y IS RAW DATA
6589C              2) TWO VARIABLE CASE: Y IS FREQUENCY, X IS CLASS
6590C                 MID-POINT.
6591C
6592C     EXAMPLE--BOREL-TANNER MAXIMUM LIKELIHOOD Y
6593C            --BOREL-TANNER MAXIMUM LIKELIHOOD Y X
6594C     REFERENCES--JOHNSON, KOTZ, AND KEMP (1992).  "UNIVARIATE
6595C                 DISCRETE DISTRIBUTIONS", SECOND EDITION,
6596C                 WILEY, PP. 394-396.
6597C               --LUC DEVROYE, "THE BRANCHING PROCESS METHOD IN
6598C                 LAGRANGE RANDOM VARIATE GENERATION",
6599C                 FROM DEVROYES'S WEB SITE.
6600C               --HAIGHT AND BREUER (1960), "THE BOREL-TANNER
6601C                 DISTRIBUTION", BIOMETRIKA, 47, PP. 143-150.
6602C     WRITTEN BY--ALAN HECKERT
6603C                 STATISTICAL ENGINEERING DIVISION
6604C                 INFORMATION TECHNOLOGY LABORATORY
6605C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
6606C                 GAITHERSBUG, MD 20899-8980
6607C                 PHONE--301-975-2899
6608C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
6609C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
6610C     LANGUAGE--ANSI FORTRAN (1977)
6611C     VERSION NUMBER--2006/5
6612C     ORIGINAL VERSION--MAY       2006.
6613C     UPDATED         --APRIL     2011. USE DPDTA1 TO PRINT THE OUTPUT
6614C
6615C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-----------------
6616C
6617      CHARACTER*4 ICAPSW
6618      CHARACTER*4 ICAPTY
6619      CHARACTER*4 IFORSW
6620      CHARACTER*4 ISUBRO
6621      CHARACTER*4 IBUGA3
6622      CHARACTER*4 IERROR
6623C
6624      CHARACTER*4 IWRITE
6625      CHARACTER*4 ISUBN1
6626      CHARACTER*4 ISUBN2
6627      CHARACTER*4 ISTEPN
6628C
6629      PARAMETER (MAXROW=20)
6630      CHARACTER*60 ITITLE
6631      CHARACTER*1  ITITLZ
6632      CHARACTER*40 IDIST
6633      CHARACTER*40 ITEXT(MAXROW)
6634      REAL         AVALUE(MAXROW)
6635      INTEGER      NCTEXT(MAXROW)
6636      INTEGER      IDIGIT(MAXROW)
6637      INTEGER      NTOT(MAXROW)
6638      LOGICAL      IFRST
6639      LOGICAL      ILAST
6640C
6641C-------------------------------------------------------------------
6642C
6643      DIMENSION Y(*)
6644      DIMENSION X(*)
6645      DIMENSION TEMP1(*)
6646      DIMENSION TEMP2(*)
6647      DIMENSION TEMP3(*)
6648C
6649C-------------------------------------------------------------------
6650C
6651      INCLUDE 'DPCOP2.INC'
6652C
6653C-----START POINT---------------------------------------------------
6654C
6655      ISUBN1='DPML'
6656      ISUBN2='BT  '
6657      IERROR='NO'
6658      IWRITE='OFF'
6659C
6660      AKHAT=CPUMIN
6661      ALAMHT=CPUMIN
6662      AIC=CPUMIN
6663      AICC=CPUMIN
6664      BIC=CPUMIN
6665C
6666      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLNM')THEN
6667        WRITE(ICOUT,999)
6668  999   FORMAT(1X)
6669        CALL DPWRST('XXX','WRIT')
6670        WRITE(ICOUT,51)
6671   51   FORMAT('**** AT THE BEGINNING OF DPMLBT--')
6672        CALL DPWRST('XXX','WRIT')
6673        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR
6674   52   FORMAT('IBUGA3,ISUBRO,N,NVAR = ',2(A4,2X),2I8)
6675        CALL DPWRST('XXX','WRIT')
6676        IF(NVAR.EQ.1)THEN
6677          DO56I=1,MIN(N,100)
6678            WRITE(ICOUT,57)I,Y(I)
6679   57       FORMAT('I,Y(I) = ',I8,G15.7)
6680            CALL DPWRST('XXX','WRIT')
6681   56     CONTINUE
6682        ELSE
6683          DO61I=1,N
6684            WRITE(ICOUT,62)I,X(I),Y(I)
6685   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
6686            CALL DPWRST('XXX','WRIT')
6687   61     CONTINUE
6688        ENDIF
6689      ENDIF
6690C
6691C               ********************************************
6692C               **  STEP 11--                             **
6693C               **  1) ROUND DATA TO INTEGER VALUES       **
6694C               **  2) COMPUTE SUMMARY STATISTICS         **
6695C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
6696C               **     INSUFFICIENT SAMPLE SIZE           **
6697C               ********************************************
6698C
6699      ISTEPN='11'
6700      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLBT')
6701     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6702C
6703      IDIST='BOREL-TANNER'
6704      NPERC=0
6705      MAXGRP=MAXNXT/2
6706      NMIN=2
6707C
6708      IF(NVAR.EQ.1)THEN
6709        DO1105I=1,N
6710          ITEMP=INT(Y(I)+0.5)
6711          Y(I)=REAL(ITEMP)
6712 1105   CONTINUE
6713        CALL CKDIST(Y,N,NMIN,TEMP2,NPERC,ISUBRO,IBUGA3,IERROR)
6714        IF(IERROR.EQ.'YES')GOTO9000
6715C
6716        IFLAG=1
6717        CALL SUMRAW(Y,N,IDIST,IFLAG,
6718     1              XMEAN,XVAR,XSD,XMIN,XMAX,
6719     1              ISUBRO,IBUGA3,IERROR)
6720        IF(IERROR.EQ.'YES')GOTO9000
6721        NTOTZZ=N
6722C
6723      ELSE
6724        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
6725     1              ISUBRO,IBUGA3,IERROR)
6726        IF(IERROR.EQ.'YES')GOTO9000
6727        IFLAG1=1
6728        IFLAG2=1
6729        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
6730     1              TEMP1,TEMP2,TEMP3,MAXNXT,
6731     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
6732     1              ISUBRO,IBUGA3,IERROR)
6733        IF(IERROR.EQ.'YES')GOTO9000
6734      ENDIF
6735C
6736      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLBT')THEN
6737        WRITE(ICOUT,999)
6738        CALL DPWRST('XXX','WRIT')
6739        WRITE(ICOUT,1151)
6740 1151   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
6741        CALL DPWRST('XXX','WRIT')
6742        WRITE(ICOUT,1152)XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ
6743 1152   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ = ',5G15.7,I10)
6744        CALL DPWRST('XXX','WRIT')
6745      ENDIF
6746C
6747C               *****************************************
6748C               **  STEP 21--                          **
6749C               **  CARRY OUT CALCULATIONS             **
6750C               **  FOR BOREL-TANNER MLE ESTIMATION    **
6751C               *****************************************
6752C
6753      ISTEPN='21'
6754      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLBT')
6755     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6756C
6757      AKHAT=XMIN
6758      ALAMHT=(XMEAN-AKHAT)/XMEAN
6759C
6760C               ***********************************************
6761C               **   STEP 42--                               **
6762C               **   WRITE OUT EVERYTHING                    **
6763C               **   FOR BOREL-TANNER MLE ESTIMATION         **
6764C               ***********************************************
6765C
6766      ISTEPN='42'
6767      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLBT')
6768     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6769C
6770C     PRINT SUMMARY STATISTICS TABLE
6771C
6772      NUMDIG=7
6773      IF(IFORSW.EQ.'1')NUMDIG=1
6774      IF(IFORSW.EQ.'2')NUMDIG=2
6775      IF(IFORSW.EQ.'3')NUMDIG=3
6776      IF(IFORSW.EQ.'4')NUMDIG=4
6777      IF(IFORSW.EQ.'5')NUMDIG=5
6778      IF(IFORSW.EQ.'6')NUMDIG=6
6779      IF(IFORSW.EQ.'7')NUMDIG=7
6780      IF(IFORSW.EQ.'8')NUMDIG=8
6781      IF(IFORSW.EQ.'9')NUMDIG=9
6782      IF(IFORSW.EQ.'0')NUMDIG=0
6783      IF(IFORSW.EQ.'E')NUMDIG=-2
6784      IF(IFORSW.EQ.'-2')NUMDIG=-2
6785      IF(IFORSW.EQ.'-3')NUMDIG=-3
6786      IF(IFORSW.EQ.'-4')NUMDIG=-4
6787      IF(IFORSW.EQ.'-5')NUMDIG=-5
6788      IF(IFORSW.EQ.'-6')NUMDIG=-6
6789      IF(IFORSW.EQ.'-7')NUMDIG=-7
6790      IF(IFORSW.EQ.'-8')NUMDIG=-8
6791      IF(IFORSW.EQ.'-9')NUMDIG=-9
6792C
6793      ITITLE='Borel-Tanner Parameter Estimation'
6794      NCTITL=34
6795      ITITLZ=' '
6796      NCTITZ=0
6797C
6798      ICNT=1
6799      ITEXT(ICNT)='Summary Statistics:'
6800      NCTEXT(ICNT)=19
6801      AVALUE(ICNT)=0.0
6802      IDIGIT(ICNT)=-1
6803      ICNT=ICNT+1
6804      ITEXT(ICNT)='Number of Observations:'
6805      NCTEXT(ICNT)=23
6806      AVALUE(ICNT)=REAL(NTOTZZ)
6807      IDIGIT(ICNT)=0
6808      ICNT=ICNT+1
6809      ITEXT(ICNT)='Sample Mean:'
6810      NCTEXT(ICNT)=12
6811      AVALUE(ICNT)=XMEAN
6812      IDIGIT(ICNT)=NUMDIG
6813      ICNT=ICNT+1
6814      ITEXT(ICNT)='Sample Standard Deviation:'
6815      NCTEXT(ICNT)=26
6816      AVALUE(ICNT)=XSD
6817      IDIGIT(ICNT)=NUMDIG
6818      ICNT=ICNT+1
6819      ITEXT(ICNT)='Sample Minimum:'
6820      NCTEXT(ICNT)=15
6821      AVALUE(ICNT)=XMIN
6822      IDIGIT(ICNT)=NUMDIG
6823      ICNT=ICNT+1
6824      ITEXT(ICNT)='Sample Maximum:'
6825      NCTEXT(ICNT)=15
6826      AVALUE(ICNT)=XMAX
6827      IDIGIT(ICNT)=NUMDIG
6828      ICNT=ICNT+1
6829      ITEXT(ICNT)=' '
6830      NCTEXT(ICNT)=0
6831      AVALUE(ICNT)=0.0
6832      IDIGIT(ICNT)=-1
6833C
6834      ICNT=ICNT+1
6835      ITEXT(ICNT)='Maximum Likelihood (= Moment) Estimates:'
6836      NCTEXT(ICNT)=40
6837      AVALUE(ICNT)=0.0
6838      IDIGIT(ICNT)=-1
6839      ICNT=ICNT+1
6840      ITEXT(ICNT)='Estimate of K:'
6841      NCTEXT(ICNT)=14
6842      AVALUE(ICNT)=AKHAT
6843      IDIGIT(ICNT)=NUMDIG
6844      ICNT=ICNT+1
6845      ITEXT(ICNT)='Estimate of Lambda:'
6846      NCTEXT(ICNT)=19
6847      AVALUE(ICNT)=ALAMHT
6848      IDIGIT(ICNT)=NUMDIG
6849C
6850      NUMROW=ICNT
6851      DO2310I=1,NUMROW
6852        NTOT(I)=15
6853 2310 CONTINUE
6854C
6855      IFRST=.TRUE.
6856      ILAST=.TRUE.
6857      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
6858     1            AVALUE,IDIGIT,
6859     1            NTOT,NUMROW,
6860     1            ICAPSW,ICAPTY,ILAST,IFRST,
6861     1            ISUBRO,IBUGA3,IERROR)
6862C
6863C               *****************
6864C               **  STEP 90--  **
6865C               **  EXIT       **
6866C               *****************
6867C
6868 9000 CONTINUE
6869      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBT')THEN
6870        WRITE(ICOUT,999)
6871        CALL DPWRST('XXX','WRIT')
6872        WRITE(ICOUT,9011)
6873 9011   FORMAT('***** AT THE END       OF DPMLBT--')
6874        CALL DPWRST('XXX','WRIT')
6875        WRITE(ICOUT,9012)IERROR,AKHAT,ALAMHT
6876 9012   FORMAT('IERROR,AKHAT,ALAMHT = ',A4,2X,2G15.7)
6877        CALL DPWRST('XXX','WRIT')
6878      ENDIF
6879C
6880      RETURN
6881      END
6882      SUBROUTINE DPMLCA(Y,N,
6883     1                  XTEMP,TEMP1,DTEMP1,MAXNXT,
6884     1                  ALOC,ASCALE,ALOCOS,ASCLOS,ALOWOS,SCAWOS,
6885     1                  ICAPSW,ICAPTY,IFORSW,
6886     1                  ISUBRO,IBUGA3,IERROR)
6887C
6888C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
6889C              ESTIMATES FOR CAUCHY DISTRIBUTION
6890C     EXAMPLE--CAUCHY MAXIMUM LIKELIHOOD Y
6891C     REFERENCE--GERALD HAAS, LEE BAIN, CHARLES ANTLE, (1970).
6892C                "INFERENCES FOR THE CAUCHY DISTRIBUTION BASED ON
6893C                MAXIMUM LIKELIHOOD ESTIMATORS", BIOMETRIKA,
6894C                PP. 403-407.
6895C     WRITTEN BY--JAMES J. FILLIBEN
6896C                 STATISTICAL ENGINEERING DIVISION
6897C                 INFORMATION TECHNOLOGY LABORATORY
6898C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
6899C                 GAITHERSBURG, MD 20899-8980
6900C                 PHONE--301-975-2855
6901C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
6902C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
6903C     LANGUAGE--ANSI FORTRAN (1977)
6904C     VERSION NUMBER--2003/10
6905C     ORIGINAL VERSION--OCTOBER   2003.
6906C     UPDATED         --MAY       2005. ADD SUMS OF WEIGHTED ORDER
6907C                                       STATISTICS METHOD
6908C     UPDATED         --JUNE      2010. USE DPDTA1 AND DPDTA7 TO
6909C                                       PRINT OUTPUT, ADD AIC AND
6910C                                       RELATED STATISTICS TO OUTPUT
6911C
6912C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
6913C
6914      CHARACTER*4 ICAPSW
6915      CHARACTER*4 ICAPTY
6916      CHARACTER*4 IFORSW
6917C
6918      CHARACTER*4 ISUBRO
6919      CHARACTER*4 IBUGA3
6920      CHARACTER*4 IERROR
6921      CHARACTER*4 IWRITE
6922      CHARACTER*4 INORM
6923C
6924      CHARACTER*4 ISUBN1
6925      CHARACTER*4 ISUBN2
6926      CHARACTER*4 ISTEPN
6927C
6928C---------------------------------------------------------------------
6929C
6930      DIMENSION Y(*)
6931      DIMENSION XTEMP(*)
6932      DIMENSION TEMP1(*)
6933      DIMENSION QP(1)
6934      DOUBLE PRECISION DTEMP1(*)
6935C
6936      DIMENSION ATABLE(11,2)
6937      DIMENSION BTABLE(10,4)
6938C
6939      PARAMETER (NUMALP=2)
6940      DIMENSION ALPHA(NUMALP)
6941      DIMENSION ALOWLO(NUMALP)
6942      DIMENSION AUPPLO(NUMALP)
6943      DIMENSION ALOWSC(NUMALP)
6944      DIMENSION AUPPSC(NUMALP)
6945C
6946      INCLUDE 'DPCOST.INC'
6947C
6948      PARAMETER (MAXROW=50)
6949      CHARACTER*60 ITITLE
6950      CHARACTER*1  ITITLZ
6951      CHARACTER*50 ITEXT(MAXROW)
6952      REAL         AVALUE(MAXROW)
6953      INTEGER      NCTEXT(MAXROW)
6954      INTEGER      IDIGIT(MAXROW)
6955      INTEGER      NTOT(MAXROW)
6956C
6957      LOGICAL IFRST
6958      LOGICAL ILAST
6959C
6960C---------------------------------------------------------------------
6961C
6962      INCLUDE 'DPCOP2.INC'
6963C
6964CCCCC DATA PI/3.14159265358979/
6965C
6966      DATA (ATABLE(1,J),J=1,2)/4.77, 6.78/
6967      DATA (ATABLE(2,J),J=1,2)/3.11, 3.95/
6968      DATA (ATABLE(3,J),J=1,2)/2.79, 3.46/
6969      DATA (ATABLE(4,J),J=1,2)/2.63, 3.27/
6970      DATA (ATABLE(5,J),J=1,2)/2.60, 3.13/
6971      DATA (ATABLE(6,J),J=1,2)/2.51, 3.05/
6972      DATA (ATABLE(7,J),J=1,2)/2.48, 2.97/
6973      DATA (ATABLE(8,J),J=1,2)/2.45, 2.96/
6974      DATA (ATABLE(9,J),J=1,2)/2.40, 2.89/
6975      DATA (ATABLE(10,J),J=1,2)/2.38, 2.85/
6976      DATA (ATABLE(11,J),J=1,2)/2.33, 2.77/
6977C
6978      DATA (BTABLE(1,J),J=1,4)/0.130, 0.101, 2.56, 3.277/
6979      DATA (BTABLE(2,J),J=1,4)/0.320, 0.387, 2.005, 2.353/
6980      DATA (BTABLE(3,J),J=1,4)/0.418, 0.479, 1.746, 1.970/
6981      DATA (BTABLE(4,J),J=1,4)/0.488, 0.546, 1.628, 1.811/
6982      DATA (BTABLE(5,J),J=1,4)/0.533, 0.583, 1.536, 1.708/
6983      DATA (BTABLE(6,J),J=1,4)/0.568, 0.621, 1.498, 1.635/
6984      DATA (BTABLE(7,J),J=1,4)/0.622, 0.670, 1.412, 1.525/
6985      DATA (BTABLE(8,J),J=1,4)/0.656, 0.702, 1.366, 1.463/
6986      DATA (BTABLE(9,J),J=1,4)/0.710, 0.751, 1.289, 1.358/
6987      DATA (BTABLE(10,J),J=1,4)/0.746, 0.779, 1.251, 1.305/
6988C
6989C-----START POINT-----------------------------------------------------
6990C
6991      ISUBN1='DPML'
6992      ISUBN2='CA  '
6993      IERROR='NO'
6994C
6995      B1=1.0
6996      B2=1.0
6997      B3=1.0
6998      B4=1.0
6999      A1=1.0
7000      A2=1.0
7001      A3=1.0
7002      A4=1.0
7003C
7004      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLCA')THEN
7005        WRITE(ICOUT,999)
7006  999   FORMAT(1X)
7007        CALL DPWRST('XXX','WRIT')
7008        WRITE(ICOUT,51)
7009   51   FORMAT('**** AT THE BEGINNING OF DPMLCA--')
7010        CALL DPWRST('XXX','WRIT')
7011        WRITE(ICOUT,52)IBUGA3
7012   52   FORMAT('IBUGA3 = ',A4)
7013        CALL DPWRST('XXX','WRIT')
7014        WRITE(ICOUT,55)N
7015   55   FORMAT('N = ',I8)
7016        CALL DPWRST('XXX','WRIT')
7017        DO56I=1,N
7018          WRITE(ICOUT,57)I,Y(I)
7019   57     FORMAT('I,Y(I) = ',I8,E15.7)
7020          CALL DPWRST('XXX','WRIT')
7021   56   CONTINUE
7022      ENDIF
7023C
7024C               ********************************************
7025C               **  STEP 11--                             **
7026C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
7027C               ********************************************
7028C
7029      ISTEPN='11'
7030      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLCA')
7031     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7032C
7033      NPERC=0
7034      NMIN=4
7035      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
7036      IF(IERROR.EQ.'YES')GOTO9000
7037C
7038C               ********************************
7039C               **  STEP 41--                 **
7040C               **  CARRY OUT CALCULATIONS    **
7041C               **  FOR CAUCHY MLE ESTIMATE   **
7042C               ********************************
7043C
7044      ISTEPN='41'
7045      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7046C
7047      IWRITE='OFF'
7048      IERROR='NO'
7049C
7050      CALL CAUML1(Y,N,TEMP1,XTEMP,DTEMP1,MAXNXT,
7051     1            XMEAN,XMED,XSD,XMAD,XIQ,XMIN,XMAX,
7052     1            ALOC,ASCALE,ALOCOS,ASCLOS,ALOWOS,SCAWOS,
7053     1            ISUBRO,IBUGA3,IERROR)
7054C
7055      CALL CAULI1(Y,N,ALOC,ASCALE,
7056     1            ALIKML,AICML,AICCML,BICML,
7057     1            ISUBRO,IBUGA3,IERROR)
7058C
7059      CALL CAULI1(Y,N,ALOCOS,ASCLOS,
7060     1            ALIKOS,AICOS,AICCOS,BICOS,
7061     1            ISUBRO,IBUGA3,IERROR)
7062C
7063      CALL CAULI1(Y,N,ALOWOS,SCAWOS,
7064     1            ALIKWS,AICWS,AICCWS,BICWS,
7065     1            ISUBRO,IBUGA3,IERROR)
7066C
7067C               ***********************************************
7068C               **  STEP 41B-                                **
7069C               **  COMPUTE 90% AND 95% CONFIDENCE INTERVALS **
7070C               **  USING METHOD GIVEN IN ANTLE PAPER        **
7071C               ***********************************************
7072C
7073      AN=REAL(N)
7074      IF(N.EQ.5)THEN
7075        A1=ATABLE(1,1)
7076        A2=ATABLE(1,2)
7077      ELSEIF(N.GE.6 .AND. N.LE.9)THEN
7078        AFACT=REAL(N-5)/REAL(10-5)
7079        A1=ATABLE(2,1) - AFACT*ABS(ATABLE(2,1)-ATABLE(1,1))
7080        A2=ATABLE(2,2) - AFACT*ABS(ATABLE(2,2)-ATABLE(1,2))
7081      ELSEIF(N.EQ.10)THEN
7082        A1=ATABLE(2,1)
7083        A2=ATABLE(2,2)
7084      ELSEIF(N.GE.11 .AND. N.LE.14)THEN
7085        AFACT=REAL(N-10)/REAL(15-10)
7086        A1=ATABLE(3,1) - AFACT*ABS(ATABLE(3,1)-ATABLE(2,1))
7087        A2=ATABLE(3,2) - AFACT*ABS(ATABLE(3,2)-ATABLE(2,2))
7088      ELSEIF(N.GE.15 .AND. N.LE.18)THEN
7089        A1=ATABLE(3,1)
7090        A2=ATABLE(3,2)
7091      ELSEIF(N.GE.19 .AND. N.LE.23)THEN
7092        A1=ATABLE(4,1)
7093        A2=ATABLE(4,2)
7094      ELSEIF(N.GE.24 .AND. N.LE.28)THEN
7095        A1=ATABLE(5,1)
7096        A2=ATABLE(5,2)
7097      ELSEIF(N.GE.29 .AND. N.LE.35)THEN
7098        A1=ATABLE(6,1)
7099        A2=ATABLE(6,2)
7100      ELSEIF(N.GE.36 .AND. N.LE.45)THEN
7101        A1=ATABLE(7,1)
7102        A2=ATABLE(7,2)
7103      ELSEIF(N.GE.46 .AND. N.LE.63)THEN
7104        A1=ATABLE(8,1)
7105        A2=ATABLE(8,2)
7106      ELSEIF(N.GE.64 .AND. N.LE.88)THEN
7107        A1=ATABLE(9,1)
7108        A2=ATABLE(9,2)
7109      ELSEIF(N.GE.89 .AND. N.LE.100)THEN
7110        A1=ATABLE(10,1)
7111        A2=ATABLE(10,2)
7112      ELSE
7113        A1=ATABLE(11,1)
7114        A2=ATABLE(11,2)
7115      ENDIF
7116      ALOWLO(1)=ALOC - A1*ASCALE/SQRT(AN)
7117      AUPPLO(1)=ALOC + A1*ASCALE/SQRT(AN)
7118      ALOWLO(2)=ALOC - A2*ASCALE/SQRT(AN)
7119      AUPPLO(2)=ALOC + A2*ASCALE/SQRT(AN)
7120C
7121      IF(N.EQ.5)THEN
7122        B1=BTABLE(1,1)
7123        B2=BTABLE(1,2)
7124        B3=BTABLE(1,3)
7125        B4=BTABLE(1,4)
7126      ELSEIF(N.GE.6 .AND. N.LE.9)THEN
7127        AFACT=REAL(N-5)/REAL(10-5)
7128        B1=BTABLE(1,1) + AFACT*ABS(BTABLE(2,1)-BTABLE(1,1))
7129        B2=BTABLE(1,2) + AFACT*ABS(BTABLE(2,2)-BTABLE(1,2))
7130        B3=BTABLE(1,3) + AFACT*ABS(BTABLE(2,3)-BTABLE(1,3))
7131        B4=BTABLE(1,4) + AFACT*ABS(BTABLE(2,4)-BTABLE(1,4))
7132      ELSEIF(N.EQ.10)THEN
7133        B1=BTABLE(2,1)
7134        B2=BTABLE(2,2)
7135        B3=BTABLE(2,3)
7136        B4=BTABLE(2,4)
7137      ELSEIF(N.GE.11 .AND. N.LE.14)THEN
7138        AFACT=REAL(N-10)/REAL(15-10)
7139        B1=BTABLE(2,1) + AFACT*ABS(BTABLE(3,1)-BTABLE(2,1))
7140        B2=BTABLE(2,2) + AFACT*ABS(BTABLE(3,2)-BTABLE(2,2))
7141        B3=BTABLE(2,3) + AFACT*ABS(BTABLE(3,3)-BTABLE(2,3))
7142        B4=BTABLE(2,4) + AFACT*ABS(BTABLE(3,4)-BTABLE(2,4))
7143      ELSEIF(N.EQ.15)THEN
7144        B1=BTABLE(3,1)
7145        B2=BTABLE(3,2)
7146        B3=BTABLE(3,3)
7147        B4=BTABLE(3,4)
7148      ELSEIF(N.GE.16 .AND. N.LE.19)THEN
7149        AFACT=REAL(N-15)/REAL(20-15)
7150        B1=BTABLE(3,1) + AFACT*ABS(BTABLE(4,1)-BTABLE(3,1))
7151        B2=BTABLE(3,2) + AFACT*ABS(BTABLE(4,2)-BTABLE(3,2))
7152        B3=BTABLE(3,3) + AFACT*ABS(BTABLE(4,3)-BTABLE(3,3))
7153        B4=BTABLE(3,4) + AFACT*ABS(BTABLE(4,4)-BTABLE(3,4))
7154      ELSEIF(N.EQ.20)THEN
7155        B1=BTABLE(4,1)
7156        B2=BTABLE(4,2)
7157        B3=BTABLE(4,3)
7158        B4=BTABLE(4,4)
7159      ELSEIF(N.GE.21 .AND. N.LE.24)THEN
7160        AFACT=REAL(N-20)/REAL(25-20)
7161        B1=BTABLE(4,1) + AFACT*ABS(BTABLE(5,1)-BTABLE(4,1))
7162        B2=BTABLE(4,2) + AFACT*ABS(BTABLE(5,2)-BTABLE(4,2))
7163        B3=BTABLE(4,3) + AFACT*ABS(BTABLE(5,3)-BTABLE(4,3))
7164        B4=BTABLE(4,4) + AFACT*ABS(BTABLE(5,4)-BTABLE(4,4))
7165      ELSEIF(N.GE.25)THEN
7166        B1=BTABLE(5,1)
7167        B2=BTABLE(5,2)
7168        B3=BTABLE(5,3)
7169        B4=BTABLE(5,4)
7170      ELSEIF(N.GE.26 .AND. N.LE.29)THEN
7171        AFACT=REAL(N-25)/REAL(30-25)
7172        B1=BTABLE(5,1) + AFACT*ABS(BTABLE(6,1)-BTABLE(5,1))
7173        B2=BTABLE(5,2) + AFACT*ABS(BTABLE(6,2)-BTABLE(5,2))
7174        B3=BTABLE(5,3) + AFACT*ABS(BTABLE(6,3)-BTABLE(5,3))
7175        B4=BTABLE(5,4) + AFACT*ABS(BTABLE(6,4)-BTABLE(5,4))
7176      ELSEIF(N.GE.30)THEN
7177        B1=BTABLE(6,1)
7178        B2=BTABLE(6,2)
7179        B3=BTABLE(6,3)
7180        B4=BTABLE(6,4)
7181      ELSEIF(N.GE.31 .AND. N.LE.39)THEN
7182        AFACT=REAL(N-30)/REAL(40-30)
7183        B1=BTABLE(6,1) + AFACT*ABS(BTABLE(7,1)-BTABLE(6,1))
7184        B2=BTABLE(6,2) + AFACT*ABS(BTABLE(7,2)-BTABLE(6,2))
7185        B3=BTABLE(6,3) + AFACT*ABS(BTABLE(7,3)-BTABLE(6,3))
7186        B4=BTABLE(6,4) + AFACT*ABS(BTABLE(7,4)-BTABLE(6,4))
7187      ELSEIF(N.GE.40)THEN
7188        B1=BTABLE(7,1)
7189        B2=BTABLE(7,2)
7190        B3=BTABLE(7,3)
7191        B4=BTABLE(7,4)
7192      ELSEIF(N.GE.41 .AND. N.LE.49)THEN
7193        AFACT=REAL(N-40)/REAL(50-40)
7194        B1=BTABLE(7,1) + AFACT*ABS(BTABLE(8,1)-BTABLE(7,1))
7195        B2=BTABLE(7,2) + AFACT*ABS(BTABLE(8,2)-BTABLE(7,2))
7196        B3=BTABLE(7,3) + AFACT*ABS(BTABLE(8,3)-BTABLE(7,3))
7197        B4=BTABLE(7,4) + AFACT*ABS(BTABLE(8,4)-BTABLE(7,4))
7198      ELSEIF(N.GE.50)THEN
7199        B1=BTABLE(8,1)
7200        B2=BTABLE(8,2)
7201        B3=BTABLE(8,3)
7202        B4=BTABLE(8,4)
7203      ELSEIF(N.GE.51 .AND. N.LE.74)THEN
7204        AFACT=REAL(N-50)/REAL(75-50)
7205        B1=BTABLE(8,1) + AFACT*ABS(BTABLE(9,1)-BTABLE(8,1))
7206        B2=BTABLE(8,2) + AFACT*ABS(BTABLE(9,2)-BTABLE(8,2))
7207        B3=BTABLE(8,3) + AFACT*ABS(BTABLE(9,3)-BTABLE(8,3))
7208        B4=BTABLE(8,4) + AFACT*ABS(BTABLE(9,4)-BTABLE(8,4))
7209      ELSEIF(N.GE.75)THEN
7210        B1=BTABLE(9,1)
7211        B2=BTABLE(9,2)
7212        B3=BTABLE(9,3)
7213        B4=BTABLE(9,4)
7214      ELSEIF(N.GE.76 .AND. N.LE.99)THEN
7215        AFACT=REAL(N-75)/REAL(100-75)
7216        B1=BTABLE(9,1) + AFACT*ABS(BTABLE(10,1)-BTABLE(9,1))
7217        B2=BTABLE(9,2) + AFACT*ABS(BTABLE(10,2)-BTABLE(9,2))
7218        B3=BTABLE(9,3) + AFACT*ABS(BTABLE(10,3)-BTABLE(9,3))
7219        B4=BTABLE(9,4) + AFACT*ABS(BTABLE(10,4)-BTABLE(9,4))
7220      ELSE
7221        B1=BTABLE(10,1)
7222        B2=BTABLE(10,2)
7223        B3=BTABLE(10,3)
7224        B4=BTABLE(10,4)
7225      ENDIF
7226      ALOWSC(1)=ASCALE/B4
7227      AUPPSC(1)=ASCALE/B2
7228      ALOWSC(2)=ASCALE/B3
7229      AUPPSC(2)=ASCALE/B1
7230C
7231C               *********************************
7232C               **   STEP 42--                 **
7233C               **   WRITE OUT EVERYTHING      **
7234C               **   FOR CAUCHY MLE ESTIMATE   **
7235C               **********************************
7236C
7237      ISTEPN='42'
7238      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLCA')
7239     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7240C
7241      IF(IPRINT.EQ.'OFF')GOTO9000
7242C
7243      NUMDIG=7
7244      IF(IFORSW.EQ.'1')NUMDIG=1
7245      IF(IFORSW.EQ.'2')NUMDIG=2
7246      IF(IFORSW.EQ.'3')NUMDIG=3
7247      IF(IFORSW.EQ.'4')NUMDIG=4
7248      IF(IFORSW.EQ.'5')NUMDIG=5
7249      IF(IFORSW.EQ.'6')NUMDIG=6
7250      IF(IFORSW.EQ.'7')NUMDIG=7
7251      IF(IFORSW.EQ.'8')NUMDIG=8
7252      IF(IFORSW.EQ.'9')NUMDIG=9
7253      IF(IFORSW.EQ.'0')NUMDIG=0
7254      IF(IFORSW.EQ.'E')NUMDIG=-2
7255      IF(IFORSW.EQ.'-2')NUMDIG=-2
7256      IF(IFORSW.EQ.'-3')NUMDIG=-3
7257      IF(IFORSW.EQ.'-4')NUMDIG=-4
7258      IF(IFORSW.EQ.'-5')NUMDIG=-5
7259      IF(IFORSW.EQ.'-6')NUMDIG=-6
7260      IF(IFORSW.EQ.'-7')NUMDIG=-7
7261      IF(IFORSW.EQ.'-8')NUMDIG=-8
7262      IF(IFORSW.EQ.'-9')NUMDIG=-9
7263C
7264      ITITLE='Cauchy Parameter Estimation'
7265      NCTITL=27
7266      ITEXT(1)='Summary Statistics:'
7267      NCTEXT(1)=19
7268      AVALUE(1)=0.0
7269      IDIGIT(1)=-1
7270      ITEXT(2)='Number of Observations:'
7271      NCTEXT(2)=23
7272      AVALUE(2)=REAL(N)
7273      IDIGIT(2)=0
7274      ICNT=3
7275      ITEXT(ICNT)='Sample Mean:'
7276      NCTEXT(ICNT)=12
7277      AVALUE(ICNT)=XMEAN
7278      IDIGIT(ICNT)=NUMDIG
7279      ICNT=ICNT+1
7280      ITEXT(ICNT)='Sample Median:'
7281      NCTEXT(ICNT)=14
7282      AVALUE(ICNT)=XMED
7283      IDIGIT(ICNT)=NUMDIG
7284      ICNT=ICNT+1
7285      ITEXT(ICNT)='Sample Standard Deviation:'
7286      NCTEXT(ICNT)=26
7287      AVALUE(ICNT)=XSD
7288      IDIGIT(ICNT)=NUMDIG
7289      ICNT=ICNT+1
7290      ITEXT(ICNT)='Sample Median Absolute Deviation:'
7291      NCTEXT(ICNT)=33
7292      AVALUE(ICNT)=XMAD
7293      IDIGIT(ICNT)=NUMDIG
7294      ICNT=ICNT+1
7295      ITEXT(ICNT)='Sample Interquartile Range:'
7296      NCTEXT(ICNT)=27
7297      AVALUE(ICNT)=XIQ
7298      IDIGIT(ICNT)=NUMDIG
7299      ICNT=ICNT+1
7300      ITEXT(ICNT)='Sample Minimum:'
7301      NCTEXT(ICNT)=15
7302      AVALUE(ICNT)=XMIN
7303      IDIGIT(ICNT)=NUMDIG
7304      ICNT=ICNT+1
7305      ITEXT(ICNT)='Sample Maximum:'
7306      NCTEXT(ICNT)=15
7307      AVALUE(ICNT)=XMAX
7308      IDIGIT(ICNT)=NUMDIG
7309      ICNT=ICNT+1
7310      ITEXT(ICNT)=' '
7311      NCTEXT(ICNT)=0
7312      AVALUE(ICNT)=0.0
7313      IDIGIT(ICNT)=-1
7314C
7315      ICNT=ICNT+1
7316      ITEXT(ICNT)='Order Statistic Estimation Method:'
7317      NCTEXT(ICNT)=34
7318      AVALUE(ICNT)=0.0
7319      IDIGIT(ICNT)=-1
7320      ICNT=ICNT+1
7321      ITEXT(ICNT)='Location Parameter:'
7322      NCTEXT(ICNT)=19
7323      AVALUE(ICNT)=ALOCOS
7324      IDIGIT(ICNT)=NUMDIG
7325      ICNT=ICNT+1
7326      ITEXT(ICNT)='Scale Parameter:'
7327      NCTEXT(ICNT)=16
7328      AVALUE(ICNT)=ASCLOS
7329      IDIGIT(ICNT)=NUMDIG
7330      ICNT=ICNT+1
7331      ITEXT(ICNT)='Log-likelihood:'
7332      NCTEXT(ICNT)=15
7333      AVALUE(ICNT)=ALIKOS
7334      IDIGIT(ICNT)=-7
7335      ICNT=ICNT+1
7336      ITEXT(ICNT)='AIC:'
7337      NCTEXT(ICNT)=4
7338      AVALUE(ICNT)=AICOS
7339      IDIGIT(ICNT)=-7
7340      ICNT=ICNT+1
7341      ITEXT(ICNT)='AICc:'
7342      NCTEXT(ICNT)=5
7343      AVALUE(ICNT)=AICCOS
7344      IDIGIT(ICNT)=-7
7345      ICNT=ICNT+1
7346      ITEXT(ICNT)='BIC:'
7347      NCTEXT(ICNT)=4
7348      AVALUE(ICNT)=BICOS
7349      IDIGIT(ICNT)=-7
7350      ICNT=ICNT+1
7351      ITEXT(ICNT)=' '
7352      NCTEXT(ICNT)=0
7353      AVALUE(ICNT)=0.0
7354      IDIGIT(ICNT)=-1
7355C
7356      ICNT=ICNT+1
7357      ITEXT(ICNT)='Weighted Order Statistic Estimation Method:'
7358      NCTEXT(ICNT)=43
7359      AVALUE(ICNT)=0.0
7360      IDIGIT(ICNT)=-1
7361      ICNT=ICNT+1
7362      ITEXT(ICNT)='Location Parameter:'
7363      NCTEXT(ICNT)=19
7364      AVALUE(ICNT)=ALOWOS
7365      IDIGIT(ICNT)=NUMDIG
7366      ICNT=ICNT+1
7367      ITEXT(ICNT)='Scale Parameter:'
7368      NCTEXT(ICNT)=16
7369      AVALUE(ICNT)=SCAWOS
7370      IDIGIT(ICNT)=NUMDIG
7371      ICNT=ICNT+1
7372      ITEXT(ICNT)='Log-likelihood:'
7373      NCTEXT(ICNT)=15
7374      AVALUE(ICNT)=ALIKWS
7375      IDIGIT(ICNT)=-7
7376      ICNT=ICNT+1
7377      ITEXT(ICNT)='AIC:'
7378      NCTEXT(ICNT)=4
7379      AVALUE(ICNT)=AICWS
7380      IDIGIT(ICNT)=-7
7381      ICNT=ICNT+1
7382      ITEXT(ICNT)='AICc:'
7383      NCTEXT(ICNT)=5
7384      AVALUE(ICNT)=AICCWS
7385      IDIGIT(ICNT)=-7
7386      ICNT=ICNT+1
7387      ITEXT(ICNT)='BIC:'
7388      NCTEXT(ICNT)=4
7389      AVALUE(ICNT)=BICWS
7390      IDIGIT(ICNT)=-7
7391      ICNT=ICNT+1
7392      ITEXT(ICNT)=' '
7393      NCTEXT(ICNT)=0
7394      AVALUE(ICNT)=0.0
7395      IDIGIT(ICNT)=-1
7396C
7397      ICNT=ICNT+1
7398      ITEXT(ICNT)='Maximum Likelihood Estimation Method:'
7399      NCTEXT(ICNT)=37
7400      AVALUE(ICNT)=0.0
7401      IDIGIT(ICNT)=-1
7402      ICNT=ICNT+1
7403      ITEXT(ICNT)='Location Parameter:'
7404      NCTEXT(ICNT)=19
7405      AVALUE(ICNT)=ALOC
7406      IDIGIT(ICNT)=NUMDIG
7407      ICNT=ICNT+1
7408      ITEXT(ICNT)='Scale Parameter:'
7409      NCTEXT(ICNT)=16
7410      AVALUE(ICNT)=ASCALE
7411      IDIGIT(ICNT)=NUMDIG
7412      ICNT=ICNT+1
7413      ITEXT(ICNT)='Log-likelihood:'
7414      NCTEXT(ICNT)=15
7415      AVALUE(ICNT)=ALIKML
7416      IDIGIT(ICNT)=-7
7417      ICNT=ICNT+1
7418      ITEXT(ICNT)='AIC:'
7419      NCTEXT(ICNT)=4
7420      AVALUE(ICNT)=AICML
7421      IDIGIT(ICNT)=-7
7422      ICNT=ICNT+1
7423      ITEXT(ICNT)='AICc:'
7424      NCTEXT(ICNT)=5
7425      AVALUE(ICNT)=AICCML
7426      IDIGIT(ICNT)=-7
7427      ICNT=ICNT+1
7428      ITEXT(ICNT)='BIC:'
7429      NCTEXT(ICNT)=4
7430      AVALUE(ICNT)=BICML
7431      IDIGIT(ICNT)=-7
7432      ICNT=ICNT+1
7433      ITEXT(ICNT)=' '
7434      NCTEXT(ICNT)=0
7435      AVALUE(ICNT)=0.0
7436      IDIGIT(ICNT)=-1
7437C
7438      NUMROW=ICNT
7439      DO2310I=1,NUMROW
7440        NTOT(I)=15
7441 2310 CONTINUE
7442C
7443      IFRST=.TRUE.
7444      ILAST=.FALSE.
7445      NCTITZ=0
7446      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
7447     1            NCTEXT,AVALUE,IDIGIT,
7448     1            NTOT,NUMROW,
7449     1            ICAPSW,ICAPTY,ILAST,IFRST,
7450     1            ISUBRO,IBUGA3,IERROR)
7451      IFRST=.FALSE.
7452      ITITLE=' '
7453      NCTITL=0
7454C
7455      ALPHA(1)=0.10
7456      ALPHA(2)=0.05
7457      INORM='YES'
7458      CALL DPDTA7(ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,NUMALP,
7459     1            ICAPSW,ICAPTY,NUMDIG,INORM,
7460     1            ISUBRO,IBUGA3,IERROR)
7461C
7462C               *****************
7463C               **  STEP 90--  **
7464C               **  EXIT       **
7465C               *****************
7466C
7467 9000 CONTINUE
7468      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLCA')THEN
7469        WRITE(ICOUT,999)
7470        CALL DPWRST('XXX','WRIT')
7471        WRITE(ICOUT,9011)
7472 9011   FORMAT('***** AT THE END       OF DPMLCA--')
7473        CALL DPWRST('XXX','WRIT')
7474        WRITE(ICOUT,9012)N,IBUGA3,IERROR
7475 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
7476        CALL DPWRST('XXX','WRIT')
7477      ENDIF
7478C
7479      RETURN
7480      END
7481      SUBROUTINE DPMLCN(Y,X,N,NVAR,
7482     1                  TEMP1,TEMP2,TEMP3,DTEMP1,
7483     1                  AMUMOM,AMMOM,AMUFR,AMFR,AMUML,AMML,
7484     1                  ICAPSW,ICAPTY,IFORSW,MAXNXT,
7485     1                  ICONDF,
7486     1                  ISUBRO,IBUGA3,IERROR)
7487C
7488C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
7489C              ESTIMATES FOR THE CONSUL DISTRIBUTION.  ESTIMATES
7490C              ARE GENERATED IN TERMS OF THE MU/M
7491C              PARAMETERIZATION.
7492C
7493C              THE MOMENT ESTIMATES OF MU AND M ARE:
7494C
7495C                 MUHAT = XBAR
7496C                 MHAT = XBAR*(XBAR - 1)**2/
7497C                        [XBAR**2*(XBAR-1)-S**2}
7498C
7499C              NOTE THAT IF THE MOMENT ESTIMATE OF M IS LESS
7500C              THAN 1, THE CONSUL DISTRIBUTION IS NOT AN
7501C              APPROPRIATE MODEL.  SPECIFICALLY, IF
7502C
7503C                  S**2 >= XBAR**2*(XBAR - 1)
7504C
7505C              THEN THE GEETA DISTRIBUTION IS THE MORE
7506C              APPROPRIATE MODEL.  IF
7507C
7508C                  XBAR*(XBAR-1) <= S**2 <= XBAR**2*(XBAR - 1)
7509C
7510C              THEN THE CONSUL IS MORE APPROPRIATE THAN THE
7511C              GEETA MODEL.  IF
7512C
7513C                  S**2 < XBAR*(XBAR - 1)
7514C
7515C              THEN NEITHER THE GEETA OR THE CONSUL IS AN
7516C              APPROPRIATE MODEL.
7517C
7518C              THE MEAN AND ONES FREQUENCY ESTIMATE OF MU IS:
7519C
7520C                  MUHAT = XBAR
7521C
7522C              THE ESTIMATE OF M IS THEN THE SOLUTION OF THE
7523C              EQUATION
7524C
7525C                 M*LOG(1 - (XBAR-1)/(M*XBAR)) - LOG(N1/N) = 0
7526C
7527C              THE MAXIMUM LIKELIHOOD FREQUENCY ESTIMATE OF MU IS:
7528C
7529C                  MUHAT = XBAR
7530C
7531C              THE ESTIMATE OF M IS THEN THE SOLUTION OF THE
7532C              EQUATION
7533C
7534C                 LOG(1 - (XBAR-1)/(M*XBAR)) + (1/(N*XBAR))*
7535C                 SUM[X=2 to k][SUM[i=0 to X-2][X*N(x)/(M*X-i)]] = 0
7536C
7537C              THERE ARE TWO CASES:
7538C
7539C              1) ONE VARIABLE CASE: Y IS RAW DATA
7540C              2) TWO VARIABLE CASE: Y IS FREQUENCY, X IS CLASS
7541C                 MID-POINT.
7542C
7543C     EXAMPLE--CONSUL MAXIMUM LIKELIHOOD Y
7544C            --CONSUL MAXIMUM LIKELIHOOD Y X
7545C     REFERENCES--CONSUL AND FAMOYE (2006), "LAGRANGIAN PROBABILITY
7546C                 DISTRIBUTIONS", BIRKHAUSER, CHAPTER 8.
7547C     WRITTEN BY--ALAN HECKERT
7548C                 STATISTICAL ENGINEERING DIVISION
7549C                 INFORMATION TECHNOLOGY LABORATORY
7550C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
7551C                 GAITHERSBUG, MD 20899-8980
7552C                 PHONE--301-975-2855
7553C     LANGUAGE--ANSI FORTRAN (1977)
7554C     VERSION NUMBER--2006/8
7555C     ORIGINAL VERSION--AUGUST    2006.
7556C     UPDATED         --APRIL     2011. USE DPDTA1 AND DPDTA5 TO PRINT
7557C                                       OUTPUT
7558C
7559C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-----------------
7560C
7561      CHARACTER*4 ICAPSW
7562      CHARACTER*4 ICAPTY
7563      CHARACTER*4 IFORSW
7564      CHARACTER*4 ICONDF
7565      CHARACTER*4 ISUBRO
7566      CHARACTER*4 IBUGA3
7567      CHARACTER*4 IERROR
7568C
7569      CHARACTER*4 IWRITE
7570      CHARACTER*4 ISUBN1
7571      CHARACTER*4 ISUBN2
7572      CHARACTER*4 ISTEPN
7573      CHARACTER*4 IRELAT
7574      CHARACTER*4 IRHSTG
7575C
7576C-------------------------------------------------------------------
7577C
7578      DIMENSION Y(*)
7579      DIMENSION X(*)
7580      DIMENSION TEMP1(*)
7581      DIMENSION TEMP2(*)
7582      DIMENSION TEMP3(*)
7583      DOUBLE PRECISION DTEMP1(*)
7584C
7585      DOUBLE PRECISION TOL
7586      DOUBLE PRECISION XPAR(2)
7587      DOUBLE PRECISION FVEC(2)
7588C
7589      DOUBLE PRECISION AE
7590      DOUBLE PRECISION RE
7591      DOUBLE PRECISION XLOW
7592      DOUBLE PRECISION XUP
7593      DOUBLE PRECISION XMID
7594CCCCC DOUBLE PRECISION DALPHA
7595C
7596      DOUBLE PRECISION CONFUN
7597      DOUBLE PRECISION CONFU2
7598      EXTERNAL CONFUN
7599      EXTERNAL CONFU2
7600      DOUBLE PRECISION XBAR
7601      DOUBLE PRECISION S2
7602      DOUBLE PRECISION F1FREQ
7603      COMMON/CONCOM/XBAR,S2,F1FREQ,MAXRO2,NTOT2
7604C
7605      PARAMETER (MAXROW=30)
7606      CHARACTER*60 ITITLE
7607      CHARACTER*1  ITITLZ
7608      CHARACTER*40 IDIST
7609      CHARACTER*40 ITEXT(MAXROW)
7610      REAL         AVALUE(MAXROW)
7611      INTEGER      NCTEXT(MAXROW)
7612      INTEGER      IDIGIT(MAXROW)
7613      INTEGER      NTOT(MAXROW)
7614      LOGICAL      IFRST
7615      LOGICAL      ILAST
7616C
7617C-------------------------------------------------------------------
7618C
7619      INCLUDE 'DPCOP2.INC'
7620C
7621C-----START POINT---------------------------------------------------
7622C
7623      ISUBN1='DPML'
7624      ISUBN2='CN  '
7625      IERROR='NO'
7626      IWRITE='OFF'
7627C
7628      AMUMOM=CPUMIN
7629      AMMOM=CPUMIN
7630      AMUFR=CPUMIN
7631      AMFR=CPUMIN
7632      AMUML=CPUMIN
7633      AMML=CPUMIN
7634C
7635      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLCN')THEN
7636        WRITE(ICOUT,999)
7637  999   FORMAT(1X)
7638        CALL DPWRST('XXX','WRIT')
7639        WRITE(ICOUT,51)
7640   51   FORMAT('**** AT THE BEGINNING OF DPMLCN--')
7641        CALL DPWRST('XXX','WRIT')
7642        WRITE(ICOUT,52)IBUGA3,ISUBRO,ICONDF,N,NVAR
7643   52   FORMAT('IBUGA3,ISUBRO,ICONDF,N,NVAR = ',3(A4,2X),2I8)
7644        CALL DPWRST('XXX','WRIT')
7645        IF(NVAR.EQ.1)THEN
7646          DO56I=1,MIN(N,100)
7647            WRITE(ICOUT,57)I,Y(I)
7648   57       FORMAT('I,Y(I) = ',I8,G15.7)
7649            CALL DPWRST('XXX','WRIT')
7650   56     CONTINUE
7651        ELSE
7652          DO61I=1,N
7653            WRITE(ICOUT,62)I,X(I),Y(I)
7654   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
7655            CALL DPWRST('XXX','WRIT')
7656   61     CONTINUE
7657        ENDIF
7658      ENDIF
7659C
7660C               ********************************************
7661C               **  STEP 11--                             **
7662C               **  1) ROUND DATA TO INTEGER VALUES       **
7663C               **  2) COMPUTE SUMMARY STATISTICS         **
7664C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
7665C               **     INSUFFICIENT SAMPLE SIZE           **
7666C               ********************************************
7667C
7668      ISTEPN='11'
7669      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGS')
7670     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7671C
7672      IDIST='CONSUL'
7673C
7674      NPERC=0
7675      MAXGRP=MAXNXT/2
7676      NMIN=2
7677      IF(NVAR.EQ.1)THEN
7678        DO1105I=1,N
7679          ITEMP=INT(Y(I)+0.5)
7680          Y(I)=REAL(ITEMP)
7681 1105   CONTINUE
7682        CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
7683        IF(IERROR.EQ.'YES')GOTO9000
7684C
7685        IFLAG=1
7686        CALL SUMRAW(Y,N,IDIST,IFLAG,
7687     1              XMEAN,XVAR,XSD,XMIN,XMAX,
7688     1              ISUBRO,IBUGA3,IERROR)
7689        IF(IERROR.EQ.'YES')GOTO9000
7690        NTOTZZ=N
7691C
7692C       NOW BIN THE DATA FOR USE BY THE ESTIMATION METHOD BELOW
7693C
7694        IRELAT='OFF'
7695        IRHSTG='OFF'
7696        XSTART=XMIN-0.5
7697        XSTOP=XMAX+0.5
7698        CLWID=1.0
7699        CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
7700     1              TEMP1,X,N2,IBUGA3,IERROR)
7701        ICNT=0
7702        DO1121I=1,N2
7703          Y(I)=TEMP1(I)
7704          ICNT=ICNT+1
7705          Y(ICNT)=Y(I)
7706          X(ICNT)=X(I)
77071121    CONTINUE
7708        N2=ICNT
7709      ELSE
7710        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
7711     1              ISUBRO,IBUGA3,IERROR)
7712        IF(IERROR.EQ.'YES')GOTO9000
7713        IFLAG1=1
7714        IFLAG2=1
7715        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
7716     1              TEMP1,TEMP2,TEMP3,MAXNXT,
7717     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
7718     1              ISUBRO,IBUGA3,IERROR)
7719        N2=N
7720      ENDIF
7721      IF(IERROR.EQ.'YES')GOTO9000
7722C
7723      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLCN')THEN
7724        WRITE(ICOUT,999)
7725        CALL DPWRST('XXX','WRIT')
7726        WRITE(ICOUT,1311)
7727 1311   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
7728        CALL DPWRST('XXX','WRIT')
7729        WRITE(ICOUT,1312)XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ
7730 1312   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ = ',5G15.7,I10)
7731        CALL DPWRST('XXX','WRIT')
7732      ENDIF
7733C
7734C               *********************************************
7735C               **  STEP 21--                              **
7736C               **  CARRY OUT CALCULATIONS                 **
7737C               **  FOR CONSUL MLE                         **
7738C               **  ESTIMATION                             **
7739C               *********************************************
7740C
7741      ISTEPN='21'
7742      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLCN')
7743     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7744C
7745      F1=Y(1)/REAL(NTOTZZ)
7746      IINDX=MAXNXT/2
7747      IF(N2.LE.IINDX)THEN
7748        IML=0
7749        DO2210I=1,N2
7750          TEMP3(I)=Y(I)
7751          TEMP3(IINDX+I)=X(I)
7752 2210   CONTINUE
7753        IK=N2
7754      ELSE
7755        IML=1
7756      ENDIF
7757C
7758      XBAR=XMEAN
7759      ACUTLO=XBAR*(XBAR-1.0)
7760      ACUTHI=XBAR**2*(XBAR-1.0)
7761CCCCC IF(AVAR.GE.ACUTHI)THEN
7762CCCCC   WRITE(ICOUT,999)
7763CCCCC   CALL DPWRST('XXX','WRIT')
7764CCCCC   WRITE(ICOUT,1111)
7765CCCCC   CALL DPWRST('XXX','WRIT')
7766CCCCC   WRITE(ICOUT,2223)
7767C2223   FORMAT('      FOR THIS DATA SET')
7768CCCCC   CALL DPWRST('XXX','WRIT')
7769CCCCC   WRITE(ICOUT,2224)
7770C2224   FORMAT('         S**2 >= XBAR**2*(XBAR - 1)')
7771CCCCC   CALL DPWRST('XXX','WRIT')
7772CCCCC   WRITE(ICOUT,2226)
7773C2226   FORMAT('      IN THIS CASE, THE CONSUL DISTRIBUTION IS ',
7774CCCCC1         'NOT APPLICABLE.')
7775CCCCC   CALL DPWRST('XXX','WRIT')
7776CCCCC   WRITE(ICOUT,2227)
7777C2227   FORMAT('      IT IS RECOMMENDED THAT YOU TRY FITTING THE ',
7778CCCCC1         'GEETA DISTRIBUTION.')
7779CCCCC   CALL DPWRST('XXX','WRIT')
7780CCCCC   WRITE(ICOUT,2228)AMEAN
7781C2228   FORMAT('      SAMPLE MEAN     = ',G15.7)
7782CCCCC   CALL DPWRST('XXX','WRIT')
7783CCCCC   WRITE(ICOUT,2229)AVAR
7784C2229   FORMAT('      SAMPLE VARIANCE = ',G15.7)
7785CCCCC   CALL DPWRST('XXX','WRIT')
7786CCCCC   GOTO9000
7787CCCCC ENDIF
7788C
7789CCCCC IF(AVAR.LT.ACUTLO)THEN
7790CCCCC   WRITE(ICOUT,999)
7791CCCCC   CALL DPWRST('XXX','WRIT')
7792CCCCC   WRITE(ICOUT,1111)
7793CCCCC   CALL DPWRST('XXX','WRIT')
7794CCCCC   WRITE(ICOUT,2233)
7795C2233   FORMAT('      FOR THIS DATA SET')
7796CCCCC   CALL DPWRST('XXX','WRIT')
7797CCCCC   WRITE(ICOUT,2234)
7798C2234   FORMAT('         S**2 < XBAR*(XBAR - 1)')
7799CCCCC   CALL DPWRST('XXX','WRIT')
7800CCCCC   WRITE(ICOUT,2235)
7801C2235   FORMAT('      IN THIS CASE, THE CONSUL DISTRIBUTION IS ',
7802CCCCC1         'NOT APPLICABLE.')
7803CCCCC   CALL DPWRST('XXX','WRIT')
7804CCCCC   WRITE(ICOUT,2237)
7805C2237   FORMAT('      NOTE THAT THE GEETA DISTRIBUTION IS ALSO ',
7806CCCCC1         'NOT APPLICABLE.')
7807CCCCC   CALL DPWRST('XXX','WRIT')
7808CCCCC   WRITE(ICOUT,2238)AMEAN
7809C2238   FORMAT('      SAMPLE MEAN     = ',G15.7)
7810CCCCC   CALL DPWRST('XXX','WRIT')
7811CCCCC   WRITE(ICOUT,2239)AVAR
7812C2239   FORMAT('      SAMPLE VARIANCE = ',G15.7)
7813CCCCC   CALL DPWRST('XXX','WRIT')
7814CCCCC   GOTO9000
7815CCCCC ENDIF
7816C
7817      AMUMOM=XMEAN
7818      AMMOM=XMEAN*(XMEAN-1.0)**2/(XMEAN**2*(XMEAN-1.0)-XVAR)
7819      AMUFR=XMEAN
7820      AMUML=XMEAN
7821C
7822      AE=1.D-7
7823      RE=1.D-7
7824      XBAR=DBLE(XMEAN)
7825      S2=DBLE(XSD)**2
7826      F1FREQ=DBLE(F1)
7827      IF(AMMOM.LE.1.0)THEN
7828        AMMOM=1.5
7829        XMID=DBLE(AMMOM)
7830      ELSE
7831        XMID=DBLE(AMMOM)
7832      ENDIF
7833      XLOW=1.000001D0
7834      XUP=XMID + 10.0D0
7835      CALL DFZERO(CONFUN,XLOW,XUP,XMID,RE,AE,IFLAG)
7836      AMFR=REAL(XLOW)
7837C
7838      IOPT=2
7839      TOL=1.0D-5
7840      NPAR=1
7841      NPRINT=-1
7842      INFO=0
7843      LWA=MAXNXT
7844      MAXRO2=MAXNXT
7845      NTOT2=NTOTZZ
7846C
7847      IF(AMMOM.LE.1.0)THEN
7848        XPAR(1)=DBLE(AMFR)
7849        IF(XPAR(1).LE.1.0D0)XPAR(1)=1.5D0
7850      ELSE
7851        XPAR(1)=DBLE(AMMOM)
7852      ENDIF
7853      CALL DNSQE(CONFU2,JAC,IOPT,NPAR,XPAR,FVEC,TOL,NPRINT,INFO,
7854     1             DTEMP1,LWA,TEMP3,IK)
7855C
7856      AMML=REAL(XPAR(1))
7857C
7858C               ***********************************************
7859C               **   STEP 42--                               **
7860C               **   WRITE OUT EVERYTHING                    **
7861C               **   FOR CONSUL MLE                          **
7862C               **   ESTIMATION                              **
7863C               ***********************************************
7864C
7865      ISTEPN='42'
7866      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLCN')
7867     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7868C
7869C     PRINT SUMMARY STATISTICS TABLE
7870C
7871      NUMDIG=7
7872      IF(IFORSW.EQ.'1')NUMDIG=1
7873      IF(IFORSW.EQ.'2')NUMDIG=2
7874      IF(IFORSW.EQ.'3')NUMDIG=3
7875      IF(IFORSW.EQ.'4')NUMDIG=4
7876      IF(IFORSW.EQ.'5')NUMDIG=5
7877      IF(IFORSW.EQ.'6')NUMDIG=6
7878      IF(IFORSW.EQ.'7')NUMDIG=7
7879      IF(IFORSW.EQ.'8')NUMDIG=8
7880      IF(IFORSW.EQ.'9')NUMDIG=9
7881      IF(IFORSW.EQ.'0')NUMDIG=0
7882      IF(IFORSW.EQ.'E')NUMDIG=-2
7883      IF(IFORSW.EQ.'-2')NUMDIG=-2
7884      IF(IFORSW.EQ.'-3')NUMDIG=-3
7885      IF(IFORSW.EQ.'-4')NUMDIG=-4
7886      IF(IFORSW.EQ.'-5')NUMDIG=-5
7887      IF(IFORSW.EQ.'-6')NUMDIG=-6
7888      IF(IFORSW.EQ.'-7')NUMDIG=-7
7889      IF(IFORSW.EQ.'-8')NUMDIG=-8
7890      IF(IFORSW.EQ.'-9')NUMDIG=-9
7891C
7892      ITITLE='Consul Parameter Estimation'
7893      NCTITL=43
7894      ITITLZ=' '
7895      NCTITZ=0
7896C
7897      ICNT=1
7898      ITEXT(ICNT)='Summary Statistics:'
7899      NCTEXT(ICNT)=19
7900      AVALUE(ICNT)=0.0
7901      IDIGIT(ICNT)=-1
7902      ICNT=ICNT+1
7903      ITEXT(ICNT)='Number of Observations:'
7904      NCTEXT(ICNT)=23
7905      AVALUE(ICNT)=REAL(NTOTZZ)
7906      IDIGIT(ICNT)=0
7907      ICNT=ICNT+1
7908      ITEXT(ICNT)='Sample Mean:'
7909      NCTEXT(ICNT)=12
7910      AVALUE(ICNT)=XMEAN
7911      IDIGIT(ICNT)=NUMDIG
7912      ICNT=ICNT+1
7913      ITEXT(ICNT)='Sample Standard Deviation:'
7914      NCTEXT(ICNT)=26
7915      AVALUE(ICNT)=XSD
7916      IDIGIT(ICNT)=NUMDIG
7917      ICNT=ICNT+1
7918      ITEXT(ICNT)='Sample Minimum:'
7919      NCTEXT(ICNT)=15
7920      AVALUE(ICNT)=XMIN
7921      IDIGIT(ICNT)=NUMDIG
7922      ICNT=ICNT+1
7923      ITEXT(ICNT)='Sample Maximum:'
7924      NCTEXT(ICNT)=15
7925      AVALUE(ICNT)=XMAX
7926      IDIGIT(ICNT)=NUMDIG
7927      ICNT=ICNT+1
7928      ITEXT(ICNT)='Sample First Frequency:'
7929      NCTEXT(ICNT)=23
7930      AVALUE(ICNT)=F1
7931      IDIGIT(ICNT)=NUMDIG
7932      ICNT=ICNT+1
7933      ITEXT(ICNT)=' '
7934      NCTEXT(ICNT)=0
7935      AVALUE(ICNT)=0.0
7936      IDIGIT(ICNT)=-1
7937C
7938      ICNT=ICNT+1
7939      ITEXT(ICNT)='Method of Moments:'
7940      NCTEXT(ICNT)=18
7941      AVALUE(ICNT)=0.0
7942      IDIGIT(ICNT)=-1
7943      ICNT=ICNT+1
7944      IF(ICONDF.EQ.'THET')THEN
7945        ITEXT(ICNT)='Estimate of Theta:'
7946        NCTEXT(ICNT)=18
7947      ELSE
7948        ITEXT(ICNT)='Estimate of Mu:'
7949        NCTEXT(ICNT)=15
7950      ENDIF
7951      AVALUE(ICNT)=AMUMOM
7952      IDIGIT(ICNT)=NUMDIG
7953      ICNT=ICNT+1
7954      ITEXT(ICNT)='Estimate of M:'
7955      NCTEXT(ICNT)=14
7956      AVALUE(ICNT)=AMMOM
7957      IDIGIT(ICNT)=NUMDIG
7958      ICNT=ICNT+1
7959      ITEXT(ICNT)=' '
7960      NCTEXT(ICNT)=0
7961      AVALUE(ICNT)=0.0
7962      IDIGIT(ICNT)=-1
7963C
7964      ICNT=ICNT+1
7965      ITEXT(ICNT)='Method of First Frequency and Mean:'
7966      NCTEXT(ICNT)=35
7967      AVALUE(ICNT)=0.0
7968      IDIGIT(ICNT)=-1
7969      ICNT=ICNT+1
7970      IF(ICONDF.EQ.'THET')THEN
7971        ITEXT(ICNT)='Estimate of Theta:'
7972        NCTEXT(ICNT)=18
7973      ELSE
7974        ITEXT(ICNT)='Estimate of Mu:'
7975        NCTEXT(ICNT)=15
7976      ENDIF
7977      ITEXT(ICNT)='Estimate of Theta:'
7978      NCTEXT(ICNT)=18
7979      AVALUE(ICNT)=AMUFR
7980      IDIGIT(ICNT)=NUMDIG
7981      ICNT=ICNT+1
7982      ITEXT(ICNT)='Estimate of M:'
7983      NCTEXT(ICNT)=14
7984      AVALUE(ICNT)=AMFR
7985      IDIGIT(ICNT)=NUMDIG
7986      ICNT=ICNT+1
7987      ITEXT(ICNT)=' '
7988      NCTEXT(ICNT)=0
7989      AVALUE(ICNT)=0.0
7990      IDIGIT(ICNT)=-1
7991C
7992      ICNT=ICNT+1
7993      ITEXT(ICNT)='Method of Maximum Likelihood:'
7994      NCTEXT(ICNT)=29
7995      AVALUE(ICNT)=0.0
7996      IDIGIT(ICNT)=-1
7997      ICNT=ICNT+1
7998      IF(ICONDF.EQ.'THET')THEN
7999        ITEXT(ICNT)='Estimate of Theta:'
8000        NCTEXT(ICNT)=18
8001      ELSE
8002        ITEXT(ICNT)='Estimate of Mu:'
8003        NCTEXT(ICNT)=15
8004      ENDIF
8005      AVALUE(ICNT)=AMUML
8006      IDIGIT(ICNT)=NUMDIG
8007      ICNT=ICNT+1
8008      ITEXT(ICNT)='Estimate of M:'
8009      NCTEXT(ICNT)=14
8010      AVALUE(ICNT)=AMML
8011      IDIGIT(ICNT)=NUMDIG
8012      ICNT=ICNT+1
8013      ITEXT(ICNT)=' '
8014      NCTEXT(ICNT)=0
8015      AVALUE(ICNT)=0.0
8016      IDIGIT(ICNT)=-1
8017C
8018      NUMROW=ICNT
8019      DO2310I=1,NUMROW
8020        NTOT(I)=15
8021 2310 CONTINUE
8022C
8023      IFRST=.TRUE.
8024      ILAST=.TRUE.
8025      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
8026     1            AVALUE,IDIGIT,
8027     1            NTOT,NUMROW,
8028     1            ICAPSW,ICAPTY,ILAST,IFRST,
8029     1            ISUBRO,IBUGA3,IERROR)
8030C
8031C               *****************
8032C               **  STEP 90--  **
8033C               **  EXIT       **
8034C               *****************
8035C
8036 9000 CONTINUE
8037      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLCN')THEN
8038        WRITE(ICOUT,999)
8039        CALL DPWRST('XXX','WRIT')
8040        WRITE(ICOUT,9011)
8041 9011   FORMAT('***** AT THE END       OF DPMLCN--')
8042        CALL DPWRST('XXX','WRIT')
8043        WRITE(ICOUT,9013)AMUMOM,AMMOM,AMUFR,AMFR,AMUML,AMML
8044 9013   FORMAT('AMUMOM,AMMOM,AMUFR,AMFR,AMUML,AMML = ',6G15.7)
8045        CALL DPWRST('XXX','WRIT')
8046      ENDIF
8047C
8048      RETURN
8049      END
8050      SUBROUTINE DPMLDE(Y,N,
8051     1                  XTEMP,MAXNXT,
8052     1                  ALOC,SCALE,ALOCSE,SCALSE,
8053     1                  ICAPSW,ICAPTY,IFORSW,
8054     1                  ISUBRO,IBUGA3,IERROR)
8055C
8056C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
8057C              ESTIMATES FOR THER DOUBLE EXPONENTIAL DISTRIBUTION
8058C     EXAMPLE--DOUBLE EXPONENTIAL MAXIMUM LIKELIHOOD Y
8059C     REFERENCE--XX
8060C     WRITTEN BY--JAMES J. FILLIBEN
8061C                 STATISTICAL ENGINEERING DIVISION
8062C                 INFORMATION TECHNOLOGY LABORATORY
8063C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
8064C                 GAITHERSBURG, MD 20899-8980
8065C                 PHONE--301-975-2855
8066C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
8067C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
8068C     LANGUAGE--ANSI FORTRAN (1977)
8069C     VERSION NUMBER--98/6
8070C     ORIGINAL VERSION--JUNE      1998.
8071C     UPDATED         --MARCH     2004.
8072C     UPDATED         --FEBRUARY  2005. SOME CHANGES IN THE OUTPUT
8073C                                       FORMAT
8074C     UPDATED         --MAY       2005. ADD CONFIDENCE INTERVALS FOR
8075C                                       LOCATION AND SCALE PARAMETERS
8076C     UPDATED         --JUNE      2010. USE DPDTA1 AND DPDTA7 TO
8077C                                       PRINT OUTPUT, ADD AIC AND
8078C                                       RELATED STATISTICS TO OUTPUT
8079C
8080C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
8081C
8082      CHARACTER*4 ICAPSW
8083      CHARACTER*4 ICAPTY
8084      CHARACTER*4 IFORSW
8085      CHARACTER*4 ISUBRO
8086      CHARACTER*4 IBUGA3
8087      CHARACTER*4 IERROR
8088C
8089      CHARACTER*4 IWRITE
8090      CHARACTER*4 INORM
8091      CHARACTER*4 ISUBN1
8092      CHARACTER*4 ISUBN2
8093      CHARACTER*4 ISTEPN
8094C
8095C---------------------------------------------------------------------
8096C
8097      DIMENSION Y(*)
8098      DIMENSION XTEMP(*)
8099      DIMENSION QP(1)
8100C
8101      PARAMETER (NUMALP=8)
8102      DIMENSION ALPHA(NUMALP)
8103      DIMENSION ALOWSC(NUMALP)
8104      DIMENSION AUPPSC(NUMALP)
8105      DIMENSION ALOWLO(NUMALP)
8106      DIMENSION AUPPLO(NUMALP)
8107C
8108      INCLUDE 'DPCOST.INC'
8109C
8110      PARAMETER (MAXROW=50)
8111      CHARACTER*60 ITITLE
8112      CHARACTER*1  ITITLZ
8113      CHARACTER*40 ITEXT(MAXROW)
8114      REAL         AVALUE(MAXROW)
8115      INTEGER      NCTEXT(MAXROW)
8116      INTEGER      IDIGIT(MAXROW)
8117      INTEGER      NTOT(MAXROW)
8118C
8119      LOGICAL IFRST
8120      LOGICAL ILAST
8121C
8122C---------------------------------------------------------------------
8123C
8124      INCLUDE 'DPCOP2.INC'
8125C
8126      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
8127C
8128C-----START POINT-----------------------------------------------------
8129C
8130      ISUBN1='DPML'
8131      ISUBN2='DE  '
8132      IERROR='NO'
8133C
8134      ALOCSE=CPUMIN
8135      SCALSE=CPUMIN
8136C
8137      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLDE')THEN
8138        WRITE(ICOUT,999)
8139  999   FORMAT(1X)
8140        CALL DPWRST('XXX','WRIT')
8141        WRITE(ICOUT,51)
8142   51   FORMAT('**** AT THE BEGINNING OF DPMLDE--')
8143        CALL DPWRST('XXX','WRIT')
8144        WRITE(ICOUT,55)N,IBUGA3
8145   55   FORMAT('N,IBUGA3 = ',I8,2X,A4)
8146        CALL DPWRST('XXX','WRIT')
8147        DO56I=1,MIN(N,100)
8148          WRITE(ICOUT,57)I,Y(I)
8149   57     FORMAT('I,Y(I) = ',I8,G15.7)
8150          CALL DPWRST('XXX','WRIT')
8151   56   CONTINUE
8152      ENDIF
8153C
8154C               ********************************************
8155C               **  STEP 11--                             **
8156C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
8157C               ********************************************
8158C
8159      ISTEPN='11'
8160      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLDE')
8161     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8162C
8163      NPERC=0
8164      NMIN=2
8165      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
8166      IF(IERROR.EQ.'YES')GOTO9000
8167C
8168C               **********************************
8169C               **  STEP 41--                   **
8170C               **  CARRY OUT CALCULATIONS      **
8171C               **  FOR DOUBLE EXPONENTIAL MLE  **
8172C               **  ESTIMATE (FULL SAMPLE CASE) **
8173C               **********************************
8174C
8175      ISTEPN='41'
8176      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLDE')
8177     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8178C
8179      IERROR='NO'
8180      IWRITE='OFF'
8181      ICASE=1
8182C
8183      CALL DEXML1(Y,N,XTEMP,ICASE,MAXNXT,
8184     1            ALOWLO,AUPPLO,ALOWSC,AUPPSC,
8185     1            ALPHA,NUMALP,NUMOUT,
8186     1            XMEAN,XMED,XSD,XMIN,XMAX,
8187     1            ALOC,SCALE,
8188     1            ISUBRO,IBUGA3,IERROR)
8189C
8190      CALL DEXLI1(Y,N,ALOC,SCALE,
8191     1            ALIK,AIC,AICC,BIC,
8192     1            ISUBRO,IBUGA3,IERROR)
8193C
8194      IF(IPRINT.EQ.'OFF')GOTO8000
8195C
8196      NUMDIG=7
8197      IF(IFORSW.EQ.'1')NUMDIG=1
8198      IF(IFORSW.EQ.'2')NUMDIG=2
8199      IF(IFORSW.EQ.'3')NUMDIG=3
8200      IF(IFORSW.EQ.'4')NUMDIG=4
8201      IF(IFORSW.EQ.'5')NUMDIG=5
8202      IF(IFORSW.EQ.'6')NUMDIG=6
8203      IF(IFORSW.EQ.'7')NUMDIG=7
8204      IF(IFORSW.EQ.'8')NUMDIG=8
8205      IF(IFORSW.EQ.'9')NUMDIG=9
8206      IF(IFORSW.EQ.'0')NUMDIG=0
8207      IF(IFORSW.EQ.'E')NUMDIG=-2
8208      IF(IFORSW.EQ.'-2')NUMDIG=-2
8209      IF(IFORSW.EQ.'-3')NUMDIG=-3
8210      IF(IFORSW.EQ.'-4')NUMDIG=-4
8211      IF(IFORSW.EQ.'-5')NUMDIG=-5
8212      IF(IFORSW.EQ.'-6')NUMDIG=-6
8213      IF(IFORSW.EQ.'-7')NUMDIG=-7
8214      IF(IFORSW.EQ.'-8')NUMDIG=-8
8215      IF(IFORSW.EQ.'-9')NUMDIG=-9
8216C
8217      ITITLE='Double Exponential Parameter Estimation'
8218      NCTITL=39
8219      ITEXT(1)='Summary Statistics:'
8220      NCTEXT(1)=19
8221      AVALUE(1)=0.0
8222      IDIGIT(1)=-1
8223      ITEXT(2)='Number of Observations:'
8224      NCTEXT(2)=23
8225      AVALUE(2)=REAL(N)
8226      IDIGIT(2)=0
8227      ICNT=3
8228      ITEXT(ICNT)='Sample Mean:'
8229      NCTEXT(ICNT)=12
8230      AVALUE(ICNT)=XMEAN
8231      IDIGIT(ICNT)=NUMDIG
8232      ICNT=ICNT+1
8233      ITEXT(ICNT)='Sample Standard Deviation:'
8234      NCTEXT(ICNT)=26
8235      AVALUE(ICNT)=XSD
8236      IDIGIT(ICNT)=NUMDIG
8237      ICNT=ICNT+1
8238      ITEXT(ICNT)='Sample Minimum:'
8239      NCTEXT(ICNT)=15
8240      AVALUE(ICNT)=XMIN
8241      IDIGIT(ICNT)=NUMDIG
8242      ICNT=ICNT+1
8243      ITEXT(ICNT)='Sample Maximum:'
8244      NCTEXT(ICNT)=15
8245      AVALUE(ICNT)=XMAX
8246      IDIGIT(ICNT)=NUMDIG
8247      ICNT=ICNT+1
8248      ITEXT(ICNT)=' '
8249      NCTEXT(ICNT)=0
8250      AVALUE(ICNT)=0.0
8251      IDIGIT(ICNT)=-1
8252C
8253      ICNT=ICNT+1
8254      ITEXT(ICNT)='Maximum Likelihood Estimation Method:'
8255      NCTEXT(ICNT)=37
8256      AVALUE(ICNT)=0.0
8257      IDIGIT(ICNT)=-1
8258      ICNT=ICNT+1
8259      ITEXT(ICNT)='Location Parameter:'
8260      NCTEXT(ICNT)=19
8261      AVALUE(ICNT)=ALOC
8262      IDIGIT(ICNT)=NUMDIG
8263      ICNT=ICNT+1
8264      ITEXT(ICNT)='Scale Parameter:'
8265      NCTEXT(ICNT)=16
8266      AVALUE(ICNT)=SCALE
8267      IDIGIT(ICNT)=NUMDIG
8268      ICNT=ICNT+1
8269      ITEXT(ICNT)='Log-likelihood:'
8270      NCTEXT(ICNT)=15
8271      AVALUE(ICNT)=ALIK
8272      IDIGIT(ICNT)=-7
8273      ICNT=ICNT+1
8274      ITEXT(ICNT)='AIC:'
8275      NCTEXT(ICNT)=4
8276      AVALUE(ICNT)=AIC
8277      IDIGIT(ICNT)=-7
8278      ICNT=ICNT+1
8279      ITEXT(ICNT)='AICc:'
8280      NCTEXT(ICNT)=5
8281      AVALUE(ICNT)=AICC
8282      IDIGIT(ICNT)=-7
8283      ICNT=ICNT+1
8284      ITEXT(ICNT)='BIC:'
8285      NCTEXT(ICNT)=4
8286      AVALUE(ICNT)=BIC
8287      IDIGIT(ICNT)=-7
8288      ICNT=ICNT+1
8289      ITEXT(ICNT)=' '
8290      NCTEXT(ICNT)=0
8291      AVALUE(ICNT)=0.0
8292      IDIGIT(ICNT)=-1
8293C
8294      NUMROW=ICNT
8295      DO2310I=1,NUMROW
8296        NTOT(I)=15
8297 2310 CONTINUE
8298C
8299      IFRST=.TRUE.
8300      ILAST=.FALSE.
8301      NCTITZ=0
8302      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
8303     1            NCTEXT,AVALUE,IDIGIT,
8304     1            NTOT,NUMROW,
8305     1            ICAPSW,ICAPTY,ILAST,IFRST,
8306     1            ISUBRO,IBUGA3,IERROR)
8307      IFRST=.FALSE.
8308      ITITLE=' '
8309      NCTITL=0
8310C
8311      INORM='YES'
8312      CALL DPDTA7(ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,NUMALP,
8313     1            ICAPSW,ICAPTY,NUMDIG,INORM,
8314     1            ISUBRO,IBUGA3,IERROR)
8315C
8316C
8317 8000 CONTINUE
8318C
8319      IF(IFEEDB.EQ.'ON')THEN
8320        WRITE(ICOUT,4141)
8321 4141   FORMAT('THE LOCATION AND SCALE PARAMETERS WILL BE SAVED AS')
8322        CALL DPWRST('XXX','BUG ')
8323        WRITE(ICOUT,4143)
8324 4143   FORMAT(6X,'THE INTERNAL PARAMETERS LOCML AND SCALEML.')
8325        CALL DPWRST('XXX','BUG ')
8326        WRITE(ICOUT,999)
8327        CALL DPWRST('XXX','BUG ')
8328      ENDIF
8329C               *****************
8330C               **  STEP 90--  **
8331C               **  EXIT       **
8332C               *****************
8333C
8334 9000 CONTINUE
8335      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLDE')GOTO9090
8336      WRITE(ICOUT,999)
8337      CALL DPWRST('XXX','WRIT')
8338      WRITE(ICOUT,9011)
8339 9011 FORMAT('***** AT THE END       OF DPMLDE--')
8340      CALL DPWRST('XXX','WRIT')
8341      WRITE(ICOUT,9012)N,IBUGA3,IERROR
8342 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
8343      CALL DPWRST('XXX','WRIT')
8344      WRITE(ICOUT,9015)N
8345 9015 FORMAT('N = ',I8)
8346      CALL DPWRST('XXX','WRIT')
8347 9090 CONTINUE
8348C
8349      RETURN
8350      END
8351      SUBROUTINE DPMLDL(Y,X,N,NVAR,
8352     1                  TEMP1,TEMP2,TEMP3,MAXNXT,
8353     1                  THETML,THETSE,
8354     1                  AIC,AICC,BIC,
8355     1                  ICAPSW,ICAPTY,IFORSW,
8356     1                  ISUBRO,IBUGA3,IERROR)
8357C
8358C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
8359C              ESTIMATES FOR LOGARITHMIC SERIES DISTRIBUTION
8360C              THE MAXIMUM LIKELIHOOD ESTIMATE OF THETA IS THE
8361C              SOLUTION TO THE EQUATION:
8362C                 XBAR = THETAHAT/[-(1-THETAHAT)LN(1-THETAHAT)
8363C              BOUNDS FOR THETAHAT ARE:
8364C                [(9*XBAR-6)-SQRT(9*XBAR**2-12*XBAR+12)]/(6*XBAR-2)
8365C                         <= THETAHAT  <=
8366C                [(6*XBAR-3)-SQRT(24*XBAR**2-24*XBAR+9)]/XBAR
8367C              THE ASYMPTOTIC VARIANCE OF THETAHAT IS:
8368C                 (1/N)*THETA**2/U2)
8369C              WITH U2 DENOTING THE VARIANCE OF THE LOGARITMIC
8370C              SERIES DISTRIBUTION:
8371C                 U2 = A*THETA(1-A*THETA)/(1-THETA)**2
8372C                  A = -1/LN(1-THETA)
8373C              THE SAMPLE VARIANCE AND THETAHAT ARE USED TO
8374C              COMPUTE AN ESTIMATE OF THIS ASYMPTOTIC VARIANCE.
8375C     EXAMPLE--LOGARITHMIC SERIES MAXIMUM LIKELIHOOD Y
8376C     REFERENCE--"UNIVARIATE DISCRETE DISTRIBUTIONS", SECOND EDITION,
8377C                JOHNSON, KOTZ, AND KEMP, WILEY, 1992, CHAPTER 7.
8378C     WRITTEN BY--ALAN HECKERT
8379C                 STATISTICAL ENGINEERING DIVISION
8380C                 INFORMATION TECHNOLOGY LABORATORY
8381C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
8382C                 GAITHERSBURG, MD 20899-8980
8383C                 PHONE--301-975-2899
8384C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
8385C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
8386C     LANGUAGE--ANSI FORTRAN (1977)
8387C     VERSION NUMBER--2004/3
8388C     ORIGINAL VERSION--MARCH     2004.
8389C     UPDATED         --APRIL     2011. USE DPDTA1 TO PRINT THE OUTPUT
8390C
8391C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
8392C
8393      CHARACTER*4 ICAPSW
8394      CHARACTER*4 ICAPTY
8395      CHARACTER*4 IFORSW
8396      CHARACTER*4 ISUBRO
8397      CHARACTER*4 IBUGA3
8398      CHARACTER*4 IERROR
8399C
8400      CHARACTER*4 IWRITE
8401      CHARACTER*4 ISUBN1
8402      CHARACTER*4 ISUBN2
8403      CHARACTER*4 ISTEPN
8404C
8405      REAL     DLGFU2
8406      EXTERNAL DLGFU2
8407      REAL XMEAN
8408      COMMON/DLGCOM/XMEAN
8409C
8410C---------------------------------------------------------------------
8411C
8412      DIMENSION Y(*)
8413      DIMENSION X(*)
8414      DIMENSION TEMP1(*)
8415      DIMENSION TEMP2(*)
8416      DIMENSION TEMP3(*)
8417C
8418      PARAMETER (NUMALP=8)
8419      DIMENSION ALPHA(NUMALP)
8420      DIMENSION ALOWTH(NUMALP)
8421      DIMENSION AUPPTH(NUMALP)
8422C
8423      PARAMETER (MAXROW=20)
8424      CHARACTER*60 ITITLE
8425      CHARACTER*1  ITITLZ
8426      CHARACTER*1  ITITL9
8427      CHARACTER*40 IDIST
8428      CHARACTER*40 ITEXT(MAXROW)
8429      CHARACTER*4  ALIGN(MAXROW)
8430      CHARACTER*4  VALIGN(MAXROW)
8431      REAL         AVALUE(MAXROW)
8432      INTEGER      NCTEXT(MAXROW)
8433      INTEGER      IDIGIT(MAXROW)
8434      INTEGER      NTOT(MAXROW)
8435      LOGICAL      IFRST
8436      LOGICAL      ILAST
8437C
8438      PARAMETER(NUMCLI=3)
8439      PARAMETER(MAXLIN=2)
8440      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
8441      INTEGER      NCTIT2(MAXLIN,NUMCLI)
8442      INTEGER      IWHTML(NUMALP)
8443      INTEGER      IWRTF(NUMALP)
8444      REAL         AMAT(MAXROW,NUMCLI)
8445C
8446C---------------------------------------------------------------------
8447C
8448      INCLUDE 'DPCOP2.INC'
8449C
8450C-----START POINT-----------------------------------------------------
8451C
8452      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.05, 0.005, 0.01/
8453C
8454      ISUBN1='DPML'
8455      ISUBN2='DL  '
8456C
8457      IERROR='NO'
8458      IWRITE='OFF'
8459C
8460      THETA=CPUMIN
8461      ASYMVA=CPUMIN
8462      AIC=CPUMIN
8463      AICC=CPUMIN
8464      BIC=CPUMIN
8465C
8466      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLDL')THEN
8467        WRITE(ICOUT,999)
8468  999   FORMAT(1X)
8469        CALL DPWRST('XXX','WRIT')
8470        WRITE(ICOUT,51)
8471   51   FORMAT('**** AT THE BEGINNING OF DPMLDL--')
8472        CALL DPWRST('XXX','WRIT')
8473        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR
8474   52   FORMAT('IBUGA3,ISUBRO,N,NVAR = ',2(A4,2X),2I8)
8475        CALL DPWRST('XXX','WRIT')
8476        IF(NVAR.EQ.1)THEN
8477          DO56I=1,MIN(N,100)
8478            WRITE(ICOUT,57)I,Y(I)
8479   57       FORMAT('I,Y(I) = ',I8,G15.7)
8480            CALL DPWRST('XXX','WRIT')
8481   56     CONTINUE
8482        ELSE
8483          DO61I=1,N
8484            WRITE(ICOUT,62)I,X(I),Y(I)
8485   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
8486            CALL DPWRST('XXX','WRIT')
8487   61     CONTINUE
8488        ENDIF
8489      ENDIF
8490C
8491C               ********************************************
8492C               **  STEP 11--                             **
8493C               **  1) ROUND DATA TO INTEGER VALUES       **
8494C               **  2) COMPUTE SUMMARY STATISTICS         **
8495C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
8496C               **     INSUFFICIENT SAMPLE SIZE           **
8497C               ********************************************
8498C
8499      ISTEPN='11'
8500      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLDL')
8501     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8502C
8503      IDIST='LOGARITHMIC SERIES'
8504C
8505      NPERC=0
8506      MAXGRP=MAXNXT/2
8507      NMIN=2
8508      IF(NVAR.EQ.1)THEN
8509        DO1105I=1,N
8510          ITEMP=INT(Y(I)+0.5)
8511          Y(I)=REAL(ITEMP)
8512 1105   CONTINUE
8513        CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
8514        IF(IERROR.EQ.'YES')GOTO9000
8515C
8516        IFLAG=1
8517        CALL SUMRAW(Y,N,IDIST,IFLAG,
8518     1              XMEAN,XVAR,XSD,XMIN,XMAX,
8519     1              ISUBRO,IBUGA3,IERROR)
8520        IF(IERROR.EQ.'YES')GOTO9000
8521        NTOTZZ=N
8522C
8523      ELSE
8524        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
8525     1              ISUBRO,IBUGA3,IERROR)
8526        IF(IERROR.EQ.'YES')GOTO9000
8527        IFLAG1=1
8528        IFLAG2=1
8529        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
8530     1              TEMP1,TEMP2,TEMP3,MAXNXT,
8531     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
8532     1              ISUBRO,IBUGA3,IERROR)
8533        IF(IERROR.EQ.'YES')GOTO9000
8534      ENDIF
8535C
8536      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLDL')THEN
8537        WRITE(ICOUT,999)
8538        CALL DPWRST('XXX','WRIT')
8539        WRITE(ICOUT,1151)
8540 1151   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
8541        CALL DPWRST('XXX','WRIT')
8542        WRITE(ICOUT,1152)XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ
8543 1152   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ = ',5G15.7,I10)
8544        CALL DPWRST('XXX','WRIT')
8545      ENDIF
8546C
8547C               ******************************************
8548C               **  STEP 21--                           **
8549C               **  CARRY OUT CALCULATIONS              **
8550C               **  FOR LOGARITHMIC SERIES MLE ESTIMATE **
8551C               ******************************************
8552C
8553      ISTEPN='21'
8554      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLDL')
8555     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8556C
8557      TERM1=9.0*XMEAN-6.0
8558      TERM2=SQRT(9.0*XMEAN*XMEAN - 12.0*XMEAN + 12.0)
8559      TERM3=6.0*XMEAN - 2.0
8560      XLOWLI=(TERM1-TERM2)/TERM3
8561      TERM1=6.0*XMEAN-3.0
8562      TERM2=SQRT(24.0*XMEAN*XMEAN - 24.0*XMEAN + 9.0)
8563      TERM3=XMEAN
8564      XUPPLI=(TERM1-TERM2)/TERM3
8565C
8566      AE=1.E-6
8567      RE=1.E-6
8568      IFLAG=0
8569      THETA2=(XLOWLI+XUPPLI)/2.0
8570      CALL FZERO(DLGFU2,XLOWLI,THETA2,XUPPLI,RE,AE,IFLAG)
8571C
8572      THETML=XLOWLI
8573      A=-1.0/(LOG(1.0-THETML))
8574      DVARI=A*THETML*(1.0-A*THETML)/(1.0-THETML)**2
8575      ASYMVA=(1.0/REAL(NTOTZZ))*(THETML**2/DVARI)
8576      THETSE=SQRT(ASYMVA)
8577C
8578      IF(IFLAG.EQ.2)THEN
8579C
8580        WRITE(ICOUT,999)
8581        CALL DPWRST('XXX','BUG ')
8582        WRITE(ICOUT,2211)
8583 2211   FORMAT('***** WARNING FROM LOGARITHMIC SERIES MAXIMUM ',
8584     1         'LIKELIHOOD--')
8585        CALL DPWRST('XXX','BUG ')
8586        WRITE(ICOUT,2213)
8587 2213   FORMAT('      ESTIMATE OF THETA VALUE MAY NOT BE COMPUTED ',
8588     1         'TO DESIRED TOLERANCE.')
8589        CALL DPWRST('XXX','BUG ')
8590      ELSEIF(IFLAG.EQ.3)THEN
8591        WRITE(ICOUT,999)
8592        CALL DPWRST('XXX','BUG ')
8593        WRITE(ICOUT,2211)
8594        CALL DPWRST('XXX','BUG ')
8595        WRITE(ICOUT,2223)
8596 2223   FORMAT('      ESTIMATE OF THETA MAY BE NEAR A SINGULAR POINT.')
8597        CALL DPWRST('XXX','BUG ')
8598      ELSEIF(IFLAG.EQ.4)THEN
8599CCCCC   WRITE(ICOUT,999)
8600CCCCC   CALL DPWRST('XXX','BUG ')
8601CCCCC   WRITE(ICOUT,2231)
8602C2231   FORMAT('***** ERROR FROM LOGARITHMIC SERIES MAXIMUM ',
8603CCCCC1         'LIKELIHOOD--')
8604CCCCC   CALL DPWRST('XXX','BUG ')
8605CCCCC   WRITE(ICOUT,2233)
8606C2233   FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
8607CCCCC   CALL DPWRST('XXX','BUG ')
8608      ELSEIF(IFLAG.EQ.5)THEN
8609        WRITE(ICOUT,999)
8610        CALL DPWRST('XXX','BUG ')
8611        WRITE(ICOUT,2211)
8612        CALL DPWRST('XXX','BUG ')
8613        WRITE(ICOUT,2243)
8614 2243   FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
8615        CALL DPWRST('XXX','BUG ')
8616      ENDIF
8617C
8618      DO2290I=1,NUMALP
8619        ALP=ALPHA(I)
8620        P1=ALP/2.0
8621        P2=1.0-(ALP/2.0)
8622        CALL NORPPF(P1,APPF1)
8623        CALL NORPPF(P2,APPF2)
8624        ALOWTH(I)=THETML + APPF1*THETSE
8625        AUPPTH(I)=THETML + APPF2*THETSE
8626        IF(ALOWTH(I).LT.0.0)ALOWTH(I)=0.0
8627        IF(AUPPTH(I).GT.1.0)AUPPTH(I)=1.0
8628 2290 CONTINUE
8629C
8630C               ********************************************
8631C               **   STEP 42--                            **
8632C               **   WRITE OUT EVERYTHING                 **
8633C               **   FOR LOGARITHMIC SERIES MLE ESTIMATE  **
8634C               ********************************************
8635C
8636      ISTEPN='42'
8637      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLDL')
8638     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8639C
8640C     PRINT SUMMARY STATISTICS TABLE
8641C
8642      NUMDIG=7
8643      IF(IFORSW.EQ.'1')NUMDIG=1
8644      IF(IFORSW.EQ.'2')NUMDIG=2
8645      IF(IFORSW.EQ.'3')NUMDIG=3
8646      IF(IFORSW.EQ.'4')NUMDIG=4
8647      IF(IFORSW.EQ.'5')NUMDIG=5
8648      IF(IFORSW.EQ.'6')NUMDIG=6
8649      IF(IFORSW.EQ.'7')NUMDIG=7
8650      IF(IFORSW.EQ.'8')NUMDIG=8
8651      IF(IFORSW.EQ.'9')NUMDIG=9
8652      IF(IFORSW.EQ.'0')NUMDIG=0
8653      IF(IFORSW.EQ.'E')NUMDIG=-2
8654      IF(IFORSW.EQ.'-2')NUMDIG=-2
8655      IF(IFORSW.EQ.'-3')NUMDIG=-3
8656      IF(IFORSW.EQ.'-4')NUMDIG=-4
8657      IF(IFORSW.EQ.'-5')NUMDIG=-5
8658      IF(IFORSW.EQ.'-6')NUMDIG=-6
8659      IF(IFORSW.EQ.'-7')NUMDIG=-7
8660      IF(IFORSW.EQ.'-8')NUMDIG=-8
8661      IF(IFORSW.EQ.'-9')NUMDIG=-9
8662C
8663      ITITLE='Logarithmic Series Parameter Estimation'
8664      NCTITL=39
8665      ITITLZ=' '
8666      NCTITZ=0
8667C
8668      ICNT=1
8669      ITEXT(ICNT)='Summary Statistics:'
8670      NCTEXT(ICNT)=19
8671      AVALUE(ICNT)=0.0
8672      IDIGIT(ICNT)=-1
8673      ICNT=ICNT+1
8674      ITEXT(ICNT)='Number of Observations:'
8675      NCTEXT(ICNT)=23
8676      AVALUE(ICNT)=REAL(NTOTZZ)
8677      IDIGIT(ICNT)=0
8678      ICNT=ICNT+1
8679      ITEXT(ICNT)='Sample Mean:'
8680      NCTEXT(ICNT)=12
8681      AVALUE(ICNT)=XMEAN
8682      IDIGIT(ICNT)=NUMDIG
8683      ICNT=ICNT+1
8684      ITEXT(ICNT)='Sample Standard Deviation:'
8685      NCTEXT(ICNT)=26
8686      AVALUE(ICNT)=XSD
8687      IDIGIT(ICNT)=NUMDIG
8688      ICNT=ICNT+1
8689      ITEXT(ICNT)='Sample Minimum:'
8690      NCTEXT(ICNT)=15
8691      AVALUE(ICNT)=XMIN
8692      IDIGIT(ICNT)=NUMDIG
8693      ICNT=ICNT+1
8694      ITEXT(ICNT)='Sample Maximum:'
8695      NCTEXT(ICNT)=15
8696      AVALUE(ICNT)=XMAX
8697      IDIGIT(ICNT)=NUMDIG
8698      ICNT=ICNT+1
8699      ITEXT(ICNT)=' '
8700      NCTEXT(ICNT)=0
8701      AVALUE(ICNT)=0.0
8702      IDIGIT(ICNT)=-1
8703C
8704      ICNT=ICNT+1
8705      ITEXT(ICNT)='Maximum Likelihood (= Moment) Estimates:'
8706      NCTEXT(ICNT)=40
8707      AVALUE(ICNT)=0.0
8708      IDIGIT(ICNT)=-1
8709      ICNT=ICNT+1
8710      ITEXT(ICNT)='Estimate of Theta:'
8711      NCTEXT(ICNT)=18
8712      AVALUE(ICNT)=THETML
8713      IDIGIT(ICNT)=NUMDIG
8714      ICNT=ICNT+1
8715      ITEXT(ICNT)='Asymptotic Standard Error of Theta:'
8716      NCTEXT(ICNT)=35
8717      AVALUE(ICNT)=THETSE
8718      IDIGIT(ICNT)=NUMDIG
8719C
8720      NUMROW=ICNT
8721      DO2310I=1,NUMROW
8722        NTOT(I)=15
8723 2310 CONTINUE
8724C
8725      IFRST=.TRUE.
8726      ILAST=.TRUE.
8727      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
8728     1            AVALUE,IDIGIT,
8729     1            NTOT,NUMROW,
8730     1            ICAPSW,ICAPTY,ILAST,IFRST,
8731     1            ISUBRO,IBUGA3,IERROR)
8732C
8733C     NORMAL APPROXIMATION MAY NOT BE RELIABLE FOR N < 9 OR
8734C     THETA > 0.9.  SO FOR THESE CASES, DO NOT PRINT THE
8735C     CONFIDENCE INTERVALS.
8736C
8737      IF(NTOTZZ.LT.9 .OR. THETML.GT.0.9)GOTO9000
8738C
8739      ITITLE(1:43)='Confidence Interval (normal approximation) '
8740      ITITLE(44:52)='for Theta'
8741      NCTITL=52
8742      ITITL9=' '
8743      NCTIT9=0
8744      NUMLIN=2
8745      NUMCOL=3
8746      ITITL2(1,1)='Confidence'
8747      ITITL2(2,1)='Coefficient'
8748      ITITL2(1,2)='Lower'
8749      ITITL2(2,2)='Limit'
8750      ITITL2(1,3)='Upper'
8751      ITITL2(2,3)='Limit'
8752      NCTIT2(1,1)=10
8753      NCTIT2(2,1)=11
8754      NCTIT2(1,2)=5
8755      NCTIT2(2,2)=5
8756      NCTIT2(1,3)=5
8757      NCTIT2(2,3)=5
8758      NMAX=0
8759      DO2521I=1,NUMCOL
8760        VALIGN(I)='b'
8761        ALIGN(I)='r'
8762        NTOT(I)=15
8763        NMAX=NMAX+NTOT(I)
8764        IDIGIT(I)=NUMDIG
8765 2521 CONTINUE
8766      IDIGIT(1)=3
8767      DO2523I=1,NUMALP
8768        NCTEXT(I)=0
8769        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
8770        AMAT(I,2)=ALOWTH(I)
8771        AMAT(I,3)=AUPPTH(I)
8772 2523 CONTINUE
8773      IWHTML(1)=150
8774      IWHTML(2)=150
8775      IWHTML(3)=150
8776      IWHTML(4)=150
8777      IWRTF(1)=2000
8778      IWRTF(2)=IWRTF(1)+2000
8779      IWRTF(3)=IWRTF(2)+2000
8780      IFRST=.FALSE.
8781      ILAST=.TRUE.
8782C
8783      CALL DPDTA2(ITITL9,NCTIT9,
8784     1            ITITLE,NCTITL,ITITL2,NCTIT2,
8785     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
8786     1            ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
8787     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
8788     1            ICAPSW,ICAPTY,IFRST,ILAST,
8789     1            ISUBRO,IBUGA3,IERROR)
8790C
8791C               *****************
8792C               **  STEP 90--  **
8793C               **  EXIT       **
8794C               *****************
8795C
8796 9000 CONTINUE
8797      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLDL')THEN
8798        WRITE(ICOUT,999)
8799        CALL DPWRST('XXX','WRIT')
8800        WRITE(ICOUT,9011)
8801 9011   FORMAT('***** AT THE END       OF DPMLDL--')
8802        CALL DPWRST('XXX','WRIT')
8803        WRITE(ICOUT,9012)THETA,THETSE
8804 9012   FORMAT('THETA,THETSE = ',2G15.7)
8805        CALL DPWRST('XXX','WRIT')
8806      ENDIF
8807C
8808      RETURN
8809      END
8810      SUBROUTINE DPMLE1(Y,N,ICASPL,
8811     1                  XTEMP,MAXNXT,
8812     1                  XMIN,SCALE,SCALE2,NUMV,
8813     1                  ICAPSW,ICAPTY,IFORSW,
8814     1                  QP,XQPHAT,XQPLCL,XQPUCL,NPERC,
8815     1                  XQPHTZ,XQPLCZ,XQPUCZ,XQPSE,
8816     1                  IOUNI1,IOUNI2,ALPHAP,
8817     1                  ISUBRO,IBUGA3,IERROR)
8818C
8819C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
8820C              ESTIMATES FOR EXPONENTIAL DISTRIBUTION
8821C              FOR THE FULL SAMPLE CASE.
8822C
8823C              NOTE THAT THE USER CAN SPECIFY EITHER THE
8824C              "1-PARAMETER" MODEL (LOCATION = 0) OR THE
8825C              "2-PARAMETER" MODEL.
8826C     EXAMPLE--EXPONENTIAL MAXIMUM LIKELIHOOD Y
8827C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
8828C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
8829C                1999, CHAPTER 12.
8830C     WRITTEN BY--JAMES J. FILLIBEN
8831C                 STATISTICAL ENGINEERING DIVISION
8832C                 INFORMATION TECHNOLOGY LABORATORY
8833C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
8834C                 GAITHERSBURG, MD 20899-8980
8835C                 PHONE--301-975-2855
8836C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
8837C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
8838C     LANGUAGE--ANSI FORTRAN (1977)
8839C     VERSION NUMBER--98/3
8840C     ORIGINAL VERSION--MARCH     1998.
8841C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML/LATEX OUTPUT
8842C     UPDATED         --OCTOBER   2004. SUPPORT FOR BOTH TIME AND
8843C                                       NUMBER OF FAILURES CENSORING,
8844C                                       MULTIPLY CENSORED DATA FOR
8845C                                       TIME CENSORED DATA
8846C     UPDATED         --OCTOBER   2004. CONFIDENCE INTERVALS FOR
8847C                                       SELECT PERCENTILES
8848C     UPDATED         --OCTOBER   2004. SPLIT FULL CASE OUT FROM
8849C                                       CENSORED CASE
8850C     UPDATED         --JUNE      2010. USE DPDTA1, DPDTA7, DPDTA9 TO
8851C                                       PRINT OUTPUT, ADD AIC AND
8852C                                       RELATED STATISTICS TO OUTPUT
8853C     UPDATED         --MAY       2014. SUPPORT FOR ONE-SIDED LIMITS
8854C                                       FOR PERCENTILES
8855C
8856C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
8857C
8858      CHARACTER*4 ICASPL
8859      CHARACTER*4 ICAPSW
8860      CHARACTER*4 ICAPTY
8861      CHARACTER*4 IFORSW
8862C
8863      CHARACTER*4 ISUBRO
8864      CHARACTER*4 IBUGA3
8865      CHARACTER*4 IERROR
8866C
8867      CHARACTER*4 IWRITE
8868      CHARACTER*4 ICASE2
8869      CHARACTER*4 INORM
8870C
8871      CHARACTER*4 ISUBN1
8872      CHARACTER*4 ISUBN2
8873      CHARACTER*4 ISTEPN
8874C
8875C---------------------------------------------------------------------
8876C
8877      PARAMETER (NUMALP=8)
8878      DIMENSION ALPHA(NUMALP)
8879      DIMENSION ALOWLO(NUMALP)
8880      DIMENSION AUPPLO(NUMALP)
8881      DIMENSION ALOWSC(NUMALP)
8882      DIMENSION AUPPSC(NUMALP)
8883C
8884      DIMENSION Y(*)
8885      DIMENSION XTEMP(*)
8886      DIMENSION XQPHTZ(*)
8887      DIMENSION XQPLCZ(*)
8888      DIMENSION XQPUCZ(*)
8889      DIMENSION QP(*)
8890      DIMENSION XQPHAT(*)
8891      DIMENSION XQPLCL(*)
8892      DIMENSION XQPUCL(*)
8893      DIMENSION XQPSE(*)
8894C
8895      INCLUDE 'DPCOST.INC'
8896C
8897      PARAMETER (MAXROW=50)
8898      CHARACTER*60 ITITLE
8899      CHARACTER*60 ITITLZ
8900      CHARACTER*40 ITEXT(MAXROW)
8901      REAL         AVALUE(MAXROW)
8902      INTEGER      NCTEXT(MAXROW)
8903      INTEGER      IDIGIT(MAXROW)
8904      INTEGER      NTOT(MAXROW)
8905      LOGICAL IFRST
8906      LOGICAL ILAST
8907C
8908      CHARACTER*4 ILIKFL
8909C
8910C---------------------------------------------------------------------
8911C
8912      INCLUDE 'DPCOP2.INC'
8913C
8914      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
8915C
8916C-----START POINT-----------------------------------------------------
8917C
8918      ISUBN1='DPML'
8919      ISUBN2='E1  '
8920      IERROR='NO'
8921C
8922      XTEMP(1)=0.0
8923      SCALE2=CPUMIN
8924C
8925      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE1')THEN
8926        WRITE(ICOUT,999)
8927  999   FORMAT(1X)
8928        CALL DPWRST('XXX','WRIT')
8929        WRITE(ICOUT,51)
8930   51   FORMAT('**** AT THE BEGINNING OF DPMLE1--')
8931        CALL DPWRST('XXX','WRIT')
8932        WRITE(ICOUT,52)IBUGA3
8933   52   FORMAT('IBUGA3 = ',A4)
8934        CALL DPWRST('XXX','WRIT')
8935        WRITE(ICOUT,55)N,NUMV,NPERC,MAXNXT
8936   55   FORMAT('N,NUMV,NPERC,MAXNXT = ',4I8)
8937        CALL DPWRST('XXX','WRIT')
8938        DO56I=1,MIN(N,100)
8939          WRITE(ICOUT,57)I,Y(I)
8940   57     FORMAT('I,Y(I)) = ',I8,G15.7)
8941          CALL DPWRST('XXX','WRIT')
8942   56   CONTINUE
8943      ENDIF
8944C
8945C               ********************************************
8946C               **  STEP 11--                             **
8947C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
8948C               ********************************************
8949C
8950      ISTEPN='11'
8951      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE1')
8952     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8953C
8954      NMIN=2
8955      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
8956      IF(IERROR.EQ.'YES')GOTO9000
8957C
8958C               **********************************
8959C               **  STEP 41--                   **
8960C               **  CARRY OUT CALCULATIONS      **
8961C               **  FOR EXPONENTIAL MLE         **
8962C               **  ESTIMATE (FULL SAMPLE CASE) **
8963C               **********************************
8964C
8965      ISTEPN='41'
8966      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE1')
8967     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8968C
8969      IERROR='NO'
8970      IWRITE='OFF'
8971      AN=REAL(N)
8972C
8973      ICASE2='2'
8974      IF(ICASPL.EQ.'1EXP')ICASE2='1'
8975      CALL EXPML1(Y,N,ICASE2,IEXPBC,
8976     1            ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,
8977     1            NUMALP,NUMOUT,
8978     1            XMEAN,XSD,XVAR,XMIN,XMAX,
8979     1            ALOCML,ALOCSE,SCALML,SCALSE,
8980     1            ALOCBC,ALOBSE,SCABML,SCABSE,
8981     1            ISUBRO,IBUGA3,IERROR)
8982      IF(ICASPL.EQ.'1EXP')THEN
8983        ALOC=0.0
8984        SCALE=SCALML
8985        ALOWLO(1)=CPUMIN
8986      ELSE
8987         IF(IEXPBC.EQ.'OFF')THEN
8988           ALOC=ALOCML
8989           SCALE=SCALML
8990         ELSE
8991           ALOC=ALOCBC
8992           SCALE=SCABML
8993           ALOCSE=ALOBSE
8994           SCALSE=SCABSE
8995         ENDIF
8996      ENDIF
8997C
8998      CALL EXPLI1(Y,N,ICASPL,
8999     1            ALOC,SCALE,
9000     1            ALIK,AIC,AICC,BIC,
9001     1            ISUBRO,IBUGA3,IERROR)
9002C
9003      IF(NPERC.GE.1 .AND. ICASPL.EQ.'1EXP')THEN
9004C
9005        NU2=2*N
9006        IF(IDTYPR.EQ.'LOWE')THEN
9007          ALPHL=ALPHAP
9008          ALPHU=1.0 - ALPHAP
9009        ELSEIF(IDTYPR.EQ.'LOWE')THEN
9010          ALPHL=ALPHAP
9011          ALPHU=1.0 - ALPHAP
9012        ELSE
9013          ALPHL=ALPHAP/2.0
9014          ALPHU=1.0 - ALPHAP/2.0
9015        ENDIF
9016        CALL CHSPPF(ALPHL,NU2,ACHSLL)
9017        CALL CHSPPF(ALPHU,NU2,ACHSUL)
9018C
9019        WRITE(IOUNI1,4131)
9020        WRITE(IOUNI1,4132)
9021        DO4119I=1,NPERC
9022          QPTEMP=QP(I)/100.0
9023          CALL EXPPPF(QPTEMP,APPF)
9024          XQPHAT(I)=SCALE*APPF
9025          SEXQP=APPF*SCALSE
9026          ATEMP1=APPF*2.0*AN*SCALE/ACHSUL
9027          ATEMP2=APPF*2.0*AN*SCALE/ACHSLL
9028          IF(IDTYPR.EQ.'UPPE')THEN
9029            XQPLCL(I)=CPUMIN
9030            XQPUCL(I)=MAX(ATEMP1,ATEMP2)
9031          ELSEIF(IDTYPR.EQ.'LOWE')THEN
9032            XQPLCL(I)=MIN(ATEMP1,ATEMP2)
9033            XQPUCL(I)=CPUMIN
9034          ELSE
9035            XQPLCL(I)=MIN(ATEMP1,ATEMP2)
9036            XQPUCL(I)=MAX(ATEMP1,ATEMP2)
9037          ENDIF
9038C
9039          WRITE(IOUNI1,'(3E15.7,2X,E15.7)')
9040     1         QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I)
9041C
9042          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLE1')THEN
9043            WRITE(ICOUT,4133)I,QP(I),XQPHTZ(I),SEXQP,APPF
9044            CALL DPWRST('XXX','BUG ')
9045            WRITE(ICOUT,4135)ACHSUL,ACHSLL,ATEMP1,ATEMP2
9046            CALL DPWRST('XXX','BUG ')
9047            WRITE(ICOUT,4137)XQPLCZ(I),XQPUCZ(I)
9048            CALL DPWRST('XXX','BUG ')
9049          ENDIF
9050C
9051 4119   CONTINUE
9052 4131   FORMAT(15X,'       POINT     ','     LOWER     ')
9053 4132   FORMAT('    PERCENTILE ','     ESTIMATE   ',
9054     1         'CONFIDENCE LIMIT ')
9055 4133       FORMAT('I,QP(I),XQPHAT(I),SEXQP,APPF = ',I8,4G15.7)
9056 4135       FORMAT('ACHSUL,ACHSLL,ATEMP1,ATEMP2 = ',4G15.7)
9057 4137       FORMAT('XQPLCL(I),XQPUCL(I) = ',2G15.7)
9058      ENDIF
9059C
9060C               **********************************************
9061C               **  STEP 41B--                              **
9062C               **  ESTIMATE CONFIDENCE LIMITS FOR SELECTED **
9063C               **  PERCENTILES.  THE CONFIDENCE LIMITS ON  **
9064C               **  SIGMA ARE (SL,SU) ARE:                  **
9065C               **  (2*N*SIGMAHAT/CHSPPF(2N,1-ALPHA/2),     **
9066C               **   2*N*SIGMAHAT/CHSPPF(2N,1-ALPHA/2))     **
9067C               **  THEN (XpLCL,XpUCL) IS:                  **
9068C               **  ((-LN(1 - Xp))*SL,(-LN(1 - Xp))*SU)     **
9069C               **********************************************
9070C
9071      ISTEPN='41B'
9072      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNO')
9073     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9074C
9075C  NOTE: USE APPROXIMATION FOR LOWER LIMIT GIVEN ON PP. 190-191 OF BURY.
9076C
9077      IF(NPERC.GE.1 .AND. ICASPL.EQ.'EXPO')THEN
9078C
9079        DSUM1=0.0D0
9080        DO4140I=1,N
9081          DSUM1=DSUM1 + DBLE(Y(I))
9082 4140   CONTINUE
9083        DS=DSUM1 - DBLE(AN*Y(1))
9084C
9085        D1N=DBLE(1.0/AN)
9086        DN=DBLE(AN)
9087        D2N=DBLE(1.0D0/(AN-1.0))
9088        DALPH=DBLE(ALPHAP)
9089        ALPHL=ALPHAP/2.0
9090        ALPHU=1.0 - ALPHAP/2.0
9091C
9092        WRITE(IOUNI2,4131)
9093        WRITE(IOUNI2,4132)
9094C
9095C       NOT SURE IF FORMULA FOR UPPER CL IS CORRECT, SO ONLY
9096C       GENERATE LOWER LIMIT FOR NOW.
9097C
9098        DO4130I=1,NPERC
9099          QPTEMP=QP(I)/100.0
9100          CALL EXPPPF(QPTEMP,APPF)
9101          XQPHAT(I)=ALOC + SCALE*APPF
9102          DAK=D1N*(1.0D0 - (DBLE(1.0D0 - QPTEMP)**DN/DALPH)**D2N)
9103CCCCC     DAK=D1N*(1.0D0 - (DBLE(1.0D0 - QPTEMP)**DN/DBLE(ALPHL))**D2N)
9104          XQPLCL(I)=Y(1) + REAL(DAK*DS)
9105CCCCC     DAK=D1N*(1.0D0 - (DBLE(1.0D0 - QPTEMP)**DN/DBLE(ALPHU))**D2N)
9106          XQPUCL(I)=CPUMIN
9107CCCCC     XQPUCL(I)=Y(1) + REAL(DAK*DS)
9108          WRITE(IOUNI2,'(4E15.7)')
9109     1         QP(I),XQPHAT(I),XQPLCL(I)
9110CCCCC1         QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I)
9111C
9112          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLE3')THEN
9113            WRITE(ICOUT,44133)I,QP(I),XQPHAT(I),DS,DAK
911444133       FORMAT('I,QP(I),XQPHAT(I),DS,DAK = ',I8,4G15.7)
9115            CALL DPWRST('XXX','BUG ')
9116            WRITE(ICOUT,44137)XQPLCL(I)
911744137       FORMAT('XQPLCL(I) = ',2G15.7)
9118            CALL DPWRST('XXX','BUG ')
9119          ENDIF
9120C
9121 4130   CONTINUE
9122      ENDIF
9123C
9124C               *************************************
9125C               **   STEP 42--                     **
9126C               **   WRITE OUT EVERYTHING          **
9127C               **   FOR EXPONENTIAL MLE ESTIMATE  **
9128C               *************************************
9129C
9130      ISTEPN='42'
9131      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE1')
9132     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9133C
9134      IF(IPRINT.EQ.'OFF')GOTO9000
9135C
9136      NUMDIG=7
9137      IF(IFORSW.EQ.'1')NUMDIG=1
9138      IF(IFORSW.EQ.'2')NUMDIG=2
9139      IF(IFORSW.EQ.'3')NUMDIG=3
9140      IF(IFORSW.EQ.'4')NUMDIG=4
9141      IF(IFORSW.EQ.'5')NUMDIG=5
9142      IF(IFORSW.EQ.'6')NUMDIG=6
9143      IF(IFORSW.EQ.'7')NUMDIG=7
9144      IF(IFORSW.EQ.'8')NUMDIG=8
9145      IF(IFORSW.EQ.'9')NUMDIG=9
9146      IF(IFORSW.EQ.'0')NUMDIG=0
9147      IF(IFORSW.EQ.'E')NUMDIG=-2
9148      IF(IFORSW.EQ.'-2')NUMDIG=-2
9149      IF(IFORSW.EQ.'-3')NUMDIG=-3
9150      IF(IFORSW.EQ.'-4')NUMDIG=-4
9151      IF(IFORSW.EQ.'-5')NUMDIG=-5
9152      IF(IFORSW.EQ.'-6')NUMDIG=-6
9153      IF(IFORSW.EQ.'-7')NUMDIG=-7
9154      IF(IFORSW.EQ.'-8')NUMDIG=-8
9155      IF(IFORSW.EQ.'-9')NUMDIG=-9
9156C
9157      IF(ICASPL.EQ.'1EXP')THEN
9158        ITITLE='1-Parameter Exponential Parameter Estimation'
9159        NCTITL=44
9160        ITITLZ=' '
9161        NCTITZ=0
9162      ELSE
9163        ITITLE='2-Parameter Exponential Parameter Estimation'
9164        NCTITL=44
9165        IF(IEXPBC.EQ.'ON')THEN
9166          ITITLZ='(with Bias Correction)'
9167          NCTITZ=22
9168        ELSE
9169          ITITLZ='(without Bias Correction)'
9170          NCTITZ=25
9171        ENDIF
9172      ENDIF
9173      ICNT=1
9174      ITEXT(ICNT)='Summary Statistics:'
9175      NCTEXT(ICNT)=19
9176      AVALUE(ICNT)=0.0
9177      IDIGIT(ICNT)=-1
9178      ICNT=ICNT+1
9179      ITEXT(ICNT)='Number of Observations:'
9180      NCTEXT(ICNT)=23
9181      AVALUE(ICNT)=REAL(N)
9182      IDIGIT(ICNT)=0
9183      ICNT=ICNT+1
9184      ITEXT(ICNT)='Sample Mean:'
9185      NCTEXT(ICNT)=12
9186      AVALUE(ICNT)=XMEAN
9187      IDIGIT(ICNT)=NUMDIG
9188      ICNT=ICNT+1
9189      ITEXT(ICNT)='Sample Standard Deviation:'
9190      NCTEXT(ICNT)=26
9191      AVALUE(ICNT)=XSD
9192      IDIGIT(ICNT)=NUMDIG
9193      ICNT=ICNT+1
9194      ITEXT(ICNT)='Sample Minimum:'
9195      NCTEXT(ICNT)=15
9196      AVALUE(ICNT)=XMIN
9197      IDIGIT(ICNT)=NUMDIG
9198      ICNT=ICNT+1
9199      ITEXT(ICNT)='Sample Maximum:'
9200      NCTEXT(ICNT)=15
9201      AVALUE(ICNT)=XMAX
9202      IDIGIT(ICNT)=NUMDIG
9203      ICNT=ICNT+1
9204      ITEXT(ICNT)=' '
9205      NCTEXT(ICNT)=0
9206      AVALUE(ICNT)=0.0
9207      IDIGIT(ICNT)=-1
9208C
9209      ICNT=ICNT+1
9210      ITEXT(ICNT)='Maximum Likelihood:'
9211      NCTEXT(ICNT)=19
9212      AVALUE(ICNT)=0.0
9213      IDIGIT(ICNT)=-1
9214      IF(ICASPL.EQ.'EXPO')THEN
9215        ICNT=ICNT+1
9216        ITEXT(ICNT)='Estimate of Location:'
9217        NCTEXT(ICNT)=21
9218        AVALUE(ICNT)=ALOC
9219        IDIGIT(ICNT)=NUMDIG
9220        ICNT=ICNT+1
9221        ITEXT(ICNT)='Standard Error of Location:'
9222        NCTEXT(ICNT)=27
9223        AVALUE(ICNT)=ALOCSE
9224        IDIGIT(ICNT)=NUMDIG
9225      ENDIF
9226      ICNT=ICNT+1
9227      ITEXT(ICNT)='Estimate of Scale:'
9228      NCTEXT(ICNT)=18
9229      AVALUE(ICNT)=SCALE
9230      IDIGIT(ICNT)=NUMDIG
9231      ICNT=ICNT+1
9232      ITEXT(ICNT)='Standard Error of Scale:'
9233      NCTEXT(ICNT)=24
9234      AVALUE(ICNT)=SCALSE
9235      IDIGIT(ICNT)=NUMDIG
9236      ICNT=ICNT+1
9237      ITEXT(ICNT)='Log-likelihood:'
9238      NCTEXT(ICNT)=15
9239      AVALUE(ICNT)=ALIK
9240      IDIGIT(ICNT)=-7
9241      ICNT=ICNT+1
9242      ITEXT(ICNT)='AIC:'
9243      NCTEXT(ICNT)=4
9244      AVALUE(ICNT)=AIC
9245      IDIGIT(ICNT)=-7
9246      ICNT=ICNT+1
9247      ITEXT(ICNT)='AICc:'
9248      NCTEXT(ICNT)=5
9249      AVALUE(ICNT)=AICC
9250      IDIGIT(ICNT)=-7
9251      ICNT=ICNT+1
9252      ITEXT(ICNT)='BIC:'
9253      NCTEXT(ICNT)=4
9254      AVALUE(ICNT)=BIC
9255      IDIGIT(ICNT)=-7
9256C
9257      NUMROW=ICNT
9258      DO2320I=1,NUMROW
9259        NTOT(I)=15
9260 2320 CONTINUE
9261C
9262      IFRST=.FALSE.
9263      ILAST=.FALSE.
9264      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
9265     1            AVALUE,IDIGIT,
9266     1            NTOT,NUMROW,
9267     1            ICAPSW,ICAPTY,ILAST,IFRST,
9268     1            ISUBRO,IBUGA3,IERROR)
9269C
9270      IF(NUMOUT.GT.1)THEN
9271        INORM='OFF'
9272        CALL DPDTA7(ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,NUMALP,
9273     1              ICAPSW,ICAPTY,NUMDIG,INORM,
9274     1              ISUBRO,IBUGA3,IERROR)
9275      ENDIF
9276C
9277      IF(NPERC.GT.1)THEN
9278        ILIKFL='EXAC'
9279        XQPSE(1)=CPUMIN
9280        IF(ICASPL.EQ.'EXPO')THEN
9281          CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
9282     l                ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
9283     1                ISUBRO,IBUGA3,IERROR)
9284        ELSE
9285          CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
9286     1                ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
9287     1                ISUBRO,IBUGA3,IERROR)
9288        ENDIF
9289      ENDIF
9290C
9291C               *****************
9292C               **  STEP 90--  **
9293C               **  EXIT       **
9294C               *****************
9295C
9296 9000 CONTINUE
9297      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE1')THEN
9298        WRITE(ICOUT,999)
9299        CALL DPWRST('XXX','WRIT')
9300        WRITE(ICOUT,9011)
9301 9011   FORMAT('***** AT THE END       OF DPMLE1--')
9302        CALL DPWRST('XXX','WRIT')
9303        WRITE(ICOUT,9012)N,IBUGA3,IERROR
9304 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
9305        CALL DPWRST('XXX','WRIT')
9306        WRITE(ICOUT,9015)N
9307 9015   FORMAT('N = ',I8)
9308        CALL DPWRST('XXX','WRIT')
9309      ENDIF
9310C
9311      RETURN
9312      END
9313      SUBROUTINE DPMLE2(Y,TAG,N,ICASPL,
9314     1                  XTEMP,MAXNXT,
9315     1                  XMIN,SCALML,SCALSE,NUMV,TEND,
9316     1                  ICAPSW,ICAPTY,IFORSW,
9317     1                  QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,NPERC,
9318     1                  XQPHTZ,XQPLCZ,XQPUCZ,
9319     1                  IOUNI1,IOUNI2,ALPHAP,
9320     1                  ISUBRO,IBUGA3,IERROR)
9321C
9322C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
9323C              ESTIMATES FOR EXPONENTIAL DISTRIBUTION
9324C              FOR THE TIME CENSORED (TYPE I, EITHER SINGLY OR
9325C              MULTIPLY CENSORED) CASE.
9326C     EXAMPLE--EXPONENTIAL MAXIMUM LIKELIHOOD Y X
9327C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
9328C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
9329C                1999, CHAPTER 12.
9330C     WRITTEN BY--JAMES J. FILLIBEN
9331C                 STATISTICAL ENGINEERING DIVISION
9332C                 INFORMATION TECHNOLOGY LABORATORY
9333C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
9334C                 GAITHERSBURG, MD 20899-8980
9335C                 PHONE--301-975-2855
9336C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
9337C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
9338C     LANGUAGE--ANSI FORTRAN (1977)
9339C     VERSION NUMBER--98/3
9340C     ORIGINAL VERSION--MARCH     1998.
9341C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML/LATEX OUTPUT
9342C     UPDATED         --OCTOBER   2004. SUPPORT FOR BOTH TIME AND
9343C                                       NUMBER OF FAILURES CENSORING,
9344C                                       MULTIPLY CENSORED DATA FOR
9345C                                       TIME CENSORED DATA
9346C     UPDATED         --OCTOBER   2004. CONFIDENCE INTERVALS FOR
9347C                                       SELECT PERCENTILES
9348C     UPDATED         --OCTOBER   2004. SPLIT FULL SAMPLE AND CENSORED
9349C                                       CASES INTO DISTINCT
9350C                                       SUBROUTINES
9351C     UPDATED         --JUNE      2010. USE DPDTA1, DPDTA7, DPDTA9 TO
9352C                                       PRINT OUTPUT, ADD AIC AND
9353C                                       RELATED STATISTICS TO OUTPUT
9354C
9355C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
9356C
9357      CHARACTER*4 ICASPL
9358      CHARACTER*4 IFORSW
9359      CHARACTER*4 ICAPSW
9360      CHARACTER*4 ICAPTY
9361C
9362      CHARACTER*4 ISUBRO
9363      CHARACTER*4 IBUGA3
9364      CHARACTER*4 IERROR
9365C
9366      CHARACTER*4 IWRITE
9367      CHARACTER*4 ILIKFL
9368      CHARACTER*4 INORM
9369C
9370      CHARACTER*4 ISUBN1
9371      CHARACTER*4 ISUBN2
9372      CHARACTER*4 ISTEPN
9373C
9374      CHARACTER*4 ICASE
9375C
9376C---------------------------------------------------------------------
9377C
9378      PARAMETER (NUMALP=8)
9379      DIMENSION ALPHA(NUMALP)
9380      DIMENSION ALOWLO(NUMALP)
9381      DIMENSION AUPPLO(NUMALP)
9382      DIMENSION ALOWSC(NUMALP)
9383      DIMENSION AUPPSC(NUMALP)
9384      DIMENSION ALOWS2(NUMALP)
9385      DIMENSION AUPPS2(NUMALP)
9386C
9387      DIMENSION Y(*)
9388      DIMENSION TAG(*)
9389      DIMENSION XTEMP(*)
9390      DIMENSION XQPHTZ(*)
9391      DIMENSION XQPLCZ(*)
9392      DIMENSION XQPUCZ(*)
9393      DIMENSION QP(*)
9394      DIMENSION XQPHAT(*)
9395      DIMENSION XQPSE(*)
9396      DIMENSION XQPLCL(*)
9397      DIMENSION XQPUCL(*)
9398C
9399      DOUBLE PRECISION DN
9400      DOUBLE PRECISION D1N
9401      DOUBLE PRECISION D2R
9402      DOUBLE PRECISION DS
9403      DOUBLE PRECISION DAK
9404      DOUBLE PRECISION DSUM1
9405      DOUBLE PRECISION DALPH
9406      DOUBLE PRECISION XLOW
9407      DOUBLE PRECISION XUP
9408C
9409      DOUBLE PRECISION AE
9410      DOUBLE PRECISION RE
9411C
9412      DOUBLE PRECISION DK
9413      DOUBLE PRECISION DR
9414      DOUBLE PRECISION SHAT
9415      DOUBLE PRECISION DXSUM
9416      DOUBLE PRECISION DC
9417      COMMON/EXPCOM/DK,DR,SHAT,DXSUM,DC
9418      DOUBLE PRECISION EXPFUN
9419      EXTERNAL EXPFUN
9420C
9421C---------------------------------------------------------------------
9422C
9423      PARAMETER (MAXROW=50)
9424      CHARACTER*60 ITITLE
9425      CHARACTER*60 ITITLZ
9426      CHARACTER*40 ITEXT(MAXROW)
9427      REAL         AVALUE(MAXROW)
9428      INTEGER      NCTEXT(MAXROW)
9429      INTEGER      IDIGIT(MAXROW)
9430      INTEGER      NTOT(MAXROW)
9431      LOGICAL IFRST
9432      LOGICAL ILAST
9433C
9434      INCLUDE 'DPCOST.INC'
9435      INCLUDE 'DPCOP2.INC'
9436C
9437      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
9438C
9439C-----START POINT-----------------------------------------------------
9440C
9441      ISUBN1='DPML'
9442      ISUBN2='E1  '
9443      IERROR='NO'
9444C
9445      DO11I=1,NUMALP
9446        XQPHTZ(I)=CPUMIN
9447        XQPLCZ(I)=CPUMIN
9448        XQPUCZ(I)=CPUMIN
9449   11 CONTINUE
9450C
9451      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE2')THEN
9452        WRITE(ICOUT,999)
9453  999   FORMAT(1X)
9454        CALL DPWRST('XXX','WRIT')
9455        WRITE(ICOUT,51)
9456   51   FORMAT('**** AT THE BEGINNING OF DPMLE2--')
9457        CALL DPWRST('XXX','WRIT')
9458        WRITE(ICOUT,55)N,NUMV,IBUGA3,ICENTY
9459   55   FORMAT('N,NUMV,NPERC,IBUGA3,ICENTY = ',3I8,2X,A4,2X,A4)
9460        CALL DPWRST('XXX','WRIT')
9461        DO56I=1,MIN(N,100)
9462          WRITE(ICOUT,57)I,Y(I),TAG(I)
9463   57     FORMAT('I,Y(I),TAG(I) = ',I8,2E15.7)
9464          CALL DPWRST('XXX','WRIT')
9465   56   CONTINUE
9466      ENDIF
9467C
9468C               ********************************************
9469C               **  STEP 11--                             **
9470C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
9471C               ********************************************
9472C
9473      ISTEPN='11'
9474      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE2')
9475     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9476C
9477      NMIN=3
9478      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
9479      IF(IERROR.EQ.'YES')GOTO9000
9480C
9481C               ********************************************
9482C               **  STEP 21--                             **
9483C               **  CHECK THE CENSORING VARIABLE: SHOULD  **
9484C               **  BE AT MOST 2 DISTINCT VALUES, 1       **
9485C               **  INDICATES FAILURE TIME, 0 INDICATES   **
9486C               **  CENSORING TIME.                       **
9487C               ********************************************
9488C
9489      ISTEPN='21'
9490      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE2')
9491     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9492C
9493      CALL EXPML2(Y,TAG,N,ICASPL,ICASE,TEND,XTEMP,MAXNXT,
9494     1            XMEAN,XSD,XVAR,XMIN,XMAX,XSUM,
9495     1            ALOCML,ALOCSE,SCALML,SCALSE,
9496     1            IR,IM,AN,AR,AM,
9497     1            ISUBRO,IBUGA3,IERROR)
9498      IF(IERROR.EQ.'YES')GOTO9000
9499C
9500C               *************************************
9501C               **  STEP 41--                      **
9502C               **  GENERATE CONFIDENCE INTERVALS  **
9503C               **  FOR PARAMETERS AND PERCENTILES **
9504C               *************************************
9505C
9506      ISTEPN='41'
9507      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE2')
9508     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9509C
9510      IERROR='NO'
9511      IWRITE='OFF'
9512C
9513C  ESTIMATES FOR 1-PARAMETER MODEL
9514C
9515      IF(ICASPL.EQ.'1EXP')THEN
9516        SHAT=DBLE(SCALML)
9517        DXSUM=DBLE(XSUM)
9518        DR=DBLE(IR)
9519        NUTEMP=1
9520        AE=1.D-7
9521        RE=1.D-7
9522        DC=2.0D0*(-DR*DLOG(SHAT) - DXSUM/SHAT)
9523C
9524        DO4110I=1,NUMALP
9525          ALP=ALPHA(I)
9526          P=1.0-(ALP/2.0)
9527          CALL NORPPF(P,ZP)
9528          CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
9529          DK=DBLE(APPF)
9530C
9531C         NOW COMPUTE NORMAL APPROXIMATION INTERVAL (USE AS
9532C         STARTING VALUE FOR LIKELIHOOD RATIO METHOD).
9533C
9534          SLNOR=SCALML - ZP*SCALSE
9535          SUNOR=SCALML + ZP*SCALSE
9536C
9537C         NOW COMPUTE LIKELIHOOD RATIO BASED INTERVAL
9538C
9539CCCCC     XLOW=DBLE(XMIN)
9540          XLOW=DBLE(SLNOR)/3.0D0
9541          XUP=DBLE(SCALML)
9542          CALL DFZERO(EXPFUN,XLOW,XUP,DBLE(SLNOR),RE,AE,IFLAG)
9543          ALOWSC(I)=XLOW
9544          ALOWS2(I)=SLNOR
9545C
9546          XLOW=DBLE(SCALML)
9547          XUP=2.0D0*DBLE(SUNOR)
9548          CALL DFZERO(EXPFUN,XLOW,XUP,DBLE(SUNOR),RE,AE,IFLAG)
9549          AUPPSC(I)=XLOW
9550          AUPPS2(I)=SUNOR
9551 4110   CONTINUE
9552C
9553C               **********************************************
9554C               **  STEP 41A--                              **
9555C               **  ESTIMATE CONFIDENCE LIMITS FOR SELECTED **
9556C               **  PERCENTILES.  COMPUTE THE LOWER         **
9557C               **  CONFIDENCE INTERVAL GIVEN ON PP. 190-191**
9558C               **  OF BURY.  NOTE THAT THIS APPROXIMATION  **
9559C               **  IS FOR THE SINGLY CENSORED CASE ONLY.   **
9560C               **  NO FORMULA IS GIVEN FOR THE MULTIPLY    **
9561C               **  CENSORED CASE.  USE THE 2-PARAMETER     **
9562C               **  CASE WITH X(1) = 0.                     **
9563C               **********************************************
9564C
9565        ISTEPN='41A'
9566        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNO')
9567     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9568C
9569        IF(NPERC.GE.1)THEN
9570C
9571          DSUM1=0.0D0
9572          DO4112I=1,N
9573            DSUM1=DSUM1 + DBLE(Y(I))
9574 4112     CONTINUE
9575          DS=DSUM1 + DBLE(AN*XMIN)
9576C
9577          D1N=DBLE(1.0/AN)
9578          DN=DBLE(AN)
9579          DR=DBLE(AR)
9580          D2R=DBLE(1.0D0/(AR+0.5-1.0))
9581          DALPH=DBLE(ALPHAP)
9582          ALPHL=ALPHAP/2.0
9583          ALPHU=1.0 - ALPHAP/2.0
9584C
9585          WRITE(IOUNI1,4131)
9586          WRITE(IOUNI1,4132)
9587          DO4115I=1,NPERC
9588            QPTEMP=QP(I)/100.0
9589            CALL EXPPPF(QPTEMP,APPF)
9590            XQPHAT(I)=SCALML*APPF
9591            DAK=D1N*(1.0D0 - (DBLE(1.0D0 - QPTEMP)**DN/DALPH)**D2R)
9592            XQPLCL(I)=REAL(DAK*DS)
9593            WRITE(IOUNI1,'(3E15.7)')
9594     1           QP(I),XQPHAT(I),XQPLCL(I)
9595C
9596            IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLE2')THEN
9597              WRITE(ICOUT,4133)I,QP(I),XQPHAT(I),DS,DAK
9598              CALL DPWRST('XXX','BUG ')
9599              WRITE(ICOUT,4137)XQPLCL(I)
9600              CALL DPWRST('XXX','BUG ')
9601            ENDIF
9602C
9603 4115     CONTINUE
9604        ENDIF
9605      ELSE
9606C
9607C       2-PARAMETER MODEL
9608C
9609        UHAT=XMIN
9610        UHATSE=CPUMIN
9611C
9612        NU2=2*IR-1
9613        DO4125I=1,NUMALP
9614          ALP=ALPHA(I)
9615          P=1.0-(ALP/2.0)
9616          CALL CHSPPF(P,NU2,PPF3)
9617          P=ALP/2.0
9618          CALL CHSPPF(P,NU2,PPF4)
9619          ALOWSC(I)=2.0*AR*SCALML/PPF3
9620          AUPPSC(I)=2.0*AR*SCALML/PPF4
9621          ACONS1=(ALP/2.0)**(2.0/(1.0-2.0*AR)) - 1.0
9622          ACONS2=(1.0 - ALP/2.0)**(2.0/(1.0-2.0*AR)) - 1.0
9623          ATEMP1=XMIN - SCALML*(AR/AN)*ACONS1
9624          ATEMP2=XMIN - SCALML*(AR/AN)*ACONS2
9625          ALOWLO(I)=MIN(ATEMP1,ATEMP2)
9626          AUPPLO(I)=MAX(ATEMP1,ATEMP2)
9627 4125   CONTINUE
9628C
9629C               **********************************************
9630C               **  STEP 41B--                              **
9631C               **  ESTIMATE CONFIDENCE LIMITS FOR SELECTED **
9632C               **  PERCENTILES.  COMPUTE THE LOWER         **
9633C               **  CONFIDENCE INTERVAL GIVEN ON PP. 190-191**
9634C               **  OF BURY.  NOTE THAT THIS APPROXIMATION  **
9635C               **  IS FOR THE SINGLY CENSORED CASE ONLY.   **
9636C               **  NO FORMULA IS GIVEN FOR THE MULTIPLY    **
9637C               **  CENSORED CASE.                          **
9638C               **********************************************
9639C
9640        ISTEPN='41B'
9641        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNO')
9642     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9643C
9644        IF(NPERC.GE.1)THEN
9645C
9646          DSUM1=0.0D0
9647          DO4140I=1,N
9648            DSUM1=DSUM1 + DBLE(Y(I))
9649 4140     CONTINUE
9650          DS=DSUM1 - DBLE(AN*XMIN)
9651C
9652          D1N=DBLE(1.0/AN)
9653          DN=DBLE(AN)
9654          DR=DBLE(AR)
9655          D2R=DBLE(1.0D0/(AR+0.5-1.0))
9656          DALPH=DBLE(ALPHAP)
9657          ALPHL=ALPHAP/2.0
9658          ALPHU=1.0 - ALPHAP/2.0
9659C
9660          WRITE(IOUNI2,4131)
9661 4131     FORMAT(15X,'       POINT     ','     LOWER     ')
9662          WRITE(IOUNI2,4132)
9663 4132     FORMAT('    PERCENTILE ','     ESTIMATE   ',
9664     1           'CONFIDENCE LIMIT ')
9665          DO4130I=1,NPERC
9666            QPTEMP=QP(I)/100.0
9667            CALL EXPPPF(QPTEMP,APPF)
9668            XQPHAT(I)=UHAT + SCALML*APPF
9669            DAK=D1N*(1.0D0 - (DBLE(1.0D0 - QPTEMP)**DN/DALPH)**D2R)
9670            XQPLCL(I)=UHAT + REAL(DAK*DS)
9671CCCCC       XQPUCL(I)=UHAT + MAX(ATEMP1,ATEMP2)
9672            WRITE(IOUNI2,'(3E15.7)')QP(I),XQPHAT(I),XQPLCL(I)
9673C
9674            IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLE2')THEN
9675              WRITE(ICOUT,4133)I,QP(I),XQPHAT(I),DS,DAK
9676 4133         FORMAT('I,QP(I),XQPHAT(I),DS,DAK = ',I8,4G15.7)
9677              CALL DPWRST('XXX','BUG ')
9678              WRITE(ICOUT,4137)XQPLCL(I)
9679 4137         FORMAT('XQPLCL(I) = ',2G15.7)
9680              CALL DPWRST('XXX','BUG ')
9681            ENDIF
9682C
9683 4130     CONTINUE
9684        ENDIF
9685      ENDIF
9686C
9687C               *************************************
9688C               **   STEP 42--                     **
9689C               **   WRITE OUT EVERYTHING          **
9690C               **   FOR EXPONENTIAL MLE ESTIMATE  **
9691C               *************************************
9692C
9693      ISTEPN='42'
9694      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE2')
9695     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9696C
9697      IF(IPRINT.EQ.'OFF')GOTO9000
9698C
9699      NUMDIG=7
9700      IF(IFORSW.EQ.'1')NUMDIG=1
9701      IF(IFORSW.EQ.'2')NUMDIG=2
9702      IF(IFORSW.EQ.'3')NUMDIG=3
9703      IF(IFORSW.EQ.'4')NUMDIG=4
9704      IF(IFORSW.EQ.'5')NUMDIG=5
9705      IF(IFORSW.EQ.'6')NUMDIG=6
9706      IF(IFORSW.EQ.'7')NUMDIG=7
9707      IF(IFORSW.EQ.'8')NUMDIG=8
9708      IF(IFORSW.EQ.'9')NUMDIG=9
9709      IF(IFORSW.EQ.'0')NUMDIG=0
9710      IF(IFORSW.EQ.'E')NUMDIG=-2
9711      IF(IFORSW.EQ.'-2')NUMDIG=-2
9712      IF(IFORSW.EQ.'-3')NUMDIG=-3
9713      IF(IFORSW.EQ.'-4')NUMDIG=-4
9714      IF(IFORSW.EQ.'-5')NUMDIG=-5
9715      IF(IFORSW.EQ.'-6')NUMDIG=-6
9716      IF(IFORSW.EQ.'-7')NUMDIG=-7
9717      IF(IFORSW.EQ.'-8')NUMDIG=-8
9718      IF(IFORSW.EQ.'-9')NUMDIG=-9
9719C
9720      IF(ICASPL.EQ.'1EXP')THEN
9721        ITITLE='1-Parameter Exponential Parameter Estimation'
9722        NCTITL=44
9723      ELSE
9724        ITITLE='2-Parameter Exponential Parameter Estimation'
9725        NCTITL=44
9726      ENDIF
9727      IF(ICASE.EQ.'SING')THEN
9728        ITITLZ='Time (Singly) Censored Case'
9729        NCTITZ=27
9730      ELSE
9731        ITITLZ='Time (Multiply) Censored Case'
9732        NCTITZ=29
9733      ENDIF
9734C
9735      ICNT=1
9736      ITEXT(ICNT)='Summary Statistics:'
9737      NCTEXT(ICNT)=19
9738      AVALUE(ICNT)=0.0
9739      IDIGIT(ICNT)=-1
9740      ICNT=ICNT+1
9741      ITEXT(ICNT)='Number of Observations:'
9742      NCTEXT(ICNT)=23
9743      AVALUE(ICNT)=REAL(N)
9744      IDIGIT(ICNT)=0
9745      ICNT=ICNT+1
9746      ITEXT(ICNT)='Number of Failure Times:'
9747      NCTEXT(ICNT)=24
9748      AVALUE(ICNT)=AR
9749      IDIGIT(ICNT)=0
9750      ICNT=ICNT+1
9751      ITEXT(ICNT)='Number of Censoring Times:'
9752      NCTEXT(ICNT)=26
9753      AVALUE(ICNT)=AM
9754      IDIGIT(ICNT)=0
9755      ICNT=ICNT+1
9756      ITEXT(ICNT)='Sample Mean:'
9757      NCTEXT(ICNT)=12
9758      AVALUE(ICNT)=XMEAN
9759      IDIGIT(ICNT)=NUMDIG
9760      ICNT=ICNT+1
9761      ITEXT(ICNT)='Sample Standard Deviation:'
9762      NCTEXT(ICNT)=26
9763      AVALUE(ICNT)=XSD
9764      IDIGIT(ICNT)=NUMDIG
9765      ICNT=ICNT+1
9766      ITEXT(ICNT)='Sample Minimum:'
9767      NCTEXT(ICNT)=15
9768      AVALUE(ICNT)=XMIN
9769      IDIGIT(ICNT)=NUMDIG
9770      ICNT=ICNT+1
9771      ITEXT(ICNT)='Sample Maximum:'
9772      NCTEXT(ICNT)=15
9773      AVALUE(ICNT)=XMAX
9774      IDIGIT(ICNT)=NUMDIG
9775      ICNT=ICNT+1
9776      ITEXT(ICNT)=' '
9777      NCTEXT(ICNT)=0
9778      AVALUE(ICNT)=0.0
9779      IDIGIT(ICNT)=-1
9780C
9781      ICNT=ICNT+1
9782      ITEXT(ICNT)='Maximum Likelihood:'
9783      NCTEXT(ICNT)=19
9784      AVALUE(ICNT)=0.0
9785      IDIGIT(ICNT)=-1
9786      IF(ICASPL.EQ.'EXPO')THEN
9787        ICNT=ICNT+1
9788        ITEXT(ICNT)='Estimate of Location:'
9789        NCTEXT(ICNT)=21
9790        AVALUE(ICNT)=ALOCML
9791        IDIGIT(ICNT)=NUMDIG
9792CCCCC   ICNT=ICNT+1
9793CCCCC   ITEXT(ICNT)='Standard Error of Location:'
9794CCCCC   NCTEXT(ICNT)=27
9795CCCCC   AVALUE(ICNT)=ALOCSE
9796CCCCC   IDIGIT(ICNT)=NUMDIG
9797      ENDIF
9798      ICNT=ICNT+1
9799      ITEXT(ICNT)='Estimate of Scale:'
9800      NCTEXT(ICNT)=18
9801      AVALUE(ICNT)=SCALML
9802      IDIGIT(ICNT)=NUMDIG
9803      ICNT=ICNT+1
9804      ITEXT(ICNT)='Standard Error of Scale:'
9805      NCTEXT(ICNT)=24
9806      AVALUE(ICNT)=SCALSE
9807      IDIGIT(ICNT)=NUMDIG
9808CCCCC ICNT=ICNT+1
9809CCCCC ITEXT(ICNT)='Covariance:'
9810CCCCC NCTEXT(ICNT)=11
9811CCCCC AVALUE(ICNT)=COVSE
9812CCCCC IDIGIT(ICNT)=NUMDIG
9813CCCCC ICNT=ICNT+1
9814CCCCC ITEXT(ICNT)='Log-likelihood:'
9815CCCCC NCTEXT(ICNT)=15
9816CCCCC AVALUE(ICNT)=ALIK
9817CCCCC IDIGIT(ICNT)=-7
9818CCCCC ICNT=ICNT+1
9819CCCCC ITEXT(ICNT)='AIC:'
9820CCCCC NCTEXT(ICNT)=4
9821CCCCC AVALUE(ICNT)=AIC
9822CCCCC IDIGIT(ICNT)=-7
9823CCCCC ICNT=ICNT+1
9824CCCCC ITEXT(ICNT)='AICc:'
9825CCCCC NCTEXT(ICNT)=5
9826CCCCC AVALUE(ICNT)=AICC
9827CCCCC IDIGIT(ICNT)=-7
9828CCCCC ICNT=ICNT+1
9829CCCCC ITEXT(ICNT)='BIC:'
9830CCCCC NCTEXT(ICNT)=4
9831CCCCC AVALUE(ICNT)=BIC
9832CCCCC IDIGIT(ICNT)=-7
9833C
9834      NUMROW=ICNT
9835      DO2320I=1,NUMROW
9836        NTOT(I)=15
9837 2320 CONTINUE
9838C
9839      IFRST=.FALSE.
9840      ILAST=.FALSE.
9841      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
9842     1            AVALUE,IDIGIT,
9843     1            NTOT,NUMROW,
9844     1            ICAPSW,ICAPTY,ILAST,IFRST,
9845     1            ISUBRO,IBUGA3,IERROR)
9846C
9847      IF(ICASPL.EQ.'1EXP')THEN
9848        ALOWLO(1)=CPUMIN
9849        ILIKFL='ON'
9850        CALL DPDT77(ALOWLO,AUPPLO,ALOWS2,AUPPS2,
9851     1              ALOWLO,AUPPLO,ALOWSC,AUPPSC,
9852     1              ALPHA,NUMALP,
9853     1              ICAPSW,ICAPTY,NUMDIG,
9854     1              ISUBRO,IBUGA3,IERROR)
9855      ELSE
9856        INORM='NO'
9857        CALL DPDTA7(ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,NUMALP,
9858     1              ICAPSW,ICAPTY,NUMDIG,INORM,
9859     1              ISUBRO,IBUGA3,IERROR)
9860      ENDIF
9861C
9862      IF(NPERC.GE.1)THEN
9863        ILIKFL='EXAC'
9864        XQPSE(1)=CPUMIN
9865        XQPUCL(1)=CPUMIN
9866        CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
9867     1              ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
9868     1              ISUBRO,IBUGA3,IERROR)
9869      ENDIF
9870C
9871C               *****************
9872C               **  STEP 90--  **
9873C               **  EXIT       **
9874C               *****************
9875C
9876 9000 CONTINUE
9877      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE2')THEN
9878        WRITE(ICOUT,999)
9879        CALL DPWRST('XXX','WRIT')
9880        WRITE(ICOUT,9011)
9881 9011   FORMAT('***** AT THE END       OF DPMLE2--')
9882        CALL DPWRST('XXX','WRIT')
9883        WRITE(ICOUT,9012)N,IBUGA3,IERROR
9884 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
9885        CALL DPWRST('XXX','WRIT')
9886      ENDIF
9887C
9888      RETURN
9889      END
9890      SUBROUTINE DPMLE3(Y,TAG,N,ICASPL,
9891     1                  XTEMP,MAXNXT,
9892     1                  XMIN,SCALML,SCALSE,NUMV,TEND,
9893     1                  ICAPSW,ICAPTY,IFORSW,
9894     1                  QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,NPERC,
9895     1                  XQPHTZ,XQPLCZ,XQPUCZ,
9896     1                  IOUNI1,IOUNI2,ALPHAP,
9897     1                  ISUBRO,IBUGA3,IERROR)
9898C
9899C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
9900C              ESTIMATES FOR EXPONENTIAL DISTRIBUTION
9901C              FOR THE FAILURE CENSORED (TYPE II, EITHER SINGLY OR
9902C              MULTIPLY CENSORED) CASE.
9903C     EXAMPLE--EXPONENTIAL MAXIMUM LIKELIHOOD Y X
9904C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
9905C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
9906C                1999, CHAPTER 12.
9907C     WRITTEN BY--JAMES J. FILLIBEN
9908C                 STATISTICAL ENGINEERING DIVISION
9909C                 INFORMATION TECHNOLOGY LABORATORY
9910C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
9911C                 GAITHERSBURG, MD 20899-8980
9912C                 PHONE--301-975-2855
9913C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
9914C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
9915C     LANGUAGE--ANSI FORTRAN (1977)
9916C     VERSION NUMBER--98/3
9917C     ORIGINAL VERSION--MARCH     1998.
9918C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML/LATEX OUTPUT
9919C     UPDATED         --OCTOBER   2004. SUPPORT FOR BOTH TIME AND
9920C                                       NUMBER OF FAILURES CENSORING,
9921C                                       MULTIPLY CENSORED DATA FOR
9922C                                       TIME CENSORED DATA
9923C     UPDATED         --OCTOBER   2004. CONFIDENCE INTERVALS FOR
9924C                                       SELECT PERCENTILES
9925C     UPDATED         --OCTOBER   2004. SPLIT FULL SAMPLE AND CENSORED
9926C                                       CASES INTO DISTINCT
9927C                                       SUBROUTINES
9928C     UPDATED         --JUNE      2010. USE DPDTA1, DPDTA7, DPDTA9 TO
9929C                                       PRINT OUTPUT, ADD AIC AND
9930C                                       RELATED STATISTICS TO OUTPUT
9931C
9932C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
9933C
9934      CHARACTER*4 ICAPSW
9935      CHARACTER*4 ICAPTY
9936      CHARACTER*4 ICASPL
9937      CHARACTER*4 IFORSW
9938C
9939      CHARACTER*4 ISUBRO
9940      CHARACTER*4 IBUGA3
9941      CHARACTER*4 IERROR
9942C
9943      CHARACTER*4 IWRITE
9944      CHARACTER*4 ILIKFL
9945      CHARACTER*4 INORM
9946C
9947      CHARACTER*4 ISUBN1
9948      CHARACTER*4 ISUBN2
9949      CHARACTER*4 ISTEPN
9950C
9951      CHARACTER*4 ICASE
9952C
9953C---------------------------------------------------------------------
9954C
9955      PARAMETER (NUMALP=8)
9956      DIMENSION ALPHA(NUMALP)
9957      DIMENSION ALOWLO(NUMALP)
9958      DIMENSION AUPPLO(NUMALP)
9959      DIMENSION ALOWSC(NUMALP)
9960      DIMENSION AUPPSC(NUMALP)
9961      DIMENSION ALOWS2(NUMALP)
9962      DIMENSION AUPPS2(NUMALP)
9963C
9964      DIMENSION Y(*)
9965      DIMENSION TAG(*)
9966      DIMENSION XTEMP(*)
9967      DIMENSION XQPHTZ(*)
9968      DIMENSION XQPLCZ(*)
9969      DIMENSION XQPUCZ(*)
9970      DIMENSION QP(*)
9971      DIMENSION XQPHAT(*)
9972      DIMENSION XQPSE(*)
9973      DIMENSION XQPLCL(*)
9974      DIMENSION XQPUCL(*)
9975C
9976      DOUBLE PRECISION DN
9977      DOUBLE PRECISION D1N
9978      DOUBLE PRECISION D2R
9979      DOUBLE PRECISION DS
9980      DOUBLE PRECISION DAK
9981      DOUBLE PRECISION DSUM1
9982      DOUBLE PRECISION DALPH
9983      DOUBLE PRECISION XLOW
9984      DOUBLE PRECISION XUP
9985C
9986      DOUBLE PRECISION AE
9987      DOUBLE PRECISION RE
9988C
9989      DOUBLE PRECISION DK
9990      DOUBLE PRECISION DR
9991      DOUBLE PRECISION SHAT
9992      DOUBLE PRECISION DXSUM
9993      DOUBLE PRECISION DC
9994      COMMON/EXPCOM/DK,DR,SHAT,DXSUM,DC
9995      DOUBLE PRECISION EXPFUN
9996      EXTERNAL EXPFUN
9997C
9998      INCLUDE 'DPCOST.INC'
9999C
10000      PARAMETER (MAXROW=50)
10001      CHARACTER*60 ITITLE
10002      CHARACTER*60 ITITLZ
10003      CHARACTER*40 ITEXT(MAXROW)
10004      REAL         AVALUE(MAXROW)
10005      INTEGER      NCTEXT(MAXROW)
10006      INTEGER      IDIGIT(MAXROW)
10007      INTEGER      NTOT(MAXROW)
10008      LOGICAL IFRST
10009      LOGICAL ILAST
10010C
10011C---------------------------------------------------------------------
10012C
10013      INCLUDE 'DPCOP2.INC'
10014C
10015      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
10016C
10017C-----START POINT-----------------------------------------------------
10018C
10019      ISUBN1='DPML'
10020      ISUBN2='E3  '
10021      IERROR='NO'
10022C
10023      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE3')THEN
10024        WRITE(ICOUT,999)
10025  999   FORMAT(1X)
10026        CALL DPWRST('XXX','WRIT')
10027        WRITE(ICOUT,51)
10028   51   FORMAT('**** AT THE BEGINNING OF DPMLE3--')
10029        CALL DPWRST('XXX','WRIT')
10030        WRITE(ICOUT,55)N,NUMV,IBUGA3
10031   55   FORMAT('N,NUMV,NPERC,IBUGA3 = ',3I8,2X,A4)
10032        CALL DPWRST('XXX','WRIT')
10033        DO56I=1,MIN(N,100)
10034          WRITE(ICOUT,57)I,Y(I),TAG(I)
10035   57     FORMAT('I,Y(I),TAG(I) = ',I8,2E15.7)
10036          CALL DPWRST('XXX','WRIT')
10037   56   CONTINUE
10038      ENDIF
10039C
10040C               ********************************************
10041C               **  STEP 11--                             **
10042C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
10043C               ********************************************
10044C
10045      ISTEPN='11'
10046      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE3')
10047     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10048C
10049      NMIN=3
10050      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
10051      IF(IERROR.EQ.'YES')GOTO9000
10052C
10053C               ********************************************
10054C               **  STEP 21--                             **
10055C               **  CHECK THE CENSORING VARIABLE: SHOULD  **
10056C               **  BE AT MOST 2 DISTINCT VALUES, 1       **
10057C               **  INDICATES FAILURE TIME, 0 INDICATES   **
10058C               **  CENSORING TIME.                       **
10059C               ********************************************
10060C
10061      ISTEPN='21'
10062      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE3')
10063     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10064C
10065      CALL EXPML3(Y,TAG,XTEMP,N,ICASPL,ICASE,TEND,MAXNXT,
10066     1            XMEAN,XSD,XVAR,XMIN,XMAX,XSUM,
10067     1            ALOCML,ALOCSE,SCALML,SCALSE,
10068     1            IR,IM,AN,AR,AM,
10069     1            ISUBRO,IBUGA3,IERROR)
10070      IF(IERROR.EQ.'YES')GOTO9000
10071      DR=DBLE(IR)
10072C
10073C               *************************************
10074C               **  STEP 41--                      **
10075C               **  GENERATE CONFIDENCE INTERVALS  **
10076C               **  FOR PARAMETERS AND PERCENTILES **
10077C               *************************************
10078C
10079      ISTEPN='41'
10080      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE3')
10081     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10082C
10083      IERROR='NO'
10084      IWRITE='OFF'
10085C
10086      IF(ICASPL.EQ.'1EXP')THEN
10087        IF(ICASE.EQ.'SING')THEN
10088          NUTEMP=2*IR
10089          DO4110I=1,NUMALP
10090            ALP=ALPHA(I)
10091            P=1.0-(ALP/2.0)
10092            CALL CHSPPF(P,NUTEMP,APPF1)
10093            P=ALP/2.0
10094            CALL CHSPPF(P,NUTEMP,APPF2)
10095            SLNOR=SCALML - ZP*SCALSE
10096            SUNOR=SCALML + ZP*SCALSE
10097            ALOWSC(I)=2.0*AR*SCALML/APPF1
10098            AUPPSC(I)=2.0*AR*SCALML/APPF2
10099 4110     CONTINUE
10100        ELSE
10101          SHAT=DBLE(SCALML)
10102          NUTEMP=1
10103          AE=1.D-7
10104          RE=1.D-7
10105          DXSUM=DBLE(XSUM)
10106          DC=2.0D0*(-DR*DLOG(SHAT) - DXSUM/SHAT)
10107C
10108          DO4120I=1,NUMALP
10109            ALP=ALPHA(I)
10110            P=1.0-(ALP/2.0)
10111            CALL NORPPF(P,ZP)
10112            CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
10113            DK=DBLE(APPF)
10114C
10115C           NOW COMPUTE NORMAL APPROXIMATION INTERVAL (USE AS
10116C           STARTING VALUE FOR LIKELIHOOD RATIO METHOD).
10117C
10118            SLNOR=SCALML - ZP*SCALSE
10119            SUNOR=SCALML + ZP*SCALSE
10120C
10121C           NOW COMPUTE LIKELIHOOD RATIO BASED INTERVAL
10122C
10123            XLOW=DBLE(XMIN)
10124            XUP=DBLE(SCALML)
10125            CALL DFZERO(EXPFUN,XLOW,XUP,DBLE(SLNOR),RE,AE,IFLAG)
10126            ALOWSC(I)=XLOW
10127            AUPPS2(I)=SLNOR
10128C
10129            XLOW=DBLE(SCALML)
10130            XUP=1.3D0*DBLE(SUNOR)
10131            CALL DFZERO(EXPFUN,XLOW,XUP,DBLE(SUNOR),RE,AE,IFLAG)
10132            AUPPSC(I)=XLOW
10133            AUPPS2(I)=SUNOR
10134 4120     CONTINUE
10135        ENDIF
10136C
10137C               **********************************************
10138C               **  STEP 41A--                              **
10139C               **  ESTIMATE CONFIDENCE LIMITS FOR SELECTED **
10140C               **  PERCENTILES.  BASED ON FORMULAS GIVEN   **
10141C               **  ON PAGE 186 OF BURY FOR SINGLY CENSORED **
10142C               **  CASE.  FOR MULTIPLY CENSORED DATA, USE  **
10143C               **  FORMULA ON PAGE 190-191 FOR TWO         **
10144C               **  MODEL (IN THIS CASE, OBTAIN LOWER       **
10145C               **  CONFIDENCE INTERVAL ONLY, SET U = 0 IN  **
10146C               **  FORMUALA).                              **
10147C               **********************************************
10148C
10149        ISTEPN='41A'
10150        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNO')
10151     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10152C
10153        IF(NPERC.GE.1 .AND. ICASE.EQ.'SING')THEN
10154C
10155          NU2=2*IR
10156          ALPHL=ALPHAP/2.0
10157          ALPHU=1.0 - ALPHAP/2.0
10158          CALL CHSPPF(ALPHL,NU2,ACHSLL)
10159          CALL CHSPPF(ALPHU,NU2,ACHSUL)
10160C
10161          WRITE(IOUNI1,4131)
10162          WRITE(IOUNI1,4132)
10163          DO4119I=1,NPERC
10164            QPTEMP=QP(I)/100.0
10165            CALL EXPPPF(QPTEMP,APPF)
10166            XQPHAT(I)=SCALML*APPF
10167            SEXQP=APPF*SCALSE
10168            ATEMP1=APPF*2.0*IR*SCALML/ACHSUL
10169            ATEMP2=APPF*2.0*IR*SCALML/ACHSLL
10170            XQPLCL(I)=MIN(ATEMP1,ATEMP2)
10171            XQPUCL(I)=MAX(ATEMP1,ATEMP2)
10172            WRITE(IOUNI1,'(3E15.7,2X,E15.7)')
10173     1           QP(I),XQPHTZ(I),XQPLCZ(I),XQPUCZ(I)
10174C
10175            IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLE1')THEN
10176              WRITE(ICOUT,4133)I,QP(I),XQPHAT(I),SEXQP,APPF
10177              CALL DPWRST('XXX','BUG ')
10178              WRITE(ICOUT,4135)ACHSUL,ACHSLL,ATEMP1,ATEMP2
10179 4135         FORMAT('ACHSUL,ACHSLL,ATEMP1,ATEMP2 = ',4G15.7)
10180              CALL DPWRST('XXX','BUG ')
10181              WRITE(ICOUT,4137)XQPLCL(I),XQPUCL(I)
10182              CALL DPWRST('XXX','BUG ')
10183            ENDIF
10184C
10185 4119     CONTINUE
10186        ELSEIF(NPERC.GE.1 .AND. ICASE.EQ.'MULT')THEN
10187C
10188C       NOTE: THE FIRST AND THIRD TERMS OF S (P. 191 OF BURY) ARE
10189C                SUM[i=1 to r][X(i)] AND (n-r)*X(r)
10190C             THIS IS SIMPLY THE SUM OF THE FAILURE TIMES AND THE SUM
10191C             OF THE CENSORING TIMES (FOR SINGLY CENSORED DATA),
10192C             RESPECTIVELY.  THIS IS SIMPLY THE SUM OF THE COMBINED
10193C             FAILURE AND CENSORING TIMES, SO JUST NEED TO TAKE THE
10194C             SUM OF ALL THE DATA.  FOR 1-PARAMETER MODEL, JUST SET
10195C             LOCATION PARAMETER TO 0.
10196C
10197          DSUM1=0.0D0
10198          DO44140I=1,N
10199            DSUM1=DSUM1 + DBLE(Y(I))
1020044140     CONTINUE
10201          DS=DSUM1 - DBLE(AN*XMIN)
10202C
10203          D1N=DBLE(1.0/AN)
10204          DN=DBLE(AN)
10205          DR=DBLE(AR)
10206          D2R=DBLE(1.0D0/(AR-1.0))
10207          DALPH=DBLE(ALPHAP)
10208          ALPHL=ALPHAP/2.0
10209          ALPHU=1.0 - ALPHAP/2.0
10210C
10211          WRITE(IOUNI2,4131)
10212          WRITE(IOUNI2,4132)
10213          DO44130I=1,NPERC
10214            QPTEMP=QP(I)/100.0
10215            CALL EXPPPF(QPTEMP,APPF)
10216            XQPHAT(I)=SCALML*APPF
10217            DAK=D1N*(1.0D0 - (DBLE(1.0D0 - QPTEMP)**DN/DALPH)**D2R)
10218            XQPLCL(I)=REAL(DAK*DS)
10219CCCCC       XQPUCL(I)=MAX(ATEMP1,ATEMP2)
10220            WRITE(IOUNI2,'(3E15.7)')
10221     1           QP(I),XQPHAT(I),XQPLCL(I)
10222C
10223            IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLE3')THEN
10224              WRITE(ICOUT,4133)I,QP(I),XQPHAT(I),DS,DAK
10225              CALL DPWRST('XXX','BUG ')
10226              WRITE(ICOUT,4137)XQPLCL(I)
10227              CALL DPWRST('XXX','BUG ')
10228            ENDIF
10229C
1023044130     CONTINUE
10231        ENDIF
10232      ELSE
10233C
10234C     ESTIMATES FOR 2-PARAMETER MODEL
10235C
10236        IF(ICASE.EQ.'SING')THEN
10237          NU2=2*IR-1
10238          DO4125I=1,NUMALP
10239            ALP=ALPHA(I)
10240            P=1.0-(ALP/2.0)
10241            CALL CHSPPF(P,NU2,PPF3)
10242            P=ALP/2.0
10243            CALL CHSPPF(P,NU2,PPF4)
10244            ALOWSC(I)=2.0*AR*SCALML/PPF3
10245            AUPPSC(I)=2.0*AR*SCALML/PPF4
10246            ACONS1=(ALP/2.0)**(2.0/(1.0-2.0*AR)) - 1.0
10247            ACONS2=(1.0 - ALP/2.0)**(2.0/(1.0-2.0*AR)) - 1.0
10248            ATEMP1=XMIN - SCALML*(AR/AN)*ACONS1
10249            ATEMP2=XMIN - SCALML*(AR/AN)*ACONS2
10250            ALOWLO(I)=MIN(ATEMP1,ATEMP2)
10251            AUPPLO(I)=MAX(ATEMP1,ATEMP2)
10252 4125     CONTINUE
10253        ELSE
10254          WRITE(ICOUT,999)
10255          CALL DPWRST('XXX','WRIT')
10256          WRITE(ICOUT,4126)
10257 4126     FORMAT('***** NOTE FROM EXPONENTIAL MAXIMUM LIKELIHOOD--')
10258          CALL DPWRST('XXX','WRIT')
10259          WRITE(ICOUT,4127)
10260 4127     FORMAT('      TWO-PARAMETER MODEL NOT SUPPORTED FOR')
10261          CALL DPWRST('XXX','WRIT')
10262          WRITE(ICOUT,4128)
10263 4128     FORMAT('      MULTIPLY FAILURE CENSORED DATA.')
10264          CALL DPWRST('XXX','WRIT')
10265          IERROR='YES'
10266          GOTO9000
10267        ENDIF
10268C
10269C               **********************************************
10270C               **  STEP 41B--                              **
10271C               **  ESTIMATE CONFIDENCE LIMITS FOR SELECTED **
10272C               **  PERCENTILES.  COMPUTE THE LOWER         **
10273C               **  CONFIDENCE INTERVAL GIVEN ON PP. 190-191**
10274C               **  OF BURY.  NOTE THAT THIS APPROXIMATION  **
10275C               **  IS FOR THE SINGLY CENSORED CASE ONLY.   **
10276C               **  NO FORMULA IS GIVEN FOR THE MULTIPLY    **
10277C               **  CENSORED CASE.                          **
10278C               **********************************************
10279C
10280        ISTEPN='41B'
10281        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNO')
10282     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10283C
10284        IF(NPERC.GE.1)THEN
10285C
10286C       NOTE: THE FIRST AND THIRD TERMS OF S (P. 191 OF BURY) ARE
10287C                SUM[i=1 to r][X(i)] AND (n-r)*X(r)
10288C             THIS IS SIMPLY THE SUM OF THE FAILURE TIMES AND THE SUM
10289C             OF THE CENSORING TIMES (FOR SINGLY CENSORED DATA),
10290C             RESPECTIVELY.  THIS IS SIMPLY THE SUM OF THE COMBINED
10291C             FAILURE AND CENSORING TIMES, SO JUST NEED TO TAKE THE
10292C             SUM OF ALL THE DATA.
10293C
10294          DSUM1=0.0D0
10295          DO4140I=1,N
10296            DSUM1=DSUM1 + DBLE(Y(I))
10297 4140     CONTINUE
10298          DS=DSUM1 - DBLE(AN*XMIN)
10299C
10300          D1N=DBLE(1.0/AN)
10301          DN=DBLE(AN)
10302          DR=DBLE(AR)
10303          D2R=DBLE(1.0D0/(AR+0.5-1.0))
10304          DALPH=DBLE(ALPHAP)
10305          ALPHL=ALPHAP/2.0
10306          ALPHU=1.0 - ALPHAP/2.0
10307C
10308          WRITE(IOUNI2,4131)
10309 4131     FORMAT(15X,'       POINT     ','     LOWER     ')
10310C4131     FORMAT(15X,'       POINT     ','     LOWER     ',
10311CCCCC1           '     UPPER')
10312          WRITE(IOUNI2,4132)
10313 4132     FORMAT('    PERCENTILE ','     ESTIMATE   ',
10314CCCCC1           'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
10315     1           'CONFIDENCE LIMIT ')
10316          DO4130I=1,NPERC
10317            QPTEMP=QP(I)/100.0
10318            CALL EXPPPF(QPTEMP,APPF)
10319            XQPHAT(I)=ALOCML + SCALML*APPF
10320            DAK=D1N*(1.0D0 - (DBLE(1.0D0 - QPTEMP)**DN/DALPH)**D2R)
10321            XQPLCL(I)=ALOCML + REAL(DAK*DS)
10322CCCCC       XQPUCL(I)=ALOCML + MAX(ATEMP1,ATEMP2)
10323            WRITE(IOUNI2,'(3E15.7)')
10324     1           QP(I),XQPHAT(I),XQPLCL(I)
10325C
10326            IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLE3')THEN
10327              WRITE(ICOUT,4133)I,QP(I),XQPHAT(I),DS,DAK
10328 4133         FORMAT('I,QP(I),XQPHAT(I),DS,DAK = ',I8,4G15.7)
10329              CALL DPWRST('XXX','BUG ')
10330              WRITE(ICOUT,4137)XQPLCL(I)
10331 4137         FORMAT('XQPLCL(I) = ',2G15.7)
10332              CALL DPWRST('XXX','BUG ')
10333            ENDIF
10334C
10335 4130     CONTINUE
10336        ENDIF
10337      ENDIF
10338C
10339C               *************************************
10340C               **   STEP 42--                     **
10341C               **   WRITE OUT EVERYTHING          **
10342C               **   FOR EXPONENTIAL MLE ESTIMATE  **
10343C               *************************************
10344C
10345      ISTEPN='42'
10346      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE3')
10347     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10348C
10349      IF(IPRINT.EQ.'OFF')GOTO9000
10350C
10351      NUMDIG=7
10352      IF(IFORSW.EQ.'1')NUMDIG=1
10353      IF(IFORSW.EQ.'2')NUMDIG=2
10354      IF(IFORSW.EQ.'3')NUMDIG=3
10355      IF(IFORSW.EQ.'4')NUMDIG=4
10356      IF(IFORSW.EQ.'5')NUMDIG=5
10357      IF(IFORSW.EQ.'6')NUMDIG=6
10358      IF(IFORSW.EQ.'7')NUMDIG=7
10359      IF(IFORSW.EQ.'8')NUMDIG=8
10360      IF(IFORSW.EQ.'9')NUMDIG=9
10361      IF(IFORSW.EQ.'0')NUMDIG=0
10362      IF(IFORSW.EQ.'E')NUMDIG=-2
10363      IF(IFORSW.EQ.'-2')NUMDIG=-2
10364      IF(IFORSW.EQ.'-3')NUMDIG=-3
10365      IF(IFORSW.EQ.'-4')NUMDIG=-4
10366      IF(IFORSW.EQ.'-5')NUMDIG=-5
10367      IF(IFORSW.EQ.'-6')NUMDIG=-6
10368      IF(IFORSW.EQ.'-7')NUMDIG=-7
10369      IF(IFORSW.EQ.'-8')NUMDIG=-8
10370      IF(IFORSW.EQ.'-9')NUMDIG=-9
10371C
10372      IF(ICASPL.EQ.'1EXP')THEN
10373        ITITLE='1-Parameter Exponential Parameter Estimation'
10374        NCTITL=44
10375      ELSE
10376        ITITLE='2-Parameter Exponential Parameter Estimation'
10377        NCTITL=44
10378      ENDIF
10379      IF(ICASE.EQ.'SING')THEN
10380        ITITLZ='Failure (Singly) Censored Case'
10381        NCTITZ=30
10382      ELSE
10383        ITITLZ='Failure (Multiply) Censored Case'
10384        NCTITZ=32
10385      ENDIF
10386C
10387      ICNT=1
10388      ITEXT(ICNT)='Summary Statistics:'
10389      NCTEXT(ICNT)=19
10390      AVALUE(ICNT)=0.0
10391      IDIGIT(ICNT)=-1
10392      ICNT=ICNT+1
10393      ITEXT(ICNT)='Number of Observations:'
10394      NCTEXT(ICNT)=23
10395      AVALUE(ICNT)=REAL(N)
10396      IDIGIT(ICNT)=0
10397      ICNT=ICNT+1
10398      ITEXT(ICNT)='Number of Failure Times:'
10399      NCTEXT(ICNT)=24
10400      AVALUE(ICNT)=AR
10401      IDIGIT(ICNT)=0
10402      ICNT=ICNT+1
10403      ITEXT(ICNT)='Number of Censoring Times:'
10404      NCTEXT(ICNT)=26
10405      AVALUE(ICNT)=AM
10406      IDIGIT(ICNT)=0
10407      ICNT=ICNT+1
10408      ITEXT(ICNT)='Sample Mean:'
10409      NCTEXT(ICNT)=12
10410      AVALUE(ICNT)=XMEAN
10411      IDIGIT(ICNT)=NUMDIG
10412      ICNT=ICNT+1
10413      ITEXT(ICNT)='Sample Standard Deviation:'
10414      NCTEXT(ICNT)=26
10415      AVALUE(ICNT)=XSD
10416      IDIGIT(ICNT)=NUMDIG
10417      ICNT=ICNT+1
10418      ITEXT(ICNT)='Sample Minimum:'
10419      NCTEXT(ICNT)=15
10420      AVALUE(ICNT)=XMIN
10421      IDIGIT(ICNT)=NUMDIG
10422      ICNT=ICNT+1
10423      ITEXT(ICNT)='Sample Maximum:'
10424      NCTEXT(ICNT)=15
10425      AVALUE(ICNT)=XMAX
10426      IDIGIT(ICNT)=NUMDIG
10427      ICNT=ICNT+1
10428      ITEXT(ICNT)=' '
10429      NCTEXT(ICNT)=0
10430      AVALUE(ICNT)=0.0
10431      IDIGIT(ICNT)=-1
10432C
10433      ICNT=ICNT+1
10434      ITEXT(ICNT)='Maximum Likelihood:'
10435      NCTEXT(ICNT)=19
10436      AVALUE(ICNT)=0.0
10437      IDIGIT(ICNT)=-1
10438      IF(ICASPL.EQ.'EXPO')THEN
10439        ICNT=ICNT+1
10440        ITEXT(ICNT)='Estimate of Location:'
10441        NCTEXT(ICNT)=21
10442        AVALUE(ICNT)=ALOCML
10443        IDIGIT(ICNT)=NUMDIG
10444CCCCC   ICNT=ICNT+1
10445CCCCC   ITEXT(ICNT)='Standard Error of Location:'
10446CCCCC   NCTEXT(ICNT)=27
10447CCCCC   AVALUE(ICNT)=ALOCSE
10448CCCCC   IDIGIT(ICNT)=NUMDIG
10449      ENDIF
10450      ICNT=ICNT+1
10451      ITEXT(ICNT)='Estimate of Scale:'
10452      NCTEXT(ICNT)=18
10453      AVALUE(ICNT)=SCALML
10454      IDIGIT(ICNT)=NUMDIG
10455      ICNT=ICNT+1
10456      ITEXT(ICNT)='Standard Error of Scale:'
10457      NCTEXT(ICNT)=24
10458      AVALUE(ICNT)=SCALSE
10459      IDIGIT(ICNT)=NUMDIG
10460CCCCC ICNT=ICNT+1
10461CCCCC ITEXT(ICNT)='Covariance:'
10462CCCCC NCTEXT(ICNT)=11
10463CCCCC AVALUE(ICNT)=COVSE
10464CCCCC IDIGIT(ICNT)=NUMDIG
10465CCCCC ICNT=ICNT+1
10466CCCCC ITEXT(ICNT)='Log-likelihood:'
10467CCCCC NCTEXT(ICNT)=15
10468CCCCC AVALUE(ICNT)=ALIK
10469CCCCC IDIGIT(ICNT)=-7
10470CCCCC ICNT=ICNT+1
10471CCCCC ITEXT(ICNT)='AIC:'
10472CCCCC NCTEXT(ICNT)=4
10473CCCCC AVALUE(ICNT)=AIC
10474CCCCC IDIGIT(ICNT)=-7
10475CCCCC ICNT=ICNT+1
10476CCCCC ITEXT(ICNT)='AICc:'
10477CCCCC NCTEXT(ICNT)=5
10478CCCCC AVALUE(ICNT)=AICC
10479CCCCC IDIGIT(ICNT)=-7
10480CCCCC ICNT=ICNT+1
10481CCCCC ITEXT(ICNT)='BIC:'
10482CCCCC NCTEXT(ICNT)=4
10483CCCCC AVALUE(ICNT)=BIC
10484CCCCC IDIGIT(ICNT)=-7
10485C
10486      NUMROW=ICNT
10487      DO2320I=1,NUMROW
10488        NTOT(I)=15
10489 2320 CONTINUE
10490C
10491      IFRST=.FALSE.
10492      ILAST=.FALSE.
10493      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
10494     1            AVALUE,IDIGIT,
10495     1            NTOT,NUMROW,
10496     1            ICAPSW,ICAPTY,ILAST,IFRST,
10497     1            ISUBRO,IBUGA3,IERROR)
10498C
10499      IF(ICASPL.EQ.'1EXP')THEN
10500        ALOWLO(1)=CPUMIN
10501        IF(ICASE.EQ.'SING')THEN
10502          INORM='NO'
10503          CALL DPDTA7(ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,NUMALP,
10504     1                ICAPSW,ICAPTY,NUMDIG,INORM,
10505     1                ISUBRO,IBUGA3,IERROR)
10506        ELSE
10507          ILIKFL='ON'
10508          CALL DPDT77(ALOWLO,AUPPLO,ALOWS2,AUPPS2,
10509     1                ALOWLO,AUPPLO,ALOWSC,AUPPSC,
10510     1                ALPHA,NUMALP,
10511     1                ICAPSW,ICAPTY,NUMDIG,
10512     1                ISUBRO,IBUGA3,IERROR)
10513        ENDIF
10514      ELSE
10515        INORM='NO'
10516        CALL DPDTA7(ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,NUMALP,
10517     1              ICAPSW,ICAPTY,NUMDIG,INORM,
10518     1              ISUBRO,IBUGA3,IERROR)
10519      ENDIF
10520C
10521      IF(NPERC.GE.1)THEN
10522        XQPSE(1)=CPUMIN
10523        IF(ICASPL.EQ.'1EXP' .AND. ICASE.EQ.'SING')THEN
10524          ILIKFL='OFF'
10525          CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
10526     1                ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
10527     1                ISUBRO,IBUGA3,IERROR)
10528        ELSE
10529          ILIKFL='OFF'
10530          XQPUCL(1)=CPUMIN
10531          CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
10532     1                ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
10533     1                ISUBRO,IBUGA3,IERROR)
10534        ENDIF
10535      ENDIF
10536C
10537C               *****************
10538C               **  STEP 90--  **
10539C               **  EXIT       **
10540C               *****************
10541C
10542 9000 CONTINUE
10543      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE3')THEN
10544        WRITE(ICOUT,999)
10545        CALL DPWRST('XXX','WRIT')
10546        WRITE(ICOUT,9011)
10547 9011   FORMAT('***** AT THE END       OF DPMLE3--')
10548        CALL DPWRST('XXX','WRIT')
10549        WRITE(ICOUT,9012)N,IBUGA3,IERROR
10550 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
10551        CALL DPWRST('XXX','WRIT')
10552        WRITE(ICOUT,9015)N
10553 9015   FORMAT('N = ',I8)
10554        CALL DPWRST('XXX','WRIT')
10555      ENDIF
10556C
10557      RETURN
10558      END
10559      SUBROUTINE DPMLE4(Y,X1,X2,N,
10560     1                  XTEMP,TEMP2,TEMP3,MAXNXT,
10561     1                  XMIN,SCALML,SCALSE,NUMV,TEND,
10562     1                  ICAPSW,ICAPTY,IFORSW,
10563     1                  QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,NPERC,
10564     1                  IOUNI1,IOUNI2,ALPHAP,
10565     1                  ISUBRO,IBUGA3,IERROR)
10566C
10567C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
10568C              ESTIMATES FOR EXPONENTIAL DISTRIBUTION
10569C              FOR THE FULL SAMPLE CASE WHEN THE DATA ARE BINNED.
10570C              CURRENTLY, ONLY THE ONE-PARAMETER MODEL IS
10571C              ESTIMATED.
10572C
10573C              THE ML ESTIMATE IS BASED ON KNOWING THE END POINTS
10574C              OF THE GROUPS (I.E., THE BIN WIDTHS NEED NOT BE
10575C              EQUAL).  SO TWO SYNTAXES ARE ALLOWED: IF ONE GROUPING
10576C              VARIABLE, THEN IT IS ASSUMED THIS REPRESENTS THE
10577C              BIN MID-POINTS AND BINS ARE EQUAL WIDTH.  IF THERE
10578C              ARE TWO GROUPING VARIABLES, THEN IT IS ASSUMED THAT
10579C              THE FIRST REPRESENTS THE LOWER BOUNDARY OF THE BIN
10580C              AND THE SECOND REPRESENTS THE UPPER BOUNDARY OF THE
10581C              BIN.
10582C
10583C              THE CURRENT IMPLEMENTATION PROVIDES A POINT ESTIMATE
10584C              AND THE STANDARD ERROR, BUT NO EXPLICIT CONFIDENCE
10585C              INTERVAL.
10586C
10587C     EXAMPLE--SET CENSORING TYPE GROUPED
10588C              EXPONENTIAL MAXIMUM LIKELIHOOD Y X
10589C
10590C              EXPONENTIAL MAXIMUM LIKELIHOOD Y XLOW XHIGH
10591C
10592C     REFERENCE--JOHNSON, KOTZ, AND BALAKRISHNAN, "CONTINUOUS
10593C                UNIVARIATE DISTRIBUTIONS--Volume 1", SECOND EDITION,
10594C                WILEY, 1994, PP. 509-510.
10595C     WRITTEN BY--JAMES J. FILLIBEN
10596C                 STATISTICAL ENGINEERING DIVISION
10597C                 INFORMATION TECHNOLOGY LABORATORY
10598C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
10599C                 GAITHERSBURG, MD 20899-8980
10600C                 PHONE--301-975-2855
10601C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
10602C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
10603C     LANGUAGE--ANSI FORTRAN (1977)
10604C     VERSION NUMBER--2004/10
10605C     ORIGINAL VERSION--OCTOBER   2004.
10606C     UPDATED         --JUNE      2010. USE DPDTA1, DPDTA7, DPDTA9 TO
10607C                                       PRINT OUTPUT, ADD AIC AND
10608C                                       RELATED STATISTICS TO OUTPUT
10609C
10610C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
10611C
10612      CHARACTER*4 ICAPSW
10613      CHARACTER*4 ICAPTY
10614      CHARACTER*4 IFORSW
10615C
10616      CHARACTER*4 ISUBRO
10617      CHARACTER*4 IBUGA3
10618      CHARACTER*4 IERROR
10619      CHARACTER*4 IWRITE
10620      CHARACTER*4 ISUBN1
10621      CHARACTER*4 ISUBN2
10622      CHARACTER*4 ISTEPN
10623C
10624C---------------------------------------------------------------------
10625C
10626      PARAMETER (NUMALP=8)
10627      DIMENSION ALPHA(NUMALP)
10628      DIMENSION ALOWLO(NUMALP)
10629      DIMENSION AUPPLO(NUMALP)
10630      DIMENSION ALOWSC(NUMALP)
10631      DIMENSION AUPPSC(NUMALP)
10632C
10633      DIMENSION Y(*)
10634      DIMENSION X1(*)
10635      DIMENSION X2(*)
10636      DIMENSION XTEMP(*)
10637      DIMENSION TEMP2(*)
10638      DIMENSION TEMP3(*)
10639      DIMENSION QP(*)
10640      DIMENSION XQPHAT(*)
10641      DIMENSION XQPSE(*)
10642      DIMENSION XQPLCL(*)
10643      DIMENSION XQPUCL(*)
10644C
10645      INCLUDE 'DPCOST.INC'
10646C
10647      PARAMETER (MAXROW=50)
10648      CHARACTER*60 ITITLE
10649      CHARACTER*60 ITITLZ
10650      CHARACTER*40 ITEXT(MAXROW)
10651      REAL         AVALUE(MAXROW)
10652      INTEGER      NCTEXT(MAXROW)
10653      INTEGER      IDIGIT(MAXROW)
10654      INTEGER      NTOT(MAXROW)
10655      LOGICAL IFRST
10656      LOGICAL ILAST
10657C
10658      CHARACTER*4 ILIKFL
10659      CHARACTER*4 INORM
10660C
10661C---------------------------------------------------------------------
10662C
10663      INCLUDE 'DPCOP2.INC'
10664C
10665      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
10666C
10667C-----START POINT-----------------------------------------------------
10668C
10669      ISUBN1='DPML'
10670      ISUBN2='E4  '
10671      IERROR='NO'
10672C
10673      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE4')THEN
10674        WRITE(ICOUT,999)
10675  999   FORMAT(1X)
10676        CALL DPWRST('XXX','WRIT')
10677        WRITE(ICOUT,51)
10678   51   FORMAT('**** AT THE BEGINNING OF DPMLE4--')
10679        CALL DPWRST('XXX','WRIT')
10680        WRITE(ICOUT,55)ICENTY,IBUGA3,N,NUMV,NPERC,IOUNI2,TEND
10681   55   FORMAT('ICENTY,IBUGA3,N,NUMV,NPERC,IOUNI2,TEND = ',
10682     1         2(A4,2X),4I8,G15.7)
10683        CALL DPWRST('XXX','WRIT')
10684        DO56I=1,MIN(N,100)
10685          WRITE(ICOUT,57)I,Y(I),X1(I),X2(I)
10686   57     FORMAT('I,Y(I),X1(I),X2(I) = ',I8,3G15.7)
10687          CALL DPWRST('XXX','WRIT')
10688   56   CONTINUE
10689      ENDIF
10690C
10691C               ********************************************
10692C               **  STEP 11--                             **
10693C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
10694C               ********************************************
10695C
10696      ISTEPN='11'
10697      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE4')
10698     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10699C
10700      NMIN=2
10701      IF(NUMV.EQ.2)THEN
10702        CALL CKDIS2(Y,X1,XTEMP,N,MAXNXT,NMIN,QP,NPERC,NTOT2,
10703     1              ISUBRO,IBUGA3,IERROR)
10704        IF(IERROR.EQ.'YES')GOTO9000
10705      ELSEIF(NUMV.EQ.3)THEN
10706        CALL CKDIS3(Y,X1,X2,XTEMP,N,MAXNXT,NMIN,QP,NPERC,NTOT2,
10707     1              ISUBRO,IBUGA3,IERROR)
10708        IF(IERROR.EQ.'YES')GOTO9000
10709      ENDIF
10710C
10711C               *****************************************
10712C               **  STEP 21--                          **
10713C               **  CARRY OUT CALCULATIONS FOR GROUPED **
10714C               **  EXPONENTIAL MLE (GROUPED, FULL     **
10715C               **  SAMPLE CASE).  ML ESTIMATE GIVEN   **
10716C               **  ON PAGE 509 OF JOHNSON, KOTZ, AND  **
10717C               **  BALAKRISHNAN.                      **
10718C               *****************************************
10719C
10720      ISTEPN='21'
10721      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE4')
10722     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10723      IERROR='NO'
10724      IWRITE='OFF'
10725C
10726      CALL EXPML4(Y,X1,X2,N,NUMV,MAXNXT,
10727     1            XTEMP,TEMP2,TEMP3,
10728     1            XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
10729     1            SCALML,SCALSE,
10730     1            ISUBRO,IBUGA3,IERROR)
10731      IF(IERROR.EQ.'YES')GOTO9000
10732      AN=REAL(NTOTZZ)
10733C
10734      DO2110I=1,NUMALP
10735        ALPHAT=ALPHA(I)
10736        ALPHAT=1.0 - ALPHAT/2.0
10737        CALL NORPPF(ALPHAT,ZPPF)
10738        ALOWSC(I)=SCALML - ZPPF*SCALSE
10739        AUPPSC(I)=SCALML + ZPPF*SCALSE
10740 2110 CONTINUE
10741C
10742      IF(NPERC.GE.1)THEN
10743C
10744        NU2=2*NTOTZZ
10745        ALPHL=ALPHAP/2.0
10746        ALPHU=1.0 - ALPHAP/2.0
10747        CALL CHSPPF(ALPHL,NU2,ACHSLL)
10748        CALL CHSPPF(ALPHU,NU2,ACHSUL)
10749C
10750        WRITE(IOUNI1,4131)
10751        WRITE(IOUNI1,4132)
10752        DO4119I=1,NPERC
10753          QPTEMP=QP(I)/100.0
10754          CALL EXPPPF(QPTEMP,APPF)
10755          XQPHAT(I)=SCALML*APPF
10756          SEXQP=APPF*SCALSE
10757          ATEMP1=APPF*2.0*AN*SCALML/ACHSUL
10758          ATEMP2=APPF*2.0*AN*SCALML/ACHSLL
10759          XQPLCL(I)=MIN(ATEMP1,ATEMP2)
10760          XQPUCL(I)=MAX(ATEMP1,ATEMP2)
10761C
10762          WRITE(IOUNI1,'(3E15.7,2X,E15.7)')
10763     1         QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I)
10764C
10765          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLE4')THEN
10766            WRITE(ICOUT,4133)I,QP(I),XQPHAT(I),SEXQP,APPF
10767            CALL DPWRST('XXX','BUG ')
10768            WRITE(ICOUT,4135)ACHSUL,ACHSLL,ATEMP1,ATEMP2
10769            CALL DPWRST('XXX','BUG ')
10770            WRITE(ICOUT,4137)XQPLCL(I),XQPUCL(I)
10771            CALL DPWRST('XXX','BUG ')
10772          ENDIF
10773C
10774 4119   CONTINUE
10775 4131   FORMAT(15X,'       POINT     ','     LOWER     ',
10776     1         '     UPPER')
10777 4132   FORMAT('    PERCENTILE ','     ESTIMATE   ',
10778     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
10779 4133   FORMAT('I,QP(I),XQPHAT(I),SEXQP,APPF = ',I8,4G15.7)
10780 4135   FORMAT('ACHSUL,ACHSLL,ATEMP1,ATEMP2 = ',4G15.7)
10781 4137   FORMAT('XQPLCL(I),XQPUCL(I) = ',2G15.7)
10782      ENDIF
10783C
10784C               *************************************
10785C               **   STEP 42--                     **
10786C               **   WRITE OUT EVERYTHING          **
10787C               **   FOR EXPONENTIAL MLE ESTIMATE  **
10788C               *************************************
10789C
10790      ISTEPN='42'
10791      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE4')
10792     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10793C
10794      IF(IPRINT.EQ.'OFF')GOTO9000
10795C
10796      NUMDIG=7
10797      IF(IFORSW.EQ.'1')NUMDIG=1
10798      IF(IFORSW.EQ.'2')NUMDIG=2
10799      IF(IFORSW.EQ.'3')NUMDIG=3
10800      IF(IFORSW.EQ.'4')NUMDIG=4
10801      IF(IFORSW.EQ.'5')NUMDIG=5
10802      IF(IFORSW.EQ.'6')NUMDIG=6
10803      IF(IFORSW.EQ.'7')NUMDIG=7
10804      IF(IFORSW.EQ.'8')NUMDIG=8
10805      IF(IFORSW.EQ.'9')NUMDIG=9
10806      IF(IFORSW.EQ.'0')NUMDIG=0
10807      IF(IFORSW.EQ.'E')NUMDIG=-2
10808      IF(IFORSW.EQ.'-2')NUMDIG=-2
10809      IF(IFORSW.EQ.'-3')NUMDIG=-3
10810      IF(IFORSW.EQ.'-4')NUMDIG=-4
10811      IF(IFORSW.EQ.'-5')NUMDIG=-5
10812      IF(IFORSW.EQ.'-6')NUMDIG=-6
10813      IF(IFORSW.EQ.'-7')NUMDIG=-7
10814      IF(IFORSW.EQ.'-8')NUMDIG=-8
10815      IF(IFORSW.EQ.'-9')NUMDIG=-9
10816C
10817      ITITLE='1-Parameter Exponential Parameter Estimation'
10818      NCTITL=44
10819      ITITLZ='(Grouped Data)'
10820      NCTITZ=14
10821      ICNT=1
10822      ITEXT(ICNT)='Summary Statistics:'
10823      NCTEXT(ICNT)=19
10824      AVALUE(ICNT)=0.0
10825      IDIGIT(ICNT)=-1
10826      ICNT=ICNT+1
10827      ITEXT(ICNT)='Number of Observations:'
10828      NCTEXT(ICNT)=23
10829      AVALUE(ICNT)=REAL(NTOTZZ)
10830      IDIGIT(ICNT)=0
10831      ICNT=ICNT+1
10832      ITEXT(ICNT)='Sample Mean:'
10833      NCTEXT(ICNT)=12
10834      AVALUE(ICNT)=XMEAN
10835      IDIGIT(ICNT)=NUMDIG
10836      ICNT=ICNT+1
10837      ITEXT(ICNT)='Sample Standard Deviation:'
10838      NCTEXT(ICNT)=26
10839      AVALUE(ICNT)=XSD
10840      IDIGIT(ICNT)=NUMDIG
10841      ICNT=ICNT+1
10842      ITEXT(ICNT)='Sample Minimum:'
10843      NCTEXT(ICNT)=15
10844      AVALUE(ICNT)=XMIN
10845      IDIGIT(ICNT)=NUMDIG
10846      ICNT=ICNT+1
10847      ITEXT(ICNT)='Sample Maximum:'
10848      NCTEXT(ICNT)=15
10849      AVALUE(ICNT)=XMAX
10850      IDIGIT(ICNT)=NUMDIG
10851      ICNT=ICNT+1
10852      ITEXT(ICNT)=' '
10853      NCTEXT(ICNT)=0
10854      AVALUE(ICNT)=0.0
10855      IDIGIT(ICNT)=-1
10856C
10857      ICNT=ICNT+1
10858      ITEXT(ICNT)='Maximum Likelihood:'
10859      NCTEXT(ICNT)=19
10860      AVALUE(ICNT)=0.0
10861      IDIGIT(ICNT)=-1
10862CCCCC IF(ICASPL.EQ.'EXPO')THEN
10863CCCCC   ICNT=ICNT+1
10864CCCCC   ITEXT(ICNT)='Estimate of Location:'
10865CCCCC   NCTEXT(ICNT)=21
10866CCCCC   AVALUE(ICNT)=ALOC
10867CCCCC   IDIGIT(ICNT)=NUMDIG
10868CCCCC   ICNT=ICNT+1
10869CCCCC   ITEXT(ICNT)='Standard Error of Location:'
10870CCCCC   NCTEXT(ICNT)=27
10871CCCCC   AVALUE(ICNT)=ALOCSE
10872CCCCC   IDIGIT(ICNT)=NUMDIG
10873CCCCC ENDIF
10874      ICNT=ICNT+1
10875      ITEXT(ICNT)='Estimate of Scale:'
10876      NCTEXT(ICNT)=18
10877      AVALUE(ICNT)=SCALML
10878      IDIGIT(ICNT)=NUMDIG
10879      ICNT=ICNT+1
10880      ITEXT(ICNT)='Standard Error of Scale:'
10881      NCTEXT(ICNT)=24
10882      AVALUE(ICNT)=SCALSE
10883      IDIGIT(ICNT)=NUMDIG
10884CCCCC ICNT=ICNT+1
10885CCCCC ITEXT(ICNT)='Log-likelihood:'
10886CCCCC NCTEXT(ICNT)=15
10887CCCCC AVALUE(ICNT)=ALIK
10888CCCCC IDIGIT(ICNT)=-7
10889CCCCC ICNT=ICNT+1
10890CCCCC ITEXT(ICNT)='AIC:'
10891CCCCC NCTEXT(ICNT)=4
10892CCCCC AVALUE(ICNT)=AIC
10893CCCCC IDIGIT(ICNT)=-7
10894CCCCC ICNT=ICNT+1
10895CCCCC ITEXT(ICNT)='AICc:'
10896CCCCC NCTEXT(ICNT)=5
10897CCCCC AVALUE(ICNT)=AICC
10898CCCCC IDIGIT(ICNT)=-7
10899CCCCC ICNT=ICNT+1
10900CCCCC ITEXT(ICNT)='BIC:'
10901CCCCC NCTEXT(ICNT)=4
10902CCCCC AVALUE(ICNT)=BIC
10903CCCCC IDIGIT(ICNT)=-7
10904C
10905      NUMROW=ICNT
10906      DO2320I=1,NUMROW
10907        NTOT(I)=15
10908 2320 CONTINUE
10909C
10910      IFRST=.FALSE.
10911      ILAST=.FALSE.
10912      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
10913     1            AVALUE,IDIGIT,
10914     1            NTOT,NUMROW,
10915     1            ICAPSW,ICAPTY,ILAST,IFRST,
10916     1            ISUBRO,IBUGA3,IERROR)
10917C
10918      INORM='ON'
10919      ALOWLO(1)=CPUMIN
10920      CALL DPDTA7(ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,NUMALP,
10921     1            ICAPSW,ICAPTY,NUMDIG,INORM,
10922     1            ISUBRO,IBUGA3,IERROR)
10923C
10924      IF(NPERC.GT.1)THEN
10925        ILIKFL='OFF'
10926        XQPSE(1)=CPUMIN
10927        CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
10928     1              ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
10929     1              ISUBRO,IBUGA3,IERROR)
10930      ENDIF
10931C
10932C               *****************
10933C               **  STEP 90--  **
10934C               **  EXIT       **
10935C               *****************
10936C
10937 9000 CONTINUE
10938      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE4')THEN
10939        WRITE(ICOUT,999)
10940        CALL DPWRST('XXX','WRIT')
10941        WRITE(ICOUT,9011)
10942 9011   FORMAT('***** AT THE END       OF DPMLE4--')
10943        CALL DPWRST('XXX','WRIT')
10944        WRITE(ICOUT,9012)N,IBUGA3,IERROR
10945 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
10946        CALL DPWRST('XXX','WRIT')
10947        WRITE(ICOUT,9015)N,NTOT
10948 9015   FORMAT('NNTOT = ',2I8)
10949        CALL DPWRST('XXX','WRIT')
10950      ENDIF
10951C
10952      RETURN
10953      END
10954      SUBROUTINE DPMLEL(Y1,N,
10955     1                  TEND,
10956     1                  ICAPSW,ICAPTY,IFORSW,
10957     1                  AHAT,BHAT,
10958     1                  ISUBRO,IBUGA3,IERROR)
10959C
10960C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
10961C              ESTIMATES FOR A NON-HOMOGENEOUS POISSON PROCESS
10962C              THAT FOLLOWS THE "EXPONENTIAL LAW" MODEL.
10963C
10964C              THE EXPONENTIAL LAW MODEL IS:
10965C
10966C                  M(t) = EXP(C + B*t)
10967C
10968C              WHERE
10969C
10970C                 M(t) = CUMULATIVE REPAIR FUNCTION
10971C                 t    = TIME TO FAILURE
10972C                 b, c = PARAMETERS TO BE ESTIMATED
10973C
10974C               THE EXPONENTIAL LAW IS INDICATED WHEN A PLOT
10975C               OF LOG(CUMULATIVE NUMBER OF REPAIRS) VS TIME
10976C               IS APPROXIMATELY LINEAR.
10977C
10978C               THE INPUT IS ASSUMED TO BE REPAIR TIMES.  WE CAN
10979C               OPTIONALLY HAVE A CENSORING VARIABLE (THERE SHOULD
10980C               BE AT MOST ONE CENSORING TIME).
10981C
10982C               FOR THE CASE WHERE THE TEST IS TERMINATED AT THE
10983C               NTH FAILURE, THE MAXIMUM LIKELIHOOD ESTIMATE OF B
10984C               IS THE SOLUTION OF THE EQUATION
10985C
10986C                   SUM[i=1 to n][t(i)] + (n/bhat) -
10987C                   n*t(n)/(1 - EXP(-bhat*t(n)) = 0
10988C
10989C               THE ESTIMATE OF C IS THEN
10990C
10991C                   chat = LOG(n*bhat/(EXP(bhat*t(n)) - 1)
10992C
10993C               FOR THE CASE WHERE THE TEST IS TERMINATED AT A FIXED
10994C               TIME T, THE MAXIMUM LIKELIHOOD ESTIMATE OF B IS
10995C               THE SOLUTION OF THE EQUATION
10996C
10997C                   SUM[i=1 to n][t(i)] + (N/bhat) -
10998C                   N*t(n)/(1 - EXP(-bhat*T)) = 0
10999C
11000C               WHERE T IS THE TIME OF TRUNCATION AND N IS THE
11001C               NUMBER OF REPAIRS.
11002C
11003C               THE ESTIMATE OF C IS THEN
11004C
11005C                   chat = LOG(N*bhat/(EXP(bhat*T) - 1)
11006C
11007C     EXAMPLE--EXPONENTIAL LAW MAXIMUM LIKELIHOOD Y
11008C     REFERENCE--TOBIAS AND TRINDADE, "APPLIED RELIABILITY", SECOND
11009C                EDITION, PP. 363-365.
11010C     WRITTEN BY--ALAN HECKERT
11011C                 STATISTICAL ENGINEERING DIVISION
11012C                 INFORMATION TECHNOLOGY LABORATORY
11013C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
11014C                 GAITHERSBURG, MD 20899-8980
11015C                 PHONE--301-975-2899
11016C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
11017C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
11018C     LANGUAGE--ANSI FORTRAN (1977)
11019C     VERSION NUMBER--2007/2
11020C     ORIGINAL VERSION--FEBRUARY  2007.
11021C     UPDATED         --APRIL     2011.
11022C
11023C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
11024C
11025      CHARACTER*4 ICAPSW
11026      CHARACTER*4 ICAPTY
11027      CHARACTER*4 IFORSW
11028C
11029      CHARACTER*4 ISUBRO
11030      CHARACTER*4 IBUGA3
11031      CHARACTER*4 IERROR
11032      CHARACTER*4 IWRITE
11033      CHARACTER*4 ISUBN1
11034      CHARACTER*4 ISUBN2
11035      CHARACTER*4 ISTEPN
11036C
11037      DOUBLE PRECISION DBHAT
11038      DOUBLE PRECISION DAHAT
11039      DOUBLE PRECISION DCHAT
11040C
11041      DOUBLE PRECISION AE
11042      DOUBLE PRECISION RE
11043      DOUBLE PRECISION XLOW
11044      DOUBLE PRECISION XUP
11045C
11046      DOUBLE PRECISION DN
11047      DOUBLE PRECISION DTEND
11048      DOUBLE PRECISION DXSUM
11049      DOUBLE PRECISION DXN
11050      COMMON/EPLCOM/DXSUM,DXN,DTEND,DN
11051      DOUBLE PRECISION EPLFUN
11052      DOUBLE PRECISION EPLFU2
11053      EXTERNAL EPLFUN
11054      EXTERNAL EPLFU2
11055C
11056C---------------------------------------------------------------------
11057C
11058      DIMENSION Y1(*)
11059C
11060      PARAMETER (MAXROW=10)
11061      CHARACTER*60 ITITLE
11062      CHARACTER*60 ITITLZ
11063      CHARACTER*40 ITEXT(MAXROW)
11064      REAL         AVALUE(MAXROW)
11065      INTEGER      NCTEXT(MAXROW)
11066      INTEGER      IDIGIT(MAXROW)
11067      INTEGER      NTOT(MAXROW)
11068      LOGICAL      IFRST
11069      LOGICAL      ILAST
11070C
11071C---------------------------------------------------------------------
11072C
11073      INCLUDE 'DPCOP2.INC'
11074C
11075C-----START POINT-----------------------------------------------------
11076C
11077      ISUBN1='DPML'
11078      ISUBN2='EL  '
11079      IERROR='NO'
11080C
11081      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLEL')THEN
11082        WRITE(ICOUT,999)
11083  999   FORMAT(1X)
11084        CALL DPWRST('XXX','WRIT')
11085        WRITE(ICOUT,51)
11086   51   FORMAT('**** AT THE BEGINNING OF DPMLEL--')
11087        CALL DPWRST('XXX','WRIT')
11088        WRITE(ICOUT,55)IBUGA3,ISUBRO,N,TEND
11089   55   FORMAT('IBUGA3,ISUBRO,N,TEND = ',2(A4,2X),I8,G15.7)
11090        CALL DPWRST('XXX','WRIT')
11091        DO56I=1,MIN(N,100)
11092          WRITE(ICOUT,57)I,Y1(I)
11093   57     FORMAT('I,Y1(I) = ',I8,G15.7)
11094          CALL DPWRST('XXX','WRIT')
11095   56   CONTINUE
11096      ENDIF
11097C
11098C               ********************************************
11099C               **  STEP 11--                             **
11100C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
11101C               ********************************************
11102C
11103      ISTEPN='11'
11104      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLEL')
11105     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11106C
11107      IF(N.LT.3)THEN
11108        WRITE(ICOUT,999)
11109        CALL DPWRST('XXX','WRIT')
11110        WRITE(ICOUT,1111)
11111 1111   FORMAT('***** ERROR IN EXPONENTIAL LAW MAXIMUM LIKELIHOOD--')
11112        CALL DPWRST('XXX','WRIT')
11113        WRITE(ICOUT,1112)
11114 1112   FORMAT('      THE NUMBER OF OBSERVATIONS IS < 3')
11115        CALL DPWRST('XXX','WRIT')
11116        WRITE(ICOUT,1113)N
11117 1113   FORMAT('      SAMPLE SIZE = ',I8)
11118        CALL DPWRST('XXX','WRIT')
11119        IERROR='YES'
11120        GOTO9000
11121      ENDIF
11122C
11123      DO1135I=1,N
11124        IF(Y1(I).LE.0.0)THEN
11125          WRITE(ICOUT,999)
11126          CALL DPWRST('XXX','WRIT')
11127          WRITE(ICOUT,1111)
11128          CALL DPWRST('XXX','WRIT')
11129          WRITE(ICOUT,1132)I
11130 1132     FORMAT('      FAILURE TIME ',I8,' IS NON-POSITIVE.')
11131          CALL DPWRST('XXX','WRIT')
11132          WRITE(ICOUT,1134)Y1(I)
11133 1134     FORMAT('      FAILURE TIME = ',G15.7)
11134          CALL DPWRST('XXX','WRIT')
11135          IERROR='YES'
11136          GOTO9000
11137        ENDIF
11138 1135 CONTINUE
11139C
11140C               **********************************
11141C               **  STEP 41--                   **
11142C               **  CARRY OUT CALCULATIONS      **
11143C               **  FOR EXPONENTIAL LAW MLE     **
11144C               **  ESTIMATE (FULL SAMPLE CASE) **
11145C               **********************************
11146C
11147      ISTEPN='41'
11148      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLEL')
11149     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11150C
11151      IERROR='NO'
11152      IWRITE='OFF'
11153      AN=REAL(N)
11154      DN=DBLE(N)
11155      AE=1.D-7
11156      RE=1.D-7
11157C
11158      CALL SORT(Y1,N,Y1)
11159      IF(TEND.LE.Y1(N))TEND=0.0
11160C
11161      IF(TEND.LE.0.0)THEN
11162C
11163C       NUMBER OF FAILURES CASE
11164C
11165        NUMCEN=0
11166        DTEND=0.0D0
11167        DXN=DBLE(Y1(N))
11168        DXSUM=0.0D0
11169        DO4110I=1,N
11170          DXSUM=DXSUM + DBLE(Y1(I))
11171 4110   CONTINUE
11172        XLOW=0.000000001D0
11173        XUP=10.0D0
11174        DBHAT=0.1D0
11175        CALL DFZERO(EPLFUN,XLOW,XUP,DBHAT,RE,AE,IFLAG)
11176        DBHAT=XLOW
11177        DCHAT=DLOG(DN*DBHAT/(DEXP(DBHAT*DXN)-1.0D0))
11178        DAHAT=DEXP(DCHAT)
11179      ELSE
11180C
11181C       TIME CENSORED CASE CASE
11182C
11183        NUMCEN=1
11184        DTEND=DBLE(TEND)
11185        DXN=DBLE(Y1(N))
11186        DXSUM=0.0D0
11187        DO4210I=1,N
11188          DXSUM=DXSUM + DBLE(Y1(I))
11189 4210   CONTINUE
11190        XLOW=0.000000001D0
11191        XUP=10.0D0
11192        DBHAT=0.1D0
11193        CALL DFZERO(EPLFU2,XLOW,XUP,DBHAT,RE,AE,IFLAG)
11194        DBHAT=XLOW
11195        DCHAT=DLOG(DN*DBHAT/(DEXP(DBHAT*DTEND)-1.0D0))
11196        DAHAT=DEXP(DCHAT)
11197      ENDIF
11198C
11199      AHAT=REAL(DAHAT)
11200      BHAT=REAL(DBHAT)
11201      CHAT=REAL(DCHAT)
11202C
11203C     PRINT TABLE
11204C
11205      NUMDIG=7
11206      IF(IFORSW.EQ.'1')NUMDIG=1
11207      IF(IFORSW.EQ.'2')NUMDIG=2
11208      IF(IFORSW.EQ.'3')NUMDIG=3
11209      IF(IFORSW.EQ.'4')NUMDIG=4
11210      IF(IFORSW.EQ.'5')NUMDIG=5
11211      IF(IFORSW.EQ.'6')NUMDIG=6
11212      IF(IFORSW.EQ.'7')NUMDIG=7
11213      IF(IFORSW.EQ.'8')NUMDIG=8
11214      IF(IFORSW.EQ.'9')NUMDIG=9
11215      IF(IFORSW.EQ.'0')NUMDIG=0
11216      IF(IFORSW.EQ.'E')NUMDIG=-2
11217      IF(IFORSW.EQ.'-2')NUMDIG=-2
11218      IF(IFORSW.EQ.'-3')NUMDIG=-3
11219      IF(IFORSW.EQ.'-4')NUMDIG=-4
11220      IF(IFORSW.EQ.'-5')NUMDIG=-5
11221      IF(IFORSW.EQ.'-6')NUMDIG=-6
11222      IF(IFORSW.EQ.'-7')NUMDIG=-7
11223      IF(IFORSW.EQ.'-8')NUMDIG=-8
11224      IF(IFORSW.EQ.'-9')NUMDIG=-9
11225C
11226      ITITLE='Exponential Law ML Estimation (M(t) = (a/b)*exp(b*t) - 1)'
11227      NCTITL=57
11228      IF(NUMCEN.EQ.0)THEN
11229        ITITLZ='Single System, Failure Truncated Case'
11230        NCTITZ=37
11231      ELSE
11232        ITITLZ='Single System, Time Truncated Case'
11233        NCTITZ=34
11234      ENDIF
11235C
11236      ICNT=1
11237      ITEXT(ICNT)='Summary Statistics:'
11238      NCTEXT(ICNT)=19
11239      AVALUE(ICNT)=0.0
11240      IDIGIT(ICNT)=-1
11241      ICNT=ICNT+1
11242      ITEXT(ICNT)='Number of Failure Times:'
11243      NCTEXT(ICNT)=24
11244      AVALUE(ICNT)=REAL(N)
11245      IDIGIT(ICNT)=0
11246      IF(TEND.GT.0.0)THEN
11247        ICNT=ICNT+1
11248        ITEXT(ICNT)='Censoring Time:'
11249        NCTEXT(ICNT)=15
11250        AVALUE(ICNT)=TEND
11251        IDIGIT(ICNT)=NUMDIG
11252      ENDIF
11253      ICNT=ICNT+1
11254      ITEXT(ICNT)=' '
11255      NCTEXT(ICNT)=0
11256      AVALUE(ICNT)=0.0
11257      IDIGIT(ICNT)=-1
11258C
11259      ICNT=ICNT+1
11260      ITEXT(ICNT)='Parameter Estimates:'
11261      NCTEXT(ICNT)=20
11262      AVALUE(ICNT)=0.0
11263      IDIGIT(ICNT)=-1
11264      ICNT=ICNT+1
11265      ITEXT(ICNT)='Estimate of B:'
11266      NCTEXT(ICNT)=14
11267      AVALUE(ICNT)=REAL(DBHAT)
11268      IDIGIT(ICNT)=NUMDIG
11269      ICNT=ICNT+1
11270      ITEXT(ICNT)='Estimate of A:'
11271      NCTEXT(ICNT)=14
11272      AVALUE(ICNT)=REAL(DAHAT)
11273      IDIGIT(ICNT)=NUMDIG
11274      ICNT=ICNT+1
11275      ITEXT(ICNT)=' '
11276      NCTEXT(ICNT)=0
11277      AVALUE(ICNT)=0.0
11278      IDIGIT(ICNT)=-1
11279C
11280      NUMROW=ICNT
11281      DO2310I=1,NUMROW
11282        NTOT(I)=15
11283 2310 CONTINUE
11284C
11285      IFRST=.TRUE.
11286      ILAST=.TRUE.
11287      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
11288     1            AVALUE,IDIGIT,
11289     1            NTOT,NUMROW,
11290     1            ICAPSW,ICAPTY,ILAST,IFRST,
11291     1            ISUBRO,IBUGA3,IERROR)
11292C
11293C               *****************
11294C               **  STEP 90--  **
11295C               **  EXIT       **
11296C               *****************
11297C
11298 9000 CONTINUE
11299      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLEL')THEN
11300        WRITE(ICOUT,999)
11301        CALL DPWRST('XXX','WRIT')
11302        WRITE(ICOUT,9011)
11303 9011   FORMAT('***** AT THE END       OF DPMLEL--')
11304        CALL DPWRST('XXX','WRIT')
11305        WRITE(ICOUT,9012)N,IBUGA3,IERROR
11306 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
11307        CALL DPWRST('XXX','WRIT')
11308        WRITE(ICOUT,9015)IERROR,DAHAT,DBHAT
11309 9015   FORMAT('IERROR,DAHAT,DBHAT = ',A4,2X,2G15.7)
11310        CALL DPWRST('XXX','WRIT')
11311      ENDIF
11312C
11313      RETURN
11314      END
11315      SUBROUTINE DPMLFL(Y,N,
11316     1                  XTEMP,DTEMP1,MAXNXT,
11317     1                  SHAPMO,SCALMO,SHAPML,SCALML,
11318     1                  ICAPSW,ICAPTY,IFORSW,
11319     1                  ISUBRO,IBUGA3,IERROR)
11320C
11321C     PURPOSE--THIS ROUTINE COMPUTES THE METHOD OF MOMENT AND
11322C              MAXIMUM LIKELIHOOD ESTIMATES FOR THE FATIGUE LIFE
11323C              DISTRIBUTION
11324C     EXAMPLE--FATIGUE LIFE MAXIMUM LIKELIHOOD Y
11325C     REFERENCE--JOHNSON, KOTZ, AND BALAKRISHNAN.  "CONTINUOUS
11326C                UNIVARIATE DISTRIBUTIONS, VOLUME I", SECOND
11327C                EDITION, WILEY, 1994, PP. 614-619.
11328C     WRITTEN BY--JAMES J. FILLIBEN
11329C                 STATISTICAL ENGINEERING DIVISION
11330C                 INFORMATION TECHNOLOGY LABORATORY
11331C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
11332C                 GAITHERSBUG, MD 20899-8980
11333C                 PHONE--301-975-2855
11334C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
11335C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
11336C     LANGUAGE--ANSI FORTRAN (1977)
11337C     VERSION NUMBER--2004/3
11338C     ORIGINAL VERSION--MARCH     2004.
11339C     UPDATED         --AUGUST    2005. ORDER OF SCALE/SHAPE WERE
11340C                                       INVERTED.  FIXED.
11341C     UPDATED         --AUGUST    2005. AESTHETIC FIXES TO OUTOUT
11342C     UPDATED         --FEBRUARY  2010. EXTRACT POINT ESTIMATES TO
11343C                                       DISTINCT ROUTINE (FLML1) TO
11344C                                       FACILITATE USE BY MULTIPLE
11345C                                       ROUTINES
11346C     UPDATED         --FEBRUARY  2010. PRINT TABLES USING DPDTA2
11347C                                       AND DPDTA8
11348C
11349C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
11350C
11351      CHARACTER*4 ICAPSW
11352      CHARACTER*4 ICAPTY
11353      CHARACTER*4 IFORSW
11354      CHARACTER*4 ISUBRO
11355      CHARACTER*4 IBUGA3
11356      CHARACTER*4 IERROR
11357C
11358      CHARACTER*4 ISUBN1
11359      CHARACTER*4 ISUBN2
11360      CHARACTER*4 ISTEPN
11361C
11362C---------------------------------------------------------------------
11363C
11364      DIMENSION Y(*)
11365      DIMENSION XTEMP(*)
11366      DOUBLE PRECISION DTEMP1(*)
11367      DIMENSION QP(1)
11368C
11369      INCLUDE 'DPCOST.INC'
11370C
11371      PARAMETER (MAXROW=10)
11372      CHARACTER*60 ITITLE
11373      CHARACTER*60 ITITLZ
11374      CHARACTER*40 ITEXT(MAXROW)
11375      REAL         AVALUE(MAXROW)
11376      INTEGER      NCTEXT(MAXROW)
11377      INTEGER      IDIGIT(MAXROW)
11378      INTEGER      NTOT(MAXROW)
11379      LOGICAL IFRST
11380      LOGICAL ILAST
11381C
11382C---------------------------------------------------------------------
11383C
11384      INCLUDE 'DPCOP2.INC'
11385C
11386C-----START POINT-----------------------------------------------------
11387C
11388      ISUBN1='DPML'
11389      ISUBN2='FL  '
11390      IERROR='NO'
11391C
11392      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLFL')THEN
11393        WRITE(ICOUT,999)
11394  999   FORMAT(1X)
11395        CALL DPWRST('XXX','WRIT')
11396        WRITE(ICOUT,51)
11397   51   FORMAT('**** AT THE BEGINNING OF DPMLFL--')
11398        CALL DPWRST('XXX','WRIT')
11399        WRITE(ICOUT,52)IBUGA3,ISUBRO,N
11400   52   FORMAT('IBUGA3,ISUBRO,N = ',A4,2X,A4,2X,I8)
11401        CALL DPWRST('XXX','WRIT')
11402        DO56I=1,MIN(N,100)
11403          WRITE(ICOUT,57)I,Y(I)
11404   57     FORMAT('I,Y(I) = ',I8,E15.7)
11405          CALL DPWRST('XXX','WRIT')
11406   56   CONTINUE
11407      ENDIF
11408C
11409C               ***************************************************
11410C               **  STEP 21--                                    **
11411C               **  CARRY OUT CALCULATIONS                       **
11412C               **  FOR FATIGUE LIFE MOMENT/MLE ESTIMATION       **
11413C               ***************************************************
11414C
11415      ISTEPN='21'
11416      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLFL')
11417     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11418C
11419      NPERC=0
11420      NMIN=3
11421      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
11422      IF(IERROR.EQ.'YES')GOTO9000
11423C
11424      CALL FLML1(Y,N,MAXNXT,
11425     1           XTEMP,DTEMP1,
11426     1           XMEAN,XSD,XVAR,XMIN,XMAX,
11427     1           SCALML,SHAPML,SCALMO,SHAPMO,
11428     1           ISUBRO,IBUGA3,IERROR)
11429C
11430C               ***********************************************
11431C               **   STEP 42--                               **
11432C               **   WRITE OUT EVERYTHING                    **
11433C               **   FOR FATIGUE LIFE MLE ESTIMATION         **
11434C               ***********************************************
11435C
11436      ISTEPN='42'
11437      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLFL')
11438     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11439C
11440C     PRINT SUMMARY STATISTICS TABLE
11441C
11442      IF(IPRINT.EQ.'OFF')GOTO9000
11443C
11444      NUMDIG=7
11445      IF(IFORSW.EQ.'1')NUMDIG=1
11446      IF(IFORSW.EQ.'2')NUMDIG=2
11447      IF(IFORSW.EQ.'3')NUMDIG=3
11448      IF(IFORSW.EQ.'4')NUMDIG=4
11449      IF(IFORSW.EQ.'5')NUMDIG=5
11450      IF(IFORSW.EQ.'6')NUMDIG=6
11451      IF(IFORSW.EQ.'7')NUMDIG=7
11452      IF(IFORSW.EQ.'8')NUMDIG=8
11453      IF(IFORSW.EQ.'9')NUMDIG=9
11454      IF(IFORSW.EQ.'0')NUMDIG=0
11455      IF(IFORSW.EQ.'E')NUMDIG=-2
11456      IF(IFORSW.EQ.'-2')NUMDIG=-2
11457      IF(IFORSW.EQ.'-3')NUMDIG=-3
11458      IF(IFORSW.EQ.'-4')NUMDIG=-4
11459      IF(IFORSW.EQ.'-5')NUMDIG=-5
11460      IF(IFORSW.EQ.'-6')NUMDIG=-6
11461      IF(IFORSW.EQ.'-7')NUMDIG=-7
11462      IF(IFORSW.EQ.'-8')NUMDIG=-8
11463      IF(IFORSW.EQ.'-9')NUMDIG=-9
11464C
11465      ITITLE='Two-Parameter Fatigue Life Parameter Estimation:'
11466      NCTITL=48
11467      ITITLZ='Full Sample Case'
11468      NCTITZ=16
11469      ITEXT(1)='Summary Statistics:'
11470      NCTEXT(1)=19
11471      AVALUE(1)=0.0
11472      IDIGIT(1)=0
11473      ITEXT(2)='Number of Observations:'
11474      NCTEXT(2)=23
11475      AVALUE(2)=REAL(N)
11476      IDIGIT(2)=0
11477      ITEXT(3)='Sample Mean:'
11478      NCTEXT(3)=12
11479      AVALUE(3)=XMEAN
11480      IDIGIT(3)=NUMDIG
11481      ITEXT(4)='Sample Standard Deviation:'
11482      NCTEXT(4)=26
11483      AVALUE(4)=XSD
11484      IDIGIT(4)=NUMDIG
11485      ITEXT(5)='Sample Minimum:'
11486      NCTEXT(5)=15
11487      AVALUE(5)=XMIN
11488      IDIGIT(5)=NUMDIG
11489      ITEXT(6)='Sample Maximum:'
11490      NCTEXT(6)=15
11491      AVALUE(6)=XMAX
11492      IDIGIT(6)=NUMDIG
11493      NUMROW=6
11494      DO2310I=1,NUMROW
11495        NTOT(I)=15
11496 2310 CONTINUE
11497      NTOT(2)=8
11498C
11499      IFRST=.TRUE.
11500      ILAST=.FALSE.
11501      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
11502     1            NCTEXT,AVALUE,IDIGIT,
11503     1            NTOT,NUMROW,
11504     1            ICAPSW,ICAPTY,ILAST,IFRST,
11505     1            ISUBRO,IBUGA3,IERROR)
11506      IFRST=.FALSE.
11507      ITITLE=' '
11508      NCTITL=0
11509C
11510      ITEXT(1)='Method of Moments:'
11511      NCTEXT(1)=18
11512      AVALUE(1)=0.0
11513      IDIGIT(1)=0
11514      ITEXT(2)='Estimate of Shape (Gamma):'
11515      NCTEXT(2)=26
11516      AVALUE(2)=SHAPMO
11517      IDIGIT(2)=NUMDIG
11518      ITEXT(3)='Estimate of Scale:'
11519      NCTEXT(3)=18
11520      AVALUE(3)=SCALMO
11521      IDIGIT(3)=NUMDIG
11522      ITEXT(4)=' '
11523      NCTEXT(4)=0
11524      AVALUE(4)=0.0
11525      IDIGIT(4)=-1
11526      ITEXT(5)='Maximum Likelihood:'
11527      NCTEXT(5)=19
11528      AVALUE(5)=0.0
11529      IDIGIT(5)=-1
11530      ITEXT(6)='Estimate of Shape (Gamma):'
11531      NCTEXT(6)=26
11532      AVALUE(6)=SHAPML
11533      IDIGIT(6)=NUMDIG
11534      ITEXT(7)='Estimate of Scale:'
11535      NCTEXT(7)=18
11536      AVALUE(7)=SCALML
11537      IDIGIT(7)=NUMDIG
11538C
11539      ICNT=7
11540C
11541CCCCC ICNT=ICNT+1
11542CCCCC ITEXT(ICNT)='Log-likelihood:'
11543CCCCC NCTEXT(ICNT)=15
11544CCCCC AVALUE(ICNT)=ALIK
11545CCCCC IDIGIT(ICNT)=-7
11546CCCCC ICNT=ICNT+1
11547CCCCC ITEXT(ICNT)='AIC:'
11548CCCCC NCTEXT(ICNT)=4
11549CCCCC AVALUE(ICNT)=AIC
11550CCCCC IDIGIT(ICNT)=-7
11551CCCCC ICNT=ICNT+1
11552CCCCC ITEXT(ICNT)='AICc:'
11553CCCCC NCTEXT(ICNT)=5
11554CCCCC AVALUE(ICNT)=AICC
11555CCCCC IDIGIT(ICNT)=-7
11556CCCCC ICNT=ICNT+1
11557CCCCC ITEXT(ICNT)='BIC:'
11558CCCCC NCTEXT(ICNT)=4
11559CCCCC AVALUE(ICNT)=BIC
11560CCCCC IDIGIT(ICNT)=-7
11561C
11562      NUMROW=ICNT
11563      DO2320I=1,NUMROW
11564        NTOT(I)=15
11565 2320 CONTINUE
11566C
11567      IFRST=.FALSE.
11568      ILAST=.FALSE.
11569      ITITLZ=' '
11570      NCTITZ=0
11571      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
11572     1            AVALUE,IDIGIT,
11573     1            NTOT,NUMROW,
11574     1            ICAPSW,ICAPTY,ILAST,IFRST,
11575     1            ISUBRO,IBUGA3,IERROR)
11576C
11577C               *****************
11578C               **  STEP 90--  **
11579C               **  EXIT       **
11580C               *****************
11581C
11582 9000 CONTINUE
11583      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLFL')THEN
11584        WRITE(ICOUT,999)
11585        CALL DPWRST('XXX','WRIT')
11586        WRITE(ICOUT,9011)
11587 9011   FORMAT('***** AT THE END       OF DPMLFL--')
11588        CALL DPWRST('XXX','WRIT')
11589      ENDIF
11590C
11591      RETURN
11592      END
11593      SUBROUTINE DPMLFN(Y,N,
11594     1                  TEMP1,DTEMP1,ITEMP1,MAXNXT,
11595     1                  AMU,SIGMA,THETA,
11596     1                  THETSE,SIGMSE,CORTHS,
11597     1                  ALIK,AIC,AICC,BIC,
11598     1                  ICAPSW,ICAPTY,IFORSW,
11599     1                  ISUBRO,IBUGA3,IERROR)
11600C
11601C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
11602C              FOR THE FOLDED NORMAL DISTRIBUTION.
11603C              THE MAXIMUM LIKELIHOOD ESTIMATES ARE THE SOLUTION TO
11604C              THE FOLLOWING SIMULTANEOUS NONLINEAR EQUATIONS:
11605C              EQUATIONS.
11606C
11607C              LOC**2 + SCALE**2 - SUM[i=1 to n][X(i)**2]/N
11608C
11609C              LOC - SUM[i=1 to n][X(i)*tanh(LOC*X(i)/SCALE**2)]/n
11610C
11611C              WITH LOC AND SCALE DENOTING THE SHAPE PARAMETERS.
11612C
11613C     EXAMPLE--FOLDED NORMAL MAXIMUM LIKELIHOOD Y
11614C     REFERENCE--"CONTINUOUS UNIVARIATE DISTRIBUTIONS-VVOLUME II",
11615C                SECOND EDITION, JOHNSON, KOTZ, AND BALAKRISHNAN,
11616C                1994, WILEY, P. 454.
11617C     REFERENCE--N. L. JOHNSON (1962), "THE FOLDED NORMAL DISTRIBUTION:
11618C                ACCURACY OF ESTIMATION BY MAXIMUM LIKELIHOOD",
11619C                TECHNOMETRICS, VOL. 4, NO. 2, PP. 249-256.
11620C     WRITTEN BY--ALAN HECKERT
11621C                 STATISTICAL ENGINEERING DIVISION
11622C                 INFORMATION TECHNOLOGY LABORATORY
11623C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
11624C                 GAITHERSBUG, MD 20899-8980
11625C                 PHONE--301-975-2855
11626C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
11627C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
11628C     LANGUAGE--ANSI FORTRAN (1977)
11629C     VERSION NUMBER--2004/3
11630C     ORIGINAL VERSION--MARCH     2004.
11631C     UPDATED         --AUGUST    2005. REFORMAT OUTPUT FOR CONSISTENCY
11632C                                       WITH OTHER ML ROUTINES
11633C     UPDATED         --MAY       2014. ADD LIKELIHOOD/AIC VALUES
11634C     UPDATED         --MAY       2014. PARAMETER CONFIDENCE INTERVALS
11635C
11636C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
11637C
11638      CHARACTER*4 ICAPSW
11639      CHARACTER*4 ICAPTY
11640      CHARACTER*4 IFORSW
11641      CHARACTER*4 ISUBRO
11642      CHARACTER*4 IBUGA3
11643      CHARACTER*4 IERROR
11644C
11645      CHARACTER*4 IWRITE
11646      CHARACTER*4 ISUBN1
11647      CHARACTER*4 ISUBN2
11648      CHARACTER*4 ISTEPN
11649      CHARACTER*4 ILIKFL
11650      CHARACTER*4 ILOCFL
11651      CHARACTER*4 ISCAFL
11652      CHARACTER*8 ISHAP1
11653      CHARACTER*8 ISHAP2
11654C
11655      PARAMETER (MAXROW=20)
11656      CHARACTER*60 ITITLE
11657      CHARACTER*1  ITITLZ
11658      CHARACTER*40 ITEXT(MAXROW)
11659      REAL         AVALUE(MAXROW)
11660      INTEGER      NCTEXT(MAXROW)
11661      INTEGER      IDIGIT(MAXROW)
11662      INTEGER      NTOT(MAXROW)
11663      LOGICAL IFRST
11664      LOGICAL ILAST
11665C
11666      INTEGER LIMIT
11667      INTEGER LENW
11668      PARAMETER(LIMIT=100)
11669      PARAMETER(LENW=4*LIMIT)
11670      INTEGER INF
11671      INTEGER NEVAL
11672      INTEGER IER
11673      INTEGER LAST
11674C
11675      DOUBLE PRECISION EPSABS
11676      DOUBLE PRECISION EPSREL
11677      DOUBLE PRECISION DX
11678      DOUBLE PRECISION ABSERR
11679      DOUBLE PRECISION E1
11680      DOUBLE PRECISION E2
11681      DOUBLE PRECISION E3
11682      DOUBLE PRECISION DN
11683      DOUBLE PRECISION DSIGMA
11684      DOUBLE PRECISION DNUM
11685      DOUBLE PRECISION DENOM
11686C
11687      DOUBLE PRECISION DTHETA
11688      COMMON/FNRCOM/DTHETA
11689C
11690      DOUBLE PRECISION FNRFU2
11691      EXTERNAL FNRFU2
11692C
11693      PARAMETER (NUMALP=8)
11694      DIMENSION ALPHA(NUMALP)
11695      DIMENSION ALOWSI(NUMALP)
11696      DIMENSION AUPPSI(NUMALP)
11697      DIMENSION ALOWTH(NUMALP)
11698      DIMENSION AUPPTH(NUMALP)
11699C
11700C---------------------------------------------------------------------
11701C
11702      DIMENSION Y(*)
11703      DIMENSION TEMP1(*)
11704      DOUBLE PRECISION DTEMP1(*)
11705      INTEGER ITEMP1(*)
11706C
11707      DIMENSION QP(1)
11708C
11709C---------------------------------------------------------------------
11710C
11711      INCLUDE 'DPCOP2.INC'
11712C
11713      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
11714C
11715C-----START POINT-----------------------------------------------------
11716C
11717      ISUBN1='DPML'
11718      ISUBN2='FN  '
11719      IERROR='NO'
11720C
11721      CORTHS=CPUMIN
11722C
11723      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLFN')THEN
11724        WRITE(ICOUT,999)
11725  999   FORMAT(1X)
11726        CALL DPWRST('XXX','WRIT')
11727        WRITE(ICOUT,51)
11728   51   FORMAT('**** AT THE BEGINNING OF DPMLFN--')
11729        CALL DPWRST('XXX','WRIT')
11730        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,MAXNXT
11731   52   FORMAT('IBUGA3,ISUBRO,N,MAXNXT = ',2(A4,2X),2I8)
11732        CALL DPWRST('XXX','WRIT')
11733        DO56I=1,MIN(N,100)
11734          WRITE(ICOUT,57)I,Y(I)
11735   57     FORMAT('I,Y(I) = ',I8,G15.7)
11736          CALL DPWRST('XXX','WRIT')
11737   56   CONTINUE
11738      ENDIF
11739C
11740C               ********************************************
11741C               **  STEP 11--                             **
11742C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
11743C               ********************************************
11744C
11745      ISTEPN='11'
11746      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLFN')
11747     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11748C
11749      NPERC=0
11750      NMIN=2
11751      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
11752      IF(IERROR.EQ.'YES')GOTO9000
11753C
11754C               ********************************************
11755C               **  STEP 21--                             **
11756C               **  CARRY OUT CALCULATIONS                **
11757C               **  FOR FOLDED NORMAL MLE ESTIMATION      **
11758C               ********************************************
11759C
11760      ISTEPN='21'
11761      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLFN')
11762     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11763C
11764      IERROR='NO'
11765      IWRITE='OFF'
11766      CALL FNRML1(Y,N,MAXNXT,
11767     1            TEMP1,DTEMP1,
11768     1            XMEAN,XSD,XVAR,XMIN,XMAX,
11769     1            AMU,SIGMA,
11770     1            ISUBRO,IBUGA3,IERROR)
11771      THETA=AMU/SIGMA
11772      DTHETA=DBLE(THETA)
11773C
11774      CALL FNRLI1(Y,N,AMU,SIGMA,
11775     1            ALIK,AIC,AICC,BIC,
11776     1            ISUBRO,IBUGA3,IERROR)
11777C
11778C     COMPUTE VARIANCE-COVARIANCE MATRIX AS DESCRIBED IN
11779C     THE JOHNSON TECHNOMETRICS PAPER.
11780C
11781      E2=DBLE(THETA)
11782      E3=DBLE(1.0D0 + E2**2)
11783C
11784      INF=-1
11785      EPSABS=0.0D0
11786      EPSREL=1.0D-7
11787      IER=0
11788      E1=0.0D0
11789      DX=0.0D0
11790      IFLAG=0
11791C
11792      CALL DQAGI(FNRFU2,DX,INF,EPSABS,EPSREL,E1,ABSERR,NEVAL,
11793     1          IER,LIMIT,LENW,LAST,ITEMP1,DTEMP1)
11794C
11795      IF(IER.EQ.1)THEN
11796        WRITE(ICOUT,999)
11797        CALL DPWRST('XXX','BUG ')
11798        WRITE(ICOUT,111)
11799  111   FORMAT('***** ERROR FROM FOLDED NORMAL MAXIMUM LIKELIHOOD--')
11800        CALL DPWRST('XXX','BUG ')
11801        WRITE(ICOUT,113)
11802  113   FORMAT('      MAXIMUM AKMBER OF SUBDIVISIONS EXCEEDED.')
11803        CALL DPWRST('XXX','BUG ')
11804      ELSEIF(IER.EQ.2)THEN
11805        WRITE(ICOUT,999)
11806        CALL DPWRST('XXX','BUG ')
11807        WRITE(ICOUT,111)
11808        CALL DPWRST('XXX','BUG ')
11809        WRITE(ICOUT,123)
11810  123   FORMAT('      ROUNDOFF ERROR PREVENTS REQUESTED TOLERANCE ',
11811     1         'FROM BEING ACHIEVED.')
11812        CALL DPWRST('XXX','BUG ')
11813      ELSEIF(IER.EQ.3)THEN
11814        WRITE(ICOUT,999)
11815        CALL DPWRST('XXX','BUG ')
11816        WRITE(ICOUT,111)
11817        CALL DPWRST('XXX','BUG ')
11818        WRITE(ICOUT,133)
11819  133   FORMAT('      BAD INTEGRAND BEHAVIOUR DETECTED.')
11820        CALL DPWRST('XXX','BUG ')
11821      ELSEIF(IER.EQ.4)THEN
11822        WRITE(ICOUT,999)
11823        CALL DPWRST('XXX','BUG ')
11824        WRITE(ICOUT,111)
11825        CALL DPWRST('XXX','BUG ')
11826        WRITE(ICOUT,143)
11827  143   FORMAT('      INTEGRATION DID NOT CONVERGE.')
11828        CALL DPWRST('XXX','BUG ')
11829      ELSEIF(IER.EQ.5)THEN
11830        WRITE(ICOUT,999)
11831        CALL DPWRST('XXX','BUG ')
11832        WRITE(ICOUT,111)
11833        CALL DPWRST('XXX','BUG ')
11834        WRITE(ICOUT,153)
11835  153   FORMAT('      THE INTEGRATION IS PROBABLY DIVERGENT.')
11836        CALL DPWRST('XXX','BUG ')
11837      ELSEIF(IER.EQ.6)THEN
11838        WRITE(ICOUT,999)
11839        CALL DPWRST('XXX','BUG ')
11840        WRITE(ICOUT,111)
11841        CALL DPWRST('XXX','BUG ')
11842        WRITE(ICOUT,163)
11843  163   FORMAT('      INVALID INPUT TO THE INTEGRATION ROUTINE.')
11844        CALL DPWRST('XXX','BUG ')
11845      ENDIF
11846C
11847      SIGMSE=CPUMIN
11848      THETSE=CPUMIN
11849      DN=DBLE(N)
11850      DSIGMA=DBLE(SIGMA)
11851      DNUM=0.5D0*(2.0D0 + DTHETA**2*(1.0D0 - E1))
11852      DENOM=DN*(2.0D0*DTHETA**2*E1 - 1.0D0 + E1)
11853      DTERM1=DNUM/DENOM
11854      IF(DTERM1.GE.0.0D0)THETSE=SQRT(REAL(DTERM1))
11855      DNUM=0.5D0*DSIGMA**2*(1.0D0 - E1)
11856      DENOM=DN*(2.0D0*DTHETA**2*E1 - 1.0D0 + E1)
11857      DTERM1=DNUM/DENOM
11858      IF(DTERM1.GE.0.0D0)SIGMSE=SQRT(REAL(DTERM1))
11859CCCCC DNUM=-DTHETA*(1.0D0 + E1)
11860CCCCC DENOM=DSQRT(1.0D0 - E1)*DSQRT(2.0D0 + DTHETA**2*(1.0D0 - E1))
11861CCCCC CORTHS=REAL(DNUM/DENOM)
11862C
11863      IF(THETSE.GE.0.0 .AND. SIGMSE.GT.0.0)THEN
11864        DO1010I=1,NUMALP
11865C
11866          ALP=ALPHA(I)
11867          P1=ALP/2.0
11868          P2=1.0-(ALP/2.0)
11869C
11870          CALL NORPPF(P2,AUPP)
11871          ALOWTH(I)=THETA - AUPP*THETSE
11872          AUPPTH(I)=THETA + AUPP*THETSE
11873          ALOWSI(I)=SIGMA - AUPP*SIGMSE
11874          AUPPSI(I)=SIGMA + AUPP*SIGMSE
11875C
11876 1010   CONTINUE
11877      ENDIF
11878C               ***********************************************
11879C               **   STEP 42--                               **
11880C               **   WRITE OUT EVERYTHING                    **
11881C               **   FOR FOLDED NORMAL MLE                   **
11882C               **   ESTIMATION                              **
11883C               ***********************************************
11884C
11885      ISTEPN='42'
11886      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLFN')
11887     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11888C
11889C     PRINT SUMMARY STATISTICS TABLE
11890C
11891      IF(IPRINT.EQ.'OFF')GOTO9000
11892C
11893      NUMDIG=7
11894      IF(IFORSW.EQ.'1')NUMDIG=1
11895      IF(IFORSW.EQ.'2')NUMDIG=2
11896      IF(IFORSW.EQ.'3')NUMDIG=3
11897      IF(IFORSW.EQ.'4')NUMDIG=4
11898      IF(IFORSW.EQ.'5')NUMDIG=5
11899      IF(IFORSW.EQ.'6')NUMDIG=6
11900      IF(IFORSW.EQ.'7')NUMDIG=7
11901      IF(IFORSW.EQ.'8')NUMDIG=8
11902      IF(IFORSW.EQ.'9')NUMDIG=9
11903      IF(IFORSW.EQ.'0')NUMDIG=0
11904      IF(IFORSW.EQ.'E')NUMDIG=-2
11905      IF(IFORSW.EQ.'-2')NUMDIG=-2
11906      IF(IFORSW.EQ.'-3')NUMDIG=-3
11907      IF(IFORSW.EQ.'-4')NUMDIG=-4
11908      IF(IFORSW.EQ.'-5')NUMDIG=-5
11909      IF(IFORSW.EQ.'-6')NUMDIG=-6
11910      IF(IFORSW.EQ.'-7')NUMDIG=-7
11911      IF(IFORSW.EQ.'-8')NUMDIG=-8
11912      IF(IFORSW.EQ.'-9')NUMDIG=-9
11913C
11914      ITITLE='Folded Normal Parameter Estimation'
11915      NCTITL=34
11916      ITEXT(1)='Summary Statistics:'
11917      NCTEXT(1)=19
11918      AVALUE(1)=0.0
11919      IDIGIT(1)=0
11920      ITEXT(2)='Number of Observations:'
11921      NCTEXT(2)=23
11922      AVALUE(2)=REAL(N)
11923      IDIGIT(2)=0
11924      ITEXT(3)='Sample Mean:'
11925      NCTEXT(3)=12
11926      AVALUE(3)=XMEAN
11927      IDIGIT(3)=NUMDIG
11928      ITEXT(4)='Sample Standard Deviation:'
11929      NCTEXT(4)=26
11930      AVALUE(4)=XSD
11931      IDIGIT(4)=NUMDIG
11932      ITEXT(5)='Sample Minimum:'
11933      NCTEXT(5)=15
11934      AVALUE(5)=XMIN
11935      IDIGIT(5)=NUMDIG
11936      ITEXT(6)='Sample Minimum:'
11937      NCTEXT(6)=15
11938      AVALUE(6)=XMAX
11939      IDIGIT(6)=NUMDIG
11940      ITEXT(7)=' '
11941      NCTEXT(7)=0
11942      AVALUE(7)=0.0
11943      IDIGIT(7)=-1
11944C
11945      ICNT=8
11946      ITEXT(ICNT)='Maximum Likelihood:'
11947      NCTEXT(ICNT)=19
11948      AVALUE(ICNT)=0.0
11949      IDIGIT(ICNT)=-1
11950      ICNT=ICNT+1
11951      ITEXT(ICNT)='Estimate of Mu:'
11952      NCTEXT(ICNT)=15
11953      AVALUE(ICNT)=AMU
11954      IDIGIT(ICNT)=NUMDIG
11955      ICNT=ICNT+1
11956      ITEXT(ICNT)='Estimate of Sigma:'
11957      NCTEXT(ICNT)=18
11958      AVALUE(ICNT)=SIGMA
11959      IDIGIT(ICNT)=NUMDIG
11960      ICNT=ICNT+1
11961      ITEXT(ICNT)='Estimate of Theta (Mu/Sigma):'
11962      NCTEXT(ICNT)=29
11963      AVALUE(ICNT)=THETA
11964      IDIGIT(ICNT)=NUMDIG
11965      IF(SIGMSE.GE.0.0 .AND. THETSE.GE.0.0)THEN
11966        ICNT=ICNT+1
11967        ITEXT(ICNT)='Standard Error of Sigma:'
11968        NCTEXT(ICNT)=24
11969        AVALUE(ICNT)=SIGMSE
11970        IDIGIT(ICNT)=NUMDIG
11971        ICNT=ICNT+1
11972        ITEXT(ICNT)='Standard Error of Theta:'
11973        NCTEXT(ICNT)=24
11974        AVALUE(ICNT)=THETSE
11975        IDIGIT(ICNT)=NUMDIG
11976CCCCC   ICNT=ICNT+1
11977CCCCC   ITEXT(ICNT)='Sigma/Theta Correlation:'
11978CCCCC   NCTEXT(ICNT)=24
11979CCCCC   AVALUE(ICNT)=CORTHS
11980CCCCC   IDIGIT(ICNT)=NUMDIG
11981      ENDIF
11982      ICNT=ICNT+1
11983      ITEXT(ICNT)='Log-likelihood:'
11984      NCTEXT(ICNT)=15
11985      AVALUE(ICNT)=ALIK
11986      IDIGIT(ICNT)=NUMDIG
11987      ICNT=ICNT+1
11988      ITEXT(ICNT)='AIC:'
11989      NCTEXT(ICNT)=4
11990      AVALUE(ICNT)=AIC
11991      IDIGIT(ICNT)=NUMDIG
11992      ICNT=ICNT+1
11993      ITEXT(ICNT)='AICc:'
11994      NCTEXT(ICNT)=5
11995      AVALUE(ICNT)=AICC
11996      IDIGIT(ICNT)=NUMDIG
11997      ICNT=ICNT+1
11998      ITEXT(ICNT)='BIC:'
11999      NCTEXT(ICNT)=4
12000      AVALUE(ICNT)=BIC
12001      IDIGIT(ICNT)=NUMDIG
12002      NUMROW=ICNT
12003      DO2320I=1,NUMROW
12004        NTOT(I)=15
12005 2320 CONTINUE
12006C
12007      IFRST=.TRUE.
12008      ILAST=.TRUE.
12009      NCTITZ=0
12010      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
12011     1            AVALUE,IDIGIT,
12012     1            NTOT,NUMROW,
12013     1            ICAPSW,ICAPTY,ILAST,IFRST,
12014     1            ISUBRO,IBUGA3,IERROR)
12015C
12016      ILOCFL='OFF'
12017      ISCAFL='OFF'
12018      ISHAP1='Sigma'
12019      NCSHA1=5
12020      ISHAP2='Theta'
12021      NCSHA2=5
12022      ILIKFL='OFF'
12023C
12024      IF(SIGMSE.GE.0.0 .AND. THETSE.GE.0.0)THEN
12025        CALL DPDT8A(ALOWSI,AUPPSI,ALOWSI,AUPPSI,
12026     1              ALOWSI,AUPPSI,ALOWSI,AUPPSI,
12027     1              ALOWTH,AUPPTH,ALOWTH,AUPPTH,
12028     1              ALPHA,NUMALP,
12029     1              ICAPSW,ICAPTY,NUMDIG,
12030     1              ILOCFL,ISCAFL,ILIKFL,
12031     1              ISHAP1,NCSHA1,ISHAP2,NCSHA2,
12032     1              ISUBRO,IBUGA3,IERROR)
12033      ENDIF
12034C
12035C               *****************
12036C               **  STEP 90--  **
12037C               **  EXIT       **
12038C               *****************
12039C
12040 9000 CONTINUE
12041      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLFN')THEN
12042        WRITE(ICOUT,999)
12043        CALL DPWRST('XXX','WRIT')
12044        WRITE(ICOUT,9011)
12045 9011   FORMAT('***** AT THE END       OF DPMLFN--')
12046        CALL DPWRST('XXX','WRIT')
12047        WRITE(ICOUT,9012)N,IBUGA3,IERROR
12048 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
12049        CALL DPWRST('XXX','WRIT')
12050        WRITE(ICOUT,9015)N
12051 9015   FORMAT('N = ',I8)
12052        CALL DPWRST('XXX','WRIT')
12053      ENDIF
12054C
12055      RETURN
12056      END
12057      SUBROUTINE DPMLFR(Y,N,
12058     1                  XTEMP,DTEMP,MAXNXT,MINMAX,
12059     1                  SCALE,SCALSE,GAMMA,GAMMSE,GAMMBC,GABCSE,
12060     1                  COVSE,COBCSE,
12061     1                  ICAPSW,ICAPTY,IFORSW,
12062     1                  QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
12063     1                  IOUNI1,IOUNI2,ALPHAP,
12064     1                  ISUBRO,IBUGA3,IERROR)
12065C
12066C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
12067C              ESTIMATES FOR FRECHET DISTRIBUTION
12068C              FOR THE FULL SAMPLE CASE.
12069C     EXAMPLE--FRECHET MAXIMUM LIKELIHOOD Y
12070C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
12071C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
12072C                1999, CHAPTER 16.
12073C     WRITTEN BY--JAMES J. FILLIBEN
12074C                 STATISTICAL ENGINEERING DIVISION
12075C                 INFORMATION TECHNOLOGY LABORATORY
12076C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
12077C                 GAITHERSBURG, MD 20899-8980
12078C                 PHONE--301-975-2855
12079C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
12080C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
12081C     LANGUAGE--ANSI FORTRAN (1977)
12082C     VERSION NUMBER--2005/5
12083C     ORIGINAL VERSION--MAY       2005.
12084C     UPDATED         --APRIL     2008. ADD MINMAX ARGUMENT TO SUPPORT
12085C                                       MINIMUM CASE
12086C     UPDATED         --FEBRUARY  2010. EXTRACT POINT ESTIMATES TO
12087C                                       EV2ML1
12088C     UPDATED         --FEBRUARY  2010. USE DPDTA1, DPDTA8, AND
12089C                                       DPDTA9 TO PRINT OUTPUT
12090C
12091C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
12092C
12093      CHARACTER*4 ICAPSW
12094      CHARACTER*4 ICAPTY
12095      CHARACTER*4 IFORSW
12096C
12097      CHARACTER*4 ISUBRO
12098      CHARACTER*4 IBUGA3
12099      CHARACTER*4 IERROR
12100      CHARACTER*4 ISUBN1
12101      CHARACTER*4 ISUBN2
12102      CHARACTER*4 ISTEPN
12103      CHARACTER*4 ILIKFL
12104      CHARACTER*7 ICASE
12105C
12106C---------------------------------------------------------------------
12107C
12108      PARAMETER (NUMALP=8)
12109      DIMENSION ALPHA(NUMALP)
12110      DIMENSION ALOWSC(NUMALP)
12111      DIMENSION AUPPSC(NUMALP)
12112      DIMENSION ALOWGA(NUMALP)
12113      DIMENSION AUPPGA(NUMALP)
12114      DIMENSION ALOWS2(NUMALP)
12115      DIMENSION AUPPS2(NUMALP)
12116      DIMENSION ALOWG2(NUMALP)
12117      DIMENSION AUPPG2(NUMALP)
12118C
12119      DIMENSION Y(*)
12120      DIMENSION XTEMP(*)
12121      DIMENSION QP(*)
12122      DIMENSION XQPHAT(*)
12123      DIMENSION XQPSE(*)
12124      DIMENSION XQPLCL(*)
12125      DIMENSION XQPUCL(*)
12126      DOUBLE PRECISION DTEMP(*)
12127C
12128      DOUBLE PRECISION EV2FU2
12129      DOUBLE PRECISION EV2FU3
12130      EXTERNAL EV2FU2
12131      EXTERNAL EV2FU3
12132C
12133      INTEGER IN2
12134      DOUBLE PRECISION DK
12135      DOUBLE PRECISION DTERM1
12136      DOUBLE PRECISION DTERM2
12137      COMMON/EV2CO2/DK,DTERM1,DTERM2,IN2
12138      INTEGER IN3
12139      DOUBLE PRECISION DK2
12140      DOUBLE PRECISION DTERM6
12141      DOUBLE PRECISION DTERM7
12142      DOUBLE PRECISION DGAMMA
12143      COMMON/EV2CO3/DK2,DTERM6,DTERM7,DGAMMA,IN3
12144C
12145      DOUBLE PRECISION DN
12146      DOUBLE PRECISION DAE
12147      DOUBLE PRECISION DRE
12148      DOUBLE PRECISION DG
12149      DOUBLE PRECISION DS
12150      DOUBLE PRECISION DT1
12151      DOUBLE PRECISION DSUM1
12152      DOUBLE PRECISION DSUM2
12153      DOUBLE PRECISION DXSTRT
12154      DOUBLE PRECISION DXLOW
12155      DOUBLE PRECISION DXUP
12156CCCCC DOUBLE PRECISION XLOWSV
12157CCCCC DOUBLE PRECISION XUPSV
12158C
12159      INCLUDE 'DPCOST.INC'
12160C
12161      PARAMETER (MAXROW=50)
12162      CHARACTER*60 ITITLE
12163      CHARACTER*60 ITITLZ
12164      CHARACTER*40 ITEXT(MAXROW)
12165      REAL         AVALUE(MAXROW)
12166      INTEGER      NCTEXT(MAXROW)
12167      INTEGER      IDIGIT(MAXROW)
12168      INTEGER      NTOT(MAXROW)
12169      LOGICAL IFRST
12170      LOGICAL ILAST
12171C
12172C---------------------------------------------------------------------
12173C
12174      INCLUDE 'DPCOP2.INC'
12175C
12176      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
12177C
12178C-----START POINT-----------------------------------------------------
12179C
12180      ISUBN1='DPML'
12181      ISUBN2='FR  '
12182      IERROR='NO'
12183C
12184      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLFR')THEN
12185        WRITE(ICOUT,999)
12186  999   FORMAT(1X)
12187        CALL DPWRST('XXX','WRIT')
12188        WRITE(ICOUT,51)
12189   51   FORMAT('**** AT THE BEGINNING OF DPMLFR--')
12190        CALL DPWRST('XXX','WRIT')
12191        WRITE(ICOUT,52)IBUGA3,ISUBRO,IFREBC,N,NPERC,IOUNI2,MAXNXT
12192   52   FORMAT('IBUGA3,ISUBRO,IFREBC,N,NPERC,IOUNI2,MAXNXT = ',
12193     1         3(A4,2X),4I8)
12194        CALL DPWRST('XXX','WRIT')
12195        DO56I=1,MIN(N,100)
12196          WRITE(ICOUT,57)I,Y(I)
12197   57     FORMAT('I,Y(I) = ',I8,G15.7)
12198          CALL DPWRST('XXX','WRIT')
12199   56   CONTINUE
12200      ENDIF
12201C
12202C               ********************************************
12203C               **  STEP 11--                             **
12204C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
12205C               ********************************************
12206C
12207      ISTEPN='11'
12208      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLFR')
12209     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12210C
12211      NMIN=3
12212      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
12213      IF(IERROR.EQ.'YES')GOTO9000
12214C
12215C               **********************************
12216C               **  STEP 41--                   **
12217C               **  CARRY OUT CALCULATIONS      **
12218C               **  FOR FRECHET MLE             **
12219C               **  ESTIMATE (FULL SAMPLE CASE) **
12220C               **********************************
12221C
12222      CALL EV2ML1(Y,N,MINMAX,
12223     1            XTEMP,DTEMP,
12224     1            XMEAN,XSD,XVAR,XMIN,XMAX,XLOGSD,XLOGSM,
12225     1            SCALE,SCALSE,GAMMA,GAMMSE,
12226     1            GAMMBC,GABCSE,COVSE,COBCSE,
12227     1            ISUBRO,IBUGA3,IERROR)
12228C
12229C  CONFIDENCE INTERVALS FOR PARAMETERS.  CAN BASE ON EITHER NORMAL
12230C  APPROXIMATION OR ON LIKELIHOOD RATIO APPROXIMATION.
12231C
12232C  NORMAL APPROXIMATION FIRST.
12233C
12234      DO4110I=1,NUMALP
12235        ALP=ALPHA(I)
12236        P=1.0-(ALP/2.0)
12237        CALL NORPPF(P,PPF)
12238        ALOWSC(I)=SCALE - PPF*SCALSE
12239        AUPPSC(I)=SCALE + PPF*SCALSE
12240        IF(IFREBC.EQ.'ON')THEN
12241          ALOWGA(I)=GAMMBC - PPF*GABCSE
12242          AUPPGA(I)=GAMMBC + PPF*GABCSE
12243        ELSE
12244          ALOWGA(I)=GAMMA - PPF*GAMMSE
12245          AUPPGA(I)=GAMMA + PPF*GAMMSE
12246        ENDIF
12247 4110 CONTINUE
12248C
12249C  NOW DO LIKELIHOOD RATIO APPROXIMATION.
12250C
12251      IN2=N
12252      IN3=N
12253      DN=DBLE(N)
12254      DAE=1.D-7
12255      DRE=1.D-7
12256      NUTEMP=1
12257C
12258      DN=DBLE(N)
12259      DG=DBLE(GAMMA)
12260      DS=DBLE(SCALE)
12261      DT1=DN*DLOG(DBLE(GAMMA)) + DN*DG*DLOG(DS)
12262      DSUM1=0.0D0
12263      DSUM2=0.0D0
12264      DO4125I=1,N
12265        DTEMP(I)=DBLE(Y(I))
12266        DSUM1=DSUM1 + DLOG(DBLE(Y(I)))
12267        DSUM2=DSUM2 + DBLE(Y(I))**(-DG)
12268 4125 CONTINUE
12269      DTERM2=DSUM1
12270      DTERM1=2.0D0*(DT1 - (DG+1.0D0)*DTERM2 - DS**DG*DSUM2)
12271      DTERM7=DTERM2
12272      DTERM6=DTERM1
12273      DGAMMA=DBLE(GAMMA)
12274C
12275      DO4120I=1,NUMALP
12276        ALP=ALPHA(I)
12277        CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
12278        DK=DBLE(APPF)
12279        DK2=DK
12280C
12281        DXSTRT=DBLE(ALOWGA(I))
12282        DXLOW=DXSTRT/5.0D0
12283        DXUP=DBLE(GAMMA)
12284        CALL DFZER2(EV2FU2,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
12285        ALOWG2(I)=REAL(DXLOW)
12286C
12287        DXSTRT=DBLE(AUPPGA(I))
12288        DXUP=DXSTRT*5.0D0
12289        DXLOW=DBLE(GAMMA)
12290        CALL DFZER2(EV2FU2,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
12291        AUPPG2(I)=REAL(DXLOW)
12292C
12293        DXSTRT=DBLE(ALOWSC(I))
12294        DXLOW=DXSTRT/5.0D0
12295        DXUP=DBLE(SCALE)
12296        CALL DFZER2(EV2FU3,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
12297        ALOWS2(I)=REAL(DXLOW)
12298C
12299        DXSTRT=DBLE(AUPPSC(I))
12300        DXUP=DXSTRT*5.0D0
12301        DXLOW=DBLE(SCALE)
12302        CALL DFZER2(EV2FU3,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
12303        AUPPS2(I)=REAL(DXLOW)
12304 4120 CONTINUE
12305C
12306C  CONFIDENCE INTERVALS FOR SELECTED PERCENTILES.
12307C
12308C  1. STANDARD ERROR USES TECHNIQUE DEMONSTRATED IN EXAMPLE 17.4
12309C     (P. 344) OF BURY.  THIS IS BASED ON PROPOGATION OF ERROR.
12310C
12311C  2. CONFIDENCE INTERVAL IS THEN GENERATED USING NORMAL
12312C     APPROXIMATION (EXAMPLE 17.7 OF BURY).  BURY ALSO DEMONSTRATES
12313C     A LIKELIHOOD RATIO APPROACH, BUT OMIT THIS FOR NOW.
12314C
12315      IF(NPERC.GE.1)THEN
12316C
12317        ALPHL=ALPHAP/2.0
12318        ALPHU=1.0 - ALPHAP/2.0
12319        CALL NORPPF(ALPHU,Z95)
12320        MINMAX=2
12321C
12322        IF(IFREBC.EQ.'ON')THEN
12323          G=GAMMBC
12324          GSE=GABCSE
12325          COV=COBCSE
12326        ELSE
12327          G=GAMMA
12328          GSE=GAMMSE
12329          COV=COVSE
12330        ENDIF
12331C
12332        WRITE(IOUNI1,4131)
12333        WRITE(IOUNI1,4132)
12334        DO4129I=1,NPERC
12335          QPTEMP=QP(I)/100.0
12336          CALL EV2PPF(QPTEMP,G,MINMAX,APPF)
12337          XQPHAT(I)=SCALE*APPF
12338C
12339          C=LOG(1.0/QPTEMP)
12340          DA=C**(-1.0/G)
12341          DB=(SCALE*C**(-1.0/G)*LOG(C)/(G**2))
12342          TERM1=(DA*SCALSE)**2
12343          TERM2=(DB*GSE)**2
12344          TERM3=2.0*DA*DB*COV*COV
12345          SEXQP=SQRT(TERM1 + TERM2 + TERM3)
12346          XQPSE(I)=SEXQP
12347          XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
12348          XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
12349          WRITE(IOUNI1,'(5E15.7)')
12350     1         QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
12351 4129   CONTINUE
12352 4131   FORMAT(15X,'       POINT     ','     LOWER     ',
12353     1         '     UPPER')
12354 4132   FORMAT('    PERCENTILE ','     ESTIMATE   ',
12355     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
12356      ENDIF
12357C
12358C               *************************************
12359C               **   STEP 42--                     **
12360C               **   WRITE OUT EVERYTHING          **
12361C               **   FOR FRECHET MLE ESTIMATE      **
12362C               *************************************
12363C
12364      ISTEPN='42'
12365      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLFR')
12366     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12367C
12368C     PRINT SUMMARY STATISTICS TABLE
12369C
12370      IF(IPRINT.EQ.'OFF')GOTO9000
12371C
12372      NUMDIG=7
12373      IF(IFORSW.EQ.'1')NUMDIG=1
12374      IF(IFORSW.EQ.'2')NUMDIG=2
12375      IF(IFORSW.EQ.'3')NUMDIG=3
12376      IF(IFORSW.EQ.'4')NUMDIG=4
12377      IF(IFORSW.EQ.'5')NUMDIG=5
12378      IF(IFORSW.EQ.'6')NUMDIG=6
12379      IF(IFORSW.EQ.'7')NUMDIG=7
12380      IF(IFORSW.EQ.'8')NUMDIG=8
12381      IF(IFORSW.EQ.'9')NUMDIG=9
12382      IF(IFORSW.EQ.'0')NUMDIG=0
12383      IF(IFORSW.EQ.'E')NUMDIG=-2
12384      IF(IFORSW.EQ.'-2')NUMDIG=-2
12385      IF(IFORSW.EQ.'-3')NUMDIG=-3
12386      IF(IFORSW.EQ.'-4')NUMDIG=-4
12387      IF(IFORSW.EQ.'-5')NUMDIG=-5
12388      IF(IFORSW.EQ.'-6')NUMDIG=-6
12389      IF(IFORSW.EQ.'-7')NUMDIG=-7
12390      IF(IFORSW.EQ.'-8')NUMDIG=-8
12391      IF(IFORSW.EQ.'-9')NUMDIG=-9
12392C
12393      ICASE='MINIMUM'
12394      IF(MINMAX.EQ.2)ICASE='MAXIMUM'
12395C
12396      IF(ICASE.EQ.'MINIMUM')THEN
12397        ITITLE='Two-Parameter Frechet (Minimum) Parameter Estimation:'
12398        NCTITL=53
12399        ITITLZ='Full Sample Case'
12400        NCTITZ=16
12401      ELSEIF(ICASE.EQ.'MAXIMUM')THEN
12402        ITITLE='Two-Parameter Frechet (Maximum) Parameter Estimation:'
12403        NCTITL=53
12404        ITITLZ='Full Sample Case'
12405        NCTITZ=16
12406      ENDIF
12407      ITEXT(1)='Summary Statistics:'
12408      NCTEXT(1)=19
12409      AVALUE(1)=0.0
12410      IDIGIT(1)=-1
12411      ITEXT(2)='Number of Observations:'
12412      NCTEXT(2)=23
12413      AVALUE(2)=REAL(N)
12414      IDIGIT(2)=0
12415      ITEXT(3)='Sample Mean:'
12416      NCTEXT(3)=12
12417      AVALUE(3)=XMEAN
12418      IDIGIT(3)=NUMDIG
12419      ITEXT(4)='Sample Standard Deviation:'
12420      NCTEXT(4)=26
12421      AVALUE(4)=XSD
12422      IDIGIT(4)=NUMDIG
12423      ITEXT(5)='Sample Minimum:'
12424      NCTEXT(5)=15
12425      AVALUE(5)=XMIN
12426      IDIGIT(5)=NUMDIG
12427      ITEXT(6)='Sample Maximum:'
12428      NCTEXT(6)=15
12429      AVALUE(6)=XMAX
12430      IDIGIT(6)=NUMDIG
12431      NUMROW=6
12432      DO2310I=1,NUMROW
12433        NTOT(I)=15
12434 2310 CONTINUE
12435      NTOT(2)=8
12436C
12437      IFRST=.TRUE.
12438      ILAST=.FALSE.
12439      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
12440     1            NCTEXT,AVALUE,IDIGIT,
12441     1            NTOT,NUMROW,
12442     1            ICAPSW,ICAPTY,ILAST,IFRST,
12443     1            ISUBRO,IBUGA3,IERROR)
12444      IFRST=.FALSE.
12445      ITITLE=' '
12446      NCTITL=0
12447C
12448      ITEXT(1)='Maximum Likelihood:'
12449      NCTEXT(1)=19
12450      AVALUE(1)=0.0
12451      IDIGIT(1)=0
12452      ITEXT(2)='Estimate of Shape (Gamma):'
12453      NCTEXT(2)=26
12454      AVALUE(2)=GAMMA
12455      IDIGIT(2)=NUMDIG
12456      ITEXT(3)='Standard Error of Shape:'
12457      NCTEXT(3)=24
12458      AVALUE(3)=GAMMSE
12459      IDIGIT(3)=NUMDIG
12460      ICNT=3
12461      ITEXT(4)='Estimate of Scale:'
12462      NCTEXT(4)=18
12463      AVALUE(4)=SCALE
12464      IDIGIT(4)=NUMDIG
12465      ITEXT(5)='Standard Error of Scale:'
12466      NCTEXT(5)=24
12467      AVALUE(5)=SCALSE
12468      IDIGIT(5)=NUMDIG
12469      ITEXT(6)='Shape/Scale Covariance:'
12470      NCTEXT(6)=23
12471      AVALUE(6)=COVSE
12472      IDIGIT(6)=NUMDIG
12473C
12474      ICNT=6
12475C
12476CCCCC ICNT=ICNT+1
12477CCCCC ITEXT(ICNT)='Log-likelihood:'
12478CCCCC NCTEXT(ICNT)=15
12479CCCCC AVALUE(ICNT)=ALIK
12480CCCCC IDIGIT(ICNT)=-7
12481CCCCC ICNT=ICNT+1
12482CCCCC ITEXT(ICNT)='AIC:'
12483CCCCC NCTEXT(ICNT)=4
12484CCCCC AVALUE(ICNT)=AIC
12485CCCCC IDIGIT(ICNT)=-7
12486CCCCC ICNT=ICNT+1
12487CCCCC ITEXT(ICNT)='AICc:'
12488CCCCC NCTEXT(ICNT)=5
12489CCCCC AVALUE(ICNT)=AICC
12490CCCCC IDIGIT(ICNT)=-7
12491CCCCC ICNT=ICNT+1
12492CCCCC ITEXT(ICNT)='BIC:'
12493CCCCC NCTEXT(ICNT)=4
12494CCCCC AVALUE(ICNT)=BIC
12495CCCCC IDIGIT(ICNT)=-7
12496C
12497      ICNT=ICNT+1
12498      ITEXT(ICNT)=' '
12499      NCTEXT(ICNT)=0
12500      AVALUE(ICNT)=0.0
12501      IDIGIT(ICNT)=-1
12502      ICNT=ICNT+1
12503      ITEXT(ICNT)='Maximum Likelihood (Bias Corrected):'
12504      NCTEXT(ICNT)=36
12505      AVALUE(ICNT)=0.0
12506      IDIGIT(ICNT)=-1
12507      ICNT=ICNT+1
12508      ITEXT(ICNT)='Estimate of Shape (Gamma):'
12509      NCTEXT(ICNT)=26
12510      AVALUE(ICNT)=GAMMBC
12511      IDIGIT(ICNT)=NUMDIG
12512      ICNT=ICNT+1
12513      ITEXT(ICNT)='Standard Error of Shape:'
12514      NCTEXT(ICNT)=24
12515      AVALUE(ICNT)=GABCSE
12516      IDIGIT(ICNT)=NUMDIG
12517      ICNT=ICNT+1
12518      ITEXT(ICNT)='Estimate of Scale:'
12519      NCTEXT(ICNT)=18
12520      AVALUE(ICNT)=SCALE
12521      IDIGIT(ICNT)=NUMDIG
12522      ICNT=ICNT+1
12523      ITEXT(ICNT)='Standard Error of Scale:'
12524      NCTEXT(ICNT)=24
12525      AVALUE(ICNT)=SCALSE
12526      IDIGIT(ICNT)=NUMDIG
12527      ICNT=ICNT+1
12528      ITEXT(ICNT)='Shape/Scale Covariance:'
12529      NCTEXT(ICNT)=23
12530      AVALUE(ICNT)=COVSE
12531      IDIGIT(ICNT)=NUMDIG
12532C
12533      NUMROW=ICNT
12534      DO2320I=1,NUMROW
12535        NTOT(I)=15
12536 2320 CONTINUE
12537C
12538      IFRST=.FALSE.
12539      ILAST=.FALSE.
12540      ITITLZ=' '
12541      NCTITZ=0
12542      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
12543     1            AVALUE,IDIGIT,
12544     1            NTOT,NUMROW,
12545     1            ICAPSW,ICAPTY,ILAST,IFRST,
12546     1            ISUBRO,IBUGA3,IERROR)
12547C
12548      ILIKFL='ON'
12549      CALL DPDTA8(ALOWSC,AUPPSC,ALOWS2,AUPPS2,
12550     1            ALOWGA,AUPPGA,ALOWG2,AUPPG2,ALPHA,NUMALP,
12551     1            ICAPSW,ICAPTY,NUMDIG,ILIKFL,
12552     1            ISUBRO,IBUGA3,IERROR)
12553C
12554      IF(NPERC.GT.1)THEN
12555        ILIKFL='OFF'
12556        CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
12557     1              ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
12558     1              ISUBRO,IBUGA3,IERROR)
12559
12560      ENDIF
12561C
12562C               *****************
12563C               **  STEP 90--  **
12564C               **  EXIT       **
12565C               *****************
12566C
12567 9000 CONTINUE
12568      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLFR')THEN
12569        WRITE(ICOUT,999)
12570        CALL DPWRST('XXX','WRIT')
12571        WRITE(ICOUT,9011)
12572 9011   FORMAT('***** AT THE END       OF DPMLFR--')
12573        CALL DPWRST('XXX','WRIT')
12574        WRITE(ICOUT,9012)N,IBUGA3,IERROR
12575 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
12576        CALL DPWRST('XXX','WRIT')
12577        WRITE(ICOUT,9015)N
12578 9015   FORMAT('N = ',I8)
12579        CALL DPWRST('XXX','WRIT')
12580      ENDIF
12581C
12582      RETURN
12583      END
12584      SUBROUTINE DPMLF3(Y,N,ICASPL,MAXNXT,MINMAX,
12585     1                  TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,
12586     1                  DTEMP1,XMOM,
12587     1                  QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
12588     1                  ALOCLM,SCALLM,SHAPLM,
12589     1                  ALOCEP,SCALEP,SHAPEP,
12590     1                  ALOCML,SCALML,SHAPML,
12591     1                  ICAPSW,ICAPTY,IFORSW,
12592     1                  IOUNI1,IOUNI2,ISEED,ALPHA,
12593     1                  MLFLAG,ISUBRO,IBUGA3,IERROR)
12594C
12595C     PURPOSE--THIS ROUTINE COMPUTES PARAMETER ESTIMATES FOR THE
12596C              GENERALIZED EXTREME VALUE DISTRIBUTION USING THE
12597C              FOLLOWING METHODS:
12598C
12599C              1) L-MOMENTS
12600C              2) ELEMENTAL PERCENTILES
12601C              3) MAXIMUM LIKELIHOOD
12602C
12603C                 NOTE: I AM HAVING PROBLEMS WITH HOSKINGS MAXIMUM
12604C                 LIKELIHOOD ROUTINE.  FOR NOW, BYPASS ML ESTIMATION.
12605C                 IF I GET THIS WORKING BETTER, THEN I WILL
12606C                 RE-ACTIVATE IT.
12607C
12608C     EXAMPLE--GENERALIZED EXTREME VALUE MAXIMUM LIKELIHOOD Y
12609C     REFERENCES--JOHNSON, KOTZ, AND BALAKRISHNAN.  "CONTINUOUS
12610C                 UNIVARIATE DISTRIBUTIONS, VOLUME I", SECOND
12611C                 EDITION, WILEY, 1994, PP. 614-619.
12612C               --HOSKING, ALGORITHM AS215   APPL. STATIST. (1985)
12613C                 VOL. 34, NO. 3, Modifications in AS R76 (1989)
12614C                 have been incorporated.
12615C               --CASTILLO, HADI, BALAKRISHNAN, SARABIA, "EXTREME
12616C                 VALUE AND RELATED MODELS WITH APPLICATIONS IN
12617C                 ENGINEERING AND SCIENCE", WILEY, 2005.
12618C               --FORTRAN CODE WRITTEN FOR INCLUSION IN IBM
12619C                 RESEARCH REPORT RC20525, 'FORTRAN ROUTINES FOR
12620C                 USE WITH THE METHOD OF L-MOMENTS, VERSION 3',
12621C                 J. R. M. HOSKING, IBM RESEARCH DIVISION,
12622C                 T. J. WATSON RESEARCH CENTER, YORKTOWN HEIGHTS
12623C                 NEW YORK 10598, U.S.A., VERSION 3     AUGUST 1996
12624C     WRITTEN BY--ALAN HECKERT
12625C                 STATISTICAL ENGINEERING DIVISION
12626C                 INFORMATION TECHNOLOGY LABORATORY
12627C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
12628C                 GAITHERSBUG, MD 20899-8980
12629C                 PHONE--301-975-2899
12630C     LANGUAGE--ANSI FORTRAN (1977)
12631C     VERSION NUMBER--2014/10
12632C     ORIGINAL VERSION--OCTOBER   2014.
12633C
12634C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
12635C
12636      CHARACTER*4 ICAPSW
12637      CHARACTER*4 ICAPTY
12638      CHARACTER*4 IFORSW
12639      CHARACTER*4 ISUBRO
12640      CHARACTER*4 IBUGA3
12641      CHARACTER*4 IERROR
12642C
12643      CHARACTER*4 IWRITE
12644      CHARACTER*4 ICASPL
12645      CHARACTER*4 IDFTZZ
12646      CHARACTER*4 ISUBN1
12647      CHARACTER*4 ISUBN2
12648      CHARACTER*4 ISTEPN
12649C
12650      LOGICAL MLFLAG
12651C
12652C---------------------------------------------------------------------
12653C
12654      DIMENSION Y(*)
12655      DIMENSION TEMP1(*)
12656      DIMENSION TEMP2(*)
12657      DIMENSION TEMP3(*)
12658      DIMENSION TEMP4(*)
12659      DIMENSION TEMP5(*)
12660      DOUBLE PRECISION DTEMP1(*)
12661      DOUBLE PRECISION XMOM(*)
12662C
12663      DIMENSION QP(*)
12664      DIMENSION XQPHAT(*)
12665      DIMENSION XQPSE(*)
12666      DIMENSION XQPLCL(*)
12667      DIMENSION XQPUCL(*)
12668C
12669      DOUBLE PRECISION VARCOV(6)
12670C
12671      INCLUDE 'DPCOST.INC'
12672C
12673      PARAMETER (MAXROW=40)
12674      CHARACTER*60 ITITLE
12675      CHARACTER*60 ITITLZ
12676      CHARACTER*40 ITEXT(MAXROW)
12677      REAL         AVALUE(MAXROW)
12678      INTEGER      NCTEXT(MAXROW)
12679      INTEGER      IDIGIT(MAXROW)
12680      INTEGER      NTOT(MAXROW)
12681      LOGICAL IFRST
12682      LOGICAL ILAST
12683C
12684C---------------------------------------------------------------------
12685C
12686      INCLUDE 'DPCOP2.INC'
12687C
12688C-----START POINT-----------------------------------------------------
12689C
12690      ISUBN1='DPML'
12691      ISUBN2='F3  '
12692      IERROR='NO'
12693C
12694      DO11I=1,1000
12695        QP(I)=CPUMIN
12696        XQPHAT(I)=CPUMIN
12697        XQPLCL(I)=CPUMIN
12698        XQPUCL(I)=CPUMIN
12699        XQPSE(I)=CPUMIN
12700   11 CONTINUE
12701C
12702      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLF3')THEN
12703        WRITE(ICOUT,999)
12704  999   FORMAT(1X)
12705        CALL DPWRST('XXX','WRIT')
12706        WRITE(ICOUT,51)
12707   51   FORMAT('**** AT THE BEGINNING OF DPMLF3--')
12708        CALL DPWRST('XXX','WRIT')
12709        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,MINMAX,IOUNI1,IOUNI2,ALPHA
12710   52   FORMAT('IBUGA3,ISUBRO,N,MINMAX,IOUNI1,IOUNI2,ALPHA = ',
12711     1         2(A4,2X),4I8,G15.7)
12712        CALL DPWRST('XXX','WRIT')
12713        DO56I=1,MIN(N,100)
12714          WRITE(ICOUT,57)I,Y(I)
12715   57     FORMAT('I,Y(I) = ',I8,G15.7)
12716          CALL DPWRST('XXX','WRIT')
12717   56   CONTINUE
12718      ENDIF
12719C
12720C               ***************************************************
12721C               **  STEP 21--                                    **
12722C               **  CARRY OUT CALCULATIONS                       **
12723C               **  FOR GENERALIZED EXTREME VALUE MOMENT/MLE     **
12724C               **  ESTIMATION                                   **
12725C               ***************************************************
12726C
12727      ISTEPN='21'
12728      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLF3')
12729     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12730C
12731      NMIN=5
12732      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
12733      IF(IERROR.EQ.'YES')GOTO9000
12734C
12735      IERROR='NO'
12736      IWRITE='OFF'
12737      IDFTZZ='ALL'
12738C
12739      MLFLAG=.TRUE.
12740      CALL EV2ML3(Y,N,MINMAX,MAXNXT,ISEED,IDFTZZ,IGEVML,
12741     1            TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,DTEMP1,
12742     1            XMOM,NMOM,VARCOV,
12743     1            XMEAN,XSD,XVAR,XMIN,XMAX,XSKEW,
12744     1            ALOCML,SCALML,SHAPML,
12745     1            ALOCLM,SCALLM,SHAPLM,
12746     1            ALOCEP,SCALEP,SHAPEP,
12747     1            ISUBRO,IBUGA3,IERROR)
12748C
12749      IF(SHAPLM.GT.0.0)THEN
12750        CALL EV2LI1(Y,N,ICASPL,MINMAX,
12751     1              ALOCLM,SCALLM,SHAPLM,
12752     1              ALIKLM,AICLM,AICCLM,BICLM,
12753     1              ISUBRO,IBUGA3,IERROR)
12754      ELSE
12755        ALIKLM=CPUMIN
12756        AICLM=CPUMIN
12757        AICCLM=CPUMIN
12758        BICLM=CPUMIN
12759      ENDIF
12760C
12761      IF(SHAPEP.GT.0.0)THEN
12762        CALL EV2LI1(Y,N,ICASPL,MINMAX,
12763     1              ALOCEP,SCALEP,SHAPEP,
12764     1              ALIKEP,AICEP,AICCEP,BICEP,
12765     1              ISUBRO,IBUGA3,IERROR)
12766      ELSE
12767        ALIKEP=CPUMIN
12768        AICEP=CPUMIN
12769        AICCEP=CPUMIN
12770        BICEP=CPUMIN
12771      ENDIF
12772C
12773      IF(SHAPML.GT.0.0)THEN
12774        CALL EV2LI1(Y,N,ICASPL,MINMAX,
12775     1              ALOCML,SCALML,SHAPML,
12776     1              ALIKML,AICML,AICCML,BICML,
12777     1              ISUBRO,IBUGA3,IERROR)
12778      ELSE
12779        ALIKML=CPUMIN
12780        AICML=CPUMIN
12781        AICCML=CPUMIN
12782        BICML=CPUMIN
12783      ENDIF
12784C
12785C               ***********************************************
12786C               **   STEP 42--                               **
12787C               **   WRITE OUT EVERYTHING                    **
12788C               **   FOR FRECHET MLE ESTIMATION              **
12789C               ***********************************************
12790C
12791      ISTEPN='42'
12792      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLF3')
12793     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12794C
12795      IF(IPRINT.EQ.'OFF')GOTO9000
12796C
12797      NUMDIG=7
12798      IF(IFORSW.EQ.'1')NUMDIG=1
12799      IF(IFORSW.EQ.'2')NUMDIG=2
12800      IF(IFORSW.EQ.'3')NUMDIG=3
12801      IF(IFORSW.EQ.'4')NUMDIG=4
12802      IF(IFORSW.EQ.'5')NUMDIG=5
12803      IF(IFORSW.EQ.'6')NUMDIG=6
12804      IF(IFORSW.EQ.'7')NUMDIG=7
12805      IF(IFORSW.EQ.'8')NUMDIG=8
12806      IF(IFORSW.EQ.'9')NUMDIG=9
12807      IF(IFORSW.EQ.'0')NUMDIG=0
12808      IF(IFORSW.EQ.'E')NUMDIG=-2
12809      IF(IFORSW.EQ.'-2')NUMDIG=-2
12810      IF(IFORSW.EQ.'-3')NUMDIG=-3
12811      IF(IFORSW.EQ.'-4')NUMDIG=-4
12812      IF(IFORSW.EQ.'-5')NUMDIG=-5
12813      IF(IFORSW.EQ.'-6')NUMDIG=-6
12814      IF(IFORSW.EQ.'-7')NUMDIG=-7
12815      IF(IFORSW.EQ.'-8')NUMDIG=-8
12816      IF(IFORSW.EQ.'-9')NUMDIG=-9
12817C
12818      ITITLE='Extreme Value Type II (Frechet) Parameter Estimation'
12819      NCTITL=52
12820      IF(MINMAX.EQ.1)THEN
12821        ITITLZ='(Minimum Case)'
12822        NCTITZ=14
12823      ELSE
12824        ITITLZ='(Maximum Case)'
12825        NCTITZ=14
12826      ENDIF
12827      ICNT=1
12828      ITEXT(ICNT)='Summary Statistics:'
12829      NCTEXT(ICNT)=19
12830      AVALUE(ICNT)=0.0
12831      IDIGIT(ICNT)=-1
12832      ICNT=ICNT+1
12833      ITEXT(ICNT)='Number of Observations:'
12834      NCTEXT(ICNT)=23
12835      AVALUE(ICNT)=REAL(N)
12836      IDIGIT(ICNT)=0
12837      ICNT=ICNT+1
12838      ITEXT(ICNT)='Sample Mean:'
12839      NCTEXT(ICNT)=12
12840      AVALUE(ICNT)=XMEAN
12841      IDIGIT(ICNT)=NUMDIG
12842      ICNT=ICNT+1
12843      ITEXT(ICNT)='Sample Standard Deviation:'
12844      NCTEXT(ICNT)=26
12845      AVALUE(ICNT)=XSD
12846      IDIGIT(ICNT)=NUMDIG
12847      ICNT=ICNT+1
12848      ITEXT(ICNT)='Sample Skewness:'
12849      NCTEXT(ICNT)=16
12850      AVALUE(ICNT)=XSKEW
12851      IDIGIT(ICNT)=NUMDIG
12852      ICNT=ICNT+1
12853      ITEXT(ICNT)='Sample Minimum:'
12854      NCTEXT(ICNT)=15
12855      AVALUE(ICNT)=XMIN
12856      IDIGIT(ICNT)=NUMDIG
12857      ICNT=ICNT+1
12858      ITEXT(ICNT)='Sample Maximum:'
12859      NCTEXT(ICNT)=15
12860      AVALUE(ICNT)=XMAX
12861      IDIGIT(ICNT)=NUMDIG
12862      ICNT=ICNT+1
12863      ITEXT(ICNT)=' '
12864      NCTEXT(ICNT)=0
12865      AVALUE(ICNT)=0.0
12866      IDIGIT(ICNT)=-1
12867C
12868      ICNT=ICNT+1
12869      ITEXT(ICNT)='First Sample L-Moment:'
12870      NCTEXT(ICNT)=22
12871      AVALUE(ICNT)=REAL(XMOM(1))
12872      IDIGIT(ICNT)=NUMDIG
12873      ICNT=ICNT+1
12874      ITEXT(ICNT)='Second Sample L-Moment:'
12875      NCTEXT(ICNT)=23
12876      AVALUE(ICNT)=REAL(XMOM(2))
12877      IDIGIT(ICNT)=NUMDIG
12878      ICNT=ICNT+1
12879      ITEXT(ICNT)='Third Sample L-Moment:'
12880      NCTEXT(ICNT)=22
12881      AVALUE(ICNT)=REAL(XMOM(3))
12882      IDIGIT(ICNT)=NUMDIG
12883      ICNT=ICNT+1
12884      ITEXT(ICNT)=' '
12885      NCTEXT(ICNT)=0
12886      AVALUE(ICNT)=0.0
12887      IDIGIT(ICNT)=-1
12888C
12889      ICNT=ICNT+1
12890      ITEXT(ICNT)='Method of L-Moments:'
12891      NCTEXT(ICNT)=20
12892      AVALUE(ICNT)=0.0
12893      IDIGIT(ICNT)=-1
12894      ICNT=ICNT+1
12895      ITEXT(ICNT)='Estimate of Location:'
12896      NCTEXT(ICNT)=22
12897      AVALUE(ICNT)=ALOCLM
12898      IDIGIT(ICNT)=NUMDIG
12899      ICNT=ICNT+1
12900      ITEXT(ICNT)='Estimate of Scale:'
12901      NCTEXT(ICNT)=18
12902      AVALUE(ICNT)=SCALLM
12903      IDIGIT(ICNT)=NUMDIG
12904      ICNT=ICNT+1
12905      ITEXT(ICNT)='Estimate of Shape (Gamma):'
12906      NCTEXT(ICNT)=26
12907      AVALUE(ICNT)=SHAPLM
12908      IDIGIT(ICNT)=NUMDIG
12909C
12910      IF(ALIKLM.NE.CPUMIN)THEN
12911        ICNT=ICNT+1
12912        ITEXT(ICNT)='Log-likelihood:'
12913        NCTEXT(ICNT)=15
12914        AVALUE(ICNT)=ALIKLM
12915        IDIGIT(ICNT)=-7
12916        ICNT=ICNT+1
12917        ITEXT(ICNT)='AIC:'
12918        NCTEXT(ICNT)=4
12919        AVALUE(ICNT)=AICLM
12920        IDIGIT(ICNT)=-7
12921        ICNT=ICNT+1
12922        ITEXT(ICNT)='AICc:'
12923        NCTEXT(ICNT)=5
12924        AVALUE(ICNT)=AICCLM
12925        IDIGIT(ICNT)=-7
12926        ICNT=ICNT+1
12927        ITEXT(ICNT)='BIC:'
12928        NCTEXT(ICNT)=4
12929        AVALUE(ICNT)=BICLM
12930        IDIGIT(ICNT)=-7
12931      ENDIF
12932      ICNT=ICNT+1
12933      ITEXT(ICNT)=' '
12934      NCTEXT(ICNT)=0
12935      AVALUE(ICNT)=0.0
12936      IDIGIT(ICNT)=-1
12937C
12938      ICNT=ICNT+1
12939      ITEXT(ICNT)='Method of Elemental Percentiles:'
12940      NCTEXT(ICNT)=32
12941      AVALUE(ICNT)=0.0
12942      IDIGIT(ICNT)=-1
12943      ICNT=ICNT+1
12944      ITEXT(ICNT)='Estimate of Location:'
12945      NCTEXT(ICNT)=22
12946      AVALUE(ICNT)=ALOCEP
12947      IDIGIT(ICNT)=NUMDIG
12948      ICNT=ICNT+1
12949      ITEXT(ICNT)='Estimate of Scale:'
12950      NCTEXT(ICNT)=18
12951      AVALUE(ICNT)=SCALEP
12952      IDIGIT(ICNT)=NUMDIG
12953      ICNT=ICNT+1
12954      ITEXT(ICNT)='Estimate of Shape (Gamma):'
12955      NCTEXT(ICNT)=26
12956      AVALUE(ICNT)=SHAPEP
12957      IDIGIT(ICNT)=NUMDIG
12958C
12959      IF(ALIKEP.NE.CPUMIN)THEN
12960        ICNT=ICNT+1
12961        ITEXT(ICNT)='Log-likelihood:'
12962        NCTEXT(ICNT)=15
12963        AVALUE(ICNT)=ALIKEP
12964        IDIGIT(ICNT)=-7
12965        ICNT=ICNT+1
12966        ITEXT(ICNT)='AIC:'
12967        NCTEXT(ICNT)=4
12968        AVALUE(ICNT)=AICEP
12969        IDIGIT(ICNT)=-7
12970        ICNT=ICNT+1
12971        ITEXT(ICNT)='AICc:'
12972        NCTEXT(ICNT)=5
12973        AVALUE(ICNT)=AICCEP
12974        IDIGIT(ICNT)=-7
12975        ICNT=ICNT+1
12976        ITEXT(ICNT)='BIC:'
12977        NCTEXT(ICNT)=4
12978        AVALUE(ICNT)=BICEP
12979        IDIGIT(ICNT)=-7
12980      ENDIF
12981      ICNT=ICNT+1
12982      ITEXT(ICNT)=' '
12983      NCTEXT(ICNT)=0
12984      AVALUE(ICNT)=0.0
12985      IDIGIT(ICNT)=-1
12986C
12987      IF(MLFLAG .AND. SHAPML.GT.0.0)THEN
12988        ICNT=ICNT+1
12989        ITEXT(ICNT)='Maximum Likelihood:'
12990        NCTEXT(ICNT)=19
12991        AVALUE(ICNT)=0.0
12992        IDIGIT(ICNT)=-1
12993        ICNT=ICNT+1
12994        ITEXT(ICNT)='Estimate of Location:'
12995        NCTEXT(ICNT)=22
12996        AVALUE(ICNT)=ALOCML
12997        IDIGIT(ICNT)=NUMDIG
12998        ICNT=ICNT+1
12999        ITEXT(ICNT)='Estimate of Scale:'
13000        NCTEXT(ICNT)=18
13001        AVALUE(ICNT)=SCALML
13002        IDIGIT(ICNT)=NUMDIG
13003        ICNT=ICNT+1
13004        ITEXT(ICNT)='Estimate of Shape (Gamma):'
13005        NCTEXT(ICNT)=26
13006        AVALUE(ICNT)=SHAPML
13007        IDIGIT(ICNT)=NUMDIG
13008C
13009        IF(ALIKML.NE.CPUMIN)THEN
13010          ICNT=ICNT+1
13011          ITEXT(ICNT)='Log-likelihood:'
13012          NCTEXT(ICNT)=15
13013          AVALUE(ICNT)=ALIKML
13014          IDIGIT(ICNT)=-7
13015          ICNT=ICNT+1
13016          ITEXT(ICNT)='AIC:'
13017          NCTEXT(ICNT)=4
13018          AVALUE(ICNT)=AICML
13019          IDIGIT(ICNT)=-7
13020          ICNT=ICNT+1
13021          ITEXT(ICNT)='AICc:'
13022          NCTEXT(ICNT)=5
13023          AVALUE(ICNT)=AICCML
13024          IDIGIT(ICNT)=-7
13025          ICNT=ICNT+1
13026          ITEXT(ICNT)='BIC:'
13027          NCTEXT(ICNT)=4
13028          AVALUE(ICNT)=BICML
13029          IDIGIT(ICNT)=-7
13030        ENDIF
13031        ICNT=ICNT+1
13032        ITEXT(ICNT)=' '
13033        NCTEXT(ICNT)=0
13034        AVALUE(ICNT)=0.0
13035        IDIGIT(ICNT)=-1
13036      ENDIF
13037C
13038      NUMROW=ICNT
13039      DO2320I=1,NUMROW
13040        NTOT(I)=15
13041 2320 CONTINUE
13042C
13043      IFRST=.FALSE.
13044      ILAST=.FALSE.
13045      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
13046     1            AVALUE,IDIGIT,
13047     1            NTOT,NUMROW,
13048     1            ICAPSW,ICAPTY,ILAST,IFRST,
13049     1            ISUBRO,IBUGA3,IERROR)
13050C
13051C               *****************
13052C               **  STEP 90--  **
13053C               **  EXIT       **
13054C               *****************
13055C
13056 9000 CONTINUE
13057      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLF3')THEN
13058        WRITE(ICOUT,999)
13059        CALL DPWRST('XXX','WRIT')
13060        WRITE(ICOUT,9011)
13061 9011   FORMAT('***** AT THE END       OF DPMLF3--')
13062        CALL DPWRST('XXX','WRIT')
13063        WRITE(ICOUT,9012)N,IBUGA3,IERROR
13064 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
13065        CALL DPWRST('XXX','WRIT')
13066      ENDIF
13067C
13068      RETURN
13069      END
13070      SUBROUTINE DPMLG1(Y,N,
13071     1                  XTEMP,DTEMP,MAXNXT,
13072     1                  SCALMO,SHAPMO,SCALML,SCALSE,SHAPML,SHAPSE,COVSE,
13073     1                  AIC,AICC,BIC,ALIKE,
13074     1                  ICAPSW,ICAPTY,IGAMFL,IFORSW,
13075     1                  QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
13076     1                  IOUNI1,IOUNI2,ALPHAP,
13077     1                  ISUBRO,IBUGA3,IERROR)
13078C
13079C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
13080C              ESTIMATES FOR GAMMA DISTRIBUTION
13081C              FOR THE FULL SAMPLE CASE.
13082C     EXAMPLE--GAMMA MAXIMUM LIKELIHOOD Y
13083C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
13084C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
13085C                1999, CHAPTER 13.
13086C              --JOHNSON, KOTZ, AND BALAKRISNAN, "CONTINUOUS
13087C                UNIVARIATE DISTRIBUTIONS--VOLUME 1", SECOND EDITION,
13088C                WILEY, 1994, CHAPTER xx.
13089C     WRITTEN BY--ALAN HECKERT
13090C                 STATISTICAL ENGINEERING DIVISION
13091C                 INFORMATION TECHNOLOGY LABORATORY
13092C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
13093C                 GAITHERSBURG, MD 20899-8980
13094C                 PHONE--301-975-2899
13095C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
13096C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
13097C     LANGUAGE--ANSI FORTRAN (1977)
13098C     VERSION NUMBER--2004/11
13099C     ORIGINAL VERSION--NOVEMBER  2004. NOTE: THIS REPLACES SOME
13100C                                       EARLIER IMPLEMENTATIONS.
13101C     UPDATED         --JULY      2008. ADD SUPPORT FOR INVERTED GAMMA
13102C     UPDATED         --FEBRUARY  2010. PUT POINT ESTIMATES IN A
13103C                                       SEPARATE ROUTINE TO MAKE IT
13104C                                       EASIER TO CALL FROM OTHER
13105C                                       ROUTINES (BOOTSTRAP, GOODNESS
13106C                                       OF FIT)
13107C     UPDATED         --FEBRUARY  2010. USE DPDTA1, DPDTA8, DPDTA9
13108C                                       ROUTINES TO PRINT OUTPUT
13109C
13110C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
13111C
13112      CHARACTER*4 ICAPSW
13113      CHARACTER*4 ICAPTY
13114      CHARACTER*4 IGAMFL
13115      CHARACTER*4 IFORSW
13116C
13117      CHARACTER*4 ISUBRO
13118      CHARACTER*4 IBUGA3
13119      CHARACTER*4 IERROR
13120      CHARACTER*4 ISUBN1
13121      CHARACTER*4 ISUBN2
13122      CHARACTER*4 ISTEPN
13123      CHARACTER*4 ILIKFL
13124      CHARACTER*40 IDIST
13125C
13126C---------------------------------------------------------------------
13127C
13128      PARAMETER (NUMALP=8)
13129      DIMENSION ALPHA(NUMALP)
13130      DIMENSION ALOWSC(NUMALP)
13131      DIMENSION AUPPSC(NUMALP)
13132      DIMENSION ALOWGA(NUMALP)
13133      DIMENSION AUPPGA(NUMALP)
13134      DIMENSION ALOWS2(NUMALP)
13135      DIMENSION AUPPS2(NUMALP)
13136      DIMENSION ALOWG2(NUMALP)
13137      DIMENSION AUPPG2(NUMALP)
13138C
13139      DIMENSION Y(*)
13140      DIMENSION XTEMP(*)
13141      DIMENSION QP(*)
13142      DIMENSION XQPHAT(*)
13143      DIMENSION XQPSE(*)
13144      DIMENSION XQPLCL(*)
13145      DIMENSION XQPUCL(*)
13146      DOUBLE PRECISION DTEMP(*)
13147C
13148      DOUBLE PRECISION GAMFU2
13149      DOUBLE PRECISION GAMFU3
13150      REAL GAMFU8
13151      REAL GAMFU9
13152      EXTERNAL GAMFU2
13153      EXTERNAL GAMFU3
13154      EXTERNAL GAMFU8
13155      EXTERNAL GAMFU9
13156C
13157      INTEGER IN2
13158      DOUBLE PRECISION DK
13159      DOUBLE PRECISION DXBAR
13160      DOUBLE PRECISION DGMEAN
13161      DOUBLE PRECISION DSCALE
13162      DOUBLE PRECISION DGAM
13163      COMMON/GAMCO2/DK,DXBAR,DGMEAN,DSCALE,DGAM,IN2
13164C
13165      INTEGER IN3
13166      DOUBLE PRECISION DK2
13167      DOUBLE PRECISION DTERM6
13168      DOUBLE PRECISION DTERM7
13169      DOUBLE PRECISION DGAMMA
13170      COMMON/GAMCO3/DK2,DTERM6,DTERM7,DGAMMA,IN3
13171C
13172      COMMON/GAMCO8/P8,SCALE8
13173      COMMON/GAMCO9/P9,GHAT9
13174C
13175      DOUBLE PRECISION DN
13176      DOUBLE PRECISION AE
13177      DOUBLE PRECISION RE
13178CCCCC DOUBLE PRECISION DG
13179CCCCC DOUBLE PRECISION DS
13180CCCCC DOUBLE PRECISION DT1
13181CCCCC DOUBLE PRECISION DSUM1
13182CCCCC DOUBLE PRECISION DSUM2
13183      DOUBLE PRECISION DXSTRT
13184      DOUBLE PRECISION DXLOW
13185      DOUBLE PRECISION DXUP
13186CCCCC DOUBLE PRECISION XLOWSV
13187CCCCC DOUBLE PRECISION XUPSV
13188CCCCC DOUBLE PRECISION DANS(10)
13189CCCCC DOUBLE PRECISION TRIGAM
13190CCCCC DOUBLE PRECISION DTRM11
13191CCCCC DOUBLE PRECISION DTRM12
13192C
13193      INCLUDE 'DPCOST.INC'
13194C
13195      PARAMETER (MAXROW=50)
13196      CHARACTER*60 ITITLE
13197      CHARACTER*60 ITITLZ
13198      CHARACTER*40 ITEXT(MAXROW)
13199      REAL         AVALUE(MAXROW)
13200      INTEGER      NCTEXT(MAXROW)
13201      INTEGER      IDIGIT(MAXROW)
13202      INTEGER      NTOT(MAXROW)
13203      LOGICAL IFRST
13204      LOGICAL ILAST
13205C
13206C---------------------------------------------------------------------
13207C
13208      INCLUDE 'DPCOP2.INC'
13209C
13210      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
13211C
13212C-----START POINT-----------------------------------------------------
13213C
13214      ISUBN1='DPML'
13215      ISUBN2='G1  '
13216      IERROR='NO'
13217C
13218      AIC=CPUMIN
13219      AICC=CPUMIN
13220      BIC=CPUMIN
13221      ALIKE=CPUMIN
13222C
13223      IF(IGAMFL.EQ.'IGAM')THEN
13224        IDIST='INVERTED GAMMA'
13225      ELSE
13226        IDIST='GAMMA'
13227      ENDIF
13228C
13229      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG1')THEN
13230        WRITE(ICOUT,999)
13231  999   FORMAT(1X)
13232        CALL DPWRST('XXX','WRIT')
13233        WRITE(ICOUT,51)
13234   51   FORMAT('**** AT THE BEGINNING OF DPMLG1--')
13235        CALL DPWRST('XXX','WRIT')
13236        WRITE(ICOUT,52)IBUGA3,ISUBRO,IGAMFL,N,IOUNI2,MAXNXT
13237   52   FORMAT('IBUGA3,ISUBRO,IGAMFL,N,IOUNI2,MAXNXT = ',3(A4,2X),3I8)
13238        CALL DPWRST('XXX','WRIT')
13239        DO56I=1,MIN(N,100)
13240          WRITE(ICOUT,57)I,Y(I)
13241   57     FORMAT('I,Y(I) = ',I8,G15.7)
13242          CALL DPWRST('XXX','WRIT')
13243   56   CONTINUE
13244      ENDIF
13245C
13246C               ********************************************
13247C               **  STEP 11--                             **
13248C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
13249C               ********************************************
13250C
13251      ISTEPN='11'
13252      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG1')
13253     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
13254C
13255      NMIN=3
13256      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
13257      IF(IERROR.EQ.'YES')GOTO9000
13258C
13259      CALL GAMML1(Y,N,IGAMFL,
13260     1            XTEMP,DTEMP,
13261     1            XMEAN,XSD,XVAR,XMIN,XMAX,XGEOM,
13262     1            ZMEAN,ZSD,ZGEOM,
13263     1            SCALML,SCALSE,SHAPML,SHAPSE,COVSE,
13264     1            SCALMO,SHAPMO,
13265     1            SCALYE,SHAPYE,SCYEBC,SHYEBC,
13266     1            ISUBRO,IBUGA3,IERROR)
13267C
13268C     CONFIDENCE INTERVALS FOR PARAMETERS.  CAN BASE ON EITHER NORMAL
13269C     APPROXIMATION OR ON LIKELIHOOD RATIO APPROXIMATION.
13270C
13271C     NORMAL APPROXIMATION FIRST.
13272C
13273      DO4110I=1,NUMALP
13274        ALP=ALPHA(I)
13275        P=1.0-(ALP/2.0)
13276        CALL NORPPF(P,PPF)
13277        ALOWSC(I)=SCALML - PPF*SCALSE
13278        AUPPSC(I)=SCALML + PPF*SCALSE
13279        ALOWGA(I)=SHAPML - PPF*SHAPSE
13280        AUPPGA(I)=SHAPML + PPF*SHAPSE
13281 4110 CONTINUE
13282C
13283C     NOW DO LIKELIHOOD RATIO APPROXIMATION.
13284C
13285      IN2=N
13286      IN3=N
13287      DN=DBLE(N)
13288      AE=1.D-7
13289      RE=1.D-7
13290      NUTEMP=1
13291C
13292      DGAM=DBLE(SHAPML)
13293      DXBAR=DBLE(XMEAN)
13294      DGMEAN=DBLE(XGEOM)
13295      DSCALE=DBLE(SCALML)
13296C
13297      DO4120I=1,NUMALP
13298        ALP=ALPHA(I)
13299        CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
13300        DK=DBLE(APPF)
13301        DK2=DK
13302C
13303        DXSTRT=DBLE(ALOWGA(I))
13304        DXLOW=DXSTRT/5.0D0
13305        DXUP=DBLE(SHAPML)
13306        CALL DFZERO(GAMFU2,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG)
13307        ALOWG2(I)=REAL(DXLOW)
13308C
13309        DXSTRT=DBLE(AUPPGA(I))
13310        DXUP=DXSTRT*5.0D0
13311        DXLOW=DBLE(SHAPML)
13312        CALL DFZERO(GAMFU2,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG)
13313        AUPPG2(I)=REAL(DXLOW)
13314C
13315        IF(IGAMFL.EQ.'IGAM')THEN
13316          DXSTRT=MIN(1.0D0/DBLE(ALOWSC(I)),1.0D0/DBLE(AUPPSC(I)))
13317          DXLOW=DXSTRT/5.0D0
13318          DXUP=1.0D0/DBLE(SCALML)
13319        ELSE
13320          DXSTRT=DBLE(ALOWSC(I))
13321          DXLOW=DXSTRT/5.0D0
13322          DXUP=DBLE(SCALML)
13323        ENDIF
13324        CALL DFZER2(GAMFU3,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG,DTEMP)
13325        IF(IGAMFL.EQ.'IGAM')THEN
13326          ALOWS2(I)=REAL(1.0D0/DXLOW)
13327        ELSE
13328          ALOWS2(I)=REAL(DXLOW)
13329        ENDIF
13330C
13331        IF(IGAMFL.EQ.'IGAM')THEN
13332          DXSTRT=MAX(1.0D0/DBLE(ALOWSC(I)),1.0D0/DBLE(AUPPSC(I)))
13333          DXUP=DXSTRT*5.0D0
13334          DXLOW=1.0D0/DBLE(SCALML)
13335        ELSE
13336          DXSTRT=DBLE(AUPPSC(I))
13337          DXUP=DXSTRT*5.0D0
13338          DXLOW=DBLE(SCALML)
13339        ENDIF
13340        CALL DFZER2(GAMFU3,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG,DTEMP)
13341        IF(IGAMFL.EQ.'IGAM')THEN
13342          AUPPS2(I)=REAL(1.0D0/DXLOW)
13343          IF(AUPPS2(I).LT.ALOWS2(I))THEN
13344            ATEMP=AUPPS2(I)
13345            AUPPS2(I)=ALOWS2(I)
13346            ALOWS2(I)=ATEMP
13347          ENDIF
13348        ELSE
13349          AUPPS2(I)=REAL(DXLOW)
13350        ENDIF
13351 4120 CONTINUE
13352C
13353C     CONFIDENCE INTERVALS FOR SELECTED PERCENTILES.
13354C
13355C     1. STANDARD ERROR USES TECHNIQUE DEMONSTRATED IN EXAMPLE 13.1
13356C        (P. 227) OF BURY.  THIS IS BASED ON PROPOGATION OF ERROR.
13357C
13358C     2. CONFIDENCE INTERVAL IS THEN GENERATED USING NORMAL
13359C        APPROXIMATION (EXAMPLE 13.1 OF BURY).
13360C
13361      IF(NPERC.GE.1)THEN
13362C
13363        ALPHL=ALPHAP/2.0
13364        ALPHU=1.0 - ALPHAP/2.0
13365        CALL NORPPF(ALPHU,Z95)
13366C
13367        GHAT9=SHAPML
13368        SCALE8=SCALML
13369        IORD=1
13370        EPS=0.001
13371        ACCUR=0.0
13372C
13373        WRITE(IOUNI1,4131)
13374        WRITE(IOUNI1,4132)
13375        DO4129I=1,NPERC
13376          QPTEMP=QP(I)/100.0
13377          CALL GAMPPF(QPTEMP,SHAPML,APPF)
13378          XQPHAT(I)=SCALML*APPF
13379C
13380          P8=QPTEMP
13381          P9=QPTEMP
13382C
13383          IFAIL=0
13384C
13385          GHAT   = SHAPML
13386          GHATMN = 0.0001
13387          GHATMX = GHAT + 20.0
13388          CALL DIFF(IORD,GHAT,GHATMN,GHATMX,GAMFU8,EPS,ACCUR,
13389     1              GHATP,ERROR,IFAIL)
13390C
13391          IF(IFAIL.EQ.1)THEN
13392            WRITE(ICOUT,999)
13393            CALL DPWRST('XXX','BUG ')
13394            WRITE(ICOUT,301)IDIST
13395  301       FORMAT('***** WARNING IN NUMERICAL DERIVATIVE FOR ',A14)
13396            CALL DPWRST('XXX','BUG ')
13397            WRITE(ICOUT,302)
13398  302       FORMAT('      MAXIMUM LIKELIHOOD PERCENTILES.')
13399            CALL DPWRST('XXX','BUG ')
13400            WRITE(ICOUT,303)
13401  303       FORMAT('      THE ESTIMATED ERROR IN THE RESULT ',
13402     1             'EXCEEDS THE')
13403            CALL DPWRST('XXX','BUG ')
13404            WRITE(ICOUT,305)
13405  305       FORMAT('      REQUESTED ERROR, BUT THE MOST ACCURATE ',
13406     1             'RESULT')
13407            CALL DPWRST('XXX','BUG ')
13408            WRITE(ICOUT,307)
13409  307       FORMAT('      POSSIBLE HAS BEEN RETURNED.')
13410            CALL DPWRST('XXX','BUG ')
13411          ELSEIF(IFAIL.EQ.2)THEN
13412            WRITE(ICOUT,999)
13413            CALL DPWRST('XXX','BUG ')
13414            WRITE(ICOUT,301)IDIST
13415            CALL DPWRST('XXX','BUG ')
13416            WRITE(ICOUT,302)
13417            CALL DPWRST('XXX','BUG ')
13418            WRITE(ICOUT,313)
13419  313       FORMAT('      ERROR IN THE INPUT TO THE DIFF ROUTINE.')
13420            CALL DPWRST('XXX','BUG ')
13421            WRITE(ICOUT,315)
13422  315       FORMAT('      NO PERCENTILES WILL BE GENERATED.')
13423            CALL DPWRST('XXX','BUG ')
13424            NPERC=0
13425          ELSEIF(IFAIL.EQ.3)THEN
13426            WRITE(ICOUT,999)
13427            CALL DPWRST('XXX','BUG ')
13428            WRITE(ICOUT,301)IDIST
13429            CALL DPWRST('XXX','BUG ')
13430            WRITE(ICOUT,302)
13431            CALL DPWRST('XXX','BUG ')
13432            WRITE(ICOUT,323)
13433  323       FORMAT('      THE INTERVAL FOR DIFFERENTIATION, (',G15.7,
13434     1             ',',G15.7,')')
13435            CALL DPWRST('XXX','BUG ')
13436            WRITE(ICOUT,325)
13437  325       FORMAT('      IS TOO SMALL.')
13438            CALL DPWRST('XXX','BUG ')
13439            WRITE(ICOUT,315)
13440            CALL DPWRST('XXX','BUG ')
13441            GHATP=0.0
13442            NPERC=0
13443          ENDIF
13444C
13445          SCALHT = SCALML
13446          SCALMN = 0.0001
13447          SCALMX = SCALHT + 20.0
13448          CALL DIFF(IORD,SCALHT,SCALMN,SCALMX,GAMFU9,EPS,ACCUR,
13449     1              SCALEP,ERROR,IFAIL)
13450C
13451          IF(IFAIL.EQ.1)THEN
13452            WRITE(ICOUT,999)
13453            CALL DPWRST('XXX','BUG ')
13454            WRITE(ICOUT,301)IDIST
13455            CALL DPWRST('XXX','BUG ')
13456            WRITE(ICOUT,302)
13457            CALL DPWRST('XXX','BUG ')
13458            WRITE(ICOUT,303)
13459            CALL DPWRST('XXX','BUG ')
13460            WRITE(ICOUT,305)
13461            CALL DPWRST('XXX','BUG ')
13462            WRITE(ICOUT,307)
13463            CALL DPWRST('XXX','BUG ')
13464          ELSEIF(IFAIL.EQ.2)THEN
13465            WRITE(ICOUT,999)
13466            CALL DPWRST('XXX','BUG ')
13467            WRITE(ICOUT,301)IDIST
13468            CALL DPWRST('XXX','BUG ')
13469            WRITE(ICOUT,302)
13470            CALL DPWRST('XXX','BUG ')
13471            WRITE(ICOUT,313)
13472            CALL DPWRST('XXX','BUG ')
13473            WRITE(ICOUT,315)
13474            CALL DPWRST('XXX','BUG ')
13475            NPERC=0
13476          ELSEIF(IFAIL.EQ.3)THEN
13477            WRITE(ICOUT,999)
13478            CALL DPWRST('XXX','BUG ')
13479            WRITE(ICOUT,301)IDIST
13480            CALL DPWRST('XXX','BUG ')
13481            WRITE(ICOUT,302)
13482            CALL DPWRST('XXX','BUG ')
13483            WRITE(ICOUT,323)
13484            CALL DPWRST('XXX','BUG ')
13485            WRITE(ICOUT,325)
13486            CALL DPWRST('XXX','BUG ')
13487            WRITE(ICOUT,315)
13488            CALL DPWRST('XXX','BUG ')
13489            GHATP=0.0
13490            NPERC=0
13491          ENDIF
13492          D1=SCALEP
13493          D2=GHATP
13494          V11=SCALSE**2
13495          V22=SHAPSE**2
13496          V21=COVSE
13497          V12=V21
13498          TERM11=D1*D1*V11
13499          TERM12=D1*D2*V12
13500          TERM21=D2*D1*V21
13501          TERM22=D2*D2*V22
13502          SEXQP=TERM11+TERM12+TERM21+TERM22
13503          IF(SEXQP.GE.0.0)THEN
13504            SEXQP=SQRT(SEXQP)
13505          ELSE
13506            SEXQP=0.0
13507          ENDIF
13508          XQPSE(I)=SEXQP
13509          XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
13510          XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
13511          WRITE(IOUNI1,'(5E15.7)')
13512     1         QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
13513 4129   CONTINUE
13514 4131   FORMAT(15X,'       POINT     ','     LOWER     ',
13515     1         '     UPPER')
13516 4132   FORMAT('    PERCENTILE ','     ESTIMATE   ',
13517     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
13518      ENDIF
13519C
13520C               *************************************
13521C               **   STEP 42--                     **
13522C               **   WRITE OUT EVERYTHING          **
13523C               **   FOR GAMMA MLE ESTIMATE        **
13524C               *************************************
13525C
13526      ISTEPN='42'
13527      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG1')
13528     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
13529C
13530C     PRINT SUMMARY STATISTICS TABLE
13531C
13532      IF(IPRINT.EQ.'OFF')GOTO8900
13533C
13534      NUMDIG=7
13535      IF(IFORSW.EQ.'1')NUMDIG=1
13536      IF(IFORSW.EQ.'2')NUMDIG=2
13537      IF(IFORSW.EQ.'3')NUMDIG=3
13538      IF(IFORSW.EQ.'4')NUMDIG=4
13539      IF(IFORSW.EQ.'5')NUMDIG=5
13540      IF(IFORSW.EQ.'6')NUMDIG=6
13541      IF(IFORSW.EQ.'7')NUMDIG=7
13542      IF(IFORSW.EQ.'8')NUMDIG=8
13543      IF(IFORSW.EQ.'9')NUMDIG=9
13544      IF(IFORSW.EQ.'0')NUMDIG=0
13545      IF(IFORSW.EQ.'E')NUMDIG=-2
13546      IF(IFORSW.EQ.'-2')NUMDIG=-2
13547      IF(IFORSW.EQ.'-3')NUMDIG=-3
13548      IF(IFORSW.EQ.'-4')NUMDIG=-4
13549      IF(IFORSW.EQ.'-5')NUMDIG=-5
13550      IF(IFORSW.EQ.'-6')NUMDIG=-6
13551      IF(IFORSW.EQ.'-7')NUMDIG=-7
13552      IF(IFORSW.EQ.'-8')NUMDIG=-8
13553      IF(IFORSW.EQ.'-9')NUMDIG=-9
13554C
13555      IF(IGAMFL.EQ.'IGAM')THEN
13556        ITITLE='Two-Parameter Inverted Gamma Parameter Estimation:'
13557        NCTITL=50
13558        ITITLZ='Full Sample Case'
13559        NCTITZ=16
13560      ELSE
13561        ITITLE='Two-Parameter Gamma Parameter Estimation:'
13562        NCTITL=41
13563        ITITLZ='Full Sample Case'
13564        NCTITZ=16
13565      ENDIF
13566      ITEXT(1)='Summary Statistics:'
13567      NCTEXT(1)=19
13568      AVALUE(1)=0.0
13569      IDIGIT(1)=0
13570      ITEXT(2)='Number of Observations:'
13571      NCTEXT(2)=23
13572      AVALUE(2)=REAL(N)
13573      IDIGIT(2)=0
13574      ITEXT(3)='Sample Mean:'
13575      NCTEXT(3)=12
13576      AVALUE(3)=XMEAN
13577      IDIGIT(3)=NUMDIG
13578      ITEXT(4)='Sample Standard Deviation:'
13579      NCTEXT(4)=26
13580      AVALUE(4)=XSD
13581      IDIGIT(4)=NUMDIG
13582      ITEXT(5)='Sample Minimum:'
13583      NCTEXT(5)=15
13584      AVALUE(5)=XMIN
13585      IDIGIT(5)=NUMDIG
13586      ITEXT(6)='Sample Maximum:'
13587      NCTEXT(6)=15
13588      AVALUE(6)=XMAX
13589      IDIGIT(6)=NUMDIG
13590      ITEXT(7)='Sample Geometric Mean:'
13591      NCTEXT(7)=22
13592      AVALUE(7)=XGEOM
13593      IDIGIT(7)=NUMDIG
13594      NUMROW=7
13595      DO2310I=1,NUMROW
13596        NTOT(I)=15
13597 2310 CONTINUE
13598      NTOT(2)=8
13599C
13600      IFRST=.TRUE.
13601      ILAST=.FALSE.
13602      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
13603     1            NCTEXT,AVALUE,IDIGIT,
13604     1            NTOT,NUMROW,
13605     1            ICAPSW,ICAPTY,ILAST,IFRST,
13606     1            ISUBRO,IBUGA3,IERROR)
13607      IFRST=.FALSE.
13608      ITITLE=' '
13609      NCTITL=0
13610C
13611      ITEXT(1)='Method of Moments:'
13612      NCTEXT(1)=18
13613      AVALUE(1)=0.0
13614      IDIGIT(1)=0
13615      ITEXT(2)='Estimate of Shape (Gamma):'
13616      NCTEXT(2)=26
13617      AVALUE(2)=SHAPMO
13618      IDIGIT(2)=NUMDIG
13619      ITEXT(3)='Estimate of Scale:'
13620      NCTEXT(3)=18
13621      AVALUE(3)=SCALMO
13622      IDIGIT(3)=NUMDIG
13623      ITEXT(4)=' '
13624      NCTEXT(4)=0
13625      AVALUE(4)=0.0
13626      IDIGIT(4)=-1
13627C
13628      ITEXT(5)='Method of Ye and Chen:'
13629      NCTEXT(5)=22
13630      AVALUE(5)=0.0
13631      IDIGIT(5)=-1
13632      ITEXT(6)='Estimate of Shape (Gamma):'
13633      NCTEXT(6)=26
13634      AVALUE(6)=SHAPYE
13635      IDIGIT(6)=NUMDIG
13636      ITEXT(7)='Estimate of Scale:'
13637      NCTEXT(7)=18
13638      AVALUE(7)=SCALYE
13639      IDIGIT(7)=NUMDIG
13640      ITEXT(8)='Estimate of Shape (Bias Corrected):'
13641      NCTEXT(8)=35
13642      AVALUE(8)=SHYEBC
13643      IDIGIT(8)=NUMDIG
13644      ITEXT(9)='Estimate of Scale (Bias Corrected):'
13645      NCTEXT(9)=35
13646      AVALUE(9)=SCYEBC
13647      IDIGIT(9)=NUMDIG
13648      ITEXT(10)=' '
13649      NCTEXT(10)=0
13650      AVALUE(10)=0.0
13651      IDIGIT(10)=-1
13652C
13653      ITEXT(11)='Maximum Likelihood:'
13654      NCTEXT(11)=19
13655      AVALUE(11)=0.0
13656      IDIGIT(11)=-1
13657      ITEXT(12)='Estimate of Shape (Gamma):'
13658      NCTEXT(12)=26
13659      AVALUE(12)=SHAPML
13660      IDIGIT(12)=NUMDIG
13661      ITEXT(13)='Standard Error of Shape:'
13662      NCTEXT(13)=24
13663      AVALUE(13)=SHAPSE
13664      IDIGIT(13)=NUMDIG
13665      ITEXT(14)='Estimate of Scale:'
13666      NCTEXT(14)=18
13667      AVALUE(14)=SCALML
13668      IDIGIT(14)=NUMDIG
13669      ITEXT(15)='Standard Error of Scale:'
13670      NCTEXT(15)=24
13671      AVALUE(15)=SCALSE
13672      IDIGIT(15)=NUMDIG
13673      ITEXT(16)='Shape/Scale Covariance:'
13674      NCTEXT(16)=23
13675      AVALUE(16)=COVSE
13676      IDIGIT(16)=NUMDIG
13677C
13678      ICNT=16
13679C
13680CCCCC ICNT=ICNT+1
13681CCCCC ITEXT(ICNT)='Log-likelihood:'
13682CCCCC NCTEXT(ICNT)=15
13683CCCCC AVALUE(ICNT)=ALIK
13684CCCCC IDIGIT(ICNT)=-7
13685CCCCC ICNT=ICNT+1
13686CCCCC ITEXT(ICNT)='AIC:'
13687CCCCC NCTEXT(ICNT)=4
13688CCCCC AVALUE(ICNT)=AIC
13689CCCCC IDIGIT(ICNT)=-7
13690CCCCC ICNT=ICNT+1
13691CCCCC ITEXT(ICNT)='AICc:'
13692CCCCC NCTEXT(ICNT)=5
13693CCCCC AVALUE(ICNT)=AICC
13694CCCCC IDIGIT(ICNT)=-7
13695CCCCC ICNT=ICNT+1
13696CCCCC ITEXT(ICNT)='BIC:'
13697CCCCC NCTEXT(ICNT)=4
13698CCCCC AVALUE(ICNT)=BIC
13699CCCCC IDIGIT(ICNT)=-7
13700C
13701      NUMROW=ICNT
13702      DO2320I=1,NUMROW
13703        NTOT(I)=15
13704 2320 CONTINUE
13705C
13706      IFRST=.FALSE.
13707      ILAST=.FALSE.
13708      ITITLZ=' '
13709      NCTITZ=0
13710      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
13711     1            AVALUE,IDIGIT,
13712     1            NTOT,NUMROW,
13713     1            ICAPSW,ICAPTY,ILAST,IFRST,
13714     1            ISUBRO,IBUGA3,IERROR)
13715C
13716      ILIKFL='ON'
13717      CALL DPDTA8(ALOWSC,AUPPSC,ALOWS2,AUPPS2,
13718     1            ALOWGA,AUPPGA,ALOWG2,AUPPG2,ALPHA,NUMALP,
13719     1            ICAPSW,ICAPTY,NUMDIG,ILIKFL,
13720     1            ISUBRO,IBUGA3,IERROR)
13721C
13722      IF(NPERC.GT.1)THEN
13723        ILIKFL='ON'
13724        CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
13725     1              ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
13726     1              ISUBRO,IBUGA3,IERROR)
13727
13728      ENDIF
13729C
13730 8900 CONTINUE
13731      IF(IFEEDB.EQ.'ON' .AND. IPRINT.EQ.'ON')THEN
13732        WRITE(ICOUT,4291)
13733 4291   FORMAT('THE FOLLOWING INTERNAL PARAMETERS ARE SAVED:')
13734        CALL DPWRST('XXX','BUG ')
13735        WRITE(ICOUT,4293)
13736 4293   FORMAT('      GAMMAML, GAMMASE, SCALEML, SCALESE, ',
13737     1         'GAMMAMOM, SCALEMOM,COVSE')
13738        CALL DPWRST('XXX','BUG ')
13739C
13740        WRITE(ICOUT,999)
13741        CALL DPWRST('XXX','BUG ')
13742        IF(NPERC.GT.0)THEN
13743          WRITE(ICOUT,4943)
13744 4943     FORMAT('PERCENTILE CONFIDENCE LIMITS  WRITTEN TO ',
13745     1           'FILE  dpst1f.dat')
13746          CALL DPWRST('XXX','BUG ')
13747        ENDIF
13748        WRITE(ICOUT,999)
13749        CALL DPWRST('XXX','BUG ')
13750      ENDIF
13751C
13752C               *****************
13753C               **  STEP 90--  **
13754C               **  EXIT       **
13755C               *****************
13756C
13757 9000 CONTINUE
13758      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG1')THEN
13759        WRITE(ICOUT,999)
13760        CALL DPWRST('XXX','WRIT')
13761        WRITE(ICOUT,9011)
13762 9011   FORMAT('***** AT THE END       OF DPMLG1--')
13763        CALL DPWRST('XXX','WRIT')
13764        WRITE(ICOUT,9012)N,IBUGA3,IERROR
13765 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
13766        CALL DPWRST('XXX','WRIT')
13767        WRITE(ICOUT,9015)N
13768 9015   FORMAT('N = ',I8)
13769        CALL DPWRST('XXX','WRIT')
13770      ENDIF
13771C
13772      RETURN
13773      END
13774      SUBROUTINE DPMLG2(Y,TAG,N,
13775     1                  TEMP1,XTEMP,YSAVE,DTEMP1,ITEMP,MAXNXT,
13776     1                  SCALMO,SHAPMO,
13777     1                  SCALML,SCALSE,SHAPML,SHAPSE,COVSE,
13778     1                  NUMV,TEND,
13779     1                  ICAPSW,ICAPTY,IFORSW,IGAMFL,
13780     1                  QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
13781     1                  IOUNI1,IOUNI2,ALPHAP,
13782     1                  ISUBRO,IBUGA3,IERROR)
13783C
13784C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
13785C              FOR THE TIME CENSORED GAMMA DISTRIBUTION.
13786C     EXAMPLE--GAMMA MAXIMUM LIKELIHOOD Y CENSOR
13787C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
13788C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
13789C                1999, CHAPTER 13.
13790C              --JOHNSON, KOTZ, AND BALAKRISNAN, "CONTINUOUS
13791C                UNIVARIATE DISTRIBUTIONS--VOLUME 1", SECOND EDITION,
13792C                WILEY, 1994, CHAPTER xx.
13793C     WRITTEN BY--ALAN HECKERT
13794C                 STATISTICAL ENGINEERING DIVISION
13795C                 INFORMATION TECHNOLOGY LABORATORY
13796C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
13797C                 GAITHERSBURG, MD 20899-8980
13798C                 PHONE--301-975-2855
13799C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
13800C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
13801C     LANGUAGE--ANSI FORTRAN (1977)
13802C     VERSION NUMBER--2004/11
13803C     ORIGINAL VERSION--NOVEMBER  2004.
13804C     UPDATED         --JULY      2008. SUPPORT FOR INVERTED GAMMA
13805C     UPDATED         --JULY      2010. PRINT TABLES WITH DPDTA1,
13806C                                       DPDTA8, AND DPDTA9
13807C     UPDATED         --JULY      2010. EXTRACT POINT ESTIMATES TO
13808C                                       GAMML2
13809C
13810C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
13811C
13812      CHARACTER*4 ICAPSW
13813      CHARACTER*4 ICAPTY
13814      CHARACTER*4 IFORSW
13815      CHARACTER*4 IGAMFL
13816C
13817      CHARACTER*4 ISUBRO
13818      CHARACTER*4 IBUGA3
13819      CHARACTER*4 IERROR
13820C
13821      CHARACTER*40 IDIST
13822      CHARACTER*4 ICASE
13823      CHARACTER*4 ILIKFL
13824C
13825      CHARACTER*4 IWRITE
13826      CHARACTER*4 ISUBN1
13827      CHARACTER*4 ISUBN2
13828      CHARACTER*4 ISTEPN
13829C
13830C---------------------------------------------------------------------
13831C
13832      PARAMETER (NUMALP=8)
13833      DIMENSION ALPHA(NUMALP)
13834      DIMENSION ALOWSC(NUMALP)
13835      DIMENSION AUPPSC(NUMALP)
13836      DIMENSION ALOWGA(NUMALP)
13837      DIMENSION AUPPGA(NUMALP)
13838      DIMENSION ALOWS2(NUMALP)
13839      DIMENSION AUPPS2(NUMALP)
13840      DIMENSION ALOWG2(NUMALP)
13841      DIMENSION AUPPG2(NUMALP)
13842C
13843      DIMENSION Y(*)
13844      DIMENSION TAG(*)
13845      DIMENSION TEMP1(*)
13846      DIMENSION XTEMP(*)
13847      DIMENSION ITEMP(*)
13848      DIMENSION YSAVE(*)
13849      DIMENSION QP(*)
13850      DIMENSION XQPHAT(*)
13851      DIMENSION XQPSE(*)
13852      DIMENSION XQPLCL(*)
13853      DIMENSION XQPUCL(*)
13854      DOUBLE PRECISION DTEMP1(*)
13855C
13856      EXTERNAL GAMFU8
13857      EXTERNAL GAMFU9
13858      COMMON/GAMCO8/P8,SCALE8
13859      COMMON/GAMCO9/P9,GHAT9
13860C
13861      INCLUDE 'DPCOST.INC'
13862C
13863      PARAMETER (MAXROW=50)
13864      CHARACTER*60 ITITLE
13865      CHARACTER*60 ITITLZ
13866      CHARACTER*40 ITEXT(MAXROW)
13867      REAL         AVALUE(MAXROW)
13868      INTEGER      NCTEXT(MAXROW)
13869      INTEGER      IDIGIT(MAXROW)
13870      INTEGER      NTOT(MAXROW)
13871      LOGICAL IFRST
13872      LOGICAL ILAST
13873C
13874C---------------------------------------------------------------------
13875C
13876      INCLUDE 'DPCOP2.INC'
13877C
13878      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
13879C
13880C-----START POINT-----------------------------------------------------
13881C
13882      ISUBN1='DPML'
13883      ISUBN2='G2  '
13884      IWRITE='NO'
13885      IERROR='NO'
13886C
13887      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG2')THEN
13888        WRITE(ICOUT,999)
13889  999   FORMAT(1X)
13890        CALL DPWRST('XXX','WRIT')
13891        WRITE(ICOUT,51)
13892   51   FORMAT('**** AT THE BEGINNING OF DPMLG2--')
13893        CALL DPWRST('XXX','WRIT')
13894        WRITE(ICOUT,54)IBUGA3,ISUBRO,ICENTY
13895   54   FORMAT('IBUGA3,ISUBRO,ICENTY = ',2(A4,2X),A4)
13896        CALL DPWRST('XXX','WRIT')
13897        WRITE(ICOUT,55)N,NUMV,NPERC,IOUNI1,IOUNI2,TEND
13898   55   FORMAT('N,NUMV,NPERC,IOUNI1,IOUNI2,TEND = ',5I8,G15.7)
13899        CALL DPWRST('XXX','WRIT')
13900        DO56I=1,MIN(N,100)
13901          WRITE(ICOUT,57)I,Y(I),TAG(I)
13902   57     FORMAT('I,Y(I),TAG(I) = ',I8,2G15.7)
13903          CALL DPWRST('XXX','WRIT')
13904   56   CONTINUE
13905      ENDIF
13906C
13907C               ********************************************
13908C               **  STEP 11--                             **
13909C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
13910C               ********************************************
13911C
13912      ISTEPN='11'
13913      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG2')
13914     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
13915C
13916      NMIN=3
13917      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
13918      IF(IERROR.EQ.'YES')GOTO9000
13919C
13920      CALL GAMML2(Y,TAG,N,IGAMFL,MAXNXT,
13921     1            ICASE,IDIST,
13922     1            TEMP1,XTEMP,YSAVE,DTEMP1,ITEMP,
13923     1            XMEANF,XSDF,XVARF,XMINF,XMAXF,XGEOMF,
13924     1            XMEANC,XSDC,XVARC,XMINC,XMAXC,XGEOMC,
13925     1            SCALMO,SHAPMO,
13926     1            SCALML,SCALSE,SHAPML,SHAPSE,COVSE,
13927     1            IR,ISE,
13928     1            ISUBRO,IBUGA3,IERROR)
13929      IF(IERROR.EQ.'YES')GOTO9000
13930      IM=N-IR
13931      IF(ISE.EQ.0)GOTO4199
13932C
13933C     CONFIDENCE INTERVALS FOR PARAMETERS BASED ON NORMAL
13934C     APPROXIMATION
13935C
13936      DO4110I=1,NUMALP
13937        ALP=ALPHA(I)
13938        P=1.0-(ALP/2.0)
13939        CALL NORPPF(P,PPF)
13940        ALOWSC(I)=SCALML - PPF*SCALSE
13941        AUPPSC(I)=SCALML + PPF*SCALSE
13942        ALOWGA(I)=SHAPML - PPF*SHAPSE
13943        AUPPGA(I)=SHAPML + PPF*SHAPSE
13944 4110 CONTINUE
13945C
13946C     CONFIDENCE INTERVALS FOR SELECTED PERCENTILES.
13947C
13948C     1. STANDARD ERROR USES TECHNIQUE DEMONSTRATED IN EXAMPLE 13.1
13949C        (P. 227) OF BURY.  THIS IS BASED ON PROPOGATION OF ERROR.
13950C
13951C     2. CONFIDENCE INTERVAL IS THEN GENERATED USING NORMAL
13952C        APPROXIMATION (EXAMPLE 13.1 OF BURY).
13953C
13954      IF(NPERC.GE.1)THEN
13955C
13956        ALPHL=ALPHAP/2.0
13957        ALPHU=1.0 - ALPHAP/2.0
13958        CALL NORPPF(ALPHU,Z95)
13959C
13960        GHAT9=SHAPML
13961        SCALE8=SCALML
13962        IORD=1
13963        EPS=0.001
13964        ACCUR=0.0
13965C
13966        WRITE(IOUNI1,3531)
13967        WRITE(IOUNI1,3532)
13968        DO3529I=1,NPERC
13969          QPTEMP=QP(I)/100.0
13970          CALL GAMPPF(QPTEMP,SHAPML,APPF)
13971          XQPHAT(I)=SCALML*APPF
13972C
13973          P8=QPTEMP
13974          P9=QPTEMP
13975C
13976          IFAIL=0
13977C
13978          GHAT   = SHAPML
13979          GHATMN = GHAT/10.0
13980          GHATMX = GHAT*10.0
13981          CALL DIFF(IORD,GHAT,GHATMN,GHATMX,GAMFU8,EPS,ACCUR,
13982     1              GHATP,ERROR,IFAIL)
13983C
13984          IF(IFAIL.EQ.1)THEN
13985            WRITE(ICOUT,999)
13986            CALL DPWRST('XXX','BUG ')
13987            WRITE(ICOUT,301)
13988  301       FORMAT('***** WARNING IN NUMERICAL DERIVATIVE FOR GAMMA ',
13989     1             'MAXIMUM LIKELIHOOD PERCENTILES.')
13990            CALL DPWRST('XXX','BUG ')
13991            WRITE(ICOUT,303)
13992  303       FORMAT('      THE ESTIMATED ERROR IN THE RESULT ',
13993     1             'EXCEEDS THE')
13994            CALL DPWRST('XXX','BUG ')
13995            WRITE(ICOUT,305)
13996  305       FORMAT('      REQUESTED ERROR, BUT THE MOST ACCURATE ',
13997     1             'RESULT')
13998            CALL DPWRST('XXX','BUG ')
13999            WRITE(ICOUT,307)
14000  307       FORMAT('      POSSIBLE HAS BEEN RETURNED.')
14001            CALL DPWRST('XXX','BUG ')
14002          ELSEIF(IFAIL.EQ.2)THEN
14003            WRITE(ICOUT,999)
14004            CALL DPWRST('XXX','BUG ')
14005            WRITE(ICOUT,311)
14006  311       FORMAT('***** ERROR IN NUMERICAL DERIVATIVE FOR GAMMA ',
14007     1             'MAXIMUM LIKELIHOOD PERCENTILES.')
14008            CALL DPWRST('XXX','BUG ')
14009            WRITE(ICOUT,313)
14010  313       FORMAT('      ERROR IN THE INPUT TO THE DIFF ROUTINE.')
14011            CALL DPWRST('XXX','BUG ')
14012            WRITE(ICOUT,315)
14013  315       FORMAT('      NO PERCENTILES WILL BE GENERATED.')
14014            CALL DPWRST('XXX','BUG ')
14015            NPERC=0
14016          ELSEIF(IFAIL.EQ.3)THEN
14017            WRITE(ICOUT,999)
14018            CALL DPWRST('XXX','BUG ')
14019            WRITE(ICOUT,311)
14020            CALL DPWRST('XXX','BUG ')
14021            WRITE(ICOUT,323)
14022  323       FORMAT('      THE INTERVAL FOR DIFFERENTIATION, (',G15.7,
14023     1             ',',G15.7,')')
14024            CALL DPWRST('XXX','BUG ')
14025            WRITE(ICOUT,325)
14026  325       FORMAT('      IS TOO SMALL.')
14027            CALL DPWRST('XXX','BUG ')
14028            WRITE(ICOUT,315)
14029            CALL DPWRST('XXX','BUG ')
14030            GHATP=0.0
14031            NPERC=0
14032          ENDIF
14033C
14034          SCALHT = SCALML
14035          SCALMN = SCALHT/10.0
14036          SCALMX = SCALHT*10.0
14037          CALL DIFF(IORD,SCALHT,SCALMN,SCALMX,GAMFU9,EPS,ACCUR,
14038     1              SCALEP,ERROR,IFAIL)
14039C
14040          IF(IFAIL.EQ.1)THEN
14041            WRITE(ICOUT,999)
14042            CALL DPWRST('XXX','BUG ')
14043            WRITE(ICOUT,301)
14044            CALL DPWRST('XXX','BUG ')
14045            WRITE(ICOUT,303)
14046            CALL DPWRST('XXX','BUG ')
14047            WRITE(ICOUT,305)
14048            CALL DPWRST('XXX','BUG ')
14049            WRITE(ICOUT,307)
14050            CALL DPWRST('XXX','BUG ')
14051          ELSEIF(IFAIL.EQ.2)THEN
14052            WRITE(ICOUT,999)
14053            CALL DPWRST('XXX','BUG ')
14054            WRITE(ICOUT,311)
14055            CALL DPWRST('XXX','BUG ')
14056            WRITE(ICOUT,313)
14057            CALL DPWRST('XXX','BUG ')
14058            WRITE(ICOUT,315)
14059            CALL DPWRST('XXX','BUG ')
14060            NPERC=0
14061          ELSEIF(IFAIL.EQ.3)THEN
14062            WRITE(ICOUT,999)
14063            CALL DPWRST('XXX','BUG ')
14064            WRITE(ICOUT,311)
14065            CALL DPWRST('XXX','BUG ')
14066            WRITE(ICOUT,323)
14067            CALL DPWRST('XXX','BUG ')
14068            WRITE(ICOUT,325)
14069            CALL DPWRST('XXX','BUG ')
14070            WRITE(ICOUT,315)
14071            CALL DPWRST('XXX','BUG ')
14072            GHATP=0.0
14073            NPERC=0
14074          ENDIF
14075          D1=SCALEP
14076          D2=GHATP
14077          V11=SCALSE**2
14078          V22=SHAPSE**2
14079          V21=COVSE
14080          V12=V21
14081          TERM11=D1*D1*V11
14082          TERM12=D1*D2*V12
14083          TERM21=D2*D1*V21
14084          TERM22=D2*D2*V22
14085          SEXQP=TERM11+TERM12+TERM21+TERM22
14086          IF(SEXQP.GE.0.0)THEN
14087            SEXQP=SQRT(SEXQP)
14088          ELSE
14089            SEXQP=0.0
14090          ENDIF
14091          XQPSE(I)=SEXQP
14092          XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
14093          XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
14094          WRITE(IOUNI1,'(5E15.7)')
14095     1         QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
14096 3529   CONTINUE
14097 3531   FORMAT(15X,'       POINT     ','   STANDARD    ',
14098     1         '     LOWER     ',
14099     1         '     UPPER')
14100 3532   FORMAT('    PERCENTILE ','     ESTIMATE   ',
14101     1         '     ERROR     ',
14102     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
14103      ENDIF
14104C
14105 4199 CONTINUE
14106C               *************************************
14107C               **   STEP 42--                     **
14108C               **   WRITE OUT EVERYTHING          **
14109C               **   FOR GAMMA MLE ESTIMATE        **
14110C               *************************************
14111C
14112      ISTEPN='42'
14113      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG2')
14114     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
14115C
14116C     PRINT SUMMARY STATISTICS TABLE
14117C
14118      IF(IPRINT.EQ.'OFF')GOTO9000
14119C
14120      NUMDIG=7
14121      IF(IFORSW.EQ.'1')NUMDIG=1
14122      IF(IFORSW.EQ.'2')NUMDIG=2
14123      IF(IFORSW.EQ.'3')NUMDIG=3
14124      IF(IFORSW.EQ.'4')NUMDIG=4
14125      IF(IFORSW.EQ.'5')NUMDIG=5
14126      IF(IFORSW.EQ.'6')NUMDIG=6
14127      IF(IFORSW.EQ.'7')NUMDIG=7
14128      IF(IFORSW.EQ.'8')NUMDIG=8
14129      IF(IFORSW.EQ.'9')NUMDIG=9
14130      IF(IFORSW.EQ.'0')NUMDIG=0
14131      IF(IFORSW.EQ.'E')NUMDIG=-2
14132      IF(IFORSW.EQ.'-2')NUMDIG=-2
14133      IF(IFORSW.EQ.'-3')NUMDIG=-3
14134      IF(IFORSW.EQ.'-4')NUMDIG=-4
14135      IF(IFORSW.EQ.'-5')NUMDIG=-5
14136      IF(IFORSW.EQ.'-6')NUMDIG=-6
14137      IF(IFORSW.EQ.'-7')NUMDIG=-7
14138      IF(IFORSW.EQ.'-8')NUMDIG=-8
14139      IF(IFORSW.EQ.'-9')NUMDIG=-9
14140C
14141      IF(IGAMFL.EQ.'IGAM')THEN
14142        ITITLE='Two-Parameter Inverted Gamma Parameter Estimation:'
14143        NCTITL=50
14144        ITITLZ='Censored Case'
14145        NCTITZ=13
14146      ELSE
14147        ITITLE='Two-Parameter Gamma Parameter Estimation:'
14148        NCTITL=41
14149        ITITLZ='Censored Case'
14150        NCTITZ=13
14151      ENDIF
14152      ICNT=1
14153      ITEXT(ICNT)='Summary Statistics:'
14154      NCTEXT(ICNT)=19
14155      AVALUE(ICNT)=0.0
14156      IDIGIT(ICNT)=-99
14157      ICNT=ICNT+1
14158      ITEXT(ICNT)='Total Number of Observations:'
14159      NCTEXT(ICNT)=29
14160      AVALUE(ICNT)=REAL(N)
14161      IDIGIT(ICNT)=0
14162      ICNT=ICNT+1
14163      ITEXT(ICNT)='Number of Uncensored Observations:'
14164      NCTEXT(ICNT)=34
14165      AVALUE(ICNT)=REAL(IR)
14166      IDIGIT(ICNT)=0
14167      ICNT=ICNT+1
14168      ITEXT(ICNT)='Number of Censored Observations:'
14169      NCTEXT(ICNT)=32
14170      AVALUE(ICNT)=REAL(IM)
14171      IDIGIT(ICNT)=0
14172      ICNT=ICNT+1
14173      ITEXT(ICNT)='Sample Mean (All Data):'
14174      NCTEXT(ICNT)=23
14175      AVALUE(ICNT)=XMEANF
14176      IDIGIT(ICNT)=NUMDIG
14177      ICNT=ICNT+1
14178      ITEXT(ICNT)='Sample SD (All Data):'
14179      NCTEXT(ICNT)=21
14180      AVALUE(ICNT)=XSDF
14181      IDIGIT(ICNT)=NUMDIG
14182      ICNT=ICNT+1
14183      ITEXT(ICNT)='Sample Minimum (All Data):'
14184      NCTEXT(ICNT)=26
14185      AVALUE(ICNT)=XMINF
14186      IDIGIT(ICNT)=NUMDIG
14187      ICNT=ICNT+1
14188      ITEXT(ICNT)='Sample Maximum (All Data):'
14189      NCTEXT(ICNT)=26
14190      AVALUE(ICNT)=XMAXF
14191      IDIGIT(ICNT)=NUMDIG
14192      ICNT=ICNT+1
14193      ITEXT(ICNT)='Sample Geometric Mean (All Data):'
14194      NCTEXT(ICNT)=33
14195      AVALUE(ICNT)=XGEOMF
14196      IDIGIT(ICNT)=NUMDIG
14197      ICNT=ICNT+1
14198      ITEXT(ICNT)='Sample Mean (Uncensored Data):'
14199      NCTEXT(ICNT)=30
14200      AVALUE(ICNT)=XMEANC
14201      IDIGIT(ICNT)=NUMDIG
14202      ICNT=ICNT+1
14203      ITEXT(ICNT)='Sample SD (Uncensored Data):'
14204      NCTEXT(ICNT)=26
14205      AVALUE(ICNT)=XSDF
14206      IDIGIT(ICNT)=NUMDIG
14207      ICNT=ICNT+1
14208      ITEXT(ICNT)='Sample Minimum (Uncensored Data):'
14209      NCTEXT(ICNT)=33
14210      AVALUE(ICNT)=XMINC
14211      IDIGIT(ICNT)=NUMDIG
14212      ICNT=ICNT+1
14213      ITEXT(ICNT)='Sample Maximum (Uncensored Data):'
14214      NCTEXT(ICNT)=33
14215      AVALUE(ICNT)=XMAXC
14216      IDIGIT(ICNT)=NUMDIG
14217      ICNT=ICNT+1
14218      ITEXT(ICNT)='Sample Geometric Mean (Uncensored Data):'
14219      NCTEXT(ICNT)=40
14220      AVALUE(ICNT)=XGEOMC
14221      IDIGIT(ICNT)=NUMDIG
14222      ICNT=ICNT+1
14223      ITEXT(ICNT)=' '
14224      NCTEXT(ICNT)=0
14225      AVALUE(ICNT)=0.0
14226      IDIGIT(ICNT)=-1
14227C
14228      ICNT=ICNT+1
14229      ITEXT(ICNT)='Moments:'
14230      NCTEXT(ICNT)=8
14231      AVALUE(ICNT)=0.0
14232      IDIGIT(ICNT)=-1
14233      ICNT=ICNT+1
14234      ITEXT(ICNT)='Estimate of Shape (Gamma):'
14235      NCTEXT(ICNT)=26
14236      AVALUE(ICNT)=SHAPMO
14237      IDIGIT(ICNT)=NUMDIG
14238      ICNT=ICNT+1
14239      ITEXT(ICNT)='Estimate of Scale:'
14240      NCTEXT(ICNT)=18
14241      AVALUE(ICNT)=SCALMO
14242      IDIGIT(ICNT)=NUMDIG
14243      ICNT=ICNT+1
14244      ITEXT(ICNT)=' '
14245      NCTEXT(ICNT)=0
14246      AVALUE(ICNT)=0.0
14247      IDIGIT(ICNT)=-1
14248C
14249      ICNT=ICNT+1
14250      ITEXT(ICNT)='Maximum Likelihood:'
14251      NCTEXT(ICNT)=19
14252      AVALUE(ICNT)=0.0
14253      IDIGIT(ICNT)=-1
14254      ICNT=ICNT+1
14255      ITEXT(ICNT)='Estimate of Shape (Gamma):'
14256      NCTEXT(ICNT)=26
14257      AVALUE(ICNT)=SHAPML
14258      IDIGIT(ICNT)=NUMDIG
14259      ICNT=ICNT+1
14260      ITEXT(ICNT)='Standard Error of Shape:'
14261      NCTEXT(ICNT)=24
14262      AVALUE(ICNT)=SHAPSE
14263      IDIGIT(ICNT)=NUMDIG
14264      ICNT=ICNT+1
14265      ITEXT(ICNT)='Estimate of Scale:'
14266      NCTEXT(ICNT)=18
14267      AVALUE(ICNT)=SCALML
14268      IDIGIT(ICNT)=NUMDIG
14269      ICNT=ICNT+1
14270      ITEXT(ICNT)='Standard Error of Scale:'
14271      NCTEXT(ICNT)=24
14272      AVALUE(ICNT)=SCALSE
14273      IDIGIT(ICNT)=NUMDIG
14274      ICNT=ICNT+1
14275      ITEXT(ICNT)='Shape/Scale Covariance:'
14276      NCTEXT(ICNT)=23
14277      AVALUE(ICNT)=COVSE
14278      IDIGIT(ICNT)=NUMDIG
14279C
14280CCCCC ICNT=ICNT+1
14281CCCCC ITEXT(ICNT)='Log-likelihood:'
14282CCCCC NCTEXT(ICNT)=15
14283CCCCC AVALUE(ICNT)=ALIK
14284CCCCC IDIGIT(ICNT)=-7
14285CCCCC ICNT=ICNT+1
14286CCCCC ITEXT(ICNT)='AIC:'
14287CCCCC NCTEXT(ICNT)=4
14288CCCCC AVALUE(ICNT)=AIC
14289CCCCC IDIGIT(ICNT)=-7
14290CCCCC ICNT=ICNT+1
14291CCCCC ITEXT(ICNT)='AICc:'
14292CCCCC NCTEXT(ICNT)=5
14293CCCCC AVALUE(ICNT)=AICC
14294CCCCC IDIGIT(ICNT)=-7
14295CCCCC ICNT=ICNT+1
14296CCCCC ITEXT(ICNT)='BIC:'
14297CCCCC NCTEXT(ICNT)=4
14298CCCCC AVALUE(ICNT)=BIC
14299CCCCC IDIGIT(ICNT)=-7
14300C
14301      NUMROW=ICNT
14302      DO2310I=1,NUMROW
14303        NTOT(I)=15
14304 2310 CONTINUE
14305C
14306      IFRST=.TRUE.
14307      ILAST=.TRUE.
14308      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
14309     1            AVALUE,IDIGIT,
14310     1            NTOT,NUMROW,
14311     1            ICAPSW,ICAPTY,ILAST,IFRST,
14312     1            ISUBRO,IBUGA3,IERROR)
14313C
14314      ILIKFL='OFF'
14315      CALL DPDTA8(ALOWSC,AUPPSC,ALOWS2,AUPPS2,
14316     1            ALOWGA,AUPPGA,ALOWG2,AUPPG2,ALPHA,NUMALP,
14317     1            ICAPSW,ICAPTY,NUMDIG,ILIKFL,
14318     1            ISUBRO,IBUGA3,IERROR)
14319C
14320      IF(NPERC.GT.1)THEN
14321        ILIKFL='OFF'
14322        CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
14323     1              ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
14324     1              ISUBRO,IBUGA3,IERROR)
14325      ENDIF
14326C
14327C               *****************
14328C               **  STEP 90--  **
14329C               **  EXIT       **
14330C               *****************
14331C
14332 9000 CONTINUE
14333      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG2')THEN
14334        WRITE(ICOUT,999)
14335        CALL DPWRST('XXX','WRIT')
14336        WRITE(ICOUT,9011)
14337 9011   FORMAT('***** AT THE END       OF DPMLG2--')
14338        CALL DPWRST('XXX','WRIT')
14339        WRITE(ICOUT,9012)N,IBUGA3,IERROR
14340 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
14341        CALL DPWRST('XXX','WRIT')
14342        WRITE(ICOUT,9015)N
14343 9015   FORMAT('N = ',I8)
14344        CALL DPWRST('XXX','WRIT')
14345      ENDIF
14346C
14347      RETURN
14348      END
14349      SUBROUTINE DPMLG3(Y,N,
14350     1                  XTEMP,DTEMP,ITEMP,MAXNXT,
14351     1                  ALOCML,SCALML,SHAPML,
14352     1                  ALOCSE,SCALSE,SHAPSE,
14353     1                  ALOCMO,SCALMO,SHAPMO,
14354     1                  ALOCMM,SCALMM,SHAPMM,
14355     1                  ALOCS2,SCALS2,SHAPS2,
14356     1                  AICML,AICCML,BICML,ALIKML,
14357     1                  AICMO,AICCMO,BICMO,ALIKMO,
14358     1                  AICMM,AICCMM,BICMM,ALIKMM,
14359     1                  NUMV,
14360     1                  ICAPSW,ICAPTY,IFORSW,
14361     1                  QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
14362     1                  IOUNI1,IOUNI2,ALPHAP,
14363     1                  ISUBRO,IBUGA3,IERROR)
14364C
14365C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
14366C              FOR THE 3-PARAMETER GAMMA DISTRIBUTION FOR THE FULL
14367C              SAMPLE CASE.
14368C     EXAMPLE--3-PARAMETER GAMMA MAXIMUM LIKELIHOOD Y
14369C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
14370C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
14371C                1999, CHAPTER 13.
14372C              --COHEN AND WHITTEN (1988), "PARAMETER ESTIMATION IN
14373C                RELIABILITY AND LIFE SPAN MODELS", MARCEL DEKKER, INC.,
14374C                CHAPTER 6.
14375C     WRITTEN BY--ALAN HECKERT
14376C                 STATISTICAL ENGINEERING DIVISION
14377C                 INFORMATION TECHNOLOGY LABORATORY
14378C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
14379C                 GAITHERSBURG, MD 20899-8980
14380C                 PHONE--301-975-2899
14381C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
14382C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
14383C     LANGUAGE--ANSI FORTRAN (1977)
14384C     VERSION NUMBER--2014/4
14385C     ORIGINAL VERSION--APRIL     2014.
14386C
14387C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
14388C
14389      CHARACTER*4 ICAPSW
14390      CHARACTER*4 ICAPTY
14391      CHARACTER*4 IFORSW
14392      CHARACTER*4 ISUBRO
14393      CHARACTER*4 IBUGA3
14394      CHARACTER*4 IERROR
14395C
14396      CHARACTER*4 IWRITE
14397      CHARACTER*4 ISUBN1
14398      CHARACTER*4 ISUBN2
14399      CHARACTER*4 ISTEPN
14400      CHARACTER*4 ILIKFL
14401      CHARACTER*4 IGAMFL
14402      CHARACTER*4 ICASAN
14403      CHARACTER*4 IOPFLG
14404      CHARACTER*40 IDIST
14405C
14406C---------------------------------------------------------------------
14407C
14408      PARAMETER (NUMALP=8)
14409      DIMENSION ALPHA(NUMALP)
14410      DIMENSION ALOWLO(NUMALP)
14411      DIMENSION AUPPLO(NUMALP)
14412      DIMENSION ALOWSC(NUMALP)
14413      DIMENSION AUPPSC(NUMALP)
14414      DIMENSION ALOWSH(NUMALP)
14415      DIMENSION AUPPSH(NUMALP)
14416C
14417      DIMENSION Y(*)
14418      DIMENSION XTEMP(*)
14419      DIMENSION QP(*)
14420      DIMENSION XQPHAT(*)
14421      DIMENSION XQPSE(*)
14422      DIMENSION XQPLCL(*)
14423      DIMENSION XQPUCL(*)
14424      INTEGER   ITEMP(*)
14425      DOUBLE PRECISION DTEMP(*)
14426C
14427      INCLUDE 'DPCOST.INC'
14428C
14429      DIMENSION COV(3,3)
14430      DIMENSION COVMM(3,3)
14431CCCCC DIMENSION COVU(3,3)
14432CCCCC DOUBLE PRECISION D(3)
14433C
14434CCCCC DOUBLE PRECISION DSIGMA
14435CCCCC DOUBLE PRECISION DS
14436CCCCC DOUBLE PRECISION DLOC
14437CCCCC DOUBLE PRECISION DZQ
14438CCCCC DOUBLE PRECISION DTERM1
14439CCCCC DOUBLE PRECISION DVAR
14440CCCCC DOUBLE PRECISION DPPF
14441C
14442      PARAMETER (MAXROW=100)
14443      CHARACTER*60 ITITLE
14444      CHARACTER*60 ITITLZ
14445      CHARACTER*40 ITEXT(MAXROW)
14446      REAL         AVALUE(MAXROW)
14447      INTEGER      NCTEXT(MAXROW)
14448      INTEGER      IDIGIT(MAXROW)
14449      INTEGER      NTOT(MAXROW)
14450      LOGICAL IFRST
14451      LOGICAL ILAST
14452C
14453C---------------------------------------------------------------------
14454C
14455      INCLUDE 'DPCOP2.INC'
14456C
14457      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
14458C
14459C-----START POINT-----------------------------------------------------
14460C
14461      ISUBN1='DPML'
14462      ISUBN2='G3  '
14463      IDIST='GAMMA'
14464      IGAMFL='GAMM'
14465      ICASAN='3GAM'
14466      IERROR='NO'
14467      IFLAG1=0
14468      IFLAG2=0
14469C
14470      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG3')THEN
14471        WRITE(ICOUT,999)
14472  999   FORMAT(1X)
14473        CALL DPWRST('XXX','WRIT')
14474        WRITE(ICOUT,51)
14475   51   FORMAT('**** AT THE BEGINNING OF DPMLG3--')
14476        CALL DPWRST('XXX','WRIT')
14477        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NUMV,NPERC,IOUNI1,IOUNI2
14478   52   FORMAT('IBUGA3,ISUBRO,N,NUMV,NPERC,IOUNI1,IOUNI2 = ',
14479     1         2(A4,2X),5I8)
14480        CALL DPWRST('XXX','WRIT')
14481        DO56I=1,MIN(N,100)
14482          WRITE(ICOUT,57)I,Y(I)
14483   57     FORMAT('I,Y(I) = ',I8,G15.7)
14484          CALL DPWRST('XXX','WRIT')
14485   56   CONTINUE
14486        DO66I=1,8
14487          WRITE(ICOUT,67)I,QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I),XQPSE(I)
14488   67     FORMAT('I,QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I),XQPSE(I) = ',
14489     1           I8,5G15.7)
14490          CALL DPWRST('XXX','WRIT')
14491   66   CONTINUE
14492      ENDIF
14493C
14494C               ********************************************
14495C               **  STEP 11--                             **
14496C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
14497C               ********************************************
14498C
14499      ISTEPN='11'
14500      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG3')
14501     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
14502C
14503C     STEP 1: OBTAIN POINT ESTIMATES AND STANDARD ERRORS
14504C
14505      IFLAG1=0
14506      IFLAG2=0
14507C
14508      IWRITE='OFF'
14509      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
14510      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
14511      CALL STMOM3(Y,N,IWRITE,XSKEW,IBUGA3,IERROR)
14512      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
14513      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
14514      XVAR=XSD**2
14515C
14516      CALL GAMMO1(XMEAN,XSD,XMIN,XSKEW,N,PSTAMV,
14517     1            ALOCMO,SCALMO,SHAPMO,
14518     1            ALOCMM,SCALMM,SHAPMM,
14519     1            ISUBRO,IBUGA3,IERROR)
14520C
14521      IF(I3GAME.EQ.'PROF')THEN
14522        IOPFLG='ON'
14523        CALL GAMML8(Y,N,IGAMFL,P3GAMI,IOPFLG,
14524     1              XTEMP,DTEMP,QP,
14525     1              ALOCML,SCALML,SHAPML,
14526     1              ISUBRO,IBUGA3,IERROR)
14527        IF(SHAPML.GT.0.0)THEN
14528          CALL GAMLI1(Y,N,ICASAN,IGAMFL,ALOCML,SCALML,SHAPML,
14529     1                ALIKML,AICML,AICCML,BICML,
14530     1                ISUBRO,IBUGA3,IERROR)
14531          CALL GAMML5(ALOCML,SCALML,SHAPML,Y,N,COV,
14532     1                XTEMP,ITEMP,MAXNXT,
14533     1                ISUBRO,IBUGA3,IERROR)
14534          IF(COV(1,1).GE.0.0 .AND. COV(2,2).GE.0.0 .AND.
14535     1       COV(3,3).GE.0.0)THEN
14536            IFLAG1=1
14537            ALOCSE=SQRT(COV(1,1))
14538            SCALSE=SQRT(COV(2,2))
14539            SHAPSE=SQRT(COV(3,3))
14540          ENDIF
14541        ENDIF
14542C
14543      ELSE
14544        CALL GAMML3(Y,N,DTEMP,
14545     1              XMEAN,XSD,XVAR,XMIN,XMAX,XSKEW,
14546     1              ALOCML,SCALML,SHAPML,
14547     1              ISUBRO,IBUGA3,IERROR)
14548        IF(SHAPML.GT.0.0)THEN
14549          CALL GAMLI1(Y,N,ICASAN,IGAMFL,ALOCML,SCALML,SHAPML,
14550     1                ALIKML,AICML,AICCML,BICML,
14551     1                ISUBRO,IBUGA3,IERROR)
14552          CALL GAMML5(ALOCML,SCALML,SHAPML,Y,N,COV,
14553     1                XTEMP,ITEMP,MAXNXT,
14554     1                ISUBRO,IBUGA3,IERROR)
14555          IF(COV(1,1).GE.0.0 .AND. COV(2,2).GE.0.0 .AND.
14556     1       COV(3,3).GE.0.0)THEN
14557            IFLAG1=1
14558            ALOCSE=SQRT(COV(1,1))
14559            SCALSE=SQRT(COV(2,2))
14560            SHAPSE=SQRT(COV(3,3))
14561          ENDIF
14562        ENDIF
14563      ENDIF
14564C
14565      IF(SHAPMO.GT.0.0)THEN
14566        CALL GAMLI1(Y,N,ICASAN,IGAMFL,ALOCMO,SCALMO,SHAPMO,
14567     1              ALIKMO,AICMO,AICCMO,BICMO,
14568     1              ISUBRO,IBUGA3,IERROR)
14569      ENDIF
14570C
14571      IF(SHAPMM.GT.0.0)THEN
14572        CALL GAMLI1(Y,N,ICASAN,IGAMFL,ALOCMM,SCALMM,SHAPMM,
14573     1              ALIKMM,AICMM,AICCMM,BICMM,
14574     1              ISUBRO,IBUGA3,IERROR)
14575        CALL GAMML5(ALOCMM,SCALMM,SHAPMM,Y,N,COVMM,
14576     1              XTEMP,ITEMP,MAXNXT,
14577     1              ISUBRO,IBUGA3,IERROR)
14578        IF(COVMM(1,1).GE.0.0 .AND. COVMM(2,2).GE.0.0 .AND.
14579     1      COVMM(3,3).GE.0.0)THEN
14580          IFLAG2=1
14581          ALOCS2=SQRT(COVMM(1,1))
14582          SCALS2=SQRT(COVMM(2,2))
14583          SHAPS2=SQRT(COVMM(3,3))
14584        ENDIF
14585      ENDIF
14586C
14587      IFLAG3=0
14588      IF(SHAPML.LE.1.0)IFLAG1=0
14589      IF(SHAPMM.LE.1.0)IFLAG2=0
14590      IF(IFLAG1.EQ.1)THEN
14591        IFLAG3=1
14592      ELSEIF(IFLAG2.EQ.1)THEN
14593        IFLAG3=2
14594      ENDIF
14595C
14596C     STEP 2: CONFIDENCE INTERVALS FOR PARAMETERS BASED ON
14597C             NORMAL APPROXIMATION.
14598C
14599C             USE ML STANDARD ERRORS IF THEY EXIST.  OTHERWISE,
14600C             USE MODIFIED MOMENT STANDARD ERRORS.
14601C
14602      DO2210I=1,NUMALP
14603        ALP=ALPHA(I)
14604        P=1.0-(ALP/2.0)
14605        CALL NORPPF(P,PPF)
14606        IF(IFLAG3.EQ.1)THEN
14607          ALOWLO(I)=ALOCML - PPF*ALOCSE
14608          AUPPLO(I)=ALOCML + PPF*ALOCSE
14609          ALOWSC(I)=SCALML - PPF*SCALSE
14610          IF(ALOWSC(I).LE.0.0)ALOWSC(I)=0.0
14611          AUPPSC(I)=SCALML + PPF*SCALSE
14612          ALOWSH(I)=SHAPML - PPF*SHAPSE
14613          IF(ALOWSH(I).LE.0.0)ALOWSH(I)=0.0
14614          AUPPSH(I)=SHAPML + PPF*SHAPSE
14615        ELSEIF(IFLAG3.EQ.2)THEN
14616          ALOWLO(I)=ALOCMM - PPF*ALOCS2
14617          AUPPLO(I)=ALOCMM + PPF*ALOCS2
14618          ALOWSC(I)=SCALMM - PPF*SCALS2
14619          IF(ALOWSC(I).LE.0.0)ALOWSC(I)=0.0
14620          AUPPSC(I)=SCALMM + PPF*SCALS2
14621          ALOWSH(I)=SHAPML - PPF*SHAPS2
14622          IF(ALOWSH(I).LE.0.0)ALOWSH(I)=0.0
14623          AUPPSH(I)=SHAPML + PPF*SHAPS2
14624        ELSE
14625          ALOWLO(I)=CPUMIN
14626          AUPPLO(I)=CPUMIN
14627          ALOWSC(I)=CPUMIN
14628          AUPPSC(I)=CPUMIN
14629          ALOWSH(I)=CPUMIN
14630          AUPPSH(I)=CPUMIN
14631        ENDIF
14632 2210 CONTINUE
14633C
14634C     APPROXIMATE CONFIDENCE INTERVALS FOR SELECTED PERCENTILES BASED
14635C     ON MAXIMUM LIKELIHOOD ESTIMATES.  FOLLOWS EXAMPLE 6 ON PP. 175-177
14636C     OF BURY.
14637C
14638C     Xp(Lower) = XpHat - NORPPF(1 - ALPHA/2)*Xp(SE)
14639C     Xp(Upper) = XpHat + NORPPF(1 - ALPHA/2)*Xp(SE)
14640C
14641C     WHERE
14642C
14643C     Xp(SE) IS THE PERCENTILE STANDARD ERROR.  THIS IS COMPUTED AS:
14644C
14645C     Xp(SE) = SQRT{SUM[j=1 to 3][SUM[k=1 to 3][d(j)*d(k)*COV(j,k)]]}
14646C
14647C     WHERE
14648C
14649C     COV  = PARAMETER VARIANCE-COVARIANCE MATRIX
14650C     D1   = PARTIAL DERIVATIVE OF THE PERCENT POINT FUNCTION WITH
14651C            RESPECT TO THE LOCATION PARAMETER
14652C          = 1
14653C     D2   = PARTIAL DERIVATIVE OF THE PERCENT POINT FUNCTION WITH
14654C            RESPECT TO THE SCALE PARAMETER
14655C          = EXP(Zp*SIGMA)
14656C     D3   = PARTIAL DERIVATIVE OF THE PERCENT POINT FUNCTION WITH
14657C            RESPECT TO THE SHAPE PARAMETER
14658C          = SCALE*Zp*EXP(SIGMA*Zp)
14659C     P    = THE DESIRED PERCENTILE
14660C     Zp   = NORPPF(p)
14661C
14662C     NOTE THAT ONE-SIDED PERCENTILE INTERVALS ARE EQUIVALENT TO
14663C     ONE-SIDED TOLERANCE INTERVALS.
14664C
14665      IF(NPERC.GE.1)THEN
14666C
14667        IF(IDTYPR.EQ.'LOWE')THEN
14668          ALPHL=ALPHAP
14669          ALPHU=1.0 - ALPHAP
14670        ELSEIF(IDTYPR.EQ.'UPPE')THEN
14671          ALPHL=ALPHAP
14672          ALPHU=1.0 - ALPHAP
14673        ELSE
14674          ALPHL=ALPHAP/2.0
14675          ALPHU=1.0 - ALPHAP/2.0
14676        ENDIF
14677        CALL NORPPF(ALPHU,Z95)
14678C
14679CCCCC   IF(IFLAG3.EQ.1)THEN
14680CCCCC     SIGMA=SHAPML
14681CCCCC     U=UHATML
14682CCCCC     COVU(2,2)=UHATSE**2
14683CCCCC   ELSEIF(IFLAG3.EQ.2)THEN
14684CCCCC     SIGMA=SHAPMM
14685CCCCC     U=UHATMM
14686CCCCC     COVU(2,2)=UHATS2**2
14687CCCCC   ELSE
14688CCCCC     GOTO2499
14689CCCCC   ENDIF
14690CCCCC   AN=REAL(N)
14691CCCCC   W=EXP(-2.0*U + SIGMA**2)*(EXP(SIGMA**2)*(SIGMA**2+1.0) -
14692CCCCC1    2.0*SIGMA**2 - 1.0)
14693CCCCC   AFACT=SIGMA**2/(AN*W)
14694CCCCC   COVU(1,1)=COV(1,1)
14695CCCCC   COVU(3,3)=COV(3,3)
14696CCCCC   TERM1=-EXP(-U + SIGMA**2/2.0)
14697CCCCC   COVU(1,2)=AFACT*TERM1
14698CCCCC   COVU(2,1)=COVU(1,2)
14699CCCCC   TERM1=SIGMA*EXP(-U + SIGMA**2/2.0)
14700CCCCC   COVU(1,3)=AFACT*TERM1
14701CCCCC   COVU(3,1)=COVU(1,3)
14702CCCCC   TERM1=-SIGMA*EXP(-2.0*U + SIGMA**2)
14703CCCCC   COVU(2,3)=AFACT*TERM1
14704CCCCC   COVU(3,2)=COVU(2,3)
14705C
14706CCCCC   WRITE(IOUNI1,2431)
14707CCCCC   WRITE(IOUNI1,2432)
14708C
14709CCCCC   IF(IFLAG3.EQ.1)THEN
14710CCCCC     DSIGMA=DBLE(SHAPML)
14711CCCCC     DS=DBLE(SCALML)
14712CCCCC     DLOC=DBLE(ALOCML)
14713CCCCC     DU=DBLE(UHATML)
14714CCCCC   ELSEIF(IFLAG3.EQ.2)THEN
14715CCCCC     DSIGMA=DBLE(SHAPMM)
14716CCCCC     DS=DBLE(SCALMM)
14717CCCCC     DLOC=DBLE(ALOCMM)
14718CCCCC     DU=DBLE(UHATMM)
14719CCCCC   ELSE
14720CCCCC     GOTO2499
14721CCCCC   ENDIF
14722C
14723CCCCC   DO2429I=1,NPERC
14724CCCCC     QPTEMP=QP(I)/100.0
14725CCCCC     CALL GAMPPF(DBLE(QPTEMP),DSIGMA,DPPF)
14726CCCCC     XQPHAT(I)=REAL(DLOC + DS*DPPF)
14727C
14728CCCCC     CALL NODPPF(DBLE(QPTEMP),DZQ)
14729C
14730CCCCC     D(1)=1.0D0
14731CCCCC     D(2)=DEXP(DZQ*DSIGMA)
14732CCCCC     D(3)=DS*DZQ*DEXP(DSIGMA*DZQ)
14733CCCCC     D(2)=DEXP(DU + DSIGMA*DZQ)
14734CCCCC     D(3)=DZQ*DEXP(DU + DSIGMA*DZQ)
14735CCCCC     DVAR=0.0D0
14736CCCCC     DO2460J=1,3
14737CCCCC       DO2470K=1,3
14738CCCCC         DTERM1=D(J)*D(K)*DBLE(COVU(J,K))
14739CCCCC         DVAR=DVAR + DTERM1
14740C2470       CONTINUE
14741C2460     CONTINUE
14742CCCCC     SEXQP=REAL(DSQRT(DVAR))
14743C
14744CCCCC     XQPSE(I)=SEXQP
14745CCCCC     IF(IDTYPR.EQ.'LOWE')THEN
14746CCCCC       XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
14747CCCCC       XQPUCL(I)=CPUMIN
14748CCCCC     ELSEIF(IDTYPR.EQ.'UPPE')THEN
14749CCCCC       XQPLCL(I)=CPUMIN
14750CCCCC       XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
14751CCCCC     ELSE
14752CCCCC       XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
14753CCCCC       XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
14754CCCCC     ENDIF
14755CCCCC     WRITE(IOUNI1,'(5E15.7)')
14756CCCCC1         QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
14757C2429   CONTINUE
14758C2431   FORMAT(15X,'       POINT     ','     LOWER     ',
14759CCCCC1         '     UPPER')
14760C2432   FORMAT('    PERCENTILE ','     ESTIMATE   ',
14761CCCCC1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
14762      ENDIF
14763C
14764C               *************************************
14765C               **   STEP 42--                     **
14766C               **   WRITE OUT EVERYTHING          **
14767C               **   FOR GAMMA   MLE ESTIMATE      **
14768C               *************************************
14769C
14770      ISTEPN='42'
14771      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG3')
14772     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
14773C
14774C     PRINT SUMMARY STATISTICS TABLE
14775C
14776      IF(IPRINT.EQ.'OFF')GOTO9000
14777C
14778      NUMDIG=7
14779      IF(IFORSW.EQ.'1')NUMDIG=1
14780      IF(IFORSW.EQ.'2')NUMDIG=2
14781      IF(IFORSW.EQ.'3')NUMDIG=3
14782      IF(IFORSW.EQ.'4')NUMDIG=4
14783      IF(IFORSW.EQ.'5')NUMDIG=5
14784      IF(IFORSW.EQ.'6')NUMDIG=6
14785      IF(IFORSW.EQ.'7')NUMDIG=7
14786      IF(IFORSW.EQ.'8')NUMDIG=8
14787      IF(IFORSW.EQ.'9')NUMDIG=9
14788      IF(IFORSW.EQ.'0')NUMDIG=0
14789      IF(IFORSW.EQ.'E')NUMDIG=-2
14790      IF(IFORSW.EQ.'-2')NUMDIG=-2
14791      IF(IFORSW.EQ.'-3')NUMDIG=-3
14792      IF(IFORSW.EQ.'-4')NUMDIG=-4
14793      IF(IFORSW.EQ.'-5')NUMDIG=-5
14794      IF(IFORSW.EQ.'-6')NUMDIG=-6
14795      IF(IFORSW.EQ.'-7')NUMDIG=-7
14796      IF(IFORSW.EQ.'-8')NUMDIG=-8
14797      IF(IFORSW.EQ.'-9')NUMDIG=-9
14798C
14799      ITITLE='Three-Parameter Gamma Parameter Estimation:'
14800      NCTITL=47
14801      IF(I3GAME.EQ.'PROF')THEN
14802        ITITLZ='Full Sample Case (Profile Likelihood)'
14803        NCTITZ=37
14804      ELSE
14805        ITITLZ='Full Sample Case (Maximim Likelihood)'
14806        NCTITZ=37
14807      ENDIF
14808C
14809      ITEXT(1)='Summary Statistics:'
14810      NCTEXT(1)=19
14811      AVALUE(1)=0.0
14812      IDIGIT(1)=-1
14813      ITEXT(2)='Number of Observations:'
14814      NCTEXT(2)=23
14815      AVALUE(2)=REAL(N)
14816      IDIGIT(2)=0
14817      ITEXT(3)='Sample Mean:'
14818      NCTEXT(3)=12
14819      AVALUE(3)=XMEAN
14820      IDIGIT(3)=NUMDIG
14821      ITEXT(4)='Sample Standard Deviation:'
14822      NCTEXT(4)=26
14823      AVALUE(4)=XSD
14824      IDIGIT(4)=NUMDIG
14825      ITEXT(5)='Sample Skewness:'
14826      NCTEXT(5)=16
14827      AVALUE(5)=XSKEW
14828      IDIGIT(5)=NUMDIG
14829      ITEXT(6)='Sample Minimum:'
14830      NCTEXT(6)=15
14831      AVALUE(6)=XMIN
14832      IDIGIT(6)=NUMDIG
14833      ITEXT(7)='Sample Maximum:'
14834      NCTEXT(7)=15
14835      AVALUE(7)=XMAX
14836      IDIGIT(7)=NUMDIG
14837      NUMROW=7
14838C
14839      DO2310I=1,NUMROW
14840        NTOT(I)=15
14841 2310 CONTINUE
14842C
14843      IFRST=.TRUE.
14844      ILAST=.FALSE.
14845      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
14846     1            NCTEXT,AVALUE,IDIGIT,
14847     1            NTOT,NUMROW,
14848     1            ICAPSW,ICAPTY,ILAST,IFRST,
14849     1            ISUBRO,IBUGA3,IERROR)
14850      IFRST=.FALSE.
14851      ITITLE=' '
14852      NCTITL=0
14853      ICNT=0
14854C
14855      IF(SHAPMO.GT.0.0)THEN
14856        ICNT=ICNT+1
14857        ITEXT(ICNT)='Moment Estimates:'
14858        NCTEXT(ICNT)=18
14859        AVALUE(ICNT)=0.0
14860        IDIGIT(ICNT)=-1
14861        ICNT=ICNT+1
14862        ITEXT(ICNT)='Estimate of Location:'
14863        NCTEXT(ICNT)=21
14864        AVALUE(ICNT)=ALOCMO
14865        IDIGIT(ICNT)=NUMDIG
14866        ICNT=ICNT+1
14867        ITEXT(ICNT)='Estimate of Scale:'
14868        NCTEXT(ICNT)=18
14869        AVALUE(ICNT)=SCALMO
14870        IDIGIT(ICNT)=NUMDIG
14871        ICNT=ICNT+1
14872        ITEXT(ICNT)='Estimate of Shape:'
14873        NCTEXT(ICNT)=18
14874        AVALUE(ICNT)=SHAPMO
14875        IDIGIT(ICNT)=NUMDIG
14876        IF(ALIKMO.NE.CPUMIN)THEN
14877          ICNT=ICNT+1
14878          ITEXT(ICNT)='Value of Log-Likelihood Function:'
14879          NCTEXT(ICNT)=33
14880          AVALUE(ICNT)=ALIKMO
14881          IDIGIT(ICNT)=NUMDIG
14882          ICNT=ICNT+1
14883          ITEXT(ICNT)='AIC:'
14884          NCTEXT(ICNT)=4
14885          AVALUE(ICNT)=AICMO
14886          IDIGIT(ICNT)=NUMDIG
14887          ICNT=ICNT+1
14888          ITEXT(ICNT)='AICC:'
14889          NCTEXT(ICNT)=5
14890          AVALUE(ICNT)=AICCMO
14891          IDIGIT(ICNT)=NUMDIG
14892          ICNT=ICNT+1
14893          ITEXT(ICNT)='BIC:'
14894          NCTEXT(ICNT)=4
14895          AVALUE(ICNT)=BICMO
14896          IDIGIT(ICNT)=NUMDIG
14897        ENDIF
14898        ICNT=ICNT+1
14899        ITEXT(ICNT)=' '
14900        NCTEXT(ICNT)=0
14901        AVALUE(ICNT)=0.0
14902        IDIGIT(ICNT)=-1
14903      ENDIF
14904C
14905      IF(SHAPMM.GT.0.0)THEN
14906        ICNT=ICNT+1
14907        ITEXT(ICNT)='Modified Moment Estimates:'
14908        NCTEXT(ICNT)=26
14909        AVALUE(ICNT)=0.0
14910        IDIGIT(ICNT)=-1
14911        ICNT=ICNT+1
14912        ITEXT(ICNT)='Estimate of Location:'
14913        NCTEXT(ICNT)=21
14914        AVALUE(ICNT)=ALOCMM
14915        IDIGIT(ICNT)=NUMDIG
14916        ICNT=ICNT+1
14917        ITEXT(ICNT)='Estimate of Scale:'
14918        NCTEXT(ICNT)=18
14919        AVALUE(ICNT)=SCALMM
14920        IDIGIT(ICNT)=NUMDIG
14921        ICNT=ICNT+1
14922        ITEXT(ICNT)='Estimate of Shape:'
14923        NCTEXT(ICNT)=18
14924        AVALUE(ICNT)=SHAPMM
14925        IDIGIT(ICNT)=NUMDIG
14926        IF(SHAPS2.GT.0.0)THEN
14927          ICNT=ICNT+1
14928          ITEXT(ICNT)='Standard Error of Location:'
14929          NCTEXT(ICNT)=27
14930          AVALUE(ICNT)=ALOCS2
14931          IDIGIT(ICNT)=NUMDIG
14932          ICNT=ICNT+1
14933          ITEXT(ICNT)='Standard Error of Scale:'
14934          NCTEXT(ICNT)=24
14935          AVALUE(ICNT)=SCALS2
14936          IDIGIT(ICNT)=NUMDIG
14937          ICNT=ICNT+1
14938          ITEXT(ICNT)='Standard Error of Shape:'
14939          NCTEXT(ICNT)=24
14940          AVALUE(ICNT)=SHAPS2
14941          IDIGIT(ICNT)=NUMDIG
14942        ENDIF
14943        IF(ALIKMM.NE.CPUMIN)THEN
14944          ICNT=ICNT+1
14945          ITEXT(ICNT)='Value of Log-Likelihood Function:'
14946          NCTEXT(ICNT)=33
14947          AVALUE(ICNT)=ALIKMM
14948          IDIGIT(ICNT)=NUMDIG
14949          ICNT=ICNT+1
14950          ITEXT(ICNT)='AIC:'
14951          NCTEXT(ICNT)=4
14952          AVALUE(ICNT)=AICMM
14953          IDIGIT(ICNT)=NUMDIG
14954          ICNT=ICNT+1
14955          ITEXT(ICNT)='AICC:'
14956          NCTEXT(ICNT)=5
14957          AVALUE(ICNT)=AICCMM
14958          IDIGIT(ICNT)=NUMDIG
14959          ICNT=ICNT+1
14960          ITEXT(ICNT)='BIC:'
14961          NCTEXT(ICNT)=4
14962          AVALUE(ICNT)=BICMM
14963          IDIGIT(ICNT)=NUMDIG
14964        ENDIF
14965        ICNT=ICNT+1
14966        ITEXT(ICNT)=' '
14967        NCTEXT(ICNT)=0
14968        AVALUE(ICNT)=0.0
14969        IDIGIT(ICNT)=-1
14970      ENDIF
14971C
14972      IF(SHAPML.GT.0.0)THEN
14973        ICNT=ICNT+1
14974        ITEXT(ICNT)='Maximum Likelihood Estimates:'
14975        NCTEXT(ICNT)=29
14976        AVALUE(ICNT)=0.0
14977        IDIGIT(ICNT)=-1
14978        ICNT=ICNT+1
14979        ITEXT(ICNT)='Estimate of Location:'
14980        NCTEXT(ICNT)=21
14981        AVALUE(ICNT)=ALOCML
14982        IDIGIT(ICNT)=NUMDIG
14983        ICNT=ICNT+1
14984        ITEXT(ICNT)='Estimate of Scale:'
14985        NCTEXT(ICNT)=18
14986        AVALUE(ICNT)=SCALML
14987        IDIGIT(ICNT)=NUMDIG
14988        ICNT=ICNT+1
14989        ITEXT(ICNT)='Estimate of Shape:'
14990        NCTEXT(ICNT)=18
14991        AVALUE(ICNT)=SHAPML
14992        IDIGIT(ICNT)=NUMDIG
14993        IF(IFLAG1.EQ.1)THEN
14994          ICNT=ICNT+1
14995          ITEXT(ICNT)='Standard Error of Location:'
14996          NCTEXT(ICNT)=27
14997          AVALUE(ICNT)=ALOCSE
14998          IDIGIT(ICNT)=NUMDIG
14999          ICNT=ICNT+1
15000          ITEXT(ICNT)='Standard Error of Scale:'
15001          NCTEXT(ICNT)=24
15002          AVALUE(ICNT)=SCALSE
15003          IDIGIT(ICNT)=NUMDIG
15004          ICNT=ICNT+1
15005          ITEXT(ICNT)='Standard Error of Shape:'
15006          NCTEXT(ICNT)=24
15007          AVALUE(ICNT)=SHAPSE
15008          IDIGIT(ICNT)=NUMDIG
15009        ENDIF
15010        IF(ALIKML.NE.CPUMIN)THEN
15011          ICNT=ICNT+1
15012          ITEXT(ICNT)='Value of Log-Likelihood Function:'
15013          NCTEXT(ICNT)=33
15014          AVALUE(ICNT)=ALIKML
15015          IDIGIT(ICNT)=NUMDIG
15016          ICNT=ICNT+1
15017          ITEXT(ICNT)='AIC:'
15018          NCTEXT(ICNT)=4
15019          AVALUE(ICNT)=AICML
15020          IDIGIT(ICNT)=NUMDIG
15021          ICNT=ICNT+1
15022          ITEXT(ICNT)='AICC:'
15023          NCTEXT(ICNT)=5
15024          AVALUE(ICNT)=AICCML
15025          IDIGIT(ICNT)=NUMDIG
15026          ICNT=ICNT+1
15027          ITEXT(ICNT)='BIC:'
15028          NCTEXT(ICNT)=4
15029          AVALUE(ICNT)=BICML
15030          IDIGIT(ICNT)=NUMDIG
15031        ENDIF
15032        ICNT=ICNT+1
15033        ITEXT(ICNT)=' '
15034        NCTEXT(ICNT)=0
15035        AVALUE(ICNT)=0.0
15036        IDIGIT(ICNT)=-1
15037      ENDIF
15038C
15039      NUMROW=ICNT
15040      DO2320I=1,NUMROW
15041        NTOT(I)=15
15042 2320 CONTINUE
15043C
15044      IFRST=.FALSE.
15045      ILAST=.FALSE.
15046      ITITLZ=' '
15047      NCTITZ=0
15048      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
15049     1            AVALUE,IDIGIT,
15050     1            NTOT,NUMROW,
15051     1            ICAPSW,ICAPTY,ILAST,IFRST,
15052     1            ISUBRO,IBUGA3,IERROR)
15053C
15054      ILIKFL='OFF'
15055      IF(IFLAG3.EQ.1)THEN
15056        CALL DPDTA6(COV,ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALOWSH,AUPPSH,
15057     1              ALPHA,NUMALP,
15058     1              ICAPSW,ICAPTY,NUMDIG,
15059     1              ISUBRO,IBUGA3,IERROR)
15060      ELSEIF(IFLAG3.EQ.2)THEN
15061        CALL DPDTA6(COVMM,ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALOWSH,AUPPSH,
15062     1              ALPHA,NUMALP,
15063     1              ICAPSW,ICAPTY,NUMDIG,
15064     1              ISUBRO,IBUGA3,IERROR)
15065      ENDIF
15066C
15067      IF(NPERC.GT.1)THEN
15068        ILIKFL='OFF'
15069CCCCC   CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
15070CCCCC1              ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
15071CCCCC1              ISUBRO,IBUGA3,IERROR)
15072      ENDIF
15073C
15074C               *****************
15075C               **  STEP 90--  **
15076C               **  EXIT       **
15077C               *****************
15078C
15079 9000 CONTINUE
15080C
15081      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG3')THEN
15082        WRITE(ICOUT,999)
15083        CALL DPWRST('XXX','WRIT')
15084        WRITE(ICOUT,9011)
15085 9011   FORMAT('***** AT THE END       OF DPMLG3--')
15086        CALL DPWRST('XXX','WRIT')
15087        WRITE(ICOUT,9012)N,IBUGA3,IERROR
15088 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
15089        CALL DPWRST('XXX','WRIT')
15090      ENDIF
15091C
15092      RETURN
15093      END
15094      SUBROUTINE DPMLGD(Y,N,
15095     1                  XTEMP,DTEMP1,MAXNXT,
15096     1                  CSV,ALPHSV,SCALSV,
15097     1                  CML,ALPHML,SCALML,
15098     1                  ICAPSW,ICAPTY,IFORSW,
15099     1                  ISUBRO,IBUGA3,IERROR)
15100C
15101C     PURPOSE--THIS ROUTINE COMPUTES MOMENT ESTIMATES
15102C              FOR THE GENERALIZED GAMMA DISTRIBUTION.
15103C              THE MOMENT ESTIMATES ARE THE SOLUTION TO
15104C              THE FOLLOWING SIMULTANEOUS NONLINEAR EQUATIONS:
15105C
15106C              A*(GAMMA(K+1/C))**2 - GAMMA(K+2/C)*GAMMA(K) = 0
15107C
15108C              XBAR - GAMMA(K+1/C)/(ALPHA*GAMMA(K)) = 0
15109C
15110C              SUM[i=1 to n][X(i)**C] - N*K/(ALPHA**C)
15111C
15112C              WHERE
15113C
15114C
15115C              ALPHA = 1/SCALE
15116C              C, K  = SHAPE PARAMETERS
15117C              A = {N*XBAR**2 + (N-1)*S**2}/{N*XBAR**2 - S**2)
15118C
15119C     EXAMPLE--GENERALIZED GAMMA MAXIMUM LIKELIHOOD Y
15120C     REFERENCE--HWANG AND HUANG (2006), "ON NEW MOMENT ESTIMATION
15121C                OF PARAMETERS OF THE GENERALIZED GAMMA DISTRIBUTION
15122C                USING IT'S CHARACTERIZATION", TAIWANESE JOURNAL OF
15123C                MATHEMATICS, VOL.10, NO. 4, PP. 1083-1093.
15124C     WRITTEN BY--ALAN HECKERT
15125C                 STATISTICAL ENGINEERING DIVISION
15126C                 INFORMATION TECHNOLOGY LABORATORY
15127C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
15128C                 GAITHERSBUG, MD 20899-8980
15129C                 PHONE--301-975-2855
15130C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
15131C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
15132C     LANGUAGE--ANSI FORTRAN (1977)
15133C     VERSION NUMBER--2007/1
15134C     ORIGINAL VERSION--JANUARY   2007.
15135C     UPDATED         --MAY       2011. USE DPDTA1 TO PRINT OUTPUT
15136C
15137C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
15138C
15139      CHARACTER*4 ICAPSW
15140      CHARACTER*4 ICAPTY
15141      CHARACTER*4 IFORSW
15142      CHARACTER*4 ISUBRO
15143      CHARACTER*4 IBUGA3
15144      CHARACTER*4 IERROR
15145C
15146      CHARACTER*4 IWRITE
15147      CHARACTER*4 ISUBN1
15148      CHARACTER*4 ISUBN2
15149      CHARACTER*4 ISTEPN
15150C
15151C---------------------------------------------------------------------
15152C
15153      DIMENSION Y(*)
15154      DIMENSION XTEMP(*)
15155      DOUBLE PRECISION DTEMP1(*)
15156C
15157      DOUBLE PRECISION DN
15158      DOUBLE PRECISION TOL
15159      DOUBLE PRECISION XPAR(3)
15160      DOUBLE PRECISION FVEC(3)
15161C
15162      DOUBLE PRECISION XBAR
15163      DOUBLE PRECISION S2
15164      DOUBLE PRECISION DA
15165      COMMON/GGDCOM/XBAR,S2,DA
15166C
15167      EXTERNAL GGDFUN
15168C
15169      CHARACTER*40 IDIST
15170      PARAMETER (MAXROW=20)
15171      CHARACTER*60 ITITLE
15172      CHARACTER*60 ITITLZ
15173      CHARACTER*40 ITEXT(MAXROW)
15174      REAL         AVALUE(MAXROW)
15175      INTEGER      NCTEXT(MAXROW)
15176      INTEGER      IDIGIT(MAXROW)
15177      INTEGER      NTOT(MAXROW)
15178      LOGICAL IFRST
15179      LOGICAL ILAST
15180C
15181C---------------------------------------------------------------------
15182C
15183      INCLUDE 'DPCOP2.INC'
15184C
15185C-----START POINT-----------------------------------------------------
15186C
15187      ISUBN1='DPML'
15188      ISUBN2='GD  '
15189      IERROR='NO'
15190      IWRITE='OFF'
15191C
15192      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGD')THEN
15193        WRITE(ICOUT,999)
15194  999   FORMAT(1X)
15195        CALL DPWRST('XXX','WRIT')
15196        WRITE(ICOUT,51)
15197   51   FORMAT('**** AT THE BEGINNING OF DPMLGD--')
15198        CALL DPWRST('XXX','WRIT')
15199        WRITE(ICOUT,52)IBUGA3,ISUBRO,N
15200   52   FORMAT('IBUGA3,ISUBRO,N = ',2(A4,2X),I8)
15201        CALL DPWRST('XXX','WRIT')
15202        WRITE(ICOUT,53)CSV,ALPHSV,SCALSV
15203   53   FORMAT('CSV,ALPHSV,SCALSV = ',3G15.7)
15204        CALL DPWRST('XXX','WRIT')
15205        DO56I=1,MIN(N,100)
15206          WRITE(ICOUT,57)I,Y(I)
15207   57     FORMAT('I,Y(I) = ',I8,G15.7)
15208          CALL DPWRST('XXX','WRIT')
15209   56   CONTINUE
15210      ENDIF
15211C
15212C               ********************************************
15213C               **  STEP 11--                             **
15214C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
15215C               ********************************************
15216C
15217      ISTEPN='11'
15218      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGD')
15219     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
15220C
15221      NMIN=5
15222      NPERC=0
15223      CALL CKDIST(Y,N,NMIN,XTEMP,NPERC,ISUBRO,IBUGA3,IERROR)
15224      IF(IERROR.EQ.'YES')GOTO9000
15225C
15226      IDIST='GENERALIZED GAMMA'
15227      IFLAG=1
15228      CALL SUMRAW(Y,N,IDIST,IFLAG,
15229     1            XMEAN,XVAR,XSD,XMIN,XMAX,
15230     1            ISUBRO,IBUGA3,IERROR)
15231      IF(IERROR.EQ.'YES')GOTO9000
15232C
15233C               *************************************************
15234C               **  STEP 21--                                  **
15235C               **  CARRY OUT CALCULATIONS                     **
15236C               **  FOR GENERALIZED GAMMA MLE ESTIMATION       **
15237C               *************************************************
15238C
15239      ISTEPN='21'
15240      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGD')
15241     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
15242C
15243      CALL SORT(Y,N,Y)
15244C
15245C     USE MOMENT ESTIMATES FOR GAMMA DISTRIBUTION AS STARTING
15246C     VALUES.
15247C
15248      XBAR=DBLE(XMEAN)
15249      S2=DBLE(XSD)**2
15250      DN=DBLE(N)
15251      DA=(DN*XBAR**2 + (DN-1.0D0)*S2)/(DN*XBAR**2 - S2)
15252C
15253      IF(CSV.GT.0.0 .AND. ALPHSV.GT.0.0 .AND.
15254     1   SCALSV.GT.0.0)THEN
15255        XPAR(1)=DBLE(CSV)
15256        XPAR(2)=DBLE(ALPHSV)
15257        XPAR(3)=DBLE(SCALSV)
15258      ELSE
15259        XPAR(1)=1.0D0
15260        XPAR(2)=(XBAR**2/S2) - (1.0D0/DBLE(N))
15261        XPAR(3)=XPAR(2)/XBAR
15262      ENDIF
15263C
15264      IOPT=2
15265      TOL=1.0D-6
15266      NVAR=3
15267      NPRINT=-1
15268      INFO=0
15269      LWA=MAXNXT
15270      CALL DNSQE(GGDFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
15271     1           DTEMP1,MAXNXT,Y,N)
15272C
15273      CML=REAL(XPAR(1))
15274      ALPHML=REAL(XPAR(2))
15275      SCALML=REAL(1.0D0/XPAR(3))
15276C
15277C               ***********************************************
15278C               **   STEP 42--                               **
15279C               **   WRITE OUT EVERYTHING                    **
15280C               **   FOR GENERALIZED GAMMA  ML ESTIMATION    **
15281C               ***********************************************
15282C
15283      ISTEPN='42'
15284      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGD')
15285     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
15286C
15287C     PRINT SUMMARY STATISTICS TABLE
15288C
15289      NUMDIG=7
15290      IF(IFORSW.EQ.'1')NUMDIG=1
15291      IF(IFORSW.EQ.'2')NUMDIG=2
15292      IF(IFORSW.EQ.'3')NUMDIG=3
15293      IF(IFORSW.EQ.'4')NUMDIG=4
15294      IF(IFORSW.EQ.'5')NUMDIG=5
15295      IF(IFORSW.EQ.'6')NUMDIG=6
15296      IF(IFORSW.EQ.'7')NUMDIG=7
15297      IF(IFORSW.EQ.'8')NUMDIG=8
15298      IF(IFORSW.EQ.'9')NUMDIG=9
15299      IF(IFORSW.EQ.'0')NUMDIG=0
15300      IF(IFORSW.EQ.'E')NUMDIG=-2
15301      IF(IFORSW.EQ.'-2')NUMDIG=-2
15302      IF(IFORSW.EQ.'-3')NUMDIG=-3
15303      IF(IFORSW.EQ.'-4')NUMDIG=-4
15304      IF(IFORSW.EQ.'-5')NUMDIG=-5
15305      IF(IFORSW.EQ.'-6')NUMDIG=-6
15306      IF(IFORSW.EQ.'-7')NUMDIG=-7
15307      IF(IFORSW.EQ.'-8')NUMDIG=-8
15308      IF(IFORSW.EQ.'-9')NUMDIG=-9
15309C
15310      ITITLE='Generalized Gamma Parameter Estimation: Full Sample Case'
15311      NCTITL=56
15312      ITITLZ=' '
15313      NCTITZ=0
15314C
15315      ICNT=1
15316      ITEXT(ICNT)='Summary Statistics:'
15317      NCTEXT(ICNT)=19
15318      AVALUE(ICNT)=0.0
15319      IDIGIT(ICNT)=-1
15320      ICNT=ICNT+1
15321      ITEXT(ICNT)='Number of Observations:'
15322      NCTEXT(ICNT)=23
15323      AVALUE(ICNT)=REAL(N)
15324      IDIGIT(ICNT)=0
15325      ICNT=ICNT+1
15326      ITEXT(ICNT)='Sample Mean:'
15327      NCTEXT(ICNT)=12
15328      AVALUE(ICNT)=XMEAN
15329      IDIGIT(ICNT)=NUMDIG
15330      ICNT=ICNT+1
15331      ITEXT(ICNT)='Sample Standard Deviation:'
15332      NCTEXT(ICNT)=26
15333      AVALUE(ICNT)=XSD
15334      IDIGIT(ICNT)=NUMDIG
15335      ICNT=ICNT+1
15336      ITEXT(ICNT)='Sample Minimum:'
15337      NCTEXT(ICNT)=15
15338      AVALUE(ICNT)=XMIN
15339      IDIGIT(ICNT)=NUMDIG
15340      ICNT=ICNT+1
15341      ITEXT(ICNT)='Sample Maximum:'
15342      NCTEXT(ICNT)=15
15343      AVALUE(ICNT)=XMAX
15344      IDIGIT(ICNT)=NUMDIG
15345      ICNT=ICNT+1
15346      ITEXT(ICNT)=' '
15347      NCTEXT(ICNT)=0
15348      AVALUE(ICNT)=0.0
15349      IDIGIT(ICNT)=-1
15350C
15351      ICNT=ICNT+1
15352      ITEXT(ICNT)='Hwang and Huang Moment Estimates:'
15353      NCTEXT(ICNT)=33
15354      AVALUE(ICNT)=0.0
15355      IDIGIT(ICNT)=-1
15356      ICNT=ICNT+1
15357      ITEXT(ICNT)='Estimate of C:'
15358      NCTEXT(ICNT)=14
15359      AVALUE(ICNT)=CML
15360      IDIGIT(ICNT)=NUMDIG
15361      ICNT=ICNT+1
15362      ITEXT(ICNT)='Estimate of Alpha:'
15363      NCTEXT(ICNT)=18
15364      AVALUE(ICNT)=ALPHML
15365      IDIGIT(ICNT)=NUMDIG
15366      ICNT=ICNT+1
15367      ITEXT(ICNT)='Estimate of Scale:'
15368      NCTEXT(ICNT)=18
15369      AVALUE(ICNT)=SCALML
15370      IDIGIT(ICNT)=NUMDIG
15371C
15372      NUMROW=ICNT
15373      DO2310I=1,NUMROW
15374        NTOT(I)=15
15375 2310 CONTINUE
15376C
15377      IFRST=.TRUE.
15378      ILAST=.TRUE.
15379      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
15380     1            AVALUE,IDIGIT,
15381     1            NTOT,NUMROW,
15382     1            ICAPSW,ICAPTY,ILAST,IFRST,
15383     1            ISUBRO,IBUGA3,IERROR)
15384C
15385C               *****************
15386C               **  STEP 90--  **
15387C               **  EXIT       **
15388C               *****************
15389C
15390 9000 CONTINUE
15391      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGD')THEN
15392        WRITE(ICOUT,999)
15393        CALL DPWRST('XXX','WRIT')
15394        WRITE(ICOUT,9011)
15395 9011   FORMAT('***** AT THE END       OF DPMLGD--')
15396        CALL DPWRST('XXX','WRIT')
15397        WRITE(ICOUT,9012)IERROR
15398 9012   FORMAT('IERROR = ',A4)
15399        CALL DPWRST('XXX','WRIT')
15400      ENDIF
15401C
15402      RETURN
15403      END
15404      SUBROUTINE DPMLGG(Y,X,N,NVAR,
15405     1                  TEMP1,TEMP2,TEMP3,DTEMP1,
15406     1                  PMOM,AMOM,PML,AML,PVARML,AVARML,COVML,
15407     1                  ICAPSW,ICAPTY,IFORSW,MAXNXT,
15408     1                  ISUBRO,IBUGA3,IERROR)
15409C
15410C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
15411C              ESTIMATES FOR THE GENERALIZED LOST GAMES
15412C              DISTRIBUTION.
15413C
15414C              IT IS ASSUMED THAT J IS KNOWN (TYPICALLY IT WILL
15415C              BE THE MINIMUM DATA POINT).
15416C
15417C              THE METHOD OF MOMENT ESTIMATES ARE:
15418C
15419C              PHAT = 0.5 + {XBAR + SQRT[XBAR*(XBAR+8*S**2)]/{8*S**2}
15420C
15421C              AHAT = XBAR*(1/(1-PHAT) - 2)
15422C
15423C              WITH XBAR AND S**2 DENOTING THE SAMPLE MEAN AND
15424C              VARIANCE, RESPECTIVELY.
15425C
15426C              THE MAXIMUM LIKELIHOOD ESTIMATES ARE:
15427C
15428C              1) USE THE MINIMUM VALUE AS THE ESTIMATE OF J.
15429C                 THEN SHIFT THE DATA TO START AT ZERO (I.E.,
15430C                 J = 0).
15431C
15432C              2) THEN SOLVE THE FOLLOWING SIMULTANEOUS EQUATIONS:
15433C
15434C                 N*SUM[x>=0][f(x)*{(a+x)/p - x/(1-p)} = 0
15435C
15436C                 N*SUM[x >= 0][f(x)*{LOG(p) + 1/a + PSI(a+2*x) -
15437C                 PS(a+x-1)}] = 0
15438C
15439C              WITH N, f(x), AND PSI DENOTING THE TOTAL SAMPLE
15440C              SIZE, THE FREQUENCY FOR CLASS X = x, AND THE
15441C              DIGAMMA FUNCTION, RESPECTIVELY.
15442C
15443C              THERE ARE TWO CASES:
15444C
15445C              1) ONE VARIABLE CASE: Y IS RAW DATA
15446C              2) TWO VARIABLE CASE: Y IS FREQUENCY, X IS CLASS
15447C                 MID-POINT.
15448C
15449C     EXAMPLE--GENERALIZED LOST GAMES MAXIMUM LIKELIHOOD Y
15450C            --GENERALIZED LOST GAMES MAXIMUM LIKELIHOOD Y X
15451C     REFERENCES--JOHNSON, KOTZ, AND KEMP (2006).  "UNIVARIATE
15452C                 DISCRETE DISTRIBUTIONS", THIRD EDITION,
15453C                 WILEY, PP. 503-505.
15454C               --KEMP AND KEMP (1992), "A GROUP-DYNAMIC MODEL AND
15455C                 THE LOST-GAMES DISTRIBUTION", COMMUNICATIONS IN
15456C                 STATISTICS--THEORY AND METHODS, 21(3),
15457C                 PP. 791-798.
15458C     WRITTEN BY--ALAN HECKERT
15459C                 STATISTICAL ENGINEERING DIVISION
15460C                 INFORMATION TECHNOLOGY LABORATORY
15461C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
15462C                 GAITHERSBUG, MD 20899-8980
15463C                 PHONE--301-975-2899
15464C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
15465C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
15466C     LANGUAGE--ANSI FORTRAN (1977)
15467C     VERSION NUMBER--2006/12
15468C     ORIGINAL VERSION--DECEMBER  2006.
15469C     UPDATED         --APRIL     2011. USE DPDTA1 AND DPDTA4 TO
15470C                                       PRINT OUTPUT
15471C
15472C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-----------------
15473C
15474      CHARACTER*4 ICAPSW
15475      CHARACTER*4 ICAPTY
15476      CHARACTER*4 IFORSW
15477      CHARACTER*4 ISUBRO
15478      CHARACTER*4 IBUGA3
15479      CHARACTER*4 IERROR
15480C
15481      CHARACTER*4 IWRITE
15482      CHARACTER*4 ISUBN1
15483      CHARACTER*4 ISUBN2
15484      CHARACTER*4 ISTEPN
15485      CHARACTER*4 IRELAT
15486      CHARACTER*4 IRHSTG
15487C
15488C-------------------------------------------------------------------
15489C
15490      DIMENSION Y(*)
15491      DIMENSION X(*)
15492      DIMENSION TEMP1(*)
15493      DIMENSION TEMP2(*)
15494      DIMENSION TEMP3(*)
15495C
15496      DOUBLE PRECISION DTEMP1(*)
15497C
15498CCCCC DOUBLE PRECISION DN
15499CCCCC DOUBLE PRECISION DX
15500CCCCC DOUBLE PRECISION DX2
15501CCCCC DOUBLE PRECISION DFREQ
15502CCCCC DOUBLE PRECISION DSUM1
15503CCCCC DOUBLE PRECISION DSUM2
15504C
15505      DOUBLE PRECISION TOL
15506      DOUBLE PRECISION XPAR(2)
15507      DOUBLE PRECISION FVEC(2)
15508C
15509      EXTERNAL GLGFUN
15510CCCCC EXTERNAL GLGFU2
15511CCCCC EXTERNAL GLGFU3
15512      DOUBLE PRECISION XBAR
15513      DOUBLE PRECISION S2
15514      DOUBLE PRECISION DF0
15515      COMMON/GLGCOM/XBAR,S2,DF0,MAXRO2,IINDX,NTOTZZ
15516C
15517      PARAMETER (MAXROW=30)
15518      CHARACTER*60 ITITLE
15519      CHARACTER*1  ITITLZ
15520      CHARACTER*40 IDIST
15521      CHARACTER*40 ITEXT(MAXROW)
15522      REAL         AVALUE(MAXROW)
15523      INTEGER      NCTEXT(MAXROW)
15524      INTEGER      IDIGIT(MAXROW)
15525      INTEGER      NTOT(MAXROW)
15526      LOGICAL      IFRST
15527      LOGICAL      ILAST
15528C
15529C-------------------------------------------------------------------
15530C
15531      INCLUDE 'DPCOP2.INC'
15532C
15533C-----START POINT---------------------------------------------------
15534C
15535      ISUBN1='DPML'
15536      ISUBN2='GG  '
15537      IERROR='NO'
15538      IWRITE='OFF'
15539C
15540      PVARML=CPUMIN
15541      AVARML=CPUMIN
15542      COVML=CPUMIN
15543C
15544      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGG')THEN
15545        WRITE(ICOUT,999)
15546  999   FORMAT(1X)
15547        CALL DPWRST('XXX','WRIT')
15548        WRITE(ICOUT,51)
15549   51   FORMAT('**** AT THE BEGINNING OF DPMLGG--')
15550        CALL DPWRST('XXX','WRIT')
15551        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR
15552   52   FORMAT('IBUGA3,ISUBRO,N,NVAR = ',2(A4,2X),2I8)
15553        CALL DPWRST('XXX','WRIT')
15554        IF(NVAR.EQ.1)THEN
15555          DO56I=1,MIN(N,100)
15556            WRITE(ICOUT,57)I,Y(I)
15557   57       FORMAT('I,Y(I) = ',I8,G15.7)
15558            CALL DPWRST('XXX','WRIT')
15559   56     CONTINUE
15560        ELSE
15561          DO61I=1,N
15562            WRITE(ICOUT,62)I,X(I),Y(I)
15563   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
15564            CALL DPWRST('XXX','WRIT')
15565   61     CONTINUE
15566        ENDIF
15567      ENDIF
15568C
15569C               ********************************************
15570C               **  STEP 11--                             **
15571C               **  1) ROUND DATA TO INTEGER VALUES       **
15572C               **  2) COMPUTE SUMMARY STATISTICS         **
15573C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
15574C               **     INSUFFICIENT SAMPLE SIZE           **
15575C               **  4) FOR RAW DATA CASE, BIN THE DATA.   **
15576C               ********************************************
15577C
15578      ISTEPN='11'
15579      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGG')
15580     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
15581C
15582      IDIST='GENERALIZED LOST GAMES'
15583C
15584      NPERC=0
15585      MAXGRP=MAXNXT/2
15586      NMIN=2
15587      IF(NVAR.EQ.1)THEN
15588        DO1105I=1,N
15589          ITEMP=INT(Y(I)+0.5)
15590          Y(I)=REAL(ITEMP)
15591 1105   CONTINUE
15592        CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
15593        IF(IERROR.EQ.'YES')GOTO9000
15594C
15595        CALL SORT(Y,N,Y)
15596        IFLAG=1
15597        CALL SUMRAW(Y,N,IDIST,IFLAG,
15598     1              XMEAN,XVAR,XSD,XMIN,XMAX,
15599     1              ISUBRO,IBUGA3,IERROR)
15600        IF(IERROR.EQ.'YES')GOTO9000
15601        NTOTZZ=N
15602C
15603        IRELAT='OFF'
15604        IRHSTG='OFF'
15605        XSTART=XMIN-0.5
15606        XSTOP=XMAX+0.5
15607        CLWID=1.0
15608        CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
15609     1              TEMP1,X,N2,IBUGA3,IERROR)
15610        ICNT=0
15611        DO1121I=1,N2
15612          Y(I)=TEMP1(I)
15613          IF(TEMP1(I).GT.0.0)THEN
15614            ICNT=ICNT+1
15615            Y(ICNT)=Y(I)
15616            X(ICNT)=X(I)
15617          ENDIF
156181121    CONTINUE
15619        N2=ICNT
15620        IF(IERROR.EQ.'YES')GOTO9000
15621      ELSE
15622        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
15623     1              ISUBRO,IBUGA3,IERROR)
15624        IF(IERROR.EQ.'YES')GOTO9000
15625        IFLAG1=1
15626        IFLAG2=1
15627        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
15628     1              TEMP1,TEMP2,TEMP3,MAXNXT,
15629     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
15630     1              ISUBRO,IBUGA3,IERROR)
15631        IF(IERROR.EQ.'YES')GOTO9000
15632        ICNT=0
15633        NTOTZZ=0
15634        DO1211I=1,N
15635          IF(Y(I).GT.0.0)THEN
15636            ICNT=ICNT+1
15637            Y(ICNT)=Y(I)
15638            X(ICNT)=X(I)
15639            NTOTZZ=NTOTZZ + INT(Y(I)+0.01)
15640          ENDIF
156411211    CONTINUE
15642        N2=ICNT
15643      ENDIF
15644C
15645      F0=Y(1)/REAL(NTOTZZ)
15646      IINDX=MAXNXT/2
15647      IF(N2.LE.IINDX)THEN
15648        IWD=0
15649        DO2210I=1,N2
15650          TEMP3(I)=Y(I)
15651          TEMP3(IINDX+I)=X(I)
15652 2210   CONTINUE
15653        IK=N
15654      ELSE
15655        IWD=1
15656      ENDIF
15657C
15658      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLBT')THEN
15659        WRITE(ICOUT,999)
15660        CALL DPWRST('XXX','WRIT')
15661        WRITE(ICOUT,1151)
15662 1151   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
15663        CALL DPWRST('XXX','WRIT')
15664        WRITE(ICOUT,1152)XMEAN,XVAR,XSD,XMIN,XMAX
15665 1152   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX = ',5G15.7)
15666        CALL DPWRST('XXX','WRIT')
15667        WRITE(ICOUT,1154)F0,N,N2,NTOTZZ,IK,IWD
15668 1154   FORMAT('F0,N,N2,NTOTZZ,IK,IWD = ',G15.7,4I8)
15669        CALL DPWRST('XXX','WRIT')
15670      ENDIF
15671C
15672C               ************************************************
15673C               **  STEP 21--                                 **
15674C               **  CARRY OUT CALCULATIONS                    **
15675C               **  FOR GENERALIZED LOST GAMES MLE ESTIMATION **
15676C               ************************************************
15677C
15678      ISTEPN='21'
15679      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGG')
15680     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
15681C
15682      PMOM=0.5 + (XMEAN + SQRT(XMEAN*(XMEAN+8.0*XVAR)))/(8.0*XVAR)
15683      AMOM=XMEAN*(1.0/(1.0 - PMOM) - 2.0)
15684C
15685      IOPT=2
15686      TOL=1.0D-6
15687      NPAR=2
15688      NPRINT=-1
15689      INFO=0
15690      LWA=MAXNXT
15691      MAXRO2=MAXNXT
15692      XBAR=DBLE(XMEAN)
15693      S2=DBLE(XVAR)
15694      DF0=DBLE(F0)
15695C
15696      XPAR(1)=DBLE(PMOM)
15697      XPAR(2)=DBLE(AMOM)
15698      CALL DNSQE(GLGFUN,JAC,IOPT,NPAR,XPAR,FVEC,TOL,NPRINT,INFO,
15699     1             DTEMP1,LWA,TEMP3,IK)
15700C
15701      PML=REAL(XPAR(1))
15702      AML=REAL(XPAR(2))
15703CCCCC Q=1.0-PML
15704CCCCC TERM1=REAL(NTOT)*AML/(PML*PML)
15705CCCCC TERM2=REAL(NTOT)*DA*(1.0-2.0*PML*Q)/((PML-Q)*PMP*PML*Q)
15706CCCCC PVARML=TERM1 + TERM2
15707CCCCC COVML=-REAL(NTOT)/PML
15708CCCCC AVARML=0.0
15709C
15710CCCCC DSUM1=0.0D0
15711CCCCC DSUM2=0.0D0
15712CCCCC DO2300I=1,IK
15713CCCCC   DSUM2=0.0D0
15714CCCCC   DX=DBLE(TEMP3(IINDX+I))
15715CCCCC   IF(DX.LT.1.99D0)GOTO2300
15716CCCCC   AX=REAL(DX)
15717CCCCC   CALL GLGPDF(AX,PML,AMIN,AML,PX)
15718CCCCC   DFREQ=DBLE(PX)
15719CCCCC   IK2=INT(DX-1.0D0 + 0.5D0)
15720CCCCC   DO2400J=1,IK2
15721CCCCC     DX2=DBLE(TEMP3(IINDX+J))
15722CCCCC     DSUM2=DSUM2 + 1.0D0/(DA+DX+DBLE(J)**2)
15723C2400   CONTINUE
15724CCCCC   DSUM1=DSUM1 + (DFREQ/DN)*DSUM2
15725C2300 CONTINUE
15726C
15727CCCCC AX=0.0
15728CCCCC CALL GLGPDF(AX,PML,AMIN,AML,P0)
15729CCCCC AVARML=REAL(DN*DLOG(1.0D0-DBLE(P0))/AML**2 + DN*DSUM1)
15730C
15731C               *************************************************
15732C               **   STEP 42--                                 **
15733C               **   WRITE OUT EVERYTHING                      **
15734C               **   FOR GENERALIZED LOST GAMES MLE ESTIMATION **
15735C               *************************************************
15736C
15737      ISTEPN='42'
15738      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGG')
15739     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
15740C
15741C     PRINT SUMMARY STATISTICS TABLE
15742C
15743      NUMDIG=7
15744      IF(IFORSW.EQ.'1')NUMDIG=1
15745      IF(IFORSW.EQ.'2')NUMDIG=2
15746      IF(IFORSW.EQ.'3')NUMDIG=3
15747      IF(IFORSW.EQ.'4')NUMDIG=4
15748      IF(IFORSW.EQ.'5')NUMDIG=5
15749      IF(IFORSW.EQ.'6')NUMDIG=6
15750      IF(IFORSW.EQ.'7')NUMDIG=7
15751      IF(IFORSW.EQ.'8')NUMDIG=8
15752      IF(IFORSW.EQ.'9')NUMDIG=9
15753      IF(IFORSW.EQ.'0')NUMDIG=0
15754      IF(IFORSW.EQ.'E')NUMDIG=-2
15755      IF(IFORSW.EQ.'-2')NUMDIG=-2
15756      IF(IFORSW.EQ.'-3')NUMDIG=-3
15757      IF(IFORSW.EQ.'-4')NUMDIG=-4
15758      IF(IFORSW.EQ.'-5')NUMDIG=-5
15759      IF(IFORSW.EQ.'-6')NUMDIG=-6
15760      IF(IFORSW.EQ.'-7')NUMDIG=-7
15761      IF(IFORSW.EQ.'-8')NUMDIG=-8
15762      IF(IFORSW.EQ.'-9')NUMDIG=-9
15763C
15764      ITITLE='Generalized Lost Games Parameter Estimation'
15765      NCTITL=43
15766      ITITLZ=' '
15767      NCTITZ=0
15768C
15769      ICNT=1
15770      ITEXT(ICNT)='Summary Statistics:'
15771      NCTEXT(ICNT)=19
15772      AVALUE(ICNT)=0.0
15773      IDIGIT(ICNT)=-1
15774      ICNT=ICNT+1
15775      ITEXT(ICNT)='Number of Observations:'
15776      NCTEXT(ICNT)=23
15777      AVALUE(ICNT)=REAL(NTOTZZ)
15778      IDIGIT(ICNT)=0
15779      ICNT=ICNT+1
15780      ITEXT(ICNT)='Sample Mean:'
15781      NCTEXT(ICNT)=12
15782      AVALUE(ICNT)=XMEAN
15783      IDIGIT(ICNT)=NUMDIG
15784      ICNT=ICNT+1
15785      ITEXT(ICNT)='Sample Standard Deviation:'
15786      NCTEXT(ICNT)=26
15787      AVALUE(ICNT)=XSD
15788      IDIGIT(ICNT)=NUMDIG
15789      ICNT=ICNT+1
15790      ITEXT(ICNT)='Sample Minimum:'
15791      NCTEXT(ICNT)=15
15792      AVALUE(ICNT)=XMIN
15793      IDIGIT(ICNT)=NUMDIG
15794      ICNT=ICNT+1
15795      ITEXT(ICNT)='Sample Maximum:'
15796      NCTEXT(ICNT)=15
15797      AVALUE(ICNT)=XMAX
15798      IDIGIT(ICNT)=NUMDIG
15799      ICNT=ICNT+1
15800      ITEXT(ICNT)=' '
15801      NCTEXT(ICNT)=0
15802      AVALUE(ICNT)=0.0
15803      IDIGIT(ICNT)=-1
15804C
15805      ICNT=ICNT+1
15806      ITEXT(ICNT)='Method of Moments:'
15807      NCTEXT(ICNT)=18
15808      AVALUE(ICNT)=0.0
15809      IDIGIT(ICNT)=-1
15810      ICNT=ICNT+1
15811      ITEXT(ICNT)='Estimate of J:'
15812      NCTEXT(ICNT)=14
15813      AVALUE(ICNT)=XMIN
15814      IDIGIT(ICNT)=NUMDIG
15815      ICNT=ICNT+1
15816      ITEXT(ICNT)='Estimate of P:'
15817      NCTEXT(ICNT)=14
15818      AVALUE(ICNT)=PMOM
15819      IDIGIT(ICNT)=NUMDIG
15820      ICNT=ICNT+1
15821      ITEXT(ICNT)='Estimate of A:'
15822      NCTEXT(ICNT)=14
15823      AVALUE(ICNT)=AMOM
15824      IDIGIT(ICNT)=NUMDIG
15825      ICNT=ICNT+1
15826      ITEXT(ICNT)=' '
15827      NCTEXT(ICNT)=0
15828      AVALUE(ICNT)=0.0
15829      IDIGIT(ICNT)=-1
15830C
15831      ICNT=ICNT+1
15832      ITEXT(ICNT)='Method of Maximum Likelihood:'
15833      NCTEXT(ICNT)=29
15834      AVALUE(ICNT)=0.0
15835      IDIGIT(ICNT)=-1
15836      ICNT=ICNT+1
15837      ITEXT(ICNT)='Estimate of J:'
15838      NCTEXT(ICNT)=14
15839      AVALUE(ICNT)=XMIN
15840      IDIGIT(ICNT)=NUMDIG
15841      ICNT=ICNT+1
15842      ITEXT(ICNT)='Estimate of P:'
15843      NCTEXT(ICNT)=14
15844      AVALUE(ICNT)=PML
15845      IDIGIT(ICNT)=NUMDIG
15846      ICNT=ICNT+1
15847      ITEXT(ICNT)='Estimate of A:'
15848      NCTEXT(ICNT)=14
15849      AVALUE(ICNT)=AML
15850      IDIGIT(ICNT)=NUMDIG
15851      ICNT=ICNT+1
15852      ITEXT(ICNT)=' '
15853      NCTEXT(ICNT)=0
15854      AVALUE(ICNT)=0.0
15855      IDIGIT(ICNT)=-1
15856C
15857      NUMROW=ICNT
15858      DO2310I=1,NUMROW
15859        NTOT(I)=15
15860 2310 CONTINUE
15861C
15862      IFRST=.TRUE.
15863      ILAST=.TRUE.
15864      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
15865     1            AVALUE,IDIGIT,
15866     1            NTOT,NUMROW,
15867     1            ICAPSW,ICAPTY,ILAST,IFRST,
15868     1            ISUBRO,IBUGA3,IERROR)
15869C
15870C               *****************
15871C               **  STEP 90--  **
15872C               **  EXIT       **
15873C               *****************
15874C
15875 9000 CONTINUE
15876      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGG')THEN
15877        WRITE(ICOUT,999)
15878        CALL DPWRST('XXX','WRIT')
15879        WRITE(ICOUT,9011)
15880 9011   FORMAT('***** AT THE END       OF DPMLGG--')
15881        CALL DPWRST('XXX','WRIT')
15882        WRITE(ICOUT,9012)PMOM,AMOM,PML,AML
15883 9012   FORMAT('PMOM,AMOM,PML,AML = ',4G15.7)
15884        CALL DPWRST('XXX','WRIT')
15885      ENDIF
15886C
15887      RETURN
15888      END
15889      SUBROUTINE DPMLGL(Y,N,
15890     1                  DTEMP1,XMOM,MAXNXT,
15891     1                  SHAPML,SCALML,ALOCML,
15892     1                  ICAPSW,ICAPTY,IFORSW,
15893     1                  ISUBRO,IBUGA3,IERROR)
15894C
15895C     PURPOSE--THIS ROUTINE COMPUTES THE L-MOMENT ESTIMATES
15896C              FOR THE GENERALIZED LOGISTIC DISTRIBUTION
15897C     EXAMPLE--GENERALIZED LOGISTIC MAXIMUM LIKELIHOOD Y
15898C     REFERENCE--FORTRAN CODE WRITTEN FOR INCLUSION IN IBM
15899C                RESEARCH REPORT RC20525, 'FORTRAN ROUTINES FOR
15900C                USE WITH THE METHOD OF L-MOMENTS, VERSION 3',
15901C                J. R. M. HOSKING, IBM RESEARCH DIVISION,
15902C                T. J. WATSON RESEARCH CENTER, YORKTOWN HEIGHTS
15903C                NEW YORK 10598, U.S.A., VERSION 3     AUGUST 1996
15904C     WRITTEN BY--ALAN HECKERT
15905C                 STATISTICAL ENGINEERING DIVISION
15906C                 INFORMATION TECHNOLOGY LABORATORY
15907C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
15908C                 GAITHERSBUG, MD 20899-8980
15909C                 PHONE--301-975-2899
15910C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
15911C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
15912C     LANGUAGE--ANSI FORTRAN (1977)
15913C     VERSION NUMBER--2006/2
15914C     ORIGINAL VERSION--FEBRUARY  2006.
15915C     UPDATED         --JULY      2010. EXTRACT POINT ESTIMATES TO
15916C                                       PE3ML1
15917C     UPDATED         --JULY      2010. USE DPDTA1 TO PRINT OUTPUT
15918C
15919C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
15920C
15921      CHARACTER*4 ICAPSW
15922      CHARACTER*4 ICAPTY
15923      CHARACTER*4 IFORSW
15924      CHARACTER*4 ISUBRO
15925      CHARACTER*4 IBUGA3
15926      CHARACTER*4 IERROR
15927C
15928      CHARACTER*4 IWRITE
15929C
15930      CHARACTER*4 ISUBN1
15931      CHARACTER*4 ISUBN2
15932      CHARACTER*4 ISTEPN
15933C
15934C---------------------------------------------------------------------
15935C
15936      DIMENSION Y(*)
15937      DIMENSION QP(1)
15938      DOUBLE PRECISION DTEMP1(*)
15939      DOUBLE PRECISION XMOM(*)
15940C
15941CCCCC PARAMETER (NUMALP=6)
15942CCCCC DIMENSION ALPHA(NUMALP)
15943CCCCC DIMENSION ALOWSC(NUMALP)
15944CCCCC DIMENSION AUPPSC(NUMALP)
15945CCCCC DIMENSION ALOWGA(NUMALP)
15946CCCCC DIMENSION AUPPGA(NUMALP)
15947C
15948      PARAMETER (MAXROW=20)
15949      CHARACTER*60 ITITLE
15950      CHARACTER*60 ITITLZ
15951      CHARACTER*40 ITEXT(MAXROW)
15952      REAL         AVALUE(MAXROW)
15953      INTEGER      NCTEXT(MAXROW)
15954      INTEGER      IDIGIT(MAXROW)
15955      INTEGER      NTOT(MAXROW)
15956      LOGICAL IFRST
15957      LOGICAL ILAST
15958C
15959C---------------------------------------------------------------------
15960C
15961      INCLUDE 'DPCOP2.INC'
15962C
15963CCCCC DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
15964C
15965C-----START POINT-----------------------------------------------------
15966C
15967      ISUBN1='DPML'
15968      ISUBN2='GL  '
15969      IERROR='NO'
15970C
15971      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGL')THEN
15972        WRITE(ICOUT,999)
15973  999   FORMAT(1X)
15974        CALL DPWRST('XXX','WRIT')
15975        WRITE(ICOUT,51)
15976   51   FORMAT('**** AT THE BEGINNING OF DPMLGL--')
15977        CALL DPWRST('XXX','WRIT')
15978        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,MAXNXT
15979   52   FORMAT('IBUGA3,ISUBRO,N,MAXNXT = ',2(A4,2X),2I8)
15980        CALL DPWRST('XXX','WRIT')
15981        DO56I=1,MIN(N,100)
15982          WRITE(ICOUT,57)I,Y(I)
15983   57     FORMAT('I,Y(I) = ',I8,G15.7)
15984          CALL DPWRST('XXX','WRIT')
15985   56   CONTINUE
15986      ENDIF
15987C
15988C               ***************************************************
15989C               **  STEP 21--                                    **
15990C               **  CARRY OUT CALCULATIONS                       **
15991C               **  FOR GENERALIZED LOGISTIC L-MOMENT ESTIMATION **
15992C               ***************************************************
15993C
15994      ISTEPN='21'
15995      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGL')
15996     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
15997C
15998      NPERC=0
15999      NMIN=4
16000      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
16001      IF(IERROR.EQ.'YES')GOTO9000
16002C
16003      IERROR='NO'
16004      IWRITE='OFF'
16005C
16006      CALL GL5ML1(Y,N,
16007     1            DTEMP1,XMOM,NMOM,
16008     1            XMEAN,XSD,XVAR,XMIN,XMAX,
16009     1            ALOCML,SCALML,SHAPML,
16010     1            ISUBRO,IBUGA3,IERROR)
16011C
16012C               ***********************************************
16013C               **   STEP 42--                               **
16014C               **   WRITE OUT EVERYTHING                    **
16015C               **   FOR GENERALIZED LOGISTIC MLE ESTIMATION **
16016C               ***********************************************
16017C
16018      ISTEPN='42'
16019      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGL')
16020     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
16021C
16022      IF(IPRINT.EQ.'OFF')GOTO9000
16023C
16024      NUMDIG=7
16025      IF(IFORSW.EQ.'1')NUMDIG=1
16026      IF(IFORSW.EQ.'2')NUMDIG=2
16027      IF(IFORSW.EQ.'3')NUMDIG=3
16028      IF(IFORSW.EQ.'4')NUMDIG=4
16029      IF(IFORSW.EQ.'5')NUMDIG=5
16030      IF(IFORSW.EQ.'6')NUMDIG=6
16031      IF(IFORSW.EQ.'7')NUMDIG=7
16032      IF(IFORSW.EQ.'8')NUMDIG=8
16033      IF(IFORSW.EQ.'9')NUMDIG=9
16034      IF(IFORSW.EQ.'0')NUMDIG=0
16035      IF(IFORSW.EQ.'E')NUMDIG=-2
16036      IF(IFORSW.EQ.'-2')NUMDIG=-2
16037      IF(IFORSW.EQ.'-3')NUMDIG=-3
16038      IF(IFORSW.EQ.'-4')NUMDIG=-4
16039      IF(IFORSW.EQ.'-5')NUMDIG=-5
16040      IF(IFORSW.EQ.'-6')NUMDIG=-6
16041      IF(IFORSW.EQ.'-7')NUMDIG=-7
16042      IF(IFORSW.EQ.'-8')NUMDIG=-8
16043      IF(IFORSW.EQ.'-9')NUMDIG=-9
16044C
16045      ITITLE='Three-Parameter Generalized Logistic Type 5'
16046      NCTITL=43
16047      ITITLZ='Parameter Estimation (Full Sample Case):'
16048      NCTITZ=40
16049      ICNT=1
16050      ITEXT(ICNT)='Summary Statistics:'
16051      NCTEXT(ICNT)=19
16052      AVALUE(ICNT)=0.0
16053      IDIGIT(ICNT)=-1
16054      ICNT=ICNT+1
16055      ITEXT(ICNT)='Number of Observations:'
16056      NCTEXT(ICNT)=23
16057      AVALUE(ICNT)=REAL(N)
16058      IDIGIT(ICNT)=0
16059      ICNT=ICNT+1
16060      ITEXT(ICNT)='Sample Mean:'
16061      NCTEXT(ICNT)=12
16062      AVALUE(ICNT)=XMEAN
16063      IDIGIT(ICNT)=NUMDIG
16064      ICNT=ICNT+1
16065      ITEXT(ICNT)='Sample Standard Deviation:'
16066      NCTEXT(ICNT)=26
16067      AVALUE(ICNT)=XSD
16068      IDIGIT(ICNT)=NUMDIG
16069      ICNT=ICNT+1
16070      ITEXT(ICNT)='Sample Minimum:'
16071      NCTEXT(ICNT)=15
16072      AVALUE(ICNT)=XMIN
16073      IDIGIT(ICNT)=NUMDIG
16074      ICNT=ICNT+1
16075      ITEXT(ICNT)='Sample Maximum:'
16076      NCTEXT(ICNT)=15
16077      AVALUE(ICNT)=XMAX
16078      IDIGIT(ICNT)=NUMDIG
16079      ICNT=ICNT+1
16080      ITEXT(ICNT)=' '
16081      NCTEXT(ICNT)=0
16082      AVALUE(ICNT)=0.0
16083      IDIGIT(ICNT)=-1
16084C
16085      ICNT=ICNT+1
16086      ITEXT(ICNT)='First Sample L-Moment:'
16087      NCTEXT(ICNT)=22
16088      AVALUE(ICNT)=REAL(XMOM(1))
16089      IDIGIT(ICNT)=NUMDIG
16090      ICNT=ICNT+1
16091      ITEXT(ICNT)='Second Sample L-Moment:'
16092      NCTEXT(ICNT)=23
16093      AVALUE(ICNT)=REAL(XMOM(2))
16094      IDIGIT(ICNT)=NUMDIG
16095      ICNT=ICNT+1
16096      ITEXT(ICNT)='Third Sample L-Moment:'
16097      NCTEXT(ICNT)=22
16098      AVALUE(ICNT)=REAL(XMOM(3))
16099      IDIGIT(ICNT)=NUMDIG
16100      ICNT=ICNT+1
16101      ITEXT(ICNT)=' '
16102      NCTEXT(ICNT)=0
16103      AVALUE(ICNT)=0.0
16104      IDIGIT(ICNT)=-1
16105C
16106      ICNT=ICNT+1
16107      ITEXT(ICNT)='Method of L-Moments:'
16108      NCTEXT(ICNT)=20
16109      AVALUE(ICNT)=0.0
16110      IDIGIT(ICNT)=-1
16111      ICNT=ICNT+1
16112      ITEXT(ICNT)='Estimate of Location:'
16113      NCTEXT(ICNT)=22
16114      AVALUE(ICNT)=ALOCML
16115      IDIGIT(ICNT)=NUMDIG
16116      ICNT=ICNT+1
16117      ITEXT(ICNT)='Estimate of Scale:'
16118      NCTEXT(ICNT)=18
16119      AVALUE(ICNT)=SCALML
16120      IDIGIT(ICNT)=NUMDIG
16121      ICNT=ICNT+1
16122      ITEXT(ICNT)='Estimate of Shape (Gamma):'
16123      NCTEXT(ICNT)=26
16124      AVALUE(ICNT)=SHAPML
16125      IDIGIT(ICNT)=NUMDIG
16126      ICNT=ICNT+1
16127      ITEXT(ICNT)=' '
16128      NCTEXT(ICNT)=0
16129      AVALUE(ICNT)=0.0
16130      IDIGIT(ICNT)=-1
16131C
16132CCCCC ICNT=ICNT+1
16133CCCCC ITEXT(ICNT)='Log-likelihood:'
16134CCCCC NCTEXT(ICNT)=15
16135CCCCC AVALUE(ICNT)=ALIK
16136CCCCC IDIGIT(ICNT)=-7
16137CCCCC ICNT=ICNT+1
16138CCCCC ITEXT(ICNT)='AIC:'
16139CCCCC NCTEXT(ICNT)=4
16140CCCCC AVALUE(ICNT)=AIC
16141CCCCC IDIGIT(ICNT)=-7
16142CCCCC ICNT=ICNT+1
16143CCCCC ITEXT(ICNT)='AICc:'
16144CCCCC NCTEXT(ICNT)=5
16145CCCCC AVALUE(ICNT)=AICC
16146CCCCC IDIGIT(ICNT)=-7
16147CCCCC ICNT=ICNT+1
16148CCCCC ITEXT(ICNT)='BIC:'
16149CCCCC NCTEXT(ICNT)=4
16150CCCCC AVALUE(ICNT)=BIC
16151CCCCC IDIGIT(ICNT)=-7
16152C
16153      NUMROW=ICNT
16154      DO2320I=1,NUMROW
16155        NTOT(I)=15
16156 2320 CONTINUE
16157C
16158      IFRST=.TRUE.
16159      ILAST=.TRUE.
16160      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
16161     1            AVALUE,IDIGIT,
16162     1            NTOT,NUMROW,
16163     1            ICAPSW,ICAPTY,ILAST,IFRST,
16164     1            ISUBRO,IBUGA3,IERROR)
16165C
16166C               *****************
16167C               **  STEP 90--  **
16168C               **  EXIT       **
16169C               *****************
16170C
16171 9000 CONTINUE
16172      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGL')THEN
16173        WRITE(ICOUT,999)
16174        CALL DPWRST('XXX','WRIT')
16175        WRITE(ICOUT,9011)
16176 9011   FORMAT('***** AT THE END       OF DPMLGL--')
16177        CALL DPWRST('XXX','WRIT')
16178        WRITE(ICOUT,9012)N,IBUGA3,IERROR
16179 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
16180        CALL DPWRST('XXX','WRIT')
16181        WRITE(ICOUT,9015)N
16182 9015   FORMAT('N = ',I8)
16183        CALL DPWRST('XXX','WRIT')
16184      ENDIF
16185C
16186      RETURN
16187      END
16188      SUBROUTINE DPMLGP(Y,N,ICASPL,
16189     1                  TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,YTEMP,
16190     1                  DTEMP1,XMOM,
16191     1                  MAXNXT,THRESH,MINMAX,
16192     1                  QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
16193     1                  SHAPMO,SCALMO,ALOCMO,
16194     1                  SHAPLM,SCALLM,ALOCLM,
16195     1                  SHAPEP,SCALEP,ALOCEP,
16196     1                  SHAPML,SCALML,ALOCML,
16197     1                  ICAPSW,ICAPTY,IFORSW,
16198     1                  IOUNI1,IOUNI2,ISEED,ALPHAP,
16199     1                  GAMMSV,SCALSV,
16200     1                  ISUBRO,IBUGA3,IERROR)
16201C
16202C     PURPOSE--THIS ROUTINE COMPUTES THE METHOD OF MOMENT AND
16203C              MAXIMUM LIKELIHOOD ESTIMATES FOR THE GENERALIZED PARETO
16204C              DISTRIBUTION
16205C     EXAMPLE--GENERALIZED PARETO MAXIMUM LIKELIHOOD Y
16206C     REFERENCE--JOHNSON, KOTZ, AND BALAKRISHNAN.  "CONTINUOUS
16207C                UNIVARIATE DISTRIBUTIONS, VOLUME I", SECOND
16208C                EDITION, WILEY, 1994, PP. 614-619.
16209C              --CASTILLO, HADI, BALAKRISHNAN, SARABIA, "EXTREME
16210C                VALUE AND RELATED MODELS WITH APPLICATIONS IN
16211C                ENGINEERING AND SCIENCE", WILEY, 2005.
16212C              --FORTRAN CODE WRITTEN FOR INCLUSION IN IBM
16213C                RESEARCH REPORT RC20525, 'FORTRAN ROUTINES FOR
16214C                USE WITH THE METHOD OF L-MOMENTS, VERSION 3',
16215C                J. R. M. HOSKING, IBM RESEARCH DIVISION,
16216C                T. J. WATSON RESEARCH CENTER, YORKTOWN HEIGHTS
16217C                NEW YORK 10598, U.S.A., VERSION 3     AUGUST 1996
16218C     WRITTEN BY--ALAN HECKERT
16219C                 STATISTICAL ENGINEERING DIVISION
16220C                 INFORMATION TECHNOLOGY LABORATORY
16221C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16222C                 GAITHERSBUG, MD 20899-8980
16223C                 PHONE--301-975-2899
16224C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
16225C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
16226C     LANGUAGE--ANSI FORTRAN (1977)
16227C     VERSION NUMBER--2003/11
16228C     ORIGINAL VERSION--NOVEMBER  2003.
16229C     UPDATED         --JUNE      2004. SUPPORT FOR IGEPDF (ALTERNATE
16230C                                       DEFINITION OF GENERALIZED
16231C                                       PARETO: SIGN IS REVERSED)
16232C     UPDATED         --JUNE      2004. PRINT VARIANCE-COVARIANCE
16233C                                       MATRIX
16234C     UPDATED         --JUNE      2005. SUPPORT FOR L-MOMENTS
16235C                                       ESTIMATES
16236C     UPDATED         --JUNE      2005. FOR MLE, MOMENTS, DEFINE
16237C                                       "THRESH" AS THE LOCATION
16238C                                       PARAMETER.
16239C     UPDATED         --OCTOBER   2005. ALLOW DIFFERENT CHOICES FOR
16240C                                       STARTING VALUES
16241C     UPDATED         --APRIL     2008. ADD MINMAX TO SUPPORT MINIMUM
16242C                                       CASE
16243C     UPDATED         --JULY      2010. EXTRACT POINT ESTIMATION TO
16244C                                       GEPML1
16245C     UPDATED         --JULY      2010. CALL GEPLI1 TO OBTAIN
16246C                                       LIKELIHOOD, AIC VALUES
16247C     UPDATED         --JULY      2010. USE DPDTA1, DPDTA7, DPDTA9
16248C                                       TO PRINT
16249C
16250C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
16251C
16252      CHARACTER*4 ICASPL
16253      CHARACTER*4 ICAPSW
16254      CHARACTER*4 ICAPTY
16255      CHARACTER*4 IFORSW
16256      CHARACTER*4 ISUBRO
16257      CHARACTER*4 IBUGA3
16258      CHARACTER*4 IERROR
16259C
16260      CHARACTER*4 ILIKFL
16261      CHARACTER*4 IDFTZZ
16262      CHARACTER*4 ISUBN1
16263      CHARACTER*4 ISUBN2
16264      CHARACTER*4 ISTEPN
16265      CHARACTER*7 ICASE
16266C
16267C---------------------------------------------------------------------
16268C
16269      DIMENSION Y(*)
16270      DIMENSION YTEMP(*)
16271      DIMENSION TEMP1(*)
16272      DIMENSION TEMP2(*)
16273      DIMENSION TEMP3(*)
16274      DIMENSION TEMP4(*)
16275      DIMENSION TEMP5(*)
16276      DOUBLE PRECISION DTEMP1(*)
16277      DOUBLE PRECISION XMOM(*)
16278C
16279      PARAMETER (NUMALP=8)
16280      DIMENSION ALPHA(NUMALP)
16281      DIMENSION ALOWSC(NUMALP)
16282      DIMENSION AUPPSC(NUMALP)
16283      DIMENSION ALOWSH(NUMALP)
16284      DIMENSION AUPPSH(NUMALP)
16285C
16286      DIMENSION QP(*)
16287      DIMENSION XQPHAT(*)
16288      DIMENSION XQPSE(*)
16289      DIMENSION XQPLCL(*)
16290      DIMENSION XQPUCL(*)
16291C
16292      DOUBLE PRECISION DT1
16293      DOUBLE PRECISION DT2
16294      DOUBLE PRECISION DTERM1
16295      DOUBLE PRECISION DG
16296      DOUBLE PRECISION DS
16297      DOUBLE PRECISION DQP
16298C
16299      INCLUDE 'DPCOST.INC'
16300C
16301      PARAMETER (MAXROW=60)
16302      CHARACTER*60 ITITLE
16303      CHARACTER*60 ITITLZ
16304      CHARACTER*60 ITEXT(MAXROW)
16305      REAL         AVALUE(MAXROW)
16306      INTEGER      NCTEXT(MAXROW)
16307      INTEGER      IDIGIT(MAXROW)
16308      INTEGER      NTOT(MAXROW)
16309      LOGICAL IFRST
16310      LOGICAL ILAST
16311C
16312C---------------------------------------------------------------------
16313C
16314      INCLUDE 'DPCOP2.INC'
16315C
16316      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
16317C
16318C-----START POINT-----------------------------------------------------
16319C
16320      ISUBN1='DPML'
16321      ISUBN2='GP  '
16322      ICASE='MAXIMUM'
16323      IF(MINMAX.EQ.1)ICASE='MINIMUM'
16324      IERROR='NO'
16325C
16326      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGP')THEN
16327        WRITE(ICOUT,999)
16328  999   FORMAT(1X)
16329        CALL DPWRST('XXX','WRIT')
16330        WRITE(ICOUT,51)
16331   51   FORMAT('**** AT THE BEGINNING OF DPMLGP--')
16332        CALL DPWRST('XXX','WRIT')
16333        WRITE(ICOUT,52)IBUGA3,ISUBRO
16334   52   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
16335        CALL DPWRST('XXX','WRIT')
16336        WRITE(ICOUT,53)N,IOUNI1,IOUNI2,ISEED
16337   53   FORMAT('N,IOUNI1,IOUNI2,ISEED = ',4I8)
16338        CALL DPWRST('XXX','WRIT')
16339        DO56I=1,MIN(N,100)
16340          WRITE(ICOUT,57)I,Y(I)
16341   57     FORMAT('I,Y(I) = ',I8,G15.7)
16342          CALL DPWRST('XXX','WRIT')
16343   56   CONTINUE
16344      ENDIF
16345C
16346C               ********************************************
16347C               **  STEP 11--                             **
16348C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
16349C               ********************************************
16350C
16351      ISTEPN='11'
16352      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGP')
16353     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
16354C
16355C               ***************************************************
16356C               **  STEP 21--                                    **
16357C               **  CARRY OUT CALCULATIONS                       **
16358C               **  FOR GENERALIZED PARETO MOMENT/MLE ESTIMATION **
16359C               ***************************************************
16360C
16361      ISTEPN='21'
16362      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGP')
16363     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
16364C
16365      NMIN=3
16366      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
16367      IF(IERROR.EQ.'YES')GOTO9000
16368C
16369      IDFTZZ='ALL'
16370      CALL GEPML1(Y,N,MAXNXT,MINMAX,ICASPL,IGEPDF,IGEPSV,IDFTTY,
16371     1            GAMMSV,SCALSV,ISEED,THRESH,
16372     1            TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,YTEMP,
16373     1            DTEMP1,XMOM,NMOM,
16374     1            XMEAN,XSD,XVAR,XMIN,XMAX,
16375     1            ALOCMO,SCALMO,SHAPMO,
16376     1            ALOCLM,SCALLM,SHAPLM,
16377     1            ALOCEP,SCALEP,SHAPEP,
16378     1            ALOCML,SCALML,SHAPML,MLFLAG,
16379     1            NUSE,ZMEAN,ZVAR,ZSD,ALOC,
16380     1            VARMM1,VARMM2,COVMOM,
16381     1            VARML1,VARML2,COVML,
16382     1            ISUBRO,IBUGA3,IERROR)
16383C
16384      CALL GEPLI1(Y,N,MINMAX,IGEPDF,
16385     1            ALOCLM,SCALLM,SHAPLM,
16386     1            ALIKLM,AICLM,AICCLM,BICLM,
16387     1            ISUBRO,IBUGA3,IERROR)
16388C
16389      CALL GEPLI1(Y,N,MINMAX,IGEPDF,
16390     1            ALOCMO,SCALMO,SHAPMO,
16391     1            ALIKMO,AICMO,AICCMO,BICMO,
16392     1            ISUBRO,IBUGA3,IERROR)
16393C
16394      CALL GEPLI1(Y,N,MINMAX,IGEPDF,
16395     1            ALOCEP,SCALEP,SHAPEP,
16396     1            ALIKEP,AICEP,AICCEP,BICEP,
16397     1            ISUBRO,IBUGA3,IERROR)
16398C
16399      IF(MLFLAG.EQ.0 .AND. SHAPML.NE.CPUMIN)THEN
16400        CALL GEPLI1(Y,N,MINMAX,IGEPDF,
16401     1              ALOCML,SCALML,SHAPML,
16402     1              ALIKML,AICML,AICCML,BICML,
16403     1              ISUBRO,IBUGA3,IERROR)
16404      ELSE
16405        ALIKML=CPUMIN
16406        AICML=CPUMIN
16407        AICCML=CPUMIN
16408        BICML=CPUMIN
16409      ENDIF
16410C
16411      IF(MLFLAG.EQ.0)THEN
16412        AN=REAL(N)
16413        DO2310I=1,NUMALP
16414          ALP=ALPHA(I)
16415          P=1.0-(ALP/2.0)
16416          CALL NORPPF(P,PPF)
16417          ALOWSC(I)=SCALML - PPF*SQRT(VARML2)
16418          AUPPSC(I)=SCALML + PPF*SQRT(VARML2)
16419          IF(IGEPDF.EQ.'SIMI')THEN
16420            ALOWSH(I)=SHAPML - PPF*SQRT(VARML1)
16421            AUPPSH(I)=SHAPML + PPF*SQRT(VARML1)
16422          ELSE
16423            ALOWSH(I)=(-SHAPML) - PPF*SQRT(VARML1)
16424            AUPPSH(I)=(-SHAPML) + PPF*SQRT(VARML1)
16425          ENDIF
16426 2310   CONTINUE
16427C
16428        IF(NPERC.GE.1)THEN
16429C
16430          ALPHL=ALPHAP/2.0
16431          ALPHU=1.0 - ALPHAP/2.0
16432          CALL NORPPF(ALPHU,Z95)
16433C
16434C
16435CCCCC     WRITE(IOUNI1,2531)
16436CCCCC     WRITE(IOUNI1,2532)
16437          DO2429I=1,NPERC
16438            QPTEMP=QP(I)/100.0
16439            CALL GEPPPF(QPTEMP,SHAPML,MINMAX,IGEPDF,APPF)
16440            XQPHAT(I)=ALOCML + SCALML*APPF
16441C
16442            IF(SHAPML.EQ.0.0)THEN
16443              DT1=-DLOG(1.0D0 - DBLE(QPTEMP))
16444              DT2=0.0D0
16445            ELSE
16446              DG=DBLE(SHAPML)
16447              DS=DBLE(SCALML)
16448              DQP=DBLE(QPTEMP)
16449              DT1=(1.0D0/DG)*(1.0D0 - (1.0D0 - DQP)**DG)
16450              DT2=-(DS/(DG*DG))*(1.0D0 - (1.0D0 - DQP)**DG) -
16451     1            (DS/DG)*((1.0D0 - DQP)**DG)*DLOG(1.0D0 - DQP)
16452            ENDIF
16453C
16454            DTERM1=DT1**2*DBLE(VARML2) + DT1*DT2*DBLE(COVML) +
16455     1             DT2**2*DBLE(VARML1) + DT1*DT2*DBLE(COVML)
16456            SEXQP=REAL(DTERM1)
16457            IF(SEXQP.GE.0.0)THEN
16458              SEXQP=SQRT(SEXQP)
16459            ELSE
16460              SEXQP=0.0
16461            ENDIF
16462            XQPSE(I)=SEXQP
16463            XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
16464            XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
16465CCCCC       WRITE(IOUNI1,'(5E15.7)')
16466CCCCC1           QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
16467 2429     CONTINUE
16468C2531     FORMAT(15X,'       POINT     ','   STANDARD    ',
16469CCCCC1           '     LOWER     ',
16470CCCCC1           '     UPPER')
16471C2532     FORMAT('    PERCENTILE ','     ESTIMATE   ',
16472CCCCC1           '     ERROR     ',
16473CCCCC1           'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
16474        ENDIF
16475C
16476      ENDIF
16477C
16478C               ***********************************************
16479C               **   STEP 42--                               **
16480C               **   WRITE OUT EVERYTHING                    **
16481C               **   FOR GENERALIZED PARETO MLE ESTIMATION   **
16482C               ***********************************************
16483C
16484      ISTEPN='42'
16485      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGP')
16486     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
16487C
16488      IF(IPRINT.EQ.'OFF')GOTO9000
16489C
16490      NUMDIG=7
16491      IF(IFORSW.EQ.'1')NUMDIG=1
16492      IF(IFORSW.EQ.'2')NUMDIG=2
16493      IF(IFORSW.EQ.'3')NUMDIG=3
16494      IF(IFORSW.EQ.'4')NUMDIG=4
16495      IF(IFORSW.EQ.'5')NUMDIG=5
16496      IF(IFORSW.EQ.'6')NUMDIG=6
16497      IF(IFORSW.EQ.'7')NUMDIG=7
16498      IF(IFORSW.EQ.'8')NUMDIG=8
16499      IF(IFORSW.EQ.'9')NUMDIG=9
16500      IF(IFORSW.EQ.'0')NUMDIG=0
16501      IF(IFORSW.EQ.'E')NUMDIG=-2
16502      IF(IFORSW.EQ.'-2')NUMDIG=-2
16503      IF(IFORSW.EQ.'-3')NUMDIG=-3
16504      IF(IFORSW.EQ.'-4')NUMDIG=-4
16505      IF(IFORSW.EQ.'-5')NUMDIG=-5
16506      IF(IFORSW.EQ.'-6')NUMDIG=-6
16507      IF(IFORSW.EQ.'-7')NUMDIG=-7
16508      IF(IFORSW.EQ.'-8')NUMDIG=-8
16509      IF(IFORSW.EQ.'-9')NUMDIG=-9
16510C
16511      ITITLE='Generalized Pareto Parameter Estimation'
16512      NCTITL=39
16513      IF(MINMAX.EQ.1)THEN
16514        ITITLZ='(Minimum Case)'
16515        NCTITZ=14
16516      ELSE
16517        ITITLZ='(Maximum Case)'
16518        NCTITZ=14
16519      ENDIF
16520      ICNT=1
16521      ITEXT(ICNT)='Summary Statistics:'
16522      NCTEXT(ICNT)=19
16523      AVALUE(ICNT)=0.0
16524      IDIGIT(ICNT)=-1
16525      ICNT=ICNT+1
16526      ITEXT(ICNT)='Number of Observations:'
16527      NCTEXT(ICNT)=23
16528      AVALUE(ICNT)=REAL(N)
16529      IDIGIT(ICNT)=0
16530      ICNT=ICNT+1
16531      ITEXT(ICNT)='Sample Mean:'
16532      NCTEXT(ICNT)=12
16533      AVALUE(ICNT)=XMEAN
16534      IDIGIT(ICNT)=NUMDIG
16535      ICNT=ICNT+1
16536      ITEXT(ICNT)='Sample Standard Deviation:'
16537      NCTEXT(ICNT)=26
16538      AVALUE(ICNT)=XSD
16539      IDIGIT(ICNT)=NUMDIG
16540      ICNT=ICNT+1
16541      ITEXT(ICNT)='Sample Minimum:'
16542      NCTEXT(ICNT)=15
16543      AVALUE(ICNT)=XMIN
16544      IDIGIT(ICNT)=NUMDIG
16545      ICNT=ICNT+1
16546      ITEXT(ICNT)='Sample Maximum:'
16547      NCTEXT(ICNT)=15
16548      AVALUE(ICNT)=XMAX
16549      IDIGIT(ICNT)=NUMDIG
16550      IF(THRESH.NE.CPUMIN)THEN
16551        ICNT=ICNT+1
16552        ITEXT(ICNT)='User-Specified Threshold:'
16553        NCTEXT(ICNT)=25
16554        AVALUE(ICNT)=THRESH
16555        IDIGIT(ICNT)=NUMDIG
16556      ENDIF
16557      ICNT=ICNT+1
16558      ITEXT(ICNT)=' '
16559      NCTEXT(ICNT)=0
16560      AVALUE(ICNT)=0.0
16561      IDIGIT(ICNT)=-1
16562C
16563      ICNT=ICNT+1
16564      ITEXT(ICNT)='Method of Moments:'
16565      NCTEXT(ICNT)=18
16566      AVALUE(ICNT)=0.0
16567      IDIGIT(ICNT)=-1
16568      IF(IGEPDF.EQ.'SIMI')THEN
16569        ICNT=ICNT+1
16570        ITEXT(ICNT)='(Valid if shape parameter < 1)'
16571        NCTEXT(ICNT)=30
16572        AVALUE(ICNT)=0.0
16573        IDIGIT(ICNT)=-1
16574      ELSE
16575        ICNT=ICNT+1
16576        ITEXT(ICNT)='(Valid if shape parameter > -1)'
16577        NCTEXT(ICNT)=31
16578        AVALUE(ICNT)=0.0
16579        IDIGIT(ICNT)=-1
16580      ENDIF
16581      ICNT=ICNT+1
16582      ITEXT(ICNT)='Sample Mean After Subtract Location:'
16583      NCTEXT(ICNT)=36
16584      AVALUE(ICNT)=ZMEAN
16585      IDIGIT(ICNT)=NUMDIG
16586      ICNT=ICNT+1
16587      ITEXT(ICNT)='Sample SD After Subtract Location:'
16588      NCTEXT(ICNT)=34
16589      AVALUE(ICNT)=ZSD
16590      IDIGIT(ICNT)=NUMDIG
16591      ICNT=ICNT+1
16592      ITEXT(ICNT)='Estimate of Location:'
16593      NCTEXT(ICNT)=22
16594      AVALUE(ICNT)=ALOCMO
16595      IDIGIT(ICNT)=NUMDIG
16596      ICNT=ICNT+1
16597      ITEXT(ICNT)='Estimate of Scale:'
16598      NCTEXT(ICNT)=18
16599      AVALUE(ICNT)=SCALMO
16600      IDIGIT(ICNT)=NUMDIG
16601      ICNT=ICNT+1
16602      ITEXT(ICNT)='Estimate of Shape (Gamma):'
16603      NCTEXT(ICNT)=26
16604      AVALUE(ICNT)=SHAPMO
16605      IDIGIT(ICNT)=NUMDIG
16606C
16607      IF(VARMM1.NE.CPUMIN)THEN
16608        ICNT=ICNT+1
16609        ITEXT(ICNT)='Standard Error of Shape:'
16610        NCTEXT(ICNT)=24
16611        AVALUE(ICNT)=SQRT(VARMM1)
16612        IDIGIT(ICNT)=NUMDIG
16613        ICNT=ICNT+1
16614        ITEXT(ICNT)='Standard Error of Scale:'
16615        NCTEXT(ICNT)=24
16616        AVALUE(ICNT)=SQRT(VARMM2)
16617        IDIGIT(ICNT)=NUMDIG
16618        ICNT=ICNT+1
16619        ITEXT(ICNT)='Scale/Shape Covariance:'
16620        NCTEXT(ICNT)=23
16621        AVALUE(ICNT)=COVMOM
16622        IDIGIT(ICNT)=NUMDIG
16623      ENDIF
16624C
16625      IF(ALIKMO.NE.CPUMIN)THEN
16626        ICNT=ICNT+1
16627        ITEXT(ICNT)='Log-likelihood:'
16628        NCTEXT(ICNT)=15
16629        AVALUE(ICNT)=ALIKMO
16630        IDIGIT(ICNT)=-7
16631        ICNT=ICNT+1
16632        ITEXT(ICNT)='AIC:'
16633        NCTEXT(ICNT)=4
16634        AVALUE(ICNT)=AICMO
16635        IDIGIT(ICNT)=-7
16636        ICNT=ICNT+1
16637        ITEXT(ICNT)='AICc:'
16638        NCTEXT(ICNT)=5
16639        AVALUE(ICNT)=AICCMO
16640        IDIGIT(ICNT)=-7
16641        ICNT=ICNT+1
16642        ITEXT(ICNT)='BIC:'
16643        NCTEXT(ICNT)=4
16644        AVALUE(ICNT)=BICMO
16645        IDIGIT(ICNT)=-7
16646      ENDIF
16647      ICNT=ICNT+1
16648      ITEXT(ICNT)=' '
16649      NCTEXT(ICNT)=0
16650      AVALUE(ICNT)=0.0
16651      IDIGIT(ICNT)=-1
16652C
16653      ICNT=ICNT+1
16654      ITEXT(ICNT)='Method of L-Moments:'
16655      NCTEXT(ICNT)=20
16656      AVALUE(ICNT)=0.0
16657      IDIGIT(ICNT)=-1
16658      ICNT=ICNT+1
16659      ITEXT(ICNT)='(L-Moment Estimates Work Best for Values'
16660      NCTEXT(ICNT)=40
16661      AVALUE(ICNT)=0.0
16662      IDIGIT(ICNT)=-1
16663      ICNT=ICNT+1
16664      ITEXT(ICNT)='for Shape Parameter in (-0.5,0.5))'
16665      NCTEXT(ICNT)=34
16666      AVALUE(ICNT)=0.0
16667      IDIGIT(ICNT)=-1
16668      ICNT=ICNT+1
16669      ITEXT(ICNT)='First Sample L-Moment:'
16670      NCTEXT(ICNT)=22
16671      AVALUE(ICNT)=REAL(XMOM(1))
16672      IDIGIT(ICNT)=NUMDIG
16673      ICNT=ICNT+1
16674      ITEXT(ICNT)='Second Sample L-Moment:'
16675      NCTEXT(ICNT)=23
16676      AVALUE(ICNT)=REAL(XMOM(2))
16677      IDIGIT(ICNT)=NUMDIG
16678      ICNT=ICNT+1
16679      ITEXT(ICNT)='Third Sample L-Moment:'
16680      NCTEXT(ICNT)=22
16681      AVALUE(ICNT)=REAL(XMOM(3))
16682      IDIGIT(ICNT)=NUMDIG
16683      ICNT=ICNT+1
16684      ITEXT(ICNT)=' '
16685      NCTEXT(ICNT)=0
16686      AVALUE(ICNT)=0.0
16687      IDIGIT(ICNT)=-1
16688C
16689      ICNT=ICNT+1
16690      ITEXT(ICNT)='Estimate of Location:'
16691      NCTEXT(ICNT)=22
16692      AVALUE(ICNT)=ALOCLM
16693      IDIGIT(ICNT)=NUMDIG
16694      ICNT=ICNT+1
16695      ITEXT(ICNT)='Estimate of Scale:'
16696      NCTEXT(ICNT)=18
16697      AVALUE(ICNT)=SCALLM
16698      IDIGIT(ICNT)=NUMDIG
16699      ICNT=ICNT+1
16700      ITEXT(ICNT)='Estimate of Shape (Gamma):'
16701      NCTEXT(ICNT)=26
16702      AVALUE(ICNT)=SHAPLM
16703      IDIGIT(ICNT)=NUMDIG
16704C
16705      IF(ALIKLM.NE.CPUMIN)THEN
16706        ICNT=ICNT+1
16707        ITEXT(ICNT)='Log-likelihood:'
16708        NCTEXT(ICNT)=15
16709        AVALUE(ICNT)=ALIKLM
16710        IDIGIT(ICNT)=-7
16711        ICNT=ICNT+1
16712        ITEXT(ICNT)='AIC:'
16713        NCTEXT(ICNT)=4
16714        AVALUE(ICNT)=AICLM
16715        IDIGIT(ICNT)=-7
16716        ICNT=ICNT+1
16717        ITEXT(ICNT)='AICc:'
16718        NCTEXT(ICNT)=5
16719        AVALUE(ICNT)=AICCLM
16720        IDIGIT(ICNT)=-7
16721        ICNT=ICNT+1
16722        ITEXT(ICNT)='BIC:'
16723        NCTEXT(ICNT)=4
16724        AVALUE(ICNT)=BICLM
16725        IDIGIT(ICNT)=-7
16726      ENDIF
16727      ICNT=ICNT+1
16728      ITEXT(ICNT)=' '
16729      NCTEXT(ICNT)=0
16730      AVALUE(ICNT)=0.0
16731      IDIGIT(ICNT)=-1
16732C
16733      ICNT=ICNT+1
16734      ITEXT(ICNT)='Method of Elemental Percentiles:'
16735      NCTEXT(ICNT)=32
16736      AVALUE(ICNT)=0.0
16737      IDIGIT(ICNT)=-1
16738      ICNT=ICNT+1
16739      ITEXT(ICNT)='Estimate of Location:'
16740      NCTEXT(ICNT)=22
16741      AVALUE(ICNT)=ALOCEP
16742      IDIGIT(ICNT)=NUMDIG
16743      ICNT=ICNT+1
16744      ITEXT(ICNT)='Estimate of Scale:'
16745      NCTEXT(ICNT)=18
16746      AVALUE(ICNT)=SCALEP
16747      IDIGIT(ICNT)=NUMDIG
16748      ICNT=ICNT+1
16749      ITEXT(ICNT)='Estimate of Shape (Gamma):'
16750      NCTEXT(ICNT)=26
16751      AVALUE(ICNT)=SHAPEP
16752      IDIGIT(ICNT)=NUMDIG
16753C
16754      IF(ALIKEP.NE.CPUMIN)THEN
16755        ICNT=ICNT+1
16756        ITEXT(ICNT)='Log-likelihood:'
16757        NCTEXT(ICNT)=15
16758        AVALUE(ICNT)=ALIKEP
16759        IDIGIT(ICNT)=-7
16760        ICNT=ICNT+1
16761        ITEXT(ICNT)='AIC:'
16762        NCTEXT(ICNT)=4
16763        AVALUE(ICNT)=AICEP
16764        IDIGIT(ICNT)=-7
16765        ICNT=ICNT+1
16766        ITEXT(ICNT)='AICc:'
16767        NCTEXT(ICNT)=5
16768        AVALUE(ICNT)=AICCEP
16769        IDIGIT(ICNT)=-7
16770        ICNT=ICNT+1
16771        ITEXT(ICNT)='BIC:'
16772        NCTEXT(ICNT)=4
16773        AVALUE(ICNT)=BICEP
16774        IDIGIT(ICNT)=-7
16775      ENDIF
16776      ICNT=ICNT+1
16777      ITEXT(ICNT)=' '
16778      NCTEXT(ICNT)=0
16779      AVALUE(ICNT)=0.0
16780      IDIGIT(ICNT)=-1
16781C
16782      IF(MLFLAG .EQ.0 .AND. SHAPML.NE.CPUMIN)THEN
16783        ICNT=ICNT+1
16784        ITEXT(ICNT)='Maximum Likelihood:'
16785        NCTEXT(ICNT)=19
16786        AVALUE(ICNT)=0.0
16787        IDIGIT(ICNT)=-1
16788        ICNT=ICNT+1
16789        ITEXT(ICNT)='Estimate of Location:'
16790        NCTEXT(ICNT)=22
16791        AVALUE(ICNT)=ALOCML
16792        IDIGIT(ICNT)=NUMDIG
16793        ICNT=ICNT+1
16794        ITEXT(ICNT)='Estimate of Scale:'
16795        NCTEXT(ICNT)=18
16796        AVALUE(ICNT)=SCALML
16797        IDIGIT(ICNT)=NUMDIG
16798        ICNT=ICNT+1
16799        ITEXT(ICNT)='Estimate of Shape (Gamma):'
16800        NCTEXT(ICNT)=26
16801        AVALUE(ICNT)=SHAPML
16802        IDIGIT(ICNT)=NUMDIG
16803C
16804        IF(VARML1.NE.CPUMIN)THEN
16805          ICNT=ICNT+1
16806          ITEXT(ICNT)='Standard Error of Shape:'
16807          NCTEXT(ICNT)=24
16808          AVALUE(ICNT)=SQRT(VARML1)
16809          IDIGIT(ICNT)=NUMDIG
16810          ICNT=ICNT+1
16811          ITEXT(ICNT)='Standard Error of Scale:'
16812          NCTEXT(ICNT)=24
16813          AVALUE(ICNT)=SQRT(VARML2)
16814          IDIGIT(ICNT)=NUMDIG
16815          ICNT=ICNT+1
16816          ITEXT(ICNT)='Scale/Shape Covariance:'
16817          NCTEXT(ICNT)=23
16818          AVALUE(ICNT)=COVML
16819          IDIGIT(ICNT)=NUMDIG
16820        ENDIF
16821C
16822        IF(ALIKML.NE.CPUMIN)THEN
16823          ICNT=ICNT+1
16824          ITEXT(ICNT)='Log-likelihood:'
16825          NCTEXT(ICNT)=15
16826          AVALUE(ICNT)=ALIKML
16827          IDIGIT(ICNT)=-7
16828          ICNT=ICNT+1
16829          ITEXT(ICNT)='AIC:'
16830          NCTEXT(ICNT)=4
16831          AVALUE(ICNT)=AICML
16832          IDIGIT(ICNT)=-7
16833          ICNT=ICNT+1
16834          ITEXT(ICNT)='AICc:'
16835          NCTEXT(ICNT)=5
16836          AVALUE(ICNT)=AICCML
16837          IDIGIT(ICNT)=-7
16838          ICNT=ICNT+1
16839          ITEXT(ICNT)='BIC:'
16840          NCTEXT(ICNT)=4
16841          AVALUE(ICNT)=BICML
16842          IDIGIT(ICNT)=-7
16843        ENDIF
16844      ELSE
16845        ICNT=ICNT+1
16846        ITEXT(ICNT)='Unable to Compute Maximum Likelihood Estimates'
16847        NCTEXT(ICNT)=46
16848        AVALUE(ICNT)=0.0
16849        IDIGIT(ICNT)=-1
16850      ENDIF
16851      ICNT=ICNT+1
16852      ITEXT(ICNT)=' '
16853      NCTEXT(ICNT)=0
16854      AVALUE(ICNT)=0.0
16855      IDIGIT(ICNT)=-1
16856C
16857      NUMROW=ICNT
16858      DO2320I=1,NUMROW
16859        NTOT(I)=15
16860 2320 CONTINUE
16861C
16862      IFRST=.TRUE.
16863      ILAST=.TRUE.
16864      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
16865     1            AVALUE,IDIGIT,
16866     1            NTOT,NUMROW,
16867     1            ICAPSW,ICAPTY,ILAST,IFRST,
16868     1            ISUBRO,IBUGA3,IERROR)
16869C
16870      IF(MLFLAG .EQ.0 .AND. SHAPML.NE.CPUMIN)THEN
16871        ILIKFL='OFF'
16872        CALL DPDTA8(ALOWSC,AUPPSC,ALOWSC,AUPPSC,
16873     1              ALOWSH,AUPPSH,ALOWSH,AUPPSH,ALPHA,NUMALP,
16874     1              ICAPSW,ICAPTY,NUMDIG,ILIKFL,
16875     1              ISUBRO,IBUGA3,IERROR)
16876C
16877        ILIKFL='OFF'
16878        IF(NPERC.GT.1)THEN
16879          ILIKFL='OFF'
16880          CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
16881     1                ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
16882     1                ISUBRO,IBUGA3,IERROR)
16883        ENDIF
16884      ENDIF
16885C
16886C               *****************
16887C               **  STEP 90--  **
16888C               **  EXIT       **
16889C               *****************
16890C
16891 9000 CONTINUE
16892      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLGP')GOTO9090
16893      WRITE(ICOUT,999)
16894      CALL DPWRST('XXX','WRIT')
16895      WRITE(ICOUT,9011)
16896 9011 FORMAT('***** AT THE END       OF DPMLGP--')
16897      CALL DPWRST('XXX','WRIT')
16898      WRITE(ICOUT,9012)N,IBUGA3,IERROR
16899 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
16900      CALL DPWRST('XXX','WRIT')
16901      WRITE(ICOUT,9015)N
16902 9015 FORMAT('N = ',I8)
16903      CALL DPWRST('XXX','WRIT')
16904 9090 CONTINUE
16905C
16906      RETURN
16907      END
16908      SUBROUTINE DPMLGS(Y,X,N,NVAR,
16909     1                  TEMP1,TEMP2,TEMP3,DTEMP1,
16910     1                  THETMO,BETAMO,THETFR,BETAFR,THETML,BETAML,
16911     1                  ICAPSW,ICAPTY,IFORSW,MAXNXT,
16912     1                  ISUBRO,IBUGA3,IERROR)
16913C
16914C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
16915C              ESTIMATES FOR THE GENERALIZED LOGARITHMIC SERIES
16916C              DISTRIBUTION.
16917C
16918C              THE MOMENT ESTIMATE OF THETA IS THE SOLUTION
16919C              OF THE EQUATION:
16920C
16921C                 (1-THETA)*XBAR**3/ALPHA**2 -
16922C                 THETA**2*(s**2+XBAR**2) 0
16923C
16924C              WHERE ALPHA = 1/-LOG(1-THETA)
16925C
16926C                 BETA = (1/THETA) - ALPHA/XBAR
16927C
16928C              THE MEAN AND ONES FREQUENCY ESTIMATE OF THETA
16929C              IS THE SOLUTION OF THE EQUATION
16930C
16931C                 LOG(THETA) + ((1/THETA) -
16932C                 (1/XBAR)*(-1/LOG(1-THETA) - 1)*LOG(1-THETA) -
16933C                 LOG(-LOG(1-THETA)) - LOG(F1/N) = 0
16934C
16935C                 BETA = (1/THETA) - ALPHA/XBAR
16936C
16937C              THE MAXIMUM LIKELIHOOD ESTIMATES ARE THE SOLUTIONS
16938C              TO THE EQUATIONS:
16939C
16940C                 (N*XBAR/THETA) - (BETA-1)*N*XBAR/(1-THETA) +
16941C                 N/((1-THETA)*LOG(1-THETA)) = 0
16942C
16943C                 N*XBAR*LOG(1-THETA) +
16944C                 SUM[X=2 to K][SUM[i=1 to x-1][X*N(X)/(BETA*X-i)]]
16945C                 = 0
16946C
16947C              THERE ARE TWO CASES:
16948C
16949C              1) ONE VARIABLE CASE: Y IS RAW DATA
16950C              2) TWO VARIABLE CASE: Y IS FREQUENCY, X IS CLASS
16951C                 MID-POINT.
16952C
16953C     EXAMPLE--GENERALIZED LOGARITHMIC SERIES MAXIMUM LIKELIHOOD Y
16954C            --GENERALIZED LOGARITHMIC SERIES MAXIMUM LIKELIHOOD Y X
16955C     REFERENCES--CONSUL AND FAMOYE (2006), "LAGRANGIAN PROBABILITY
16956C                 DISTRIBUTIONS", BIRKHAUSER, CHAPTER 11.
16957C     WRITTEN BY--ALAN HECKERT
16958C                 STATISTICAL ENGINEERING DIVISION
16959C                 INFORMATION TECHNOLOGY LABORATORY
16960C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16961C                 GAITHERSBUG, MD 20899-8980
16962C                 PHONE--301-975-2899
16963C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
16964C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
16965C     LANGUAGE--ANSI FORTRAN (1977)
16966C     VERSION NUMBER--2006/6
16967C     ORIGINAL VERSION--LAGRANGE  2006.
16968C     UPDATED         --APRIL     2011. USE DPDTA1 TO PRINT THE OUTPUT
16969C
16970C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-----------------
16971C
16972      CHARACTER*4 ICAPSW
16973      CHARACTER*4 ICAPTY
16974      CHARACTER*4 IFORSW
16975      CHARACTER*4 ISUBRO
16976      CHARACTER*4 IBUGA3
16977      CHARACTER*4 IERROR
16978C
16979      CHARACTER*4 IWRITE
16980      CHARACTER*4 ISUBN1
16981      CHARACTER*4 ISUBN2
16982      CHARACTER*4 ISTEPN
16983      CHARACTER*4 IRELAT
16984      CHARACTER*4 IRHSTG
16985C
16986C-------------------------------------------------------------------
16987C
16988      DIMENSION Y(*)
16989      DIMENSION X(*)
16990      DIMENSION TEMP1(*)
16991      DIMENSION TEMP2(*)
16992      DIMENSION TEMP3(*)
16993      DOUBLE PRECISION DTEMP1(*)
16994C
16995      DOUBLE PRECISION TOL
16996      DOUBLE PRECISION XPAR(2)
16997      DOUBLE PRECISION FVEC(2)
16998C
16999      DOUBLE PRECISION AE
17000      DOUBLE PRECISION RE
17001      DOUBLE PRECISION XLOW
17002      DOUBLE PRECISION XUP
17003      DOUBLE PRECISION XMID
17004      DOUBLE PRECISION DALPHA
17005C
17006      DOUBLE PRECISION GLSFUN
17007      DOUBLE PRECISION GLSFU3
17008      EXTERNAL GLSFUN
17009      EXTERNAL GLSFU2
17010      EXTERNAL GLSFU3
17011      DOUBLE PRECISION XBAR
17012      DOUBLE PRECISION S2
17013      DOUBLE PRECISION F1FREQ
17014      COMMON/GLSCOM/XBAR,S2,F1FREQ,MAXRO2,NTOT2
17015C
17016      PARAMETER (MAXROW=30)
17017      CHARACTER*60 ITITLE
17018      CHARACTER*1  ITITLZ
17019      CHARACTER*40 IDIST
17020      CHARACTER*40 ITEXT(MAXROW)
17021      REAL         AVALUE(MAXROW)
17022      INTEGER      NCTEXT(MAXROW)
17023      INTEGER      IDIGIT(MAXROW)
17024      INTEGER      NTOT(MAXROW)
17025      LOGICAL      IFRST
17026      LOGICAL      ILAST
17027C
17028CCCCC PARAMETER(NUMCLI=3)
17029CCCCC PARAMETER(MAXLIN=2)
17030CCCCC CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
17031CCCCC INTEGER      NCTIT2(MAXLIN,NUMCLI)
17032CCCCC INTEGER      IWHTML(NUMALP)
17033CCCCC INTEGER      IWRTF(NUMALP)
17034CCCCC REAL         AMAT(MAXROW,NUMCLI)
17035C
17036C-------------------------------------------------------------------
17037C
17038      INCLUDE 'DPCOP2.INC'
17039C
17040C-----START POINT---------------------------------------------------
17041C
17042      ISUBN1='DPML'
17043      ISUBN2='GS  '
17044      IERROR='NO'
17045      IWRITE='OFF'
17046C
17047      THETMO=CPUMIN
17048      BETAMO=CPUMIN
17049      THETFR=CPUMIN
17050      BETAFR=CPUMIN
17051      THETML=CPUMIN
17052      BETAML=CPUMIN
17053C
17054      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGS')THEN
17055        WRITE(ICOUT,999)
17056  999   FORMAT(1X)
17057        CALL DPWRST('XXX','WRIT')
17058        WRITE(ICOUT,51)
17059   51   FORMAT('**** AT THE BEGINNING OF DPMLGS--')
17060        CALL DPWRST('XXX','WRIT')
17061        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR
17062   52   FORMAT('IBUGA3,ISUBRO,N,NVAR = ',2(A4,2X),2I8)
17063        CALL DPWRST('XXX','WRIT')
17064        IF(NVAR.EQ.1)THEN
17065          DO56I=1,MIN(N,100)
17066            WRITE(ICOUT,57)I,Y(I)
17067   57       FORMAT('I,Y(I) = ',I8,G15.7)
17068            CALL DPWRST('XXX','WRIT')
17069   56     CONTINUE
17070        ELSE
17071          DO61I=1,N
17072            WRITE(ICOUT,62)I,X(I),Y(I)
17073   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
17074            CALL DPWRST('XXX','WRIT')
17075   61     CONTINUE
17076        ENDIF
17077      ENDIF
17078C
17079C               ********************************************
17080C               **  STEP 11--                             **
17081C               **  1) ROUND DATA TO INTEGER VALUES       **
17082C               **  2) COMPUTE SUMMARY STATISTICS         **
17083C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
17084C               **     INSUFFICIENT SAMPLE SIZE           **
17085C               ********************************************
17086C
17087      ISTEPN='11'
17088      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLYU')
17089     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17090C
17091      IDIST='GENERALIZED LOST GAMES'
17092C
17093      NPERC=0
17094      MAXGRP=MAXNXT/2
17095      NMIN=2
17096      IF(NVAR.EQ.1)THEN
17097        DO1105I=1,N
17098          ITEMP=INT(Y(I)+0.5)
17099          Y(I)=REAL(ITEMP)
17100 1105   CONTINUE
17101        CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
17102        IF(IERROR.EQ.'YES')GOTO9000
17103C
17104        IFLAG=1
17105        CALL SUMRAW(Y,N,IDIST,IFLAG,
17106     1              XMEAN,XVAR,XSD,XMIN,XMAX,
17107     1              ISUBRO,IBUGA3,IERROR)
17108        IF(IERROR.EQ.'YES')GOTO9000
17109        NTOTZZ=N
17110C
17111C       NOW BIN THE DATA FOR USE BY THE ESTIMATION METHOD BELOW
17112C
17113        IRELAT='OFF'
17114        IRHSTG='OFF'
17115        XSTART=XMIN-0.5
17116        XSTOP=XMAX+0.5
17117        CLWID=1.0
17118        CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
17119     1              TEMP1,X,N2,IBUGA3,IERROR)
17120        ICNT=0
17121        DO1121I=1,N2
17122          Y(I)=TEMP1(I)
17123          ICNT=ICNT+1
17124          Y(ICNT)=Y(I)
17125          X(ICNT)=X(I)
171261121    CONTINUE
17127        N2=ICNT
17128      ELSE
17129        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
17130     1              ISUBRO,IBUGA3,IERROR)
17131        IF(IERROR.EQ.'YES')GOTO9000
17132        IFLAG1=1
17133        IFLAG2=1
17134        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
17135     1              TEMP1,TEMP2,TEMP3,MAXNXT,
17136     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
17137     1              ISUBRO,IBUGA3,IERROR)
17138        N2=N
17139      ENDIF
17140      IF(IERROR.EQ.'YES')GOTO9000
17141C
17142      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGS')THEN
17143        WRITE(ICOUT,999)
17144        CALL DPWRST('XXX','WRIT')
17145        WRITE(ICOUT,1311)
17146 1311   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
17147        CALL DPWRST('XXX','WRIT')
17148        WRITE(ICOUT,1312)XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ
17149 1312   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ = ',5G15.7,I10)
17150        CALL DPWRST('XXX','WRIT')
17151      ENDIF
17152C
17153C               *********************************************
17154C               **  STEP 21--                              **
17155C               **  CARRY OUT CALCULATIONS                 **
17156C               **  FOR GENERALIZED LOGARITHMIC SERIES MLE **
17157C               **  ESTIMATION                             **
17158C               *********************************************
17159C
17160      ISTEPN='21'
17161      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGS')
17162     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17163C
17164      F1=Y(1)/REAL(NTOTZZ)
17165      IINDX=MAXNXT/2
17166      IF(N2.LE.IINDX)THEN
17167        IML=0
17168        DO2210I=1,N2
17169          TEMP3(I)=Y(I)
17170          TEMP3(IINDX+I)=X(I)
17171 2210   CONTINUE
17172        IK=N2
17173      ELSE
17174        IML=1
17175      ENDIF
17176C
17177      AE=1.D-7
17178      RE=1.D-7
17179      XBAR=DBLE(XMEAN)
17180      S2=DBLE(XSD)**2
17181      XLOW=0.000001D0
17182      XUP=0.999999D0
17183      XMID=0.5D0
17184      CALL DFZERO(GLSFUN,XLOW,XUP,XMID,RE,AE,IFLAG)
17185      THETMO=REAL(XLOW)
17186      DALPHA=-1.0D0/DLOG(1.0D0 - THETMO)
17187      BETAMO=(1.0D0/THETMO) - DALPHA/XBAR
17188      IF(BETAMO.LE.1.0)BETAMO=1.0
17189C
17190      F1FREQ=DBLE(F1)
17191      NTOT2=NTOTZZ
17192      XLOW=0.000001D0
17193      XUP=0.999999D0
17194      XMID=DBLE(THETMO)
17195      CALL DFZERO(GLSFU3,XLOW,XUP,XMID,RE,AE,IFLAG)
17196      THETFR=REAL(XLOW)
17197      DALPHA=-1.0D0/DLOG(1.0D0 - THETFR)
17198      BETAFR=(1.0D0/THETFR) - DALPHA/XBAR
17199      IF(BETAFR.LE.1.0)BETAFR=1.0
17200C
17201      IF(IML.EQ.0)THEN
17202        IOPT=2
17203        TOL=1.0D-5
17204        NPAR=2
17205        NPRINT=-1
17206        INFO=0
17207        LWA=MAXNXT
17208        MAXRO2=MAXNXT
17209C
17210        XPAR(1)=DBLE(THETMO)
17211        XPAR(2)=DBLE(BETAMO)
17212        CALL DNSQE(GLSFU2,JAC,IOPT,NPAR,XPAR,FVEC,TOL,NPRINT,INFO,
17213     1             DTEMP1,LWA,TEMP3,IK)
17214C
17215        THETML=REAL(XPAR(1))
17216        BETAML=REAL(XPAR(2))
17217        IF(BETAML.LE.1.0)BETAML=1.0
17218      ENDIF
17219C
17220C               ***********************************************
17221C               **   STEP 42--                               **
17222C               **   WRITE OUT EVERYTHING                    **
17223C               **   FOR GENERALIZED LOGARITHMIC SERIES MLE  **
17224C               **   ESTIMATION                              **
17225C               ***********************************************
17226C
17227      ISTEPN='42'
17228      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNM')
17229     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17230C
17231C     PRINT SUMMARY STATISTICS TABLE
17232C
17233      NUMDIG=7
17234      IF(IFORSW.EQ.'1')NUMDIG=1
17235      IF(IFORSW.EQ.'2')NUMDIG=2
17236      IF(IFORSW.EQ.'3')NUMDIG=3
17237      IF(IFORSW.EQ.'4')NUMDIG=4
17238      IF(IFORSW.EQ.'5')NUMDIG=5
17239      IF(IFORSW.EQ.'6')NUMDIG=6
17240      IF(IFORSW.EQ.'7')NUMDIG=7
17241      IF(IFORSW.EQ.'8')NUMDIG=8
17242      IF(IFORSW.EQ.'9')NUMDIG=9
17243      IF(IFORSW.EQ.'0')NUMDIG=0
17244      IF(IFORSW.EQ.'E')NUMDIG=-2
17245      IF(IFORSW.EQ.'-2')NUMDIG=-2
17246      IF(IFORSW.EQ.'-3')NUMDIG=-3
17247      IF(IFORSW.EQ.'-4')NUMDIG=-4
17248      IF(IFORSW.EQ.'-5')NUMDIG=-5
17249      IF(IFORSW.EQ.'-6')NUMDIG=-6
17250      IF(IFORSW.EQ.'-7')NUMDIG=-7
17251      IF(IFORSW.EQ.'-8')NUMDIG=-8
17252      IF(IFORSW.EQ.'-9')NUMDIG=-9
17253C
17254      ITITLE='Generalized Logarithmic Series Parameter Estimation'
17255      NCTITL=51
17256      ITITLZ=' '
17257      NCTITZ=0
17258C
17259      ICNT=1
17260      ITEXT(ICNT)='Summary Statistics:'
17261      NCTEXT(ICNT)=19
17262      AVALUE(ICNT)=0.0
17263      IDIGIT(ICNT)=-1
17264      ICNT=ICNT+1
17265      ITEXT(ICNT)='Number of Observations:'
17266      NCTEXT(ICNT)=23
17267      AVALUE(ICNT)=REAL(NTOTZZ)
17268      IDIGIT(ICNT)=0
17269      ICNT=ICNT+1
17270      ITEXT(ICNT)='Sample Mean:'
17271      NCTEXT(ICNT)=12
17272      AVALUE(ICNT)=XMEAN
17273      IDIGIT(ICNT)=NUMDIG
17274      ICNT=ICNT+1
17275      ITEXT(ICNT)='Sample Standard Deviation:'
17276      NCTEXT(ICNT)=26
17277      AVALUE(ICNT)=XSD
17278      IDIGIT(ICNT)=NUMDIG
17279      ICNT=ICNT+1
17280      ITEXT(ICNT)='Sample Minimum:'
17281      NCTEXT(ICNT)=15
17282      AVALUE(ICNT)=XMIN
17283      IDIGIT(ICNT)=NUMDIG
17284      ICNT=ICNT+1
17285      ITEXT(ICNT)='Sample Maximum:'
17286      NCTEXT(ICNT)=15
17287      AVALUE(ICNT)=XMAX
17288      IDIGIT(ICNT)=NUMDIG
17289      ICNT=ICNT+1
17290      ITEXT(ICNT)='Sample First Frequency:'
17291      NCTEXT(ICNT)=23
17292      AVALUE(ICNT)=F1
17293      IDIGIT(ICNT)=NUMDIG
17294      ICNT=ICNT+1
17295      ITEXT(ICNT)=' '
17296      NCTEXT(ICNT)=0
17297      AVALUE(ICNT)=0.0
17298      IDIGIT(ICNT)=-1
17299C
17300      ICNT=ICNT+1
17301      ITEXT(ICNT)='Method of Moments:'
17302      NCTEXT(ICNT)=18
17303      AVALUE(ICNT)=0.0
17304      IDIGIT(ICNT)=-1
17305      ICNT=ICNT+1
17306      ITEXT(ICNT)='Estimate of Theta:'
17307      NCTEXT(ICNT)=18
17308      AVALUE(ICNT)=THETMO
17309      IDIGIT(ICNT)=NUMDIG
17310      ICNT=ICNT+1
17311      ITEXT(ICNT)='Estimate of Beta:'
17312      NCTEXT(ICNT)=17
17313      AVALUE(ICNT)=BETAMO
17314      IDIGIT(ICNT)=NUMDIG
17315      ICNT=ICNT+1
17316      ITEXT(ICNT)=' '
17317      NCTEXT(ICNT)=0
17318      AVALUE(ICNT)=0.0
17319      IDIGIT(ICNT)=-1
17320C
17321      ICNT=ICNT+1
17322      ITEXT(ICNT)='Method of First Frequency:'
17323      NCTEXT(ICNT)=26
17324      AVALUE(ICNT)=0.0
17325      IDIGIT(ICNT)=-1
17326      ICNT=ICNT+1
17327      ITEXT(ICNT)='Estimate of Theta:'
17328      NCTEXT(ICNT)=18
17329      AVALUE(ICNT)=THETFR
17330      IDIGIT(ICNT)=NUMDIG
17331      ICNT=ICNT+1
17332      ITEXT(ICNT)='Estimate of Beta:'
17333      NCTEXT(ICNT)=17
17334      AVALUE(ICNT)=BETAFR
17335      IDIGIT(ICNT)=NUMDIG
17336      ICNT=ICNT+1
17337      ITEXT(ICNT)=' '
17338      NCTEXT(ICNT)=0
17339      AVALUE(ICNT)=0.0
17340      IDIGIT(ICNT)=-1
17341C
17342      ICNT=ICNT+1
17343      ITEXT(ICNT)='Method of Maximum Likelihood:'
17344      NCTEXT(ICNT)=29
17345      AVALUE(ICNT)=0.0
17346      IDIGIT(ICNT)=-1
17347      ICNT=ICNT+1
17348      ITEXT(ICNT)='Estimate of Theta:'
17349      NCTEXT(ICNT)=18
17350      AVALUE(ICNT)=THETML
17351      IDIGIT(ICNT)=NUMDIG
17352      ICNT=ICNT+1
17353      ITEXT(ICNT)='Estimate of Beta:'
17354      NCTEXT(ICNT)=17
17355      AVALUE(ICNT)=BETAML
17356      IDIGIT(ICNT)=NUMDIG
17357      ICNT=ICNT+1
17358      ITEXT(ICNT)=' '
17359      NCTEXT(ICNT)=0
17360      AVALUE(ICNT)=0.0
17361      IDIGIT(ICNT)=-1
17362C
17363      NUMROW=ICNT
17364      DO2310I=1,NUMROW
17365        NTOT(I)=15
17366 2310 CONTINUE
17367C
17368      IFRST=.TRUE.
17369      ILAST=.TRUE.
17370      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
17371     1            AVALUE,IDIGIT,
17372     1            NTOT,NUMROW,
17373     1            ICAPSW,ICAPTY,ILAST,IFRST,
17374     1            ISUBRO,IBUGA3,IERROR)
17375C
17376C
17377C               *****************
17378C               **  STEP 90--  **
17379C               **  EXIT       **
17380C               *****************
17381C
17382 9000 CONTINUE
17383      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGS')THEN
17384        WRITE(ICOUT,999)
17385        CALL DPWRST('XXX','WRIT')
17386        WRITE(ICOUT,9011)
17387 9011   FORMAT('***** AT THE END       OF DPMLGS--')
17388        CALL DPWRST('XXX','WRIT')
17389        WRITE(ICOUT,9015)THETMO,BETAMO,THETFR,BETAFR,THETML,BETAML
17390 9015   FORMAT('THETMO,BETAMO,THETFR,BETAFR,THETML,BETAML = ',6G15.7)
17391        CALL DPWRST('XXX','WRIT')
17392      ENDIF
17393C
17394      RETURN
17395      END
17396      SUBROUTINE DPMLGV(Y,N,ICASPL,MAXNXT,MINMAX,
17397     1                  TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,
17398     1                  DTEMP1,XMOM,
17399     1                  QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
17400     1                  ALOCLM,SCALLM,SHAPLM,
17401     1                  ALOCEP,SCALEP,SHAPEP,
17402     1                  ALOCML,SCALML,SHAPML,
17403     1                  AICLM,BICLM,AICCLM,
17404     1                  AICEP,BICEP,AICCEP,
17405     1                  AICML,BICML,AICCML,
17406     1                  ICAPSW,ICAPTY,IFORSW,
17407     1                  IOUNI1,IOUNI2,ISEED,ALPHA,
17408     1                  MLFLAG,ISUBRO,IBUGA3,IERROR)
17409C
17410C     PURPOSE--THIS ROUTINE COMPUTES PARAMETER ESTIMATES FOR THE
17411C              GENERALIZED EXTREME VALUE DISTRIBUTION USING THE
17412C              FOLLOWING METHODS:
17413C
17414C              1) L-MOMENTS
17415C              2) ELEMENTAL PERCENTILES
17416C              3) MAXIMUM LIKELIHOOD
17417C
17418C                 NOTE: I AM HAVING PROBLEMS WITH HOSKINGS MAXIMUM
17419C                 LIKELIHOOD ROUTINE.  FOR NOW, BYPASS ML ESTIMATION.
17420C                 IF I GET THIS WORKING BETTER, THEN I WILL
17421C                 RE-ACTIVATE IT.
17422C
17423C     EXAMPLE--GENERALIZED EXTREME VALUE MAXIMUM LIKELIHOOD Y
17424C     REFERENCE--JOHNSON, KOTZ, AND BALAKRISHNAN.  "CONTINUOUS
17425C                UNIVARIATE DISTRIBUTIONS, VOLUME I", SECOND
17426C                EDITION, WILEY, 1994, PP. 614-619.
17427C              --HOSKING, ALGORITHM AS215   APPL. STATIST. (1985)
17428C                VOL. 34, NO. 3, Modifications in AS R76 (1989)
17429C                have been incorporated.
17430C              --CASTILLO, HADI, BALAKRISHNAN, SARABIA, "EXTREME
17431C                VALUE AND RELATED MODELS WITH APPLICATIONS IN
17432C                ENGINEERING AND SCIENCE", WILEY, 2005.
17433C     WRITTEN BY--JAMES J. FILLIBEN
17434C                 STATISTICAL ENGINEERING DIVISION
17435C                 INFORMATION TECHNOLOGY LABORATORY
17436C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17437C                 GAITHERSBUG, MD 20899-8980
17438C                 PHONE--301-975-2855
17439C     LANGUAGE--ANSI FORTRAN (1977)
17440C     VERSION NUMBER--2005/7
17441C     ORIGINAL VERSION--JULY      2005.
17442C     UPDATED         --JULY      2010. EXTRACT POINT ESTIMATES TO
17443C                                       GEVML1
17444C     UPDATED         --JULY      2010. USE DPDTA1 TO PRINT OUTPUT
17445C
17446C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
17447C
17448      CHARACTER*4 ICAPSW
17449      CHARACTER*4 ICAPTY
17450      CHARACTER*4 IFORSW
17451      CHARACTER*4 ISUBRO
17452      CHARACTER*4 IBUGA3
17453      CHARACTER*4 IERROR
17454C
17455      CHARACTER*4 IWRITE
17456      CHARACTER*4 ICASPL
17457      CHARACTER*4 IDFTZZ
17458C
17459      CHARACTER*4 ISUBN1
17460      CHARACTER*4 ISUBN2
17461      CHARACTER*4 ISTEPN
17462C
17463      LOGICAL MLFLAG
17464C
17465C---------------------------------------------------------------------
17466C
17467      DIMENSION Y(*)
17468      DIMENSION TEMP1(*)
17469      DIMENSION TEMP2(*)
17470      DIMENSION TEMP3(*)
17471      DIMENSION TEMP4(*)
17472      DIMENSION TEMP5(*)
17473      DOUBLE PRECISION DTEMP1(*)
17474      DOUBLE PRECISION XMOM(*)
17475C
17476      DIMENSION QP(*)
17477      DIMENSION XQPHAT(*)
17478      DIMENSION XQPSE(*)
17479      DIMENSION XQPLCL(*)
17480      DIMENSION XQPUCL(*)
17481C
17482      DOUBLE PRECISION VARCOV(6)
17483C
17484      INCLUDE 'DPCOST.INC'
17485C
17486      PARAMETER (MAXROW=40)
17487      CHARACTER*60 ITITLE
17488      CHARACTER*60 ITITLZ
17489      CHARACTER*40 ITEXT(MAXROW)
17490      REAL         AVALUE(MAXROW)
17491      INTEGER      NCTEXT(MAXROW)
17492      INTEGER      IDIGIT(MAXROW)
17493      INTEGER      NTOT(MAXROW)
17494      LOGICAL IFRST
17495      LOGICAL ILAST
17496C
17497C---------------------------------------------------------------------
17498C
17499      INCLUDE 'DPCOP2.INC'
17500C
17501C-----START POINT-----------------------------------------------------
17502C
17503      ISUBN1='DPML'
17504      ISUBN2='GV  '
17505      IERROR='NO'
17506C
17507      DO10I=1,10
17508        QP(I)=CPUMIN
17509        XQPHAT(I)=CPUMIN
17510        XQPLCL(I)=CPUMIN
17511        XQPUCL(I)=CPUMIN
17512        XQPSE(I)=CPUMIN
17513   10 CONTINUE
17514C
17515      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGV')THEN
17516        WRITE(ICOUT,999)
17517  999   FORMAT(1X)
17518        CALL DPWRST('XXX','WRIT')
17519        WRITE(ICOUT,51)
17520   51   FORMAT('**** AT THE BEGINNING OF DPMLGV--')
17521        CALL DPWRST('XXX','WRIT')
17522        WRITE(ICOUT,52)IBUGA3,N,IOUNI1,IOUNI2,ALPHA
17523   52   FORMAT('IBUGA3,N,IOUNI2,IOUNI2,ALPHA = ',A4,2X,3I4,F10.5)
17524        CALL DPWRST('XXX','WRIT')
17525        DO56I=1,MIN(N,100)
17526          WRITE(ICOUT,57)I,Y(I)
17527   57     FORMAT('I,Y(I) = ',I8,G15.7)
17528          CALL DPWRST('XXX','WRIT')
17529   56   CONTINUE
17530      ENDIF
17531C
17532C               ***************************************************
17533C               **  STEP 21--                                    **
17534C               **  CARRY OUT CALCULATIONS                       **
17535C               **  FOR GENERALIZED EXTREME VALUE MOMENT/MLE     **
17536C               **  ESTIMATION                                   **
17537C               ***************************************************
17538C
17539      ISTEPN='21'
17540      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGV')
17541     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17542C
17543      NMIN=3
17544      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
17545      IF(IERROR.EQ.'YES')GOTO9000
17546C
17547      IERROR='NO'
17548      IWRITE='OFF'
17549      IDFTZZ='ALL'
17550C
17551      MLFLAG=.TRUE.
17552      CALL GEVML1(Y,N,MAXNXT,MINMAX,ICASPL,MLFLAG,IGEPDF,
17553     1            ISEED,IDFTTY,IGEVML,
17554     1            TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,
17555     1            DTEMP1,XMOM,NMOM,VARCOV,
17556     1            XMEAN,XSD,XVAR,XMIN,XMAX,
17557     1            ALOCLM,SCALLM,SHAPLM,
17558     1            ALOCEP,SCALEP,SHAPEP,
17559     1            ALOCML,SCALML,SHAPML,
17560     1            ISUBRO,IBUGA3,IERROR)
17561C
17562      CALL GEVLI1(Y,N,MINMAX,
17563     1            ALOCLM,SCALLM,SHAPLM,
17564     1            ALIKLM,AICLM,AICCLM,BICLM,
17565     1            ISUBRO,IBUGA3,IERROR)
17566C
17567      CALL GEVLI1(Y,N,MINMAX,
17568     1            ALOCEP,SCALEP,SHAPEP,
17569     1            ALIKEP,AICEP,AICCEP,BICEP,
17570     1            ISUBRO,IBUGA3,IERROR)
17571C
17572      IF(MLFLAG .AND. SHAPML.NE.CPUMIN .AND. IGEVML.EQ.'ON')THEN
17573        CALL GEVLI1(Y,N,MINMAX,
17574     1              ALOCML,SCALML,SHAPML,
17575     1              ALIKML,AICML,AICCML,BICML,
17576     1              ISUBRO,IBUGA3,IERROR)
17577      ENDIF
17578C
17579C               ***********************************************
17580C               **   STEP 42--                               **
17581C               **   WRITE OUT EVERYTHING                    **
17582C               **   FOR GENERALIZED EXTREME VALUE           **
17583C               **   MLE ESTIMATION                          **
17584C               ***********************************************
17585C
17586      ISTEPN='42'
17587      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGV')
17588     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17589C
17590      IF(IPRINT.EQ.'OFF')GOTO9000
17591C
17592      NUMDIG=7
17593      IF(IFORSW.EQ.'1')NUMDIG=1
17594      IF(IFORSW.EQ.'2')NUMDIG=2
17595      IF(IFORSW.EQ.'3')NUMDIG=3
17596      IF(IFORSW.EQ.'4')NUMDIG=4
17597      IF(IFORSW.EQ.'5')NUMDIG=5
17598      IF(IFORSW.EQ.'6')NUMDIG=6
17599      IF(IFORSW.EQ.'7')NUMDIG=7
17600      IF(IFORSW.EQ.'8')NUMDIG=8
17601      IF(IFORSW.EQ.'9')NUMDIG=9
17602      IF(IFORSW.EQ.'0')NUMDIG=0
17603      IF(IFORSW.EQ.'E')NUMDIG=-2
17604      IF(IFORSW.EQ.'-2')NUMDIG=-2
17605      IF(IFORSW.EQ.'-3')NUMDIG=-3
17606      IF(IFORSW.EQ.'-4')NUMDIG=-4
17607      IF(IFORSW.EQ.'-5')NUMDIG=-5
17608      IF(IFORSW.EQ.'-6')NUMDIG=-6
17609      IF(IFORSW.EQ.'-7')NUMDIG=-7
17610      IF(IFORSW.EQ.'-8')NUMDIG=-8
17611      IF(IFORSW.EQ.'-9')NUMDIG=-9
17612C
17613      ITITLE='Generalized Extreme Value Parameter Estimation'
17614      NCTITL=46
17615      IF(MINMAX.EQ.1)THEN
17616        ITITLZ='(Minimum Case)'
17617        NCTITZ=14
17618      ELSE
17619        ITITLZ='(Maximum Case)'
17620        NCTITZ=14
17621      ENDIF
17622      ICNT=1
17623      ITEXT(ICNT)='Summary Statistics:'
17624      NCTEXT(ICNT)=19
17625      AVALUE(ICNT)=0.0
17626      IDIGIT(ICNT)=-1
17627      ICNT=ICNT+1
17628      ITEXT(ICNT)='Number of Observations:'
17629      NCTEXT(ICNT)=23
17630      AVALUE(ICNT)=REAL(N)
17631      IDIGIT(ICNT)=0
17632      ICNT=ICNT+1
17633      ITEXT(ICNT)='Sample Mean:'
17634      NCTEXT(ICNT)=12
17635      AVALUE(ICNT)=XMEAN
17636      IDIGIT(ICNT)=NUMDIG
17637      ICNT=ICNT+1
17638      ITEXT(ICNT)='Sample Standard Deviation:'
17639      NCTEXT(ICNT)=26
17640      AVALUE(ICNT)=XSD
17641      IDIGIT(ICNT)=NUMDIG
17642      ICNT=ICNT+1
17643      ITEXT(ICNT)='Sample Minimum:'
17644      NCTEXT(ICNT)=15
17645      AVALUE(ICNT)=XMIN
17646      IDIGIT(ICNT)=NUMDIG
17647      ICNT=ICNT+1
17648      ITEXT(ICNT)='Sample Maximum:'
17649      NCTEXT(ICNT)=15
17650      AVALUE(ICNT)=XMAX
17651      IDIGIT(ICNT)=NUMDIG
17652      ICNT=ICNT+1
17653      ITEXT(ICNT)=' '
17654      NCTEXT(ICNT)=0
17655      AVALUE(ICNT)=0.0
17656      IDIGIT(ICNT)=-1
17657C
17658      ICNT=ICNT+1
17659      ITEXT(ICNT)='First Sample L-Moment:'
17660      NCTEXT(ICNT)=22
17661      AVALUE(ICNT)=REAL(XMOM(1))
17662      IDIGIT(ICNT)=NUMDIG
17663      ICNT=ICNT+1
17664      ITEXT(ICNT)='Second Sample L-Moment:'
17665      NCTEXT(ICNT)=23
17666      AVALUE(ICNT)=REAL(XMOM(2))
17667      IDIGIT(ICNT)=NUMDIG
17668      ICNT=ICNT+1
17669      ITEXT(ICNT)='Third Sample L-Moment:'
17670      NCTEXT(ICNT)=22
17671      AVALUE(ICNT)=REAL(XMOM(3))
17672      IDIGIT(ICNT)=NUMDIG
17673      ICNT=ICNT+1
17674      ITEXT(ICNT)=' '
17675      NCTEXT(ICNT)=0
17676      AVALUE(ICNT)=0.0
17677      IDIGIT(ICNT)=-1
17678C
17679      ICNT=ICNT+1
17680      ITEXT(ICNT)='Method of L-Moments:'
17681      NCTEXT(ICNT)=20
17682      AVALUE(ICNT)=0.0
17683      IDIGIT(ICNT)=-1
17684      ICNT=ICNT+1
17685      ITEXT(ICNT)='Estimate of Location:'
17686      NCTEXT(ICNT)=22
17687      AVALUE(ICNT)=ALOCLM
17688      IDIGIT(ICNT)=NUMDIG
17689      ICNT=ICNT+1
17690      ITEXT(ICNT)='Estimate of Scale:'
17691      NCTEXT(ICNT)=18
17692      AVALUE(ICNT)=SCALLM
17693      IDIGIT(ICNT)=NUMDIG
17694      ICNT=ICNT+1
17695      ITEXT(ICNT)='Estimate of Shape (Gamma):'
17696      NCTEXT(ICNT)=26
17697      AVALUE(ICNT)=SHAPLM
17698      IDIGIT(ICNT)=NUMDIG
17699C
17700      IF(ALIKLM.NE.CPUMIN)THEN
17701        ICNT=ICNT+1
17702        ITEXT(ICNT)='Log-likelihood:'
17703        NCTEXT(ICNT)=15
17704        AVALUE(ICNT)=ALIKLM
17705        IDIGIT(ICNT)=-7
17706        ICNT=ICNT+1
17707        ITEXT(ICNT)='AIC:'
17708        NCTEXT(ICNT)=4
17709        AVALUE(ICNT)=AICLM
17710        IDIGIT(ICNT)=-7
17711        ICNT=ICNT+1
17712        ITEXT(ICNT)='AICc:'
17713        NCTEXT(ICNT)=5
17714        AVALUE(ICNT)=AICCLM
17715        IDIGIT(ICNT)=-7
17716        ICNT=ICNT+1
17717        ITEXT(ICNT)='BIC:'
17718        NCTEXT(ICNT)=4
17719        AVALUE(ICNT)=BICLM
17720        IDIGIT(ICNT)=-7
17721      ENDIF
17722      ICNT=ICNT+1
17723      ITEXT(ICNT)=' '
17724      NCTEXT(ICNT)=0
17725      AVALUE(ICNT)=0.0
17726      IDIGIT(ICNT)=-1
17727C
17728      ICNT=ICNT+1
17729      ITEXT(ICNT)='Method of Elemental Percentiles:'
17730      NCTEXT(ICNT)=32
17731      AVALUE(ICNT)=0.0
17732      IDIGIT(ICNT)=-1
17733      ICNT=ICNT+1
17734      ITEXT(ICNT)='Estimate of Location:'
17735      NCTEXT(ICNT)=22
17736      AVALUE(ICNT)=ALOCEP
17737      IDIGIT(ICNT)=NUMDIG
17738      ICNT=ICNT+1
17739      ITEXT(ICNT)='Estimate of Scale:'
17740      NCTEXT(ICNT)=18
17741      AVALUE(ICNT)=SCALEP
17742      IDIGIT(ICNT)=NUMDIG
17743      ICNT=ICNT+1
17744      ITEXT(ICNT)='Estimate of Shape (Gamma):'
17745      NCTEXT(ICNT)=26
17746      AVALUE(ICNT)=SHAPEP
17747      IDIGIT(ICNT)=NUMDIG
17748C
17749      IF(ALIKEP.NE.CPUMIN)THEN
17750        ICNT=ICNT+1
17751        ITEXT(ICNT)='Log-likelihood:'
17752        NCTEXT(ICNT)=15
17753        AVALUE(ICNT)=ALIKEP
17754        IDIGIT(ICNT)=-7
17755        ICNT=ICNT+1
17756        ITEXT(ICNT)='AIC:'
17757        NCTEXT(ICNT)=4
17758        AVALUE(ICNT)=AICEP
17759        IDIGIT(ICNT)=-7
17760        ICNT=ICNT+1
17761        ITEXT(ICNT)='AICc:'
17762        NCTEXT(ICNT)=5
17763        AVALUE(ICNT)=AICCEP
17764        IDIGIT(ICNT)=-7
17765        ICNT=ICNT+1
17766        ITEXT(ICNT)='BIC:'
17767        NCTEXT(ICNT)=4
17768        AVALUE(ICNT)=BICEP
17769        IDIGIT(ICNT)=-7
17770      ENDIF
17771      ICNT=ICNT+1
17772      ITEXT(ICNT)=' '
17773      NCTEXT(ICNT)=0
17774      AVALUE(ICNT)=0.0
17775      IDIGIT(ICNT)=-1
17776C
17777      IF(MLFLAG .AND. SHAPML.NE.CPUMIN)THEN
17778        ICNT=ICNT+1
17779        ITEXT(ICNT)='Maximum Likelihood:'
17780        NCTEXT(ICNT)=19
17781        AVALUE(ICNT)=0.0
17782        IDIGIT(ICNT)=-1
17783        ICNT=ICNT+1
17784        ITEXT(ICNT)='Estimate of Location:'
17785        NCTEXT(ICNT)=22
17786        AVALUE(ICNT)=ALOCML
17787        IDIGIT(ICNT)=NUMDIG
17788        ICNT=ICNT+1
17789        ITEXT(ICNT)='Estimate of Scale:'
17790        NCTEXT(ICNT)=18
17791        AVALUE(ICNT)=SCALML
17792        IDIGIT(ICNT)=NUMDIG
17793        ICNT=ICNT+1
17794        ITEXT(ICNT)='Estimate of Shape (Gamma):'
17795        NCTEXT(ICNT)=26
17796        AVALUE(ICNT)=SHAPML
17797        IDIGIT(ICNT)=NUMDIG
17798C
17799        IF(ALIKML.NE.CPUMIN)THEN
17800          ICNT=ICNT+1
17801          ITEXT(ICNT)='Log-likelihood:'
17802          NCTEXT(ICNT)=15
17803          AVALUE(ICNT)=ALIKML
17804          IDIGIT(ICNT)=-7
17805          ICNT=ICNT+1
17806          ITEXT(ICNT)='AIC:'
17807          NCTEXT(ICNT)=4
17808          AVALUE(ICNT)=AICML
17809          IDIGIT(ICNT)=-7
17810          ICNT=ICNT+1
17811          ITEXT(ICNT)='AICc:'
17812          NCTEXT(ICNT)=5
17813          AVALUE(ICNT)=AICCML
17814          IDIGIT(ICNT)=-7
17815        ENDIF
17816        ICNT=ICNT+1
17817        ITEXT(ICNT)='BIC:'
17818        NCTEXT(ICNT)=4
17819        AVALUE(ICNT)=BICML
17820        IDIGIT(ICNT)=-7
17821      ENDIF
17822C
17823      NUMROW=ICNT
17824      DO2320I=1,NUMROW
17825        NTOT(I)=15
17826 2320 CONTINUE
17827C
17828      IFRST=.FALSE.
17829      ILAST=.FALSE.
17830      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
17831     1            AVALUE,IDIGIT,
17832     1            NTOT,NUMROW,
17833     1            ICAPSW,ICAPTY,ILAST,IFRST,
17834     1            ISUBRO,IBUGA3,IERROR)
17835C
17836C               *****************
17837C               **  STEP 90--  **
17838C               **  EXIT       **
17839C               *****************
17840C
17841 9000 CONTINUE
17842      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGV')THEN
17843        WRITE(ICOUT,999)
17844        CALL DPWRST('XXX','WRIT')
17845        WRITE(ICOUT,9011)
17846 9011   FORMAT('***** AT THE END       OF DPMLGV--')
17847        CALL DPWRST('XXX','WRIT')
17848        WRITE(ICOUT,9012)N,IBUGA3,IERROR
17849 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
17850        CALL DPWRST('XXX','WRIT')
17851      ENDIF
17852C
17853      RETURN
17854      END
17855      SUBROUTINE DPMLGX(Y,N,
17856     1XTEMP,XTEMP2,XTEMP3,DTEMP1,MAXNXT,
17857     1SHAPSV,SCALSV,SHAPML,SCALML,
17858     1ICAPSW,ICAPTY,IFORSW,
17859     1ISUBRO,IBUGA3,IERROR)
17860C
17861C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
17862C              FOR THE GEOMETRIC EXTREME EXPONENTIAL DISTRIBUTION.
17863C              THE MAXIMUM LIKELIHOOD ESTIMATES ARE THE SOLUTION TO
17864C              THE FOLLOWING SIMULTANEOUS NONLINEAR EQUATIONS:
17865C              EQUATIONS.
17866C
17867C              N/G - 2*SUM[i=1 to N][EXP(-L*X(i)/(1-(1-G)*EXP(-L*X(i)))]
17868C
17869C              N/L - SUM[i=1 to n][X(i)] -
17870C                    2*SUM[i=1 to N][(1-G)*X(i)*EXP(-L*X(i))/
17871C                    (1 - (1-G)*EXP(-L*X(i)))]
17872C
17873C              WITH G AND L DENOTING THE SHAPE PARAMETER GAMMA AND
17874C              SCALE PARAMETER LAMBDA RESPECTIVELY.  NOTE THAT L
17875C              IS ACTUALLY (1/SCALE).
17876C
17877C     EXAMPLE--GEOMETRIC EXTREME EXPONENTIAL MAXIMUM LIKELIHOOD Y
17878C     REFERENCE--"CAN DATA RECOGNIZE ITS PARENT DISTRIBUTION?",
17879C                MARSHALL, MEZA, AND OLKIN, JOURNAL OF COMPUTATIONAL
17880C                AND GRAPHICAL STATISTICS, SEPTEMBER, 2001,
17881C                PP. 555-580.
17882C     WRITTEN BY--ALAN HECKERT
17883C                 STATISTICAL ENGINEERING DIVISION
17884C                 INFORMATION TECHNOLOGY LABORATORY
17885C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17886C                 GAITHERSBUG, MD 20899-8980
17887C                 PHONE--301-975-2899
17888C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
17889C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
17890C     LANGUAGE--ANSI FORTRAN (1977)
17891C     VERSION NUMBER--2004/3
17892C     ORIGINAL VERSION--MARCH     2004.
17893C     UPDATED         --AUGUST    2005. MODIFY OUTPUT OF FORMAT TO MAKE IT
17894C                                       MORE CONSISTENT WITH OTHER ML
17895C                                       ROUTINES
17896C     UPDATED         --FEBRUARY  2010. EXTRACT POINT ESTIMATES TO
17897C                                       GEEML1 TO MAKE IT CALLABLE
17898C                                       FROM MULTIPLE ROUTINES
17899C     UPDATED         --FEBRUARY  2010. PRINT TABLES WITH DPDTA1
17900C     UPDATED         --FEBRUARY  2010. CORRECT: LAMBDA ACTUALLY
17901C                                       (1/SCALE)
17902C
17903C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
17904C
17905      CHARACTER*4 ICAPSW
17906      CHARACTER*4 ICAPTY
17907      CHARACTER*4 IFORSW
17908      CHARACTER*4 ISUBRO
17909      CHARACTER*4 IBUGA3
17910      CHARACTER*4 IERROR
17911C
17912      CHARACTER*4 ISUBN1
17913      CHARACTER*4 ISUBN2
17914      CHARACTER*4 ISTEPN
17915C
17916C---------------------------------------------------------------------
17917C
17918      DIMENSION Y(*)
17919      DIMENSION XTEMP(*)
17920      DIMENSION XTEMP2(*)
17921      DIMENSION XTEMP3(*)
17922      DOUBLE PRECISION DTEMP1(*)
17923      DIMENSION QP(1)
17924C
17925      INCLUDE 'DPCOST.INC'
17926C
17927      PARAMETER (MAXROW=10)
17928      PARAMETER(NUMCLI=3)
17929      PARAMETER(MAXLIN=2)
17930      CHARACTER*60 ITITLE
17931      CHARACTER*60 ITITLZ
17932      CHARACTER*40 ITEXT(MAXROW)
17933      REAL         AVALUE(MAXROW)
17934      INTEGER      NCTEXT(MAXROW)
17935      INTEGER      IDIGIT(MAXROW)
17936      INTEGER      NTOT(MAXROW)
17937      LOGICAL IFRST
17938      LOGICAL ILAST
17939C
17940C---------------------------------------------------------------------
17941C
17942      INCLUDE 'DPCOP2.INC'
17943C
17944C-----START POINT-----------------------------------------------------
17945C
17946      ISUBN1='DPML'
17947      ISUBN2='GX  '
17948      IERROR='NO'
17949C
17950      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGX')THEN
17951        WRITE(ICOUT,999)
17952  999   FORMAT(1X)
17953        CALL DPWRST('XXX','WRIT')
17954        WRITE(ICOUT,51)
17955   51   FORMAT('**** AT THE BEGINNING OF DPMLGX--')
17956        CALL DPWRST('XXX','WRIT')
17957        WRITE(ICOUT,52)IBUGA3,ISUBRO,N
17958   52   FORMAT('IBUGA3,ISUBRO,N = ',A4,2X,A4,2X,I8)
17959        CALL DPWRST('XXX','WRIT')
17960        DO56I=1,MIN(N,100)
17961          WRITE(ICOUT,57)I,Y(I)
17962   57     FORMAT('I,Y(I) = ',I8,G15.7)
17963          CALL DPWRST('XXX','WRIT')
17964   56   CONTINUE
17965      ENDIF
17966C
17967C               ********************************************************
17968C               **  STEP 21--                                         **
17969C               **  CARRY OUT CALCULATIONS                            **
17970C               **  FOR GEOMETRIC EXTREME EXPONENTIAL MLE ESTIMATION  **
17971C               ********************************************************
17972C
17973      ISTEPN='21'
17974      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGX')
17975     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17976C
17977      NPERC=0
17978      NMIN=3
17979      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
17980      IF(IERROR.EQ.'YES')GOTO9000
17981C
17982      CALL GEEML1(Y,N,MAXNXT,
17983     1            XTEMP,XTEMP2,XTEMP3,DTEMP1,
17984     1            XMEAN,XSD,XVAR,XMIN,XMAX,
17985     1            SCALSV,SHAPSV,SCALML,SHAPML,
17986     1            ISUBRO,IBUGA3,IERROR)
17987C
17988C               ***********************************************
17989C               **   STEP 42--                               **
17990C               **   WRITE OUT EVERYTHING                    **
17991C               **   FOR GEOMETRIC   EXTREME EXPONENTIAL MLE **
17992C               **   ESTIMATION                              **
17993C               ***********************************************
17994C
17995      ISTEPN='42'
17996      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGX')
17997     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17998C
17999C     PRINT SUMMARY STATISTICS TABLE
18000C
18001      IF(IPRINT.EQ.'OFF')GOTO9000
18002C
18003      NUMDIG=7
18004      IF(IFORSW.EQ.'1')NUMDIG=1
18005      IF(IFORSW.EQ.'2')NUMDIG=2
18006      IF(IFORSW.EQ.'3')NUMDIG=3
18007      IF(IFORSW.EQ.'4')NUMDIG=4
18008      IF(IFORSW.EQ.'5')NUMDIG=5
18009      IF(IFORSW.EQ.'6')NUMDIG=6
18010      IF(IFORSW.EQ.'7')NUMDIG=7
18011      IF(IFORSW.EQ.'8')NUMDIG=8
18012      IF(IFORSW.EQ.'9')NUMDIG=9
18013      IF(IFORSW.EQ.'0')NUMDIG=0
18014      IF(IFORSW.EQ.'E')NUMDIG=-2
18015      IF(IFORSW.EQ.'-2')NUMDIG=-2
18016      IF(IFORSW.EQ.'-3')NUMDIG=-3
18017      IF(IFORSW.EQ.'-4')NUMDIG=-4
18018      IF(IFORSW.EQ.'-5')NUMDIG=-5
18019      IF(IFORSW.EQ.'-6')NUMDIG=-6
18020      IF(IFORSW.EQ.'-7')NUMDIG=-7
18021      IF(IFORSW.EQ.'-8')NUMDIG=-8
18022      IF(IFORSW.EQ.'-9')NUMDIG=-9
18023C
18024      ITITLE='Two-Parameter Geometric Extreme Exponential'
18025      NCTITL=43
18026      ITITLZ='Parameter Estimation: Full Sample Case'
18027      NCTITZ=38
18028      ITEXT(1)='Summary Statistics:'
18029      NCTEXT(1)=19
18030      AVALUE(1)=0.0
18031      IDIGIT(1)=0
18032      ITEXT(2)='Number of Observations:'
18033      NCTEXT(2)=23
18034      AVALUE(2)=REAL(N)
18035      IDIGIT(2)=0
18036      ITEXT(3)='Sample Mean:'
18037      NCTEXT(3)=12
18038      AVALUE(3)=XMEAN
18039      IDIGIT(3)=NUMDIG
18040      ITEXT(4)='Sample Standard Deviation:'
18041      NCTEXT(4)=26
18042      AVALUE(4)=XSD
18043      IDIGIT(4)=NUMDIG
18044      ITEXT(5)='Sample Minimum:'
18045      NCTEXT(5)=15
18046      AVALUE(5)=XMIN
18047      IDIGIT(5)=NUMDIG
18048      ITEXT(6)='Sample Maximum:'
18049      NCTEXT(6)=15
18050      AVALUE(6)=XMAX
18051      IDIGIT(6)=NUMDIG
18052      NUMROW=6
18053CCCCC DO2310I=1,NUMROW
18054CCCCC   NTOT(I)=15
18055C2310 CONTINUE
18056      NTOT(1:NUMROW)=15
18057      NTOT(2)=8
18058C
18059      IFRST=.TRUE.
18060      ILAST=.FALSE.
18061      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
18062     1            NCTEXT,AVALUE,IDIGIT,
18063     1            NTOT,NUMROW,
18064     1            ICAPSW,ICAPTY,ILAST,IFRST,
18065     1            ISUBRO,IBUGA3,IERROR)
18066      IFRST=.FALSE.
18067      ITITLE=' '
18068      NCTITL=0
18069C
18070      ITEXT(1)='Maximum Likelihood:'
18071      NCTEXT(1)=19
18072      AVALUE(1)=0.0
18073      IDIGIT(1)=-1
18074      ITEXT(2)='Estimate of Shape (Gamma):'
18075      NCTEXT(2)=26
18076      AVALUE(2)=SHAPML
18077      IDIGIT(2)=NUMDIG
18078      ITEXT(3)='Estimate of Scale:'
18079      NCTEXT(3)=18
18080      AVALUE(3)=SCALML
18081      IDIGIT(3)=NUMDIG
18082C
18083      ICNT=3
18084C
18085CCCCC ICNT=ICNT+1
18086CCCCC ITEXT(ICNT)='Log-likelihood:'
18087CCCCC NCTEXT(ICNT)=15
18088CCCCC AVALUE(ICNT)=ALIK
18089CCCCC IDIGIT(ICNT)=-7
18090CCCCC ICNT=ICNT+1
18091CCCCC ITEXT(ICNT)='AIC:'
18092CCCCC NCTEXT(ICNT)=4
18093CCCCC AVALUE(ICNT)=AIC
18094CCCCC IDIGIT(ICNT)=-7
18095CCCCC ICNT=ICNT+1
18096CCCCC ITEXT(ICNT)='AICc:'
18097CCCCC NCTEXT(ICNT)=5
18098CCCCC AVALUE(ICNT)=AICC
18099CCCCC IDIGIT(ICNT)=-7
18100CCCCC ICNT=ICNT+1
18101CCCCC ITEXT(ICNT)='BIC:'
18102CCCCC NCTEXT(ICNT)=4
18103CCCCC AVALUE(ICNT)=BIC
18104CCCCC IDIGIT(ICNT)=-7
18105C
18106      NUMROW=ICNT
18107      DO2320I=1,NUMROW
18108        NTOT(I)=15
18109 2320 CONTINUE
18110C
18111      IFRST=.FALSE.
18112      ILAST=.FALSE.
18113      ITITLZ=' '
18114      NCTITZ=0
18115      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
18116     1            AVALUE,IDIGIT,
18117     1            NTOT,NUMROW,
18118     1            ICAPSW,ICAPTY,ILAST,IFRST,
18119     1            ISUBRO,IBUGA3,IERROR)
18120C
18121C               *****************
18122C               **  STEP 90--  **
18123C               **  EXIT       **
18124C               *****************
18125C
18126 9000 CONTINUE
18127      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGX')THEN
18128        WRITE(ICOUT,999)
18129        CALL DPWRST('XXX','WRIT')
18130        WRITE(ICOUT,9011)
18131 9011   FORMAT('***** AT THE END       OF DPMLGX--')
18132        CALL DPWRST('XXX','WRIT')
18133        WRITE(ICOUT,9012)N,IBUGA3,IERROR
18134 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
18135        CALL DPWRST('XXX','WRIT')
18136        WRITE(ICOUT,9015)N
18137 9015   FORMAT('N = ',I8)
18138        CALL DPWRST('XXX','WRIT')
18139      ENDIF
18140C
18141      RETURN
18142      END
18143      SUBROUTINE DPMLGZ(Y,TAG,XLOW,XHIGH,N,NVAR,
18144     1                  Y2,X2,X3,N2,
18145     1                  TEMP1,TEMP2,TEMP3,DTEMP1,ITEMP9,MAXNXT,
18146     1                  CLLIMI,CLWIDT,
18147     1                  IHSTCW,MAXOBV,
18148     1                  IGOMDF,ICFLAG,ALPHAT,AK,
18149     1                  ICAPSW,ICAPTY,IFORSW,
18150     1                  ISUBRO,IBUGA3,IERROR)
18151C
18152C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
18153C              ESTIMATES FOR THE GOMPERTZ DISTRIBUTION.
18154C              IT USES THE ALGORITHM GIVEN IN THE GARG
18155C              ARTICLE.  THIS ALGORITHM IS GIVEN FOR GROUPED
18156C              DATA THAT MAY CONTAIN CENSORED DATA.  THE
18157C              ALGORITHM DOES NOT REQUIRE EQUAL SIZE BINS.
18158C              IF THE USER SPECIFIES UNBINNED DATA, THEN
18159C              BIN THE DATA FIRST.
18160C
18161C              THE MAXIMUM LIKELIHOOD ESTIMATES ARE:
18162C
18163C                  KHAT = D*ALPHAHAT/Q(ALPHAHAT)
18164C
18165C              WHERE ALPHAHAT IS THE SOLUTION OF THE EQUATION
18166C
18167C                  T + (D/ALPHA) - D*Q'(ALPHA)/Q(ALPHA) = 0
18168C
18169C                  N    = THE TOTAL NUMBER OF OBSERVATIONS
18170C                  d(i) = NUMBER OF FAILURE TIMES IN THE
18171C                         I-TH INTERVAL
18172C                  s(i) = NUMBER OF CENSORING TIMES IN I-TH
18173C                         INTERVAL
18174C                  t(i) = UPPER END POINT OF I-TH INTERVAL
18175C
18176C                  T    = SUM[i=1 to p][d(i)*tau(i)]
18177C                  D    = SUM[i=1 to p][d(i)]
18178C                  Q(ALPHA)  = SUM[i=1 to p]
18179C                              [s(i)*(EXP(ALPHA*t(i)) - 1) +
18180C                              d(i)*(EXP(ALPHA*t(i)) - 1)]
18181C
18182C     EXAMPLE--GOMPERTZ MLE Y
18183C            --GOMPERTZ MLE Y X
18184C            --GOMPERTZ MLE Y XLOW XHIGH
18185C            --GOMPERTZ CENSORED MLE Y CENS
18186C            --GOMPERTZ CENSORED MLE Y CENS X
18187C            --GOMPERTZ CENSORED MLE Y CENS XLOW XHIGH
18188C     REFERENCE--GARG, RAO, AND REDMOND (1970), "MAXIMUM LIKELIHOOD
18189C                ESTIMATION OF THE PARAMETERS OF THE GOMPERTZ
18190C                SURVIVAL FUNCTION", APPLIED STATISTICS,
18191C                PP. 152-159.
18192C     WRITTEN BY--ALAN HECKERT
18193C                 STATISTICAL ENGINEERING DIVISION
18194C                 INFORMATION TECHNOLOGY LABORATORY
18195C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
18196C                 GAITHERSBUG, MD 20899-8980
18197C                 PHONE--301-975-2899
18198C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
18199C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
18200C     LANGUAGE--ANSI FORTRAN (1977)
18201C     VERSION NUMBER--2007/1
18202C     ORIGINAL VERSION--JANUARY   2007.
18203C     UPDATED         --APRIL     2011. USE DPDTA1 TO PRINT OUTPUT
18204C
18205C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-----------------
18206C
18207      CHARACTER*4 ICAPSW
18208      CHARACTER*4 ICAPTY
18209      CHARACTER*4 IFORSW
18210      CHARACTER*4 IGOMDF
18211      CHARACTER*4 ICFLAG
18212      CHARACTER*4 ISUBRO
18213      CHARACTER*4 IBUGA3
18214      CHARACTER*4 IERROR
18215C
18216      CHARACTER*4 IWRITE
18217      CHARACTER*4 IHSTCW
18218      CHARACTER*4 IHSTO2
18219      CHARACTER*4 IRELAT
18220      CHARACTER*4 IRHSTG
18221      CHARACTER*4 ISUBN1
18222      CHARACTER*4 ISUBN2
18223      CHARACTER*4 ISTEPN
18224      CHARACTER*4 IOP
18225C
18226      CHARACTER*40 IDIST
18227      PARAMETER (MAXROW=25)
18228      CHARACTER*60 ITITLE
18229      CHARACTER*60 ITITLZ
18230      CHARACTER*40 ITEXT(MAXROW)
18231      REAL         AVALUE(MAXROW)
18232      INTEGER      NCTEXT(MAXROW)
18233      INTEGER      IDIGIT(MAXROW)
18234      INTEGER      NTOT(MAXROW)
18235      LOGICAL IFRST
18236      LOGICAL ILAST
18237C
18238C-------------------------------------------------------------------
18239C
18240      PARAMETER (KMAX=20)
18241      PARAMETER (MMAX=200)
18242C
18243      DIMENSION Y(*)
18244      DIMENSION TAG(*)
18245      DIMENSION XLOW(*)
18246      DIMENSION XHIGH(*)
18247      DIMENSION Y2(*)
18248      DIMENSION X2(*)
18249      DIMENSION X3(*)
18250      DIMENSION TEMP1(*)
18251      DIMENSION TEMP2(*)
18252      DIMENSION TEMP3(*)
18253      DIMENSION CLLIMI(*)
18254      DIMENSION CLWIDT(*)
18255C
18256      INTEGER ITEMP9(*)
18257      DOUBLE PRECISION DTEMP1(*)
18258C
18259CCCCC REAL TOL
18260C
18261      PARAMETER (NUMALP=8)
18262CCCCC DIMENSION ALPHA(NUMALP)
18263CCCCC DIMENSION ALOWSC(NUMALP)
18264CCCCC DIMENSION AUPPSC(NUMALP)
18265CCCCC DIMENSION ALOWGA(NUMALP)
18266CCCCC DIMENSION AUPPGA(NUMALP)
18267CCCCC DIMENSION ALOWS2(NUMALP)
18268CCCCC DIMENSION AUPPS2(NUMALP)
18269CCCCC DIMENSION ALOWG2(NUMALP)
18270CCCCC DIMENSION AUPPG2(NUMALP)
18271C
18272      DIMENSION FISH(2,2)
18273      DIMENSION COV(2,2)
18274C
18275      DOUBLE PRECISION GOMFUN
18276      EXTERNAL GOMFUN
18277      INTEGER NTOTZZ,NCLASS
18278      DOUBLE PRECISION D
18279      DOUBLE PRECISION T
18280      DOUBLE PRECISION DQ
18281      DOUBLE PRECISION DQP
18282      DOUBLE PRECISION DQPP
18283      COMMON/GOMCOM/D,T,DQ,DQP,DQPP,NTOTZZ,NCLASS
18284C
18285      DOUBLE PRECISION DAE
18286      DOUBLE PRECISION DRE
18287      DOUBLE PRECISION DSUM1
18288      DOUBLE PRECISION DSUM2
18289      DOUBLE PRECISION DXSTRT
18290      DOUBLE PRECISION DXLOW
18291      DOUBLE PRECISION DXUP
18292      DOUBLE PRECISION XLOWSV
18293      DOUBLE PRECISION XUPSV
18294C
18295C-------------------------------------------------------------------
18296C
18297      INCLUDE 'DPCOP2.INC'
18298C
18299CCCCC DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
18300C
18301C-----START POINT---------------------------------------------------
18302C
18303      ISUBN1='DPML'
18304      ISUBN2='GZ  '
18305      IWRITE='OFF'
18306      IERROR='NO'
18307C
18308      IR=0
18309C
18310      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGZ')THEN
18311        WRITE(ICOUT,999)
18312  999   FORMAT(1X)
18313        CALL DPWRST('XXX','WRIT')
18314        WRITE(ICOUT,51)
18315   51   FORMAT('**** AT THE BEGINNING OF DPMLGZ--')
18316        CALL DPWRST('XXX','WRIT')
18317        WRITE(ICOUT,55)N,NVAR,IGOMDF,ICFLAG,IBUGA3,ISUBRO
18318   55   FORMAT('N,NVAR,IGOMDF,ICFLAG,IBUGA3,ISUBRO = ',
18319     1         2I8,2X,3(A4,2X),A4)
18320        CALL DPWRST('XXX','WRIT')
18321        DO56I=1,N
18322          WRITE(ICOUT,57)I,Y(I),TAG(I),XLOW(I),XHIGH(I)
18323   57     FORMAT('I,Y(I),TAG(I),XLOW(I),XHIGH(I) = ',I8,4G15.7)
18324          CALL DPWRST('XXX','WRIT')
18325   56   CONTINUE
18326      ENDIF
18327C
18328C               ********************************************
18329C               **  STEP 11--                             **
18330C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
18331C               ********************************************
18332C
18333      ISTEPN='11'
18334      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGZ')
18335     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18336C
18337C     NOTE: THERE ARE 6 POSSIBLE CASES.
18338C
18339C            I. NO CENSORING
18340C               1. UNBINNED DATA
18341C               2. GROUPED DATA, BIN MID-POINTS PROVIDED
18342C               3. GROUPED DATA, BIN LOWER/UPPER LIMITS
18343C                  PROVIDED (I.E., UNEQUAL SIZE BINS)
18344C           II. CENSORING
18345C               1. UNBINNED DATA
18346C               2. GROUPED DATA, BIN MID-POINTS PROVIDED
18347C               3. GROUPED DATA, BIN LOWER/UPPER LIMITS
18348C                  PROVIDED (I.E., UNEQUAL SIZE BINS)
18349C
18350      NPERC=0
18351      MAXGRP=MAXNXT/2
18352      NMIN=3
18353C
18354      IF(ICFLAG.EQ.'OFF')THEN
18355        IF(NVAR.EQ.1)THEN
18356          CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
18357          IF(IERROR.EQ.'YES')GOTO9000
18358          IFLAG=1
18359          CALL SUMRAW(Y,N,IDIST,IFLAG,
18360     1                XMEAN,XVAR,XSD,XMIN,XMAX,
18361     1                ISUBRO,IBUGA3,IERROR)
18362          NTOTZZ=N
18363          IF(IERROR.EQ.'YES')GOTO9000
18364          IRELAT='OFF'
18365          IRHSTG='PERC'
18366          CLWID=CLWIDT(1)
18367          IHSTO2='ON'
18368          CALL DPBIN(Y,N,IRELAT,CLWID,CLLIMI(1),CLLIMI(2),IRHSTG,
18369     1               TEMP1,MAXOBV,IHSTCW,IHSTO2,
18370     1               Y2,X2,N2,IBUGA3,IERROR)
18371C
18372        ELSEIF(NVAR.EQ.2)THEN
18373          CALL CKDIS2(Y,XLOW,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOT2,
18374     1                ISUBRO,IBUGA3,IERROR)
18375          IF(IERROR.EQ.'YES')GOTO9000
18376          IFLAG1=1
18377          IFLAG2=1
18378          CALL SUMGRP(Y,XLOW,N,IDIST,IFLAG1,IFLAG2,
18379     1                TEMP1,TEMP2,TEMP3,MAXNXT,
18380     1                XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
18381     1                ISUBRO,IBUGA3,IERROR)
18382          IF(IERROR.EQ.'YES')GOTO9000
18383C
18384        ELSEIF(NVAR.EQ.3)THEN
18385          CALL CKDIS3(Y,XLOW,XHIGH,
18386     1                TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOT2,
18387     1                ISUBRO,IBUGA3,IERROR)
18388          IF(IERROR.EQ.'YES')GOTO9000
18389          IFLAG1=1
18390          IFLAG2=1
18391          CALL SUMGR2(Y,XLOW,XHIGH,N,IDIST,IFLAG1,IFLAG2,
18392     1                TEMP1,TEMP2,TEMP3,MAXNXT,
18393     1                XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
18394     1                ISUBRO,IBUGA3,IERROR)
18395          IF(IERROR.EQ.'YES')GOTO9000
18396C
18397        ELSE
18398          WRITE(ICOUT,999)
18399          CALL DPWRST('XXX','WRIT')
18400          WRITE(ICOUT,111)
18401          CALL DPWRST('XXX','WRIT')
18402          WRITE(ICOUT,390)
18403  390     FORMAT('      FOR THE UNCENSORED CASE, MORE THAN ',
18404     1           'THREE VARIABLES WERE SPECIFIED.')
18405          CALL DPWRST('XXX','WRIT')
18406          IERROR='YES'
18407          GOTO9000
18408        ENDIF
18409C
18410        IF(N2.LT.2 .OR. N2.GT.25000)THEN
18411          WRITE(ICOUT,999)
18412          CALL DPWRST('XXX','WRIT')
18413          WRITE(ICOUT,111)
18414  111     FORMAT('***** ERROR IN GOMPERTZ MAXIMUM LIKELIHOOD--')
18415          CALL DPWRST('XXX','WRIT')
18416          WRITE(ICOUT,171)
18417  171     FORMAT('      AFTER BINNING, THE NUMBER OF CLASSES ',
18418     1           'IS GREATER THAN 25,000')
18419          CALL DPWRST('XXX','WRIT')
18420          WRITE(ICOUT,173)
18421 173      FORMAT('      OR LESS THAN 2.')
18422          CALL DPWRST('XXX','WRIT')
18423          IERROR='YES'
18424          GOTO9000
18425        ENDIF
18426C
18427        DSUM1=0.0D0
18428        DSUM2=0.0D0
18429        DELTA=(X2(2) - X2(1))/2.0
18430        DO330I=1,N2
18431          DTEMP1(I)=DBLE(Y2(I))
18432          DTEMP1(I+25000)=0.0D0
18433          IF(NVAR.EQ.3)THEN
18434            DTEMP1(I+50000)=DBLE(X2(I))
18435            DTEMP1(I+75000)=DBLE(X3(I))
18436          ELSE
18437            DTEMP1(I+50000)=DBLE(X2(I)-DELTA)
18438            DTEMP1(I+75000)=DBLE(X3(I)+DELTA)
18439          ENDIF
18440          DSUM1=DSUM1 + DBLE(Y2(I))
18441          TAU=(X3(I) + X2(I))/2.0
18442          DSUM2=DSUM2 + DBLE(Y2(I)*TAU)
18443  330   CONTINUE
18444        D=DSUM1
18445        T=DSUM2
18446C
18447C     NOW DO THE CENSORED CASES
18448C
18449      ELSE
18450        IF(NVAR.EQ.2)THEN
18451C
18452          CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
18453          IF(IERROR.EQ.'YES')GOTO9000
18454          CALL CKCENS(TAG,TEMP1,N,IDIST,ISUBRO,IBUGA3,IERROR)
18455          IF(IERROR.EQ.'YES')GOTO9000
18456          IFLAG=0
18457          CALL SUMRAW(Y,N,IDIST,IFLAG,
18458     1                XMEAN,XVAR,XSD,XMIN,XMAX,
18459     1                ISUBRO,IBUGA3,IERROR)
18460          NTOTZZ=N
18461C
18462          CALL SORTC(Y,TAG,N,Y,TAG)
18463          IR=0
18464          DO460I=1,N
18465            IF(TAG(I).EQ.1.0)IR=IR+1
18466  460     CONTINUE
18467          IM=N-IR
18468C
18469C         BIN BASED ON FULL DATA SET.
18470C
18471          IRELAT='OFF'
18472          IRHSTG='PERC'
18473          CLWID=CLWIDT(1)
18474          IHSTO2='ON'
18475          CALL DPBIN(Y,N,IRELAT,CLWID,CLLIMI(1),CLLIMI(2),IRHSTG,
18476     1               TEMP1,MAXOBV,IHSTCW,IHSTO2,
18477     1               Y2,X2,N2,IBUGA3,IERROR)
18478C
18479          IF(N2.LT.2 .OR. N2.GT.25000)THEN
18480            WRITE(ICOUT,999)
18481            CALL DPWRST('XXX','WRIT')
18482            WRITE(ICOUT,111)
18483            CALL DPWRST('XXX','WRIT')
18484            WRITE(ICOUT,471)
18485  471       FORMAT('      AFTER BINNING, THE NUMBER OF CLASSES ',
18486     1             'IS GREATER THAN 25,000')
18487            CALL DPWRST('XXX','WRIT')
18488            WRITE(ICOUT,473)
18489  473       FORMAT('      OR LESS THAN 2.')
18490            CALL DPWRST('XXX','WRIT')
18491            IERROR='YES'
18492            GOTO9000
18493          ENDIF
18494C
18495          DSUM1=0.0D0
18496          DSUM2=0.0D0
18497          DELTA=(X2(2) - X2(1))/2.0
18498          DO480I=1,N2
18499            XLOWLM=X2(I) - DELTA
18500            XHIGHLM=X2(I) + DELTA
18501            ITEMP1=0
18502            ITEMP2=0
18503            DO485J=1,N
18504              IF(Y(J).GE.XLOWLM .AND. Y(J).LT.XHIGHLM)THEN
18505                IF(TAG(J).EQ.1.0)THEN
18506                  ITEMP1=ITEMP1+1
18507                ELSE
18508                  ITEMP2=ITEMP2+1
18509                ENDIF
18510              ENDIF
18511  485       CONTINUE
18512            DTEMP1(I)=DBLE(ITEMP1)
18513            DTEMP1(I+25000)=DBLE(ITEMP2)
18514            DTEMP1(I+50000)=DBLE(X2(I)-DELTA)
18515            DTEMP1(I+75000)=DBLE(X2(I)+DELTA)
18516            DSUM1=DSUM1 + DBLE(Y2(I))
18517            DSUM2=DSUM2 + DBLE(Y2(I)*X2(I))
18518  480     CONTINUE
18519          D=DSUM1
18520          T=DSUM2
18521C
18522        ELSEIF(NVAR.EQ.3)THEN
18523          CALL CKDIS2(Y,XLOW,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOT2,
18524     1                ISUBRO,IBUGA3,IERROR)
18525          IF(IERROR.EQ.'YES')GOTO9000
18526C
18527          DO510I=1,N
18528            IF(TAG(I).LT.0.0)THEN
18529              WRITE(ICOUT,999)
18530              CALL DPWRST('XXX','WRIT')
18531              WRITE(ICOUT,111)
18532              CALL DPWRST('XXX','WRIT')
18533              WRITE(ICOUT,518)I,TAG(I)
18534  518         FORMAT('      THE CENSORING FREQUENCY FOR CLASS ',I8,
18535     1               'IS NEGATIVE (',G15.7,').')
18536              CALL DPWRST('XXX','WRIT')
18537              IERROR='YES'
18538              GOTO9000
18539            ENDIF
18540  510     CONTINUE
18541C
18542          IFLAG1=1
18543          IFLAG2=1
18544          CALL SUMGRP(Y,XLOW,N,IDIST,IFLAG1,IFLAG2,
18545     1                TEMP1,TEMP2,TEMP3,MAXNXT,
18546     1                XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
18547     1                ISUBRO,IBUGA3,IERROR)
18548          IF(IERROR.EQ.'YES')GOTO9000
18549C
18550          N2=N
18551          DELTA=(X2(2) - X2(1))/2.0
18552          DSUM1=0.0D0
18553          DSUM2=0.0D0
18554          IR=0
18555          DO530I=1,N2
18556            DTEMP1(I)=DBLE(Y(I))
18557            DTEMP1(I+25000)=DBLE(TAG(I))
18558            IR=IR + INT(TAG(I)+0.5)
18559            DTEMP1(I+50000)=DBLE(XLOW(I)-DELTA)
18560            DTEMP1(I+75000)=DBLE(XLOW(I)+DELTA)
18561            DSUM1=DSUM1 + DBLE(Y(I))
18562            DSUM2=DSUM2 + DBLE(Y(I)*XLOW(I))
18563  530     CONTINUE
18564          D=DSUM1
18565          T=DSUM2
18566C
18567        ELSEIF(NVAR.EQ.4)THEN
18568          CALL CKDIS3(Y,XLOW,XHIGH,
18569     1                TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOT2,
18570     1                ISUBRO,IBUGA3,IERROR)
18571          IF(IERROR.EQ.'YES')GOTO9000
18572C
18573          DO610I=1,N
18574            IF(TAG(I).LT.0.0)THEN
18575              WRITE(ICOUT,999)
18576              CALL DPWRST('XXX','WRIT')
18577              WRITE(ICOUT,111)
18578              CALL DPWRST('XXX','WRIT')
18579              WRITE(ICOUT,518)I,TAG(I)
18580              CALL DPWRST('XXX','WRIT')
18581              IERROR='YES'
18582              GOTO9000
18583            ENDIF
18584  610     CONTINUE
18585C
18586          IFLAG1=1
18587          IFLAG2=1
18588          CALL SUMGR2(Y,XLOW,XHIGH,N,IDIST,IFLAG1,IFLAG2,
18589     1                TEMP1,TEMP2,TEMP3,MAXNXT,
18590     1                XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
18591     1                ISUBRO,IBUGA3,IERROR)
18592          IF(IERROR.EQ.'YES')GOTO9000
18593C
18594C
18595          N2=N
18596          DSUM1=0.0D0
18597          DSUM2=0.0D0
18598          IR=0
18599          DO630I=1,N2
18600            DTEMP1(I)=DBLE(Y(I))
18601            DTEMP1(I+25000)=DBLE(TAG(I))
18602            IR=IR + INT(TAG(I)+0.5)
18603            DTEMP1(I+50000)=DBLE(XLOW(I))
18604            DTEMP1(I+75000)=DBLE(XHIGH(I))
18605            DSUM1=DSUM1 + DBLE(Y(I))
18606            TAU=(XHIGH(I) + XLOW(I))/2.0
18607            DSUM2=DSUM2 + DBLE(Y2(I)*TAU)
18608  630     CONTINUE
18609          D=DSUM1
18610          T=DSUM2
18611C
18612        ELSE
18613          WRITE(ICOUT,999)
18614          CALL DPWRST('XXX','WRIT')
18615          WRITE(ICOUT,111)
18616          CALL DPWRST('XXX','WRIT')
18617          WRITE(ICOUT,690)
18618  690     FORMAT('      FOR THE CENSORED CASE, MORE THAN ',
18619     1           'FOUR VARIABLES WERE SPECIFIED.')
18620          CALL DPWRST('XXX','WRIT')
18621          IERROR='YES'
18622          GOTO9000
18623        ENDIF
18624      ENDIF
18625C
18626      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGZ')THEN
18627        WRITE(ICOUT,999)
18628        CALL DPWRST('XXX','WRIT')
18629        WRITE(ICOUT,901)N,N2
18630  901   FORMAT('N,N2 = ',2I10)
18631        CALL DPWRST('XXX','WRIT')
18632        DO910I=1,N2
18633          WRITE(ICOUT,911)I,DTEMP1(I),DTEMP1(I+25000),
18634     1                    DTEMP1(I+50000),DTEMP1(I+75000)
18635  911     FORMAT('I,DTEMP1(I),DTEMP1(I+25000),DTEMP1(I+50000),',
18636     1           'DTEMP1(I+75000)= ',I8,4G15.7)
18637          CALL DPWRST('XXX','WRIT')
18638  910   CONTINUE
18639      ENDIF
18640C
18641C               *****************************************
18642C               **  STEP 21--                          **
18643C               **  CARRY OUT CALCULATIONS             **
18644C               **  FOR GOMPERTZ MLE ESTIMATION        **
18645C               *****************************************
18646C
18647      ISTEPN='21'
18648      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGZ')
18649     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18650C
18651      NCLASS=N2
18652      DXSTRT=0.5D0
18653      DXLOW=0.1D0
18654      DXUP=1.0D0
18655      DAE=2.0*0.000001D0*DXSTRT
18656      DRE=DAE
18657      IFLAG=0
18658      ITBRAC=0
18659 2105 CONTINUE
18660      XLOWSV=DXLOW
18661      XUPSV=DXUP
18662      CALL DFZER2(GOMFUN,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP1)
18663C
18664      IF(IFLAG.EQ.4 .AND. ITBRAC.LE.100)THEN
18665        DXLOW=XLOWSV/2.0D0
18666        DXUP=2.0D0*XUPSV
18667        ITBRAC=ITBRAC+1
18668        GOTO2105
18669      ENDIF
18670C
18671      ALPHAT=REAL(DXLOW)
18672      AK=REAL(D*DXLOW/DQ)
18673C
18674      FISH(1,1)=-REAL(DBLE(-2.0*AK/ALPHAT**3)*DQ +
18675     1          DBLE(2.0*AK/ALPHAT**2)*DQP - DBLE(AK/ALPHAT)*DQPP)
18676      FISH(2,2)=-REAL(-D/DBLE(AK**2))
18677      FISH(1,2)=-REAL(DQ/DBLE(ALPHAT**2) - DQP/DBLE(ALPHAT))
18678      FISH(2,1)=FISH(1,2)
18679C
18680C  NOW COMPUTE THE FISHER INFORMATION MATRIX, THEN INVERT TO
18681C  OBTAIN THE ASYMPTOTIC VARIANCE-COVARIANCE MATRIX.
18682C
18683      CALL SGECO(FISH,2,2,ITEMP9,RCOND,TEMP1)
18684      IJOB=1
18685      CALL SGEDI(FISH,2,2,ITEMP9,TEMP1,TEMP1(MAXNXT/2),IJOB)
18686      DO2810J=1,2
18687        DO2815I=1,2
18688          COV(I,J)=FISH(I,J)
18689 2815   CONTINUE
18690 2810 CONTINUE
18691C
18692C
18693      IF(IFLAG.EQ.2)THEN
18694C
18695C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
18696CCCCC   WRITE(ICOUT,999)
18697CCCCC   CALL DPWRST('XXX','BUG ')
18698CCCCC   WRITE(ICOUT,2111)
18699C2111   FORMAT('***** WARNING FROM GOMPERTZ MAXIMUM ',
18700CCCCC1         'LIKELIHOOD--')
18701CCCCC   CALL DPWRST('XXX','BUG ')
18702CCCCC   WRITE(ICOUT,2113)
18703C2113   FORMAT('      ESTIMATE OF SIGMA MAY NOT BE COMPUTED TO ',
18704CCCCC1         'DESIRED TOLERANCE.')
18705CCCCC   CALL DPWRST('XXX','BUG ')
18706      ELSEIF(IFLAG.EQ.3)THEN
18707        WRITE(ICOUT,999)
18708        CALL DPWRST('XXX','BUG ')
18709        WRITE(ICOUT,2121)
18710 2121   FORMAT('***** WARNING FROM GOMPERTZ MAXIMUM LIKELIHOOD--')
18711        CALL DPWRST('XXX','BUG ')
18712        WRITE(ICOUT,2123)
18713 2123   FORMAT('      ESTIMATE OF COMPERTZ MAY BE NEAR A SINGULAR ',
18714     1         'POINT.')
18715        CALL DPWRST('XXX','BUG ')
18716      ELSEIF(IFLAG.EQ.4)THEN
18717        WRITE(ICOUT,999)
18718        CALL DPWRST('XXX','BUG ')
18719        WRITE(ICOUT,111)
18720        CALL DPWRST('XXX','BUG ')
18721        WRITE(ICOUT,2133)
18722 2133   FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
18723        CALL DPWRST('XXX','BUG ')
18724      ELSEIF(IFLAG.EQ.5)THEN
18725        WRITE(ICOUT,999)
18726        CALL DPWRST('XXX','BUG ')
18727        WRITE(ICOUT,2121)
18728        CALL DPWRST('XXX','BUG ')
18729        WRITE(ICOUT,2143)
18730 2143   FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
18731        CALL DPWRST('XXX','BUG ')
18732      ENDIF
18733C
18734      IOP='OPEN'
18735      IFLAG1=1
18736      IFLAG2=0
18737      IFLAG3=0
18738      IFLAG4=0
18739      IFLAG5=0
18740      CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
18741     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
18742     1            IBUGA3,ISUBRO,IERROR)
18743      IF(IERROR.EQ.'YES')GOTO9000
18744C
18745CCCCC DO2300I=1,NCOMP
18746CCCCC   WRITE(IOUNI1,2301)ALPHA(I),XMEAN(I),XSD(I)
18747C2300 CONTINUE
18748C2301 FORMAT(3(E15.7,1X))
18749C
18750      IOP='CLOS'
18751      CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
18752     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
18753     1            IBUGA3,ISUBRO,IERROR)
18754      IF(IERROR.EQ.'YES')GOTO9000
18755C
18756C               ***********************************************
18757C               **   STEP 42--                               **
18758C               **   WRITE OUT EVERYTHING                    **
18759C               **   FOR GOMPERTZ MLE ESTIMATION             **
18760C               ***********************************************
18761C
18762      ISTEPN='42'
18763      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGZ')
18764     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18765C
18766C     PRINT SUMMARY STATISTICS TABLE
18767C
18768      IF(IPRINT.EQ.'OFF')GOTO9000
18769C
18770      NUMDIG=7
18771      IF(IFORSW.EQ.'1')NUMDIG=1
18772      IF(IFORSW.EQ.'2')NUMDIG=2
18773      IF(IFORSW.EQ.'3')NUMDIG=3
18774      IF(IFORSW.EQ.'4')NUMDIG=4
18775      IF(IFORSW.EQ.'5')NUMDIG=5
18776      IF(IFORSW.EQ.'6')NUMDIG=6
18777      IF(IFORSW.EQ.'7')NUMDIG=7
18778      IF(IFORSW.EQ.'8')NUMDIG=8
18779      IF(IFORSW.EQ.'9')NUMDIG=9
18780      IF(IFORSW.EQ.'0')NUMDIG=0
18781      IF(IFORSW.EQ.'E')NUMDIG=-2
18782      IF(IFORSW.EQ.'-2')NUMDIG=-2
18783      IF(IFORSW.EQ.'-3')NUMDIG=-3
18784      IF(IFORSW.EQ.'-4')NUMDIG=-4
18785      IF(IFORSW.EQ.'-5')NUMDIG=-5
18786      IF(IFORSW.EQ.'-6')NUMDIG=-6
18787      IF(IFORSW.EQ.'-7')NUMDIG=-7
18788      IF(IFORSW.EQ.'-8')NUMDIG=-8
18789      IF(IFORSW.EQ.'-9')NUMDIG=-9
18790C
18791      IF(ICFLAG.EQ.'OFF')THEN
18792        ITITLE='Gompertz Parameter Estimation'
18793        NCTITL=29
18794        ICNT=1
18795        ITEXT(ICNT)='Summary Statistics:'
18796        NCTEXT(ICNT)=19
18797        AVALUE(ICNT)=0.0
18798        IDIGIT(ICNT)=0
18799        ICNT=ICNT+1
18800        ITEXT(ICNT)='Number of Observations:'
18801        NCTEXT(ICNT)=23
18802        AVALUE(ICNT)=REAL(NTOTZZ)
18803        IDIGIT(ICNT)=0
18804        ICNT=ICNT+1
18805        ITEXT(ICNT)='Sample Mean:'
18806        NCTEXT(ICNT)=12
18807        AVALUE(ICNT)=XMEAN
18808        IDIGIT(ICNT)=NUMDIG
18809        ICNT=ICNT+1
18810        ITEXT(ICNT)='Sample Standard Deviation:'
18811        NCTEXT(ICNT)=26
18812        AVALUE(ICNT)=XSD
18813        IDIGIT(ICNT)=NUMDIG
18814        ICNT=ICNT+1
18815        ITEXT(ICNT)='Sample Minimum:'
18816        NCTEXT(ICNT)=15
18817        AVALUE(ICNT)=XMIN
18818        IDIGIT(ICNT)=NUMDIG
18819        ICNT=ICNT+1
18820        ITEXT(ICNT)='Sample Minimum:'
18821        NCTEXT(ICNT)=15
18822        AVALUE(ICNT)=XMAX
18823        IDIGIT(ICNT)=NUMDIG
18824      ELSE
18825        ITITLE='Gompertz Parameter Estimation: Censoring Case'
18826        NCTITL=45
18827        ICNT=1
18828        ITEXT(ICNT)='Summary Statistics:'
18829        NCTEXT(ICNT)=19
18830        AVALUE(ICNT)=0.0
18831        IDIGIT(ICNT)=0
18832        ICNT=ICNT+1
18833        ITEXT(ICNT)='Number of Uncensored Observations:'
18834        NCTEXT(ICNT)=34
18835        AVALUE(ICNT)=REAL(NTOTZZ-IR)
18836        IDIGIT(ICNT)=0
18837        ICNT=ICNT+1
18838        ITEXT(ICNT)='Number of Censored Observations:'
18839        NCTEXT(ICNT)=32
18840        AVALUE(ICNT)=REAL(IR)
18841        IDIGIT(ICNT)=0
18842        ICNT=ICNT+1
18843        ITEXT(ICNT)='Sample Mean:'
18844        NCTEXT(ICNT)=12
18845        AVALUE(ICNT)=XMEAN
18846        IDIGIT(ICNT)=NUMDIG
18847        ICNT=ICNT+1
18848        ITEXT(ICNT)='Sample Standard Deviation:'
18849        NCTEXT(ICNT)=26
18850        AVALUE(ICNT)=XSD
18851        IDIGIT(ICNT)=NUMDIG
18852        ICNT=ICNT+1
18853        ITEXT(ICNT)='Sample Minimum:'
18854        NCTEXT(ICNT)=15
18855        AVALUE(ICNT)=XMIN
18856        IDIGIT(ICNT)=NUMDIG
18857        ICNT=ICNT+1
18858        ITEXT(ICNT)='Sample Minimum:'
18859        NCTEXT(ICNT)=15
18860        AVALUE(ICNT)=XMAX
18861        IDIGIT(ICNT)=NUMDIG
18862      ENDIF
18863      ICNT=ICNT+1
18864      ITEXT(ICNT)=' '
18865      NCTEXT(ICNT)=0
18866      AVALUE(ICNT)=0.0
18867      IDIGIT(ICNT)=-1
18868C
18869      ICNT=ICNT+1
18870      ITEXT(ICNT)='Maximum Likelihood:'
18871      NCTEXT(ICNT)=19
18872      AVALUE(ICNT)=0.0
18873      IDIGIT(ICNT)=-1
18874      ICNT=ICNT+1
18875      ITEXT(ICNT)='Estimate of Alpha:'
18876      NCTEXT(ICNT)=18
18877      AVALUE(ICNT)=ALPHAT
18878      IDIGIT(ICNT)=NUMDIG
18879      ICNT=ICNT+1
18880      ITEXT(ICNT)='Estimate of K:'
18881      NCTEXT(ICNT)=14
18882      AVALUE(ICNT)=AK
18883      IDIGIT(ICNT)=NUMDIG
18884      ICNT=ICNT+1
18885      ITEXT(ICNT)='Standard Error of Alpha:'
18886      NCTEXT(ICNT)=24
18887      AVALUE(ICNT)=SQRT(COV(1,1))
18888      IDIGIT(ICNT)=NUMDIG
18889      ICNT=ICNT+1
18890      ITEXT(ICNT)='Standard Error of K:'
18891      NCTEXT(ICNT)=20
18892      AVALUE(ICNT)=SQRT(COV(2,2))
18893      IDIGIT(ICNT)=NUMDIG
18894      ICNT=ICNT+1
18895      ITEXT(ICNT)='Covariance of Alpha and K:'
18896      NCTEXT(ICNT)=26
18897      AVALUE(ICNT)=COV(1,2)
18898      IDIGIT(ICNT)=NUMDIG
18899CCCCC ICNT=ICNT+1
18900CCCCC ITEXT(ICNT)='Log-likelihood:'
18901CCCCC NCTEXT(ICNT)=15
18902CCCCC AVALUE(ICNT)=ALIK
18903CCCCC IDIGIT(ICNT)=NUMDIG
18904CCCCC ICNT=ICNT+1
18905CCCCC ITEXT(ICNT)='AIC:'
18906CCCCC NCTEXT(ICNT)=4
18907CCCCC AVALUE(ICNT)=AIC
18908CCCCC IDIGIT(ICNT)=NUMDIG
18909CCCCC ICNT=ICNT+1
18910CCCCC ITEXT(ICNT)='AICc:'
18911CCCCC NCTEXT(ICNT)=5
18912CCCCC AVALUE(ICNT)=AICC
18913CCCCC IDIGIT(ICNT)=NUMDIG
18914CCCCC ICNT=ICNT+1
18915CCCCC ITEXT(ICNT)='BIC:'
18916CCCCC NCTEXT(ICNT)=4
18917CCCCC AVALUE(ICNT)=BIC
18918CCCCC IDIGIT(ICNT)=NUMDIG
18919      NUMROW=ICNT
18920      DO2320I=1,NUMROW
18921        NTOT(I)=15
18922 2320 CONTINUE
18923C
18924      IFRST=.TRUE.
18925      ILAST=.TRUE.
18926      NCTITZ=0
18927      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
18928     1            AVALUE,IDIGIT,
18929     1            NTOT,NUMROW,
18930     1            ICAPSW,ICAPTY,ILAST,IFRST,
18931     1            ISUBRO,IBUGA3,IERROR)
18932C
18933C               *****************
18934C               **  STEP 90--  **
18935C               **  EXIT       **
18936C               *****************
18937C
18938 9000 CONTINUE
18939      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGZ')THEN
18940        WRITE(ICOUT,999)
18941        CALL DPWRST('XXX','WRIT')
18942        WRITE(ICOUT,9011)
18943 9011   FORMAT('***** AT THE END       OF DPMLGZ--')
18944        CALL DPWRST('XXX','WRIT')
18945        WRITE(ICOUT,9012)IERROR
18946 9012   FORMAT('IERROR = ',A4)
18947        CALL DPWRST('XXX','WRIT')
18948      ENDIF
18949C
18950      RETURN
18951      END
18952      SUBROUTINE DPMLHE(Y,X,N,NVAR,
18953     1                  TEMP1,TEMP2,TEMP3,ITEMP1,MAXNXT,
18954     1                  ALPHMO,BETAMO,ALPHML,BETAML,
18955     1                  ALPHEP,BETAEP,ALPHZF,BETAZF,
18956     1                  ICAPSW,ICAPTY,IFORSW,
18957     1                  ISUBRO,IBUGA3,IERROR)
18958C
18959C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
18960C              ESTIMATES AND METHOD OF MOMENT ESTIMATES FOR
18961C              THE HERMITE DISTRIBUTION.  FOUR METHODS OF ESTIMATION
18962C              ARE COMPUTED.
18963C
18964C              1. THE METHOD OF MOMENT ESTIMATES ARE THE SOLUTIONS
18965C                 TO THE EQUATIONS:
18966C                    ALPHA*(ALPHA+BETA)   - XMEAN = 0
18967C                    ALPHA*(2*ALPHA+BETA) - XVARI = 0
18968C                 WITH XMEAN AND XVARI DENOTING THE SAMPLE MEAN AND
18969C                 VARIANCE RESPECTIVELY.  AFTER SOME ALGEBRA, THIS
18970C                 CAN BE SOLVED AS:
18971C
18972C                    ALPHAHAT = SQRT(XVAR - XBAR)
18973C                    BETAHAT  = (XVAR/ALPHAHAT) - 2*ALPHAHAT
18974C
18975C              2. THE MAXIMUM LIKELIHOOD EQUATIONS ARE:
18976C                    SUM[n=0 to k][f(n)*{(n/ALPHA) - (ALPHA + BETA)}]
18977C                       = 0
18978C                    SUM[n=0 to k][f(n)*ALPHA*{(p(n-1)/p(n) - 1}] = 0
18979C                 WITH f(n) DENOTING THE SAMPLE FREQUENCIES FOR
18980C                 N = 0, 1, 2, ..., K   (K = MAXIMUM OBSERVED VALUE)
18981C                 AND P(n) = HERPDF.
18982C
18983C              3. THE EVEN POINT ESTIMATORS ARE
18984C
18985C                    AHAT=-0.5*LOG(2*SE/N - 1)
18986C                    BHAT=0.5*(XBAR - AHAT)
18987C
18988C                 WHERE
18989C
18990C                    XBAR = SAMPLE MEAN
18991C                    SE = SUM OF OBSEVED FREQUENCES AT X = 0, 2, ...
18992C                    ALPHAHAT = SQRT(2*BHAT)
18993C                    BETAHAT = AHAT/SQRT(2*BHAT)
18994C
18995C              4. THE ZEROTH FREQUENCY AND THE MEAN ESTIMATORS ARE
18996C
18997C                    AHAT = -(XBAR + 2*LOG(N0/N))
18998C                    BHAT = XBAR + LOG(N0/N)
18999C
19000C              DETAILS OF MAXIMIM LIKELIHOOD ESTIMATION ARE GIVEN
19001C              IN "SOME PROPERTIES OF THE HERMITE DISTRIBUTION",
19002C              KEMP AND KEMP, BIOMETRIKA (1965), 52, 3 and 4,
19003C              P. 381.  THE OTHER METHODS ARE DESCRIBED IN
19004C              "EVEN POINT ESTIMATION AND MOMENT ESTIMATION IN
19005C              HERMITE DISTRIBUTIONS", Y. C. PATEL, BIOMETRICS,
19006C              32, DECEMBER, 1976, PP. 865-873.  THE PATEL
19007C              ARTICLE ALSO GIVES THE VARIANCES AND COVARIANCES
19008C              FOR EACH OF THESE METHODS.
19009C     EXAMPLE--HERMITE MAXIMUM LIKELIHOOD Y
19010C     REFERENCE--"UNIVARIATE DISCRETE DISTRIBUTIONS", SECOND EDITION,
19011C                JOHNSON, KOTZ, AND KEMP, WILEY, PP. 202.
19012C              --"SOME PROPERTIES OF THE HERMITE DISTRIBUTION",
19013C                KEMP AND KEMP, BIOMETRIKA (1965), 52, 3 and 4,
19014C                P. 381.
19015C              --"EVEN POINT ESTIMATION AND MOMENT ESTIMATION IN
19016C                HERMITE DISTRIBUTIONS", Y. C. PATEL, BIOMETRICS,
19017C                32, DECEMBER, 1976, PP. 865-873.
19018C     WRITTEN BY--ALAN HECKERT
19019C                 STATISTICAL ENGINEERING DIVISION
19020C                 INFORMATION TECHNOLOGY LABORATORY
19021C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
19022C                 GAITHERSBURG, MD 20899-8980
19023C                 PHONE--301-975-2899
19024C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
19025C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
19026C     LANGUAGE--ANSI FORTRAN (1977)
19027C     VERSION NUMBER--2004/4
19028C     ORIGINAL VERSION--APRIL     2004.
19029C     UPDATED         --APRIL     2011. USE DPDTA1 AND DPDTA5 TO PRINT
19030C                                       OUTPUT
19031C
19032C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
19033C
19034      CHARACTER*4 ICAPSW
19035      CHARACTER*4 ICAPTY
19036      CHARACTER*4 IFORSW
19037      CHARACTER*4 ISUBRO
19038      CHARACTER*4 IBUGA3
19039      CHARACTER*4 IERROR
19040C
19041      CHARACTER*4 IWRITE
19042      CHARACTER*4 IRELAT
19043      CHARACTER*4 IRHSTG
19044C
19045      CHARACTER*4 ISUBN1
19046      CHARACTER*4 ISUBN2
19047      CHARACTER*4 ISTEPN
19048C
19049      REAL IAA
19050      REAL IAB
19051      REAL IBB
19052      REAL MOMCOV
19053      REAL MLCOV
19054      DOUBLE PRECISION DSUM1
19055      DOUBLE PRECISION DSUM2
19056      DOUBLE PRECISION DSUM3
19057      DOUBLE PRECISION DSE
19058C
19059      PARAMETER (MAXROW=50)
19060      CHARACTER*60 ITITLE
19061      CHARACTER*1  ITITLZ
19062      CHARACTER*40 IDIST
19063      CHARACTER*40 ITEXT(MAXROW)
19064      REAL         AVALUE(MAXROW)
19065      INTEGER      NCTEXT(MAXROW)
19066      INTEGER      IDIGIT(MAXROW)
19067      INTEGER      NTOT(MAXROW)
19068      LOGICAL      IFRST
19069      LOGICAL      ILAST
19070C
19071C---------------------------------------------------------------------
19072C
19073      DIMENSION Y(*)
19074      DIMENSION X(*)
19075      DIMENSION TEMP1(*)
19076      DIMENSION TEMP2(*)
19077      DIMENSION TEMP3(*)
19078      DIMENSION ITEMP1(*)
19079C
19080      REAL AMLCOV(2,2)
19081C
19082C---------------------------------------------------------------------
19083C
19084      INCLUDE 'DPCOP2.INC'
19085C
19086C-----START POINT-----------------------------------------------------
19087C
19088      ISUBN1='DPML'
19089      ISUBN2='HE  '
19090      IERROR='NO'
19091      IWRITE='OFF'
19092C
19093      IFLAG1=0
19094      IFLAG2=0
19095      IFLAG3=0
19096      IFLAG4=0
19097C
19098      MOMCOV=CPUMIN
19099      BMOVAR=CPUMIN
19100      AMOVAR=CPUMIN
19101      DSO=DBLE(CPUMIN)
19102      DSE=DBLE(CPUMIN)
19103C
19104      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLHE')THEN
19105        WRITE(ICOUT,999)
19106  999   FORMAT(1X)
19107        CALL DPWRST('XXX','WRIT')
19108        WRITE(ICOUT,51)
19109   51   FORMAT('**** AT THE BEGINNING OF DPMLHE--')
19110        CALL DPWRST('XXX','WRIT')
19111        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR
19112   52   FORMAT('IBUGA3,ISUBRO,N,NVAR = ',2(A4,2X),2I8)
19113        CALL DPWRST('XXX','WRIT')
19114        IF(NVAR.EQ.1)THEN
19115          DO56I=1,MIN(N,100)
19116            WRITE(ICOUT,57)I,Y(I)
19117   57       FORMAT('I,Y(I) = ',I8,G15.7)
19118            CALL DPWRST('XXX','WRIT')
19119   56     CONTINUE
19120        ELSE
19121          DO61I=1,N
19122            WRITE(ICOUT,62)I,X(I),Y(I)
19123   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
19124            CALL DPWRST('XXX','WRIT')
19125   61     CONTINUE
19126        ENDIF
19127       ENDIF
19128C
19129C               ********************************************
19130C               **  STEP 11--                             **
19131C               **  1) ROUND DATA TO INTEGER VALUES       **
19132C               **  2) COMPUTE SUMMARY STATISTICS         **
19133C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
19134C               **     INSUFFICIENT SAMPLE SIZE           **
19135C               ********************************************
19136C
19137      ISTEPN='11'
19138      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLHE')
19139     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19140C
19141      IDIST='HERMITE'
19142C
19143      NPERC=0
19144      MAXGRP=MAXNXT/2
19145      NMIN=2
19146      IF(NVAR.EQ.1)THEN
19147        DSE=0.0D0
19148        DSO=0.0D0
19149        DO1105I=1,N
19150          ITEMP=INT(Y(I)+0.5)
19151          Y(I)=REAL(ITEMP)
19152          IF(MOD(ITEMP,2).EQ.0)THEN
19153            DSE=DSE + 1.0D0
19154          ELSE
19155            DSO=DSO + 1.0D0
19156          ENDIF
19157 1105   CONTINUE
19158        CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
19159        IF(IERROR.EQ.'YES')GOTO9000
19160C
19161        IFLAG=1
19162        CALL SUMRAW(Y,N,IDIST,IFLAG,
19163     1              XMEAN,XVAR,XSD,XMIN,XMAX,
19164     1              ISUBRO,IBUGA3,IERROR)
19165        IF(IERROR.EQ.'YES')GOTO9000
19166        NTOTZZ=N
19167C
19168C       NOW BIN THE DATA FOR USE BY THE ESTIMATION METHOD BELOW
19169C
19170        IRELAT='OFF'
19171        IRHSTG='OFF'
19172        XSTART=XMIN-0.5
19173        XSTOP=XMAX+0.5
19174        CLWID=1.0
19175        CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
19176     1              TEMP1,X,N2,IBUGA3,IERROR)
19177        ICNT=0
19178        DO1121I=1,N2
19179          Y(I)=TEMP1(I)
19180          ICNT=ICNT+1
19181          Y(ICNT)=Y(I)
19182          X(ICNT)=X(I)
191831121    CONTINUE
19184        N2=ICNT
19185      ELSE
19186        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
19187     1              ISUBRO,IBUGA3,IERROR)
19188        IF(IERROR.EQ.'YES')GOTO9000
19189        IFLAG1=1
19190        IFLAG2=1
19191        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
19192     1              TEMP1,TEMP2,TEMP3,MAXNXT,
19193     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
19194     1              ISUBRO,IBUGA3,IERROR)
19195        N2=N
19196      ENDIF
19197      IF(IERROR.EQ.'YES')GOTO9000
19198C
19199      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLHE')THEN
19200        WRITE(ICOUT,999)
19201        CALL DPWRST('XXX','WRIT')
19202        WRITE(ICOUT,1311)
19203 1311   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
19204        CALL DPWRST('XXX','WRIT')
19205        WRITE(ICOUT,1312)XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ
19206 1312   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ = ',5G15.7,I10)
19207        CALL DPWRST('XXX','WRIT')
19208      ENDIF
19209C
19210C               *********************************************
19211C               **  STEP 21--                              **
19212C               **  CARRY OUT CALCULATIONS FOR HERMITE     **
19213C               **  PARAMETER ESTIMATION (4 METHODS)       **
19214C               *********************************************
19215C
19216C     HERMITE ONLY APPROPRIATE IF MEAN < VARIANCE
19217C
19218      TEMP=XVAR - XMEAN
19219      IF(TEMP.LE.0.0)THEN
19220        WRITE(ICOUT,999)
19221        CALL DPWRST('XXX','WRIT')
19222        WRITE(ICOUT,2121)
19223 2121   FORMAT('***** ERROR FROM HERMITE MAXIMUM LIKELIHOOD ',
19224     1         'ESTIMATION--')
19225        CALL DPWRST('XXX','WRIT')
19226        WRITE(ICOUT,2123)
19227 2123   FORMAT('      MEAN IS GREATER THAN VARIANCE.  MOMENT AND ')
19228        CALL DPWRST('XXX','WRIT')
19229        WRITE(ICOUT,2125)
19230 2125   FORMAT('      MAXIMUM LIKELIHOOD ESTIMATES DO NOT EXIST.')
19231        CALL DPWRST('XXX','WRIT')
19232        WRITE(ICOUT,2127)
19233 2127   FORMAT('      HERMITE DISTRIBUTION NOT APPROPRIATE FOR ',
19234     1         'THESE DATA.')
19235        CALL DPWRST('XXX','WRIT')
19236        WRITE(ICOUT,2129)XMEAN,XVAR
19237 2129   FORMAT('      MEAN = ',F14.7,' AND VARIANCE = ',F14.7)
19238        CALL DPWRST('XXX','WRIT')
19239        IERROR='YES'
19240        GOTO9000
19241      ENDIF
19242C
19243      ALPHMO=SQRT(XVAR - XMEAN)
19244      BETAMO=(XVAR/ALPHMO) - 2.0*ALPHMO
19245      IF(BETAMO.LE.0.0)IFLAG1=1
19246      IF(IFLAG1.EQ.0)THEN
19247        AHAT=ALPHMO*BETAMO
19248        BHAT=ALPHMO**2/2.0
19249        AN=REAL(NTOTZZ)
19250        TERM1=(1.0/AN)*(AHAT + 2.0*(AHAT + 4.0*BHAT)**2)
19251        TERM2=(1.0/AN**2)*(2.0*AHAT - 2.0*(AHAT + 4.0*BHAT)**2)
19252        TERM3=(1.0/AN**3)*(AHAT + 16.0*BHAT)
19253        AMOVAR=TERM1 + TERM2 + TERM3
19254        TERM1=(1.0/AN)*(BHAT + 0.5*(AHAT + 4.0*BHAT)**2)
19255        TERM2=(1.0/AN**2)*(-4.0*BHAT - 0.5*(AHAT + 4.0*BHAT)**2)
19256        TERM3=(1.0/AN**3)*(0.25*AHAT + 4.0*BHAT)
19257        BMOVAR=TERM1 + TERM2 + TERM3
19258        TERM1=(1.0/AN)*(-1.0*(AHAT + 4.0*BHAT)**2)
19259        TERM2=(1.0/AN**2)*(-0.5*AHAT + 4.0*BHAT + (AHAT+4.0*BHAT)**2)
19260        TERM3=(1.0/AN**3)*(-0.5*AHAT - 8.0*BHAT)
19261        MOMCOV=TERM1 + TERM2 + TERM3
19262      ENDIF
19263C
19264C  EVEN POINT ESTIMATOR
19265C
19266C  NOTE: FORMULAS FOR VARIANCES, COVARIANCE IN PATEL ARTICLE
19267C        SEEM TO BE INCORRECT (I.E., PLUGGING AHAT AND BHAT INTO
19268C        HIS FORMULAS DOES NOT GIVE ANYTHING CLOSE TO HIS PRINTED
19269C        RESULTS, I SUSPECT EXP(4*A) TERM IS NOT ACCURATE).
19270C
19271      IF(NVAR.EQ.1 .AND. DSE.GT.DSO)THEN
19272        AHAT=REAL(-0.5D0*DLOG(2.0D0*DSE/DBLE(N) - 1.0D0))
19273        BHAT=0.5*(XMEAN - AHAT)
19274        ALPHEP=SQRT(2.0*BHAT)
19275        BETAEP=AHAT/SQRT(2.0*BHAT)
19276CCCCC   AEPVAR=0.25*(EXP(4.0*AHAT) - 1.0)
19277CCCCC   BEPVAR=(1.0/16.0)*(EXP(4.0*AHAT) - 1.0 - 4.0*AHAT + 16.0*BHAT)
19278CCCCC   EPCOV=(1.0/8.0)*(4.0*AHAT - EXP(4.0*AHAT) + 1.0)
19279      ELSE
19280        IFLAG2=1
19281      ENDIF
19282C
19283C  ZERO FREQUENCY AND MEAN ESTIMATOR
19284C
19285      DO2160I=1,N2
19286        IF(X(I).EQ.XMIN)THEN
19287          AN0=Y(I)
19288          GOTO2169
19289        ENDIF
19290 2160 CONTINUE
19291      IFLAG3=1
19292 2169 CONTINUE
19293C
19294      IF(IFLAG3.EQ.0)THEN
19295        AN=REAL(NTOTZZ)
19296        ALOWLM=-LOG(AN0/AN)
19297        AUPPLM=-2.0*LOG(AN0/AN)
19298        IF(XMEAN.GE.ALOWLM .AND. XMEAN.LE.AUPPLM)THEN
19299          ATEMP=LOG(AN0/AN)
19300          AHAT=-(XMEAN + 2.0*ATEMP)
19301          BHAT=XMEAN + ATEMP
19302          ALPHZF=SQRT(2.0*BHAT)
19303          BETAZF=AHAT/SQRT(2.0*BHAT)
19304          Z=EXP(AHAT+BHAT)
19305          AZFVAR=(1.0/AN)*(4.0*Z - 3.0*AHAT - 4.0*BHAT - 4.0)
19306          BZFVAR=(1.0/AN)*(Z - AHAT - 1.0)
19307          ZFCOV=(2.0/AN)*(Z - AHAT - BHAT - 1.0)
19308        ELSE
19309          IFLAG3=1
19310        ENDIF
19311      ENDIF
19312C
19313C  USE MOMENT ESTIMATORS AS INITIAL VALUES FOR MAXIMUM
19314C  LIKELIHOOD.
19315C
19316      BETAML=BETAMO
19317      IF(BETAML.LE.0.01)BETAML=0.3
19318      ALPHML=ALPHMO
19319      IF(ALPHML.LE.0.01)ALPHML=0.3
19320      MAXIT=100
19321      ITER=0
19322C
19323 2200 CONTINUE
19324      ITER=ITER+1
19325      IF(ITER.GT.MAXIT)THEN
19326        WRITE(ICOUT,999)
19327        CALL DPWRST('XXX','WRIT')
19328        WRITE(ICOUT,2201)
19329 2201   FORMAT('***** WARNING FROM HERMITE MAXIMUM LIKELIHOOD ',
19330     1         'ESTIMATION--')
19331        CALL DPWRST('XXX','WRIT')
19332        WRITE(ICOUT,2203)
19333 2203   FORMAT('      MAXIMUM NUMBER OF ITERATIONS REACHED ',
19334     1         'WITHOUT CONVERGENCE.')
19335        CALL DPWRST('XXX','WRIT')
19336        GOTO2299
19337      ENDIF
19338C
19339      IAB=REAL(N)
19340      IF(ALPHML.GT.0.0)THEN
19341        IAA=REAL(N)*(1.0 + XMEAN/(ALPHML*ALPHML))
19342      ELSE
19343        IFLAG4=1
19344        GOTO2299
19345      ENDIF
19346C
19347      DSUM1=0.0D0
19348      DSUM2=0.0D0
19349      DSUM3=0.0D0
19350      ANMAX=X(N2)
19351      DO2210I=1,N2
19352        AN=X(I)
19353        FN=Y(I)
19354        CALL HERPDF(AN,ALPHML,BETAML,PDFN)
19355        AN2=AN-1
19356        IF(AN2.GE.0.0)THEN
19357          CALL HERPDF(AN2,ALPHML,BETAML,PDFNM1)
19358        ELSE
19359          PDFNM1=0.0
19360        ENDIF
19361        IF(PDFN.GT.0.0)THEN
19362          THETAN=(PDFNM1/PDFN) - 1.0
19363        ELSE
19364          THETAN=0.0
19365        ENDIF
19366        DSUM1=DSUM1 + DBLE(FN)*DBLE(THETAN)
19367        DSUM2=DSUM2 + DBLE(PDFN)*DBLE(THETAN)**2
19368 2210 CONTINUE
19369C
19370      SB=ALPHML*REAL(DSUM1)
19371      IBB=REAL(N)*ALPHML*ALPHML*REAL(DSUM2)
19372      BETANW=BETAML + (IAA*SB)/(IAA*IBB - IAB*IAB)
19373      ALPHML=(-BETANW + SQRT(BETANW*BETANW + 4.0*XMEAN))/2.0
19374C
19375C     CHECK FOR CONVERGENCE
19376C
19377      IF(ABS(BETANW - BETAML).GT.0.0001)THEN
19378        BETAML=BETANW
19379        GOTO2200
19380      ELSE
19381        BETAML=BETANW
19382      ENDIF
19383C
19384 2299 CONTINUE
19385C
19386      IF(IFLAG4.EQ.0)THEN
19387        AMLCOV(1,1)=IAA
19388        AMLCOV(2,2)=IBB
19389        AMLCOV(1,2)=IAB
19390        AMLCOV(2,1)=IAB
19391        MAXROM=2
19392        NR1=2
19393        CALL SGECO(AMLCOV,MAXROM,NR1,ITEMP1,RCOND,TEMP1)
19394        IJOB=1
19395        CALL SGEDI(AMLCOV,MAXROM,NR1,ITEMP1,TEMP1,TEMP2,IJOB)
19396        AMLVAR=AMLCOV(1,1)
19397        BMLVAR=AMLCOV(2,2)
19398        MLCOV=AMLCOV(1,2)
19399      ENDIF
19400C
19401C               ******************************************
19402C               **   STEP 42--                          **
19403C               **   WRITE OUT EVERYTHING               **
19404C               **   FOR HERMITE MLE ESTIMATE           **
19405C               ******************************************
19406C
19407      ISTEPN='42'
19408      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLHE')
19409     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19410      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19411C
19412C     PRINT SUMMARY STATISTICS TABLE
19413C
19414      NUMDIG=7
19415      IF(IFORSW.EQ.'1')NUMDIG=1
19416      IF(IFORSW.EQ.'2')NUMDIG=2
19417      IF(IFORSW.EQ.'3')NUMDIG=3
19418      IF(IFORSW.EQ.'4')NUMDIG=4
19419      IF(IFORSW.EQ.'5')NUMDIG=5
19420      IF(IFORSW.EQ.'6')NUMDIG=6
19421      IF(IFORSW.EQ.'7')NUMDIG=7
19422      IF(IFORSW.EQ.'8')NUMDIG=8
19423      IF(IFORSW.EQ.'9')NUMDIG=9
19424      IF(IFORSW.EQ.'0')NUMDIG=0
19425      IF(IFORSW.EQ.'E')NUMDIG=-2
19426      IF(IFORSW.EQ.'-2')NUMDIG=-2
19427      IF(IFORSW.EQ.'-3')NUMDIG=-3
19428      IF(IFORSW.EQ.'-4')NUMDIG=-4
19429      IF(IFORSW.EQ.'-5')NUMDIG=-5
19430      IF(IFORSW.EQ.'-6')NUMDIG=-6
19431      IF(IFORSW.EQ.'-7')NUMDIG=-7
19432      IF(IFORSW.EQ.'-8')NUMDIG=-8
19433      IF(IFORSW.EQ.'-9')NUMDIG=-9
19434C
19435      ITITLE='Hermite Parameter Estimation'
19436      NCTITL=28
19437      ITITLZ=' '
19438      NCTITZ=0
19439C
19440      ICNT=1
19441      ITEXT(ICNT)='Summary Statistics:'
19442      NCTEXT(ICNT)=19
19443      AVALUE(ICNT)=0.0
19444      IDIGIT(ICNT)=-1
19445      ICNT=ICNT+1
19446      ITEXT(ICNT)='Number of Observations:'
19447      NCTEXT(ICNT)=23
19448      AVALUE(ICNT)=REAL(NTOTZZ)
19449      IDIGIT(ICNT)=0
19450      ICNT=ICNT+1
19451      ITEXT(ICNT)='Sample Mean:'
19452      NCTEXT(ICNT)=12
19453      AVALUE(ICNT)=XMEAN
19454      IDIGIT(ICNT)=NUMDIG
19455      ICNT=ICNT+1
19456      ITEXT(ICNT)='Sample Standard Deviation:'
19457      NCTEXT(ICNT)=26
19458      AVALUE(ICNT)=XSD
19459      IDIGIT(ICNT)=NUMDIG
19460      ICNT=ICNT+1
19461      ITEXT(ICNT)='Sample Minimum:'
19462      NCTEXT(ICNT)=15
19463      AVALUE(ICNT)=XMIN
19464      IDIGIT(ICNT)=NUMDIG
19465      ICNT=ICNT+1
19466      ITEXT(ICNT)='Sample Maximum:'
19467      NCTEXT(ICNT)=15
19468      AVALUE(ICNT)=XMAX
19469      IDIGIT(ICNT)=NUMDIG
19470      ICNT=ICNT+1
19471      ITEXT(ICNT)=' '
19472      NCTEXT(ICNT)=0
19473      AVALUE(ICNT)=0.0
19474      IDIGIT(ICNT)=-1
19475C
19476      IF(IFLAG1.EQ.0)THEN
19477        AHAT=ALPHMO*BETAMO
19478        BHAT=ALPHMO**2/2.0
19479        ICNT=ICNT+1
19480        ITEXT(ICNT)='Method of Moments:'
19481        NCTEXT(ICNT)=18
19482        AVALUE(ICNT)=0.0
19483        IDIGIT(ICNT)=-1
19484        ICNT=ICNT+1
19485        ITEXT(ICNT)='Estimate of Alpha:'
19486        NCTEXT(ICNT)=18
19487        AVALUE(ICNT)=ALPHMO
19488        IDIGIT(ICNT)=NUMDIG
19489        ICNT=ICNT+1
19490        ITEXT(ICNT)='Estimate of Beta:'
19491        NCTEXT(ICNT)=17
19492        AVALUE(ICNT)=BETAMO
19493        IDIGIT(ICNT)=NUMDIG
19494        ICNT=ICNT+1
19495        ITEXT(ICNT)='Estimate of A:'
19496        NCTEXT(ICNT)=14
19497        AVALUE(ICNT)=AHAT
19498        IDIGIT(ICNT)=NUMDIG
19499        ICNT=ICNT+1
19500        ITEXT(ICNT)='Estimate of B:'
19501        NCTEXT(ICNT)=14
19502        AVALUE(ICNT)=BHAT
19503        IDIGIT(ICNT)=NUMDIG
19504        ICNT=ICNT+1
19505        ITEXT(ICNT)='Standard Error of A:'
19506        NCTEXT(ICNT)=20
19507        AVALUE(ICNT)=SQRT(AMOVAR)
19508        IDIGIT(ICNT)=NUMDIG
19509        ICNT=ICNT+1
19510        ITEXT(ICNT)='Standard Error of B:'
19511        NCTEXT(ICNT)=20
19512        AVALUE(ICNT)=SQRT(BMOVAR)
19513        IDIGIT(ICNT)=NUMDIG
19514        ICNT=ICNT+1
19515        ITEXT(ICNT)='A-B Covariance:'
19516        NCTEXT(ICNT)=15
19517        AVALUE(ICNT)=MOMCOV
19518        IDIGIT(ICNT)=NUMDIG
19519        ICNT=ICNT+1
19520        ITEXT(ICNT)=' '
19521        NCTEXT(ICNT)=0
19522        AVALUE(ICNT)=0.0
19523        IDIGIT(ICNT)=-1
19524      ENDIF
19525C
19526      IF(IFLAG1.EQ.0)THEN
19527        AHAT=ALPHEP*BETAEP
19528        BHAT=ALPHEP**2/2.0
19529        ICNT=ICNT+1
19530        ITEXT(ICNT)='Method of Even Points:'
19531        NCTEXT(ICNT)=22
19532        AVALUE(ICNT)=0.0
19533        IDIGIT(ICNT)=-1
19534        ICNT=ICNT+1
19535        ITEXT(ICNT)='Sum of Even Frequencies:'
19536        NCTEXT(ICNT)=24
19537        AVALUE(ICNT)=REAL(DSE)
19538        IDIGIT(ICNT)=NUMDIG
19539        ICNT=ICNT+1
19540        ITEXT(ICNT)='Sum of Odd Frequencies:'
19541        NCTEXT(ICNT)=23
19542        AVALUE(ICNT)=REAL(DSO)
19543        IDIGIT(ICNT)=NUMDIG
19544        ICNT=ICNT+1
19545        ITEXT(ICNT)='Estimate of Alpha:'
19546        NCTEXT(ICNT)=18
19547        AVALUE(ICNT)=ALPHEP
19548        IDIGIT(ICNT)=NUMDIG
19549        ICNT=ICNT+1
19550        ITEXT(ICNT)='Estimate of Beta:'
19551        NCTEXT(ICNT)=17
19552        AVALUE(ICNT)=BETAEP
19553        IDIGIT(ICNT)=NUMDIG
19554        ICNT=ICNT+1
19555        ITEXT(ICNT)='Estimate of A:'
19556        NCTEXT(ICNT)=14
19557        AVALUE(ICNT)=AHAT
19558        IDIGIT(ICNT)=NUMDIG
19559        ICNT=ICNT+1
19560        ITEXT(ICNT)='Estimate of B:'
19561        NCTEXT(ICNT)=14
19562        AVALUE(ICNT)=BHAT
19563        IDIGIT(ICNT)=NUMDIG
19564        ICNT=ICNT+1
19565        ITEXT(ICNT)=' '
19566        NCTEXT(ICNT)=0
19567        AVALUE(ICNT)=0.0
19568        IDIGIT(ICNT)=-1
19569      ENDIF
19570C
19571      IF(IFLAG3.EQ.0)THEN
19572        AHAT=ALPHZF*BETAZF
19573        BHAT=ALPHZF**2/2.0
19574        ICNT=ICNT+1
19575        ITEXT(ICNT)='Method of First Frequency:'
19576        NCTEXT(ICNT)=26
19577        AVALUE(ICNT)=0.0
19578        IDIGIT(ICNT)=-1
19579        ICNT=ICNT+1
19580        ITEXT(ICNT)='Estimate of Alpha:'
19581        NCTEXT(ICNT)=18
19582        AVALUE(ICNT)=ALPHZF
19583        IDIGIT(ICNT)=NUMDIG
19584        ICNT=ICNT+1
19585        ITEXT(ICNT)='Estimate of Beta:'
19586        NCTEXT(ICNT)=17
19587        AVALUE(ICNT)=BETAZF
19588        IDIGIT(ICNT)=NUMDIG
19589        ICNT=ICNT+1
19590        ITEXT(ICNT)='Estimate of A:'
19591        NCTEXT(ICNT)=14
19592        AVALUE(ICNT)=AHAT
19593        IDIGIT(ICNT)=NUMDIG
19594        ICNT=ICNT+1
19595        ITEXT(ICNT)='Estimate of B:'
19596        NCTEXT(ICNT)=14
19597        AVALUE(ICNT)=BHAT
19598        IDIGIT(ICNT)=NUMDIG
19599        ICNT=ICNT+1
19600        ITEXT(ICNT)='Standard Error of A:'
19601        NCTEXT(ICNT)=20
19602        AVALUE(ICNT)=SQRT(AZFVAR)
19603        IDIGIT(ICNT)=NUMDIG
19604        ICNT=ICNT+1
19605        ITEXT(ICNT)='Standard Error of B:'
19606        NCTEXT(ICNT)=20
19607        AVALUE(ICNT)=SQRT(BZFVAR)
19608        IDIGIT(ICNT)=NUMDIG
19609        ICNT=ICNT+1
19610        ITEXT(ICNT)='A-B Covariance:'
19611        NCTEXT(ICNT)=15
19612        AVALUE(ICNT)=ZFCOV
19613        IDIGIT(ICNT)=NUMDIG
19614        ICNT=ICNT+1
19615        ITEXT(ICNT)=' '
19616        NCTEXT(ICNT)=0
19617        AVALUE(ICNT)=0.0
19618        IDIGIT(ICNT)=-1
19619      ENDIF
19620C
19621      IF(IFLAG4.EQ.0)THEN
19622        AHAT=ALPHML*BETAML
19623        BHAT=ALPHML**2/2.0
19624        ICNT=ICNT+1
19625        ITEXT(ICNT)='Method of Maximum Likelihood:'
19626        NCTEXT(ICNT)=29
19627        AVALUE(ICNT)=0.0
19628        IDIGIT(ICNT)=-1
19629        ICNT=ICNT+1
19630        ITEXT(ICNT)='Estimate of Alpha:'
19631        NCTEXT(ICNT)=18
19632        AVALUE(ICNT)=ALPHML
19633        IDIGIT(ICNT)=NUMDIG
19634        ICNT=ICNT+1
19635        ITEXT(ICNT)='Estimate of Beta:'
19636        NCTEXT(ICNT)=17
19637        AVALUE(ICNT)=BETAML
19638        IDIGIT(ICNT)=NUMDIG
19639        ICNT=ICNT+1
19640        ITEXT(ICNT)='Estimate of A:'
19641        NCTEXT(ICNT)=14
19642        AVALUE(ICNT)=AHAT
19643        IDIGIT(ICNT)=NUMDIG
19644        ICNT=ICNT+1
19645        ITEXT(ICNT)='Estimate of B:'
19646        NCTEXT(ICNT)=14
19647        AVALUE(ICNT)=BHAT
19648        IDIGIT(ICNT)=NUMDIG
19649        ICNT=ICNT+1
19650        ITEXT(ICNT)='Standard Error of A:'
19651        NCTEXT(ICNT)=20
19652        AVALUE(ICNT)=SQRT(AMLVAR)
19653        IDIGIT(ICNT)=NUMDIG
19654        ICNT=ICNT+1
19655        ITEXT(ICNT)='Standard Error of B:'
19656        NCTEXT(ICNT)=20
19657        AVALUE(ICNT)=SQRT(BMLVAR)
19658        IDIGIT(ICNT)=NUMDIG
19659        ICNT=ICNT+1
19660        ITEXT(ICNT)='A-B Covariance:'
19661        NCTEXT(ICNT)=15
19662        AVALUE(ICNT)=MLCOV
19663        IDIGIT(ICNT)=NUMDIG
19664        ICNT=ICNT+1
19665        ITEXT(ICNT)=' '
19666        NCTEXT(ICNT)=0
19667        AVALUE(ICNT)=0.0
19668        IDIGIT(ICNT)=-1
19669      ENDIF
19670C
19671      NUMROW=ICNT
19672      DO2310I=1,NUMROW
19673        NTOT(I)=15
19674 2310 CONTINUE
19675C
19676      IFRST=.TRUE.
19677      ILAST=.TRUE.
19678      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
19679     1            AVALUE,IDIGIT,
19680     1            NTOT,NUMROW,
19681     1            ICAPSW,ICAPTY,ILAST,IFRST,
19682     1            ISUBRO,IBUGA3,IERROR)
19683C
19684C               *****************
19685C               **  STEP 90--  **
19686C               **  EXIT       **
19687C               *****************
19688C
19689 9000 CONTINUE
19690      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLHE')THEN
19691        WRITE(ICOUT,999)
19692        CALL DPWRST('XXX','WRIT')
19693        WRITE(ICOUT,9011)
19694 9011   FORMAT('***** AT THE END       OF DPMLHE--')
19695        CALL DPWRST('XXX','WRIT')
19696        WRITE(ICOUT,9013)ALPHMO,BETAMO,ALPHML,BETAML
19697 9013   FORMAT('ALPHMO,BETAMO,ALPHML,BETAML = ',4G15.7)
19698        CALL DPWRST('XXX','WRIT')
19699        WRITE(ICOUT,9015)ALPHEP,BETAEP,ALPHZF,BETAZF
19700 9015   FORMAT('ALPHEP,BETAEP,ALPHZF,BETAZF = ',4G15.7)
19701        CALL DPWRST('XXX','WRIT')
19702      ENDIF
19703C
19704      RETURN
19705      END
19706      SUBROUTINE DPMLHL(Y,N,ICASPL,
19707     1                  TEMP1,DTEMP1,MAXNXT,
19708     1                  ALOCML,SCALML,SCALBC,SCALSE,
19709     1                  ICAPSW,ICAPTY,IFORSW,
19710     1                  ISUBRO,IBUGA3,IERROR)
19711C
19712C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
19713C              ESTIMATES FOR THE HALF-LOGISTIC DISTRIBUTION.
19714C     EXAMPLE--HALF LOGISTIC MAXIMUM LIKELIHOOD Y
19715C              1-PARAMETER HALF-LOGISTIC MAXIMUM LIKELIHOOD Y
19716C     REFERENCE--XXX
19717C     WRITTEN BY--ALAN HECKERT
19718C                 STATISTICAL ENGINEERING DIVISION
19719C                 INFORMATION TECHNOLOGY LABORATORY
19720C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
19721C                 GAITHERSBURG, MD 20899-8980
19722C                 PHONE--301-975-2899
19723C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
19724C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
19725C     LANGUAGE--ANSI FORTRAN (1977)
19726C     VERSION NUMBER--2020/04
19727C     ORIGINAL VERSION--ARRIL     2020.
19728C
19729C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
19730C
19731      CHARACTER*4 ICASPL
19732      CHARACTER*4 ICAPSW
19733      CHARACTER*4 ICAPTY
19734      CHARACTER*4 IFORSW
19735      CHARACTER*4 ISUBRO
19736      CHARACTER*4 IBUGA3
19737      CHARACTER*4 IERROR
19738C
19739      CHARACTER*4 IWRITE
19740      CHARACTER*4 ISUBN1
19741      CHARACTER*4 ISUBN2
19742      CHARACTER*4 ISTEPN
19743      CHARACTER*4 ICASE
19744C
19745C---------------------------------------------------------------------
19746C
19747      DIMENSION Y(*)
19748      DIMENSION TEMP1(*)
19749      DOUBLE PRECISION DTEMP1(*)
19750C
19751CCCCC PARAMETER (NUMALP=8)
19752CCCCC DIMENSION ALPHA(NUMALP)
19753CCCCC DIMENSION ALOWLO(NUMALP)
19754CCCCC DIMENSION AUPPLO(NUMALP)
19755CCCCC DIMENSION ALOWSC(NUMALP)
19756CCCCC DIMENSION AUPPSC(NUMALP)
19757      DIMENSION QP(1)
19758C
19759      INCLUDE 'DPCOST.INC'
19760C
19761      PARAMETER (MAXROW=30)
19762      CHARACTER*60 ITITLE
19763      CHARACTER*60 ITITLZ
19764      CHARACTER*40 ITEXT(MAXROW)
19765      REAL         AVALUE(MAXROW)
19766      INTEGER      NCTEXT(MAXROW)
19767      INTEGER      IDIGIT(MAXROW)
19768      INTEGER      NTOT(MAXROW)
19769      LOGICAL IFRST
19770      LOGICAL ILAST
19771C
19772C---------------------------------------------------------------------
19773C
19774      INCLUDE 'DPCOP2.INC'
19775C
19776CCCCC DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
19777C
19778C-----START POINT-----------------------------------------------------
19779C
19780      ISUBN1='DPML'
19781      ISUBN2='HL  '
19782      IERROR='NO'
19783      IWRITE='OFF'
19784C
19785      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLHL')THEN
19786        WRITE(ICOUT,999)
19787  999   FORMAT(1X)
19788        CALL DPWRST('XXX','WRIT')
19789        WRITE(ICOUT,51)
19790   51   FORMAT('**** AT THE BEGINNING OF DPMLHL--')
19791        CALL DPWRST('XXX','WRIT')
19792        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,MAXNXT
19793   52   FORMAT('IBUGA3,ISUBRO,N,MAXNXT = ',2(A4,2X),2I8)
19794        CALL DPWRST('XXX','WRIT')
19795        DO56I=1,MIN(N,100)
19796          WRITE(ICOUT,57)I,Y(I)
19797   57     FORMAT('I,Y(I) = ',I8,G15.7)
19798          CALL DPWRST('XXX','WRIT')
19799   56   CONTINUE
19800      ENDIF
19801C
19802C               ********************************************
19803C               **  STEP 11--                             **
19804C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
19805C               ********************************************
19806C
19807      ISTEPN='11'
19808      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLHL')
19809     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19810C
19811      NPERC=0
19812      NMIN=2
19813      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
19814      IF(IERROR.EQ.'YES')GOTO9000
19815C
19816C               ********************************************
19817C               **  STEP 21--                             **
19818C               **  CARRY OUT CALCULATIONS FOR            **
19819C               **  HALF-LOGISTIC MLE (FULL SAMPLE CASE)  **
19820C               ********************************************
19821C
19822      ISTEPN='21'
19823      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLHL')
19824     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19825C
19826      ICASE='2'
19827      IF(ICASPL.EQ.'1HAL')ICASE='1'
19828      CALL HFLML1(Y,N,ICASE,
19829     1            TEMP1,DTEMP1,
19830     1            XMEAN,XSD,XMIN,XMAX,
19831     1            ALOCML,SCALML,SCALBC,SCALSE,
19832     1            ISUBRO,IBUGA3,IERROR)
19833      CALL HFLLI1(Y,N,ICASE,
19834     1            ALOCML,SCALBC,
19835     1            ALIK,AIC,AICC,BIC,
19836     1            ISUBRO,IBUGA3,IERROR)
19837C
19838CCCCC DO2120I=1,NUMALP
19839CCCCC   ALP=ALPHA(I)
19840CCCCC   P=1.0-(ALP/2.0)
19841CCCCC   CALL CHSPPF(P,NU,PPF1)
19842CCCCC   P=ALP/2.0
19843CCCCC   CALL CHSPPF(P,NU,PPF2)
19844CCCCC   ALOWSC(I)=SQRT(REAL(DTERM1)/PPF1)
19845CCCCC   AUPPSC(I)=SQRT(REAL(DTERM1)/PPF2)
19846C2120 CONTINUE
19847C
19848C               ****************************************
19849C               **   STEP 42--                        **
19850C               **   WRITE OUT EVERYTHING             **
19851C               **   FOR HALF-LOGISTIC MLE ESTIMATE   **
19852C               ****************************************
19853C
19854      ISTEPN='42'
19855      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLHL')
19856     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19857C
19858      IF(IPRINT.EQ.'OFF')GOTO9000
19859C
19860      NUMDIG=7
19861      IF(IFORSW.EQ.'1')NUMDIG=1
19862      IF(IFORSW.EQ.'2')NUMDIG=2
19863      IF(IFORSW.EQ.'3')NUMDIG=3
19864      IF(IFORSW.EQ.'4')NUMDIG=4
19865      IF(IFORSW.EQ.'5')NUMDIG=5
19866      IF(IFORSW.EQ.'6')NUMDIG=6
19867      IF(IFORSW.EQ.'7')NUMDIG=7
19868      IF(IFORSW.EQ.'8')NUMDIG=8
19869      IF(IFORSW.EQ.'9')NUMDIG=9
19870      IF(IFORSW.EQ.'0')NUMDIG=0
19871      IF(IFORSW.EQ.'E')NUMDIG=-2
19872      IF(IFORSW.EQ.'-2')NUMDIG=-2
19873      IF(IFORSW.EQ.'-3')NUMDIG=-3
19874      IF(IFORSW.EQ.'-4')NUMDIG=-4
19875      IF(IFORSW.EQ.'-5')NUMDIG=-5
19876      IF(IFORSW.EQ.'-6')NUMDIG=-6
19877      IF(IFORSW.EQ.'-7')NUMDIG=-7
19878      IF(IFORSW.EQ.'-8')NUMDIG=-8
19879      IF(IFORSW.EQ.'-9')NUMDIG=-9
19880C
19881      IF(ICASE.EQ.'1')THEN
19882        ITITLE='1-Parameter Half-Logistic Parameter Estimation'
19883        NCTITL=46
19884      ELSE
19885        ITITLE='2-Parameter Half-Logistic Parameter Estimation'
19886        NCTITL=46
19887      ENDIF
19888      ITITLZ=' '
19889      NCTITZ=0
19890      ICNT=1
19891      ITEXT(ICNT)='Summary Statistics:'
19892      NCTEXT(ICNT)=19
19893      AVALUE(ICNT)=0.0
19894      IDIGIT(ICNT)=-1
19895      ICNT=ICNT+1
19896      ITEXT(ICNT)='Number of Observations:'
19897      NCTEXT(ICNT)=23
19898      AVALUE(ICNT)=REAL(N)
19899      IDIGIT(ICNT)=0
19900      ICNT=ICNT+1
19901      ITEXT(ICNT)='Sample Mean:'
19902      NCTEXT(ICNT)=12
19903      AVALUE(ICNT)=XMEAN
19904      IDIGIT(ICNT)=NUMDIG
19905      ICNT=ICNT+1
19906      ITEXT(ICNT)='Sample Standard Deviation:'
19907      NCTEXT(ICNT)=26
19908      AVALUE(ICNT)=XSD
19909      IDIGIT(ICNT)=NUMDIG
19910      ICNT=ICNT+1
19911      ITEXT(ICNT)='Sample Minimum:'
19912      NCTEXT(ICNT)=15
19913      AVALUE(ICNT)=XMIN
19914      IDIGIT(ICNT)=NUMDIG
19915      ICNT=ICNT+1
19916      ITEXT(ICNT)='Sample Maximum:'
19917      NCTEXT(ICNT)=15
19918      AVALUE(ICNT)=XMAX
19919      IDIGIT(ICNT)=NUMDIG
19920      ICNT=ICNT+1
19921      ITEXT(ICNT)=' '
19922      NCTEXT(ICNT)=0
19923      AVALUE(ICNT)=0.0
19924      IDIGIT(ICNT)=-1
19925C
19926      ICNT=ICNT+1
19927      ITEXT(ICNT)='Maximum Likelihood:'
19928      NCTEXT(ICNT)=19
19929      AVALUE(ICNT)=0.0
19930      IDIGIT(ICNT)=-1
19931C
19932      IF(ICASE.EQ.'2')THEN
19933        ICNT=ICNT+1
19934        ITEXT(ICNT)='Estimate of Location:'
19935        NCTEXT(ICNT)=21
19936        AVALUE(ICNT)=ALOCML
19937        IDIGIT(ICNT)=NUMDIG
19938      ENDIF
19939C
19940      ICNT=ICNT+1
19941      ITEXT(ICNT)='Estimate of Scale:'
19942      NCTEXT(ICNT)=18
19943      AVALUE(ICNT)=SCALML
19944      IDIGIT(ICNT)=NUMDIG
19945      ICNT=ICNT+1
19946      ITEXT(ICNT)='Bias Corrected Estimate of Scale:'
19947      NCTEXT(ICNT)=33
19948      AVALUE(ICNT)=SCALBC
19949      IDIGIT(ICNT)=NUMDIG
19950CCCCC ICNT=ICNT+1
19951CCCCC ITEXT(ICNT)='Standard Error of Scale:'
19952CCCCC NCTEXT(ICNT)=24
19953CCCCC AVALUE(ICNT)=SCALSE
19954CCCCC IDIGIT(ICNT)=NUMDIG
19955C
19956      ICNT=ICNT+1
19957      ITEXT(ICNT)='Log-likelihood:'
19958      NCTEXT(ICNT)=15
19959      AVALUE(ICNT)=ALIK
19960      IDIGIT(ICNT)=-7
19961      ICNT=ICNT+1
19962      ITEXT(ICNT)='AIC:'
19963      NCTEXT(ICNT)=4
19964      AVALUE(ICNT)=AIC
19965      IDIGIT(ICNT)=-7
19966      ICNT=ICNT+1
19967      ITEXT(ICNT)='AICc:'
19968      NCTEXT(ICNT)=5
19969      AVALUE(ICNT)=AICC
19970      IDIGIT(ICNT)=-7
19971      ICNT=ICNT+1
19972      ITEXT(ICNT)='BIC:'
19973      NCTEXT(ICNT)=4
19974      AVALUE(ICNT)=BIC
19975      IDIGIT(ICNT)=-7
19976C
19977      NUMROW=ICNT
19978      DO2320I=1,NUMROW
19979        NTOT(I)=15
19980 2320 CONTINUE
19981C
19982      IFRST=.FALSE.
19983      ILAST=.FALSE.
19984      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
19985     1            AVALUE,IDIGIT,
19986     1            NTOT,NUMROW,
19987     1            ICAPSW,ICAPTY,ILAST,IFRST,
19988     1            ISUBRO,IBUGA3,IERROR)
19989C
19990CCCCC ALOWLO(1)=CPUMIN
19991CCCCC CALL DPDTA7(ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,NUMALP,
19992CCCCC1            ICAPSW,ICAPTY,NUMDIG,INORM,
19993CCCCC1            ISUBRO,IBUGA3,IERROR)
19994C
19995C               *****************
19996C               **  STEP 90--  **
19997C               **  EXIT       **
19998C               *****************
19999C
20000 9000 CONTINUE
20001      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLHL')THEN
20002        WRITE(ICOUT,999)
20003        CALL DPWRST('XXX','WRIT')
20004        WRITE(ICOUT,9011)
20005 9011   FORMAT('***** AT THE END       OF DPMLHL--')
20006        CALL DPWRST('XXX','WRIT')
20007        WRITE(ICOUT,9012)IERROR,ALOCML,SCALML,SCALBC
20008 9012   FORMAT('IERROR,ALOCML,SCALML,SCALBC = ',A4,2X,3G15.7)
20009        CALL DPWRST('XXX','WRIT')
20010      ENDIF
20011C
20012      RETURN
20013      END
20014      SUBROUTINE DPMLHN(Y,N,ICASPL,
20015     1                  ALOCML,SCALML,
20016     1                  ICAPSW,ICAPTY,IFORSW,
20017     1                  ISUBRO,IBUGA3,IERROR)
20018C
20019C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
20020C              ESTIMATES FOR THE HALF-NORMAL DISTRIBUTION.
20021C
20022C              THE ESTIMATE OF THE LOCATION PARAMETER IS THE
20023C              SAMPLE MINIMUM.  THE ESTIMATE OF THE SCALE PARAMETER IS
20024C
20025C                 SCALEHAT = SQRT(SUM[i=1 to N][(X(i) - YMIN)**2/N])
20026C
20027C     EXAMPLE--HALF NORMAL MAXIMUM LIKELIHOOD Y
20028C              1-PARAMETER HALF-NORMAL MAXIMUM LIKELIHOOD Y
20029C     REFERENCE--XXX
20030C     WRITTEN BY--ALAN HECKERT
20031C                 STATISTICAL ENGINEERING DIVISION
20032C                 INFORMATION TECHNOLOGY LABORATORY
20033C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
20034C                 GAITHERSBURG, MD 20899-8980
20035C                 PHONE--301-975-2899
20036C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
20037C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
20038C     LANGUAGE--ANSI FORTRAN (1977)
20039C     VERSION NUMBER--2020/04
20040C     ORIGINAL VERSION--APRIL     2020.
20041C
20042C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
20043C
20044      CHARACTER*4 ICASPL
20045      CHARACTER*4 ICAPSW
20046      CHARACTER*4 ICAPTY
20047      CHARACTER*4 IFORSW
20048      CHARACTER*4 ISUBRO
20049      CHARACTER*4 IBUGA3
20050      CHARACTER*4 IERROR
20051C
20052      CHARACTER*4 IWRITE
20053      CHARACTER*4 ISUBN1
20054      CHARACTER*4 ISUBN2
20055      CHARACTER*4 ISTEPN
20056      CHARACTER*4 ICASE
20057C
20058C---------------------------------------------------------------------
20059C
20060      DIMENSION Y(*)
20061C
20062CCCCC PARAMETER (NUMALP=8)
20063CCCCC DIMENSION ALPHA(NUMALP)
20064CCCCC DIMENSION ALOWLO(NUMALP)
20065CCCCC DIMENSION AUPPLO(NUMALP)
20066CCCCC DIMENSION ALOWSC(NUMALP)
20067CCCCC DIMENSION AUPPSC(NUMALP)
20068      DIMENSION QP(1)
20069C
20070      INCLUDE 'DPCOST.INC'
20071C
20072      PARAMETER (MAXROW=30)
20073      CHARACTER*60 ITITLE
20074      CHARACTER*60 ITITLZ
20075      CHARACTER*40 ITEXT(MAXROW)
20076      REAL         AVALUE(MAXROW)
20077      INTEGER      NCTEXT(MAXROW)
20078      INTEGER      IDIGIT(MAXROW)
20079      INTEGER      NTOT(MAXROW)
20080      LOGICAL IFRST
20081      LOGICAL ILAST
20082C
20083C---------------------------------------------------------------------
20084C
20085      INCLUDE 'DPCOP2.INC'
20086C
20087CCCCC DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
20088C
20089C-----START POINT-----------------------------------------------------
20090C
20091      ISUBN1='DPML'
20092      ISUBN2='HN  '
20093      IERROR='NO'
20094      IWRITE='OFF'
20095C
20096      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLHN')THEN
20097        WRITE(ICOUT,999)
20098  999   FORMAT(1X)
20099        CALL DPWRST('XXX','WRIT')
20100        WRITE(ICOUT,51)
20101   51   FORMAT('**** AT THE BEGINNING OF DPMLHN--')
20102        CALL DPWRST('XXX','WRIT')
20103        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,MAXNXT
20104   52   FORMAT('IBUGA3,ISUBRO,N,MAXNXT = ',2(A4,2X),2I8)
20105        CALL DPWRST('XXX','WRIT')
20106        DO56I=1,MIN(N,100)
20107          WRITE(ICOUT,57)I,Y(I)
20108   57     FORMAT('I,Y(I) = ',I8,G15.7)
20109          CALL DPWRST('XXX','WRIT')
20110   56   CONTINUE
20111      ENDIF
20112C
20113C               ********************************************
20114C               **  STEP 11--                             **
20115C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
20116C               ********************************************
20117C
20118      ISTEPN='11'
20119      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLHN')
20120     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20121C
20122      NPERC=0
20123      NMIN=2
20124      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
20125      IF(IERROR.EQ.'YES')GOTO9000
20126C
20127C               **************************************
20128C               **  STEP 21--                       **
20129C               **  CARRY OUT CALCULATIONS FOR      **
20130C               **  MAXWELL MLE (FULL SAMPLE CASE)  **
20131C               **************************************
20132C
20133      ISTEPN='21'
20134      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLHN')
20135     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20136C
20137      ICASE='2'
20138      IF(ICASPL.EQ.'1HNO')ICASE='1'
20139      CALL HFNML1(Y,N,ICASE,
20140     1            XMEAN,XSD,XMIN,XMAX,
20141     1            ALOCML,SCALML,
20142     1            ISUBRO,IBUGA3,IERROR)
20143      IF(ICASE.EQ.'1')ALOCML=0.0
20144      CALL HFNLI1(Y,N,ICASE,
20145     1            ALOCML,SCALML,
20146     1            ALIK,AIC,AICC,BIC,
20147     1            ISUBRO,IBUGA3,IERROR)
20148C
20149CCCCC NU=2*N
20150CCCCC DTERM1=DBLE(N)*2.0D0*DBLE(SCALML)**2
20151CCCCC DO2120I=1,NUMALP
20152CCCCC   ALP=ALPHA(I)
20153CCCCC   P=1.0-(ALP/2.0)
20154CCCCC   CALL CHSPPF(P,NU,PPF1)
20155CCCCC   P=ALP/2.0
20156CCCCC   CALL CHSPPF(P,NU,PPF2)
20157CCCCC   ALOWSC(I)=SQRT(REAL(DTERM1)/PPF1)
20158CCCCC   AUPPSC(I)=SQRT(REAL(DTERM1)/PPF2)
20159C2120 CONTINUE
20160C
20161C               *************************************
20162C               **   STEP 42--                     **
20163C               **   WRITE OUT EVERYTHING          **
20164C               **   FOR HALF-NORMAL MLE ESTIMATE  **
20165C               *************************************
20166C
20167      ISTEPN='42'
20168      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLHN')
20169     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20170C
20171      IF(IPRINT.EQ.'OFF')GOTO9000
20172C
20173      NUMDIG=7
20174      IF(IFORSW.EQ.'1')NUMDIG=1
20175      IF(IFORSW.EQ.'2')NUMDIG=2
20176      IF(IFORSW.EQ.'3')NUMDIG=3
20177      IF(IFORSW.EQ.'4')NUMDIG=4
20178      IF(IFORSW.EQ.'5')NUMDIG=5
20179      IF(IFORSW.EQ.'6')NUMDIG=6
20180      IF(IFORSW.EQ.'7')NUMDIG=7
20181      IF(IFORSW.EQ.'8')NUMDIG=8
20182      IF(IFORSW.EQ.'9')NUMDIG=9
20183      IF(IFORSW.EQ.'0')NUMDIG=0
20184      IF(IFORSW.EQ.'E')NUMDIG=-2
20185      IF(IFORSW.EQ.'-2')NUMDIG=-2
20186      IF(IFORSW.EQ.'-3')NUMDIG=-3
20187      IF(IFORSW.EQ.'-4')NUMDIG=-4
20188      IF(IFORSW.EQ.'-5')NUMDIG=-5
20189      IF(IFORSW.EQ.'-6')NUMDIG=-6
20190      IF(IFORSW.EQ.'-7')NUMDIG=-7
20191      IF(IFORSW.EQ.'-8')NUMDIG=-8
20192      IF(IFORSW.EQ.'-9')NUMDIG=-9
20193C
20194      IF(ICASPL.EQ.'1HNO')THEN
20195        ITITLE='1-Parameter Half-Normal Parameter Estimation'
20196        NCTITL=44
20197      ELSE
20198        ITITLE='2-Parameter Half-Normal Parameter Estimation'
20199        NCTITL=44
20200      ENDIF
20201      ITITLZ=' '
20202      NCTITZ=0
20203      ICNT=1
20204      ITEXT(ICNT)='Summary Statistics:'
20205      NCTEXT(ICNT)=19
20206      AVALUE(ICNT)=0.0
20207      IDIGIT(ICNT)=-1
20208      ICNT=ICNT+1
20209      ITEXT(ICNT)='Number of Observations:'
20210      NCTEXT(ICNT)=23
20211      AVALUE(ICNT)=REAL(N)
20212      IDIGIT(ICNT)=0
20213      ICNT=ICNT+1
20214      ITEXT(ICNT)='Sample Mean:'
20215      NCTEXT(ICNT)=12
20216      AVALUE(ICNT)=XMEAN
20217      IDIGIT(ICNT)=NUMDIG
20218      ICNT=ICNT+1
20219      ITEXT(ICNT)='Sample Standard Deviation:'
20220      NCTEXT(ICNT)=26
20221      AVALUE(ICNT)=XSD
20222      IDIGIT(ICNT)=NUMDIG
20223      ICNT=ICNT+1
20224      ITEXT(ICNT)='Sample Minimum:'
20225      NCTEXT(ICNT)=15
20226      AVALUE(ICNT)=XMIN
20227      IDIGIT(ICNT)=NUMDIG
20228      ICNT=ICNT+1
20229      ITEXT(ICNT)='Sample Maximum:'
20230      NCTEXT(ICNT)=15
20231      AVALUE(ICNT)=XMAX
20232      IDIGIT(ICNT)=NUMDIG
20233      ICNT=ICNT+1
20234      ITEXT(ICNT)=' '
20235      NCTEXT(ICNT)=0
20236      AVALUE(ICNT)=0.0
20237      IDIGIT(ICNT)=-1
20238C
20239      ICNT=ICNT+1
20240      ITEXT(ICNT)='Maximum Likelihood:'
20241      NCTEXT(ICNT)=19
20242      AVALUE(ICNT)=0.0
20243      IDIGIT(ICNT)=-1
20244C
20245      IF(ICASPL.EQ.'HNOR')THEN
20246        ICNT=ICNT+1
20247        ITEXT(ICNT)='Estimate of Location:'
20248        NCTEXT(ICNT)=21
20249        AVALUE(ICNT)=ALOCML
20250        IDIGIT(ICNT)=NUMDIG
20251      ENDIF
20252C
20253      ICNT=ICNT+1
20254      ITEXT(ICNT)='Estimate of Scale:'
20255      NCTEXT(ICNT)=18
20256      AVALUE(ICNT)=SCALML
20257      IDIGIT(ICNT)=NUMDIG
20258CCCCC ICNT=ICNT+1
20259CCCCC ITEXT(ICNT)='Standard Error of Scale:'
20260CCCCC NCTEXT(ICNT)=24
20261CCCCC AVALUE(ICNT)=SCALSE
20262CCCCC IDIGIT(ICNT)=NUMDIG
20263C
20264      ICNT=ICNT+1
20265      ITEXT(ICNT)='Log-likelihood:'
20266      NCTEXT(ICNT)=15
20267      AVALUE(ICNT)=ALIK
20268      IDIGIT(ICNT)=-7
20269      ICNT=ICNT+1
20270      ITEXT(ICNT)='AIC:'
20271      NCTEXT(ICNT)=4
20272      AVALUE(ICNT)=AIC
20273      IDIGIT(ICNT)=-7
20274      ICNT=ICNT+1
20275      ITEXT(ICNT)='AICc:'
20276      NCTEXT(ICNT)=5
20277      AVALUE(ICNT)=AICC
20278      IDIGIT(ICNT)=-7
20279      ICNT=ICNT+1
20280      ITEXT(ICNT)='BIC:'
20281      NCTEXT(ICNT)=4
20282      AVALUE(ICNT)=BIC
20283      IDIGIT(ICNT)=-7
20284C
20285      NUMROW=ICNT
20286      DO2320I=1,NUMROW
20287        NTOT(I)=15
20288 2320 CONTINUE
20289C
20290      IFRST=.FALSE.
20291      ILAST=.FALSE.
20292      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
20293     1            AVALUE,IDIGIT,
20294     1            NTOT,NUMROW,
20295     1            ICAPSW,ICAPTY,ILAST,IFRST,
20296     1            ISUBRO,IBUGA3,IERROR)
20297C
20298CCCCC ALOWLO(1)=CPUMIN
20299CCCCC CALL DPDTA7(ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,NUMALP,
20300CCCCC1            ICAPSW,ICAPTY,NUMDIG,INORM,
20301CCCCC1            ISUBRO,IBUGA3,IERROR)
20302C
20303C               *****************
20304C               **  STEP 90--  **
20305C               **  EXIT       **
20306C               *****************
20307C
20308 9000 CONTINUE
20309      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLHN')THEN
20310        WRITE(ICOUT,999)
20311        CALL DPWRST('XXX','WRIT')
20312        WRITE(ICOUT,9011)
20313 9011   FORMAT('***** AT THE END       OF DPMLHN--')
20314        CALL DPWRST('XXX','WRIT')
20315        WRITE(ICOUT,9012)ALOCML,SCALML,IERROR
20316 9012   FORMAT('ALOCML,SCALML,IERROR = ',2G15.7,2X,A4)
20317        CALL DPWRST('XXX','WRIT')
20318      ENDIF
20319C
20320      RETURN
20321      END
20322      SUBROUTINE DPMLHY(Y,N,ITEMP1,ITEMP2,
20323     1                  XTEMP,MAXNXT,
20324     1                  ICAPSW,ICAPTY,IHYPTY,IOUNI1,
20325     1                  ISUBRO,IBUGA3,IERROR)
20326C
20327C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
20328C              ESTIMATES FOR HYPERGEOMETRIC DISTRIBUTION.
20329C              FOR THE HYPERGEOMETRIC DISTRIBUTION, WE HAVE:
20330C
20331C                 1) N  = TOTAL NUMBER OF ITEMS IN POPULATION
20332C                 2) n  = NUMBER OF ITEMS SAMPLED (STORED IN THE
20333C                         ITEMP1 ARRAY)
20334C                 3) K  = NUMBER OF DEFECTIVE ITEMS (OR SUCCESSES)
20335C                         IN POPULATION
20336C                 4) x  = NUMBER OF DEFECTIVES IN SAMPLE (STORED IN
20337C                         Y ARRAY)
20338C
20339C              THERE ARE TWO DISTINCT CASES:
20340C
20341C              GIVEN THAT N (THE POPULATION SIZE) IS KNOWN, WE
20342C              WANT TO ESTIMATE THE NUMBER OF DEFECTIVES IN
20343C              THE POPULATION GIVEN A SAMPLE OF SIZE n WITH x
20344C              DEFECTIVES.  AN EXAMPLE IS ACCEPTANCE SAMPLING
20345C              WHERE THE LOT SIZE IS KNOWN AND A SUBSAMPLE IS
20346C              CHOOSEN FOR INSPECTION.  IN THIS CASE, THE MAXIMUM
20347C              LIKELIHOOD ESTIMATE OF K IS:
20348C
20349C                   K = MAX INTEGER <= x*(N+1)/n
20350C
20351C              IN CAPTURE/RECAPTURE PROBLEMS, A SAMPLE IS TAKEN
20352C              AND MARKED.  THAT IS, K IS KNOWN.  THEN A SECOND
20353C              SAMPLE (OF SIZE n) IS TAKEN AND THE NUMBER OF MARKED
20354C              ITEMS (x) ARE COUNTED.  IN THIS CASE,
20355C              THE MAXIMUM LIKELIHOOD ESTIMATES ARE:
20356C
20357C                   N = MAX INTEGER <= n*K/x
20358C
20359C              WE IMPLEMENT THE REFINEMENT OF CHAPMAN (SEE
20360C              PAGE 263 OF JOHNSON, KOTZ, AND KEMP):
20361C
20362C                   N* = (n+1)*(K+1)/(x+1) - 1
20363C
20364C              FORMULAS FOR THE VARIANCE ARE ALSO GIVEN IN
20365C              JOHNSON, KOTZ, AND KEMP.
20366C
20367C
20368C     EXAMPLE--HYPERGEOMETRIC MAXIMUM LIKELIHOOD NUMDEF NSAMP NPOP
20369C              HYPERGEOMETRIC MAXIMUM LIKELIHOOD NUMDEF NSAMP NK
20370C     REFERENCE--"UNIVARIATE DISCRETE DISTRIBUTIONS", SECOND EDITION,
20371C                JOHNSON, KOTZ, AND KEMP, WILEY, PP. 262-264.
20372C              --"STATISTICAL DISTRIBUTIONS", THIRD EDITION,
20373C                EVANS, HASTINGS, AND PEACOCK, WILEY, PP. 109-113.
20374C     WRITTEN BY--JAMES J. FILLIBEN
20375C                 STATISTICAL ENGINEERING DIVISION
20376C                 INFORMATION TECHNOLOGY LABORATORY
20377C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
20378C                 GAITHERSBURG, MD 20899-8980
20379C                 PHONE--301-975-2855
20380C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
20381C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
20382C     LANGUAGE--ANSI FORTRAN (1977)
20383C     VERSION NUMBER--2004/3
20384C     ORIGINAL VERSION--MARCH     2004.
20385C
20386C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
20387C
20388      CHARACTER*4 ICAPSW
20389      CHARACTER*4 ICAPTY
20390      CHARACTER*4 IHYPTY
20391      CHARACTER*4 ISUBRO
20392      CHARACTER*4 IBUGA3
20393      CHARACTER*4 IERROR
20394C
20395      CHARACTER*4 IWRITE
20396C
20397      CHARACTER*4 ISUBN1
20398      CHARACTER*4 ISUBN2
20399      CHARACTER*4 ISTEPN
20400      CHARACTER*1 IBASLC
20401C
20402C---------------------------------------------------------------------
20403C
20404      DIMENSION Y(*)
20405      DIMENSION XTEMP(*)
20406      DIMENSION ITEMP1(*)
20407      DIMENSION ITEMP2(*)
20408C
20409C---------------------------------------------------------------------
20410C
20411      INCLUDE 'DPCOP2.INC'
20412C
20413C-----START POINT-----------------------------------------------------
20414C
20415      ISUBN1='DPML'
20416      ISUBN2='HY  '
20417      IERROR='NO'
20418C
20419      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLHY')THEN
20420        WRITE(ICOUT,999)
20421  999   FORMAT(1X)
20422        CALL DPWRST('XXX','WRIT')
20423        WRITE(ICOUT,51)
20424   51   FORMAT('**** AT THE BEGINNING OF DPMLHY--')
20425        CALL DPWRST('XXX','WRIT')
20426        WRITE(ICOUT,52)IBUGA3,IHYPTY,N,MAXNXT
20427   52   FORMAT('IBUGA3,IHYPTY,MAXNXT = ',2(A4,2X),2I8)
20428        CALL DPWRST('XXX','WRIT')
20429        DO56I=1,MIN(N,100)
20430          WRITE(ICOUT,57)I,Y(I),XTEMP(I),ITEMP1(I),ITEMP2(I)
20431   57     FORMAT('I,Y(I),XTEMP(I),ITEMP1(I) = ',I8,2G15.7,2I8)
20432          CALL DPWRST('XXX','WRIT')
20433   56   CONTINUE
20434       ENDIF
20435C
20436C               ********************************************
20437C               **  STEP 11--                             **
20438C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
20439C               ********************************************
20440C
20441      ISTEPN='11'
20442      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLHY')
20443     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20444C
20445      IF(N.LT.1)THEN
20446        WRITE(ICOUT,999)
20447        CALL DPWRST('XXX','WRIT')
20448        WRITE(ICOUT,1111)
20449 1111   FORMAT('***** ERROR IN HYPERGEOMETRIC MAXIMUM ',
20450     1         'LIKELIHOOD--')
20451        CALL DPWRST('XXX','WRIT')
20452        WRITE(ICOUT,1113)
20453 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
20454     1         'FOR VARIABLE 1 IS NON-POSITIVE.')
20455        CALL DPWRST('XXX','WRIT')
20456        WRITE(ICOUT,1115)N
20457 1115   FORMAT('SAMPLE SIZE = ',I8)
20458        CALL DPWRST('XXX','WRIT')
20459        IERROR='YES'
20460        GOTO9000
20461      ENDIF
20462C
20463C               ********************************************
20464C               **  STEP 21--                             **
20465C               **  PRINT OUT PRELIMINARY INFORMATION     **
20466C               ********************************************
20467C
20468      IF(IPRINT.EQ.'ON')THEN
20469      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
20470C
20471C  STEP 2: START TABLE AND DEFINE A CAPTION
20472C
20473 5001   FORMAT('</PRE>')
20474 5011   FORMAT('<UL>')
20475 5013   FORMAT('<TABLE NOBORDER>')
20476 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
20477 5017   FORMAT('      <B>Hypergeometric  Maximum Likelihood ',
20478     1         'Estimation</B>')
20479 5019   FORMAT('   </CAPTION>')
20480        WRITE(ICOUT,5001)
20481        CALL DPWRST('XXX','WRIT')
20482        WRITE(ICOUT,999)
20483        WRITE(ICOUT,5011)
20484        CALL DPWRST('XXX','WRIT')
20485        WRITE(ICOUT,5013)
20486        CALL DPWRST('XXX','WRIT')
20487        WRITE(ICOUT,5015)
20488        CALL DPWRST('XXX','WRIT')
20489        WRITE(ICOUT,5017)
20490        CALL DPWRST('XXX','WRIT')
20491        WRITE(ICOUT,5019)
20492        CALL DPWRST('XXX','WRIT')
20493C
20494 5021   FORMAT('   <TR>')
20495 5023   FORMAT('      <TH ALIGN=CENTER VALIGN=BOTTOM WIDTH=150>')
20496 5027   FORMAT('      </TH>')
20497 5029   FORMAT('   </TR>')
20498 5031   FORMAT('         Number of<BR> Defectives<BR>in Sample')
20499 5032   FORMAT('         Number of<BR> Items<BR>in Sample')
20500 5033   FORMAT('         Number of<BR> Defectives<BR>in Population')
20501C5034   FORMAT('         Number of<BR> Defectives<BR>in Population')
20502 5035   FORMAT('         Maximum Likelihood<BR>Estimate of<BR>',
20503     1         'Defectives in Population')
20504 5036   FORMAT('         Maximum Likelihood<BR>Estimate of<BR>',
20505     1         'Population Size')
20506 5037   FORMAT('         Approximate<BR>Variance of<BR>',
20507     1         'Estimate')
20508 5038   FORMAT('      <TH COLSPAN=5>')
20509 5039   FORMAT('         <HR>')
20510C
20511        WRITE(ICOUT,5021)
20512        CALL DPWRST('XXX','WRIT')
20513        WRITE(ICOUT,5023)
20514        CALL DPWRST('XXX','WRIT')
20515        WRITE(ICOUT,5031)
20516        CALL DPWRST('XXX','WRIT')
20517        WRITE(ICOUT,5027)
20518        CALL DPWRST('XXX','WRIT')
20519        WRITE(ICOUT,5023)
20520        CALL DPWRST('XXX','WRIT')
20521        WRITE(ICOUT,5032)
20522        CALL DPWRST('XXX','WRIT')
20523        WRITE(ICOUT,5027)
20524        CALL DPWRST('XXX','WRIT')
20525        IF(IHYPTY.EQ.'ACCE')THEN
20526          WRITE(ICOUT,5023)
20527          CALL DPWRST('XXX','WRIT')
20528          WRITE(ICOUT,5033)
20529          CALL DPWRST('XXX','WRIT')
20530          WRITE(ICOUT,5027)
20531          CALL DPWRST('XXX','WRIT')
20532          WRITE(ICOUT,5023)
20533          CALL DPWRST('XXX','WRIT')
20534          WRITE(ICOUT,5035)
20535          CALL DPWRST('XXX','WRIT')
20536          WRITE(ICOUT,5027)
20537          CALL DPWRST('XXX','WRIT')
20538        ELSE
20539          WRITE(ICOUT,5023)
20540          CALL DPWRST('XXX','WRIT')
20541          WRITE(ICOUT,5033)
20542          CALL DPWRST('XXX','WRIT')
20543          WRITE(ICOUT,5027)
20544          CALL DPWRST('XXX','WRIT')
20545          WRITE(ICOUT,5023)
20546          CALL DPWRST('XXX','WRIT')
20547          WRITE(ICOUT,5036)
20548          CALL DPWRST('XXX','WRIT')
20549          WRITE(ICOUT,5027)
20550          CALL DPWRST('XXX','WRIT')
20551        ENDIF
20552        WRITE(ICOUT,5023)
20553        CALL DPWRST('XXX','WRIT')
20554        WRITE(ICOUT,5037)
20555        CALL DPWRST('XXX','WRIT')
20556        WRITE(ICOUT,5027)
20557        CALL DPWRST('XXX','WRIT')
20558C
20559        WRITE(ICOUT,5029)
20560        CALL DPWRST('XXX','WRIT')
20561C
20562        WRITE(ICOUT,5021)
20563        CALL DPWRST('XXX','WRIT')
20564        WRITE(ICOUT,5038)
20565        CALL DPWRST('XXX','WRIT')
20566        WRITE(ICOUT,5039)
20567        CALL DPWRST('XXX','WRIT')
20568        WRITE(ICOUT,5027)
20569        CALL DPWRST('XXX','WRIT')
20570        WRITE(ICOUT,5021)
20571        CALL DPWRST('XXX','WRIT')
20572C
20573      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
20574C
20575C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
20576C          AND WRITE A TABLE CAPTION
20577C
20578 8001 FORMAT(A1,'end{verbatim}')
20579 8003 FORMAT(A1,'begin{table}')
20580 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
20581 8009 FORMAT(A1,'begin{center}')
20582 8011 FORMAT(5X,'{',A1,'bf Hypergeometric Maximum Likelihood ',
20583     1       'Estimate}')
20584 8013 FORMAT(A1,'end{center}')
20585C8015 FORMAT(5X,'} ',A1,A1)
20586C
20587        CALL DPCONA(92,IBASLC)
20588C
20589        WRITE(ICOUT,8001)IBASLC
20590        CALL DPWRST('XXX','WRIT')
20591        WRITE(ICOUT,999)
20592        CALL DPWRST('XXX','WRIT')
20593        WRITE(ICOUT,8003)IBASLC
20594        CALL DPWRST('XXX','WRIT')
20595        WRITE(ICOUT,999)
20596        CALL DPWRST('XXX','WRIT')
20597        WRITE(ICOUT,8009)IBASLC
20598        CALL DPWRST('XXX','WRIT')
20599        WRITE(ICOUT,8011)IBASLC
20600        CALL DPWRST('XXX','WRIT')
20601        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
20602        CALL DPWRST('XXX','WRIT')
20603        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
20604        CALL DPWRST('XXX','WRIT')
20605        WRITE(ICOUT,8013)IBASLC
20606        CALL DPWRST('XXX','WRIT')
20607        WRITE(ICOUT,999)
20608        CALL DPWRST('XXX','WRIT')
20609C
20610C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
20611C         TABULAR ENVIRONMENT
20612C
20613 8020 FORMAT(5X,A1,'begin{tabular} {ccccc}')
20614 8021 FORMAT(5X,'Number of & Number of & Number of & ',
20615     1       'Maximum Likelihood & Approximate', 2X,A1,A1)
20616 8022 FORMAT(5X,'Defectives & Items & Items & ',
20617     1       'Estimate of & Variance of', 2X,A1,A1)
20618 8023 FORMAT(5X,'Defectives & Items & Items & ',
20619     1       'Estimate of & Variance of', 2X,A1,A1)
20620 8024 FORMAT(5X,'Defectives & Items & Defectives & ',
20621     1       'Estimate of', 2X,A1,A1)
20622 8025 FORMAT(5X,'In Sample & In Sample & In Population & ',
20623     1       'Defectives in Population & Estimate', 2X,A1,A1)
20624 8026 FORMAT(5X,'In Sample & In Sample & In Population & ',
20625     1       'Population Size & Estimate', 2X,A1,A1)
20626C8040 FORMAT(5X,A1,'hline')
20627 8049 FORMAT(A1,'end{tabular}')
20628        WRITE(ICOUT,8009)IBASLC
20629        CALL DPWRST('XXX','WRIT')
20630        WRITE(ICOUT,8020)IBASLC
20631        CALL DPWRST('XXX','WRIT')
20632        WRITE(ICOUT,8021)IBASLC,IBASLC
20633        CALL DPWRST('XXX','WRIT')
20634        WRITE(ICOUT,8022)IBASLC,IBASLC
20635        CALL DPWRST('XXX','WRIT')
20636        IF(IHYPTY.EQ.'ACCE')THEN
20637          WRITE(ICOUT,8023)IBASLC,IBASLC
20638          CALL DPWRST('XXX','WRIT')
20639          WRITE(ICOUT,8025)IBASLC,IBASLC
20640          CALL DPWRST('XXX','WRIT')
20641        ELSE
20642          WRITE(ICOUT,8024)IBASLC,IBASLC
20643          CALL DPWRST('XXX','WRIT')
20644          WRITE(ICOUT,8026)IBASLC,IBASLC
20645          CALL DPWRST('XXX','WRIT')
20646        ENDIF
20647        WRITE(ICOUT,8049)IBASLC
20648        CALL DPWRST('XXX','WRIT')
20649      ELSE
20650        WRITE(ICOUT,999)
20651        CALL DPWRST('XXX','WRIT')
20652        WRITE(ICOUT,4301)
20653 4301   FORMAT('HYPERGEOMETRIC MAXIMUM LIKELIHOOD ESTIMATION:')
20654        CALL DPWRST('XXX','WRIT')
20655C
20656        WRITE(ICOUT,999)
20657        CALL DPWRST('XXX','WRIT')
20658        WRITE(ICOUT,4311)
20659 4311   FORMAT('NUMBER OF      NUMBER OF     NUMBER OF    ',
20660     1         '   MAXIMUM LIKELIHOOD         APPROXIMATE')
20661        CALL DPWRST('XXX','WRIT')
20662        IF(IHYPTY.EQ.'ACCE')THEN
20663          WRITE(ICOUT,4313)
20664 4313   FORMAT('DEFECTIVES     ITEMS         ITEMS        ',
20665     1         '   ESTIMATE OF                VARIANCE OF')
20666          CALL DPWRST('XXX','WRIT')
20667          WRITE(ICOUT,4315)
20668 4315   FORMAT('IN SAMPLE      IN SAMPLE     IN POPULATION',
20669     1         '   DEFECTIVES IN POPULATION   ESTIMATE')
20670          CALL DPWRST('XXX','WRIT')
20671        ELSE
20672          WRITE(ICOUT,4323)
20673 4323   FORMAT('DEFECTIVES     ITEMS         DEFECTIVES   ',
20674     1         '   ESTIMATE OF                VARIANCE OF')
20675          CALL DPWRST('XXX','WRIT')
20676          WRITE(ICOUT,4325)
20677 4325   FORMAT('IN SAMPLE      IN SAMPLE     IN POPULATION',
20678     1         '   POPULATION SIZE            ESTIMATE')
20679          CALL DPWRST('XXX','WRIT')
20680        ENDIF
20681        WRITE(ICOUT,4331)
20682 4331   FORMAT('------------------------------------------',
20683     1         '-----------------------------------------')
20684        CALL DPWRST('XXX','WRIT')
20685C
20686      ENDIF
20687      ENDIF
20688C
20689C               ****************************************
20690C               **  STEP 41--                         **
20691C               **  CARRY OUT CALCULATIONS            **
20692C               **  FOR HYPERGEOMETRIC MLE ESTIMATE   **
20693C               ****************************************
20694C
20695      ISTEPN='41'
20696      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLHY')
20697     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20698C
20699      IERROR='NO'
20700      IWRITE='OFF'
20701C
20702      DO1405I=1,N
20703        ITEMP=INT(Y(I)+0.5)
20704        Y(I)=REAL(ITEMP)
20705        IF(ITEMP.LT.0)THEN
20706          WRITE(ICOUT,999)
20707          CALL DPWRST('XXX','WRIT')
20708          WRITE(ICOUT,1411)
20709 1411     FORMAT('***** ERROR FROM HYPERGEOMETRIC MAXIMUM ',
20710     1           'LIKELIHOOD--')
20711          CALL DPWRST('XXX','WRIT')
20712          WRITE(ICOUT,1413)
20713 1413     FORMAT('      NEGATIVE VALUE ENCOUNTERED FOR NUMBER OF ',
20714     1           'DEFECTIVES.')
20715          CALL DPWRST('XXX','WRIT')
20716          IERROR='YES'
20717          GOTO9000
20718        ELSEIF(ITEMP1(I).LT.1)THEN
20719          WRITE(ICOUT,999)
20720          CALL DPWRST('XXX','WRIT')
20721          WRITE(ICOUT,1421)
20722 1421     FORMAT('***** ERROR FROM HYPERGEOMETRIC MAXIMUM ',
20723     1           'LIKELIHOOD--')
20724          CALL DPWRST('XXX','WRIT')
20725          WRITE(ICOUT,1423)
20726 1423     FORMAT('      NON-POSITIVE VALUE ENCOUNTERED IN SECOND ',
20727     1           'RESPONSE VARIABLE.')
20728          CALL DPWRST('XXX','WRIT')
20729          IERROR='YES'
20730          GOTO9000
20731        ELSEIF(ITEMP2(I).LT.1)THEN
20732          WRITE(ICOUT,999)
20733          CALL DPWRST('XXX','WRIT')
20734          WRITE(ICOUT,1431)
20735 1431     FORMAT('***** ERROR FROM HYPERGEOMETRIC MAXIMUM ',
20736     1           'LIKELIHOOD--')
20737          CALL DPWRST('XXX','WRIT')
20738          WRITE(ICOUT,1433)
20739 1433     FORMAT('      NON-POSITIVE VALUE ENCOUNTERED IN THIRD ',
20740     1           'RESPONSE VARIABLE.')
20741          CALL DPWRST('XXX','WRIT')
20742          IERROR='YES'
20743          GOTO9000
20744        ENDIF
20745 1405 CONTINUE
20746      IERROR='NO'
20747      IWRITE='OFF'
20748C
20749      IF(IHYPTY.EQ.'ACCE')THEN
20750        DO2010I=1,N
20751          IX=INT(Y(I)+0.1)
20752          NSAMP=ITEMP1(I)
20753          NPOP=ITEMP2(I)
20754          ANSAMP=REAL(NSAMP)
20755          ANPOP=REAL(NPOP)
20756          AX=REAL(IX)
20757          AK=AX*(ANPOP+1.0)/ANSAMP
20758          K=INT(AK)
20759          AK=REAL(K)
20760          AP=AK/ANPOP
20761          AVAR=(ANPOP+1.0)**2*(ANPOP-ANSAMP)*AP*(1.0-AP)/
20762     1         (ANSAMP*(ANPOP-1.0))
20763          IF(IPRINT.EQ.'ON')THEN
20764          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
20765C
20766C  STEP 4: DEFINE DATA ROW
20767C
20768 5041       FORMAT('   <TR>')
20769 5043       FORMAT('      <TD ALIGN=CENTER VALIGN=BOTTOM WIDTH=150>')
20770 5047       FORMAT('      </TD>')
20771 5053       FORMAT('         ',I8)
20772 5055       FORMAT('         ',E15.7)
20773 5059       FORMAT('   </TR>')
20774C
20775            WRITE(ICOUT,5041)
20776            CALL DPWRST('XXX','WRIT')
20777            WRITE(ICOUT,5043)
20778            CALL DPWRST('XXX','WRIT')
20779            WRITE(ICOUT,5053)IX
20780            CALL DPWRST('XXX','WRIT')
20781            WRITE(ICOUT,5047)
20782            CALL DPWRST('XXX','WRIT')
20783            WRITE(ICOUT,5043)
20784            CALL DPWRST('XXX','WRIT')
20785            WRITE(ICOUT,5053)NSAMP
20786            CALL DPWRST('XXX','WRIT')
20787            WRITE(ICOUT,5047)
20788            CALL DPWRST('XXX','WRIT')
20789            WRITE(ICOUT,5043)
20790            CALL DPWRST('XXX','WRIT')
20791            WRITE(ICOUT,5053)NPOP
20792            CALL DPWRST('XXX','WRIT')
20793            WRITE(ICOUT,5047)
20794            CALL DPWRST('XXX','WRIT')
20795            WRITE(ICOUT,5043)
20796            CALL DPWRST('XXX','WRIT')
20797            WRITE(ICOUT,5053)K
20798            CALL DPWRST('XXX','WRIT')
20799            WRITE(ICOUT,5047)
20800            CALL DPWRST('XXX','WRIT')
20801            WRITE(ICOUT,5043)
20802            CALL DPWRST('XXX','WRIT')
20803            WRITE(ICOUT,5055)AVAR
20804            CALL DPWRST('XXX','WRIT')
20805            WRITE(ICOUT,5047)
20806            CALL DPWRST('XXX','WRIT')
20807            WRITE(ICOUT,5059)
20808            CALL DPWRST('XXX','WRIT')
20809C
20810          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
20811 8031       FORMAT(5X,I8,' & ',I8,' & ',I8,' & ',I8,' & ',G15.7,
20812     1             2X,A1,A1)
20813            WRITE(ICOUT,8031)IX,NSAMP,NPOP,K,AVAR,IBASLC,IBASLC
20814            CALL DPWRST('XXX','WRIT')
20815          ELSE
20816            WRITE(ICOUT,4351)IX,NSAMP,NPOP,K,AVAR
20817            WRITE(IOUNI1,4352)IX,NSAMP,NPOP,K,AVAR
20818 4351       FORMAT(I8,5X,I8,9X,I8,10X,I8,12X,E15.7)
20819 4352       FORMAT(4(I8,2X),E15.7)
20820            CALL DPWRST('XXX','WRIT')
20821          ENDIF
20822          ENDIF
20823 2010   CONTINUE
20824      ELSE
20825        DO2610I=1,N
20826          IX=INT(Y(I))
20827          NSAMP=ITEMP1(I)
20828          NK=ITEMP2(I)
20829          ANSAMP=REAL(NSAMP)
20830          AK=REAL(NK)
20831          AX=REAL(IX)
20832CCCCC     AN=REAL(NSAMP)*REAL(NK)/REAL(IX)
20833          AN=((ANSAMP+1.0)*(AK+1.0)/(AX+1.0)) - 1.0
20834          NPOP=INT(AN)
20835          AN=NPOP
20836          AM=ANSAMP*AK/AN
20837          TERM1=(AM**(-1) + 2.0*AM**(-2) + 6.0*AN**(-3))
20838          AVAR=AN**2*TERM1
20839          IF(IPRINT.EQ.'ON')THEN
20840          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
20841C
20842C  STEP 4: DEFINE DATA ROW
20843C
20844            WRITE(ICOUT,5041)
20845            CALL DPWRST('XXX','WRIT')
20846            WRITE(ICOUT,5043)
20847            CALL DPWRST('XXX','WRIT')
20848            WRITE(ICOUT,5053)IX
20849            CALL DPWRST('XXX','WRIT')
20850            WRITE(ICOUT,5047)
20851            CALL DPWRST('XXX','WRIT')
20852            WRITE(ICOUT,5043)
20853            CALL DPWRST('XXX','WRIT')
20854            WRITE(ICOUT,5053)NSAMP
20855            CALL DPWRST('XXX','WRIT')
20856            WRITE(ICOUT,5047)
20857            CALL DPWRST('XXX','WRIT')
20858            WRITE(ICOUT,5043)
20859            CALL DPWRST('XXX','WRIT')
20860            WRITE(ICOUT,5053)NK
20861            CALL DPWRST('XXX','WRIT')
20862            WRITE(ICOUT,5047)
20863            CALL DPWRST('XXX','WRIT')
20864            WRITE(ICOUT,5043)
20865            CALL DPWRST('XXX','WRIT')
20866            WRITE(ICOUT,5053)NPOP
20867            CALL DPWRST('XXX','WRIT')
20868            WRITE(ICOUT,5047)
20869            CALL DPWRST('XXX','WRIT')
20870            WRITE(ICOUT,5043)
20871            CALL DPWRST('XXX','WRIT')
20872            WRITE(ICOUT,5055)AVAR
20873            CALL DPWRST('XXX','WRIT')
20874            WRITE(ICOUT,5047)
20875            CALL DPWRST('XXX','WRIT')
20876            WRITE(ICOUT,5059)
20877            CALL DPWRST('XXX','WRIT')
20878C
20879          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
20880            WRITE(ICOUT,8031)IX,NSAMP,NK,NPOP,AVAR,IBASLC,IBASLC
20881            CALL DPWRST('XXX','WRIT')
20882          ELSE
20883            WRITE(ICOUT,4351)IX,NSAMP,NK,NPOP,AVAR
20884            CALL DPWRST('XXX','WRIT')
20885            WRITE(IOUNI1,4352)IX,NSAMP,NK,NPOP,AVAR
20886          ENDIF
20887          ENDIF
20888 2610   CONTINUE
20889      ENDIF
20890C
20891C               ******************************************
20892C               **   STEP 42--                          **
20893C               **   CLOSE OUT TABLES                   **
20894C               ******************************************
20895C
20896      ISTEPN='42'
20897      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLHY')
20898     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20899C
20900      IF(IPRINT.EQ.'ON')THEN
20901      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
20902C
20903C  STEP 4: END THE TABLE AND RESET ASIS MODE
20904C
20905 5091   FORMAT('</TABLE>')
20906 5093   FORMAT('</UL>')
20907 5099   FORMAT('<PRE>')
20908        WRITE(ICOUT,5091)
20909        CALL DPWRST('XXX','WRIT')
20910        WRITE(ICOUT,5093)
20911        CALL DPWRST('XXX','WRIT')
20912        WRITE(ICOUT,999)
20913        CALL DPWRST('XXX','WRIT')
20914        WRITE(ICOUT,5099)
20915        CALL DPWRST('XXX','WRIT')
20916C
20917      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
20918C
20919C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
20920C
20921 8091 FORMAT(A1,'end{center}')
20922 8093 FORMAT(A1,'end{table}')
20923 8099 FORMAT(A1,'begin{verbatim}')
20924        WRITE(ICOUT,8091)IBASLC
20925        CALL DPWRST('XXX','WRIT')
20926        WRITE(ICOUT,8093)IBASLC
20927        CALL DPWRST('XXX','WRIT')
20928        WRITE(ICOUT,999)
20929        CALL DPWRST('XXX','WRIT')
20930        WRITE(ICOUT,8099)IBASLC
20931        CALL DPWRST('XXX','WRIT')
20932      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
20933      ELSE
20934        WRITE(ICOUT,999)
20935        CALL DPWRST('XXX','BUG ')
20936C
20937      ENDIF
20938      ENDIF
20939C
20940C               *****************
20941C               **  STEP 90--  **
20942C               **  EXIT       **
20943C               *****************
20944C
20945 9000 CONTINUE
20946      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLHY')THEN
20947        WRITE(ICOUT,999)
20948        CALL DPWRST('XXX','WRIT')
20949        WRITE(ICOUT,9011)
20950 9011   FORMAT('***** AT THE END       OF DPMLHY--')
20951        CALL DPWRST('XXX','WRIT')
20952        WRITE(ICOUT,9012)N,IBUGA3,IERROR
20953 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
20954        CALL DPWRST('XXX','WRIT')
20955        WRITE(ICOUT,9015)N
20956 9015   FORMAT('N = ',I8)
20957        CALL DPWRST('XXX','WRIT')
20958      ENDIF
20959C
20960      RETURN
20961      END
20962      SUBROUTINE DPMLIG(Y,XLOW,XHIGH,N,NUMVAR,ICASAN,
20963     1                  XTEMP,XTEMP2,XTEMP3,DTEMP,ITEMP,MAXNXT,
20964     1                  ALOCML,SIGMML,AMUML,GAMMML,
20965     1                  ALOCSE,SIGMSE,AMUSE,GAMMSE,
20966     1                  ALOCMM,SIGMMM,AMUMM,GAMMMM,
20967     1                  ALOCMO,SIGMMO,AMUMO,GAMMMO,
20968     1                  AICML,AICCML,BICML,ALIKML,
20969     1                  AICMM,AICCMM,BICMM,ALIKMM,
20970     1                  AICMO,AICCMO,BICMO,ALIKMO,
20971     1                  ICAPSW,ICAPTY,IFORSW,
20972     1                  QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
20973     1                  ALPHAP,
20974     1                  ISUBRO,IBUGA3,IERROR)
20975C
20976C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
20977C              FOR EITHER THE 2-PARAMETER INVERSE GAUSSIAN OR THE
20978C              3-PARAMETER INVESE GAUSSIAN DISTRIBUTION FOR THE FULL
20979C              SAMPLE CASE.
20980C     EXAMPLE--3-PARAMETER INVERSE GAUSSIAN MAXIMUM LIKELIHOOD Y
20981C     REFERENCE--COHEN AND WHITTEN (1988), "PARAMETER ESTIMATION IN
20982C                RELIABILITY AND LIFE SPAN MODELS", MARCEL DEKKER, INC.,
20983C                CHAPTER 5.
20984C     WRITTEN BY--ALAN HECKERT
20985C                 STATISTICAL ENGINEERING DIVISION
20986C                 INFORMATION TECHNOLOGY LABORATORY
20987C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
20988C                 GAITHERSBURG, MD 20899-8980
20989C                 PHONE--301-975-2899
20990C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
20991C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
20992C     LANGUAGE--ANSI FORTRAN (1977)
20993C     VERSION NUMBER--2014/4
20994C     ORIGINAL VERSION--APRIL     2014.
20995C
20996C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
20997C
20998      CHARACTER*4 ICASAN
20999      CHARACTER*4 ICAPSW
21000      CHARACTER*4 ICAPTY
21001      CHARACTER*4 IFORSW
21002      CHARACTER*4 ISUBRO
21003      CHARACTER*4 IBUGA3
21004      CHARACTER*4 IERROR
21005C
21006      CHARACTER*4 IWRITE
21007      CHARACTER*4 ISUBN1
21008      CHARACTER*4 ISUBN2
21009      CHARACTER*4 ISTEPN
21010      CHARACTER*4 ILIKFL
21011CCCCC CHARACTER*4 ICASPL
21012CCCCC CHARACTER*7 ICASE
21013      CHARACTER*40 IDIST
21014      CHARACTER*8 ISHAP1
21015      CHARACTER*8 ISHAP2
21016      CHARACTER*4 ILOCFL
21017      CHARACTER*4 ISCAFL
21018C
21019C---------------------------------------------------------------------
21020C
21021      PARAMETER (NUMALP=8)
21022      DIMENSION ALPHA(NUMALP)
21023      DIMENSION ALOWLO(NUMALP)
21024      DIMENSION AUPPLO(NUMALP)
21025      DIMENSION ALOWSC(NUMALP)
21026      DIMENSION AUPPSC(NUMALP)
21027      DIMENSION ALOWSI(NUMALP)
21028      DIMENSION AUPPSI(NUMALP)
21029      DIMENSION ALOWMU(NUMALP)
21030      DIMENSION AUPPMU(NUMALP)
21031      DIMENSION ALOWGA(NUMALP)
21032      DIMENSION AUPPGA(NUMALP)
21033C
21034      DIMENSION Y(*)
21035      DIMENSION XLOW(*)
21036      DIMENSION XHIGH(*)
21037      DIMENSION XTEMP(*)
21038      DIMENSION XTEMP2(*)
21039      DIMENSION XTEMP3(*)
21040      DIMENSION QP(*)
21041      DIMENSION XQPHAT(*)
21042      DIMENSION XQPSE(*)
21043      DIMENSION XQPLCL(*)
21044      DIMENSION XQPUCL(*)
21045      INTEGER   ITEMP(*)
21046      DOUBLE PRECISION DTEMP(*)
21047C
21048      INCLUDE 'DPCOST.INC'
21049C
21050      DIMENSION COV(3,3)
21051CCCCC DIMENSION COVMM(3,3)
21052CCCCC DOUBLE PRECISION D(3)
21053C
21054CCCCC DOUBLE PRECISION DSIGMA
21055CCCCC DOUBLE PRECISION DS
21056CCCCC DOUBLE PRECISION DLOC
21057CCCCC DOUBLE PRECISION DZQ
21058      DOUBLE PRECISION DTERM1
21059CCCCC DOUBLE PRECISION DVAR
21060      DOUBLE PRECISION DPPF
21061      DOUBLE PRECISION DW
21062      DOUBLE PRECISION DX
21063C
21064      PARAMETER (MAXROW=50)
21065      CHARACTER*60 ITITLE
21066      CHARACTER*60 ITITLZ
21067      CHARACTER*40 ITEXT(MAXROW)
21068      REAL         AVALUE(MAXROW)
21069      INTEGER      NCTEXT(MAXROW)
21070      INTEGER      IDIGIT(MAXROW)
21071      INTEGER      NTOT(MAXROW)
21072      LOGICAL IFRST
21073      LOGICAL ILAST
21074C
21075C---------------------------------------------------------------------
21076C
21077      INCLUDE 'DPCOP2.INC'
21078C
21079      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
21080C
21081C-----START POINT-----------------------------------------------------
21082C
21083      ISUBN1='DPML'
21084      ISUBN2='IG  '
21085      IDIST='INVERSE GAUSSIAN'
21086      IERROR='NO'
21087      IFLAG1=0
21088      IFLAG2=0
21089C
21090      ALOCML=CPUMIN
21091      ALOCM3=CPUMIN
21092      ALOCS2=CPUMIN
21093      ALOCS3=CPUMIN
21094      AMUML=CPUMIN
21095      SIGMML=CPUMIN
21096      GAMMML=CPUMIN
21097      ALOCMO=CPUMIN
21098      AMUMO=CPUMIN
21099      SIGMMO=CPUMIN
21100      SIGMM3=CPUMIN
21101      SIGMS2=CPUMIN
21102      SIGMS3=CPUMIN
21103      GAMMMO=CPUMIN
21104      GAMMM3=CPUMIN
21105      GAMMS2=CPUMIN
21106      GAMMS3=CPUMIN
21107      ALOCMM=CPUMIN
21108      AMUMM=CPUMIN
21109      SIGMMM=CPUMIN
21110      GAMMMM=CPUMIN
21111      ALOCSE=CPUMIN
21112      SIGMSE=CPUMIN
21113      GAMMSE=CPUMIN
21114      AMUSE=CPUMIN
21115      AMUS2=CPUMIN
21116      AMUS3=CPUMIN
21117      ALIKML=CPUMIN
21118      AICML=CPUMIN
21119      BICML=CPUMIN
21120      AICCML=CPUMIN
21121      ALIKMM=CPUMIN
21122      AICMM=CPUMIN
21123      BICMM=CPUMIN
21124      AICCMM=CPUMIN
21125      ALIKMO=CPUMIN
21126      AICMO=CPUMIN
21127      BICMO=CPUMIN
21128      AICCMO=CPUMIN
21129      DSUM=0.0D0
21130      COVMUS=CPUMIN
21131C
21132      DO11I=1,MAXNXT
21133        DTEMP(I)=0.0D0
21134        QP(I)=CPUMIN
21135        XQPHAT(I)=CPUMIN
21136        XQPHAT(I)=CPUMIN
21137        XQPLCL(I)=CPUMIN
21138        XQPUCL(I)=CPUMIN
21139        XQPSE(I)=CPUMIN
21140   11 CONTINUE
21141C
21142      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLIG')THEN
21143        WRITE(ICOUT,999)
21144  999   FORMAT(1X)
21145        CALL DPWRST('XXX','WRIT')
21146        WRITE(ICOUT,51)
21147   51   FORMAT('**** AT THE BEGINNING OF DPMLIG--')
21148        CALL DPWRST('XXX','WRIT')
21149        WRITE(ICOUT,52)IBUGA3,ISUBRO,ICASAN,N,NUMVAR,NPERC
21150   52   FORMAT('IBUGA3,ISUBRO,ICASAN,N,NUMVAR,NPERC = ',3(A4,2X),3I8)
21151        CALL DPWRST('XXX','WRIT')
21152        DO56I=1,MIN(N,100)
21153          WRITE(ICOUT,57)I,Y(I),XLOW(I),XHIGH(I)
21154   57     FORMAT('I,Y(I),XLOW(I),XHIGH(I) = ',I8,3G15.7)
21155          CALL DPWRST('XXX','WRIT')
21156   56   CONTINUE
21157      ENDIF
21158C
21159C               ********************************************
21160C               **  STEP 11--                             **
21161C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
21162C               ********************************************
21163C
21164      ISTEPN='11'
21165      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLIG')
21166     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
21167C
21168C     STEP 1: OBTAIN POINT ESTIMATES AND STANDARD ERRORS
21169C
21170      IFLAG1=0
21171      IFLAG2=0
21172C
21173      IFLAG=0
21174      IF(ICASAN.EQ.'2IGA')IFLAG=1
21175      IDIST='INVERSE GAUSSIAN'
21176      IWRITE='OFF'
21177      NPERC=0
21178      MAXGRP=MAXNXT/2
21179C
21180      IF(NUMVAR.EQ.1)THEN
21181        NMIN=5
21182        CALL CKDIST(Y,N,NMIN,XTEMP,NPERC,ISUBRO,IBUGA3,IERROR)
21183        IF(IERROR.EQ.'YES')GOTO9000
21184        CALL SUMRAW(Y,N,IDIST,IFLAG,
21185     1              XMEAN,XVAR,XSD,XMIN,XMAX,
21186     1              ISUBRO,IBUGA3,IERROR)
21187        IF(IERROR.EQ.'YES')GOTO9000
21188        CALL STMOM3(Y,N,IWRITE,XSKEW,IBUGA3,IERROR)
21189        NTOTZZ=N
21190      ELSEIF(NUMVAR.EQ.2)THEN
21191        NMIN=3
21192        CALL CKDIS2(Y,XLOW,XTEMP,N,MAXGRP,NMIN,XTEMP2,NPERC,NTOT2,
21193     1              ISUBRO,IBUGA3,IERROR)
21194        IF(IERROR.EQ.'YES')GOTO9000
21195        IFLAG1=1
21196        IFLAG2=1
21197        CALL SUMGRP(Y,XLOW,N,IDIST,IFLAG1,IFLAG2,
21198     1              XTEMP,XTEMP2,XTEMP3,MAXNXT,
21199     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
21200     1              ISUBRO,IBUGA3,IERROR)
21201        IF(IERROR.EQ.'YES')GOTO9000
21202        CALL WESKEW(XLOW,Y,N,IWRITE,XSKEW,
21203     1              IBUGA3,ISUBRO,IERROR)
21204C
21205      ELSEIF(NUMVAR.EQ.3)THEN
21206        CALL CKDIS3(Y,XLOW,XHIGH,
21207     1              XTEMP,N,MAXGRP,NMIN,XTEMP2,NPERC,NTOT2,
21208     1              ISUBRO,IBUGA3,IERROR)
21209        IF(IERROR.EQ.'YES')GOTO9000
21210        IFLAG1=1
21211        IFLAG2=1
21212        CALL SUMGR2(Y,XLOW,XHIGH,N,IDIST,IFLAG1,IFLAG2,
21213     1              XTEMP,XTEMP2,XTEMP3,MAXNXT,
21214     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
21215     1              ISUBRO,IBUGA3,IERROR)
21216        IF(IERROR.EQ.'YES')GOTO9000
21217        CALL WESKE2(XLOW,XHIGH,Y,N,IWRITE,XSKEW,
21218     1              IBUGA3,ISUBRO,IERROR)
21219C
21220      ELSE
21221        WRITE(ICOUT,999)
21222        CALL DPWRST('XXX','WRIT')
21223        WRITE(ICOUT,111)
21224  111   FORMAT('***** ERROR IN INVERSE GAUSSIAN MAXIMUM LIKELIHOOD--')
21225        CALL DPWRST('XXX','WRIT')
21226        WRITE(ICOUT,390)
21227  390   FORMAT('      MORE THAN THREE VARIABLES WERE SPECIFIED.')
21228        CALL DPWRST('XXX','WRIT')
21229        IERROR='YES'
21230        GOTO9000
21231      ENDIF
21232C
21233      IF(ICASAN.EQ.'2IGA')THEN
21234        ALOCML=0.0
21235        AMUML=XMEAN
21236        DSUM=0.0D0
21237        IF(NUMVAR.EQ.1)THEN
21238          DO120I=1,N
21239            DSUM=DSUM + (1.0D0/DBLE(Y(I)) - 1.0D0/DBLE(XMEAN))
21240  120     CONTINUE
21241          GAMMML=REAL(DBLE(N)/DSUM)
21242          SIGMML=SQRT(AMUML**3/GAMMML)
21243          CALL IGLI1(Y,N,ICASAN,ALOCML,AMUML,GAMMML,
21244     1               ALIKML,AICML,AICCML,BICML,
21245     1               ISUBRO,IBUGA3,IERROR)
21246        ELSEIF(NUMVAR.EQ.2)THEN
21247          DSUM=0.0D0
21248          DO125I=1,N
21249            DW=DBLE(Y(I))
21250            DX=DBLE(XLOW(I))
21251            DTERM1=DW*((1.0D0/DX) - (1.0D0/DBLE(XMEAN)))
21252            DSUM=DSUM + DTERM1
21253  125     CONTINUE
21254          GAMMML=REAL(DBLE(NTOTZZ)/DSUM)
21255          SIGMML=SQRT(AMUML**3/GAMMML)
21256          ALOCML=0.0
21257          CALL IGLI2(Y,XLOW,N,NTOTZZ,ICASAN,ALOCML,AMUML,GAMMML,
21258     1               ALIKML,AICML,AICCML,BICML,
21259     1               ISUBRO,IBUGA3,IERROR)
21260        ELSEIF(NUMVAR.EQ.3)THEN
21261          DSUM=0.0D0
21262          DO128I=1,N
21263            DW=DBLE(Y(I))
21264            DX=(DBLE(XLOW(I)) + DBLE(XHIGH(I)))/2.0D0
21265            DTERM1=DW*((1.0D0/DX) - (1.0D0/DBLE(XMEAN)))
21266            DSUM=DSUM + DTERM1
21267  128     CONTINUE
21268          GAMMML=REAL(DBLE(NTOTZZ)/DSUM)
21269          SIGMML=SQRT(AMUML**3/GAMMML)
21270          ALOCML=0.0
21271        ENDIF
21272C
21273C       COMPUTE STANDARD ERRORS/COVARIANCE MATRIX
21274C
21275        AN=REAL(NTOTZZ)
21276        IF(IGAUDF.EQ.'CHAN')THEN
21277          ALOCSE=0.0
21278          A3=3.0*SIGMML
21279          AMUVAR=SIGMML**2/AN
21280          AMUSE=SQRT(AMUVAR)
21281          SIGMVA=(SIGMML**2/(2.0*AN))*((A3**2/2.0) + 1.0)
21282          SIGMSE=SQRT(SIGMVA)
21283          COVMUS=(SIGMML**2/(2.0*AN))*A3
21284          COV(1,1)=AMUVAR
21285          COV(2,2)=SIGMVA
21286          COV(1,2)=COVMUS
21287        ELSE
21288          CALL IGML5(ALOCML,AMUML,SIGMML,GAMMML,NTOTZZ,ICASAN,
21289     1               IGAUDF,COV,
21290     1               XTEMP,ITEMP,MAXNXT,
21291     1               ISUBRO,IBUGA3,IERROR)
21292          COV(1,1)=COV(2,2)
21293          COV(2,2)=COV(3,3)
21294          COV(1,2)=COV(2,3)
21295          COV(2,1)=COV(1,2)
21296          ALOCSE=0.0
21297          AMUSE=SQRT(COV(1,1)/AN)
21298          GAMMSE=SQRT(COV(2,2)/AN)
21299        ENDIF
21300C
21301C       MOMENT ESTIMATES
21302C
21303        AMUMO=XMEAN
21304        SIGMMO=XSD
21305        GAMMMO=AMUMO**3/SIGMMO**2
21306        ALOCMO=0.0
21307        IF(NUMVAR.EQ.1)THEN
21308          CALL IGLI1(Y,N,ICASAN,ALOCMO,AMUMO,GAMMMO,
21309     1               ALIKMO,AICMO,AICCMO,BICMO,
21310     1               ISUBRO,IBUGA3,IERROR)
21311        ELSEIF(NUMVAR.EQ.2)THEN
21312          CALL IGLI2(Y,XLOW,N,NTOTZZ,ICASAN,ALOCMO,AMUMO,GAMMMO,
21313     1               ALIKMO,AICMO,AICCMO,BICMO,
21314     1               ISUBRO,IBUGA3,IERROR)
21315        ENDIF
21316C
21317      ELSEIF(ICASAN.EQ.'3IGA')THEN
21318        CALL IGMO1(XMEAN,XSD,XMIN,XSKEW,NTOTZZ,PSTAMV,
21319     1             ALOCMO,AMUMO,SIGMMO,GAMMMO,
21320     1             ALOCMM,AMUMM,SIGMMM,GAMMMM,
21321     1             ISUBRO,IBUGA3,IERROR)
21322C
21323        IF(AMUMO.GT.0.0 .AND. GAMMMO.GT.0.0 .AND.NUMVAR.EQ.1)THEN
21324          IF(NUMVAR.EQ.1)THEN
21325            CALL IGLI1(Y,N,ICASAN,ALOCMO,AMUMO,GAMMMO,
21326     1                 ALIKMO,AICMO,AICCMO,BICMO,
21327     1                 ISUBRO,IBUGA3,IERROR)
21328          ELSEIF(NUMVAR.EQ.2)THEN
21329            CALL IGLI2(Y,XLOW,N,NTOTZZ,ICASAN,ALOCMO,AMUMO,GAMMMO,
21330     1                 ALIKMO,AICMO,AICCMO,BICMO,
21331     1                 ISUBRO,IBUGA3,IERROR)
21332          ENDIF
21333        ENDIF
21334C
21335        IF(AMUMM.GT.0.0 .AND. GAMMMM.GT.0.0)THEN
21336          IF(NUMVAR.EQ.1)THEN
21337            CALL IGLI1(Y,N,ICASAN,ALOCMM,AMUMM,GAMMMM,
21338     1                 ALIKMM,AICMM,AICCMM,BICMM,
21339     1                 ISUBRO,IBUGA3,IERROR)
21340          ELSEIF(NUMVAR.EQ.2)THEN
21341            CALL IGLI2(Y,XLOW,N,NTOTZZ,ICASAN,ALOCMM,AMUMM,GAMMMM,
21342     1                 ALIKMM,AICMM,AICCMM,BICMM,
21343     1                 ISUBRO,IBUGA3,IERROR)
21344          ENDIF
21345          CALL IGML5(ALOCMM,AMUMM,SIGMMM,GAMMMM,NTOTZZ,ICASAN,
21346     1               IGAUDF,COV,
21347     1               XTEMP,ITEMP,MAXNXT,
21348     1               ISUBRO,IBUGA3,IERROR)
21349          IF(COV(1,1).GE.0.0 .AND. COV(2,2).GE.0.0 .AND.
21350     1       COV(3,3).GE.0.0)THEN
21351             AN=REAL(NTOTZZ)
21352             IF(IGAUDF.EQ.'CHAN')THEN
21353               ALOCS2=SQRT(COV(1,1))
21354               AMUS2=SQRT(COV(2,2))
21355               SIGMS2=SQRT(COV(3,3))
21356             ELSE
21357               ALOCS2=SQRT(COV(1,1)/AN)
21358               AMUS2=SQRT(COV(2,2)/AN)
21359               GAMMS2=SQRT(COV(3,3)/AN)
21360             ENDIF
21361          ELSE
21362             ALOCS2=CPUMIN
21363             AMUS2=CPUMIN
21364             SIGMS2=CPUMIN
21365             GAMMS2=CPUMIN
21366          ENDIF
21367        ENDIF
21368C
21369        IF(NUMVAR.EQ.1)THEN
21370          CALL IGML1(Y,N,PSTAMV,
21371     1               XMEAN,XSD,XMIN,XSKEW,
21372     1               ALOCML,AMUML,SIGMML,GAMMML,
21373     1               ISUBRO,IBUGA3,IERROR)
21374          IF(AMUML.GT.0.0 .AND.GAMMML.GT.0.0)THEN
21375            CALL IGLI1(Y,N,ICASAN,ALOCML,AMUML,GAMMML,
21376     1                 ALIKML,AICML,AICCML,BICML,
21377     1                 ISUBRO,IBUGA3,IERROR)
21378          ENDIF
21379C
21380C         USER CAN OPTIONALLY SPECIFY WHETHER MODIFIED MOMENT OR
21381C         MAXIMUM LIKELIHOOD ESTIMATE WILL BE USED FOR CONFIDENCE
21382C         INTERVAL.
21383C
21384          IF(IGAUME.EQ.'MLE')THEN
21385            CALL IGML5(ALOCML,AMUML,SIGMML,GAMMML,NTOTZZ,ICASAN,
21386     1                 IGAUDF,COV,
21387     1                 XTEMP,ITEMP,MAXNXT,
21388     1                 ISUBRO,IBUGA3,IERROR)
21389            IF(COV(1,1).GE.0.0 .AND. COV(2,2).GE.0.0 .AND.
21390     1         COV(3,3).GE.0.0)THEN
21391               AN=REAL(NTOTZZ)
21392               IF(IGAUDF.EQ.'CHAN')THEN
21393                 ALOCSE=SQRT(COV(1,1))
21394                 AMUSE=SQRT(COV(2,2))
21395                 SIGMSE=SQRT(COV(3,3))
21396               ELSE
21397                 ALOCSE=SQRT(COV(1,1)/AN)
21398                 AMUSE=SQRT(COV(2,2)/AN)
21399                 GAMMSE=SQRT(COV(3,3)/AN)
21400               ENDIF
21401            ELSE
21402              ALOCSE=CPUMIN
21403              AMUSE=CPUMIN
21404              SIGMSE=CPUMIN
21405              GAMMSE=CPUMIN
21406            ENDIF
21407          ENDIF
21408        ENDIF
21409      ENDIF
21410C
21411C     STEP 2: CONFIDENCE INTERVALS FOR PARAMETERS BASED ON
21412C             NORMAL APPROXIMATION.
21413C
21414C             USE ML STANDARD ERRORS IF THEY EXIST.  OTHERWISE,
21415C             USE MODIFIED MOMENT STANDARD ERRORS.
21416C
21417C             USER CAN SELECT WHETHER CONFIDENCE INTERVALS WILL BE BASED
21418C             ON ML ESTIMATES OR MODIFIED MOMENT ESTIMATES.
21419C
21420      IF(ICASAN.EQ.'2IGA' .OR.
21421     1  (IGAUME.EQ.'MLE' .AND. NUMVAR.EQ.1))THEN
21422        ALOCS3=ALOCSE
21423        GAMMS3=GAMMSE
21424        SIGMS3=SIGMSE
21425        AMUS3=AMUSE
21426        ALOCM3=ALOCML
21427        GAMMM3=GAMMML
21428        SIGMM3=SIGMML
21429        AMUM3=AMUML
21430      ELSE
21431        ALOCS3=ALOCS2
21432        GAMMS3=GAMMS2
21433        SIGMS3=SIGMS2
21434        AMUS3=AMUS2
21435        ALOCM3=ALOCMM
21436        GAMMM3=GAMMMM
21437        SIGMM3=SIGMMM
21438        AMUM3=AMUMM
21439      ENDIF
21440C
21441      DO2210I=1,NUMALP
21442        ALP=ALPHA(I)
21443        P=1.0-(ALP/2.0)
21444        CALL NORPPF(P,PPF)
21445C
21446C       FOR 2-PARAMETER INVERSE GAUSSIAN, TWEEDIE GIVES DISTRIBUTIONS
21447C       OF PARAMETER ESTIMATES THAT ARE NOT BASED ON NORMAL
21448C       APPROXIMATIONS.  FOR CHAN PARAMETERIZATION, USE NORMAL
21449C       APPROXIMATION METHOD.
21450C
21451        IF(ICASAN.EQ.'2IGA')THEN
21452          ALOWLO(I)=CPUMIN
21453          AUPPLO(I)=CPUMIN
21454          IF(IGAUDF.EQ.'CHAN')THEN
21455            IF(AMUS3.GT.0.0)THEN
21456              ALOWMU(I)=AMUM3  - PPF*AMUS3
21457              AUPPMU(I)=AMUM3  + PPF*AMUS3
21458              IF(ALOWMU(I).LT.0.0)ALOWMU(I)=0.0
21459            ELSE
21460              ALOWMU(I)=CPUMIN
21461              AUPPMU(I)=CPUMIN
21462            ENDIF
21463            IF(SIGMS3.GT.0.0)THEN
21464              ALOWSI(I)=SIGMM3 - PPF*SIGMS3
21465              AUPPSI(I)=SIGMM3 + PPF*SIGMS3
21466              IF(ALOWSI(I).LT.0.0)ALOWSI(I)=0.0
21467            ELSE
21468              ALOWSI(I)=CPUMIN
21469              AUPPSI(I)=CPUMIN
21470            ENDIF
21471          ELSE
21472            PL=1.0 - P
21473            PU=P
21474C
21475            CALL IGPPF(DBLE(PL),DBLE(GAMMM3),DBLE(AMUM3),DPPF)
21476            ALOWMU(I)=REAL(DPPF)
21477            CALL IGPPF(DBLE(PU),DBLE(GAMMM3),DBLE(AMUM3),DPPF)
21478            AUPPMU(I)=REAL(DPPF)
21479C
21480            NU=NTOTZZ-1
21481            CALL CHSPPF(PL,NU,PPF)
21482            ALOWGA(I)=PPF/REAL(DSUM)
21483            CALL CHSPPF(PU,NU,PPF)
21484            AUPPGA(I)=PPF/REAL(DSUM)
21485          ENDIF
21486        ELSE
21487C
21488          IF(ALOCS3.GT.0.0)THEN
21489            ALOWLO(I)=ALOCM3 - PPF*ALOCS3
21490            AUPPLO(I)=ALOCM3 + PPF*ALOCS3
21491          ELSE
21492            ALOWLO(I)=CPUMIN
21493            AUPPLO(I)=CPUMIN
21494          ENDIF
21495C
21496          IF(AMUS3.GT.0.0)THEN
21497            ALOWMU(I)=AMUM3  - PPF*AMUS3
21498            AUPPMU(I)=AMUM3  + PPF*AMUS3
21499            IF(ALOWMU(I).LT.0.0)ALOWMU(I)=0.0
21500          ELSE
21501            ALOWMU(I)=CPUMIN
21502            AUPPMU(I)=CPUMIN
21503          ENDIF
21504C
21505          IF(IGAUDF.EQ.'CHAN')THEN
21506            IF(SIGMS3.GT.0.0)THEN
21507              ALOWSI(I)=SIGMM3 - PPF*SIGMS3
21508              AUPPSI(I)=SIGMM3 + PPF*SIGMS3
21509              IF(ALOWSI(I).LT.0.0)ALOWSI(I)=0.0
21510            ELSE
21511              ALOWSI(I)=CPUMIN
21512              AUPPSI(I)=CPUMIN
21513            ENDIF
21514          ELSE
21515            IF(GAMMS3.GT.0.0)THEN
21516              ALOWGA(I)=GAMMM3 - PPF*GAMMS3
21517              AUPPGA(I)=GAMMM3 + PPF*GAMMS3
21518              IF(ALOWGA(I).LT.0.0)ALOWGA(I)=0.0
21519            ELSE
21520              ALOWGA(I)=CPUMIN
21521              AUPPGA(I)=CPUMIN
21522            ENDIF
21523          ENDIF
21524        ENDIF
21525 2210 CONTINUE
21526C
21527C     APPROXIMATE CONFIDENCE INTERVALS FOR SELECTED PERCENTILES BASED
21528C     ON MAXIMUM LIKELIHOOD ESTIMATES.
21529C
21530C     Xp(Lower) = XpHat - NORPPF(1 - ALPHA/2)*Xp(SE)
21531C     Xp(Upper) = XpHat + NORPPF(1 - ALPHA/2)*Xp(SE)
21532C
21533C     WHERE
21534C
21535C     Xp(SE) IS THE PERCENTILE STANDARD ERROR.  THIS IS COMPUTED AS:
21536C
21537C     Xp(SE) = SQRT{SUM[j=1 to 3][SUM[k=1 to 3][d(j)*d(k)*COV(j,k)]]}
21538C
21539C     WHERE
21540C
21541C     COV  = PARAMETER VARIANCE-COVARIANCE MATRIX
21542C     D1   = PARTIAL DERIVATIVE OF THE PERCENT POINT FUNCTION WITH
21543C            RESPECT TO THE LOCATION PARAMETER
21544C          = 1
21545C     D2   = PARTIAL DERIVATIVE OF THE PERCENT POINT FUNCTION WITH
21546C            RESPECT TO THE SCALE PARAMETER
21547C          = EXP(Zp*SIGMA)
21548C     D3   = PARTIAL DERIVATIVE OF THE PERCENT POINT FUNCTION WITH
21549C            RESPECT TO THE SHAPE PARAMETER
21550C          = SCALE*Zp*EXP(SIGMA*Zp)
21551C     P    = THE DESIRED PERCENTILE
21552C     Zp   = NORPPF(p)
21553C
21554C     NOTE THAT ONE-SIDED PERCENTILE INTERVALS ARE EQUIVALENT TO
21555C     ONE-SIDED TOLERANCE INTERVALS.
21556C
21557      IF(NPERC.GE.1)THEN
21558C
21559        IF(IDTYPR.EQ.'LOWE')THEN
21560          ALPHL=ALPHAP
21561          ALPHU=1.0 - ALPHAP
21562        ELSEIF(IDTYPR.EQ.'UPPE')THEN
21563          ALPHL=ALPHAP
21564          ALPHU=1.0 - ALPHAP
21565        ELSE
21566          ALPHL=ALPHAP/2.0
21567          ALPHU=1.0 - ALPHAP/2.0
21568        ENDIF
21569        CALL NORPPF(ALPHU,Z95)
21570C
21571CCCCC   IF(IFLAG3.EQ.1)THEN
21572CCCCC     SIGMA=SHAPML
21573CCCCC     U=UHATML
21574CCCCC     COVU(2,2)=UHATSE**2
21575CCCCC   ELSEIF(IFLAG3.EQ.2)THEN
21576CCCCC     SIGMA=SHAPMM
21577CCCCC     U=UHATMM
21578CCCCC     COVU(2,2)=UHATS2**2
21579CCCCC   ELSE
21580CCCCC     GOTO2499
21581CCCCC   ENDIF
21582CCCCC   AN=REAL(N)
21583CCCCC   W=EXP(-2.0*U + SIGMA**2)*(EXP(SIGMA**2)*(SIGMA**2+1.0) -
21584CCCCC1    2.0*SIGMA**2 - 1.0)
21585CCCCC   AFACT=SIGMA**2/(AN*W)
21586CCCCC   COVU(1,1)=COV(1,1)
21587CCCCC   COVU(3,3)=COV(3,3)
21588CCCCC   TERM1=-EXP(-U + SIGMA**2/2.0)
21589CCCCC   COVU(1,2)=AFACT*TERM1
21590CCCCC   COVU(2,1)=COVU(1,2)
21591CCCCC   TERM1=SIGMA*EXP(-U + SIGMA**2/2.0)
21592CCCCC   COVU(1,3)=AFACT*TERM1
21593CCCCC   COVU(3,1)=COVU(1,3)
21594CCCCC   TERM1=-SIGMA*EXP(-2.0*U + SIGMA**2)
21595CCCCC   COVU(2,3)=AFACT*TERM1
21596CCCCC   COVU(3,2)=COVU(2,3)
21597C
21598CCCCC   WRITE(IOUNI1,2431)
21599CCCCC   WRITE(IOUNI1,2432)
21600C
21601CCCCC   IF(IFLAG3.EQ.1)THEN
21602CCCCC     DSIGMA=DBLE(SHAPML)
21603CCCCC     DS=DBLE(SCALML)
21604CCCCC     DLOC=DBLE(ALOCML)
21605CCCCC     DU=DBLE(UHATML)
21606CCCCC   ELSEIF(IFLAG3.EQ.2)THEN
21607CCCCC     DSIGMA=DBLE(SHAPMM)
21608CCCCC     DS=DBLE(SCALMM)
21609CCCCC     DLOC=DBLE(ALOCMM)
21610CCCCC     DU=DBLE(UHATMM)
21611CCCCC   ELSE
21612CCCCC     GOTO2499
21613CCCCC   ENDIF
21614C
21615CCCCC   DO2429I=1,NPERC
21616CCCCC     QPTEMP=QP(I)/100.0
21617CCCCC     CALL GAMPPF(DBLE(QPTEMP),DSIGMA,DPPF)
21618CCCCC     XQPHAT(I)=REAL(DLOC + DS*DPPF)
21619C
21620CCCCC     CALL NODPPF(DBLE(QPTEMP),DZQ)
21621C
21622CCCCC     D(1)=1.0D0
21623CCCCC     D(2)=DEXP(DZQ*DSIGMA)
21624CCCCC     D(3)=DS*DZQ*DEXP(DSIGMA*DZQ)
21625CCCCC     D(2)=DEXP(DU + DSIGMA*DZQ)
21626CCCCC     D(3)=DZQ*DEXP(DU + DSIGMA*DZQ)
21627CCCCC     DVAR=0.0D0
21628CCCCC     DO2460J=1,3
21629CCCCC       DO2470K=1,3
21630CCCCC         DTERM1=D(J)*D(K)*DBLE(COVU(J,K))
21631CCCCC         DVAR=DVAR + DTERM1
21632C2470       CONTINUE
21633C2460     CONTINUE
21634CCCCC     SEXQP=REAL(DSQRT(DVAR))
21635C
21636CCCCC     XQPSE(I)=SEXQP
21637CCCCC     IF(IDTYPR.EQ.'LOWE')THEN
21638CCCCC       XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
21639CCCCC       XQPUCL(I)=CPUMIN
21640CCCCC     ELSEIF(IDTYPR.EQ.'UPPE')THEN
21641CCCCC       XQPLCL(I)=CPUMIN
21642CCCCC       XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
21643CCCCC     ELSE
21644CCCCC       XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
21645CCCCC       XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
21646CCCCC     ENDIF
21647CCCCC     WRITE(IOUNI1,'(5E15.7)')
21648CCCCC1         QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
21649C2429   CONTINUE
21650C2431   FORMAT(15X,'       POINT     ','     LOWER     ',
21651CCCCC1         '     UPPER')
21652C2432   FORMAT('    PERCENTILE ','     ESTIMATE   ',
21653CCCCC1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
21654      ENDIF
21655C
21656C2499 CONTINUE
21657C
21658C               *************************************
21659C               **   STEP 42--                     **
21660C               **   WRITE OUT EVERYTHING          **
21661C               **   FOR GAMMA   MLE ESTIMATE      **
21662C               *************************************
21663C
21664      ISTEPN='42'
21665      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLIG')
21666     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
21667C
21668C     PRINT SUMMARY STATISTICS TABLE
21669C
21670      IF(IPRINT.EQ.'OFF')GOTO9000
21671C
21672      NUMDIG=7
21673      IF(IFORSW.EQ.'1')NUMDIG=1
21674      IF(IFORSW.EQ.'2')NUMDIG=2
21675      IF(IFORSW.EQ.'3')NUMDIG=3
21676      IF(IFORSW.EQ.'4')NUMDIG=4
21677      IF(IFORSW.EQ.'5')NUMDIG=5
21678      IF(IFORSW.EQ.'6')NUMDIG=6
21679      IF(IFORSW.EQ.'7')NUMDIG=7
21680      IF(IFORSW.EQ.'8')NUMDIG=8
21681      IF(IFORSW.EQ.'9')NUMDIG=9
21682      IF(IFORSW.EQ.'0')NUMDIG=0
21683      IF(IFORSW.EQ.'E')NUMDIG=-2
21684      IF(IFORSW.EQ.'-2')NUMDIG=-2
21685      IF(IFORSW.EQ.'-3')NUMDIG=-3
21686      IF(IFORSW.EQ.'-4')NUMDIG=-4
21687      IF(IFORSW.EQ.'-5')NUMDIG=-5
21688      IF(IFORSW.EQ.'-6')NUMDIG=-6
21689      IF(IFORSW.EQ.'-7')NUMDIG=-7
21690      IF(IFORSW.EQ.'-8')NUMDIG=-8
21691      IF(IFORSW.EQ.'-9')NUMDIG=-9
21692C
21693      IF(ICASAN.EQ.'2IGA')THEN
21694        ITITLE='Two-Parameter Inverse Guassian Parameter Estimation:'
21695        NCTITL=52
21696      ELSE
21697        ITITLE='Three-Parameter Inverse Guassian Parameter Estimation:'
21698        NCTITL=54
21699      ENDIF
21700      ITITLZ='Full Sample Case (Maximim Likelihood)'
21701      NCTITZ=37
21702C
21703      ITEXT(1)='Summary Statistics:'
21704      NCTEXT(1)=19
21705      AVALUE(1)=0.0
21706      IDIGIT(1)=-1
21707      ITEXT(2)='Number of Observations:'
21708      NCTEXT(2)=23
21709      AVALUE(2)=REAL(NTOTZZ)
21710      IDIGIT(2)=0
21711      ITEXT(3)='Sample Mean:'
21712      NCTEXT(3)=12
21713      AVALUE(3)=XMEAN
21714      IDIGIT(3)=NUMDIG
21715      ITEXT(4)='Sample Standard Deviation:'
21716      NCTEXT(4)=26
21717      AVALUE(4)=XSD
21718      IDIGIT(4)=NUMDIG
21719      ITEXT(5)='Sample Skewness:'
21720      NCTEXT(5)=16
21721      AVALUE(5)=XSKEW
21722      IDIGIT(5)=NUMDIG
21723      ITEXT(6)='Sample Minimum:'
21724      NCTEXT(6)=15
21725      AVALUE(6)=XMIN
21726      IDIGIT(6)=NUMDIG
21727      ITEXT(7)='Sample Maximum:'
21728      NCTEXT(7)=15
21729      AVALUE(7)=XMAX
21730      IDIGIT(7)=NUMDIG
21731      NUMROW=7
21732C
21733      DO2310I=1,NUMROW
21734        NTOT(I)=15
21735 2310 CONTINUE
21736C
21737      IFRST=.TRUE.
21738      ILAST=.FALSE.
21739      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
21740     1            NCTEXT,AVALUE,IDIGIT,
21741     1            NTOT,NUMROW,
21742     1            ICAPSW,ICAPTY,ILAST,IFRST,
21743     1            ISUBRO,IBUGA3,IERROR)
21744      IFRST=.FALSE.
21745      ITITLE=' '
21746      NCTITL=0
21747      ICNT=0
21748C
21749      IF(SIGMMO.GT.0.0 .AND. AMUMO.GT.0.0)THEN
21750        ICNT=ICNT+1
21751        ITEXT(ICNT)='Moment Estimates:'
21752        NCTEXT(ICNT)=18
21753        AVALUE(ICNT)=0.0
21754        IDIGIT(ICNT)=-1
21755        IF(ICASAN.EQ.'3IGA')THEN
21756          ICNT=ICNT+1
21757          ITEXT(ICNT)='Estimate of Location:'
21758          NCTEXT(ICNT)=21
21759          AVALUE(ICNT)=ALOCMO
21760          IDIGIT(ICNT)=NUMDIG
21761        ENDIF
21762        ICNT=ICNT+1
21763        ITEXT(ICNT)='Estimate of Shape (mu):'
21764        NCTEXT(ICNT)=23
21765        AVALUE(ICNT)=AMUMO
21766        IDIGIT(ICNT)=NUMDIG
21767        IF(IGAUDF.EQ.'CHAN')THEN
21768          ICNT=ICNT+1
21769          ITEXT(ICNT)='Estimate of Shape (sigma):'
21770          NCTEXT(ICNT)=26
21771          AVALUE(ICNT)=SIGMMO
21772          IDIGIT(ICNT)=NUMDIG
21773        ELSE
21774          ICNT=ICNT+1
21775          ITEXT(ICNT)='Estimate of Shape (gamma):'
21776          NCTEXT(ICNT)=26
21777          AVALUE(ICNT)=GAMMMO
21778          IDIGIT(ICNT)=NUMDIG
21779        ENDIF
21780        IF(ALIKMO.NE.CPUMIN)THEN
21781          ICNT=ICNT+1
21782          ITEXT(ICNT)='Value of Log-Likelihood Function:'
21783          NCTEXT(ICNT)=33
21784          AVALUE(ICNT)=ALIKMO
21785          IDIGIT(ICNT)=NUMDIG
21786          ICNT=ICNT+1
21787          ITEXT(ICNT)='AIC:'
21788          NCTEXT(ICNT)=4
21789          AVALUE(ICNT)=AICMO
21790          IDIGIT(ICNT)=NUMDIG
21791          ICNT=ICNT+1
21792          ITEXT(ICNT)='AICC:'
21793          NCTEXT(ICNT)=5
21794          AVALUE(ICNT)=AICCMO
21795          IDIGIT(ICNT)=NUMDIG
21796          ICNT=ICNT+1
21797          ITEXT(ICNT)='BIC:'
21798          NCTEXT(ICNT)=4
21799          AVALUE(ICNT)=BICMO
21800          IDIGIT(ICNT)=NUMDIG
21801        ENDIF
21802        ICNT=ICNT+1
21803        ITEXT(ICNT)=' '
21804        NCTEXT(ICNT)=0
21805        AVALUE(ICNT)=0.0
21806        IDIGIT(ICNT)=-1
21807      ENDIF
21808C
21809      IF(ICASAN.EQ.'3IGA')THEN
21810        ICNT=ICNT+1
21811        ITEXT(ICNT)='Modified Moment Estimates:'
21812        NCTEXT(ICNT)=26
21813        AVALUE(ICNT)=0.0
21814        IDIGIT(ICNT)=-1
21815        ICNT=ICNT+1
21816        ITEXT(ICNT)='Estimate of Location:'
21817        NCTEXT(ICNT)=21
21818        AVALUE(ICNT)=ALOCMM
21819        IDIGIT(ICNT)=NUMDIG
21820        ICNT=ICNT+1
21821        ITEXT(ICNT)='Estimate of Shape (mu):'
21822        NCTEXT(ICNT)=23
21823        AVALUE(ICNT)=AMUMM
21824        IDIGIT(ICNT)=NUMDIG
21825        IF(IGAUDF.EQ.'CHAN')THEN
21826          ICNT=ICNT+1
21827          ITEXT(ICNT)='Estimate of Shape (sigma):'
21828          NCTEXT(ICNT)=26
21829          AVALUE(ICNT)=SIGMMM
21830          IDIGIT(ICNT)=NUMDIG
21831        ELSE
21832          ICNT=ICNT+1
21833          ITEXT(ICNT)='Estimate of Shape (gamma):'
21834          NCTEXT(ICNT)=26
21835          AVALUE(ICNT)=GAMMMM
21836          IDIGIT(ICNT)=NUMDIG
21837        ENDIF
21838        IF(ICASAN.EQ.'3IGA')THEN
21839          ICNT=ICNT+1
21840          ITEXT(ICNT)='Standard Error of Location:'
21841          NCTEXT(ICNT)=27
21842          AVALUE(ICNT)=ALOCS2
21843          IDIGIT(ICNT)=NUMDIG
21844        ENDIF
21845        ICNT=ICNT+1
21846        ITEXT(ICNT)='Standard Error of mu:'
21847        NCTEXT(ICNT)=21
21848        AVALUE(ICNT)=AMUS2
21849        IDIGIT(ICNT)=NUMDIG
21850        IF(IGAUDF.EQ.'CHAN')THEN
21851          ICNT=ICNT+1
21852          ITEXT(ICNT)='Standard Error of Sigma:'
21853          NCTEXT(ICNT)=24
21854          AVALUE(ICNT)=SIGMS2
21855          IDIGIT(ICNT)=NUMDIG
21856        ELSE
21857          ICNT=ICNT+1
21858          ITEXT(ICNT)='Standard Error of Gamma:'
21859          NCTEXT(ICNT)=24
21860          AVALUE(ICNT)=GAMMS2
21861          IDIGIT(ICNT)=NUMDIG
21862        ENDIF
21863        IF(ALIKMM.NE.CPUMIN)THEN
21864          ICNT=ICNT+1
21865          ITEXT(ICNT)='Value of Log-Likelihood Function:'
21866          NCTEXT(ICNT)=33
21867          AVALUE(ICNT)=ALIKMM
21868          IDIGIT(ICNT)=NUMDIG
21869          ICNT=ICNT+1
21870          ITEXT(ICNT)='AIC:'
21871          NCTEXT(ICNT)=4
21872          AVALUE(ICNT)=AICMM
21873          IDIGIT(ICNT)=NUMDIG
21874          ICNT=ICNT+1
21875          ITEXT(ICNT)='AICC:'
21876          NCTEXT(ICNT)=5
21877          AVALUE(ICNT)=AICCMM
21878          IDIGIT(ICNT)=NUMDIG
21879          ICNT=ICNT+1
21880          ITEXT(ICNT)='BIC:'
21881          NCTEXT(ICNT)=4
21882          AVALUE(ICNT)=BICMM
21883          IDIGIT(ICNT)=NUMDIG
21884        ENDIF
21885        ICNT=ICNT+1
21886        ITEXT(ICNT)=' '
21887        NCTEXT(ICNT)=0
21888        AVALUE(ICNT)=0.0
21889        IDIGIT(ICNT)=-1
21890      ENDIF
21891C
21892C     ML ESTIMATES NOT SUPPORTED FOR GROUPED DATA FOR
21893C     3-PARAMETER CASE.
21894C
21895      IF(NUMVAR.GT.1 .AND. ICASAN.EQ.'3IGA')GOTO2199
21896C
21897      ICNT=ICNT+1
21898      ITEXT(ICNT)='Maximum Likelihood Estimates:'
21899      NCTEXT(ICNT)=29
21900      AVALUE(ICNT)=0.0
21901      IDIGIT(ICNT)=-1
21902      IF(ICASAN.EQ.'3IGA')THEN
21903        ICNT=ICNT+1
21904        ITEXT(ICNT)='Estimate of Location:'
21905        NCTEXT(ICNT)=21
21906        AVALUE(ICNT)=ALOCML
21907        IDIGIT(ICNT)=NUMDIG
21908      ENDIF
21909      ICNT=ICNT+1
21910      ITEXT(ICNT)='Estimate of Shape (mu):'
21911      NCTEXT(ICNT)=23
21912      AVALUE(ICNT)=AMUML
21913      IDIGIT(ICNT)=NUMDIG
21914      IF(IGAUDF.EQ.'CHAN')THEN
21915        ICNT=ICNT+1
21916        ITEXT(ICNT)='Estimate of Shape (sigma):'
21917        NCTEXT(ICNT)=26
21918        AVALUE(ICNT)=SIGMML
21919        IDIGIT(ICNT)=NUMDIG
21920      ELSE
21921        ICNT=ICNT+1
21922        ITEXT(ICNT)='Estimate of Shape (gamma):'
21923        NCTEXT(ICNT)=26
21924        AVALUE(ICNT)=GAMMML
21925        IDIGIT(ICNT)=NUMDIG
21926      ENDIF
21927C
21928      IF(ICASAN.EQ.'3IGA')THEN
21929        ICNT=ICNT+1
21930        ITEXT(ICNT)='Standard Error of Location:'
21931        NCTEXT(ICNT)=27
21932        AVALUE(ICNT)=ALOCSE
21933        IDIGIT(ICNT)=NUMDIG
21934      ENDIF
21935      ICNT=ICNT+1
21936      ITEXT(ICNT)='Standard Error of mu:'
21937      NCTEXT(ICNT)=21
21938      AVALUE(ICNT)=AMUSE
21939      IDIGIT(ICNT)=NUMDIG
21940      IF(IGAUDF.EQ.'CHAN')THEN
21941        ICNT=ICNT+1
21942        ITEXT(ICNT)='Standard Error of Sigma:'
21943        NCTEXT(ICNT)=24
21944        AVALUE(ICNT)=SIGMSE
21945        IDIGIT(ICNT)=NUMDIG
21946      ELSE
21947        ICNT=ICNT+1
21948        ITEXT(ICNT)='Standard Error of Gamma:'
21949        NCTEXT(ICNT)=24
21950        AVALUE(ICNT)=GAMMSE
21951        IDIGIT(ICNT)=NUMDIG
21952      ENDIF
21953      IF(ICASAN.EQ.'2IGA')THEN
21954        IF(IGAUDF.EQ.'CHAN')THEN
21955          ICNT=ICNT+1
21956          ITEXT(ICNT)='Covariance of mu and Sigma:'
21957          NCTEXT(ICNT)=27
21958          AVALUE(ICNT)=COVMUS
21959          IDIGIT(ICNT)=NUMDIG
21960        ELSE
21961          ICNT=ICNT+1
21962          ITEXT(ICNT)='Covariance of mu and Gamma:'
21963          NCTEXT(ICNT)=27
21964          AVALUE(ICNT)=COV(1,2)
21965          IDIGIT(ICNT)=NUMDIG
21966        ENDIF
21967      ENDIF
21968      IF(ALIKML.NE.CPUMIN)THEN
21969        ICNT=ICNT+1
21970        ITEXT(ICNT)='Value of Log-Likelihood Function:'
21971        NCTEXT(ICNT)=33
21972        AVALUE(ICNT)=ALIKML
21973        IDIGIT(ICNT)=NUMDIG
21974        ICNT=ICNT+1
21975        ITEXT(ICNT)='AIC:'
21976        NCTEXT(ICNT)=4
21977        AVALUE(ICNT)=AICML
21978        IDIGIT(ICNT)=NUMDIG
21979        ICNT=ICNT+1
21980        ITEXT(ICNT)='AICC:'
21981        NCTEXT(ICNT)=5
21982        AVALUE(ICNT)=AICCML
21983        IDIGIT(ICNT)=NUMDIG
21984        ICNT=ICNT+1
21985        ITEXT(ICNT)='BIC:'
21986        NCTEXT(ICNT)=4
21987        AVALUE(ICNT)=BICML
21988        IDIGIT(ICNT)=NUMDIG
21989      ENDIF
21990      ICNT=ICNT+1
21991      ITEXT(ICNT)=' '
21992      NCTEXT(ICNT)=0
21993      AVALUE(ICNT)=0.0
21994      IDIGIT(ICNT)=-1
21995C
21996 2199 CONTINUE
21997C
21998      NUMROW=ICNT
21999      DO2320I=1,NUMROW
22000        NTOT(I)=15
22001 2320 CONTINUE
22002C
22003      IFRST=.FALSE.
22004      ILAST=.FALSE.
22005      ITITLZ=' '
22006      NCTITZ=0
22007      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
22008     1            AVALUE,IDIGIT,
22009     1            NTOT,NUMROW,
22010     1            ICAPSW,ICAPTY,ILAST,IFRST,
22011     1            ISUBRO,IBUGA3,IERROR)
22012C
22013      ILIKFL='OFF'
22014CCCCC CALL DPDTA6(COV,ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALOWSH,AUPPSH,
22015CCCCC1            ALPHA,NUMALP,
22016CCCCC1            ICAPSW,ICAPTY,NUMDIG,
22017CCCCC1            ISUBRO,IBUGA3,IERROR)
22018C
22019      ILOCFL='ON'
22020      IF(ICASAN.EQ.'2IGA')ILOCFL='OFF'
22021      ISCAFL='OFF'
22022      ISHAP2='Mu'
22023      NCSHA2=2
22024      IF(IGAUDF.EQ.'TWEE')THEN
22025        ISHAP1='Gamma'
22026        NCSHA1=5
22027        CALL DPDT8A(ALOWLO,AUPPLO,ALOWSC,AUPPSC,
22028     1              ALOWGA,AUPPGA,ALOWGA,AUPPGA,
22029     1              ALOWMU,AUPPMU,ALOWMU,AUPPMU,
22030     1              ALPHA,NUMALP,
22031     1              ICAPSW,ICAPTY,NUMDIG,
22032     1              ILOCFL,ISCAFL,ILIKFL,
22033     1              ISHAP1,NCSHA1,ISHAP2,NCSHA2,
22034     1              ISUBRO,IBUGA3,IERROR)
22035      ELSE
22036        ISHAP1='Sigma'
22037        NCSHA1=5
22038        CALL DPDT8A(ALOWLO,AUPPLO,ALOWSC,AUPPSC,
22039     1              ALOWSI,AUPPSI,ALOWSI,AUPPSI,
22040     1              ALOWMU,AUPPMU,ALOWMU,AUPPMU,
22041     1              ALPHA,NUMALP,
22042     1              ICAPSW,ICAPTY,NUMDIG,
22043     1              ILOCFL,ISCAFL,ILIKFL,
22044     1              ISHAP1,NCSHA1,ISHAP2,NCSHA2,
22045     1              ISUBRO,IBUGA3,IERROR)
22046      ENDIF
22047C
22048      IF(NPERC.GT.1)THEN
22049        ILIKFL='OFF'
22050CCCCC   CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
22051CCCCC1              ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
22052CCCCC1              ISUBRO,IBUGA3,IERROR)
22053      ENDIF
22054C
22055C               *****************
22056C               **  STEP 90--  **
22057C               **  EXIT       **
22058C               *****************
22059C
22060 9000 CONTINUE
22061C
22062      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLIG')THEN
22063        WRITE(ICOUT,999)
22064        CALL DPWRST('XXX','WRIT')
22065        WRITE(ICOUT,9011)
22066 9011   FORMAT('***** AT THE END       OF DPMLIG--')
22067        CALL DPWRST('XXX','WRIT')
22068        WRITE(ICOUT,9012)N,IBUGA3,IERROR
22069 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
22070        CALL DPWRST('XXX','WRIT')
22071      ENDIF
22072C
22073      RETURN
22074      END
22075      SUBROUTINE DPMLJO(Y,XLOW,XHIGH,N,NVAR,ICASE,
22076     1                  TEMP1,TEMP2,TEMP3,TEMP4,DTEMP1,MAXNXT,
22077     1                  ALPHP1,ALPHP2,ALOCPE,SCALPE,IJOHN,Z,
22078     1                  ALPHM1,ALPHM2,ALOCMO,SCALMO,
22079     1                  ICAPSW,ICAPTY,IFORSW,IQUAME,
22080     1                  ISUBRO,IBUGA3,IERROR)
22081C
22082C     PURPOSE--THIS ROUTINE COMPUTES THE PARAMETER ESTIMATES FOR
22083C              THE JOHNSON SU/SB DISTRIBUTIONS USING THE PERCENTILE
22084C              METHOD OF SLIFKER AND SHAPIRO.
22085C     EXAMPLE--JOHNSON PERCENTILE Y
22086C     REFERENCE--JAMES F. SLIFKER AND SAMUEL S. SHAPIRO, "THE JOHNSON
22087C                SYSTEM: SELECTION AND PARAMETER ESTIMATION",
22088C                TECHNOMETRICS, VOL. 22, NO. 2, MAY 1980, PP. 239-246.
22089C     WRITTEN BY--ALAN HECKERT
22090C                 STATISTICAL ENGINEERING DIVISION
22091C                 INFORMATION TECHNOLOGY LABORATORY
22092C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
22093C                 GAITHERSBURG, MD 20899-8980
22094C                 PHONE--301-975-2899
22095C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
22096C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
22097C     LANGUAGE--ANSI FORTRAN (1977)
22098C     VERSION NUMBER--2004/4
22099C     ORIGINAL VERSION--APRIL     2004.
22100C     UPDATED         --APRIL     2011. USE DPDTA1 TO PRINT OUTPUT
22101C     UPDATED         --APRIL     2011. INCORPORATE MOMENT ESTIMATES
22102C
22103C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
22104C
22105      CHARACTER*4 ICAPSW
22106      CHARACTER*4 ICAPTY
22107      CHARACTER*4 IFORSW
22108      CHARACTER*4 ICASE
22109      CHARACTER*4 IQUAME
22110      CHARACTER*4 ISUBRO
22111      CHARACTER*4 IBUGA3
22112      CHARACTER*4 IERROR
22113C
22114      CHARACTER*4 ITYPE
22115      CHARACTER*4 IWRITE
22116C
22117      CHARACTER*4 ISUBN1
22118      CHARACTER*4 ISUBN2
22119      CHARACTER*4 ISTEPN
22120C
22121C---------------------------------------------------------------------
22122C
22123      DIMENSION Y(*)
22124      DIMENSION XLOW(*)
22125      DIMENSION XHIGH(*)
22126      DIMENSION TEMP1(*)
22127      DIMENSION TEMP2(*)
22128      DIMENSION TEMP3(*)
22129      DIMENSION TEMP4(*)
22130      DOUBLE PRECISION DTEMP1(*)
22131C
22132      CHARACTER*10 IDIST2
22133      CHARACTER*40 IDIST
22134      PARAMETER (MAXROW=50)
22135      CHARACTER*60 ITITLE
22136      CHARACTER*60 ITITLZ
22137      CHARACTER*40 ITEXT(MAXROW)
22138      REAL         AVALUE(MAXROW)
22139      INTEGER      NCTEXT(MAXROW)
22140      INTEGER      IDIGIT(MAXROW)
22141      INTEGER      NTOT(MAXROW)
22142      LOGICAL IFRST
22143      LOGICAL ILAST
22144C
22145C---------------------------------------------------------------------
22146C
22147      INCLUDE 'DPCOP2.INC'
22148C
22149C-----START POINT-----------------------------------------------------
22150C
22151      ISUBN1='DPML'
22152      ISUBN2='JO  '
22153      IERROR='NO'
22154      IWRITE='OFF'
22155      IDIST='JOHNSON SB/SU'
22156C
22157      ALPHP1=CPUMIN
22158      ALPHP2=CPUMIN
22159      ALOCPE=CPUMIN
22160      SCALPE=CPUMIN
22161      ALPHM1=CPUMIN
22162      ALPHM2=CPUMIN
22163      ALOCMO=CPUMIN
22164      SCALMO=CPUMIN
22165      IJOHN=-1
22166C
22167      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLJO')THEN
22168        WRITE(ICOUT,999)
22169  999   FORMAT(1X)
22170        CALL DPWRST('XXX','WRIT')
22171        WRITE(ICOUT,51)
22172   51   FORMAT('**** AT THE BEGINNING OF DPMLJO--')
22173        CALL DPWRST('XXX','WRIT')
22174        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR,MAXNXT,Z
22175   52   FORMAT('IBUGA3,ISUBRO,N,NVAR,MAXNXT,Z = ',2(A4,2X),3I8,G15.7)
22176        CALL DPWRST('XXX','WRIT')
22177        DO56I=1,MIN(N,100)
22178          WRITE(ICOUT,57)I,Y(I),XLOW(I),XHIGH(I)
22179   57     FORMAT('I,Y(I),XLOW(I),XHIGH(I) = ',I8,3G15.7)
22180          CALL DPWRST('XXX','WRIT')
22181   56   CONTINUE
22182        WRITE(ICOUT,59)TEMP4(1),DTEMP1(1)
22183   59   FORMAT('TEMP4(1),DTEMP1(1) = ',2G15.7)
22184        CALL DPWRST('XXX','WRIT')
22185      ENDIF
22186C
22187C               ********************************************
22188C               **  STEP 11--                             **
22189C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
22190C               ********************************************
22191C
22192      ISTEPN='11'
22193      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLJO')
22194     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
22195C
22196C     NOTE: THERE ARE 3 POSSIBLE CASES.
22197C
22198C     1. UNBINNED DATA
22199C     2. GROUPED DATA, BIN MID-POINTS PROVIDED
22200C     3. GROUPED DATA, BIN LOWER/UPPER LIMITS
22201C        PROVIDED (I.E., UNEQUAL SIZE BINS)
22202C
22203      NPERC=0
22204      MAXGRP=MAXNXT/2
22205      NMIN=4
22206      IF(NVAR.EQ.1)THEN
22207        CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
22208        IF(IERROR.EQ.'YES')GOTO9000
22209        NTOT2=N
22210        NCLASS=N
22211        IFLAG=0
22212        CALL SUMRAW(Y,N,IDIST,IFLAG,
22213     1              XMEAN,XVAR,XSD,XMIN,XMAX,
22214     1              ISUBRO,IBUGA3,IERROR)
22215        NTOTZZ=N
22216        IF(IERROR.EQ.'YES')GOTO9000
22217        CALL STMOM3(Y,N,IWRITE,XSKEW,IBUGA3,IERROR)
22218        IF(IERROR.EQ.'YES')GOTO9000
22219        CALL STMOM4(Y,N,IWRITE,XKURT,IBUGA3,IERROR)
22220        IF(IERROR.EQ.'YES')GOTO9000
22221      ELSEIF(NVAR.EQ.2)THEN
22222        CALL CKDIS2(Y,XLOW,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOT2,
22223     1              ISUBRO,IBUGA3,IERROR)
22224        IF(IERROR.EQ.'YES')GOTO9000
22225        IFLAG1=1
22226        IFLAG2=1
22227        CALL SUMGRP(Y,XLOW,N,IDIST,IFLAG1,IFLAG2,
22228     1              TEMP1,TEMP2,TEMP3,MAXNXT,
22229     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
22230     1              ISUBRO,IBUGA3,IERROR)
22231        IF(IERROR.EQ.'YES')GOTO9000
22232      ELSEIF(NVAR.EQ.3)THEN
22233        CALL CKDIS3(Y,XLOW,XHIGH,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOT2,
22234     1              ISUBRO,IBUGA3,IERROR)
22235        IF(IERROR.EQ.'YES')GOTO9000
22236        IFLAG1=1
22237        IFLAG2=1
22238        CALL SUMGR2(Y,XLOW,XHIGH,N,IDIST,IFLAG1,IFLAG2,
22239     1              TEMP1,TEMP2,TEMP3,MAXNXT,
22240     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
22241     1              ISUBRO,IBUGA3,IERROR)
22242        IF(IERROR.EQ.'YES')GOTO9000
22243      ELSE
22244        WRITE(ICOUT,999)
22245        CALL DPWRST('XXX','WRIT')
22246        WRITE(ICOUT,111)
22247  111   FORMAT('***** ERROR IN JOHNSON SB/SU PARAMETER ESTIMATION--')
22248        CALL DPWRST('XXX','WRIT')
22249        WRITE(ICOUT,390)
22250  390   FORMAT('      MORE THAN THREE RESPONSE VARIABLES WERE ',
22251     1         'SPECIFIED.')
22252        CALL DPWRST('XXX','WRIT')
22253        IERROR='YES'
22254        GOTO9000
22255      ENDIF
22256C
22257C               **************************************
22258C               **  STEP 21--                       **
22259C               **  CARRY OUT CALCULATIONS          **
22260C               **  FOR JOHNSON PERCENTILE ESTIMATE **
22261C               **************************************
22262C
22263C     NOTE: PERCENTILE ESTIMATE CURRENTLY ONLY AVAILABLE
22264C           FOR RAW (I.E., UNBINNED DATA).
22265C
22266      ISTEPN='21'
22267      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLJO')
22268     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
22269C
22270      IF(NVAR.EQ.1)THEN
22271        AN=NTOTZZ
22272C
22273CCCCC   Z=0.524
22274        ZM=-Z
22275        Z3=3*Z
22276        Z3M=-3*Z
22277        CALL NORCDF(Z,PZ)
22278        CALL NORCDF(ZM,PZM)
22279        CALL NORCDF(Z3,PZ3)
22280        CALL NORCDF(Z3M,PZ3M)
22281C
22282        CALL QUANT(PZ,Y,N,IWRITE,TEMP1,MAXNXT,
22283     1             IQUAME,
22284     1             XZ,IBUGA3,IERROR)
22285        CALL QUANT(PZM,Y,N,IWRITE,TEMP1,MAXNXT,
22286     1             IQUAME,
22287     1             XZM,IBUGA3,IERROR)
22288        CALL QUANT(PZ3,Y,N,IWRITE,TEMP1,MAXNXT,
22289     1             IQUAME,
22290     1             XZ3,IBUGA3,IERROR)
22291        CALL QUANT(PZ3M,Y,N,IWRITE,TEMP1,MAXNXT,
22292     1             IQUAME,
22293     1             XZ3M,IBUGA3,IERROR)
22294C
22295        AM=XZ3 - XZ
22296        AN2=XZM - XZ3M
22297        AP=XZ  - XZM
22298        ACUT=AM*AN2/(AP*AP)
22299C
22300        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLJO')THEN
22301          WRITE(ICOUT,2190)Z,ZM,Z3,Z3M
22302 2190     FORMAT('Z,ZM,Z3,Z3M = ',4G15.7)
22303          CALL DPWRST('XXX','WRIT')
22304          WRITE(ICOUT,2191)PZ,PZM,PZ3,PZ3M
22305 2191     FORMAT('PZ,PZM,PZ3,PZ3M = ',4G15.7)
22306          CALL DPWRST('XXX','WRIT')
22307          WRITE(ICOUT,2192)XZ,XZM,XZ3,XZ3M
22308 2192     FORMAT('XZ,XZM,XZ3,XZ3M = ',4G15.7)
22309          CALL DPWRST('XXX','WRIT')
22310          WRITE(ICOUT,2193)AM,AN2,AP,ACUT
22311 2193     FORMAT('AM,AN2,AP,ACUT = ',4G15.7)
22312          CALL DPWRST('XXX','WRIT')
22313        ENDIF
22314C
22315        IF(ACUT.GE.0.99 .AND. ACUT.LE.1.01)THEN
22316          WRITE(ICOUT,999)
22317          CALL DPWRST('XXX','WRIT')
22318          WRITE(ICOUT,2201)
22319 2201     FORMAT('***** FROM JOHNSON PERCENTILE ESTIMATION--')
22320          CALL DPWRST('XXX','WRIT')
22321          WRITE(ICOUT,2203)
22322 2203     FORMAT('      COMPUTATIONS SUGGEST THE LOGNORMAL ',
22323     1           'DISTRIBUTION')
22324          CALL DPWRST('XXX','WRIT')
22325          WRITE(ICOUT,2205)
22326 2205     FORMAT('      IS THE MOST APPROPRIATE MODEL.  NO JOHNSON ',
22327     1           'SB/SU ESTIMATION IS PERFORMED.')
22328          CALL DPWRST('XXX','WRIT')
22329          WRITE(ICOUT,999)
22330          CALL DPWRST('XXX','WRIT')
22331          IJOHN=0
22332          GOTO9000
22333        ELSEIF(ACUT.GT.1.01)THEN
22334          ITYPE='SU'
22335          ANUM=2.0*Z
22336          TERM1=0.5*((AM/AP) + (AN2/AP))
22337          IF(TERM1.LT.1.0)THEN
22338            WRITE(ICOUT,999)
22339            CALL DPWRST('XXX','WRIT')
22340            WRITE(ICOUT,2201)
22341            CALL DPWRST('XXX','WRIT')
22342            WRITE(ICOUT,2213)
22343 2213       FORMAT('      SQUARE ROOT OF A NEGATVE NUMBER ENCOUNTERED')
22344            CALL DPWRST('XXX','WRIT')
22345            WRITE(ICOUT,2215)
22346 2215       FORMAT('      IN COMPUTING ESTIMATE OF ALPHA2.  NO JOHNSON',
22347     1             'SB/SU ESTIMATION IS PERFORMED.')
22348            CALL DPWRST('XXX','WRIT')
22349            WRITE(ICOUT,999)
22350            CALL DPWRST('XXX','WRIT')
22351            GOTO9000
22352          ELSE
22353            ADENOM=LOG(TERM1+SQRT(TERM1*TERM1-1.0))
22354          ENDIF
22355          ALPHP2=ANUM/ADENOM
22356C
22357          ANUM=(AN2/AP) - (AM/AP)
22358          TERM1=(AM/AP)*(AN2/AP) - 1.0
22359          IF(TERM1.LT.0.0)THEN
22360            WRITE(ICOUT,999)
22361            CALL DPWRST('XXX','WRIT')
22362            WRITE(ICOUT,2201)
22363            CALL DPWRST('XXX','WRIT')
22364            WRITE(ICOUT,2213)
22365            CALL DPWRST('XXX','WRIT')
22366            WRITE(ICOUT,2225)
22367 2225       FORMAT('      IN COMPUTING ESTIMATE OF ALPHA1.  NO JOHNSON',
22368     1             'SB/SU ESTIMATION IS PERFORMED.')
22369            CALL DPWRST('XXX','WRIT')
22370            WRITE(ICOUT,999)
22371            CALL DPWRST('XXX','WRIT')
22372            WRITE(ICOUT,2227)Z
22373 2227       FORMAT('      TRY ADJUSTING THE VALUE OF Z (CURRENTLY = ',
22374     1             G15.7,')')
22375            CALL DPWRST('XXX','WRIT')
22376            GOTO9000
22377          ELSE
22378            ADENOM=2.0*SQRT(TERM1)
22379          ENDIF
22380          TERM1=ANUM/ADENOM
22381          TERM2=LOG(TERM1+SQRT(TERM1*TERM1+1.0))
22382          ALPHP1=ALPHP2*TERM2
22383C
22384          ANUM=2.0*AP*SQRT((AM/AP)*(AN2/AP) - 1.0)
22385          ADENOM=((AM/AP)+(AN2/AP)-2.0)*SQRT((AM/AP)+(AN2/AP)+2.0)
22386          SCALPE=ANUM/ADENOM
22387C
22388          TERM1=(XZ + XZM)/2.0
22389          ANUM=AP*((AN2/AP) - (AM/AP))
22390          ADENOM=2.0*((AM/AP) + (AN2/AP) - 2.0)
22391          ALOCPE=TERM1 + (ANUM/ADENOM)
22392          IJOHN=2
22393C
22394        ELSE
22395          ITYPE='SB'
22396          ANUM=Z
22397          TERM1=0.5*SQRT((1.0 + (AP/AM))*(1.0 + (AP/AN2)))
22398          IF(TERM1.LT.1.0)THEN
22399            WRITE(ICOUT,999)
22400            CALL DPWRST('XXX','WRIT')
22401            WRITE(ICOUT,2201)
22402            CALL DPWRST('XXX','WRIT')
22403            WRITE(ICOUT,2213)
22404            CALL DPWRST('XXX','WRIT')
22405            WRITE(ICOUT,2235)
22406 2235       FORMAT('      IN COMPUTING ESTIMATE OF ALPHA2.  NO ',
22407     1         'JOHNSON SB/SU ESTIMATION IS PERFORMED.')
22408            CALL DPWRST('XXX','WRIT')
22409            WRITE(ICOUT,2227)Z
22410            CALL DPWRST('XXX','WRIT')
22411            WRITE(ICOUT,999)
22412            CALL DPWRST('XXX','WRIT')
22413            GOTO9000
22414          ELSE
22415            ADENOM=LOG(TERM1+SQRT(TERM1*TERM1-1.0))
22416          ENDIF
22417          ALPHP2=ANUM/ADENOM
22418C
22419          ANUM=(AP/AN2) - (AP/AM)
22420          ANUM=ANUM*SQRT((1.0 + (AP/AM))*(1.0 + (AP/AN2)) - 4.0)
22421          ADENOM=2.0*((AP/AM)*(AP/AN2) - 1.0)
22422          TERM1=ANUM/ADENOM
22423          TERM2=LOG(TERM1+SQRT(TERM1*TERM1+1.0))
22424          ALPHP1=ALPHP2*TERM2
22425C
22426          TERM1=(1.0 + (AP/AM))*(1.0 + (AP/AN2) - 2.0)**2 - 4.0
22427          IF(TERM1.LT.0.0)THEN
22428            WRITE(ICOUT,999)
22429            CALL DPWRST('XXX','WRIT')
22430            WRITE(ICOUT,2201)
22431            CALL DPWRST('XXX','WRIT')
22432            WRITE(ICOUT,2213)
22433            CALL DPWRST('XXX','WRIT')
22434            WRITE(ICOUT,2245)
22435 2245       FORMAT('      IN COMPUTING ESTIMATE OF SCALE FOR JOHNSON ',
22436     1             'SB.')
22437            CALL DPWRST('XXX','WRIT')
22438            WRITE(ICOUT,2247)
22439 2247       FORMAT('NO JOHNSON SB/SU ESTIMATION IS PERFORMED.')
22440            CALL DPWRST('XXX','WRIT')
22441            WRITE(ICOUT,2227)Z
22442            CALL DPWRST('XXX','WRIT')
22443            WRITE(ICOUT,999)
22444            CALL DPWRST('XXX','WRIT')
22445            IERROR='YES'
22446            GOTO9000
22447          ELSE
22448CCCCC       ANUM=AP*SQRT(TERM1 - 4.0)
22449            ANUM=AP*SQRT(TERM1)
22450          ENDIF
22451          ADENOM=((AP/AM)*(AP/AN2) - 1.0)
22452          SCALPE=ANUM/ADENOM
22453C
22454          TERM1=(XZ + XZM)/2.0
22455          TERM2=SCALPE/2.0
22456          ANUM=AP*((AP/AN2) - (AP/AM))
22457          ADENOM=2.0*((AP/AM)*(AP/AN2) - 1.0)
22458          IF(ADENOM.EQ.0.0)THEN
22459            WRITE(ICOUT,999)
22460            CALL DPWRST('XXX','WRIT')
22461            WRITE(ICOUT,2201)
22462            CALL DPWRST('XXX','WRIT')
22463            WRITE(ICOUT,2253)
22464 2253       FORMAT('      DIVISION BY ZERO ENCOUNTERED IN COMPUTING')
22465            CALL DPWRST('XXX','WRIT')
22466            WRITE(ICOUT,2255)
22467 2255       FORMAT('      ESTIMATE OF LOCATION FOR JOHNSON SB.')
22468            CALL DPWRST('XXX','WRIT')
22469            WRITE(ICOUT,2257)
22470 2257       FORMAT('NO JOHNSON SB/SU ESTIMATION IS PERFORMED.')
22471            CALL DPWRST('XXX','WRIT')
22472            WRITE(ICOUT,2227)Z
22473            CALL DPWRST('XXX','WRIT')
22474            WRITE(ICOUT,999)
22475            CALL DPWRST('XXX','WRIT')
22476            GOTO9000
22477          ELSE
22478            ALOCPE=TERM1 - TERM2 + (ANUM/ADENOM)
22479          ENDIF
22480          IJOHN=1
22481C
22482        ENDIF
22483C
22484      ENDIF
22485C
22486C               **************************************
22487C               **  STEP 31--                       **
22488C               **  CARRY OUT CALCULATIONS          **
22489C               **  FOR JOHNSON MOMENT     ESTIMATE **
22490C               **************************************
22491C
22492C     NOTE: MOMENT ESTIMATE CURRENTLY ONLY AVAILABLE
22493C           FOR RAW (I.E., UNBINNED DATA).
22494C
22495      ISTEPN='31'
22496      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLJO')
22497     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
22498C
22499      IF(NVAR.EQ.1)THEN
22500        IF(ICASE.EQ.'JB')THEN
22501          IDIST2='JOHNSON SB'
22502          ITYPE2=3
22503        ELSE
22504          IDIST2='JOHNSON SU'
22505          ITYPE2=2
22506        ENDIF
22507        CALL JNSN(XMEAN,XSD,XSKEW,XKURT,ITYPE2,ALPHM1,ALPHM2,
22508     1            SCALMO,ALOCMO,IFAULT)
22509        IF(IFAULT.EQ.1)THEN
22510          WRITE(ICOUT,999)
22511          CALL DPWRST('XXX','WRIT')
22512          WRITE(ICOUT,3101)IDIST2
22513 3101     FORMAT('***** ERROR FOR ',A10,' METHOD OF MOMENTS.')
22514          CALL DPWRST('XXX','WRIT')
22515          WRITE(ICOUT,3103)
22516 3103     FORMAT('      COMPUTED STANDARD DEVIATION LESS THAN ZERO.')
22517          CALL DPWRST('XXX','WRIT')
22518          GOTO9000
22519        ELSEIF(IFAULT.EQ.2)THEN
22520          WRITE(ICOUT,999)
22521          CALL DPWRST('XXX','WRIT')
22522          WRITE(ICOUT,3101)IDIST2
22523          CALL DPWRST('XXX','WRIT')
22524          WRITE(ICOUT,3106)
22525 3106     FORMAT('      KURTOSIS < SKEWNESS**2 + 1')
22526          CALL DPWRST('XXX','WRIT')
22527          GOTO9000
22528        ELSEIF(IFAULT.EQ.3)THEN
22529          WRITE(ICOUT,999)
22530          CALL DPWRST('XXX','WRIT')
22531          WRITE(ICOUT,3101)IDIST2
22532          CALL DPWRST('XXX','WRIT')
22533          WRITE(ICOUT,3108)
22534 3108     FORMAT('      FITTING FAILED TO CONVERGE.')
22535          CALL DPWRST('XXX','WRIT')
22536        ENDIF
22537C
22538      ENDIF
22539C
22540C               ***************************************
22541C               **   STEP 42--                      **
22542C               **   WRITE OUT EVERYTHING           **
22543C               **   FOR JOHNSON SB/SU ESTIMATION   **
22544C               **************************************
22545C
22546      ISTEPN='42'
22547      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLJO')
22548     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
22549C
22550C     PRINT SUMMARY STATISTICS TABLE
22551C
22552      NUMDIG=7
22553      IF(IFORSW.EQ.'1')NUMDIG=1
22554      IF(IFORSW.EQ.'2')NUMDIG=2
22555      IF(IFORSW.EQ.'3')NUMDIG=3
22556      IF(IFORSW.EQ.'4')NUMDIG=4
22557      IF(IFORSW.EQ.'5')NUMDIG=5
22558      IF(IFORSW.EQ.'6')NUMDIG=6
22559      IF(IFORSW.EQ.'7')NUMDIG=7
22560      IF(IFORSW.EQ.'8')NUMDIG=8
22561      IF(IFORSW.EQ.'9')NUMDIG=9
22562      IF(IFORSW.EQ.'0')NUMDIG=0
22563      IF(IFORSW.EQ.'E')NUMDIG=-2
22564      IF(IFORSW.EQ.'-2')NUMDIG=-2
22565      IF(IFORSW.EQ.'-3')NUMDIG=-3
22566      IF(IFORSW.EQ.'-4')NUMDIG=-4
22567      IF(IFORSW.EQ.'-5')NUMDIG=-5
22568      IF(IFORSW.EQ.'-6')NUMDIG=-6
22569      IF(IFORSW.EQ.'-7')NUMDIG=-7
22570      IF(IFORSW.EQ.'-8')NUMDIG=-8
22571      IF(IFORSW.EQ.'-9')NUMDIG=-9
22572C
22573      ITITLE='Johnson SB/SU Parameter Estimation: Full Sample Case'
22574      NCTITL=52
22575      ITITLZ=' '
22576      NCTITZ=0
22577C
22578      ICNT=1
22579      ITEXT(ICNT)='Summary Statistics:'
22580      NCTEXT(ICNT)=19
22581      AVALUE(ICNT)=0.0
22582      IDIGIT(ICNT)=-1
22583      ICNT=ICNT+1
22584      ITEXT(ICNT)='Number of Observations:'
22585      NCTEXT(ICNT)=23
22586      AVALUE(ICNT)=REAL(NTOTZZ)
22587      IDIGIT(ICNT)=0
22588      ICNT=ICNT+1
22589      ITEXT(ICNT)='Sample Mean:'
22590      NCTEXT(ICNT)=12
22591      AVALUE(ICNT)=XMEAN
22592      IDIGIT(ICNT)=NUMDIG
22593      ICNT=ICNT+1
22594      ITEXT(ICNT)='Sample Standard Deviation:'
22595      NCTEXT(ICNT)=26
22596      AVALUE(ICNT)=XSD
22597      IDIGIT(ICNT)=NUMDIG
22598      ICNT=ICNT+1
22599      ITEXT(ICNT)='Sample Minimum:'
22600      NCTEXT(ICNT)=15
22601      AVALUE(ICNT)=XMIN
22602      IDIGIT(ICNT)=NUMDIG
22603      ICNT=ICNT+1
22604      ITEXT(ICNT)='Sample Maximum:'
22605      NCTEXT(ICNT)=15
22606      AVALUE(ICNT)=XMAX
22607      IDIGIT(ICNT)=NUMDIG
22608      ICNT=ICNT+1
22609      ITEXT(ICNT)=' '
22610      NCTEXT(ICNT)=0
22611      AVALUE(ICNT)=0.0
22612      IDIGIT(ICNT)=-1
22613C
22614      IF(NVAR.GT.1)GOTO4209
22615C
22616      ICNT=ICNT+1
22617      ITEXT(ICNT)='Percentile Method:'
22618      NCTEXT(ICNT)=18
22619      AVALUE(ICNT)=0.0
22620      IDIGIT(ICNT)=-1
22621      ICNT=ICNT+1
22622      ITEXT(ICNT)='Value of Z:'
22623      NCTEXT(ICNT)=11
22624      AVALUE(ICNT)=Z
22625      IDIGIT(ICNT)=NUMDIG
22626      ICNT=ICNT+1
22627      ITEXT(ICNT)='Value of PZ = NORCDF(Z):'
22628      NCTEXT(ICNT)=24
22629      AVALUE(ICNT)=PZ
22630      IDIGIT(ICNT)=NUMDIG
22631      ICNT=ICNT+1
22632      ITEXT(ICNT)='Value of PZM = NORCDF(-Z):'
22633      NCTEXT(ICNT)=26
22634      AVALUE(ICNT)=PZM
22635      IDIGIT(ICNT)=NUMDIG
22636      ICNT=ICNT+1
22637      ITEXT(ICNT)='Value of PZ3 = NORCDF(3*Z):'
22638      NCTEXT(ICNT)=27
22639      AVALUE(ICNT)=PZ3
22640      IDIGIT(ICNT)=NUMDIG
22641      ICNT=ICNT+1
22642      ITEXT(ICNT)='Value of PZ3M = NORCDF(-3*Z):'
22643      NCTEXT(ICNT)=29
22644      AVALUE(ICNT)=PZ3M
22645      IDIGIT(ICNT)=NUMDIG
22646C
22647      ICNT=ICNT+1
22648      ITEXT(ICNT)='Value of Quantile(0.5 + PZ/N):'
22649      NCTEXT(ICNT)=30
22650      AVALUE(ICNT)=XZ
22651      IDIGIT(ICNT)=NUMDIG
22652      ICNT=ICNT+1
22653      ITEXT(ICNT)='Value of Quantile(0.5 + PZM/N):'
22654      NCTEXT(ICNT)=31
22655      AVALUE(ICNT)=XZM
22656      IDIGIT(ICNT)=NUMDIG
22657      ICNT=ICNT+1
22658      ITEXT(ICNT)='Value of Quantile(0.5 + PZ3/N):'
22659      NCTEXT(ICNT)=31
22660      AVALUE(ICNT)=XZ3
22661      IDIGIT(ICNT)=NUMDIG
22662      ICNT=ICNT+1
22663      ITEXT(ICNT)='Value of Quantile(0.5 + PZ3M/N):'
22664      NCTEXT(ICNT)=32
22665      AVALUE(ICNT)=XZ3M
22666      IDIGIT(ICNT)=NUMDIG
22667C
22668      ICNT=ICNT+1
22669      ITEXT(ICNT)='Value of M = XZ3 - XZ:'
22670      NCTEXT(ICNT)=22
22671      AVALUE(ICNT)=AM
22672      IDIGIT(ICNT)=NUMDIG
22673      ICNT=ICNT+1
22674      ITEXT(ICNT)='Value of N = XZM - XZ3:'
22675      NCTEXT(ICNT)=23
22676      AVALUE(ICNT)=AN2
22677      IDIGIT(ICNT)=NUMDIG
22678      ICNT=ICNT+1
22679      ITEXT(ICNT)='Value of P = XZ - XZM:'
22680      NCTEXT(ICNT)=22
22681      AVALUE(ICNT)=AP
22682      IDIGIT(ICNT)=NUMDIG
22683C
22684      ICNT=ICNT+1
22685      ITEXT(ICNT)='Value of ACUT = M*N/P**2:'
22686      NCTEXT(ICNT)=25
22687      AVALUE(ICNT)=ACUT
22688      IDIGIT(ICNT)=NUMDIG
22689      IF(ACUT.GT.1.0)THEN
22690        ICNT=ICNT+1
22691        ITEXT(ICNT)='ACUT > 1 => Johnson SU Distribution:'
22692        NCTEXT(ICNT)=36
22693        AVALUE(ICNT)=0.0
22694        IDIGIT(ICNT)=-1
22695      ELSE
22696        ICNT=ICNT+1
22697        ITEXT(ICNT)='ACUT < 1 => Johnson SB Distribution:'
22698        NCTEXT(ICNT)=36
22699        AVALUE(ICNT)=0.0
22700        IDIGIT(ICNT)=-1
22701      ENDIF
22702C
22703      ICNT=ICNT+1
22704      ITEXT(ICNT)='Estimate of Alpha1:'
22705      NCTEXT(ICNT)=19
22706      AVALUE(ICNT)=ALPHP1
22707      IDIGIT(ICNT)=NUMDIG
22708      ICNT=ICNT+1
22709      ITEXT(ICNT)='Estimate of Alpha2:'
22710      NCTEXT(ICNT)=19
22711      AVALUE(ICNT)=ALPHP2
22712      IDIGIT(ICNT)=NUMDIG
22713      ICNT=ICNT+1
22714      ITEXT(ICNT)='Estimate of Location:'
22715      NCTEXT(ICNT)=21
22716      AVALUE(ICNT)=ALOCPE
22717      IDIGIT(ICNT)=NUMDIG
22718      ICNT=ICNT+1
22719      ITEXT(ICNT)='Estimate of Scale:'
22720      NCTEXT(ICNT)=18
22721      AVALUE(ICNT)=SCALPE
22722      IDIGIT(ICNT)=NUMDIG
22723C
22724      IF(NVAR.GT.1)GOTO4209
22725C
22726      ICNT=ICNT+1
22727      ITEXT(ICNT)=' '
22728      NCTEXT(ICNT)=0
22729      AVALUE(ICNT)=0.0
22730      IDIGIT(ICNT)=-1
22731      ICNT=ICNT+1
22732      IF(ICASE.EQ.'SB')THEN
22733        ITEXT(ICNT)='Johnson SB Moments Method:'
22734        NCTEXT(ICNT)=26
22735      ELSE
22736        ITEXT(ICNT)='Johnson SU Moments Method:'
22737        NCTEXT(ICNT)=26
22738      ENDIF
22739      AVALUE(ICNT)=0.0
22740      IDIGIT(ICNT)=-1
22741      ICNT=ICNT+1
22742      ITEXT(ICNT)='Estimate of Alpha1:'
22743      NCTEXT(ICNT)=19
22744      AVALUE(ICNT)=ALPHM1
22745      IDIGIT(ICNT)=NUMDIG
22746      ICNT=ICNT+1
22747      ITEXT(ICNT)='Estimate of Alpha2:'
22748      NCTEXT(ICNT)=19
22749      AVALUE(ICNT)=ALPHM2
22750      IDIGIT(ICNT)=NUMDIG
22751      ICNT=ICNT+1
22752      ITEXT(ICNT)='Estimate of Location:'
22753      NCTEXT(ICNT)=21
22754      AVALUE(ICNT)=ALOCMO
22755      IDIGIT(ICNT)=NUMDIG
22756      ICNT=ICNT+1
22757      ITEXT(ICNT)='Estimate of Scale:'
22758      NCTEXT(ICNT)=18
22759      AVALUE(ICNT)=SCALMO
22760      IDIGIT(ICNT)=NUMDIG
22761C
22762 4209 CONTINUE
22763C
22764      NUMROW=ICNT
22765      DO2310I=1,NUMROW
22766        NTOT(I)=15
22767 2310 CONTINUE
22768C
22769      IFRST=.TRUE.
22770      ILAST=.TRUE.
22771      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
22772     1            AVALUE,IDIGIT,
22773     1            NTOT,NUMROW,
22774     1            ICAPSW,ICAPTY,ILAST,IFRST,
22775     1            ISUBRO,IBUGA3,IERROR)
22776C
22777C               *****************
22778C               **  STEP 90--  **
22779C               **  EXIT       **
22780C               *****************
22781C
22782 9000 CONTINUE
22783      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLJO')THEN
22784        WRITE(ICOUT,999)
22785        CALL DPWRST('XXX','WRIT')
22786        WRITE(ICOUT,9011)
22787 9011   FORMAT('***** AT THE END       OF DPMLJO--')
22788        CALL DPWRST('XXX','WRIT')
22789        WRITE(ICOUT,9012)IERROR
22790 9012   FORMAT('IERROR = ',A4)
22791        CALL DPWRST('XXX','WRIT')
22792      ENDIF
22793C
22794      RETURN
22795      END
22796      SUBROUTINE DPMLKA(Y,X,N,NVAR,
22797     1                  TEMP1,TEMP2,TEMP3,
22798     1                  ALPHMO,BETAMO,ALPHML,BETAML,
22799     1                  AICMO,AICCMO,BICMO,
22800     1                  AICML,AICCML,BICML,
22801     1                  ICAPSW,ICAPTY,IFORSW,MAXNXT,
22802     1                  ISUBRO,IBUGA3,IERROR)
22803C
22804C     PURPOSE--THIS ROUTINE COMPUTES THE METHOD OF MOMENT ESTIMATES
22805C              FOR THE KATZ DISTRIBUTION (NEED TO OBTAIN THE KATZ
22806C              ARTICLE TO ADD MAXIMUM LIKELIHOOD ESTIMATES).
22807C
22808C              KATZ PROPOSED THE REPARAMETERIZATION:
22809C
22810C                 MU = ALPHA/(1 - BETA)
22811C
22812C                 ETA = BETA/(1 - BETA)
22813C                     = (SIGMA**2 - MU)/MU
22814C
22815C              SO THE MOMENT ESTIMATES OF MU AND ETA ARE:
22816C
22817C                 MUHAT = XBAR
22818C                 ETAHAT = (S**2 - XBAR)/XBAR
22819C
22820C              WITH XBAR AND S**2 DENOTING THE SAMPLE MEAN AND
22821C              SAMPLE VARIANCE, RESPECTIVELY.  THE MOMENT ESTIMATES
22822C              FOR ALPHA AND BETA CAN BE DETERMINED FROM MUHAT
22823C              AND ETAHAT AS:
22824C
22825C                 ALPHAHAT = MUHAT*(1 - ETAHAT/(ETAHAT+1))
22826C                 BETAHAT  = ETAHAT/(ETAHAT+1)
22827C
22828C     EXAMPLE--KATZ MAXIMUM LIKELIHOOD Y
22829C     REFERENCE--"UNIVARIATE DISCRETE DISTRIBUTIONS", THIRD EDITION,
22830C                JOHNSON, KEMP, AND KOTZ, WILEY, PP. 82-83.
22831C     WRITTEN BY--ALAN HECKERT
22832C                 STATISTICAL ENGINEERING DIVISION
22833C                 INFORMATION TECHNOLOGY LABORATORY
22834C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
22835C                 GAITHERSBURG, MD 20899-8980
22836C                 PHONE--301-975-2899
22837C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
22838C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
22839C     LANGUAGE--ANSI FORTRAN (1977)
22840C     VERSION NUMBER--2007/3
22841C     ORIGINAL VERSION--MARCH     2007.
22842C     UPDATED         --APRIL     2011. USE DPDTA1 TO PRINT OUTPUT
22843C
22844C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
22845C
22846      CHARACTER*4 ICAPSW
22847      CHARACTER*4 ICAPTY
22848      CHARACTER*4 IFORSW
22849      CHARACTER*4 ISUBRO
22850      CHARACTER*4 IBUGA3
22851      CHARACTER*4 IERROR
22852C
22853      CHARACTER*4 IWRITE
22854      CHARACTER*4 ISUBN1
22855      CHARACTER*4 ISUBN2
22856      CHARACTER*4 ISTEPN
22857C
22858C---------------------------------------------------------------------
22859C
22860      DIMENSION Y(*)
22861      DIMENSION X(*)
22862      DIMENSION TEMP1(*)
22863      DIMENSION TEMP2(*)
22864      DIMENSION TEMP3(*)
22865C
22866      PARAMETER (MAXROW=20)
22867      CHARACTER*60 ITITLE
22868      CHARACTER*1  ITITLZ
22869      CHARACTER*40 IDIST
22870      CHARACTER*40 ITEXT(MAXROW)
22871      REAL         AVALUE(MAXROW)
22872      INTEGER      NCTEXT(MAXROW)
22873      INTEGER      IDIGIT(MAXROW)
22874      INTEGER      NTOT(MAXROW)
22875      LOGICAL      IFRST
22876      LOGICAL      ILAST
22877C
22878C---------------------------------------------------------------------
22879C
22880      INCLUDE 'DPCOP2.INC'
22881C
22882C-----START POINT-----------------------------------------------------
22883C
22884      ISUBN1='DPML'
22885      ISUBN2='KA  '
22886      IERROR='NO'
22887      IWRITE='OFF'
22888C
22889      ALPHMO=CPUMIN
22890      BETAMO=CPUMIN
22891      ALPHML=CPUMIN
22892      BETAML=CPUMIN
22893      AICML=CPUMIN
22894      AICCML=CPUMIN
22895      BICML=CPUMIN
22896      AICMO=CPUMIN
22897      AICCMO=CPUMIN
22898      BICMO=CPUMIN
22899C
22900      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLKA')THEN
22901        WRITE(ICOUT,999)
22902  999   FORMAT(1X)
22903        CALL DPWRST('XXX','WRIT')
22904        WRITE(ICOUT,51)
22905   51   FORMAT('**** AT THE BEGINNING OF DPMLKA--')
22906        CALL DPWRST('XXX','WRIT')
22907        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR
22908   52   FORMAT('IBUGA3,ISUBRO,N,NVAR = ',2(A4,2X),2I8)
22909        CALL DPWRST('XXX','WRIT')
22910        IF(NVAR.EQ.1)THEN
22911          DO56I=1,MIN(N,100)
22912            WRITE(ICOUT,57)I,Y(I)
22913   57       FORMAT('I,Y(I) = ',I8,G15.7)
22914            CALL DPWRST('XXX','WRIT')
22915   56     CONTINUE
22916        ELSE
22917          DO61I=1,N
22918            WRITE(ICOUT,62)I,X(I),Y(I)
22919   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
22920            CALL DPWRST('XXX','WRIT')
22921   61     CONTINUE
22922        ENDIF
22923       ENDIF
22924C
22925C               ********************************************
22926C               **  STEP 11--                             **
22927C               **  1) ROUND DATA TO INTEGER VALUES       **
22928C               **  2) COMPUTE SUMMARY STATISTICS         **
22929C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
22930C               **     INSUFFICIENT SAMPLE SIZE           **
22931C               ********************************************
22932C
22933      ISTEPN='11'
22934      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLKA')
22935     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
22936C
22937      IDIST='KATZ'
22938C
22939      NPERC=0
22940      MAXGRP=MAXNXT/2
22941      NMIN=2
22942      IF(NVAR.EQ.1)THEN
22943        DO1105I=1,N
22944          ITEMP=INT(Y(I)+0.5)
22945          Y(I)=REAL(ITEMP)
22946 1105   CONTINUE
22947        CALL CKDIST(Y,N,NMIN,TEMP2,NPERC,ISUBRO,IBUGA3,IERROR)
22948        IF(IERROR.EQ.'YES')GOTO9000
22949C
22950        IFLAG=1
22951        CALL SUMRAW(Y,N,IDIST,IFLAG,
22952     1              XMEAN,XVAR,XSD,XMIN,XMAX,
22953     1              ISUBRO,IBUGA3,IERROR)
22954        IF(IERROR.EQ.'YES')GOTO9000
22955        NTOTZZ=N
22956C
22957      ELSE
22958        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
22959     1              ISUBRO,IBUGA3,IERROR)
22960        IF(IERROR.EQ.'YES')GOTO9000
22961        IFLAG1=1
22962        IFLAG2=1
22963        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
22964     1              TEMP1,TEMP2,TEMP3,MAXNXT,
22965     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
22966     1              ISUBRO,IBUGA3,IERROR)
22967        IF(IERROR.EQ.'YES')GOTO9000
22968      ENDIF
22969C
22970      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLKA')THEN
22971        WRITE(ICOUT,999)
22972        CALL DPWRST('XXX','WRIT')
22973        WRITE(ICOUT,1151)
22974 1151   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
22975        CALL DPWRST('XXX','WRIT')
22976        WRITE(ICOUT,1152)XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ
22977 1152   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ = ',5G15.7,I10)
22978        CALL DPWRST('XXX','WRIT')
22979      ENDIF
22980C
22981C               ******************************************
22982C               **  STEP 21--                           **
22983C               **  CARRY OUT CALCULATIONS              **
22984C               **  FOR KATZ MLE ESTIMATE               **
22985C               ******************************************
22986C
22987C
22988      ISTEPN='21'
22989      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLKA')
22990     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
22991C
22992      AMUHAT=XMEAN
22993      ETAHAT=(XVAR - XMEAN)/XMEAN
22994      ALPHMO=AMUHAT*(1.0 - ETAHAT/(ETAHAT+1.0))
22995      BETAMO=ETAHAT/(ETAHAT + 1.0)
22996C
22997C               ******************************************
22998C               **   STEP 42--                          **
22999C               **   WRITE OUT EVERYTHING               **
23000C               **   FOR KATZ MLE ESTIMATE             **
23001C               ******************************************
23002C
23003      ISTEPN='42'
23004      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLKA')
23005     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23006C
23007C     PRINT SUMMARY STATISTICS TABLE
23008C
23009      NUMDIG=7
23010      IF(IFORSW.EQ.'1')NUMDIG=1
23011      IF(IFORSW.EQ.'2')NUMDIG=2
23012      IF(IFORSW.EQ.'3')NUMDIG=3
23013      IF(IFORSW.EQ.'4')NUMDIG=4
23014      IF(IFORSW.EQ.'5')NUMDIG=5
23015      IF(IFORSW.EQ.'6')NUMDIG=6
23016      IF(IFORSW.EQ.'7')NUMDIG=7
23017      IF(IFORSW.EQ.'8')NUMDIG=8
23018      IF(IFORSW.EQ.'9')NUMDIG=9
23019      IF(IFORSW.EQ.'0')NUMDIG=0
23020      IF(IFORSW.EQ.'E')NUMDIG=-2
23021      IF(IFORSW.EQ.'-2')NUMDIG=-2
23022      IF(IFORSW.EQ.'-3')NUMDIG=-3
23023      IF(IFORSW.EQ.'-4')NUMDIG=-4
23024      IF(IFORSW.EQ.'-5')NUMDIG=-5
23025      IF(IFORSW.EQ.'-6')NUMDIG=-6
23026      IF(IFORSW.EQ.'-7')NUMDIG=-7
23027      IF(IFORSW.EQ.'-8')NUMDIG=-8
23028      IF(IFORSW.EQ.'-9')NUMDIG=-9
23029C
23030      ITITLE='Katz Parameter Estimation'
23031      NCTITL=25
23032      ITITLZ=' '
23033      NCTITZ=0
23034C
23035      ICNT=1
23036      ITEXT(ICNT)='Summary Statistics:'
23037      NCTEXT(ICNT)=19
23038      AVALUE(ICNT)=0.0
23039      IDIGIT(ICNT)=-1
23040      ICNT=ICNT+1
23041      ITEXT(ICNT)='Number of Observations:'
23042      NCTEXT(ICNT)=23
23043      AVALUE(ICNT)=REAL(NTOTZZ)
23044      IDIGIT(ICNT)=0
23045      ICNT=ICNT+1
23046      ITEXT(ICNT)='Sample Mean:'
23047      NCTEXT(ICNT)=12
23048      AVALUE(ICNT)=XMEAN
23049      IDIGIT(ICNT)=NUMDIG
23050      ICNT=ICNT+1
23051      ITEXT(ICNT)='Sample Standard Deviation:'
23052      NCTEXT(ICNT)=26
23053      AVALUE(ICNT)=XSD
23054      IDIGIT(ICNT)=NUMDIG
23055      ICNT=ICNT+1
23056      ITEXT(ICNT)='Sample Minimum:'
23057      NCTEXT(ICNT)=15
23058      AVALUE(ICNT)=XMIN
23059      IDIGIT(ICNT)=NUMDIG
23060      ICNT=ICNT+1
23061      ITEXT(ICNT)='Sample Maximum:'
23062      NCTEXT(ICNT)=15
23063      AVALUE(ICNT)=XMAX
23064      IDIGIT(ICNT)=NUMDIG
23065      ICNT=ICNT+1
23066      ITEXT(ICNT)=' '
23067      NCTEXT(ICNT)=0
23068      AVALUE(ICNT)=0.0
23069      IDIGIT(ICNT)=-1
23070C
23071      ICNT=ICNT+1
23072      ITEXT(ICNT)='Moment Estimates:'
23073      NCTEXT(ICNT)=17
23074      AVALUE(ICNT)=0.0
23075      IDIGIT(ICNT)=-1
23076      ICNT=ICNT+1
23077      ITEXT(ICNT)='Estimate of Alpha:'
23078      NCTEXT(ICNT)=18
23079      AVALUE(ICNT)=ALPHMO
23080      IDIGIT(ICNT)=NUMDIG
23081      ICNT=ICNT+1
23082      ITEXT(ICNT)='Estimate of Beta:'
23083      NCTEXT(ICNT)=17
23084      AVALUE(ICNT)=BETAMO
23085      IDIGIT(ICNT)=NUMDIG
23086C
23087      NUMROW=ICNT
23088      DO2310I=1,NUMROW
23089        NTOT(I)=15
23090 2310 CONTINUE
23091C
23092      IFRST=.TRUE.
23093      ILAST=.TRUE.
23094      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
23095     1            AVALUE,IDIGIT,
23096     1            NTOT,NUMROW,
23097     1            ICAPSW,ICAPTY,ILAST,IFRST,
23098     1            ISUBRO,IBUGA3,IERROR)
23099C
23100C               *****************
23101C               **  STEP 90--  **
23102C               **  EXIT       **
23103C               *****************
23104C
23105 9000 CONTINUE
23106      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLKA')THEN
23107        WRITE(ICOUT,999)
23108        CALL DPWRST('XXX','WRIT')
23109        WRITE(ICOUT,9011)
23110 9011   FORMAT('***** AT THE END       OF DPMLKA--')
23111        CALL DPWRST('XXX','WRIT')
23112        WRITE(ICOUT,9012)IERROR,ALPHMO,BETAMO
23113 9012   FORMAT('IERROR,ALPHMO,BETAMO = ',A4,2X,2G15.7)
23114        CALL DPWRST('XXX','WRIT')
23115      ENDIF
23116C
23117      RETURN
23118      END
23119      SUBROUTINE DPMLKP(Y,N,
23120     1                  DTEMP1,XMOM,MAXNXT,
23121     1                  SHA1LM,SHA2LM,ALOCLM,SCALLM,
23122     1                  ICAPSW,ICAPTY,IFORSW,
23123     1                  ISUBRO,IBUGA3,IERROR)
23124C
23125C     PURPOSE--THIS ROUTINE COMPUTES THE L-MOMENT ESTIMATES
23126C              FOR THE KAPPA DISTRIBUTION
23127C     EXAMPLE--KAPPA MAXIMUM LIKELIHOOD Y
23128C     REFERENCE--FORTRAN CODE WRITTEN FOR INCLUSION IN IBM
23129C                RESEARCH REPORT RC20525, 'FORTRAN ROUTINES FOR
23130C                USE WITH THE METHOD OF L-MOMENTS, VERSION 3',
23131C                J. R. M. HOSKING, IBM RESEARCH DIVISION,
23132C                T. J. WATSON RESEARCH CENTER, YORKTOWN HEIGHTS
23133C                NEW YORK 10598, U.S.A., VERSION 3     AUGUST 1996
23134C     WRITTEN BY--ALAN HECKERT
23135C                 STATISTICAL ENGINEERING DIVISION
23136C                 INFORMATION TECHNOLOGY LABORATORY
23137C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
23138C                 GAITHERSBUG, MD 20899-8980
23139C                 PHONE--301-975-2899
23140C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
23141C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
23142C     LANGUAGE--ANSI FORTRAN (1977)
23143C     VERSION NUMBER--2008/6
23144C     ORIGINAL VERSION--JUNE      2008.
23145C     UPDATED         --JULY      2010. EXTRACT POINT ESTIMATES TO KAPML1
23146C     UPDATED         --JULY      2010. USE DPDTA1 TO PRINT OUTPUT
23147C
23148C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
23149C
23150      CHARACTER*4 ICAPSW
23151      CHARACTER*4 ICAPTY
23152      CHARACTER*4 IFORSW
23153      CHARACTER*4 ISUBRO
23154      CHARACTER*4 IBUGA3
23155      CHARACTER*4 IERROR
23156C
23157      CHARACTER*4 IWRITE
23158      CHARACTER*4 ISUBN1
23159      CHARACTER*4 ISUBN2
23160      CHARACTER*4 ISTEPN
23161C
23162C---------------------------------------------------------------------
23163C
23164      DIMENSION Y(*)
23165      DIMENSION QP(1)
23166      DOUBLE PRECISION DTEMP1(*)
23167      DOUBLE PRECISION XMOM(*)
23168C
23169CCCCC PARAMETER (NUMALP=6)
23170CCCCC DIMENSION ALPHA(NUMALP)
23171CCCCC DIMENSION ALOWSC(NUMALP)
23172CCCCC DIMENSION AUPPSC(NUMALP)
23173CCCCC DIMENSION ALOWGA(NUMALP)
23174CCCCC DIMENSION AUPPGA(NUMALP)
23175C
23176      PARAMETER (MAXROW=20)
23177      CHARACTER*60 ITITLE
23178      CHARACTER*60 ITITLZ
23179      CHARACTER*40 ITEXT(MAXROW)
23180      REAL         AVALUE(MAXROW)
23181      INTEGER      NCTEXT(MAXROW)
23182      INTEGER      IDIGIT(MAXROW)
23183      INTEGER      NTOT(MAXROW)
23184      LOGICAL IFRST
23185      LOGICAL ILAST
23186C
23187C---------------------------------------------------------------------
23188C
23189      INCLUDE 'DPCOP2.INC'
23190C
23191CCCCC DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
23192C
23193C-----START POINT-----------------------------------------------------
23194C
23195      ISUBN1='DPML'
23196      ISUBN2='KP  '
23197      IERROR='NO'
23198C
23199      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLKP')THEN
23200        WRITE(ICOUT,999)
23201  999   FORMAT(1X)
23202        CALL DPWRST('XXX','WRIT')
23203        WRITE(ICOUT,51)
23204   51   FORMAT('**** AT THE BEGINNING OF DPMLKP--')
23205        CALL DPWRST('XXX','WRIT')
23206        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,MAXNXT
23207   52   FORMAT('IBUGA3,ISUBRO,N,MAXNXT = ',2(A4,2X),2I8)
23208        CALL DPWRST('XXX','WRIT')
23209        DO56I=1,MIN(N,100)
23210          WRITE(ICOUT,57)I,Y(I)
23211   57     FORMAT('I,Y(I) = ',I8,G15.7)
23212          CALL DPWRST('XXX','WRIT')
23213   56   CONTINUE
23214      ENDIF
23215C
23216C               ********************************************
23217C               **  STEP 11--                             **
23218C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
23219C               ********************************************
23220C
23221      ISTEPN='11'
23222      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLKP')
23223     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23224C
23225C               ***************************************************
23226C               **  STEP 21--                                    **
23227C               **  CARRY OUT CALCULATIONS                       **
23228C               **  FOR KAPPA L-MOMENT ESTIMATION                **
23229C               ***************************************************
23230C
23231      ISTEPN='21'
23232      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLKP')
23233     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23234C
23235      NPERC=0
23236      NMIN=3
23237      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
23238      IF(IERROR.EQ.'YES')GOTO9000
23239C
23240      IERROR='NO'
23241      IWRITE='OFF'
23242C
23243      CALL KAPML1(Y,N,
23244     1            DTEMP1,XMOM,NMOM,
23245     1            XMEAN,XSD,XVAR,XMIN,XMAX,
23246     1            ALOCLM,SCALLM,SHA1LM,SHA2LM,
23247     1            ISUBRO,IBUGA3,IERROR)
23248      IF(IERROR.EQ.'YES')GOTO9000
23249C
23250C               ***********************************************
23251C               **   STEP 42--                               **
23252C               **   WRITE OUT EVERYTHING                    **
23253C               **   FOR KAPPA MLE ESTIMATION                **
23254C               ***********************************************
23255C
23256      ISTEPN='42'
23257      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLKP')
23258     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23259      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23260C
23261      IF(IPRINT.EQ.'OFF')GOTO9000
23262C
23263      NUMDIG=7
23264      IF(IFORSW.EQ.'1')NUMDIG=1
23265      IF(IFORSW.EQ.'2')NUMDIG=2
23266      IF(IFORSW.EQ.'3')NUMDIG=3
23267      IF(IFORSW.EQ.'4')NUMDIG=4
23268      IF(IFORSW.EQ.'5')NUMDIG=5
23269      IF(IFORSW.EQ.'6')NUMDIG=6
23270      IF(IFORSW.EQ.'7')NUMDIG=7
23271      IF(IFORSW.EQ.'8')NUMDIG=8
23272      IF(IFORSW.EQ.'9')NUMDIG=9
23273      IF(IFORSW.EQ.'0')NUMDIG=0
23274      IF(IFORSW.EQ.'E')NUMDIG=-2
23275      IF(IFORSW.EQ.'-2')NUMDIG=-2
23276      IF(IFORSW.EQ.'-3')NUMDIG=-3
23277      IF(IFORSW.EQ.'-4')NUMDIG=-4
23278      IF(IFORSW.EQ.'-5')NUMDIG=-5
23279      IF(IFORSW.EQ.'-6')NUMDIG=-6
23280      IF(IFORSW.EQ.'-7')NUMDIG=-7
23281      IF(IFORSW.EQ.'-8')NUMDIG=-8
23282      IF(IFORSW.EQ.'-9')NUMDIG=-9
23283C
23284      ITITLE='Kappa Parameter Estimation:'
23285      NCTITL=27
23286      ITITLZ='Full Sample Case'
23287      NCTITZ=16
23288      ICNT=1
23289      ITEXT(ICNT)='Summary Statistics:'
23290      NCTEXT(ICNT)=19
23291      AVALUE(ICNT)=0.0
23292      IDIGIT(ICNT)=-1
23293      ICNT=ICNT+1
23294      ITEXT(ICNT)='Number of Observations:'
23295      NCTEXT(ICNT)=23
23296      AVALUE(ICNT)=REAL(N)
23297      IDIGIT(ICNT)=0
23298      ICNT=ICNT+1
23299      ITEXT(ICNT)='Sample Mean:'
23300      NCTEXT(ICNT)=12
23301      AVALUE(ICNT)=XMEAN
23302      IDIGIT(ICNT)=NUMDIG
23303      ICNT=ICNT+1
23304      ITEXT(ICNT)='Sample Standard Deviation:'
23305      NCTEXT(ICNT)=26
23306      AVALUE(ICNT)=XSD
23307      IDIGIT(ICNT)=NUMDIG
23308      ICNT=ICNT+1
23309      ITEXT(ICNT)='Sample Minimum:'
23310      NCTEXT(ICNT)=15
23311      AVALUE(ICNT)=XMIN
23312      IDIGIT(ICNT)=NUMDIG
23313      ICNT=ICNT+1
23314      ITEXT(ICNT)='Sample Maximum:'
23315      NCTEXT(ICNT)=15
23316      AVALUE(ICNT)=XMAX
23317      IDIGIT(ICNT)=NUMDIG
23318      ICNT=ICNT+1
23319      ITEXT(ICNT)=' '
23320      NCTEXT(ICNT)=0
23321      AVALUE(ICNT)=0.0
23322      IDIGIT(ICNT)=-1
23323C
23324      ICNT=ICNT+1
23325      ITEXT(ICNT)='First Sample L-Moment:'
23326      NCTEXT(ICNT)=22
23327      AVALUE(ICNT)=REAL(XMOM(1))
23328      IDIGIT(ICNT)=NUMDIG
23329      ICNT=ICNT+1
23330      ITEXT(ICNT)='Second Sample L-Moment:'
23331      NCTEXT(ICNT)=23
23332      AVALUE(ICNT)=REAL(XMOM(2))
23333      IDIGIT(ICNT)=NUMDIG
23334      ICNT=ICNT+1
23335      ITEXT(ICNT)='Third Sample L-Moment:'
23336      NCTEXT(ICNT)=22
23337      AVALUE(ICNT)=REAL(XMOM(3))
23338      IDIGIT(ICNT)=NUMDIG
23339      ICNT=ICNT+1
23340      ITEXT(ICNT)='Fourth Sample L-Moment:'
23341      NCTEXT(ICNT)=23
23342      AVALUE(ICNT)=REAL(XMOM(4))
23343      IDIGIT(ICNT)=NUMDIG
23344      ICNT=ICNT+1
23345      ITEXT(ICNT)=' '
23346      NCTEXT(ICNT)=0
23347      AVALUE(ICNT)=0.0
23348      IDIGIT(ICNT)=-1
23349C
23350      ICNT=ICNT+1
23351      ITEXT(ICNT)='Method of L-Moments:'
23352      NCTEXT(ICNT)=20
23353      AVALUE(ICNT)=0.0
23354      IDIGIT(ICNT)=-1
23355      ICNT=ICNT+1
23356      ITEXT(ICNT)='Estimate of Location:'
23357      NCTEXT(ICNT)=22
23358      AVALUE(ICNT)=ALOCLM
23359      IDIGIT(ICNT)=NUMDIG
23360      ICNT=ICNT+1
23361      ITEXT(ICNT)='Estimate of Scale:'
23362      NCTEXT(ICNT)=18
23363      AVALUE(ICNT)=SCALLM
23364      IDIGIT(ICNT)=NUMDIG
23365      ICNT=ICNT+1
23366      ITEXT(ICNT)='Estimate of Shape Parameter K:'
23367      NCTEXT(ICNT)=30
23368      AVALUE(ICNT)=SHA1LM
23369      IDIGIT(ICNT)=NUMDIG
23370      ICNT=ICNT+1
23371      ITEXT(ICNT)='Estimate of Shape Parameter H:'
23372      NCTEXT(ICNT)=30
23373      AVALUE(ICNT)=SHA2LM
23374      IDIGIT(ICNT)=NUMDIG
23375      ICNT=ICNT+1
23376      ITEXT(ICNT)=' '
23377      NCTEXT(ICNT)=0
23378      AVALUE(ICNT)=0.0
23379      IDIGIT(ICNT)=-1
23380C
23381CCCCC ICNT=ICNT+1
23382CCCCC ITEXT(ICNT)='Log-likelihood:'
23383CCCCC NCTEXT(ICNT)=15
23384CCCCC AVALUE(ICNT)=ALIK
23385CCCCC IDIGIT(ICNT)=-7
23386CCCCC ICNT=ICNT+1
23387CCCCC ITEXT(ICNT)='AIC:'
23388CCCCC NCTEXT(ICNT)=4
23389CCCCC AVALUE(ICNT)=AIC
23390CCCCC IDIGIT(ICNT)=-7
23391CCCCC ICNT=ICNT+1
23392CCCCC ITEXT(ICNT)='AICc:'
23393CCCCC NCTEXT(ICNT)=5
23394CCCCC AVALUE(ICNT)=AICC
23395CCCCC IDIGIT(ICNT)=-7
23396CCCCC ICNT=ICNT+1
23397CCCCC ITEXT(ICNT)='BIC:'
23398CCCCC NCTEXT(ICNT)=4
23399CCCCC AVALUE(ICNT)=BIC
23400CCCCC IDIGIT(ICNT)=-7
23401C
23402      NUMROW=ICNT
23403      DO2320I=1,NUMROW
23404        NTOT(I)=15
23405 2320 CONTINUE
23406C
23407      IFRST=.TRUE.
23408      ILAST=.TRUE.
23409      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
23410     1            AVALUE,IDIGIT,
23411     1            NTOT,NUMROW,
23412     1            ICAPSW,ICAPTY,ILAST,IFRST,
23413     1            ISUBRO,IBUGA3,IERROR)
23414C
23415C               *****************
23416C               **  STEP 90--  **
23417C               **  EXIT       **
23418C               *****************
23419C
23420 9000 CONTINUE
23421      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLKP')THEN
23422        WRITE(ICOUT,999)
23423        CALL DPWRST('XXX','WRIT')
23424        WRITE(ICOUT,9011)
23425 9011   FORMAT('***** AT THE END       OF DPMLKP--')
23426        CALL DPWRST('XXX','WRIT')
23427        WRITE(ICOUT,9012)N,IBUGA3,IERROR
23428 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
23429        CALL DPWRST('XXX','WRIT')
23430        WRITE(ICOUT,9015)N
23431 9015   FORMAT('N = ',I8)
23432        CALL DPWRST('XXX','WRIT')
23433      ENDIF
23434C
23435      RETURN
23436      END
23437      SUBROUTINE DPMLLB(Y,N,
23438     1                  XTEMP,YLOG,MAXNXT,CUSER,DUSER,
23439     1                  ALPHSV,BETASV,CSV,DSV,
23440     1                  A,B,ALPHA2,BETA2,ALPHA1,BETA1,
23441     1                  ALPHSE,BETASE,COVSE,
23442     1                  QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
23443     1                  IOUNI1,IOUNI2,ALPHAP,
23444     1                  ICAPSW,ICAPTY,IFORSW,DTEMP1,
23445     1                  ISUBRO,IBUGA3,IERROR)
23446C
23447C     PURPOSE--THIS ROUTINE COMPUTES THE METHOD OF MOMENT AND
23448C              MAXIMUM LIKELIHOOD ESTIMATES FOR THE SHAPE PARAMETERS
23449C              OF THE LOG BETA DISTRIBUTION.
23450C
23451C              THE ALGORITHM IS TO TAKE THE LOG OF THE DATA,
23452C              COMPUTE THE BETA MOMENT/ML ESTIMATES, AND THEN
23453C              TAKE THE EXPONENT OF THE RESULTS.
23454C
23455C     EXAMPLE--LOG BETA MOMENTS Y
23456C     REFERENCE--NADARAJAH AND GUPTA (2004).  "APPLICATIONS OF THE
23457C                BETA DISTRIBUTION" in "HANDBOOK OF THE BETA
23458C                DISTRIBUTION", EDITED BY GUPTA AND NADARAJAH,
23459C                MARCEL-DEKKER, PP.100-102.
23460C              --EVANS, HASTINGS, AND PEACOCK.  "STATISTICAL
23461C                DISTRIBUTIONS", THIRD EDITION, WILEY, 2000,
23462C                PP. 34-42.
23463C                JOHNSON, KOTZ, AND BALAKRISHNAN.  "CONTINUOUS
23464C                UNIVARIATE DISTRIBUTIONS, VOLUME II", SECOND
23465C                EDITION, WILEY, 1994.
23466C              --KARL BURY, "STATISTICAL DISTRIBUTIONS IN
23467C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
23468C                1999, CHAPTER 14.
23469C     WRITTEN BY--ALAN HECKERT
23470C                 STATISTICAL ENGINEERING DIVISION
23471C                 INFORMATION TECHNOLOGY LABORATORY
23472C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
23473C                 GAITHERSBURG, MD 20899-8980
23474C                 PHONE--301-975-2899
23475C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
23476C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
23477C     LANGUAGE--ANSI FORTRAN (1977)
23478C     VERSION NUMBER--2007/6
23479C     ORIGINAL VERSION--JUNE      2007.
23480C     UPDATED         --AUGUST    2007. SOME UPGRADES TO FIT
23481C                                       PROCEDURE.  ALLOW STARTING
23482C                                       VALUES, OTHER TWEAKS.
23483C     UPDATED         --SEPTEMBER 2012. USE DPDTA1, DPDTA5 ROUTINES
23484C
23485C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
23486C
23487      CHARACTER*4 ICAPSW
23488      CHARACTER*4 ICAPTY
23489      CHARACTER*4 IFORSW
23490      CHARACTER*4 ISUBRO
23491      CHARACTER*4 IBUGA3
23492      CHARACTER*4 IERROR
23493C
23494      CHARACTER*4 IWRITE
23495C
23496      CHARACTER*4 ISUBN1
23497      CHARACTER*4 ISUBN2
23498      CHARACTER*4 ISTEPN
23499C
23500C---------------------------------------------------------------------
23501C
23502      DIMENSION Y(*)
23503      DIMENSION YLOG(*)
23504      DIMENSION XTEMP(*)
23505      DOUBLE PRECISION DTEMP1(*)
23506C
23507      PARAMETER (NUMALP=8)
23508      DIMENSION ALPHA(NUMALP)
23509      DIMENSION ALOWAL(NUMALP)
23510      DIMENSION AUPPAL(NUMALP)
23511      DIMENSION ALOWBE(NUMALP)
23512      DIMENSION AUPPBE(NUMALP)
23513      DIMENSION ALOWA2(NUMALP)
23514      DIMENSION AUPPA2(NUMALP)
23515      DIMENSION ALOWB2(NUMALP)
23516      DIMENSION AUPPB2(NUMALP)
23517      DIMENSION ALOWLO(NUMALP)
23518      DIMENSION AUPPLO(NUMALP)
23519      DIMENSION ALOWSC(NUMALP)
23520      DIMENSION AUPPSC(NUMALP)
23521C
23522      DIMENSION QP(*)
23523      DIMENSION XQPHAT(*)
23524      DIMENSION XQPSE(*)
23525      DIMENSION XQPLCL(*)
23526      DIMENSION XQPUCL(*)
23527C
23528      DOUBLE PRECISION TOL
23529      DOUBLE PRECISION XPAR(2)
23530      DOUBLE PRECISION FVEC(2)
23531      DOUBLE PRECISION DAE
23532      DOUBLE PRECISION DRE
23533      DOUBLE PRECISION DXSTRT
23534      DOUBLE PRECISION DXLOW
23535      DOUBLE PRECISION DXUP
23536C
23537      EXTERNAL BETFUN
23538      DOUBLE PRECISION BETFU2
23539      EXTERNAL BETFU2
23540      DOUBLE PRECISION BETFU5
23541      EXTERNAL BETFU5
23542      EXTERNAL BETFU7
23543      EXTERNAL BETFU8
23544      DOUBLE PRECISION DLBETA
23545      EXTERNAL DLBETA
23546C
23547      DOUBLE PRECISION DANS(10)
23548      DOUBLE PRECISION DA
23549      DOUBLE PRECISION DB
23550      DOUBLE PRECISION DC
23551      DOUBLE PRECISION DALPHA
23552      DOUBLE PRECISION DBETA
23553      DOUBLE PRECISION DALPBE
23554      DOUBLE PRECISION DTERM1
23555      DOUBLE PRECISION DTERM2
23556      DOUBLE PRECISION DTERM3
23557CCCCC DOUBLE PRECISION DTERM4
23558C
23559      INCLUDE 'DPCOMC.INC'
23560C
23561C---------------------------------------------------------------------
23562C
23563      COMMON /BETAML/ BETALL, BETAUL
23564C
23565      INTEGER N2
23566      DOUBLE PRECISION DSUM3
23567      DOUBLE PRECISION DSUM4
23568      DOUBLE PRECISION DLLAB
23569      DOUBLE PRECISION DK
23570      COMMON/BETCO9/DSUM3,DSUM4,DLLAB,DK,N2
23571C
23572      DOUBLE PRECISION DBETA2
23573      COMMON/BETCO2/DBETA2
23574C
23575      DOUBLE PRECISION DALPH2
23576      COMMON/BETCO5/DALPH2
23577C
23578      DOUBLE PRECISION DBETA3
23579      COMMON/BETCO3/DBETA3
23580C
23581      DOUBLE PRECISION DALPH3
23582      COMMON/BETCO4/DALPH3
23583C
23584      COMMON/BETCO7/P7,BETA3
23585      COMMON/BETCO8/P8,ALPHA3
23586C
23587      DOUBLE PRECISION DN
23588C
23589      DOUBLE PRECISION BE4FUN
23590      EXTERNAL BE4FUN
23591C
23592CCCCC DOUBLE PRECISION DTERM5
23593CCCCC DOUBLE PRECISION DTERM6
23594CCCCC DOUBLE PRECISION DTERM7
23595CCCCC DOUBLE PRECISION DTERM8
23596      DOUBLE PRECISION DSUM1
23597      DOUBLE PRECISION DSUM2
23598      DOUBLE PRECISION DM1
23599      DOUBLE PRECISION DM2
23600      DOUBLE PRECISION DM3
23601      DOUBLE PRECISION DM4
23602C
23603      DOUBLE PRECISION DM1P
23604      DOUBLE PRECISION DM2P
23605      DOUBLE PRECISION DM3P
23606      DOUBLE PRECISION DM4P
23607      COMMON /BET4ML/ DM2P, DM3P, DM4P
23608C
23609      INCLUDE 'DPCOST.INC'
23610C
23611      PARAMETER (MAXROW=40)
23612      CHARACTER*60 ITITLE
23613      CHARACTER*60 ITITLZ
23614      CHARACTER*40 ITEXT(MAXROW)
23615      REAL         AVALUE(MAXROW)
23616      INTEGER      NCTEXT(MAXROW)
23617      INTEGER      IDIGIT(MAXROW)
23618      INTEGER      NTOT(MAXROW)
23619      LOGICAL IFRST
23620      LOGICAL ILAST
23621C
23622      CHARACTER*4 ILIKFL
23623      CHARACTER*4 ILOCFL
23624      CHARACTER*4 ISCAFL
23625      CHARACTER*8 ISHAP1
23626      CHARACTER*8 ISHAP2
23627C
23628      INCLUDE 'DPCOP2.INC'
23629C
23630      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
23631C
23632C-----START POINT-----------------------------------------------------
23633C
23634      ISUBN1='DPML'
23635      ISUBN2='LB  '
23636      IERROR='NO'
23637C
23638      XTEMP(1)=0.0
23639C
23640      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLB')THEN
23641        WRITE(ICOUT,999)
23642  999   FORMAT(1X)
23643        CALL DPWRST('XXX','WRIT')
23644        WRITE(ICOUT,51)
23645   51   FORMAT('**** AT THE BEGINNING OF DPMLLB--')
23646        CALL DPWRST('XXX','WRIT')
23647        WRITE(ICOUT,52)IBUGA3
23648   52   FORMAT('IBUGA3 = ',A4)
23649        CALL DPWRST('XXX','WRIT')
23650        WRITE(ICOUT,55)N,IOUNI2,CUSER,DUSER
23651   55   FORMAT('N,IOUNI2,CUSER,DUSER = ',2I8,2G15.7)
23652        CALL DPWRST('XXX','WRIT')
23653        DO56I=1,MIN(N,100)
23654          WRITE(ICOUT,57)I,Y(I)
23655   57     FORMAT('I,Y(I) = ',I8,G15.7)
23656          CALL DPWRST('XXX','WRIT')
23657   56   CONTINUE
23658      ENDIF
23659C
23660C               ********************************************
23661C               **  STEP 11--                             **
23662C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
23663C               ********************************************
23664C
23665      ISTEPN='11'
23666      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLB')
23667     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23668C
23669      IF(N.LE.2)THEN
23670        WRITE(ICOUT,999)
23671        CALL DPWRST('XXX','WRIT')
23672        WRITE(ICOUT,1111)
23673 1111   FORMAT('***** ERROR IN DPMLLB--')
23674        CALL DPWRST('XXX','WRIT')
23675        WRITE(ICOUT,1113)
23676 1113   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE RESPONSE ',
23677     1         'IS LESS THAN 3')
23678        CALL DPWRST('XXX','WRIT')
23679        WRITE(ICOUT,1115)N
23680 1115   FORMAT('SAMPLE SIZE = ',I8)
23681        CALL DPWRST('XXX','WRIT')
23682        IERROR='YES'
23683        GOTO9000
23684      ENDIF
23685C
23686      HOLD=Y(1)
23687      DO1135I=2,N
23688      IF(Y(I).NE.HOLD)GOTO1139
23689 1135 CONTINUE
23690      WRITE(ICOUT,999)
23691      CALL DPWRST('XXX','WRIT')
23692      WRITE(ICOUT,1111)
23693      CALL DPWRST('XXX','WRIT')
23694      WRITE(ICOUT,1131)HOLD
23695 1131 FORMAT('      THE RESPONSE VARIABLE HAS ALL ELEMENTS = ',G15.7)
23696      CALL DPWRST('XXX','WRIT')
23697      IERROR='YES'
23698      GOTO9000
23699 1139 CONTINUE
23700C
23701      IF(NPERC.GT.0)THEN
23702        DO1145I=1,NPERC
23703          IF(QP(I).LE.0.0 .OR. QP(I).GE.100.0)THEN
23704            WRITE(ICOUT,999)
23705            CALL DPWRST('XXX','WRIT')
23706            WRITE(ICOUT,1141)
23707 1141       FORMAT('***** WARNING IN LOG BETA MAXIMUM LIKELIHOOD--')
23708            CALL DPWRST('XXX','WRIT')
23709            WRITE(ICOUT,1143)QP(I)
23710 1143       FORMAT('      REQUESTED PERCENTILE (',G15.7,') IS ',
23711     1             'OUTSIDE THE (0,100) INTERVAL')
23712            CALL DPWRST('XXX','WRIT')
23713            WRITE(ICOUT,1144)
23714 1144       FORMAT('      NO PERCENTILE CONFIDENCE LIMITS WILL BE ',
23715     1             'COMPUTED.')
23716            CALL DPWRST('XXX','WRIT')
23717            NPERC=0
23718          ENDIF
23719 1145   CONTINUE
23720      ENDIF
23721C
23722      DO1155I=1,N
23723        IF(Y(I).LE.0.0)THEN
23724          WRITE(ICOUT,999)
23725          CALL DPWRST('XXX','WRIT')
23726          WRITE(ICOUT,1111)
23727          CALL DPWRST('XXX','WRIT')
23728          WRITE(ICOUT,1151)I
23729 1151     FORMAT('      ROW ',I8,' OF THE RESPONSE VARIABLE IS ',
23730     1           'NON-POSITIVE.')
23731
23732          WRITE(ICOUT,1153)Y(I)
23733 1153     FORMAT('      THE VALUE OF RESPONSE VARIABLE = ',G15.7)
23734
23735          CALL DPWRST('XXX','WRIT')
23736          IERROR='YES'
23737          GOTO9000
23738        ENDIF
23739 1155 CONTINUE
23740C
23741C               *************************************
23742C               **  STEP 31--                      **
23743C               **  CARRY OUT CALCULATIONS         **
23744C               **  FOR BETA MOMENT/MLE ESTIMATION **
23745C               *************************************
23746C
23747      ISTEPN='41'
23748      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLB')
23749     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23750C
23751      IERROR='NO'
23752      IWRITE='OFF'
23753C
23754      CALL SORT(Y,N,Y)
23755      CALL MINIM(Y,N,IWRITE,ZMIN,IBUGA3,IERROR)
23756      CALL MAXIM(Y,N,IWRITE,ZMAX,IBUGA3,IERROR)
23757      CALL MEAN(Y,N,IWRITE,ZMEAN,IBUGA3,IERROR)
23758      CALL VAR(Y,N,IWRITE,ZVAR,IBUGA3,IERROR)
23759      ZSD=SQRT(ZVAR)
23760C
23761CCCCC ALLOW FOR USER SPECIFIED LOWER AND UPPER LIMITS AND
23762CCCCC STARTING VALUES.  NOTE THAT CUSER AND DUSER DENOTE
23763CCCCC FIXED LIMITS WHILE CSV AND DSV DENOTE STARTING VALUES.
23764CCCCC IF USER DOES NOT SPECIFY THE LIMITS, THEN DETERMINE
23765CCCCC ESTIMATES IN THE FOLLOWING WAY:
23766CCCCC
23767CCCCC   1) USE MIN AND MAX AS INITIAL ESTIMATE IF NO
23768CCCCC      STARTING VALUES SPECIFIED.
23769CCCCC
23770CCCCC   2) USE THESE INITIAL ESTIMATES TO OBTAIN THE
23771CCCCC      METHOD OF MOMENT ESTIMATES OF ALPHA AND
23772CCCCC      BETA.
23773CCCCC
23774CCCCC   3) USE THE 4-PARAMETER BETA METHOD OF MOMENTS
23775CCCCC      TO GENERATE REFINED ESTIMATES OF LOWER AND
23776CCCCC      UPPER LIMITS.
23777CCCCC
23778CCCCC   USE THE METHOD OF MOMENT ESTIMATES AS STARTING
23779CCCCC   VALUES FOR MAXIMUM LIKELIHOOD METHOD.
23780C
23781      IF((CUSER.NE.CPUMIN .AND. DUSER.NE.CPUMIN) .AND.
23782     1   (CUSER.LT.ZMIN .AND. DUSER.GT.ZMAX))THEN
23783        C=CUSER
23784        D=DUSER
23785        IFIX=1
23786      ELSEIF((CSV.NE.CPUMIN .AND. DSV.NE.CPUMIN) .AND.
23787     1   (CSV.LT.ZMIN .AND. DSV.GT.ZMAX))THEN
23788        C=CSV
23789        D=DSV
23790        IFIX=0
23791      ELSE
23792        AINC=(ZMAX-ZMIN)*0.001
23793        C=ZMIN - AINC
23794        D=ZMAX + AINC
23795        IF(C.LE.0.0)C=0.1E-12
23796        IFIX=0
23797      ENDIF
23798      CINIT=C
23799      DINIT=D
23800C
23801      DO2801I=1,N
23802        YLOG(I)=(LOG(Y(I)) - LOG(C))/(LOG(D) - LOG(C))
23803 2801 CONTINUE
23804      CALL MINIM(YLOG,N,IWRITE,XMIN,IBUGA3,IERROR)
23805      CALL MAXIM(YLOG,N,IWRITE,XMAX,IBUGA3,IERROR)
23806C
23807      DN=DBLE(N)
23808      DSUM1=0.0D0
23809      DSUM2=0.0D0
23810      DSUM3=0.0D0
23811      DSUM4=0.0D0
23812      DO2810I=1,N
23813        DSUM1=DSUM1 + DBLE(YLOG(I))
23814        DSUM2=DSUM2 + DBLE(YLOG(I))**2
23815        DSUM3=DSUM3 + DBLE(YLOG(I))**3
23816        DSUM4=DSUM4 + DBLE(YLOG(I))**4
23817 2810 CONTINUE
23818      DM1=DSUM1/DN
23819      DM2=DSUM2/DN
23820      DM3=DSUM3/DN
23821      DM4=DSUM4/DN
23822      DM1P=DM1
23823      DM2P=DM2 - DM1**2
23824      DM3P=DM3 - 3.0D0*DM1*DM2 + 2.0D0*(DM1**3)
23825      DM4P=DM4 - 4.0D0*DM1*DM3 + 6.0D0*(DM1**2)*DM2 - 3.0D0*(DM1**4)
23826C
23827C     CHECK IF STARTING VALUES FOR ALPHA/BETA SPECIFIED
23828C
23829      IF(ALPHSV.GT.0.0 .AND. BETASV.GT.0.0)THEN
23830        XPAR(1)=DBLE(ALPHSV)
23831        XPAR(2)=DBLE(BETASV)
23832      ELSE
23833        XPAR(1)=1.0D0
23834        XPAR(2)=1.0D0
23835      ENDIF
23836C
23837      IOPT=2
23838      TOL=1.0D-6
23839      NVAR=2
23840      NPRINT=-1
23841      INFO=0
23842      LWA=MAXNXT
23843      CALL DNSQE(BE4FUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
23844     1           DTEMP1,MAXNXT,YLOG,N)
23845C
23846      IF(INFO.EQ.2)THEN
23847        WRITE(ICOUT,999)
23848        CALL DPWRST('XXX','WRIT')
23849        WRITE(ICOUT,1111)
23850        CALL DPWRST('XXX','WRIT')
23851        WRITE(ICOUT,2811)
23852 2811   FORMAT('      TOO MANY ITERATIONS WHEN COMPUTING THE ',
23853     1         'MOMENT ESTIMATES FOR ALPHA AND BETA.')
23854        CALL DPWRST('XXX','WRIT')
23855        IERROR='YES'
23856        GOTO9000
23857      ELSEIF(INFO.EQ.4)THEN
23858        WRITE(ICOUT,999)
23859        CALL DPWRST('XXX','WRIT')
23860        WRITE(ICOUT,1111)
23861        CALL DPWRST('XXX','WRIT')
23862        WRITE(ICOUT,2813)
23863 2813   FORMAT('      MOMENT ESTIMATES FOR ALPHA AND BETA NOT ',
23864     1         'MAKING GOOD PROGRESS.')
23865        IERROR='YES'
23866        GOTO9000
23867      ENDIF
23868C
23869      ALPHMO=REAL(XPAR(1))
23870      BETAMO=REAL(XPAR(2))
23871C
23872C     NOW FINE-TUNE ESTIMATES OF C AND D (UNLESS A
23873C     FIXED LIMIT SPECIFIED)
23874C
23875      IF(IFIX.EQ.0)THEN
23876        EPS=(D-C)*0.001
23877        DA=DBLE(ALPHMO)
23878        DB=DBLE(BETAMO)
23879        DTERM1=DA*(DA+DB+1.0D0)
23880        DTERM2=DB
23881        AMOM=DM1 - DSQRT(DM2P)*DSQRT(DTERM1/DTERM2)
23882        DTERM1=DB*(DA+DB+1.0D0)
23883        DTERM2=DA
23884        BMOM=DM1 + DSQRT(DM2P)*DSQRT(DTERM1/DTERM2)
23885        IF(AMOM.GE.XMIN)AMOM=XMIN - EPS
23886        IF(BMOM.LE.XMAX)BMOM=XMAX + EPS
23887        C=EXP(AMOM)
23888        D=EXP(BMOM)
23889        EPS=(D-C)*0.01
23890        IF(C.GE.ZMIN)C=ZMIN - EPS
23891        IF(D.LE.ZMAX)D=ZMAX + EPS
23892        CMOM=C
23893        DMOM=D
23894      ELSE
23895        CMOM=C
23896        DMOM=D
23897      ENDIF
23898C
23899      DO3010I=1,N
23900        YLOG(I)=(LOG(Y(I)) - LOG(C))/(LOG(D) - LOG(C))
23901 3010 CONTINUE
23902C
23903      CALL MINIM(YLOG,N,IWRITE,XMIN,IBUGA3,IERROR)
23904      CALL MAXIM(YLOG,N,IWRITE,XMAX,IBUGA3,IERROR)
23905      CALL MEAN(YLOG,N,IWRITE,XMEAN,IBUGA3,IERROR)
23906      CALL VAR(YLOG,N,IWRITE,XVAR,IBUGA3,IERROR)
23907      XSD=SQRT(XVAR)
23908C
23909      A=0.0
23910      B=1.0
23911      BETALL=A
23912      BETAUL=B
23913C
23914      XMEAN1=(XMEAN-A)/(B-A)
23915      VAR1=XVAR/((B-A)**2)
23916      ALPHA1=XMEAN1*(XMEAN1*(1.0-XMEAN1)/VAR1 - 1.0)
23917      BETA1=(1.0-XMEAN1)*(XMEAN1*(1.0-XMEAN1)/VAR1 - 1.0)
23918C
23919      XPAR(1)=DBLE(ALPHA1)
23920      XPAR(2)=DBLE(BETA1)
23921      DPROD1=1.0D0
23922      DPROD2=1.0D0
23923      DN=DBLE(N)
23924C
23925      DO3101I=1,N
23926        DTERM1=DBLE((B-YLOG(I))/(B-A))**(1.0D0/DN)
23927        DTERM2=DBLE( (YLOG(I)-A)/(B-A))**(1.0D0/DN)
23928        IF(DTERM1.NE.0.0D0)DPROD1=DPROD1*DTERM1
23929        IF(DTERM2.NE.0.0D0)DPROD2=DPROD2*DTERM2
23930 3101 CONTINUE
23931      XPAR(1)=0.5D0*(1.0D0 - DPROD1)/(1.0D0 - DPROD2 - DPROD1)
23932      DO3103I=1,N
23933        DTERM1=DBLE((YLOG(I)-A)/(B-A))**(1.0D0/DN)
23934        DTERM2=DBLE( (B-YLOG(I))/(B-A))**(1.0D0/DN)
23935        IF(DTERM1.NE.0.0D0)DPROD1=DPROD1*DTERM1
23936        IF(DTERM2.NE.0.0D0)DPROD2=DPROD2*DTERM2
23937 3103 CONTINUE
23938      XPAR(2)=0.5D0*(1.0D0 - DPROD1)/(1.0D0 - DPROD1 - DPROD2)
23939C
23940      IOPT=2
23941      TOL=1.0D-6
23942      NVAR=2
23943      NPRINT=-1
23944      INFO=0
23945      LWA=MAXNXT
23946      CALL DNSQE(BETFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
23947     1           DTEMP1,MAXNXT,YLOG,N)
23948C
23949      IF(INFO.EQ.2)THEN
23950        WRITE(ICOUT,999)
23951        CALL DPWRST('XXX','WRIT')
23952        WRITE(ICOUT,1111)
23953        CALL DPWRST('XXX','WRIT')
23954        WRITE(ICOUT,3111)
23955 3111   FORMAT('      TOO MANY ITERATIONS WHEN COMPUTING THE ',
23956     1         'ML ESTIMATES FOR ALPHA AND BETA.')
23957        CALL DPWRST('XXX','WRIT')
23958        IERROR='YES'
23959        GOTO9000
23960      ELSEIF(INFO.EQ.4)THEN
23961        WRITE(ICOUT,999)
23962        CALL DPWRST('XXX','WRIT')
23963        WRITE(ICOUT,1111)
23964        CALL DPWRST('XXX','WRIT')
23965        WRITE(ICOUT,3113)
23966 3113   FORMAT('      ML ESTIMATES FOR ALPHA AND BETA NOT ',
23967     1         'MAKING GOOD PROGRESS.')
23968        IERROR='YES'
23969        GOTO9000
23970      ENDIF
23971C
23972      ALPHA2=REAL(XPAR(1))
23973      BETA2=REAL(XPAR(2))
23974C
23975CCCCC CONFIDENCE INTERVALS FOR SHAPE PARAMETERS
23976C
23977      DN=DBLE(N)
23978      DALPHA=DBLE(ALPHA2)
23979      DBETA=DBLE(BETA2)
23980      DALPBE=DBLE(ALPHA2 + BETA2)
23981C
23982      KODE=1
23983      NTEMP=1
23984      M=1
23985      NZ=0
23986C
23987      CALL DPSIFN(DALPHA,NTEMP,KODE,M,DANS,NZ,IERR)
23988      DA=DANS(1)
23989      IF(IERR.EQ.1)THEN
23990        WRITE(ICOUT,999)
23991        CALL DPWRST('XXX','WRIT')
23992        WRITE(ICOUT,3201)
23993 3201   FORMAT('***** ERROR FROM LOG BETA MAXIMUM LIKELIHOOD--')
23994        CALL DPWRST('XXX','WRIT')
23995        WRITE(ICOUT,3203)
23996 3203   FORMAT('      UNABLE TO COMPUTE TRIGAMMA FUNCTION.')
23997        CALL DPWRST('XXX','WRIT')
23998        IERROR='YES'
23999        GOTO9000
24000      ELSEIF(IERR.EQ.2)THEN
24001        WRITE(ICOUT,999)
24002        CALL DPWRST('XXX','WRIT')
24003        WRITE(ICOUT,3201)
24004        CALL DPWRST('XXX','WRIT')
24005        WRITE(ICOUT,3205)
24006 3205   FORMAT('      OVERFLOW IN COMPUTING THE TRIGAMMA FUNCTION.')
24007        CALL DPWRST('XXX','WRIT')
24008        IERROR='YES'
24009        GOTO9000
24010      ELSEIF(IERR.EQ.3)THEN
24011        WRITE(ICOUT,999)
24012        CALL DPWRST('XXX','WRIT')
24013        WRITE(ICOUT,3201)
24014        CALL DPWRST('XXX','WRIT')
24015        WRITE(ICOUT,3207)
24016 3207   FORMAT('      OVERFLOW IN COMPUTING THE TRIGAMMA FUNCTION.')
24017        CALL DPWRST('XXX','WRIT')
24018        IERROR='YES'
24019        GOTO9000
24020      ENDIF
24021C
24022      CALL DPSIFN(DBETA,NTEMP,KODE,M,DANS,NZ,IERR)
24023      DB=DANS(1)
24024      IF(IERR.EQ.1)THEN
24025        WRITE(ICOUT,999)
24026        CALL DPWRST('XXX','WRIT')
24027        WRITE(ICOUT,3201)
24028        CALL DPWRST('XXX','WRIT')
24029        WRITE(ICOUT,3203)
24030        CALL DPWRST('XXX','WRIT')
24031        IERROR='YES'
24032        GOTO9000
24033      ELSEIF(IERR.EQ.2)THEN
24034        WRITE(ICOUT,999)
24035        CALL DPWRST('XXX','WRIT')
24036        WRITE(ICOUT,3201)
24037        CALL DPWRST('XXX','WRIT')
24038        WRITE(ICOUT,3205)
24039        CALL DPWRST('XXX','WRIT')
24040        IERROR='YES'
24041        GOTO9000
24042      ELSEIF(IERR.EQ.3)THEN
24043        WRITE(ICOUT,999)
24044        CALL DPWRST('XXX','WRIT')
24045        WRITE(ICOUT,3201)
24046        CALL DPWRST('XXX','WRIT')
24047        WRITE(ICOUT,3207)
24048        CALL DPWRST('XXX','WRIT')
24049        IERROR='YES'
24050        GOTO9000
24051      ENDIF
24052C
24053      CALL DPSIFN(DALPBE,NTEMP,KODE,M,DANS,NZ,IERR)
24054      DC=DANS(1)
24055      IF(IERR.EQ.1)THEN
24056        WRITE(ICOUT,999)
24057        CALL DPWRST('XXX','WRIT')
24058        WRITE(ICOUT,3201)
24059        CALL DPWRST('XXX','WRIT')
24060        WRITE(ICOUT,3203)
24061        CALL DPWRST('XXX','WRIT')
24062        IERROR='YES'
24063        GOTO9000
24064      ELSEIF(IERR.EQ.2)THEN
24065        WRITE(ICOUT,999)
24066        CALL DPWRST('XXX','WRIT')
24067        WRITE(ICOUT,3201)
24068        CALL DPWRST('XXX','WRIT')
24069        WRITE(ICOUT,3205)
24070        CALL DPWRST('XXX','WRIT')
24071        IERROR='YES'
24072        GOTO9000
24073      ELSEIF(IERR.EQ.3)THEN
24074        WRITE(ICOUT,999)
24075        CALL DPWRST('XXX','WRIT')
24076        WRITE(ICOUT,3201)
24077        CALL DPWRST('XXX','WRIT')
24078        WRITE(ICOUT,3207)
24079        CALL DPWRST('XXX','WRIT')
24080        IERROR='YES'
24081        GOTO9000
24082      ENDIF
24083C
24084      DTERM1=1.0D0/(DN*(DA*DB - DC*(DA+DB)))
24085      DTERM2=DTERM1*(DB-DC)
24086      ALPHSE=REAL(DSQRT(DTERM2))
24087      DTERM2=DTERM1*(DA-DC)
24088      BETASE=REAL(DSQRT(DTERM2))
24089      DTERM2=DTERM1*DC
24090      COVSE=REAL(DSQRT(DTERM2))
24091C
24092      DO3310I=1,NUMALP
24093        ALP=ALPHA(I)
24094        P=1.0-(ALP/2.0)
24095        CALL NORPPF(P,PPF)
24096        ALOWAL(I)=ALPHA2 - PPF*ALPHSE
24097        AUPPAL(I)=ALPHA2 + PPF*ALPHSE
24098        ALOWBE(I)=BETA2 - PPF*BETASE
24099        AUPPBE(I)=BETA2 + PPF*BETASE
24100 3310 CONTINUE
24101C
24102      N2=N
24103      DA=DBLE(A)
24104      DB=DBLE(B)
24105      DALPH2=DBLE(ALPHA2)
24106      DALPH3=DBLE(ALPHA2)
24107      DBETA2=DBLE(BETA2)
24108      DBETA3=DBLE(BETA2)
24109      DSUM3=0.0D0
24110      DSUM4=0.0D0
24111      DO3320I=1,N
24112        DTEMP1(I)=DBLE(YLOG(I))
24113        DSUM3=DSUM3 + DLOG(DBLE(YLOG(I)) - DA)
24114        DSUM4=DSUM4 + DLOG(DB - DBLE(YLOG(I)))
24115 3320 CONTINUE
24116      DSUM3=DSUM3/(DN*(DB - DA))
24117      DSUM4=DSUM4/(DN*(DB - DA))
24118C
24119      DTERM1=-DN*DLBETA(DALPH2,DBETA2)
24120      DTERM2=DN*(DALPH2-1.0D0)*DSUM3
24121      DTERM3=DN*(DBETA2-1.0D0)*DSUM4
24122      DLLAB=DTERM1 + DTERM2 + DTERM3
24123C
24124      DAE=1.D-7
24125      DRE=1.D-7
24126      NUTEMP=1
24127C
24128      DO3410I=1,NUMALP
24129        ALP=ALPHA(I)
24130        CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
24131        DK=DBLE(APPF)
24132C
24133        DXSTRT=DBLE(ALOWAL(I))
24134        DXLOW=DXSTRT/5.0D0
24135        DXUP=DBLE(ALPHA2)
24136        CALL DFZER2(BETFU2,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP1)
24137        ALOWA2(I)=REAL(DXLOW)
24138C
24139        DXSTRT=DBLE(AUPPAL(I))
24140        DXUP=DXSTRT*5.0D0
24141        DXLOW=DBLE(ALPHA2)
24142        CALL DFZER2(BETFU2,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP1)
24143        AUPPA2(I)=REAL(DXLOW)
24144C
24145        DXSTRT=DBLE(ALOWBE(I))
24146        DXLOW=DXSTRT/5.0D0
24147        DXUP=DBLE(BETA2)
24148        CALL DFZER2(BETFU5,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP1)
24149        ALOWB2(I)=REAL(DXLOW)
24150C
24151        DXSTRT=DBLE(AUPPBE(I))
24152        DXUP=DXSTRT*5.0D0
24153        DXLOW=DBLE(BETA2)
24154        CALL DFZER2(BETFU5,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP1)
24155        AUPPB2(I)=REAL(DXLOW)
24156C
24157 3410 CONTINUE
24158C
24159C  CONFIDENCE INTERVALS FOR SELECTED PERCENTILES.
24160C
24161C  1. STANDARD ERROR USES TECHNIQUE DEMONSTRATED IN EXAMPLE 14.3
24162C     (PP. 256-257) OF BURY.  THIS IS BASED ON PROPOGATION OF ERROR.
24163C
24164C  2. CONFIDENCE INTERVAL IS THEN GENERATED USING NORMAL
24165C     APPROXIMATION (EXAMPLE 14.3 OF BURY).
24166C
24167      IF(NPERC.GE.1)THEN
24168C
24169        ALPHL=ALPHAP/2.0
24170        ALPHU=1.0 - ALPHAP/2.0
24171        CALL NORPPF(ALPHU,Z95)
24172C
24173        ALPHA3=ALPHA2
24174        BETA3=BETA2
24175        IORD=1
24176        EPS=0.001
24177        ACCUR=0.0
24178C
24179        WRITE(IOUNI1,3531)
24180        WRITE(IOUNI1,3532)
24181        DO3529I=1,NPERC
24182          QPTEMP=QP(I)/100.0
24183          CALL BETPPF(QPTEMP,ALPHA2,BETA2,APPF)
24184          XQPHAT(I)=APPF
24185C
24186          P7=QPTEMP
24187          P8=QPTEMP
24188C
24189          IFAIL=0
24190C
24191          ALPHAT = ALPHA2
24192          ALPHMN = 0.0001
24193          ALPHMX = ALPHA2 + 10.0
24194          CALL DIFF(IORD,ALPHAT,ALPHMN,ALPHMX,BETFU7,EPS,ACCUR,
24195     1              D1,ERROR,IFAIL)
24196C
24197          IF(IFAIL.EQ.1)THEN
24198            WRITE(ICOUT,999)
24199            CALL DPWRST('XXX','BUG ')
24200            WRITE(ICOUT,3501)
24201 3501       FORMAT('***** WARNING IN NUMERICAL DERIVATIVE FOR BETA ',
24202     1             'MAXIMUM LIKELIHOOD PERCENTILES.')
24203            CALL DPWRST('XXX','BUG ')
24204            WRITE(ICOUT,3503)
24205 3503       FORMAT('      THE ESTIMATED ERROR IN THE RESULT ',
24206     1             'EXCEEDS THE')
24207            CALL DPWRST('XXX','BUG ')
24208            WRITE(ICOUT,3505)
24209 3505       FORMAT('      REQUESTED ERROR, BUT THE MOST ACCURATE ',
24210     1             'RESULT')
24211            CALL DPWRST('XXX','BUG ')
24212            WRITE(ICOUT,3507)
24213 3507       FORMAT('      POSSIBLE HAS BEEN RETURNED.')
24214            CALL DPWRST('XXX','BUG ')
24215          ELSEIF(IFAIL.EQ.2)THEN
24216            WRITE(ICOUT,999)
24217            CALL DPWRST('XXX','BUG ')
24218            WRITE(ICOUT,3511)
24219 3511       FORMAT('***** ERROR IN NUMERICAL DERIVATIVE FOR BETA ',
24220     1             'MAXIMUM LIKELIHOOD PERCENTILES.')
24221            CALL DPWRST('XXX','BUG ')
24222            WRITE(ICOUT,3513)
24223 3513       FORMAT('      ERROR IN THE INPUT TO THE DIFF ROUTINE.')
24224            CALL DPWRST('XXX','BUG ')
24225            WRITE(ICOUT,3515)
24226 3515       FORMAT('      NO PERCENTILES WILL BE GENERATED.')
24227            CALL DPWRST('XXX','BUG ')
24228            NPERC=0
24229          ELSEIF(IFAIL.EQ.3)THEN
24230            WRITE(ICOUT,999)
24231            CALL DPWRST('XXX','BUG ')
24232            WRITE(ICOUT,3511)
24233            CALL DPWRST('XXX','BUG ')
24234            WRITE(ICOUT,3523)
24235 3523       FORMAT('      THE INTERVAL FOR DIFFERENTIATION, (',G15.7,
24236     1             ',',G15.7,')')
24237            CALL DPWRST('XXX','BUG ')
24238            WRITE(ICOUT,3525)
24239 3525       FORMAT('      IS TOO SMALL.')
24240            CALL DPWRST('XXX','BUG ')
24241            WRITE(ICOUT,3515)
24242            CALL DPWRST('XXX','BUG ')
24243            D1=0.0
24244            NPERC=0
24245          ENDIF
24246C
24247          BETAT = BETA2
24248          BETAMN = 0.0001
24249          BETAMX = BETA2 + 10.0
24250          CALL DIFF(IORD,BETAT,BETAMN,BETAMX,BETFU8,EPS,ACCUR,
24251     1              D2,ERROR,IFAIL)
24252C
24253          IF(IFAIL.EQ.1)THEN
24254            WRITE(ICOUT,999)
24255            CALL DPWRST('XXX','BUG ')
24256            WRITE(ICOUT,3501)
24257            CALL DPWRST('XXX','BUG ')
24258            WRITE(ICOUT,3503)
24259            CALL DPWRST('XXX','BUG ')
24260            WRITE(ICOUT,3505)
24261            CALL DPWRST('XXX','BUG ')
24262            WRITE(ICOUT,3507)
24263            CALL DPWRST('XXX','BUG ')
24264          ELSEIF(IFAIL.EQ.2)THEN
24265            WRITE(ICOUT,999)
24266            CALL DPWRST('XXX','BUG ')
24267            WRITE(ICOUT,3511)
24268            CALL DPWRST('XXX','BUG ')
24269            WRITE(ICOUT,3513)
24270            CALL DPWRST('XXX','BUG ')
24271            WRITE(ICOUT,3515)
24272            CALL DPWRST('XXX','BUG ')
24273            NPERC=0
24274          ELSEIF(IFAIL.EQ.3)THEN
24275            WRITE(ICOUT,999)
24276            CALL DPWRST('XXX','BUG ')
24277            WRITE(ICOUT,3511)
24278            CALL DPWRST('XXX','BUG ')
24279            WRITE(ICOUT,3523)
24280            CALL DPWRST('XXX','BUG ')
24281            WRITE(ICOUT,3525)
24282            CALL DPWRST('XXX','BUG ')
24283            WRITE(ICOUT,3515)
24284            CALL DPWRST('XXX','BUG ')
24285            D2=0.0
24286            NPERC=0
24287          ENDIF
24288          V11=ALPHSE**2
24289          V22=BETASE**2
24290          V21=COVSE
24291          V12=V21
24292          TERM11=(D1*ALPHSE)**2
24293          TERM22=(D2*BETASE)**2
24294          TERM12=2.0*D2*D1*COVSE**2
24295          SEXQP=TERM11+TERM12+TERM22
24296          IF(SEXQP.GE.0.0)THEN
24297            SEXQP=SQRT(SEXQP)
24298          ELSE
24299            SEXQP=0.0
24300          ENDIF
24301          XQPSE(I)=SEXQP
24302          XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
24303          XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
24304C
24305C
24306          WRITE(IOUNI1,'(5E15.7)')
24307     1         QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
24308 3529   CONTINUE
24309 3531   FORMAT(15X,'       POINT     ','   STANDARD   ',
24310     1         '     LOWER     ',
24311     1         '     UPPER')
24312 3532   FORMAT('    PERCENTILE ','     ESTIMATE   ',
24313     1         '     ERRROR     ',
24314     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
24315      ENDIF
24316C
24317C               *************************************
24318C               **   STEP 42--                     **
24319C               **   WRITE OUT EVERYTHING          **
24320C               **   FOR LOG BETA MLE ESTIMATION   **
24321C               *************************************
24322C
24323      ISTEPN='42'
24324      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLB')
24325     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
24326C
24327C     PRINT SUMMARY STATISTICS TABLE
24328C
24329      IF(IPRINT.EQ.'OFF')GOTO9000
24330C
24331      NUMDIG=7
24332      IF(IFORSW.EQ.'1')NUMDIG=1
24333      IF(IFORSW.EQ.'2')NUMDIG=2
24334      IF(IFORSW.EQ.'3')NUMDIG=3
24335      IF(IFORSW.EQ.'4')NUMDIG=4
24336      IF(IFORSW.EQ.'5')NUMDIG=5
24337      IF(IFORSW.EQ.'6')NUMDIG=6
24338      IF(IFORSW.EQ.'7')NUMDIG=7
24339      IF(IFORSW.EQ.'8')NUMDIG=8
24340      IF(IFORSW.EQ.'9')NUMDIG=9
24341      IF(IFORSW.EQ.'0')NUMDIG=0
24342      IF(IFORSW.EQ.'E')NUMDIG=-2
24343      IF(IFORSW.EQ.'-2')NUMDIG=-2
24344      IF(IFORSW.EQ.'-3')NUMDIG=-3
24345      IF(IFORSW.EQ.'-4')NUMDIG=-4
24346      IF(IFORSW.EQ.'-5')NUMDIG=-5
24347      IF(IFORSW.EQ.'-6')NUMDIG=-6
24348      IF(IFORSW.EQ.'-7')NUMDIG=-7
24349      IF(IFORSW.EQ.'-8')NUMDIG=-8
24350      IF(IFORSW.EQ.'-9')NUMDIG=-9
24351C
24352      ITITLE='Log Beta Parameter Estimation:'
24353      NCTITL=30
24354      ITITLZ='Full Sample Case'
24355      NCTITZ=16
24356      ITEXT(1)='Summary Statistics:'
24357      NCTEXT(1)=19
24358      AVALUE(1)=0.0
24359      IDIGIT(1)=0
24360      ITEXT(2)='Number of Observations:'
24361      NCTEXT(2)=23
24362      AVALUE(2)=REAL(N)
24363      IDIGIT(2)=0
24364      ITEXT(3)='Sample Minimum:'
24365      NCTEXT(3)=15
24366      AVALUE(3)=ZMIN
24367      IDIGIT(3)=NUMDIG
24368      ITEXT(4)='Sample Maximum:'
24369      NCTEXT(4)=15
24370      AVALUE(4)=ZMAX
24371      IDIGIT(4)=NUMDIG
24372      ITEXT(5)='Sample Mean:'
24373      NCTEXT(5)=12
24374      AVALUE(5)=ZMEAN
24375      IDIGIT(5)=NUMDIG
24376      ITEXT(6)='Sample Standard Deviation:'
24377      NCTEXT(6)=26
24378      AVALUE(6)=ZSD
24379      IDIGIT(6)=NUMDIG
24380      ITEXT(7)='Initial Value Used for Lower Limit:'
24381      NCTEXT(7)=35
24382      AVALUE(7)=CINIT
24383      IDIGIT(7)=NUMDIG
24384      ITEXT(8)='Initial Value Used for Upper Limit:'
24385      NCTEXT(8)=35
24386      AVALUE(8)=DINIT
24387      IDIGIT(8)=NUMDIG
24388      ITEXT(9)=' '
24389      NCTEXT(9)=1
24390      AVALUE(9)=0.0
24391      IDIGIT(9)=-1
24392C
24393      ITEXT(10)='Method of Moment Estimates:'
24394      NCTEXT(10)=27
24395      AVALUE(10)=0.0
24396      IDIGIT(10)=0
24397C
24398      ICNT=6
24399      IF(CUSER.NE.CPUMIN)THEN
24400        ICNT=ICNT+1
24401        ITEXT(ICNT)='User Specified Lower Limit:'
24402        NCTEXT(ICNT)=27
24403        AVALUE(ICNT)=CUSER
24404        IDIGIT(ICNT)=NUMDIG
24405      ENDIF
24406      IF(DUSER.NE.CPUMIN)THEN
24407        ICNT=ICNT+1
24408        ITEXT(ICNT)='User Specified Upper Limit:'
24409        NCTEXT(ICNT)=27
24410        AVALUE(ICNT)=DUSER
24411        IDIGIT(ICNT)=NUMDIG
24412      ENDIF
24413      ICNT=ICNT+1
24414      ITEXT(ICNT)=' '
24415      NCTEXT(ICNT)=0
24416      AVALUE(ICNT)=0.0
24417      IDIGIT(ICNT)=-1
24418C
24419      ICNT=ICNT+1
24420      ITEXT(ICNT)='Moments:'
24421      NCTEXT(ICNT)=8
24422      AVALUE(ICNT)=0.0
24423      IDIGIT(ICNT)=-1
24424      ICNT=ICNT+1
24425      ITEXT(ICNT)='Estimate of Alpha:'
24426      NCTEXT(ICNT)=18
24427      AVALUE(ICNT)=ALPHMO
24428      IDIGIT(ICNT)=NUMDIG
24429      ICNT=ICNT+1
24430      ITEXT(ICNT)='Estimate of Beta:'
24431      NCTEXT(ICNT)=17
24432      AVALUE(ICNT)=BETAMO
24433      IDIGIT(ICNT)=NUMDIG
24434      ICNT=ICNT+1
24435      ITEXT(ICNT)=' '
24436      NCTEXT(ICNT)=0
24437      AVALUE(ICNT)=0.0
24438      IDIGIT(ICNT)=-1
24439C
24440      ICNT=ICNT+1
24441      ITEXT(ICNT)='Maximum Likelihood:'
24442      NCTEXT(ICNT)=19
24443      AVALUE(ICNT)=0.0
24444      IDIGIT(ICNT)=-1
24445      ICNT=ICNT+1
24446      ITEXT(ICNT)='Estimate of Alpha:'
24447      NCTEXT(ICNT)=18
24448      AVALUE(ICNT)=ALPHA2
24449      IDIGIT(ICNT)=NUMDIG
24450      ICNT=ICNT+1
24451      ITEXT(ICNT)='Standard Error of Alpha:'
24452      NCTEXT(ICNT)=24
24453      AVALUE(ICNT)=ALPHSE
24454      IDIGIT(ICNT)=NUMDIG
24455      ICNT=ICNT+1
24456      ITEXT(ICNT)='Estimate of Beta:'
24457      NCTEXT(ICNT)=17
24458      AVALUE(ICNT)=BETA2
24459      IDIGIT(ICNT)=NUMDIG
24460      ICNT=ICNT+1
24461      ITEXT(ICNT)='Standard Error of Beta:'
24462      NCTEXT(ICNT)=23
24463      AVALUE(ICNT)=BETASE
24464      IDIGIT(ICNT)=NUMDIG
24465      ICNT=ICNT+1
24466      ITEXT(ICNT)='Covariance:'
24467      NCTEXT(ICNT)=11
24468      AVALUE(ICNT)=COVSE
24469      IDIGIT(ICNT)=NUMDIG
24470CCCCC ICNT=ICNT+1
24471CCCCC ITEXT(ICNT)='Log-likelihood:'
24472CCCCC NCTEXT(ICNT)=15
24473CCCCC AVALUE(ICNT)=ALIKE
24474CCCCC IDIGIT(ICNT)=-7
24475CCCCC ICNT=ICNT+1
24476CCCCC ITEXT(ICNT)='AIC:'
24477CCCCC NCTEXT(ICNT)=4
24478CCCCC AVALUE(ICNT)=AIC
24479CCCCC IDIGIT(ICNT)=-7
24480CCCCC ICNT=ICNT+1
24481CCCCC ITEXT(ICNT)='AICc:'
24482CCCCC NCTEXT(ICNT)=5
24483CCCCC AVALUE(ICNT)=AICC
24484CCCCC IDIGIT(ICNT)=-7
24485CCCCC ICNT=ICNT+1
24486CCCCC ITEXT(ICNT)='BIC:'
24487CCCCC NCTEXT(ICNT)=4
24488CCCCC AVALUE(ICNT)=BIC
24489CCCCC IDIGIT(ICNT)=-7
24490C
24491      ICNT=ICNT+1
24492      ITEXT(ICNT)=' '
24493      NCTEXT(ICNT)=0
24494      AVALUE(ICNT)=0.0
24495      IDIGIT(ICNT)=-1
24496C
24497C
24498      NUMROW=ICNT
24499      DO2320I=1,NUMROW
24500        NTOT(I)=15
24501 2320 CONTINUE
24502C
24503      IFRST=.TRUE.
24504      ILAST=.TRUE.
24505      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
24506     1            AVALUE,IDIGIT,
24507     1            NTOT,NUMROW,
24508     1            ICAPSW,ICAPTY,ILAST,IFRST,
24509     1            ISUBRO,IBUGA3,IERROR)
24510C
24511      ILIKFL='ON'
24512      ILOCFL='OFF'
24513      ISCAFL='OFF'
24514      ISHAP1='Alpha'
24515      NCSHA1=5
24516      ISHAP2='Beta'
24517      NCSHA2=4
24518      CALL DPDT8A(ALOWLO,AUPPLO,ALOWSC,AUPPSC,
24519     1            ALOWAL,AUPPAL,ALOWA2,AUPPA2,
24520     1            ALOWBE,AUPPBE,ALOWB2,AUPPB2,
24521     1            ALPHA,NUMALP,
24522     1            ICAPSW,ICAPTY,NUMDIG,
24523     1            ILOCFL,ISCAFL,ILIKFL,
24524     1            ISHAP1,NCSHA1,ISHAP2,NCSHA2,
24525     1            ISUBRO,IBUGA3,IERROR)
24526C
24527      IF(NPERC.GT.1)THEN
24528        ILIKFL='OFF'
24529        CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
24530     1              ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
24531     1              ISUBRO,IBUGA3,IERROR)
24532      ENDIF
24533C
24534C
24535C               *****************
24536C               **  STEP 90--  **
24537C               **  EXIT       **
24538C               *****************
24539C
24540 9000 CONTINUE
24541      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLB')THEN
24542        WRITE(ICOUT,999)
24543        CALL DPWRST('XXX','WRIT')
24544        WRITE(ICOUT,9011)
24545 9011   FORMAT('***** AT THE END       OF DPMLLB--')
24546        CALL DPWRST('XXX','WRIT')
24547        WRITE(ICOUT,9012)N,IBUGA3,IERROR
24548 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
24549        CALL DPWRST('XXX','WRIT')
24550        WRITE(ICOUT,9015)N
24551 9015   FORMAT('N = ',I8)
24552        CALL DPWRST('XXX','WRIT')
24553      ENDIF
24554C
24555      RETURN
24556      END
24557      SUBROUTINE DPMLLO(Y,N,
24558     1                  XTEMP,DTEMP1,MAXNXT,
24559     1                  ALOC,ASCALE,
24560     1                  ICAPSW,ICAPTY,IFORSW,
24561     1                  ISUBRO,IBUGA3,IERROR)
24562C
24563C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
24564C              ESTIMATES FOR LOGISTIC DISTRIBUTION
24565C     EXAMPLE--LOGISTIC MAXIMUM LIKELIHOOD Y
24566C     REFERENCE--CHARLES ANTLE, LAWRENCE KLIMKO, AND WILLIAM
24567C                HARKNESS, (1970), "CONFIDENCE INTERVALS FOR THE
24568C                PARAMETERS OF THE LOGISTIC DISTRIBUTION", BIOMETRIKA,
24569C                PP. 397-402.
24570C     WRITTEN BY--JAMES J. FILLIBEN
24571C                 STATISTICAL ENGINEERING DIVISION
24572C                 INFORMATION TECHNOLOGY LABORATORY
24573C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
24574C                 GAITHERSBURG, MD 20899-8980
24575C                 PHONE--301-975-2855
24576C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
24577C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
24578C     LANGUAGE--ANSI FORTRAN (1977)
24579C     VERSION NUMBER--2003/10
24580C     ORIGINAL VERSION--OCTOBER   2003.
24581C     UPDATED         --JANUARY   2005. MODIFY THE OUTPUT FORMAT
24582C                                       TO MAKE MORE CONSISTENT
24583C                                       WITH OTHER DISTRIBUTIONS
24584C     UPDATED         --OCTOBER   2009. EXTRACT ML ESTIMATION TO
24585C                                       LOGML1 ROUTINE
24586C     UPDATED         --OCTOBER   2009. CALL LOGLI1 ROUTINE TO
24587C                                       COMPUTE VALUE OF LIKELIHOOD
24588C     UPDATED         --JUNE      2010. CALL DPDTA1 AND DPDTA7 TO PRINT
24589C                                       OUTPUT
24590C
24591C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
24592C
24593      CHARACTER*4 ICAPSW
24594      CHARACTER*4 ICAPTY
24595      CHARACTER*4 IFORSW
24596C
24597      CHARACTER*4 ISUBRO
24598      CHARACTER*4 IBUGA3
24599      CHARACTER*4 IERROR
24600      CHARACTER*4 INORM
24601      CHARACTER*4 ISUBN1
24602      CHARACTER*4 ISUBN2
24603      CHARACTER*4 ISTEPN
24604C
24605C---------------------------------------------------------------------
24606C
24607      DIMENSION Y(*)
24608      DIMENSION XTEMP(*)
24609      DOUBLE PRECISION DTEMP1(*)
24610C
24611      DIMENSION QP(1)
24612      DIMENSION ATABLE(6,5)
24613      DIMENSION BTABLE(5,10)
24614C
24615      INCLUDE 'DPCOST.INC'
24616C
24617      PARAMETER (NUMALP=2)
24618      REAL ALPHA(NUMALP)
24619      REAL ALOWLO(NUMALP)
24620      REAL AUPPLO(NUMALP)
24621      REAL ALOWSC(NUMALP)
24622      REAL AUPPSC(NUMALP)
24623C
24624      PARAMETER (MAXROW=50)
24625      CHARACTER*60 ITITLZ
24626      CHARACTER*60 ITITLE
24627      CHARACTER*40 ITEXT(MAXROW)
24628      REAL         AVALUE(MAXROW)
24629      INTEGER      NCTEXT(MAXROW)
24630      INTEGER      IDIGIT(MAXROW)
24631      INTEGER      NTOT(MAXROW)
24632C
24633      LOGICAL IFRST
24634      LOGICAL ILAST
24635C
24636C---------------------------------------------------------------------
24637C
24638      INCLUDE 'DPCOP2.INC'
24639C
24640CCCCC DATA PI/3.14159265358979/
24641C
24642      DATA (ATABLE(1,J),J=1,5)/6.3,12.8,25.7,32.2,64.4/
24643      DATA (ATABLE(2,J),J=1,5)/2.9,4.0,5.0,5.4,6.7/
24644      DATA (ATABLE(3,J),J=1,5)/2.50,3.29,4.07,4.30,5.06/
24645      DATA (ATABLE(4,J),J=1,5)/2.34,3.06,3.67,3.87,4.45/
24646      DATA (ATABLE(5,J),J=1,5)/2.25,2.93,3.54,3.70,4.19/
24647      DATA (ATABLE(6,J),J=1,5)/2.22,2.85,3.40,3.56,4.03/
24648C
24649      DATA (BTABLE(I,1),I=1,5)/0.01,0.24,0.436,0.588,0.707/
24650      DATA (BTABLE(I,2),I=1,5)/0.02,0.29,0.475,0.623,0.739/
24651      DATA (BTABLE(I,3),I=1,5)/0.024,0.304,0.492,0.640,0.749/
24652      DATA (BTABLE(I,4),I=1,5)/0.049,0.367,0.551,0.689,0.781/
24653      DATA (BTABLE(I,5),I=1,5)/0.098,0.454,0.626,0.745,0.821/
24654      DATA (BTABLE(I,6),I=1,5)/1.36,1.36,1.28,1.21,1.15/
24655      DATA (BTABLE(I,7),I=1,5)/1.66,1.53,1.45,1.29,1.21/
24656      DATA (BTABLE(I,8),I=1,5)/1.94,1.66,1.52,1.36,1.26/
24657      DATA (BTABLE(I,9),I=1,5)/2.03,1.75,1.55,1.38,1.27/
24658      DATA (BTABLE(I,10),I=1,5)/2.3,2.0,1.65,1.45,1.32/
24659C
24660C-----START POINT-----------------------------------------------------
24661C
24662      ISUBN1='DPML'
24663      ISUBN2='LO  '
24664      IERROR='NO'
24665C
24666      XTEMP(1)=0.0
24667      B1=CPUMIN
24668      B2=CPUMIN
24669      B3=CPUMIN
24670      B4=CPUMIN
24671      A1=CPUMIN
24672      A2=CPUMIN
24673      A3=CPUMIN
24674      A4=CPUMIN
24675C
24676      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLO')THEN
24677        WRITE(ICOUT,999)
24678  999   FORMAT(1X)
24679        CALL DPWRST('XXX','WRIT')
24680        WRITE(ICOUT,51)
24681   51   FORMAT('**** AT THE BEGINNING OF DPMLLO--')
24682        CALL DPWRST('XXX','WRIT')
24683        WRITE(ICOUT,52)IBUGA3
24684   52   FORMAT('IBUGA3 = ',A4)
24685        CALL DPWRST('XXX','WRIT')
24686        WRITE(ICOUT,55)N
24687   55   FORMAT('N = ',I8)
24688        CALL DPWRST('XXX','WRIT')
24689        DO56I=1,N
24690          WRITE(ICOUT,57)I,Y(I)
24691   57     FORMAT('I,Y(I) = ',I8,E15.7)
24692          CALL DPWRST('XXX','WRIT')
24693   56   CONTINUE
24694      ENDIF
24695C
24696C               ********************************************
24697C               **  STEP 11--                             **
24698C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
24699C               ********************************************
24700C
24701      ISTEPN='11'
24702      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLLO')
24703     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
24704C
24705      NPERC=0
24706      NMIN=3
24707      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
24708      IF(IERROR.EQ.'YES')GOTO9000
24709C
24710C               ********************************
24711C               **  STEP 41--                 **
24712C               **  CARRY OUT CALCULATIONS    **
24713C               **  FOR LOGISTIC MLE ESTIMATE **
24714C               ********************************
24715C
24716      ISTEPN='41'
24717      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLO')
24718     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
24719C
24720      CALL LOGML1(Y,N,MAXNXT,
24721     1            DTEMP1,
24722     1            XMEAN,XSD,XMIN,XMAX,
24723     1            ALOC,ASCALE,
24724     1            ISUBRO,IBUGA3,IERROR)
24725C
24726      CALL LOGLI1(Y,N,ALOC,ASCALE,
24727     1            ALIK,AIC,AICC,BIC,
24728     1            ISUBRO,IBUGA3,IERROR)
24729C
24730C               ***********************************************
24731C               **  STEP 41B-                                **
24732C               **  COMPUTE 90% AND 95% CONFIDENCE INTERVALS **
24733C               **  USING METHOD GIVEN IN ANTLE PAPER        **
24734C               ***********************************************
24735C
24736      AN=REAL(N)
24737      IF(N.EQ.2)THEN
24738        A1=ATABLE(1,2)
24739        A2=ATABLE(1,3)
24740      ELSEIF(N.GE.3 .AND. N.LE.4)THEN
24741        AFACT=REAL(N-2)/REAL(5-2)
24742        A1=ATABLE(2,2) - AFACT*ABS(ATABLE(2,2)-ATABLE(1,2))
24743        A2=ATABLE(2,3) - AFACT*ABS(ATABLE(2,3)-ATABLE(1,3))
24744      ELSEIF(N.EQ.5)THEN
24745        A1=ATABLE(2,2)
24746        A2=ATABLE(2,3)
24747      ELSEIF(N.GE.6 .AND. N.LE.9)THEN
24748        AFACT=REAL(N-5)/REAL(10-5)
24749        A1=ATABLE(3,2) - AFACT*ABS(ATABLE(3,2)-ATABLE(2,2))
24750        A2=ATABLE(3,3) - AFACT*ABS(ATABLE(3,3)-ATABLE(2,3))
24751      ELSEIF(N.EQ.10)THEN
24752        A1=ATABLE(3,2)
24753        A2=ATABLE(3,3)
24754      ELSEIF(N.GE.11 .AND. N.LE.19)THEN
24755        AFACT=REAL(N-10)/REAL(20-10)
24756        A1=ATABLE(4,2) - AFACT*ABS(ATABLE(4,2)-ATABLE(3,2))
24757        A2=ATABLE(4,3) - AFACT*ABS(ATABLE(4,3)-ATABLE(3,3))
24758      ELSEIF(N.EQ.20)THEN
24759        A1=ATABLE(4,2)
24760        A2=ATABLE(4,3)
24761      ELSEIF(N.GE.21 .AND. N.LE.39)THEN
24762        AFACT=REAL(N-20)/REAL(40-20)
24763        A1=ATABLE(5,2) - AFACT*ABS(ATABLE(5,2)-ATABLE(4,2))
24764        A2=ATABLE(5,3) - AFACT*ABS(ATABLE(5,3)-ATABLE(4,3))
24765      ELSEIF(N.EQ.40)THEN
24766        A1=ATABLE(5,2)
24767        A2=ATABLE(5,3)
24768      ELSEIF(N.GT.40)THEN
24769        A1=ATABLE(6,2)
24770        A2=ATABLE(6,3)
24771      ENDIF
24772      ALOWLO(1)=ALOC - A1*ASCALE/SQRT(AN)
24773      AUPPLO(1)=ALOC + A1*ASCALE/SQRT(AN)
24774      ALOWLO(2)=ALOC - A2*ASCALE/SQRT(AN)
24775      AUPPLO(2)=ALOC + A2*ASCALE/SQRT(AN)
24776C
24777      IF(N.EQ.2)THEN
24778        B1=BTABLE(1,4)
24779        B2=BTABLE(1,7)
24780        B3=BTABLE(1,3)
24781        B4=BTABLE(1,8)
24782      ELSEIF(N.GE.3 .AND. N.LE.4)THEN
24783        AFACT=REAL(N-2)/REAL(5-2)
24784        B1=BTABLE(1,4) + AFACT*ABS(BTABLE(2,4)-BTABLE(1,4))
24785        B2=BTABLE(1,7) + AFACT*ABS(BTABLE(2,7)-BTABLE(1,7))
24786        B3=BTABLE(1,3) + AFACT*ABS(BTABLE(2,3)-BTABLE(1,3))
24787        B4=BTABLE(1,8) + AFACT*ABS(BTABLE(2,8)-BTABLE(1,8))
24788      ELSEIF(N.EQ.5)THEN
24789        B1=BTABLE(2,4)
24790        B2=BTABLE(2,7)
24791        B3=BTABLE(2,3)
24792        B4=BTABLE(2,8)
24793      ELSEIF(N.GE.6 .AND. N.LE.9)THEN
24794        AFACT=REAL(N-5)/REAL(10-5)
24795        B1=BTABLE(2,4) + AFACT*ABS(BTABLE(3,4)-BTABLE(2,4))
24796        B2=BTABLE(2,7) + AFACT*ABS(BTABLE(3,7)-BTABLE(2,7))
24797        B3=BTABLE(2,3) + AFACT*ABS(BTABLE(3,3)-BTABLE(2,3))
24798        B4=BTABLE(2,8) + AFACT*ABS(BTABLE(3,8)-BTABLE(2,8))
24799      ELSEIF(N.EQ.10)THEN
24800        B1=BTABLE(3,4)
24801        B2=BTABLE(3,7)
24802        B3=BTABLE(3,3)
24803        B4=BTABLE(3,8)
24804      ELSEIF(N.GE.11 .AND. N.LE.19)THEN
24805        AFACT=REAL(N-10)/REAL(20-10)
24806        B1=BTABLE(3,4) + AFACT*ABS(BTABLE(4,4)-BTABLE(3,4))
24807        B2=BTABLE(3,7) + AFACT*ABS(BTABLE(4,7)-BTABLE(3,7))
24808        B3=BTABLE(3,3) + AFACT*ABS(BTABLE(4,3)-BTABLE(3,3))
24809        B4=BTABLE(3,8) + AFACT*ABS(BTABLE(4,8)-BTABLE(3,8))
24810      ELSEIF(N.EQ.20)THEN
24811        B1=BTABLE(4,4)
24812        B2=BTABLE(4,7)
24813        B3=BTABLE(4,3)
24814        B4=BTABLE(4,8)
24815      ELSEIF(N.GE.21 .AND. N.LE.39)THEN
24816        AFACT=REAL(N-20)/REAL(40-20)
24817        B1=BTABLE(4,4) + AFACT*ABS(BTABLE(5,4)-BTABLE(4,4))
24818        B2=BTABLE(4,7) + AFACT*ABS(BTABLE(5,7)-BTABLE(4,7))
24819        B3=BTABLE(4,3) + AFACT*ABS(BTABLE(5,3)-BTABLE(4,3))
24820        B4=BTABLE(4,8) + AFACT*ABS(BTABLE(5,8)-BTABLE(4,8))
24821      ELSEIF(N.GE.40)THEN
24822        B1=BTABLE(5,4)
24823        B2=BTABLE(5,7)
24824        B3=BTABLE(5,3)
24825        B4=BTABLE(5,8)
24826      ENDIF
24827      ALOWSC(1)=ASCALE/B2
24828      AUPPSC(1)=ASCALE/B1
24829      ALOWSC(2)=ASCALE/B4
24830      AUPPSC(2)=ASCALE/B3
24831C
24832C               **********************************
24833C               **   STEP 42--                  **
24834C               **   WRITE OUT EVERYTHING       **
24835C               **   FOR LOGISTIC MLE ESTIMATE  **
24836C               **********************************
24837C
24838      ISTEPN='42'
24839      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLLO')
24840     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
24841C
24842      IF(IPRINT.EQ.'OFF')GOTO9000
24843C
24844      NUMDIG=7
24845      IF(IFORSW.EQ.'1')NUMDIG=1
24846      IF(IFORSW.EQ.'2')NUMDIG=2
24847      IF(IFORSW.EQ.'3')NUMDIG=3
24848      IF(IFORSW.EQ.'4')NUMDIG=4
24849      IF(IFORSW.EQ.'5')NUMDIG=5
24850      IF(IFORSW.EQ.'6')NUMDIG=6
24851      IF(IFORSW.EQ.'7')NUMDIG=7
24852      IF(IFORSW.EQ.'8')NUMDIG=8
24853      IF(IFORSW.EQ.'9')NUMDIG=9
24854      IF(IFORSW.EQ.'0')NUMDIG=0
24855      IF(IFORSW.EQ.'E')NUMDIG=-2
24856      IF(IFORSW.EQ.'-2')NUMDIG=-2
24857      IF(IFORSW.EQ.'-3')NUMDIG=-3
24858      IF(IFORSW.EQ.'-4')NUMDIG=-4
24859      IF(IFORSW.EQ.'-5')NUMDIG=-5
24860      IF(IFORSW.EQ.'-6')NUMDIG=-6
24861      IF(IFORSW.EQ.'-7')NUMDIG=-7
24862      IF(IFORSW.EQ.'-8')NUMDIG=-8
24863      IF(IFORSW.EQ.'-9')NUMDIG=-9
24864C
24865      ITITLE='Logisitic Parameter Estimation'
24866      NCTITL=30
24867      ITITLZ=' '
24868      NCTITZ=0
24869      ITEXT(1)='Summary Statistics:'
24870      NCTEXT(1)=19
24871      AVALUE(1)=0.0
24872      IDIGIT(1)=-1
24873      ITEXT(2)='Number of Observations:'
24874      NCTEXT(2)=23
24875      AVALUE(2)=REAL(N)
24876      IDIGIT(2)=0
24877      ICNT=3
24878      ITEXT(ICNT)='Sample Mean:'
24879      NCTEXT(ICNT)=12
24880      AVALUE(ICNT)=XMEAN
24881      IDIGIT(ICNT)=NUMDIG
24882      ICNT=ICNT+1
24883      ITEXT(ICNT)='Sample Standard Deviation:'
24884      NCTEXT(ICNT)=26
24885      AVALUE(ICNT)=XSD
24886      IDIGIT(ICNT)=NUMDIG
24887      ICNT=ICNT+1
24888      ITEXT(ICNT)='Sample Minimum:'
24889      NCTEXT(ICNT)=15
24890      AVALUE(ICNT)=XMIN
24891      IDIGIT(ICNT)=NUMDIG
24892      ICNT=ICNT+1
24893      ITEXT(ICNT)='Sample Maximum:'
24894      NCTEXT(ICNT)=15
24895      AVALUE(ICNT)=XMAX
24896      IDIGIT(ICNT)=NUMDIG
24897      ICNT=ICNT+1
24898      ITEXT(ICNT)=' '
24899      NCTEXT(ICNT)=0
24900      AVALUE(ICNT)=0.0
24901      IDIGIT(ICNT)=-1
24902C
24903      ICNT=ICNT+1
24904      ITEXT(ICNT)='Maximum Likelihood Estimation Method:'
24905      NCTEXT(ICNT)=37
24906      AVALUE(ICNT)=0.0
24907      IDIGIT(ICNT)=-1
24908      ICNT=ICNT+1
24909      ITEXT(ICNT)='Location Parameter:'
24910      NCTEXT(ICNT)=19
24911      AVALUE(ICNT)=ALOC
24912      IDIGIT(ICNT)=NUMDIG
24913      ICNT=ICNT+1
24914      ITEXT(ICNT)='Scale Parameter:'
24915      NCTEXT(ICNT)=16
24916      AVALUE(ICNT)=ASCALE
24917      IDIGIT(ICNT)=NUMDIG
24918      ICNT=ICNT+1
24919      ITEXT(ICNT)='Log-likelihood:'
24920      NCTEXT(ICNT)=15
24921      AVALUE(ICNT)=ALIK
24922      IDIGIT(ICNT)=-7
24923      ICNT=ICNT+1
24924      ITEXT(ICNT)='AIC:'
24925      NCTEXT(ICNT)=4
24926      AVALUE(ICNT)=AIC
24927      IDIGIT(ICNT)=-7
24928      ICNT=ICNT+1
24929      ITEXT(ICNT)='AICc:'
24930      NCTEXT(ICNT)=5
24931      AVALUE(ICNT)=AICC
24932      IDIGIT(ICNT)=-7
24933      ICNT=ICNT+1
24934      ITEXT(ICNT)='BIC:'
24935      NCTEXT(ICNT)=4
24936      AVALUE(ICNT)=BIC
24937      IDIGIT(ICNT)=-7
24938      ICNT=ICNT+1
24939      ITEXT(ICNT)=' '
24940      NCTEXT(ICNT)=0
24941      AVALUE(ICNT)=0.0
24942      IDIGIT(ICNT)=-1
24943C
24944      NUMROW=ICNT
24945      DO2310I=1,NUMROW
24946        NTOT(I)=15
24947 2310 CONTINUE
24948C
24949      IFRST=.TRUE.
24950      ILAST=.FALSE.
24951      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
24952     1            NCTEXT,AVALUE,IDIGIT,
24953     1            NTOT,NUMROW,
24954     1            ICAPSW,ICAPTY,ILAST,IFRST,
24955     1            ISUBRO,IBUGA3,IERROR)
24956      IFRST=.FALSE.
24957      ITITLE=' '
24958      NCTITL=0
24959C
24960      ALPHA(1)=0.10
24961      ALPHA(2)=0.05
24962      INORM='YES'
24963      CALL DPDTA7(ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,NUMALP,
24964     1            ICAPSW,ICAPTY,NUMDIG,INORM,
24965     1            ISUBRO,IBUGA3,IERROR)
24966C
24967C
24968C               *****************
24969C               **  STEP 90--  **
24970C               **  EXIT       **
24971C               *****************
24972C
24973 9000 CONTINUE
24974      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLO')THEN
24975        WRITE(ICOUT,999)
24976        CALL DPWRST('XXX','WRIT')
24977        WRITE(ICOUT,9011)
24978 9011   FORMAT('***** AT THE END       OF DPMLLO--')
24979        CALL DPWRST('XXX','WRIT')
24980        WRITE(ICOUT,9012)N,IBUGA3,IERROR
24981 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
24982        CALL DPWRST('XXX','WRIT')
24983      ENDIF
24984C
24985      RETURN
24986      END
24987      SUBROUTINE DPMLL1(Y,N,MAXNXT,XTEMP,
24988     1                  SHAPML,SHAPSE,SCALML,SCALSE,UHATML,UHATSE,
24989     1                  NUMV,
24990     1                  ICAPSW,ICAPTY,IFORSW,
24991     1                  QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
24992     1                  IOUNI1,IOUNI2,ALPHAP,
24993     1                  ISUBRO,IBUGA3,IERROR)
24994C
24995C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
24996C              ESTIMATES FOR LOGNORMAL DISTRIBUTION
24997C              FOR THE FULL SAMPLE CASE.
24998C     EXAMPLE--LOGNORMAL MAXIMUM LIKELIHOOD Y
24999C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
25000C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
25001C                1999, CHAPTER 13.
25002C              --"STATISTICAL DISTRIBUTIONS", THIRD EDITION,
25003C                EVANS, HASTINGS, AND PEACOCK, WILEY, 2001.
25004C              --"METHODS FOR STATISTICAL ANALYSIS OF RELIABILITY
25005C                AND LIFE DATA", MANN, SCHAFER, AND SINGPURWALLA,
25006C                WILEY, 1974, PP. 264-268.
25007C     WRITTEN BY--ALAN HECKERT
25008C                 STATISTICAL ENGINEERING DIVISION
25009C                 INFORMATION TECHNOLOGY LABORATORY
25010C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
25011C                 GAITHERSBURG, MD 20899-8980
25012C                 PHONE--301-975-2899
25013C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
25014C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
25015C     LANGUAGE--ANSI FORTRAN (1977)
25016C     VERSION NUMBER--2004/11
25017C     ORIGINAL VERSION--NOVEMBER  2004. NOTE: THIS REPLACES AN
25018C                                       EARLIER IMPLEMENTATION.
25019C     UPDATED         --APRIL     2010. PUT POINT ESTIMATES IN A
25020C                                       SEPARATE ROUTINE TO MAKE IT
25021C                                       EASIER TO CALL FROM OTHER
25022C                                       ROUTINES (BOOTSTRAP, GOODNESS
25023C                                       OF FIT)
25024C     UPDATED         --APRIL     2010. USE DPDTA1, DPDTA8, DPDTA9
25025C                                       ROUTINES TO PRINT OUTPUT
25026C
25027C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
25028C
25029      CHARACTER*4 ICAPSW
25030      CHARACTER*4 ICAPTY
25031      CHARACTER*4 IFORSW
25032      CHARACTER*4 ISUBRO
25033      CHARACTER*4 IBUGA3
25034      CHARACTER*4 IERROR
25035C
25036      CHARACTER*4 ILIKFL
25037      CHARACTER*4 ISUBN1
25038      CHARACTER*4 ISUBN2
25039      CHARACTER*4 ISTEPN
25040C
25041C---------------------------------------------------------------------
25042C
25043      PARAMETER (NUMALP=8)
25044      DIMENSION ALPHA(NUMALP)
25045      DIMENSION ALOWSC(NUMALP)
25046      DIMENSION AUPPSC(NUMALP)
25047      DIMENSION ALOWUH(NUMALP)
25048      DIMENSION AUPPUH(NUMALP)
25049      DIMENSION ALOWSH(NUMALP)
25050      DIMENSION AUPPSH(NUMALP)
25051      DIMENSION ALOWS2(NUMALP)
25052      DIMENSION AUPPS2(NUMALP)
25053C
25054      DIMENSION Y(*)
25055      DIMENSION XTEMP(*)
25056      DIMENSION QP(*)
25057      DIMENSION XQPHAT(*)
25058      DIMENSION XQPSE(*)
25059      DIMENSION XQPLCL(*)
25060      DIMENSION XQPUCL(*)
25061C
25062      INCLUDE 'DPCOST.INC'
25063C
25064      PARAMETER (MAXROW=30)
25065      CHARACTER*60 ITITLE
25066      CHARACTER*60 ITITLZ
25067      CHARACTER*40 ITEXT(MAXROW)
25068      REAL         AVALUE(MAXROW)
25069      INTEGER      NCTEXT(MAXROW)
25070      INTEGER      IDIGIT(MAXROW)
25071      INTEGER      NTOT(MAXROW)
25072      LOGICAL IFRST
25073      LOGICAL ILAST
25074C
25075C---------------------------------------------------------------------
25076C
25077      INCLUDE 'DPCOP2.INC'
25078C
25079      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
25080C
25081C-----START POINT-----------------------------------------------------
25082C
25083      ISUBN1='DPML'
25084      ISUBN2='L1  '
25085      IERROR='NO'
25086C
25087      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL1')THEN
25088        WRITE(ICOUT,999)
25089  999   FORMAT(1X)
25090        CALL DPWRST('XXX','WRIT')
25091        WRITE(ICOUT,51)
25092   51   FORMAT('**** AT THE BEGINNING OF DPMLL1--')
25093        CALL DPWRST('XXX','WRIT')
25094        WRITE(ICOUT,55)N,NUMV,IOUNI2,IBUGA3
25095   55   FORMAT('N,NUMV,NPERC,IOUNI2,IBUGA3 = ',4I8,2X,A4)
25096        CALL DPWRST('XXX','WRIT')
25097        DO56I=1,MIN(N,100)
25098          WRITE(ICOUT,57)I,Y(I)
25099   57     FORMAT('I,Y(I) = ',I8,G15.7)
25100          CALL DPWRST('XXX','WRIT')
25101   56   CONTINUE
25102      ENDIF
25103C
25104C               ********************************************
25105C               **  STEP 11--                             **
25106C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
25107C               ********************************************
25108C
25109      ISTEPN='11'
25110      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL1')
25111     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
25112C
25113      NMIN=3
25114      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
25115      IF(IERROR.EQ.'YES')GOTO9000
25116C
25117C               **********************************
25118C               **  STEP 41--                   **
25119C               **  CARRY OUT CALCULATIONS      **
25120C               **  FOR LOGNORMAL MLE           **
25121C               **  ESTIMATE (FULL SAMPLE CASE) **
25122C               **********************************
25123C
25124      CALL LGNML1(Y,N,MAXNXT,
25125     1            XTEMP,
25126     1            XMEAN,XMED,XSD,XVAR,XMIN,XMAX,XMEANL,XSDL,
25127     1            SCALML,SCALSE,SHAPML,SHAPSE,UHATML,UHATSE,
25128     1            ISUBRO,IBUGA3,IERROR)
25129      ALOC=0.0
25130      CALL LGNLI1(Y,N,ALOC,SCALML,SHAPML,
25131     1            ALIK,AIC,AICC,BIC,
25132     1            ISUBRO,IBUGA3,IERROR)
25133C
25134C     CONFIDENCE INTERVALS FOR PARAMETERS.  NOTE THAT FOR THE
25135C     FULL SAMPLE CASE, THE SAMPLING DISTRIBUTIONS ARE EXACT.
25136C
25137      AN=REAL(N)
25138      IDF=N-1
25139      ADF=REAL(N-1)
25140      DO4110I=1,NUMALP
25141        ALP=ALPHA(I)
25142        P1=ALP/2.0
25143        P2=1.0-(ALP/2.0)
25144        CALL TPPF(P1,REAL(IDF),TLOW)
25145        CALL TPPF(P2,REAL(IDF),TUPP)
25146        ALOWUH(I)=UHATML + TLOW*UHATSE
25147        AUPPUH(I)=UHATML + TUPP*UHATSE
25148CCCCC   ALOWSC(I)=SCALML + TLOW*SCALSE
25149CCCCC   AUPPSC(I)=SCALML + TUPP*SCALSE
25150        ALOWSC(I)=EXP(ALOWUH(I))
25151        AUPPSC(I)=EXP(AUPPUH(I))
25152        CALL CHSPPF(P1,IDF,CSLOW)
25153        CALL CHSPPF(P2,IDF,CSUPP)
25154        ALOWSH(I)=SHAPML*SQRT(ADF/CSUPP)
25155        AUPPSH(I)=SHAPML*SQRT(ADF/CSLOW)
25156 4110 CONTINUE
25157C
25158C     CONFIDENCE INTERVALS FOR SELECTED PERCENTILES.
25159C
25160C     FULL SAMPLE CASE BASED ON NON-CENTRAL T
25161C
25162      IF(NPERC.GE.1)THEN
25163C
25164        C1=SHAPML/SQRT(AN)
25165        ALPHL=ALPHAP/2.0
25166        ALPHU=1.0 - ALPHAP/2.0
25167C
25168        WRITE(IOUNI1,4191)
25169 4191   FORMAT(15X,'       POINT     ','     LOWER     ',
25170     1         '     UPPER')
25171        WRITE(IOUNI1,4192)
25172 4192   FORMAT('    PERCENTILE ','     ESTIMATE   ',
25173     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
25174        DO4190I=1,NPERC
25175          QPTEMP=QP(I)/100.0
25176C
25177          CALL NORPPF(QPTEMP,APPF)
25178          DELTA=APPF*SQRT(AN)
25179C
25180          CALL LGNPPF(QPTEMP,SHAPML,ATEMP)
25181          XQPHAT(I)=SCALML*ATEMP
25182C
25183          IF(DELTA.LT.0.0)THEN
25184            DELTA2=-DELTA
25185            CALL NCTPPF(ALPHU,ADF,DELTA2,C2)
25186            C2=-C2
25187            CALL NCTPPF(ALPHL,ADF,DELTA2,C3)
25188            C3=-C3
25189          ELSE
25190            CALL NCTPPF(ALPHL,ADF,DELTA,C2)
25191            CALL NCTPPF(ALPHU,ADF,DELTA,C3)
25192          ENDIF
25193          ATEMP1=EXP(UHATML + C1*C2)
25194          ATEMP2=EXP(UHATML + C1*C3)
25195          XQPLCL(I)=MIN(ATEMP1,ATEMP2)
25196          XQPUCL(I)=MAX(ATEMP1,ATEMP2)
25197          WRITE(IOUNI1,'(3E15.7,2X,E15.7)')
25198     1         QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I)
25199C
25200          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLL1')THEN
25201            WRITE(ICOUT,4193)XMEAN,XSD,ADF,ALPHA
25202 4193       FORMAT('XMEAN,XSD,ADF,ALPHA = ',4G15.7)
25203            CALL DPWRST('XXX','BUG ')
25204            WRITE(ICOUT,4195)DELTA,C1,C2,C3
25205 4195       FORMAT('DELTA,C1,C2,C3 = ',4G15.7)
25206            CALL DPWRST('XXX','BUG ')
25207            WRITE(ICOUT,4197)ATEMP1,ATEMP2
25208 4197       FORMAT('ATEMP1,ATEMP2 = ',2G15.7)
25209            CALL DPWRST('XXX','BUG ')
25210          ENDIF
25211C
25212 4190   CONTINUE
25213C
25214      ENDIF
25215C
25216C               *************************************
25217C               **   STEP 42--                     **
25218C               **   WRITE OUT EVERYTHING          **
25219C               **   FOR LOGNORMAL MLE ESTIMATE    **
25220C               *************************************
25221C
25222      ISTEPN='42'
25223      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL1')
25224     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
25225C
25226C     PRINT SUMMARY STATISTICS TABLE
25227C
25228      IF(IPRINT.EQ.'OFF')GOTO9000
25229C
25230      NUMDIG=7
25231      IF(IFORSW.EQ.'1')NUMDIG=1
25232      IF(IFORSW.EQ.'2')NUMDIG=2
25233      IF(IFORSW.EQ.'3')NUMDIG=3
25234      IF(IFORSW.EQ.'4')NUMDIG=4
25235      IF(IFORSW.EQ.'5')NUMDIG=5
25236      IF(IFORSW.EQ.'6')NUMDIG=6
25237      IF(IFORSW.EQ.'7')NUMDIG=7
25238      IF(IFORSW.EQ.'8')NUMDIG=8
25239      IF(IFORSW.EQ.'9')NUMDIG=9
25240      IF(IFORSW.EQ.'0')NUMDIG=0
25241      IF(IFORSW.EQ.'E')NUMDIG=-2
25242      IF(IFORSW.EQ.'-2')NUMDIG=-2
25243      IF(IFORSW.EQ.'-3')NUMDIG=-3
25244      IF(IFORSW.EQ.'-4')NUMDIG=-4
25245      IF(IFORSW.EQ.'-5')NUMDIG=-5
25246      IF(IFORSW.EQ.'-6')NUMDIG=-6
25247      IF(IFORSW.EQ.'-7')NUMDIG=-7
25248      IF(IFORSW.EQ.'-8')NUMDIG=-8
25249      IF(IFORSW.EQ.'-9')NUMDIG=-9
25250C
25251      ITITLE='Two-Parameter Lognormal Parameter Estimation:'
25252      NCTITL=45
25253      ITITLZ='Full Sample Case'
25254      NCTITZ=16
25255      ICNT=1
25256      ITEXT(ICNT)='Summary Statistics:'
25257      NCTEXT(ICNT)=19
25258      AVALUE(ICNT)=0.0
25259      IDIGIT(ICNT)=0
25260      ICNT=ICNT+1
25261      ITEXT(ICNT)='Number of Observations:'
25262      NCTEXT(ICNT)=23
25263      AVALUE(ICNT)=REAL(N)
25264      IDIGIT(ICNT)=0
25265      ICNT=ICNT+1
25266      ITEXT(ICNT)='Sample Mean:'
25267      NCTEXT(ICNT)=12
25268      AVALUE(ICNT)=XMEAN
25269      IDIGIT(ICNT)=NUMDIG
25270      ICNT=ICNT+1
25271      ITEXT(ICNT)='Sample Standard Deviation:'
25272      NCTEXT(ICNT)=26
25273      AVALUE(ICNT)=XSD
25274      IDIGIT(ICNT)=NUMDIG
25275      ICNT=ICNT+1
25276      ITEXT(ICNT)='Sample Minimum:'
25277      NCTEXT(ICNT)=15
25278      AVALUE(ICNT)=XMIN
25279      IDIGIT(ICNT)=NUMDIG
25280      ICNT=ICNT+1
25281      ITEXT(ICNT)='Sample Maximum:'
25282      NCTEXT(ICNT)=15
25283      AVALUE(ICNT)=XMAX
25284      IDIGIT(ICNT)=NUMDIG
25285      ICNT=ICNT+1
25286      ITEXT(ICNT)='Sample Median:'
25287      NCTEXT(ICNT)=14
25288      AVALUE(ICNT)=XMED
25289      IDIGIT(ICNT)=NUMDIG
25290      ICNT=ICNT+1
25291      ITEXT(ICNT)=' '
25292      NCTEXT(ICNT)=0
25293      AVALUE(ICNT)=0.0
25294      IDIGIT(ICNT)=-1
25295C
25296      ICNT=ICNT+1
25297      ITEXT(ICNT)='Maximum Likelihood:'
25298      NCTEXT(ICNT)=19
25299      AVALUE(ICNT)=0.0
25300      IDIGIT(ICNT)=-1
25301      ICNT=ICNT+1
25302      ITEXT(ICNT)='Estimate of Shape (Sigma):'
25303      NCTEXT(ICNT)=26
25304      AVALUE(ICNT)=SHAPML
25305      IDIGIT(ICNT)=NUMDIG
25306      ICNT=ICNT+1
25307      ITEXT(ICNT)='Standard Error of Shape:'
25308      NCTEXT(ICNT)=24
25309      AVALUE(ICNT)=SHAPSE
25310      IDIGIT(ICNT)=NUMDIG
25311      ICNT=ICNT+1
25312      ITEXT(ICNT)='Estimate of Scale:'
25313      NCTEXT(ICNT)=18
25314      AVALUE(ICNT)=SCALML
25315      IDIGIT(ICNT)=NUMDIG
25316      ICNT=ICNT+1
25317      ITEXT(ICNT)='Standard Error of Scale:'
25318      NCTEXT(ICNT)=24
25319      AVALUE(ICNT)=SCALSE
25320      IDIGIT(ICNT)=NUMDIG
25321      ICNT=ICNT+1
25322      ITEXT(ICNT)='Estimate of MU (= LOG(Scale)):'
25323      NCTEXT(ICNT)=30
25324      AVALUE(ICNT)=UHATML
25325      IDIGIT(ICNT)=NUMDIG
25326      ICNT=ICNT+1
25327      ITEXT(ICNT)='Standard Error of MU:'
25328      NCTEXT(ICNT)=21
25329      AVALUE(ICNT)=UHATSE
25330      IDIGIT(ICNT)=NUMDIG
25331C
25332      ICNT=ICNT+1
25333      ITEXT(ICNT)='Log-likelihood:'
25334      NCTEXT(ICNT)=15
25335      AVALUE(ICNT)=ALIK
25336      IDIGIT(ICNT)=-7
25337      ICNT=ICNT+1
25338      ITEXT(ICNT)='AIC:'
25339      NCTEXT(ICNT)=4
25340      AVALUE(ICNT)=AIC
25341      IDIGIT(ICNT)=-7
25342      ICNT=ICNT+1
25343      ITEXT(ICNT)='AICc:'
25344      NCTEXT(ICNT)=5
25345      AVALUE(ICNT)=AICC
25346      IDIGIT(ICNT)=-7
25347      ICNT=ICNT+1
25348      ITEXT(ICNT)='BIC:'
25349      NCTEXT(ICNT)=4
25350      AVALUE(ICNT)=BIC
25351      IDIGIT(ICNT)=-7
25352C
25353      NUMROW=ICNT
25354      DO2320I=1,NUMROW
25355        NTOT(I)=15
25356 2320 CONTINUE
25357C
25358      IFRST=.TRUE.
25359      ILAST=.TRUE.
25360      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
25361     1            AVALUE,IDIGIT,
25362     1            NTOT,NUMROW,
25363     1            ICAPSW,ICAPTY,ILAST,IFRST,
25364     1            ISUBRO,IBUGA3,IERROR)
25365C
25366      ILIKFL='LOGN'
25367      CALL DPDTA8(ALOWSC,AUPPSC,ALOWUH,AUPPUH,
25368     1            ALOWSH,AUPPSH,ALOWS2,AUPPS2,ALPHA,NUMALP,
25369     1            ICAPSW,ICAPTY,NUMDIG,ILIKFL,
25370     1            ISUBRO,IBUGA3,IERROR)
25371C
25372      IF(NPERC.GT.1)THEN
25373        ILIKFL='OFF'
25374        XQPSE(1)=CPUMIN
25375        CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
25376     1              ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
25377     1              ISUBRO,IBUGA3,IERROR)
25378
25379      ENDIF
25380C
25381C               *****************
25382C               **  STEP 90--  **
25383C               **  EXIT       **
25384C               *****************
25385C
25386 9000 CONTINUE
25387      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL1')THEN
25388        WRITE(ICOUT,999)
25389        CALL DPWRST('XXX','WRIT')
25390        WRITE(ICOUT,9011)
25391 9011   FORMAT('***** AT THE END       OF DPMLL1--')
25392        CALL DPWRST('XXX','WRIT')
25393        WRITE(ICOUT,9012)SHAPML,SCALML,UHATML
25394 9012   FORMAT('SHAPML,SCALML,UHATML = ',3G15.7)
25395        CALL DPWRST('XXX','WRIT')
25396        WRITE(ICOUT,9013)SHAPSE,SCALSE,UHATSE
25397 9013   FORMAT('SHAPSE,SCALSE,UHATSE = ',3G15.7)
25398        CALL DPWRST('XXX','WRIT')
25399      ENDIF
25400C
25401      RETURN
25402      END
25403      SUBROUTINE DPMLL2(Y,TAG,N,
25404     1                  XTEMP,TEMP1,DTEMP,ITEMP,MAXNXT,
25405     1                  SIGMML,SIGMSE,SCALML,SCALSE,
25406     1                  UHATML,UHATSE,COVSE,
25407     1                  NUMV,TEND,
25408     1                  ICAPSW,ICAPTY,IFORSW,
25409     1                  QP,XQPHAT,XQPLCL,XQPUCL,XQPLC2,
25410     1                  XQPUC2,XQPSE,NPERC,
25411     1                  IOUNI1,IOUNI2,ALPHAP,
25412     1                  ISUBRO,IBUGA3,IERROR)
25413C
25414C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
25415C              ESTIMATES FOR LOGNORMAL DISTRIBUTION
25416C              FOR THE TIME CENSORED CASE.  CURRENTLY, ONLY
25417C              SINGLY CENSORED DATA IS SUPPORTED (I.E., ALL
25418C              CENSOR TIMES ARE THE SAME).
25419C     EXAMPLE--LOGNORMAL MAXIMUM LIKELIHOOD Y X
25420C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
25421C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
25422C                1999, CHAPTER 11.
25423C     WRITTEN BY--ALAN HECKERT
25424C                 STATISTICAL ENGINEERING DIVISION
25425C                 INFORMATION TECHNOLOGY LABORATORY
25426C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
25427C                 GAITHERSBURG, MD 20899-8980
25428C                 PHONE--301-975-2899
25429C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
25430C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
25431C     LANGUAGE--ANSI FORTRAN (1977)
25432C     VERSION NUMBER--2004/11
25433C     ORIGINAL VERSION--NOVEMBER  2004.
25434C     UPDATED         --JULY      2010. PRINT OUTPUT USING DPDTA1,
25435C                                       DPDTA7, DPDTA9
25436C     UPDATED         --JULY      2010. EXTRACT POINT ESTIMATES TO
25437C                                       LGNML2
25438C
25439C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
25440C
25441      CHARACTER*4 ICAPSW
25442      CHARACTER*4 ICAPTY
25443      CHARACTER*4 IFORSW
25444      CHARACTER*4 ISUBRO
25445      CHARACTER*4 IBUGA3
25446      CHARACTER*4 IERROR
25447C
25448      CHARACTER*4 ICASE
25449      CHARACTER*4 IWRITE
25450      CHARACTER*40 IDIST
25451      CHARACTER*4 ISUBN1
25452      CHARACTER*4 ISUBN2
25453      CHARACTER*4 ISTEPN
25454C
25455C---------------------------------------------------------------------
25456C
25457      PARAMETER (NUMALP=8)
25458      DIMENSION ALPHA(NUMALP)
25459      DIMENSION ALOWSC(NUMALP)
25460      DIMENSION AUPPSC(NUMALP)
25461      DIMENSION ALOWS2(NUMALP)
25462      DIMENSION AUPPS2(NUMALP)
25463      DIMENSION ALOWUH(NUMALP)
25464      DIMENSION AUPPUH(NUMALP)
25465      DIMENSION ALOWU2(NUMALP)
25466      DIMENSION AUPPU2(NUMALP)
25467      DIMENSION ALOWSH(NUMALP)
25468      DIMENSION AUPPSH(NUMALP)
25469      DIMENSION ALOSH2(NUMALP)
25470      DIMENSION AUPSH2(NUMALP)
25471C
25472      DIMENSION Y(*)
25473      DIMENSION TAG(*)
25474      DIMENSION XTEMP(*)
25475      DIMENSION TEMP1(*)
25476      DIMENSION QP(*)
25477      DIMENSION XQPHAT(*)
25478      DIMENSION XQPSE(*)
25479      DIMENSION XQPLCL(*)
25480      DIMENSION XQPUCL(*)
25481      DIMENSION XQPLC2(*)
25482      DIMENSION XQPUC2(*)
25483      INTEGER ITEMP(*)
25484      DOUBLE PRECISION DTEMP(*)
25485C
25486      DOUBLE PRECISION LG1FUN
25487      DOUBLE PRECISION LG2FUN
25488      DOUBLE PRECISION LG4FUN
25489      DOUBLE PRECISION LG6FUN
25490      EXTERNAL LG1FUN
25491      EXTERNAL LG2FUN
25492      EXTERNAL LG4FUN
25493      EXTERNAL LG6FUN
25494C
25495      DOUBLE PRECISION C
25496      INTEGER IN
25497      INTEGER IM
25498      COMMON/LG1COM/C,IN,IM
25499C
25500      INTEGER N2
25501      INTEGER IR2
25502      INTEGER IM2
25503      DOUBLE PRECISION DLLUS
25504      DOUBLE PRECISION DC
25505      DOUBLE PRECISION DK
25506      DOUBLE PRECISION DSIGMA
25507      COMMON/LG2COM/DLLUS,DC,DK,DSIGMA,N2,IR2,IM2
25508C
25509      INTEGER N3
25510      INTEGER IR3
25511      INTEGER IM3
25512      DOUBLE PRECISION DLLUS2
25513      DOUBLE PRECISION DC2
25514      DOUBLE PRECISION DK2
25515      DOUBLE PRECISION DU2
25516      COMMON/LG4COM/DLLUS2,DC2,DK2,DU2,N3,IR3,IM3
25517C
25518      INTEGER N4
25519      INTEGER IR4
25520      INTEGER IM4
25521      DOUBLE PRECISION DLLUS3
25522      DOUBLE PRECISION DC3
25523      DOUBLE PRECISION DK3
25524      DOUBLE PRECISION DSIGMA3
25525      DOUBLE PRECISION DU3
25526      DOUBLE PRECISION DX05
25527      DOUBLE PRECISION DZ05
25528      DOUBLE PRECISION SEXQP
25529      COMMON/LG6COM/DLLUS3,DC3,DK3,DSIGMA3,DU3,DX05,DZ05,SEXQP,
25530     1N4,IR4,IM4
25531C
25532CCCCC DOUBLE PRECISION TOL
25533CCCCC DOUBLE PRECISION XPAR(2)
25534CCCCC DOUBLE PRECISION FVEC(2)
25535C
25536      DOUBLE PRECISION DXLOW
25537      DOUBLE PRECISION DXUP
25538      DOUBLE PRECISION DXSTRT
25539      DOUBLE PRECISION DN
25540      DOUBLE PRECISION DR
25541      DOUBLE PRECISION DM
25542      DOUBLE PRECISION DX
25543      DOUBLE PRECISION AE
25544      DOUBLE PRECISION RE
25545      DOUBLE PRECISION DS
25546      DOUBLE PRECISION DU
25547      DOUBLE PRECISION DZ
25548CCCCC DOUBLE PRECISION DH
25549      DOUBLE PRECISION DSUM1
25550      DOUBLE PRECISION DSUM2
25551      DOUBLE PRECISION DTERM1
25552      DOUBLE PRECISION DTERM2
25553      DOUBLE PRECISION DTERM3
25554      DOUBLE PRECISION DTERM4
25555      DOUBLE PRECISION DSUM
25556CCCCC DOUBLE PRECISION DCDF
25557C
25558      INCLUDE 'DPCOST.INC'
25559C
25560      PARAMETER (MAXROW=30)
25561      CHARACTER*60 ITITLE
25562      CHARACTER*60 ITITLZ
25563      CHARACTER*4  ILIKFL
25564      CHARACTER*40 ITEXT(MAXROW)
25565      REAL         AVALUE(MAXROW)
25566      INTEGER      NCTEXT(MAXROW)
25567      INTEGER      IDIGIT(MAXROW)
25568      INTEGER      NTOT(MAXROW)
25569      LOGICAL IFRST
25570      LOGICAL ILAST
25571C
25572C---------------------------------------------------------------------
25573C
25574      INCLUDE 'DPCOP2.INC'
25575C
25576      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
25577C
25578C-----START POINT-----------------------------------------------------
25579C
25580      ISUBN1='DPML'
25581      ISUBN2='L2  '
25582      IWRITE='NO'
25583      IERROR='NO'
25584C
25585      DO11I=1,NUMALP
25586        QP(I)=CPUMIN
25587        XQPHAT(I)=CPUMIN
25588        XQPLCL(I)=CPUMIN
25589        XQPUCL(I)=CPUMIN
25590        XQPLC2(I)=CPUMIN
25591        XQPUC2(I)=CPUMIN
25592   11 CONTINUE
25593C
25594      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL2')THEN
25595        WRITE(ICOUT,999)
25596  999   FORMAT(1X)
25597        CALL DPWRST('XXX','WRIT')
25598        WRITE(ICOUT,51)
25599   51   FORMAT('**** AT THE BEGINNING OF DPMLL2--')
25600        CALL DPWRST('XXX','WRIT')
25601        WRITE(ICOUT,52)IBUGA3,ISUBRO,ICENTY,N,NUMV,IOUNI2,TEND
25602   52   FORMAT('IBUGA3,ISUBRO,ICENTY,N,NUMV,IOUNI2,TEND = ',
25603     1         3(A4,2X),3I8,G15.7)
25604        CALL DPWRST('XXX','WRIT')
25605        DO56I=1,MIN(N,100)
25606          WRITE(ICOUT,57)I,Y(I),TAG(I)
25607   57     FORMAT('I,Y(I),TAG(I) = ',I8,2G15.7)
25608          CALL DPWRST('XXX','WRIT')
25609   56   CONTINUE
25610      ENDIF
25611C
25612C               ********************************************
25613C               **  STEP 11--                             **
25614C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
25615C               ********************************************
25616C
25617      ISTEPN='11'
25618      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL2')
25619     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
25620C
25621      NMIN=3
25622      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
25623      IF(IERROR.EQ.'YES')GOTO9000
25624C
25625      CALL LGNML2(Y,TAG,N,MAXNXT,
25626     1            ICASE,IDIST,
25627     1            TEMP1,XTEMP,DTEMP,ITEMP,
25628     1            XMEANF,XSDF,XVARF,XMINF,XMAXF,XMEDF,
25629     1            XMEANC,XSDC,XVARC,XMINC,XMAXC,XMEDC,
25630     1            SCALML,UHATML,UHATSE,SHAPML,SHAPSE,COVSE,
25631     1            IR,
25632     1            ISUBRO,IBUGA3,IERROR)
25633      IF(IERROR.EQ.'YES')GOTO9000
25634      SIGMML=SHAPML
25635      SIGMSE=SHAPSE
25636      SCALSE=EXP(UHATML)
25637      AR=REAL(IR)
25638      DR=DBLE(IR)
25639      AN=REAL(N)
25640      DN=DBLE(N)
25641      AM=REAL(IM)
25642      DM=DBLE(IM)
25643      DS=DBLE(SIGMML)
25644      DU=DBLE(UHATML)
25645      DZ=(DLOG(C)-DU)/DS
25646C
25647      ISTEPN='34'
25648      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL2')THEN
25649        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
25650        WRITE(ICOUT,2418)SIGMML,UHATML,SCALML,DR
25651 2418   FORMAT('SIGML,UHATML,SCALML,IR = ',4G15.7)
25652        CALL DPWRST('XXX','WRIT')
25653        WRITE(ICOUT,2419)UHATSE,SIGMSE,COVSE
25654 2419   FORMAT('UHATSE,SIGMSE,COVSE = ',3G15.7)
25655        CALL DPWRST('XXX','WRIT')
25656      ENDIF
25657C
25658C     CONFIDENCE INTERVALS FOR PARAMETERS.  CAN BASE ON EITHER NORMAL
25659C     APPROXIMATION OR ON LIKELIHOOD RATIO APPROXIMATION.
25660C
25661C     NORMAL APPROXIMATION FIRST.
25662C
25663      DO4110I=1,NUMALP
25664        ALP=ALPHA(I)
25665        P=1.0-(ALP/2.0)
25666        CALL NORPPF(P,PPF)
25667CCCCC   ALOWSC(I)=SCALML - PPF*SCALSE
25668CCCCC   AUPPSC(I)=SCALML + PPF*SCALSE
25669        ALOWUH(I)=UHATML - PPF*UHATSE
25670        AUPPUH(I)=UHATML + PPF*UHATSE
25671        ALOWSC(I)=EXP(ALOWUH(I))
25672        AUPPSC(I)=EXP(AUPPUH(I))
25673        ALOWSH(I)=SIGMML - PPF*SIGMSE
25674        AUPPSH(I)=SIGMML + PPF*SIGMSE
25675 4110 CONTINUE
25676C
25677C     NOW DO LIKELIHOOD RATIO APPROXIMATION (SEE COMMENTS IN
25678C     LG2FUN FOR FORMULAS).
25679C
25680C     COMPUTE LL(UHAT,SIGMA) AND SAVE IN COMMOM BLOCK.
25681C
25682      N2=N
25683      IR2=IR
25684      IM2=IM
25685      DSIGMA=DBLE(SIGMML)
25686      DC=C
25687      N3=N
25688      IR3=IR
25689      IM3=IM
25690      DSIGM2=DBLE(SIGMML)
25691      DC2=C
25692      DU2=DBLE(UHATML)
25693C
25694      DX=(DLOG(DC) - DBLE(UHATML))/DSIGMA
25695      CALL NODCDF(DX,DTERM2)
25696      DTERM1=-DR*DLOG(DSIGMA) + DM*DLOG(1.0D0 - DTERM2)
25697      DSUM1=0.0D0
25698      DSUM2=0.0D0
25699      DO4118I=1,IR
25700        DTEMP(I)=DBLE(Y(I))
25701        DX=DLOG(DTEMP(I))
25702        DSUM1=DSUM1 + DX
25703        DSUM2=DSUM2 + ((DX - DBLE(UHATML))/DSIGMA)**2
25704 4118 CONTINUE
25705      DLLUS=DTERM1 - DSUM1 - 0.5D0*DSUM2
25706      DLLUS2=DLLUS
25707C
25708      DN=DBLE(N)
25709      AE=1.D-7
25710      RE=1.D-7
25711      NUTEMP=1
25712C
25713      DO4120I=1,NUMALP
25714        ALP=ALPHA(I)
25715        CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
25716        DK=DBLE(APPF)
25717        DK2=DK
25718C
25719        DXSTRT=DBLE(ALOWSH(I))
25720        DXLOW=DXSTRT/5.0D0
25721        DXUP=DBLE(SIGMML)
25722        CALL DFZER2(LG4FUN,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG,DTEMP)
25723        ALOSH2(I)=REAL(DXLOW)
25724C
25725        DXSTRT=DBLE(AUPPSH(I))
25726        DXUP=DXSTRT*5.0D0
25727        DXLOW=DBLE(SIGMML)
25728        CALL DFZER2(LG4FUN,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG,DTEMP)
25729        AUPSH2(I)=REAL(DXLOW)
25730C
25731        DXSTRT=DBLE(ALOWUH(I))
25732        DXLOW=DXSTRT/2.0D0
25733        DXUP=DBLE(UHATML)
25734        CALL DFZER2(LG2FUN,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG,DTEMP)
25735        ALOWU2(I)=REAL(DXLOW)
25736        ALOWS2(I)=EXP(ALOWU2(I))
25737C
25738        DXSTRT=DBLE(AUPPUH(I))
25739        DXUP=DXSTRT*2.0D0
25740        DXLOW=DBLE(UHATML)
25741        CALL DFZER2(LG2FUN,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG,DTEMP)
25742        AUPPU2(I)=REAL(DXLOW)
25743        AUPPS2(I)=EXP(AUPPU2(I))
25744 4120 CONTINUE
25745C
25746      ISTEPN='35'
25747      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL2')
25748     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
25749C
25750C  CONFIDENCE INTERVALS FOR SELECTED PERCENTILES.
25751C
25752C  BASE ON EITHER THE ASYMPTOTIC NORMAL APPROXIMATION OR THE
25753C  LIKELIHOOD RATIO.
25754C
25755C  NOTE: I HAVEN'T BEEN ABLE TO GET THE LIKELIHOOD RATION METHOD
25756C        TO WORK.  COMMENT OUT FOR NOW.
25757C
25758      IF(NPERC.GE.1)THEN
25759C
25760        ALPHL=ALPHAP/2.0
25761        ALPHU=1.0 - ALPHAP/2.0
25762        CALL NORPPF(ALPHU,Z95)
25763        DU=DBLE(UHATML)
25764        DS=DBLE(SIGMML)
25765C
25766        WRITE(IOUNI1,4191)
25767 4191   FORMAT(15X,'       POINT     ','   STANDARD   ',
25768     1         '     LOWER     ','     UPPER')
25769        WRITE(IOUNI1,4192)
25770 4192   FORMAT('    PERCENTILE ','     ESTIMATE   ','     ERROR     ',
25771     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
25772C
25773        N4=N
25774        IR4=IR
25775        IM4=IM
25776        DSIGMA3=DBLE(SIGMML)
25777        DC3=C
25778        DU3=DBLE(UHATML)
25779        DLLUS3=DLLUS
25780C
25781        NUTEMP=1
25782        CALL CHSPPF(1.0-ALPHAP,NUTEMP,APPF)
25783        DK=DBLE(APPF)
25784        DK3=DK
25785C
25786        DO4190I=1,NPERC
25787          QPTEMP=QP(I)/100.0
25788C
25789          CALL LGNPPF(QPTEMP,SIGMML,ATEMP)
25790          XQPHAT(I)=SCALML*ATEMP
25791C
25792          CALL NORPPF(QPTEMP,X95)
25793          D0=DEXP(DU + DBLE(X95)*DS)
25794          D1=DBLE(X95)*DEXP(DU + DBLE(X95)*DS)
25795          DTERM1=D0*D0*UHATSE**2
25796          DTERM2=D1*D1*SIGMSE**2
25797          DTERM3=D0*D1*COVSE
25798          DTERM4=D1*D0*COVSE
25799          DSUM=DTERM1 + DTERM2 + DTERM3 + DTERM4
25800          SEXQP=0.0
25801          IF(DSUM.GE.0.0D0)SEXQP=DSQRT(DSUM)
25802          XQPSE(I)=REAL(SEXQP)
25803          XQPLCL(I)=XQPHAT(I) - Z95*XQPSE(I)
25804          XQPUCL(I)=XQPHAT(I) + Z95*XQPSE(I)
25805C
25806CCCCC     DX05=DBLE(XQPHAT(I))
25807CCCCC     DZ05=DBLE(X95)
25808CCCCC     DXSTRT=DBLE(XQPLCL(I))
25809CCCCC     DXLOW=DXSTRT/2.0D0
25810CCCCC     DXUP=DBLE(XQPHAT(I))
25811CCCCC     CALL DFZER2(LG6FUN,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG,DTEMP)
25812CCCCC     write(19,*)'i,iflag=',i,iflag
25813CCCCC     XQPLC2(I)=REAL(DXLOW)
25814C
25815CCCCC     DXSTRT=DBLE(XQPUCL(I))
25816CCCCC     DXUP=DXSTRT*5.0D0
25817CCCCC     DXLOW=DBLE(XQPHAT(I))
25818CCCCC     CALL DFZER2(LG6FUN,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG,DTEMP)
25819CCCCC     XQPUC2(I)=REAL(DXLOW)
25820CCCCC     write(19,*)'i,xqphat(i),xqplc2(i)=',i,xqphat(i),xqplc2(i)
25821C
25822          WRITE(IOUNI1,'(4E15.7,2X,E15.7)')
25823     1         QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
25824          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLL2')THEN
25825            WRITE(ICOUT,4193)D0,D1
25826 4193       FORMAT('D0,D1,DSUM = ',3G15.7)
25827            CALL DPWRST('XXX','BUG ')
25828            WRITE(ICOUT,4195)DTERM1,DTERM2,DTERM3,DTERM4
25829 4195       FORMAT('DTERM1,DTERM2,DTERM3,DTERM4 = ',4G15.7)
25830            CALL DPWRST('XXX','BUG ')
25831          ENDIF
25832 4190   CONTINUE
25833C
25834      ENDIF
25835C
25836C               *************************************
25837C               **   STEP 42--                     **
25838C               **   WRITE OUT EVERYTHING          **
25839C               **   FOR LOGNORMAL MLE ESTIMATE    **
25840C               *************************************
25841C
25842      ISTEPN='42'
25843      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL2')
25844     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
25845C
25846C     PRINT SUMMARY STATISTICS TABLE
25847C
25848      IF(IPRINT.EQ.'OFF')GOTO9000
25849C
25850      NUMDIG=7
25851      IF(IFORSW.EQ.'1')NUMDIG=1
25852      IF(IFORSW.EQ.'2')NUMDIG=2
25853      IF(IFORSW.EQ.'3')NUMDIG=3
25854      IF(IFORSW.EQ.'4')NUMDIG=4
25855      IF(IFORSW.EQ.'5')NUMDIG=5
25856      IF(IFORSW.EQ.'6')NUMDIG=6
25857      IF(IFORSW.EQ.'7')NUMDIG=7
25858      IF(IFORSW.EQ.'8')NUMDIG=8
25859      IF(IFORSW.EQ.'9')NUMDIG=9
25860      IF(IFORSW.EQ.'0')NUMDIG=0
25861      IF(IFORSW.EQ.'E')NUMDIG=-2
25862      IF(IFORSW.EQ.'-2')NUMDIG=-2
25863      IF(IFORSW.EQ.'-3')NUMDIG=-3
25864      IF(IFORSW.EQ.'-4')NUMDIG=-4
25865      IF(IFORSW.EQ.'-5')NUMDIG=-5
25866      IF(IFORSW.EQ.'-6')NUMDIG=-6
25867      IF(IFORSW.EQ.'-7')NUMDIG=-7
25868      IF(IFORSW.EQ.'-8')NUMDIG=-8
25869      IF(IFORSW.EQ.'-9')NUMDIG=-9
25870C
25871      ITITLE='Two-Parameter Lognormal Parameter Estimation:'
25872      NCTITL=45
25873      ITITLZ='Time (Singly) Censored Case'
25874      NCTITZ=27
25875      ICNT=1
25876      ITEXT(ICNT)='Summary Statistics:'
25877      NCTEXT(ICNT)=19
25878      AVALUE(ICNT)=0.0
25879      IDIGIT(ICNT)=-1
25880      ICNT=ICNT+1
25881      ITEXT(ICNT)='Total Number of Observations:'
25882      NCTEXT(ICNT)=29
25883      AVALUE(ICNT)=REAL(N)
25884      IDIGIT(ICNT)=0
25885      ICNT=ICNT+1
25886      ITEXT(ICNT)='Number of Uncensored Observations:'
25887      NCTEXT(ICNT)=34
25888      AVALUE(ICNT)=REAL(IR)
25889      IDIGIT(ICNT)=0
25890      ICNT=ICNT+1
25891      ITEXT(ICNT)='Number of Censored Observations:'
25892      NCTEXT(ICNT)=32
25893      AVALUE(ICNT)=REAL(IM)
25894      IDIGIT(ICNT)=0
25895      ICNT=ICNT+1
25896      ITEXT(ICNT)='Sample Mean (All Data):'
25897      NCTEXT(ICNT)=23
25898      AVALUE(ICNT)=XMEANF
25899      IDIGIT(ICNT)=NUMDIG
25900      ICNT=ICNT+1
25901      ITEXT(ICNT)='Sample Median (All Data):'
25902      NCTEXT(ICNT)=25
25903      AVALUE(ICNT)=XMEDF
25904      IDIGIT(ICNT)=NUMDIG
25905      ICNT=ICNT+1
25906      ITEXT(ICNT)='Sample SD (All Data):'
25907      NCTEXT(ICNT)=21
25908      AVALUE(ICNT)=XSDF
25909      IDIGIT(ICNT)=NUMDIG
25910      ICNT=ICNT+1
25911      ITEXT(ICNT)='Sample Minimum (All Data):'
25912      NCTEXT(ICNT)=26
25913      AVALUE(ICNT)=XMINF
25914      IDIGIT(ICNT)=NUMDIG
25915      ICNT=ICNT+1
25916      ITEXT(ICNT)='Sample Maximum (All Data):'
25917      NCTEXT(ICNT)=26
25918      AVALUE(ICNT)=XMAXF
25919      IDIGIT(ICNT)=NUMDIG
25920      ICNT=ICNT+1
25921      ITEXT(ICNT)='Sample Mean (Uncensored Data):'
25922      NCTEXT(ICNT)=30
25923      AVALUE(ICNT)=XMEANC
25924      IDIGIT(ICNT)=NUMDIG
25925      ICNT=ICNT+1
25926      ITEXT(ICNT)='Sample Median (Uncensored Data):'
25927      NCTEXT(ICNT)=32
25928      AVALUE(ICNT)=XMEDC
25929      IDIGIT(ICNT)=NUMDIG
25930      ICNT=ICNT+1
25931      ITEXT(ICNT)='Sample SD (Uncensored Data):'
25932      NCTEXT(ICNT)=26
25933      AVALUE(ICNT)=XSDC
25934      IDIGIT(ICNT)=NUMDIG
25935      ICNT=ICNT+1
25936      ITEXT(ICNT)='Sample Minimum (Uncensored Data):'
25937      NCTEXT(ICNT)=33
25938      AVALUE(ICNT)=XMINC
25939      IDIGIT(ICNT)=NUMDIG
25940      ICNT=ICNT+1
25941      ITEXT(ICNT)='Sample Maximum (Uncensored Data):'
25942      NCTEXT(ICNT)=33
25943      AVALUE(ICNT)=XMAXC
25944      IDIGIT(ICNT)=NUMDIG
25945      ICNT=ICNT+1
25946      ITEXT(ICNT)=' '
25947      NCTEXT(ICNT)=0
25948      AVALUE(ICNT)=0.0
25949      IDIGIT(ICNT)=-1
25950C
25951      ICNT=ICNT+1
25952      ITEXT(ICNT)='Maximum Likelihood:'
25953      NCTEXT(ICNT)=19
25954      AVALUE(ICNT)=0.0
25955      IDIGIT(ICNT)=-1
25956      ICNT=ICNT+1
25957      ITEXT(ICNT)='Estimate of Shape (Sigma):'
25958      NCTEXT(ICNT)=26
25959      AVALUE(ICNT)=SHAPML
25960      IDIGIT(ICNT)=NUMDIG
25961      ICNT=ICNT+1
25962      ITEXT(ICNT)='Standard Error of Shape:'
25963      NCTEXT(ICNT)=24
25964      AVALUE(ICNT)=SHAPSE
25965      IDIGIT(ICNT)=NUMDIG
25966      ICNT=ICNT+1
25967      ITEXT(ICNT)='Estimate of Mu (= LOG(Scale)):'
25968      NCTEXT(ICNT)=30
25969      AVALUE(ICNT)=UHATML
25970      IDIGIT(ICNT)=NUMDIG
25971      ICNT=ICNT+1
25972      ITEXT(ICNT)='Standard Error of Mu:'
25973      NCTEXT(ICNT)=21
25974      AVALUE(ICNT)=UHATSE
25975      IDIGIT(ICNT)=NUMDIG
25976      ICNT=ICNT+1
25977      ITEXT(ICNT)='Shape/Mu Covariance:'
25978      NCTEXT(ICNT)=20
25979      AVALUE(ICNT)=COVSE
25980      IDIGIT(ICNT)=NUMDIG
25981      ICNT=ICNT+1
25982      ITEXT(ICNT)='Estimate of Scale:'
25983      NCTEXT(ICNT)=18
25984      AVALUE(ICNT)=SCALML
25985      IDIGIT(ICNT)=NUMDIG
25986C
25987CCCCC ICNT=ICNT+1
25988CCCCC ITEXT(ICNT)='Log-likelihood:'
25989CCCCC NCTEXT(ICNT)=15
25990CCCCC AVALUE(ICNT)=ALIK
25991CCCCC IDIGIT(ICNT)=-7
25992CCCCC ICNT=ICNT+1
25993CCCCC ITEXT(ICNT)='AIC:'
25994CCCCC NCTEXT(ICNT)=4
25995CCCCC AVALUE(ICNT)=AIC
25996CCCCC IDIGIT(ICNT)=-7
25997CCCCC ICNT=ICNT+1
25998CCCCC ITEXT(ICNT)='AICc:'
25999CCCCC NCTEXT(ICNT)=5
26000CCCCC AVALUE(ICNT)=AICC
26001CCCCC IDIGIT(ICNT)=-7
26002CCCCC ICNT=ICNT+1
26003CCCCC ITEXT(ICNT)='BIC:'
26004CCCCC NCTEXT(ICNT)=4
26005CCCCC AVALUE(ICNT)=BIC
26006CCCCC IDIGIT(ICNT)=-7
26007C
26008      NUMROW=ICNT
26009      DO2310I=1,NUMROW
26010        NTOT(I)=15
26011 2310 CONTINUE
26012C
26013      IFRST=.TRUE.
26014      ILAST=.TRUE.
26015      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
26016     1            AVALUE,IDIGIT,
26017     1            NTOT,NUMROW,
26018     1            ICAPSW,ICAPTY,ILAST,IFRST,
26019     1            ISUBRO,IBUGA3,IERROR)
26020C
26021      ILIKFL='LGNC'
26022      CALL DPDT8D(ALOWSC,AUPPSC,ALOWS2,AUPPS2,
26023     1            ALOWUH,AUPPUH,ALOWU2,AUPPU2,
26024     1            ALOWSH,AUPPSH,ALOSH2,AUPSH2,ALPHA,NUMALP,
26025     1            ICAPSW,ICAPTY,NUMDIG,ILIKFL,
26026     1            ISUBRO,IBUGA3,IERROR)
26027C
26028      IF(NPERC.GT.1)THEN
26029        ILIKFL='OFF'
26030        CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
26031     1              ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
26032     1              ISUBRO,IBUGA3,IERROR)
26033      ENDIF
26034C
26035C               *****************
26036C               **  STEP 90--  **
26037C               **  EXIT       **
26038C               *****************
26039C
26040 9000 CONTINUE
26041      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL2')THEN
26042        WRITE(ICOUT,999)
26043        CALL DPWRST('XXX','WRIT')
26044        WRITE(ICOUT,9011)
26045 9011   FORMAT('***** AT THE END       OF DPMLL2--')
26046        CALL DPWRST('XXX','WRIT')
26047        WRITE(ICOUT,9012)IBUGA3,IERROR
26048 9012   FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
26049        CALL DPWRST('XXX','WRIT')
26050      ENDIF
26051C
26052      RETURN
26053      END
26054      SUBROUTINE DPMLL3(Y,TAG,N,
26055     1                  XTEMP,DTEMP,ITEMP,MAXNXT,
26056     1                  ALOCML,SCALML,SHAPML,UHATML,
26057     1                  ALOCSE,SCALSE,SHAPSE,UHATSE,
26058     1                  ALOCMO,SCALMO,SHAPMO,UHATMO,
26059     1                  ALOCMM,SCALMM,SHAPMM,UHATMM,
26060     1                  ALOCS2,SCALS2,SHAPS2,UHATS2,
26061     1                  AICML,AICCML,BICML,ALIKML,
26062     1                  AICMO,AICCMO,BICMO,ALIKMO,
26063     1                  AICMM,AICCMM,BICMM,ALIKMM,
26064     1                  NUMV,
26065     1                  ICAPSW,ICAPTY,IFORSW,
26066     1                  QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
26067     1                  IOUNI1,IOUNI2,ALPHAP,
26068     1                  ISUBRO,IBUGA3,IERROR)
26069C
26070C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
26071C              FOR THE 3-PARAMETER LOGNORMAL DISTRIBUTION FOR THE FULL
26072C              SAMPLE CASE.
26073C     EXAMPLE--3-PARAMETER LOGNORMAL MAXIMUM LIKELIHOOD Y
26074C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
26075C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
26076C                1999, CHAPTER 13.
26077C              --COHEN AND WHITTEN (1988), "PARAMETER ESTIMATION IN
26078C                RELIABILITY AND LIFE SPAN MODELS", MARCEL DEKKER, INC.,
26079C                CHAPTER 4.
26080C     WRITTEN BY--ALAN HECKERT
26081C                 STATISTICAL ENGINEERING DIVISION
26082C                 INFORMATION TECHNOLOGY LABORATORY
26083C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
26084C                 GAITHERSBURG, MD 20899-8980
26085C                 PHONE--301-975-2899
26086C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
26087C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
26088C     LANGUAGE--ANSI FORTRAN (1977)
26089C     VERSION NUMBER--2014/4
26090C     ORIGINAL VERSION--APRIL     2014.
26091C
26092C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
26093C
26094      CHARACTER*4 ICAPSW
26095      CHARACTER*4 ICAPTY
26096      CHARACTER*4 IFORSW
26097      CHARACTER*4 ISUBRO
26098      CHARACTER*4 IBUGA3
26099      CHARACTER*4 IERROR
26100C
26101      CHARACTER*4 IWRITE
26102      CHARACTER*4 ISUBN1
26103      CHARACTER*4 ISUBN2
26104      CHARACTER*4 ISTEPN
26105      CHARACTER*4 ILIKFL
26106      CHARACTER*4 IOPFLG
26107      CHARACTER*40 IDIST
26108C
26109C---------------------------------------------------------------------
26110C
26111      PARAMETER (NUMALP=8)
26112      DIMENSION ALPHA(NUMALP)
26113      DIMENSION ALOWLO(NUMALP)
26114      DIMENSION AUPPLO(NUMALP)
26115      DIMENSION ALOWSC(NUMALP)
26116      DIMENSION AUPPSC(NUMALP)
26117      DIMENSION ALOWSH(NUMALP)
26118      DIMENSION AUPPSH(NUMALP)
26119      DIMENSION ALOWU(NUMALP)
26120      DIMENSION AUPPU(NUMALP)
26121C
26122      DIMENSION Y(*)
26123      DIMENSION TAG(*)
26124      DIMENSION XTEMP(*)
26125      DIMENSION QP(*)
26126      DIMENSION XQPHAT(*)
26127      DIMENSION XQPSE(*)
26128      DIMENSION XQPLCL(*)
26129      DIMENSION XQPUCL(*)
26130      INTEGER   ITEMP(*)
26131      DOUBLE PRECISION DTEMP(*)
26132C
26133      INCLUDE 'DPCOST.INC'
26134C
26135      DIMENSION COV(3,3)
26136      DIMENSION COVMM(3,3)
26137      DIMENSION COVU(3,3)
26138      DOUBLE PRECISION D(3)
26139C
26140      DOUBLE PRECISION DSIGMA
26141      DOUBLE PRECISION DS
26142      DOUBLE PRECISION DLOC
26143      DOUBLE PRECISION DZQ
26144      DOUBLE PRECISION DTERM1
26145      DOUBLE PRECISION DVAR
26146      DOUBLE PRECISION DPPF
26147C
26148      PARAMETER (MAXROW=100)
26149      CHARACTER*60 ITITLE
26150      CHARACTER*60 ITITLZ
26151      CHARACTER*40 ITEXT(MAXROW)
26152      REAL         AVALUE(MAXROW)
26153      INTEGER      NCTEXT(MAXROW)
26154      INTEGER      IDIGIT(MAXROW)
26155      INTEGER      NTOT(MAXROW)
26156      LOGICAL IFRST
26157      LOGICAL ILAST
26158C
26159C---------------------------------------------------------------------
26160C
26161      INCLUDE 'DPCOP2.INC'
26162C
26163      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
26164C
26165C-----START POINT-----------------------------------------------------
26166C
26167      ISUBN1='DPML'
26168      ISUBN2='L3  '
26169      IDIST='LOGNORMAL'
26170      IERROR='NO'
26171      IFLAG1=0
26172      IFLAG2=0
26173C
26174      ITEMP(1)=0
26175      XTEMP(1)=0.0
26176      TAG(1)=0.0
26177C
26178      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL3')THEN
26179        WRITE(ICOUT,999)
26180  999   FORMAT(1X)
26181        CALL DPWRST('XXX','WRIT')
26182        WRITE(ICOUT,51)
26183   51   FORMAT('**** AT THE BEGINNING OF DPMLL3--')
26184        CALL DPWRST('XXX','WRIT')
26185        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NUMV,NPERC,IOUNI2
26186   52   FORMAT('IBUGA3,ISUBRO,N,NUMV,NPERC,IOUNI2 = ',2(A4,2X),4I8)
26187        CALL DPWRST('XXX','WRIT')
26188        DO56I=1,MIN(N,100)
26189          WRITE(ICOUT,57)I,Y(I)
26190   57     FORMAT('I,Y(I) = ',I8,G15.7)
26191          CALL DPWRST('XXX','WRIT')
26192   56   CONTINUE
26193      ENDIF
26194C
26195C               ********************************************
26196C               **  STEP 11--                             **
26197C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
26198C               ********************************************
26199C
26200      ISTEPN='11'
26201      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL3')
26202     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
26203C
26204C     STEP 1: OBTAIN POINT ESTIMATES AND STANDARD ERRORS
26205C
26206      IF(I3LNME.EQ.'PROF')THEN
26207        IOPFLG='ON'
26208        CALL LGNML8(Y,N,MAXNXT,P3LNMI,IOPFLG,
26209     1              XTEMP,QP,
26210     1              ALOCML,SCALML,SHAPML,
26211     1              ISUBRO,IBUGA3,IERROR)
26212         UHATML=LOG(SCALML)
26213         IWRITE='OFF'
26214         CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
26215         CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
26216         CALL STMOM3(Y,N,IWRITE,XSKEW,IBUGA3,IERROR)
26217         CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
26218         CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
26219         XVAR=XSD**2
26220C
26221      ELSE
26222        CALL LGNML3(Y,N,DTEMP,
26223     1              XMEAN,XSD,XVAR,XMIN,XMAX,XSKEW,
26224     1              ALOCML,SCALML,SHAPML,UHATML,
26225     1              ISUBRO,IBUGA3,IERROR)
26226      ENDIF
26227C
26228      CALL LGNMO1(XMEAN,XSD,XMIN,XSKEW,N,PSTAMV,
26229     1            ALOCMO,SCALMO,SHAPMO,UHATMO,
26230     1            ALOCMM,SCALMM,SHAPMM,UHATMM,
26231     1            ISUBRO,IBUGA3,IERROR)
26232C
26233      IF(SHAPMO.GT.0.0)THEN
26234        CALL LGNLI1(Y,N,ALOCMO,SCALMO,SHAPMO,
26235     1              ALIKMO,AICMO,AICCMO,BICMO,
26236     1              ISUBRO,IBUGA3,IERROR)
26237      ENDIF
26238C
26239      IF(SHAPMM.GT.0.0)THEN
26240        CALL LGNLI1(Y,N,ALOCMM,SCALMM,SHAPMM,
26241     1              ALIKMM,AICMM,AICCMM,BICMM,
26242     1              ISUBRO,IBUGA3,IERROR)
26243        CALL LGNML5(ALOCMM,SCALMM,SHAPMM,N,COVMM,UHATS2,
26244     1              ISUBRO,IBUGA3,IERROR)
26245         IF(COVMM(1,1).GE.0.0 .AND. COVMM(2,2).GE.0.0 .AND.
26246     1      COVMM(3,3).GE.0.0)THEN
26247         IFLAG2=1
26248         ALOCS2=SQRT(COVMM(1,1))
26249         SCALS2=SQRT(COVMM(2,2))
26250         SHAPS2=SQRT(COVMM(3,3))
26251        ENDIF
26252      ENDIF
26253C
26254      IF(SHAPML.GT.0.0)THEN
26255        CALL LGNLI1(Y,N,ALOCML,SCALML,SHAPML,
26256     1              ALIKML,AICML,AICCML,BICML,
26257     1              ISUBRO,IBUGA3,IERROR)
26258        CALL LGNML5(ALOCML,SCALML,SHAPML,N,COV,UHATSE,
26259     1              ISUBRO,IBUGA3,IERROR)
26260        IF(COV(1,1).GE.0.0 .AND. COV(2,2).GE.0.0 .AND.
26261     1     COV(3,3).GE.0.0)THEN
26262          IFLAG1=1
26263          ALOCSE=SQRT(COV(1,1))
26264          SCALSE=SQRT(COV(2,2))
26265          SHAPSE=SQRT(COV(3,3))
26266        ENDIF
26267      ENDIF
26268C
26269      IFLAG3=0
26270      IF(IFLAG1.EQ.1)THEN
26271        IFLAG3=1
26272      ELSEIF(IFLAG2.EQ.1)THEN
26273        IFLAG3=2
26274      ENDIF
26275C
26276C     STEP 2: CONFIDENCE INTERVALS FOR PARAMETERS BASED ON
26277C             NORMAL APPROXIMATION.
26278C
26279C             USE ML STANDARD ERRORS IF THEY EXIST.  OTHERWISE,
26280C             USE MODIFIED MOMENT STANDARD ERRORS.
26281C
26282      DO2210I=1,NUMALP
26283        ALP=ALPHA(I)
26284        P=1.0-(ALP/2.0)
26285        CALL NORPPF(P,PPF)
26286        IF(IFLAG3.EQ.1)THEN
26287          ALOWLO(I)=ALOCML - PPF*ALOCSE
26288          AUPPLO(I)=ALOCML + PPF*ALOCSE
26289          ALOWSC(I)=SCALML - PPF*SCALSE
26290          IF(ALOWSC(I).LE.0.0)ALOWSC(I)=0.0
26291          AUPPSC(I)=SCALML + PPF*SCALSE
26292          ALOWSH(I)=SHAPML - PPF*SHAPSE
26293          IF(ALOWSH(I).LE.0.0)ALOWSH(I)=0.0
26294          AUPPSH(I)=SHAPML + PPF*SHAPSE
26295          ALOWU(I)=UHATML - PPF*UHATSE
26296          AUPPU(I)=UHATML + PPF*UHATSE
26297        ELSEIF(IFLAG3.EQ.2)THEN
26298          ALOWLO(I)=ALOCMM - PPF*ALOCS2
26299          AUPPLO(I)=ALOCMM + PPF*ALOCS2
26300          ALOWSC(I)=SCALMM - PPF*SCALS2
26301          IF(ALOWSC(I).LE.0.0)ALOWSC(I)=0.0
26302          AUPPSC(I)=SCALMM + PPF*SCALS2
26303          ALOWSH(I)=SHAPML - PPF*SHAPS2
26304          IF(ALOWSH(I).LE.0.0)ALOWSH(I)=0.0
26305          AUPPSH(I)=SHAPML + PPF*SHAPS2
26306          ALOWU(I)=UHATMM - PPF*UHATS2
26307          AUPPU(I)=UHATMM + PPF*UHATS2
26308        ELSE
26309          ALOWLO(I)=CPUMIN
26310          AUPPLO(I)=CPUMIN
26311          ALOWSC(I)=CPUMIN
26312          AUPPSC(I)=CPUMIN
26313          ALOWSH(I)=CPUMIN
26314          AUPPSH(I)=CPUMIN
26315          ALOWU(I)=CPUMIN
26316          AUPPU(I)=CPUMIN
26317        ENDIF
26318 2210 CONTINUE
26319C
26320C     APPROXIMATE CONFIDENCE INTERVALS FOR SELECTED PERCENTILES BASED
26321C     ON MAXIMUM LIKELIHOOD ESTIMATES.  FOLLOWS EXAMPLE 6 ON PP. 175-177
26322C     OF BURY.
26323C
26324C     Xp(Lower) = XpHat - NORPPF(1 - ALPHA/2)*Xp(SE)
26325C     Xp(Upper) = XpHat + NORPPF(1 - ALPHA/2)*Xp(SE)
26326C
26327C     WHERE
26328C
26329C     Xp(SE) IS THE PERCENTILE STANDARD ERROR.  THIS IS COMPUTED AS:
26330C
26331C     Xp(SE) = SQRT{SUM[j=1 to 3][SUM[k=1 to 3][d(j)*d(k)*COV(j,k)]]}
26332C
26333C     WHERE
26334C
26335C     COV  = PARAMETER VARIANCE-COVARIANCE MATRIX
26336C     D1   = PARTIAL DERIVATIVE OF THE PERCENT POINT FUNCTION WITH
26337C            RESPECT TO THE LOCATION PARAMETER
26338C          = 1
26339C     D2   = PARTIAL DERIVATIVE OF THE PERCENT POINT FUNCTION WITH
26340C            RESPECT TO THE SCALE PARAMETER
26341C          = EXP(Zp*SIGMA)
26342C     D3   = PARTIAL DERIVATIVE OF THE PERCENT POINT FUNCTION WITH
26343C            RESPECT TO THE SHAPE PARAMETER
26344C          = SCALE*Zp*EXP(SIGMA*Zp)
26345C     P    = THE DESIRED PERCENTILE
26346C     Zp   = NORPPF(p)
26347C
26348C     NOTE THAT ONE-SIDED PERCENTILE INTERVALS ARE EQUIVALENT TO
26349C     ONE-SIDED TOLERANCE INTERVALS.
26350C
26351      IF(NPERC.GE.1)THEN
26352C
26353        IF(IDTYPR.EQ.'LOWE')THEN
26354          ALPHL=ALPHAP
26355          ALPHU=1.0 - ALPHAP
26356        ELSEIF(IDTYPR.EQ.'UPPE')THEN
26357          ALPHL=ALPHAP
26358          ALPHU=1.0 - ALPHAP
26359        ELSE
26360          ALPHL=ALPHAP/2.0
26361          ALPHU=1.0 - ALPHAP/2.0
26362        ENDIF
26363        CALL NORPPF(ALPHU,Z95)
26364        MINMAX=1
26365C
26366C       BASE COVARIANCE MATRIX ON "U" PARAMEZTERIZATION
26367C       AS DONE IN BURY EXAMPLE.
26368C
26369        IF(IFLAG3.EQ.1)THEN
26370          SIGMA=SHAPML
26371          U=UHATML
26372          COVU(2,2)=UHATSE**2
26373        ELSEIF(IFLAG3.EQ.2)THEN
26374          SIGMA=SHAPMM
26375          U=UHATMM
26376          COVU(2,2)=UHATS2**2
26377        ELSE
26378          GOTO2499
26379        ENDIF
26380        AN=REAL(N)
26381        W=EXP(-2.0*U + SIGMA**2)*(EXP(SIGMA**2)*(SIGMA**2+1.0) -
26382     1    2.0*SIGMA**2 - 1.0)
26383        AFACT=SIGMA**2/(AN*W)
26384        COVU(1,1)=COV(1,1)
26385        COVU(3,3)=COV(3,3)
26386        TERM1=-EXP(-U + SIGMA**2/2.0)
26387        COVU(1,2)=AFACT*TERM1
26388        COVU(2,1)=COVU(1,2)
26389        TERM1=SIGMA*EXP(-U + SIGMA**2/2.0)
26390        COVU(1,3)=AFACT*TERM1
26391        COVU(3,1)=COVU(1,3)
26392        TERM1=-SIGMA*EXP(-2.0*U + SIGMA**2)
26393        COVU(2,3)=AFACT*TERM1
26394        COVU(3,2)=COVU(2,3)
26395C
26396        WRITE(IOUNI1,2431)
26397        WRITE(IOUNI1,2432)
26398C
26399        IF(IFLAG3.EQ.1)THEN
26400          DSIGMA=DBLE(SHAPML)
26401          DS=DBLE(SCALML)
26402          DLOC=DBLE(ALOCML)
26403          DU=DBLE(UHATML)
26404        ELSEIF(IFLAG3.EQ.2)THEN
26405          DSIGMA=DBLE(SHAPMM)
26406          DS=DBLE(SCALMM)
26407          DLOC=DBLE(ALOCMM)
26408          DU=DBLE(UHATMM)
26409        ELSE
26410          GOTO2499
26411        ENDIF
26412C
26413        DO2429I=1,NPERC
26414          QPTEMP=QP(I)/100.0
26415          CALL LGDPPF(DBLE(QPTEMP),DSIGMA,DPPF)
26416          XQPHAT(I)=REAL(DLOC + DS*DPPF)
26417C
26418          CALL NODPPF(DBLE(QPTEMP),DZQ)
26419C
26420          D(1)=1.0D0
26421CCCCC     D(2)=DEXP(DZQ*DSIGMA)
26422CCCCC     D(3)=DS*DZQ*DEXP(DSIGMA*DZQ)
26423          D(2)=DEXP(DU + DSIGMA*DZQ)
26424          D(3)=DZQ*DEXP(DU + DSIGMA*DZQ)
26425          DVAR=0.0D0
26426          DO2460J=1,3
26427            DO2470K=1,3
26428              DTERM1=D(J)*D(K)*DBLE(COVU(J,K))
26429              DVAR=DVAR + DTERM1
26430 2470       CONTINUE
26431 2460     CONTINUE
26432          SEXQP=REAL(DSQRT(DVAR))
26433C
26434          XQPSE(I)=SEXQP
26435          IF(IDTYPR.EQ.'LOWE')THEN
26436            XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
26437            XQPUCL(I)=CPUMIN
26438          ELSEIF(IDTYPR.EQ.'UPPE')THEN
26439            XQPLCL(I)=CPUMIN
26440            XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
26441          ELSE
26442            XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
26443            XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
26444          ENDIF
26445          WRITE(IOUNI1,'(5E15.7)')
26446     1         QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
26447 2429   CONTINUE
26448 2431   FORMAT(15X,'       POINT     ','     LOWER     ',
26449     1         '     UPPER')
26450 2432   FORMAT('    PERCENTILE ','     ESTIMATE   ',
26451     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
26452      ENDIF
26453C
26454 2499 CONTINUE
26455C
26456C               *************************************
26457C               **   STEP 42--                     **
26458C               **   WRITE OUT EVERYTHING          **
26459C               **   FOR WEIBULL MLE ESTIMATE      **
26460C               *************************************
26461C
26462      ISTEPN='42'
26463      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL3')
26464     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
26465C
26466C     PRINT SUMMARY STATISTICS TABLE
26467C
26468      IF(IPRINT.EQ.'OFF')GOTO9000
26469C
26470      NUMDIG=7
26471      IF(IFORSW.EQ.'1')NUMDIG=1
26472      IF(IFORSW.EQ.'2')NUMDIG=2
26473      IF(IFORSW.EQ.'3')NUMDIG=3
26474      IF(IFORSW.EQ.'4')NUMDIG=4
26475      IF(IFORSW.EQ.'5')NUMDIG=5
26476      IF(IFORSW.EQ.'6')NUMDIG=6
26477      IF(IFORSW.EQ.'7')NUMDIG=7
26478      IF(IFORSW.EQ.'8')NUMDIG=8
26479      IF(IFORSW.EQ.'9')NUMDIG=9
26480      IF(IFORSW.EQ.'0')NUMDIG=0
26481      IF(IFORSW.EQ.'E')NUMDIG=-2
26482      IF(IFORSW.EQ.'-2')NUMDIG=-2
26483      IF(IFORSW.EQ.'-3')NUMDIG=-3
26484      IF(IFORSW.EQ.'-4')NUMDIG=-4
26485      IF(IFORSW.EQ.'-5')NUMDIG=-5
26486      IF(IFORSW.EQ.'-6')NUMDIG=-6
26487      IF(IFORSW.EQ.'-7')NUMDIG=-7
26488      IF(IFORSW.EQ.'-8')NUMDIG=-8
26489      IF(IFORSW.EQ.'-9')NUMDIG=-9
26490C
26491      ITITLE='Three-Parameter Lognormal Parameter Estimation:'
26492      NCTITL=47
26493      IF(I3LNME.EQ.'PROF')THEN
26494        ITITLZ='Full Sample Case (Profile Likelihood)'
26495        NCTITZ=37
26496      ELSE
26497        ITITLZ='Full Sample Case (Cohen Maximim Likelihood)'
26498        NCTITZ=43
26499      ENDIF
26500C
26501      ITEXT(1)='Summary Statistics:'
26502      NCTEXT(1)=19
26503      AVALUE(1)=0.0
26504      IDIGIT(1)=-1
26505      ITEXT(2)='Number of Observations:'
26506      NCTEXT(2)=23
26507      AVALUE(2)=REAL(N)
26508      IDIGIT(2)=0
26509      ITEXT(3)='Sample Mean:'
26510      NCTEXT(3)=12
26511      AVALUE(3)=XMEAN
26512      IDIGIT(3)=NUMDIG
26513      ITEXT(4)='Sample Standard Deviation:'
26514      NCTEXT(4)=26
26515      AVALUE(4)=XSD
26516      IDIGIT(4)=NUMDIG
26517      ITEXT(5)='Sample Skewness:'
26518      NCTEXT(5)=16
26519      AVALUE(5)=XSKEW
26520      IDIGIT(5)=NUMDIG
26521      ITEXT(6)='Sample Minimum:'
26522      NCTEXT(6)=15
26523      AVALUE(6)=XMIN
26524      IDIGIT(6)=NUMDIG
26525      ITEXT(7)='Sample Maximum:'
26526      NCTEXT(7)=15
26527      AVALUE(7)=XMAX
26528      IDIGIT(7)=NUMDIG
26529      NUMROW=7
26530C
26531      DO2310I=1,NUMROW
26532        NTOT(I)=15
26533 2310 CONTINUE
26534C
26535      IFRST=.TRUE.
26536      ILAST=.FALSE.
26537      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
26538     1            NCTEXT,AVALUE,IDIGIT,
26539     1            NTOT,NUMROW,
26540     1            ICAPSW,ICAPTY,ILAST,IFRST,
26541     1            ISUBRO,IBUGA3,IERROR)
26542      IFRST=.FALSE.
26543      ITITLE=' '
26544      NCTITL=0
26545      ICNT=0
26546C
26547      IF(SHAPMO.GT.0.0)THEN
26548        ICNT=ICNT+1
26549        ITEXT(ICNT)='Moment Estimates:'
26550        NCTEXT(ICNT)=18
26551        AVALUE(ICNT)=0.0
26552        IDIGIT(ICNT)=-1
26553        ICNT=ICNT+1
26554        ITEXT(ICNT)='Estimate of Location:'
26555        NCTEXT(ICNT)=21
26556        AVALUE(ICNT)=ALOCMO
26557        IDIGIT(ICNT)=NUMDIG
26558        ICNT=ICNT+1
26559        ITEXT(ICNT)='Estimate of Scale:'
26560        NCTEXT(ICNT)=18
26561        AVALUE(ICNT)=SCALMO
26562        IDIGIT(ICNT)=NUMDIG
26563        ICNT=ICNT+1
26564        ITEXT(ICNT)='Estimate of U (= LOG(Scale):'
26565        NCTEXT(ICNT)=29
26566        AVALUE(ICNT)=UHATMO
26567        IDIGIT(ICNT)=NUMDIG
26568        ICNT=ICNT+1
26569        ITEXT(ICNT)='Estimate of Shape (Sigma):'
26570        NCTEXT(ICNT)=27
26571        AVALUE(ICNT)=SHAPMO
26572        IDIGIT(ICNT)=NUMDIG
26573        IF(ALIKMO.NE.CPUMIN)THEN
26574          ICNT=ICNT+1
26575          ITEXT(ICNT)='Value of Log-Likelihood Function:'
26576          NCTEXT(ICNT)=33
26577          AVALUE(ICNT)=ALIKMO
26578          IDIGIT(ICNT)=NUMDIG
26579          ICNT=ICNT+1
26580          ITEXT(ICNT)='AIC:'
26581          NCTEXT(ICNT)=4
26582          AVALUE(ICNT)=AICMO
26583          IDIGIT(ICNT)=NUMDIG
26584          ICNT=ICNT+1
26585          ITEXT(ICNT)='AICC:'
26586          NCTEXT(ICNT)=5
26587          AVALUE(ICNT)=AICCMO
26588          IDIGIT(ICNT)=NUMDIG
26589          ICNT=ICNT+1
26590          ITEXT(ICNT)='BIC:'
26591          NCTEXT(ICNT)=4
26592          AVALUE(ICNT)=BICMO
26593          IDIGIT(ICNT)=NUMDIG
26594        ENDIF
26595        ICNT=ICNT+1
26596        ITEXT(ICNT)=' '
26597        NCTEXT(ICNT)=0
26598        AVALUE(ICNT)=0.0
26599        IDIGIT(ICNT)=-1
26600      ENDIF
26601C
26602      IF(SHAPMM.GT.0.0)THEN
26603        ICNT=ICNT+1
26604        ITEXT(ICNT)='Modified Moment Estimates:'
26605        NCTEXT(ICNT)=26
26606        AVALUE(ICNT)=0.0
26607        IDIGIT(ICNT)=-1
26608        ICNT=ICNT+1
26609        ITEXT(ICNT)='Estimate of Location:'
26610        NCTEXT(ICNT)=21
26611        AVALUE(ICNT)=ALOCMM
26612        IDIGIT(ICNT)=NUMDIG
26613        ICNT=ICNT+1
26614        ITEXT(ICNT)='Estimate of Scale:'
26615        NCTEXT(ICNT)=18
26616        AVALUE(ICNT)=SCALMM
26617        IDIGIT(ICNT)=NUMDIG
26618        ICNT=ICNT+1
26619        ITEXT(ICNT)='Estimate of U (= LOG(Scale):'
26620        NCTEXT(ICNT)=29
26621        AVALUE(ICNT)=UHATMM
26622        IDIGIT(ICNT)=NUMDIG
26623        ICNT=ICNT+1
26624        ITEXT(ICNT)='Estimate of Shape (Sigma):'
26625        NCTEXT(ICNT)=26
26626        AVALUE(ICNT)=SHAPMM
26627        IDIGIT(ICNT)=NUMDIG
26628        IF(SHAPS2.GT.0.0)THEN
26629          ICNT=ICNT+1
26630          ITEXT(ICNT)='Standard Error of Location:'
26631          NCTEXT(ICNT)=27
26632          AVALUE(ICNT)=ALOCS2
26633          IDIGIT(ICNT)=NUMDIG
26634          ICNT=ICNT+1
26635          ITEXT(ICNT)='Standard Error of Scale:'
26636          NCTEXT(ICNT)=24
26637          AVALUE(ICNT)=SCALS2
26638          IDIGIT(ICNT)=NUMDIG
26639          ICNT=ICNT+1
26640          ITEXT(ICNT)='Standard Error of Shape:'
26641          NCTEXT(ICNT)=24
26642          AVALUE(ICNT)=SHAPS2
26643          IDIGIT(ICNT)=NUMDIG
26644          ICNT=ICNT+1
26645          ITEXT(ICNT)='Standard Error of U:'
26646          NCTEXT(ICNT)=20
26647          AVALUE(ICNT)=UHATS2
26648          IDIGIT(ICNT)=NUMDIG
26649        ENDIF
26650        IF(ALIKMM.NE.CPUMIN)THEN
26651          ICNT=ICNT+1
26652          ITEXT(ICNT)='Value of Log-Likelihood Function:'
26653          NCTEXT(ICNT)=33
26654          AVALUE(ICNT)=ALIKMM
26655          IDIGIT(ICNT)=NUMDIG
26656          ICNT=ICNT+1
26657          ITEXT(ICNT)='AIC:'
26658          NCTEXT(ICNT)=4
26659          AVALUE(ICNT)=AICMM
26660          IDIGIT(ICNT)=NUMDIG
26661          ICNT=ICNT+1
26662          ITEXT(ICNT)='AICC:'
26663          NCTEXT(ICNT)=5
26664          AVALUE(ICNT)=AICCMM
26665          IDIGIT(ICNT)=NUMDIG
26666          ICNT=ICNT+1
26667          ITEXT(ICNT)='BIC:'
26668          NCTEXT(ICNT)=4
26669          AVALUE(ICNT)=BICMM
26670          IDIGIT(ICNT)=NUMDIG
26671        ENDIF
26672        ICNT=ICNT+1
26673        ITEXT(ICNT)=' '
26674        NCTEXT(ICNT)=0
26675        AVALUE(ICNT)=0.0
26676        IDIGIT(ICNT)=-1
26677      ENDIF
26678C
26679      IF(SHAPML.GT.0.0)THEN
26680        ICNT=ICNT+1
26681        ITEXT(ICNT)='Maximum Likelihood Estimates:'
26682        NCTEXT(ICNT)=29
26683        AVALUE(ICNT)=0.0
26684        IDIGIT(ICNT)=-1
26685        ICNT=ICNT+1
26686        ITEXT(ICNT)='Estimate of Location:'
26687        NCTEXT(ICNT)=21
26688        AVALUE(ICNT)=ALOCML
26689        IDIGIT(ICNT)=NUMDIG
26690        ICNT=ICNT+1
26691        ITEXT(ICNT)='Estimate of Scale:'
26692        NCTEXT(ICNT)=18
26693        AVALUE(ICNT)=SCALML
26694        IDIGIT(ICNT)=NUMDIG
26695        ICNT=ICNT+1
26696        ITEXT(ICNT)='Estimate of U (= LOG(Scale):'
26697        NCTEXT(ICNT)=29
26698        AVALUE(ICNT)=UHATML
26699        IDIGIT(ICNT)=NUMDIG
26700        ICNT=ICNT+1
26701        ITEXT(ICNT)='Estimate of Shape (Sigma):'
26702        NCTEXT(ICNT)=26
26703        AVALUE(ICNT)=SHAPML
26704        IDIGIT(ICNT)=NUMDIG
26705        IF(IFLAG1.EQ.1)THEN
26706          ICNT=ICNT+1
26707          ITEXT(ICNT)='Standard Error of Location:'
26708          NCTEXT(ICNT)=27
26709          AVALUE(ICNT)=ALOCSE
26710          IDIGIT(ICNT)=NUMDIG
26711          ICNT=ICNT+1
26712          ITEXT(ICNT)='Standard Error of Scale:'
26713          NCTEXT(ICNT)=24
26714          AVALUE(ICNT)=SCALSE
26715          IDIGIT(ICNT)=NUMDIG
26716          ICNT=ICNT+1
26717          ITEXT(ICNT)='Standard Error of Shape:'
26718          NCTEXT(ICNT)=24
26719          AVALUE(ICNT)=SHAPSE
26720          IDIGIT(ICNT)=NUMDIG
26721          ICNT=ICNT+1
26722          ITEXT(ICNT)='Standard Error of U:'
26723          NCTEXT(ICNT)=20
26724          AVALUE(ICNT)=UHATSE
26725          IDIGIT(ICNT)=NUMDIG
26726        ENDIF
26727        IF(ALIKML.NE.CPUMIN)THEN
26728          ICNT=ICNT+1
26729          ITEXT(ICNT)='Value of Log-Likelihood Function:'
26730          NCTEXT(ICNT)=33
26731          AVALUE(ICNT)=ALIKML
26732          IDIGIT(ICNT)=NUMDIG
26733          ICNT=ICNT+1
26734          ITEXT(ICNT)='AIC:'
26735          NCTEXT(ICNT)=4
26736          AVALUE(ICNT)=AICML
26737          IDIGIT(ICNT)=NUMDIG
26738          ICNT=ICNT+1
26739          ITEXT(ICNT)='AICC:'
26740          NCTEXT(ICNT)=5
26741          AVALUE(ICNT)=AICCML
26742          IDIGIT(ICNT)=NUMDIG
26743          ICNT=ICNT+1
26744          ITEXT(ICNT)='BIC:'
26745          NCTEXT(ICNT)=4
26746          AVALUE(ICNT)=BICML
26747          IDIGIT(ICNT)=NUMDIG
26748        ENDIF
26749        ICNT=ICNT+1
26750        ITEXT(ICNT)=' '
26751        NCTEXT(ICNT)=0
26752        AVALUE(ICNT)=0.0
26753        IDIGIT(ICNT)=-1
26754      ENDIF
26755C
26756      NUMROW=ICNT
26757      DO2320I=1,NUMROW
26758        NTOT(I)=15
26759 2320 CONTINUE
26760C
26761      IFRST=.FALSE.
26762      ILAST=.FALSE.
26763      ITITLZ=' '
26764      NCTITZ=0
26765      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
26766     1            AVALUE,IDIGIT,
26767     1            NTOT,NUMROW,
26768     1            ICAPSW,ICAPTY,ILAST,IFRST,
26769     1            ISUBRO,IBUGA3,IERROR)
26770C
26771      ILIKFL='OFF'
26772      IF(IFLAG3.EQ.1)THEN
26773        CALL DPDTA6(COV,ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALOWSH,AUPPSH,
26774     1              ALPHA,NUMALP,
26775     1              ICAPSW,ICAPTY,NUMDIG,
26776     1              ISUBRO,IBUGA3,IERROR)
26777      ELSEIF(IFLAG3.EQ.2)THEN
26778        CALL DPDTA6(COVMM,ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALOWSH,AUPPSH,
26779     1              ALPHA,NUMALP,
26780     1              ICAPSW,ICAPTY,NUMDIG,
26781     1              ISUBRO,IBUGA3,IERROR)
26782      ENDIF
26783C
26784      IF(NPERC.GT.1)THEN
26785        ILIKFL='OFF'
26786        CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
26787     1              ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
26788     1              ISUBRO,IBUGA3,IERROR)
26789      ENDIF
26790C
26791C               *****************
26792C               **  STEP 90--  **
26793C               **  EXIT       **
26794C               *****************
26795C
26796 9000 CONTINUE
26797C
26798      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL3')THEN
26799        WRITE(ICOUT,999)
26800        CALL DPWRST('XXX','WRIT')
26801        WRITE(ICOUT,9011)
26802 9011   FORMAT('***** AT THE END       OF DPMLL3--')
26803        CALL DPWRST('XXX','WRIT')
26804        WRITE(ICOUT,9012)N,IBUGA3,IERROR
26805 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
26806        CALL DPWRST('XXX','WRIT')
26807        WRITE(ICOUT,9015)N
26808 9015   FORMAT('N = ',I8)
26809        CALL DPWRST('XXX','WRIT')
26810      ENDIF
26811C
26812      RETURN
26813      END
26814      SUBROUTINE DPMLLK(Y,X,N,NVAR,
26815     1                  TEMP1,TEMP2,TEMP3,DTEMP1,
26816     1                  AMOM,BETAMO,BMOM,
26817     1                  AFR,BETAFR,BFR,
26818     1                  AML,BETAML,BML,
26819     1                  ICAPSW,ICAPTY,IFORSW,MAXNXT,
26820     1                  ISUBRO,IBUGA3,IERROR)
26821C
26822C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
26823C              ESTIMATES FOR THE LAGRANGE KATZ DISTRIBUTION.
26824C
26825C              THE MOMENT ESTIMATES ARE:
26826C
26827C                 BETAHAT = 2 - 0.5*(A +/- SQRT(A*(A-4))
26828C
26829C                 AHAT = 0.5*XBAR**(3/2)*(1/SQRT(S2))*
26830C                        (SQRT(A) +/- SQRT(A-4))
26831C
26832C                 BHAT = -1 + 0.5*(SQRT(A) +/- SQRT(A-4)*
26833C                         (SQRT(A) - SQRT(XBAR/S2))
26834C
26835C              WHERE
26836C
26837C                 A = (3*S2**2 - S3*XBAR)**2/(XBAR - S2**3)
26838C
26839C              NOTE THAT THE MOMENT ESTIMATORS ONLY EXIST IF A >= 4
26840C
26841C              THE MOMENTS AND ZERO FREQUENCY ESTIMATE OF BETA
26842C              IS THE SOLUTION OF THE EQUATION
26843C
26844C                 (1-BETA)*(LOG(1-BETA))**2 -
26845C                 (BETA**2*S/XBAR**3)*[LOG(F0)]**2 = 0
26846C
26847C              THE ESTIMATES OF A AND B ARE THEN
26848C
26849C                 AHAT = SQRT(XBAR**3*(1 - BETAHAT)/S2)
26850C                 BHAT = 1 - BETAHAT - (AHAT/XBAR)
26851C
26852C              THE MAXIMUM LIKELIHOOD ESTIMATES OF B AND BETA
26853C              ARE THE SOLUTIONS TO THE EQUATIONS:
26854C
26855C                 N*XBAR*LOG(1-BETA)/BETA -
26856C                 SUM[X=2 to k][SUM[i=1 to x-1]
26857C                 [X*N(x)/(XBAR*(1-B-BETA) + B*X + BETA*I)]] = 0
26858C
26859C                 -N*XBAR*(1-BETA)*LOG(1-BETA)/BETA + N*XBAR/BETA +
26860C                 SUM[X=2 to k][SUM[i=1 to x-1]
26861C                 [I*N(x)/(XBAR*(1-b-BETA) + B*X + BETA*I)]] = 0
26862C
26863C
26864C              THE ESTIMATE OF A IS THEN
26865C
26866C                 AHAT = XBAR*(1 - B - BETA)
26867C
26868C              THERE ARE TWO CASES:
26869C
26870C              1) ONE VARIABLE CASE: Y IS RAW DATA
26871C              2) TWO VARIABLE CASE: Y IS FREQUENCY, X IS CLASS
26872C                 MID-POINT.
26873C
26874C     EXAMPLE--LAGRANGE KATZ MAXIMUM LIKELIHOOD Y
26875C            --LAGRANGE KATZ MAXIMUM LIKELIHOOD Y X
26876C     REFERENCES--CONSUL AND FAMOYE (2006), "LAGRANGIAN PROBABILITY
26877C                 DISTRIBUTIONS", BIRKHAUSER, CHAPTER 10.
26878C     WRITTEN BY--ALAN HECKERT
26879C                 STATISTICAL ENGINEERING DIVISION
26880C                 INFORMATION TECHNOLOGY LABORATORY
26881C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
26882C                 GAITHERSBUG, MD 20899-8980
26883C                 PHONE--301-975-2899
26884C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
26885C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
26886C     LANGUAGE--ANSI FORTRAN (1977)
26887C     VERSION NUMBER--2006/8
26888C     ORIGINAL VERSION--AUGUST    2006.
26889C
26890C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-----------------
26891C
26892      CHARACTER*4 ICAPSW
26893      CHARACTER*4 ICAPTY
26894      CHARACTER*4 IFORSW
26895      CHARACTER*4 ISUBRO
26896      CHARACTER*4 IBUGA3
26897      CHARACTER*4 IERROR
26898C
26899      CHARACTER*4 IWRITE
26900      CHARACTER*4 ISUBN1
26901      CHARACTER*4 ISUBN2
26902      CHARACTER*4 ISTEPN
26903      CHARACTER*4 IRELAT
26904      CHARACTER*4 IRHSTG
26905C
26906C-------------------------------------------------------------------
26907C
26908      DIMENSION Y(*)
26909      DIMENSION X(*)
26910      DIMENSION TEMP1(*)
26911      DIMENSION TEMP2(*)
26912      DIMENSION TEMP3(*)
26913      DOUBLE PRECISION DTEMP1(*)
26914C
26915      DOUBLE PRECISION TOL
26916CCCCC DOUBLE PRECISION XPAR(3)
26917CCCCC DOUBLE PRECISION FVEC(2)
26918C
26919      DOUBLE PRECISION AE
26920      DOUBLE PRECISION RE
26921      DOUBLE PRECISION XLOW
26922      DOUBLE PRECISION XUP
26923      DOUBLE PRECISION XMID
26924      DOUBLE PRECISION DSUM
26925      DOUBLE PRECISION DTERM1
26926CCCCC DOUBLE PRECISION DTERM2
26927      DOUBLE PRECISION DATER1
26928      DOUBLE PRECISION DATER2
26929      DOUBLE PRECISION DATERM
26930      DOUBLE PRECISION DA
26931C
26932CCCCC DOUBLE PRECISION LKFUN
26933CCCCC DOUBLE PRECISION LKFU3
26934CCCCC DOUBLE PRECISION LKFU4
26935CCCCC EXTERNAL LKFUN
26936CCCCC EXTERNAL LKFU2
26937CCCCC EXTERNAL LKFU3
26938CCCCC EXTERNAL LKFU4
26939      DOUBLE PRECISION XBAR
26940      DOUBLE PRECISION S2
26941      DOUBLE PRECISION S3
26942      DOUBLE PRECISION F0FREQ
26943      DOUBLE PRECISION F1FREQ
26944      DOUBLE PRECISION F10FRE
26945      DOUBLE PRECISION DC1
26946      COMMON/LKCOM/XBAR,S2,S3,F0FREQ,F1FREQ,F10FRE,DC1,
26947     1              MAXRO2,NTOT2
26948C
26949      PARAMETER (MAXROW=40)
26950      CHARACTER*60 ITITLE
26951      CHARACTER*1  ITITLZ
26952      CHARACTER*40 IDIST
26953      CHARACTER*40 ITEXT(MAXROW)
26954      REAL         AVALUE(MAXROW)
26955      INTEGER      NCTEXT(MAXROW)
26956      INTEGER      IDIGIT(MAXROW)
26957      INTEGER      NTOT(MAXROW)
26958      LOGICAL      IFRST
26959      LOGICAL      ILAST
26960C
26961C-------------------------------------------------------------------
26962C
26963      INCLUDE 'DPCOP2.INC'
26964C
26965C-----START POINT---------------------------------------------------
26966C
26967      ISUBN1='DPML'
26968      ISUBN2='LK  '
26969      IERROR='NO'
26970      IWRITE='OFF'
26971C
26972      DATERM=DBLE(CPUMIN)
26973C
26974      DO11I=1,MAXNXT
26975        DTEMP1(I)=0.0D0
26976   11 CONTINUE
26977C
26978      AMOM=CPUMIN
26979      BETAMO=CPUMIN
26980      BMOM=CPUMIN
26981      AFR=CPUMIN
26982      BETAFR=CPUMIN
26983      BFR=CPUMIN
26984      THETF2=CPUMIN
26985      BETAF2=CPUMIN
26986      AMF2=CPUMIN
26987      AML=CPUMIN
26988      BETAML=CPUMIN
26989      BML=CPUMIN
26990      IFR=0
26991      IFR2=0
26992C
26993      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLK')THEN
26994        WRITE(ICOUT,999)
26995  999   FORMAT(1X)
26996        CALL DPWRST('XXX','WRIT')
26997        WRITE(ICOUT,51)
26998   51   FORMAT('**** AT THE BEGINNING OF DPMLLK--')
26999        CALL DPWRST('XXX','WRIT')
27000        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR
27001   52   FORMAT('IBUGA3,ISUBRO,N,NVAR = ',2(A4,2X),2I8)
27002        CALL DPWRST('XXX','WRIT')
27003        IF(NVAR.EQ.1)THEN
27004          DO56I=1,MIN(N,100)
27005            WRITE(ICOUT,57)I,Y(I)
27006   57       FORMAT('I,Y(I) = ',I8,G15.7)
27007            CALL DPWRST('XXX','WRIT')
27008   56     CONTINUE
27009        ELSE
27010          DO61I=1,N
27011            WRITE(ICOUT,62)I,X(I),Y(I)
27012   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
27013            CALL DPWRST('XXX','WRIT')
27014   61     CONTINUE
27015        ENDIF
27016      ENDIF
27017C
27018C               ********************************************
27019C               **  STEP 11--                             **
27020C               **  1) ROUND DATA TO INTEGER VALUES       **
27021C               **  2) COMPUTE SUMMARY STATISTICS         **
27022C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
27023C               **     INSUFFICIENT SAMPLE SIZE           **
27024C               **  4) FOR RAW DATA CASE, BIN THE DATA.   **
27025C               ********************************************
27026C
27027      ISTEPN='11'
27028      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLLP')
27029     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
27030C
27031      IDIST='LAGRANGE KATZ'
27032C
27033      NPERC=0
27034      MAXGRP=MAXNXT/2
27035      NMIN=2
27036      IF(NVAR.EQ.1)THEN
27037        DO1105I=1,N
27038          ITEMP=INT(Y(I)+0.5)
27039          Y(I)=REAL(ITEMP)
27040 1105   CONTINUE
27041        CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
27042        IF(IERROR.EQ.'YES')GOTO9000
27043C
27044        CALL SORT(Y,N,Y)
27045        IFLAG=1
27046        CALL SUMRAW(Y,N,IDIST,IFLAG,
27047     1              XMEAN,XVAR,XSD,XMIN,XMAX,
27048     1              ISUBRO,IBUGA3,IERROR)
27049        IF(IERROR.EQ.'YES')GOTO9000
27050        NTOTZZ=N
27051C
27052        IRELAT='OFF'
27053        IRHSTG='OFF'
27054        XSTART=XMIN-0.5
27055        XSTOP=XMAX+0.5
27056        CLWID=1.0
27057        CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
27058     1              TEMP1,X,N2,IBUGA3,IERROR)
27059        ICNT=0
27060        DO1121I=1,N2
27061          Y(I)=TEMP1(I)
27062CCCCC     IF(TEMP1(I).GT.0.0)THEN
27063            ICNT=ICNT+1
27064            Y(ICNT)=Y(I)
27065            X(ICNT)=X(I)
27066CCCCC     ENDIF
270671121    CONTINUE
27068        N2=ICNT
27069        IF(IERROR.EQ.'YES')GOTO9000
27070      ELSE
27071        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
27072     1              ISUBRO,IBUGA3,IERROR)
27073        IF(IERROR.EQ.'YES')GOTO9000
27074        IFLAG1=1
27075        IFLAG2=1
27076        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
27077     1              TEMP1,TEMP2,TEMP3,MAXNXT,
27078     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
27079     1              ISUBRO,IBUGA3,IERROR)
27080        IF(IERROR.EQ.'YES')GOTO9000
27081        ICNT=0
27082        NTOTZZ=0
27083        DO1211I=1,N
27084CCCCC     IF(Y(I).GT.0.0)THEN
27085            ICNT=ICNT+1
27086            Y(ICNT)=Y(I)
27087            X(ICNT)=X(I)
27088            NTOTZZ=NTOTZZ + INT(Y(I)+0.01)
27089CCCCC     ENDIF
270901211    CONTINUE
27091        N2=ICNT
27092      ENDIF
27093C
27094      IINDX=MAXNXT/2
27095      IF(N2.LE.IINDX)THEN
27096        IML=0
27097        DO2210I=1,N2
27098          TEMP3(I)=Y(I)
27099          TEMP3(IINDX+I)=X(I)
27100 2210   CONTINUE
27101        IK=N2
27102      ELSE
27103        IML=1
27104      ENDIF
27105      F0=TEMP3(1)/REAL(NTOTZZ)
27106      F1=TEMP3(2)/REAL(NTOTZZ)
27107      IF(F0.NE.0.0)THEN
27108        F10=F1/F0
27109      ELSE
27110        F10=CPUMIN
27111      ENDIF
27112C
27113      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLLK')THEN
27114        WRITE(ICOUT,999)
27115        CALL DPWRST('XXX','WRIT')
27116        WRITE(ICOUT,1151)
27117 1151   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
27118        CALL DPWRST('XXX','WRIT')
27119        WRITE(ICOUT,1152)XMEAN,XVAR,XSD,XMIN,XMAX
27120 1152   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX = ',5G15.7)
27121        CALL DPWRST('XXX','WRIT')
27122        WRITE(ICOUT,1154)F1,N,N2,NTOTZZ,IK,IWD
27123 1154   FORMAT('F1,N,N2,NTOTZZ,IK,IWD = ',G15.7,4I8)
27124        CALL DPWRST('XXX','WRIT')
27125      ENDIF
27126C
27127C               *********************************************
27128C               **  STEP 21--                              **
27129C               **  CARRY OUT CALCULATIONS                 **
27130C               **  FOR LAGRANGE KATZ MLE                  **
27131C               **  ESTIMATION                             **
27132C               *********************************************
27133C
27134      ISTEPN='21'
27135      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLLK')
27136     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
27137C
27138C
27139      IF(NVAR.EQ.1)THEN
27140        DSUM=0.0D0
27141        DO2108I=1,N
27142          DTERM1=DBLE(Y(I)) - DBLE(XMEAN)
27143          DSUM=DSUM +  DTERM1**3
27144 2108   CONTINUE
27145        S3=REAL(DSUM/DBLE(NTOTZZ-1))
27146C
27147      ELSE
27148        DSUM=0.0D0
27149        DO2208I=1,N
27150          DSUM=DSUM +  DBLE(Y(I))*(DBLE(I) - DBLE(XMEAN))**3
27151 2208   CONTINUE
27152        S3=REAL(DSUM/DBLE(NTOTZZ-1))
27153      ENDIF
27154C
27155      IMOM=0
27156      XBAR=DBLE(XMEAN)
27157      S2=DBLE(XSD)**2
27158      S3SKEW=S3/(DBLE(XSD)**3)
27159      DA=(3.0D0*S2**2 - S3*XBAR)**2/(XBAR - S2**3)
27160      IF(DA.GE.4.0D0)THEN
27161        DATER1=DA + DSQRT(DA*(DA-4.0D0))
27162        DATER2=DA - DSQRT(DA*(DA-4.0D0))
27163        BETAM1=2.0D0 - 0.5D0*DATER1
27164        BETAM2=2.0D0 - 0.5D0*DATER2
27165        print *,'dater1,dater2=',dater1,dater2
27166        print *,'betam1,betam2=',betam1,betam2
27167        IF(BETAM1.LT.1.0D0)THEN
27168          BETAM0=BETAM1
27169          DATERM=DATER1
27170        ELSEIF(BETAM2.LT.1.0D0)THEN
27171          BETAM0=BETAM2
27172          DATERM=DATER2
27173        ELSE
27174          IMOM=1
27175        ENDIF
27176        AMOM=REAL(0.5D0*XBAR**(1.5D0)*DATERM/DSQRT(S2))
27177        BMOM=REAL(1.0D0 + 0.5D0*DATERM*(DSQRT(DA) - DSQRT(XBAR/S2)))
27178      ELSE
27179        IMOM=1
27180      ENDIF
27181C
27182      AE=1.D-7
27183      RE=1.D-7
27184      XLOW=0.000001D0
27185      XUP=0.999999D0
27186      XMID=0.5D0
27187      F0FREQ=DBLE(F0)
27188      F1FREQ=DBLE(F1)
27189      F10FRE=DBLE(F10)
27190      NTOT2=NTOTZZ
27191C
27192CCCCC IFR=0
27193CCCCC IF(F0.GT.0.0)THEN
27194CCCCC   C1=S2*LOG(F0)**2/(XBAR**3)
27195CCCCC   IF(C1.GE.1.0 .OR. C1.LE.0.0)IFR=1
27196CCCCC ELSE
27197CCCCC   IFR=1
27198CCCCC ENDIF
27199CCCCC IF(IFR.EQ.0)THEN
27200CCCCC   DC1=DBLE(C1)
27201CCCCC   XLOW=0.000001D0
27202CCCCC   XUP=0.999999D0
27203CCCCC   XMID=DBLE(AMOM)
27204CCCCC   CALL DFZERO(GNBFU3,XLOW,XUP,XMID,RE,AE,IFLAG)
27205CCCCC   AFR=REAL(XLOW)
27206CCCCC   BFR=SQRT((1.0-AFR)*AMEAN**3/AVAR)/AFR
27207CCCCC   BETAFR=(1.0/AFR) - (BFR/AMEAN)
27208CCCCC   IF(BETAFR.LE.1.0)BETAFR=1.0
27209CCCCC ENDIF
27210C
27211      IF(IML.EQ.0)THEN
27212        IOPT=2
27213        TOL=1.0D-5
27214        NPAR=2
27215        NPRINT=-1
27216        INFO=0
27217        LWA=MAXNXT
27218        MAXRO2=MAXNXT
27219C
27220CCCCC   IF(IFR2.EQ.0)THEN
27221CCCCC     XPAR(1)=DBLE(BETAF2)
27222CCCCC     XPAR(2)=DBLE(AMF2)
27223CCCCC   ELSEIF(IFR.EQ.0)THEN
27224CCCCC     XPAR(1)=DBLE(BETAFR)
27225CCCCC     XPAR(2)=DBLE(BFR)
27226CCCCC   ELSE
27227CCCCC     XPAR(1)=DBLE(BETAMO)
27228CCCCC     XPAR(2)=DBLE(BMOM)
27229CCCCC   ENDIF
27230CCCCC   CALL DNSQE(GNBFU2,JAC,IOPT,NPAR,XPAR,FVEC,TOL,NPRINT,INFO,
27231CCCCC1             DTEMP1,LWA,TEMP3,IK)
27232CCCCC   print *,'info = ',info
27233C
27234CCCCC   BETAML=REAL(XPAR(1))
27235CCCCC   BML=REAL(XPAR(2))
27236CCCCC   IF(BETAML.LE.1.0)BETAML=1.0
27237CCCCC   AML=AMEAN/(BML + BETAML*XBAR)
27238      ENDIF
27239C
27240C               ***********************************************
27241C               **   STEP 42--                               **
27242C               **   WRITE OUT EVERYTHING                    **
27243C               **   FOR LAGRANGE KATZ MLE                   **
27244C               **   ESTIMATION                              **
27245C               ***********************************************
27246C
27247      ISTEPN='42'
27248      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNM')
27249     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
27250C
27251C     PRINT SUMMARY STATISTICS TABLE
27252C
27253      NUMDIG=7
27254      IF(IFORSW.EQ.'1')NUMDIG=1
27255      IF(IFORSW.EQ.'2')NUMDIG=2
27256      IF(IFORSW.EQ.'3')NUMDIG=3
27257      IF(IFORSW.EQ.'4')NUMDIG=4
27258      IF(IFORSW.EQ.'5')NUMDIG=5
27259      IF(IFORSW.EQ.'6')NUMDIG=6
27260      IF(IFORSW.EQ.'7')NUMDIG=7
27261      IF(IFORSW.EQ.'8')NUMDIG=8
27262      IF(IFORSW.EQ.'9')NUMDIG=9
27263      IF(IFORSW.EQ.'0')NUMDIG=0
27264      IF(IFORSW.EQ.'E')NUMDIG=-2
27265      IF(IFORSW.EQ.'-2')NUMDIG=-2
27266      IF(IFORSW.EQ.'-3')NUMDIG=-3
27267      IF(IFORSW.EQ.'-4')NUMDIG=-4
27268      IF(IFORSW.EQ.'-5')NUMDIG=-5
27269      IF(IFORSW.EQ.'-6')NUMDIG=-6
27270      IF(IFORSW.EQ.'-7')NUMDIG=-7
27271      IF(IFORSW.EQ.'-8')NUMDIG=-8
27272      IF(IFORSW.EQ.'-9')NUMDIG=-9
27273C
27274      ITITLE='Lagrange Katz Parameter Estimation'
27275      NCTITL=34
27276      ITITLZ=' '
27277      NCTITZ=0
27278C
27279      ICNT=1
27280      ITEXT(ICNT)='Summary Statistics:'
27281      NCTEXT(ICNT)=19
27282      AVALUE(ICNT)=0.0
27283      IDIGIT(ICNT)=-1
27284      ICNT=ICNT+1
27285      ITEXT(ICNT)='Number of Observations:'
27286      NCTEXT(ICNT)=23
27287      AVALUE(ICNT)=REAL(NTOTZZ)
27288      IDIGIT(ICNT)=0
27289      ICNT=ICNT+1
27290      ITEXT(ICNT)='Sample Mean:'
27291      NCTEXT(ICNT)=12
27292      AVALUE(ICNT)=XMEAN
27293      IDIGIT(ICNT)=NUMDIG
27294      ICNT=ICNT+1
27295      ITEXT(ICNT)='Sample Standard Deviation:'
27296      NCTEXT(ICNT)=26
27297      AVALUE(ICNT)=XSD
27298      IDIGIT(ICNT)=NUMDIG
27299      ICNT=ICNT+1
27300      ITEXT(ICNT)='Sample Centralized Third Moment:'
27301      NCTEXT(ICNT)=32
27302      AVALUE(ICNT)=REAL(S3)
27303      IDIGIT(ICNT)=NUMDIG
27304      ICNT=ICNT+1
27305      ITEXT(ICNT)='Sample Minimum:'
27306      NCTEXT(ICNT)=15
27307      AVALUE(ICNT)=XMIN
27308      IDIGIT(ICNT)=NUMDIG
27309      ICNT=ICNT+1
27310      ITEXT(ICNT)='Sample Maximum:'
27311      NCTEXT(ICNT)=15
27312      AVALUE(ICNT)=XMAX
27313      IDIGIT(ICNT)=NUMDIG
27314      ICNT=ICNT+1
27315      ITEXT(ICNT)='Zero-Class Frequency:'
27316      NCTEXT(ICNT)=21
27317      AVALUE(ICNT)=F0
27318      IDIGIT(ICNT)=NUMDIG
27319      ICNT=ICNT+1
27320      ITEXT(ICNT)='Ones-Class Frequency:'
27321      NCTEXT(ICNT)=21
27322      AVALUE(ICNT)=F1
27323      IDIGIT(ICNT)=NUMDIG
27324      ICNT=ICNT+1
27325      ITEXT(ICNT)='Ratio of Ones/Zero Class Frequencies:'
27326      NCTEXT(ICNT)=37
27327      AVALUE(ICNT)=F10
27328      IDIGIT(ICNT)=NUMDIG
27329      ICNT=ICNT+1
27330      ITEXT(ICNT)=' '
27331      NCTEXT(ICNT)=0
27332      AVALUE(ICNT)=0.0
27333      IDIGIT(ICNT)=-1
27334C
27335      ICNT=ICNT+1
27336      ITEXT(ICNT)='Method of Moments:'
27337      NCTEXT(ICNT)=18
27338      AVALUE(ICNT)=0.0
27339      IDIGIT(ICNT)=-1
27340      ICNT=ICNT+1
27341      ITEXT(ICNT)='Estimate of Theta:'
27342      NCTEXT(ICNT)=18
27343      AVALUE(ICNT)=AMOM
27344      IDIGIT(ICNT)=NUMDIG
27345      ICNT=ICNT+1
27346      ITEXT(ICNT)='Estimate of Beta:'
27347      NCTEXT(ICNT)=17
27348      AVALUE(ICNT)=BETAMO
27349      IDIGIT(ICNT)=NUMDIG
27350      ICNT=ICNT+1
27351      ITEXT(ICNT)='Estimate of M:'
27352      NCTEXT(ICNT)=14
27353      AVALUE(ICNT)=BMOM
27354      IDIGIT(ICNT)=NUMDIG
27355      ICNT=ICNT+1
27356      ITEXT(ICNT)=' '
27357      NCTEXT(ICNT)=0
27358      AVALUE(ICNT)=0.0
27359      IDIGIT(ICNT)=-1
27360C
27361      IF(IFR.EQ.0)THEN
27362        ICNT=ICNT+1
27363        ITEXT(ICNT)='Zero-Class Frequency and Moments:'
27364        NCTEXT(ICNT)=18
27365        AVALUE(ICNT)=0.0
27366        IDIGIT(ICNT)=-1
27367        ICNT=ICNT+1
27368        ITEXT(ICNT)='Estimate of Theta:'
27369        NCTEXT(ICNT)=18
27370        AVALUE(ICNT)=AFR
27371        IDIGIT(ICNT)=NUMDIG
27372        ICNT=ICNT+1
27373        ITEXT(ICNT)='Estimate of Beta:'
27374        NCTEXT(ICNT)=17
27375        AVALUE(ICNT)=BETAFR
27376        IDIGIT(ICNT)=NUMDIG
27377        ICNT=ICNT+1
27378        ITEXT(ICNT)='Estimate of M:'
27379        NCTEXT(ICNT)=14
27380        AVALUE(ICNT)=BFR
27381        IDIGIT(ICNT)=NUMDIG
27382        ICNT=ICNT+1
27383        ITEXT(ICNT)=' '
27384        NCTEXT(ICNT)=0
27385        AVALUE(ICNT)=0.0
27386        IDIGIT(ICNT)=-1
27387      ENDIF
27388C
27389      IF(IML.EQ.0)THEN
27390        ICNT=ICNT+1
27391        ITEXT(ICNT)='Maximum Likelihood:'
27392        NCTEXT(ICNT)=19
27393        AVALUE(ICNT)=0.0
27394        IDIGIT(ICNT)=-1
27395        ICNT=ICNT+1
27396        ITEXT(ICNT)='Estimate of Theta:'
27397        NCTEXT(ICNT)=18
27398        AVALUE(ICNT)=AML
27399        IDIGIT(ICNT)=NUMDIG
27400        ICNT=ICNT+1
27401        ITEXT(ICNT)='Estimate of Beta:'
27402        NCTEXT(ICNT)=17
27403        AVALUE(ICNT)=BETAML
27404        IDIGIT(ICNT)=NUMDIG
27405        ICNT=ICNT+1
27406        ITEXT(ICNT)='Estimate of M:'
27407        NCTEXT(ICNT)=14
27408        AVALUE(ICNT)=BML
27409        IDIGIT(ICNT)=NUMDIG
27410        ICNT=ICNT+1
27411        ITEXT(ICNT)=' '
27412        NCTEXT(ICNT)=0
27413        AVALUE(ICNT)=0.0
27414        IDIGIT(ICNT)=-1
27415      ENDIF
27416C
27417      NUMROW=ICNT
27418      DO2410I=1,NUMROW
27419        NTOT(I)=15
27420 2410 CONTINUE
27421C
27422      IFRST=.TRUE.
27423      ILAST=.TRUE.
27424      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
27425     1            AVALUE,IDIGIT,
27426     1            NTOT,NUMROW,
27427     1            ICAPSW,ICAPTY,ILAST,IFRST,
27428     1            ISUBRO,IBUGA3,IERROR)
27429C
27430C               *****************
27431C               **  STEP 90--  **
27432C               **  EXIT       **
27433C               *****************
27434C
27435 9000 CONTINUE
27436      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLK')THEN
27437        WRITE(ICOUT,999)
27438        CALL DPWRST('XXX','WRIT')
27439        WRITE(ICOUT,9011)
27440 9011   FORMAT('***** AT THE END       OF DPMLLK--')
27441        CALL DPWRST('XXX','WRIT')
27442        WRITE(ICOUT,9012)IERROR
27443 9012   FORMAT('IERROR = ',A4)
27444        CALL DPWRST('XXX','WRIT')
27445      ENDIF
27446C
27447      RETURN
27448      END
27449      SUBROUTINE DPMLLP(Y,X,N,NVAR,
27450     1                  TEMP1,TEMP2,TEMP3,DTEMP1,
27451     1                  THETMO,ALAMMO,THETVM,ALAMVM,COVMOM,
27452     1                  THETFR,ALAMFR,THETVF,ALAMVF,COVFR,
27453     1                  THETWD,ALAMWD,
27454     1                  THETML,ALAMML,THETVL,ALAMVL,COVML,
27455     1                  AICMO,AICCMO,BICMO,
27456     1                  AICML,AICCML,BICML,
27457     1                  AICFR,AICCFR,BICFR,
27458     1                  AICWD,AICCWD,BICWD,
27459     1                  ICAPSW,ICAPTY,IFORSW,MAXNXT,
27460     1                  ISUBRO,IBUGA3,IERROR)
27461C
27462C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
27463C              ESTIMATES FOR THE LAGRANGE-POISSON DISTRIBUTION.
27464C
27465C              THE MOMENT ESTIMATORS ARE:
27466C
27467C                  THETAHAT = SQRT(XBAR**3/XVAR)
27468C                  LAMBDAHAT = THETAHAT*[SQRT(XVAR/XBAR**3) - 1/XBAR]
27469C
27470C              THE MEAN AND ZERO FREQUENCY ESTIMATORS ARE:
27471C
27472C                  THETAHAT = LOG(f0/N)
27473C                  LAMBDAHAT = 1 - THETHAT/XBAR
27474C
27475C              THE WEIGHTED DISCREPANCIES ESTIMATES ARE THE
27476C              SOLUTION TO THE EQUATIONS:
27477C
27478C              SUM[i=1 to k][Y(i) - LPOPDF(X)]*
27479C                 [(X*(THETA+LAMBDA)/(THETA*(THETA+LAMBDA*X)) - 1] = 0
27480C
27481C              SUM[i=1 to k][Y(i) - LPOPDF(X)]*
27482C                 [(X*(X-1)/(THETA+LAMBDA*X)) - X] = 0
27483C
27484C              THE EWRC ESTIMATES ARE THE SOLUTION TO THE EQUATIONS:
27485C
27486C              SUM[i=1 to k][Y(i)*(Y(i) - LPOPDF(X))]*
27487C                 [(X*(THETA+LAMBDA)/(THETA*(THETA+LAMBDA*X)) - 1] = 0
27488C
27489C              SUM[i=1 to k][Y(i)*(Y(i) - LPOPDF(X))]*
27490C                 [(X*(X-1)/(THETA+LAMBDA*X)) - X] = 0
27491C
27492C              THE MAXIMUM LIKELIHOOD ESTIMATE OF LAMBDA IS
27493C              THE SOLUTION OF THE EQUATION:
27494C
27495C                 SUM[X=0 to K][X*(X-1)*N(X)/(XBAR+(X-XBAR)*LAMBDA)] -
27496C                 N*XBAR = 0
27497C
27498C              THERE ARE TWO CASES:
27499C
27500C              1) ONE VARIABLE CASE: Y IS RAW DATA
27501C              2) TWO VARIABLE CASE: Y IS FREQUENCY, X IS CLASS
27502C                 MID-POINT.
27503C
27504C     EXAMPLE--LAGRANGE-POISSON MAXIMUM LIKELIHOOD Y
27505C            --LAGRANGE-POISSON MAXIMUM LIKELIHOOD Y X
27506C     REFERENCES--JOHNSON, KOTZ, AND KEMP (1992).  "UNIVARIATE
27507C                 DISCRETE DISTRIBUTIONS", SECOND EDITION,
27508C                 WILEY, PP. 394-396.
27509C               --CONSUL AND FAMOYE (2006), "LAGRANGIAN PROBABILITY
27510C                 DISTRIBUTIONS", BIRKHAUSER, CHAPTER 8.
27511C     WRITTEN BY--ALAN HECKERT
27512C                 STATISTICAL ENGINEERING DIVISION
27513C                 INFORMATION TECHNOLOGY LABORATORY
27514C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
27515C                 GAITHERSBUG, MD 20899-8980
27516C                 PHONE--301-975-2899
27517C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
27518C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
27519C     LANGUAGE--ANSI FORTRAN (1977)
27520C     VERSION NUMBER--2006/6
27521C     ORIGINAL VERSION--JUNE      2006.
27522C     UPDATED         --APRIL     2011. USE DPDTA1 AND DPDTA5 TO PRINT
27523C                                       OUTPUT
27524C
27525C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-----------------
27526C
27527      CHARACTER*4 ICAPSW
27528      CHARACTER*4 ICAPTY
27529      CHARACTER*4 IFORSW
27530      CHARACTER*4 ISUBRO
27531      CHARACTER*4 IBUGA3
27532      CHARACTER*4 IERROR
27533C
27534      CHARACTER*4 IWRITE
27535      CHARACTER*4 ISUBN1
27536      CHARACTER*4 ISUBN2
27537      CHARACTER*4 ISTEPN
27538      CHARACTER*4 IRELAT
27539      CHARACTER*4 IRHSTG
27540C
27541      PARAMETER (MAXROW=50)
27542      CHARACTER*60 ITITLE
27543      CHARACTER*1  ITITLZ
27544      CHARACTER*40 IDIST
27545      CHARACTER*40 ITEXT(MAXROW)
27546      REAL         AVALUE(MAXROW)
27547      INTEGER      NCTEXT(MAXROW)
27548      INTEGER      IDIGIT(MAXROW)
27549      INTEGER      NTOT(MAXROW)
27550      LOGICAL      IFRST
27551      LOGICAL      ILAST
27552C
27553      PARAMETER(NUMCLI=5)
27554      PARAMETER(MAXLIN=3)
27555      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
27556      INTEGER      NCTIT2(MAXLIN,NUMCLI)
27557      INTEGER      IWHTML(NUMCLI+1)
27558      INTEGER      IWRTF(NUMCLI)
27559      REAL         AMAT(MAXROW,NUMCLI)
27560C
27561C-------------------------------------------------------------------
27562C
27563      DIMENSION Y(*)
27564      DIMENSION X(*)
27565      DIMENSION TEMP1(*)
27566      DIMENSION TEMP2(*)
27567      DIMENSION TEMP3(*)
27568      DOUBLE PRECISION DTEMP1(*)
27569C
27570      REAL LCL
27571      REAL UCL
27572C
27573      DOUBLE PRECISION TOL
27574      DOUBLE PRECISION XPAR(2)
27575      DOUBLE PRECISION FVEC(2)
27576C
27577      EXTERNAL LPOFUN
27578      EXTERNAL LPOFU2
27579      EXTERNAL LPOFU3
27580      DOUBLE PRECISION XBAR
27581      COMMON/LPOCOM/XBAR,MAXRO2,NTOTZZ
27582C
27583      PARAMETER (NUMALP=8)
27584      DIMENSION ALPHA(NUMALP)
27585      DIMENSION ALOWTH(NUMALP)
27586      DIMENSION AUPPTH(NUMALP)
27587      DIMENSION ALOWLA(NUMALP)
27588      DIMENSION AUPPLA(NUMALP)
27589C
27590C-------------------------------------------------------------------
27591C
27592      INCLUDE 'DPCOP2.INC'
27593C
27594      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
27595C
27596C-----START POINT---------------------------------------------------
27597C
27598      ISUBN1='DPML'
27599      ISUBN2='LP  '
27600      IERROR='NO'
27601      IWRITE='OFF'
27602C
27603      THETMO=CPUMIN
27604      ALAMMO=CPUMIN
27605      THETMO=CPUMIN
27606      ALAMVM=CPUMIN
27607      COVMOM=CPUMIN
27608      THETFR=CPUMIN
27609      ALAMFR=CPUMIN
27610      THETVF=CPUMIN
27611      ALAMVF=CPUMIN
27612      COVFR=CPUMIN
27613      THETWD=CPUMIN
27614      ALAMWD=CPUMIN
27615      THETML=CPUMIN
27616      ALAMML=CPUMIN
27617      THETVL=CPUMIN
27618      ALAMVL=CPUMIN
27619      COVML=CPUMIN
27620      AICMO=CPUMIN
27621      AICCMO=CPUMIN
27622      BICMO=CPUMIN
27623      AICML=CPUMIN
27624      AICCML=CPUMIN
27625      BICML=CPUMIN
27626      AICFR=CPUMIN
27627      AICCFR=CPUMIN
27628      BICFR=CPUMIN
27629      AICWD=CPUMIN
27630      AICCWD=CPUMIN
27631      BICWD=CPUMIN
27632C
27633      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLP')THEN
27634        WRITE(ICOUT,999)
27635  999   FORMAT(1X)
27636        CALL DPWRST('XXX','WRIT')
27637        WRITE(ICOUT,51)
27638   51   FORMAT('**** AT THE BEGINNING OF DPMLLP--')
27639        CALL DPWRST('XXX','WRIT')
27640        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR
27641   52   FORMAT('IBUGA3,ISUBRO,N,NVAR = ',2(A4,2X),2I8)
27642        CALL DPWRST('XXX','WRIT')
27643        IF(NVAR.EQ.1)THEN
27644          DO56I=1,MIN(N,100)
27645            WRITE(ICOUT,57)I,Y(I)
27646   57       FORMAT('I,Y(I) = ',I8,G15.7)
27647            CALL DPWRST('XXX','WRIT')
27648   56     CONTINUE
27649        ELSE
27650          DO61I=1,N
27651            WRITE(ICOUT,62)I,X(I),Y(I)
27652   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
27653            CALL DPWRST('XXX','WRIT')
27654   61     CONTINUE
27655        ENDIF
27656      ENDIF
27657C
27658C               ********************************************
27659C               **  STEP 11--                             **
27660C               **  1) ROUND DATA TO INTEGER VALUES       **
27661C               **  2) COMPUTE SUMMARY STATISTICS         **
27662C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
27663C               **     INSUFFICIENT SAMPLE SIZE           **
27664C               **  4) FOR RAW DATA CASE, BIN THE DATA.   **
27665C               ********************************************
27666C
27667      ISTEPN='11'
27668      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLLP')
27669     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
27670C
27671      IDIST='LAGRANGE POISSON'
27672C
27673      NPERC=0
27674      MAXGRP=MAXNXT/2
27675      NMIN=2
27676      IF(NVAR.EQ.1)THEN
27677        DO1105I=1,N
27678          ITEMP=INT(Y(I)+0.5)
27679          Y(I)=REAL(ITEMP)
27680 1105   CONTINUE
27681        CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
27682        IF(IERROR.EQ.'YES')GOTO9000
27683C
27684        CALL SORT(Y,N,Y)
27685        IFLAG=1
27686        CALL SUMRAW(Y,N,IDIST,IFLAG,
27687     1              XMEAN,XVAR,XSD,XMIN,XMAX,
27688     1              ISUBRO,IBUGA3,IERROR)
27689        IF(IERROR.EQ.'YES')GOTO9000
27690        NTOTZZ=N
27691C
27692        IRELAT='OFF'
27693        IRHSTG='OFF'
27694        XSTART=XMIN-0.5
27695        XSTOP=XMAX+0.5
27696        CLWID=1.0
27697        CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
27698     1              TEMP1,X,N2,IBUGA3,IERROR)
27699        ICNT=0
27700        DO1121I=1,N2
27701          Y(I)=TEMP1(I)
27702          IF(TEMP1(I).GT.0.0)THEN
27703            ICNT=ICNT+1
27704            Y(ICNT)=Y(I)
27705            X(ICNT)=X(I)
27706          ENDIF
277071121    CONTINUE
27708        N2=ICNT
27709        IF(IERROR.EQ.'YES')GOTO9000
27710      ELSE
27711        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
27712     1              ISUBRO,IBUGA3,IERROR)
27713        IF(IERROR.EQ.'YES')GOTO9000
27714        IFLAG1=1
27715        IFLAG2=1
27716        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
27717     1              TEMP1,TEMP2,TEMP3,MAXNXT,
27718     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
27719     1              ISUBRO,IBUGA3,IERROR)
27720        IF(IERROR.EQ.'YES')GOTO9000
27721        ICNT=0
27722        NTOTZZ=0
27723        DO1211I=1,N
27724          IF(Y(I).GT.0.0)THEN
27725            ICNT=ICNT+1
27726            Y(ICNT)=Y(I)
27727            X(ICNT)=X(I)
27728            NTOTZZ=NTOTZZ + INT(Y(I)+0.01)
27729          ENDIF
277301211    CONTINUE
27731        N2=ICNT
27732      ENDIF
27733C
27734      F1=Y(1)/REAL(NTOTZZ)
27735      IINDX=MAXNXT/2
27736      IF(N2.LE.IINDX)THEN
27737        IWD=0
27738        DO2210I=1,N2
27739          TEMP3(I)=Y(I)
27740          TEMP3(IINDX+I)=X(I)
27741 2210   CONTINUE
27742        IK=N
27743      ELSE
27744        IWD=1
27745      ENDIF
27746C
27747      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLBT')THEN
27748        WRITE(ICOUT,999)
27749        CALL DPWRST('XXX','WRIT')
27750        WRITE(ICOUT,1151)
27751 1151   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
27752        CALL DPWRST('XXX','WRIT')
27753        WRITE(ICOUT,1152)XMEAN,XVAR,XSD,XMIN,XMAX
27754 1152   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX = ',5G15.7)
27755        CALL DPWRST('XXX','WRIT')
27756        WRITE(ICOUT,1154)F1,N,N2,NTOTZZ,IK,IWD
27757 1154   FORMAT('F1,N,N2,NTOTZZ,IK,IWD = ',G15.7,4I8)
27758        CALL DPWRST('XXX','WRIT')
27759      ENDIF
27760C
27761C               *********************************************
27762C               **  STEP 21--                              **
27763C               **  CARRY OUT CALCULATIONS                 **
27764C               **  FOR LAGRANGE-POISSON MLE ESTIMATION    **
27765C               *********************************************
27766C
27767      ISTEPN='21'
27768      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLLP')
27769     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
27770C
27771C     MOMENT ESTIMATES AND ASSOCITED VARIANCES AND COVARIANCES
27772C
27773      AN=REAL(NTOTZZ)
27774      THETMO=SQRT(XMEAN**3/XSD**2)
27775      ALAMMO=THETMO*(SQRT(XSD**2/XMEAN**3) - 1.0/XMEAN)
27776      TERM1=THETMO/(2.0*AN)
27777      TERM2=THETMO + (2.0-2.0*ALAMMO+3.0*ALAMMO**2)/(1.0-ALAMMO)
27778      THETVM=TERM1*TERM2
27779      TERM1=(1.0 - ALAMMO)/(2.0*AN*THETMO)
27780      TERM2=THETMO - THETMO*ALAMMO + 2.0*ALAMMO + 3.0*THETMO**2
27781      ALAMVM=TERM1*TERM2
27782      TERM1=1.0/(2.0*AN)
27783      TERM2=THETMO*(1.0-ALAMMO) + 3.0*ALAMMO**2
27784      COVMOM=TERM1*TERM2
27785C
27786C     MEAN AND FIRST FREQUENCY ESTIMATE
27787C
27788      IF(F1.GT.0.0)THEN
27789        THETFR=LOG(1.0/F1)
27790        ALAMFR=1.0 - THETFR/XMEAN
27791        THETVF=(1.0/AN)*(EXP(THETMO) - 1.0)
27792        ALAMVF=1.0 - THETFR/XMEAN
27793        TERM1=(1.0 - ALAMFR)/(AN*THETFR**2)
27794        TERM2=(1.0 - ALAMFR)*(EXP(THETFR-1.0) +
27795     1        THETFR*(2.0*ALAMFR - 1.0))
27796        TERM1=(1.0-ALAMFR)/(AN*THETFR)
27797        TERM2=EXP(THETFR) - THETFR - 1.0
27798        COVFR=TERM1*TERM2
27799      ENDIF
27800C
27801C     WEIGHTED DISCREPANCIES
27802C
27803      XBAR=DBLE(XMEAN)
27804      IF(IWD.EQ.0)THEN
27805        IOPT=2
27806        TOL=1.0D-5
27807        NPAR=2
27808        NPRINT=-1
27809        INFO=0
27810        LWA=MAXNXT
27811        MAXRO2=MAXNXT
27812C
27813        IF(ALAMFR.GT.0.0 .AND. THETFR.GT.0.0)THEN
27814          XPAR(1)=DBLE(ALAMFR)
27815          XPAR(2)=DBLE(THETFR)
27816        ELSE
27817          XPAR(1)=DBLE(ALAMMO)
27818          XPAR(2)=DBLE(THETMO)
27819        ENDIF
27820        CALL DNSQE(LPOFUN,JAC,IOPT,NPAR,XPAR,FVEC,TOL,NPRINT,INFO,
27821     1             DTEMP1,LWA,TEMP3,IK)
27822C
27823        ALAMWD=REAL(XPAR(1))
27824        THETWD=REAL(XPAR(2))
27825C
27826        IF(ALAMFR.GT.0.0 .AND. THETFR.GT.0.0)THEN
27827          XPAR(1)=DBLE(ALAMFR)
27828          XPAR(2)=DBLE(THETFR)
27829        ELSE
27830          XPAR(1)=DBLE(ALAMMO)
27831          XPAR(2)=DBLE(THETMO)
27832        ENDIF
27833CCCCC   XPAR(1)=DBLE(ALAMWD)
27834CCCCC   XPAR(2)=DBLE(THETWD)
27835CCCCC   CALL DNSQE(LPOFU3,JAC,IOPT,NPAR,XPAR,FVEC,TOL,NPRINT,INFO,
27836CCCCC1             DTEMP1,LWA,TEMP3,IK)
27837CCCCC   ALAMEW=REAL(XPAR(1))
27838CCCCC   THETEW=REAL(XPAR(2))
27839        THETEW=CPUMIN
27840        ALAMEW=CPUMIN
27841      ENDIF
27842C
27843C     MAXIMUM LIKELIHOOD ESTIMATE
27844C
27845C     IF LAMBDA IS OUT OF RANGE, THEN SUPPRESS ML OUTPUT.
27846C
27847      IML=1
27848      IOPT=2
27849      TOL=1.0D-5
27850      NPAR=1
27851      NPRINT=-1
27852      INFO=0
27853      LWA=MAXNXT
27854      MAXRO2=MAXNXT
27855C
27856      IF(IWD.EQ.0)THEN
27857        XPAR(1)=DBLE(ALAMWD)
27858      ELSE
27859        XPAR(1)=DBLE(ALAMMO)
27860      ENDIF
27861      CALL DNSQE(LPOFU2,JAC,IOPT,NPAR,XPAR,FVEC,TOL,NPRINT,INFO,
27862     1             DTEMP1,LWA,TEMP3,IK)
27863C
27864      ALAMML=REAL(XPAR(1))
27865      IF(ALAMML.LT.0.0 .OR. ALAMML.GT.1.0)THEN
27866        IML=0
27867        ALAM=ALAMWD
27868        THET=THETWD
27869      ELSE
27870        THETML=XBAR*(1.0-ALAMML)
27871        THETVL=THETML*(THETML+2.0)/(2.0*AN)
27872        ALAMVL=(THETML+2.0*ALAMML-THETML*ALAMML)*(1.0-ALAMML)/
27873     1         (2.0*AN*THETML)
27874        COVML=-THETML*(1.0-ALAMML)/(2.0*AN)
27875        ALAM=ALAMML
27876        THET=THETML
27877      ENDIF
27878C
27879      DO2310I=1,NUMALP
27880C
27881        ALP=ALPHA(I)
27882        P1=ALP/2.0
27883        P2=1.0-(ALP/2.0)
27884        CALL NORPPF(P2,ZALPHA)
27885C
27886CCCCC   TERM1=XMEAN*(1.0 - ALAMML)**3*SQRT(AN)
27887CCCCC   TERM2=(1.0-ALAMML)**2*SQRT(AN) + ZALPHA
27888CCCCC   TERM3=(1.0-ALAMML)**2*SQRT(AN) - ZALPHA
27889CCCCC   UCL=TERM1/TERM3
27890CCCCC   LCL=TERM1/TERM2
27891        LCL=(XMEAN - ZALPHA*XSD)*(1.0 - ALAM)/SQRT(AN)
27892        IF(LCL.LT.0.0)LCL=0.0
27893        UCL=(XMEAN + ZALPHA*XSD)*(1.0 - ALAM)/SQRT(AN)
27894        ALOWTH(I)=LCL
27895        AUPPTH(I)=UCL
27896        UCL=1.0 - THET/(XMEAN + ZALPHA*XSD/SQRT(AN))
27897        LCL=1.0 - THET/(XMEAN - ZALPHA*XSD/SQRT(AN))
27898        IF(LCL.LT.0.0)LCL=0.0
27899        ALOWLA(I)=LCL
27900        AUPPLA(I)=UCL
27901C
27902 2310 CONTINUE
27903C
27904C               ***********************************************
27905C               **   STEP 42--                               **
27906C               **   WRITE OUT EVERYTHING                    **
27907C               **   FOR LAGRANGE-POISSON MLE ESTIMATION     **
27908C               ***********************************************
27909C
27910      ISTEPN='42'
27911      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLLP')
27912     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
27913C
27914C     PRINT SUMMARY STATISTICS TABLE
27915C
27916      NUMDIG=7
27917      IF(IFORSW.EQ.'1')NUMDIG=1
27918      IF(IFORSW.EQ.'2')NUMDIG=2
27919      IF(IFORSW.EQ.'3')NUMDIG=3
27920      IF(IFORSW.EQ.'4')NUMDIG=4
27921      IF(IFORSW.EQ.'5')NUMDIG=5
27922      IF(IFORSW.EQ.'6')NUMDIG=6
27923      IF(IFORSW.EQ.'7')NUMDIG=7
27924      IF(IFORSW.EQ.'8')NUMDIG=8
27925      IF(IFORSW.EQ.'9')NUMDIG=9
27926      IF(IFORSW.EQ.'0')NUMDIG=0
27927      IF(IFORSW.EQ.'E')NUMDIG=-2
27928      IF(IFORSW.EQ.'-2')NUMDIG=-2
27929      IF(IFORSW.EQ.'-3')NUMDIG=-3
27930      IF(IFORSW.EQ.'-4')NUMDIG=-4
27931      IF(IFORSW.EQ.'-5')NUMDIG=-5
27932      IF(IFORSW.EQ.'-6')NUMDIG=-6
27933      IF(IFORSW.EQ.'-7')NUMDIG=-7
27934      IF(IFORSW.EQ.'-8')NUMDIG=-8
27935      IF(IFORSW.EQ.'-9')NUMDIG=-9
27936C
27937      ITITLE='Lagrange-Poisson Parameter Estimation'
27938      NCTITL=37
27939      ITITLZ=' '
27940      NCTITZ=0
27941C
27942      ICNT=1
27943      ITEXT(ICNT)='Summary Statistics:'
27944      NCTEXT(ICNT)=19
27945      AVALUE(ICNT)=0.0
27946      IDIGIT(ICNT)=-1
27947      ICNT=ICNT+1
27948      ITEXT(ICNT)='Number of Observations:'
27949      NCTEXT(ICNT)=23
27950      AVALUE(ICNT)=REAL(NTOTZZ)
27951      IDIGIT(ICNT)=0
27952      ICNT=ICNT+1
27953      ITEXT(ICNT)='Sample Mean:'
27954      NCTEXT(ICNT)=12
27955      AVALUE(ICNT)=XMEAN
27956      IDIGIT(ICNT)=NUMDIG
27957      ICNT=ICNT+1
27958      ITEXT(ICNT)='Sample Standard Deviation:'
27959      NCTEXT(ICNT)=26
27960      AVALUE(ICNT)=XSD
27961      IDIGIT(ICNT)=NUMDIG
27962      ICNT=ICNT+1
27963      ITEXT(ICNT)='Sample Minimum:'
27964      NCTEXT(ICNT)=15
27965      AVALUE(ICNT)=XMIN
27966      IDIGIT(ICNT)=NUMDIG
27967      ICNT=ICNT+1
27968      ITEXT(ICNT)='Sample Maximum:'
27969      NCTEXT(ICNT)=15
27970      AVALUE(ICNT)=XMAX
27971      IDIGIT(ICNT)=NUMDIG
27972      ICNT=ICNT+1
27973      ITEXT(ICNT)='First Frequency:'
27974      NCTEXT(ICNT)=16
27975      AVALUE(ICNT)=F1
27976      IDIGIT(ICNT)=NUMDIG
27977      ICNT=ICNT+1
27978      ITEXT(ICNT)=' '
27979      NCTEXT(ICNT)=0
27980      AVALUE(ICNT)=0.0
27981      IDIGIT(ICNT)=-1
27982C
27983      ICNT=ICNT+1
27984      ITEXT(ICNT)='Method of Moments:'
27985      NCTEXT(ICNT)=18
27986      AVALUE(ICNT)=0.0
27987      IDIGIT(ICNT)=-1
27988      ICNT=ICNT+1
27989      ITEXT(ICNT)='Estimate of Theta:'
27990      NCTEXT(ICNT)=18
27991      AVALUE(ICNT)=THETMO
27992      IDIGIT(ICNT)=NUMDIG
27993      ICNT=ICNT+1
27994      ITEXT(ICNT)='Estimate of Lambda:'
27995      NCTEXT(ICNT)=19
27996      AVALUE(ICNT)=ALAMMO
27997      IDIGIT(ICNT)=NUMDIG
27998      ICNT=ICNT+1
27999      ITEXT(ICNT)='Asymptotic Variance of Theta:'
28000      NCTEXT(ICNT)=29
28001      AVALUE(ICNT)=THETVM
28002      IDIGIT(ICNT)=NUMDIG
28003      ICNT=ICNT+1
28004      ITEXT(ICNT)='Asymptotic Variance of Lambda:'
28005      NCTEXT(ICNT)=30
28006      AVALUE(ICNT)=ALAMVM
28007      IDIGIT(ICNT)=NUMDIG
28008      ICNT=ICNT+1
28009      ITEXT(ICNT)='Asymptotic Covariance of Theta/Lambda:'
28010      NCTEXT(ICNT)=38
28011      AVALUE(ICNT)=COVMOM
28012      IDIGIT(ICNT)=NUMDIG
28013      ICNT=ICNT+1
28014      ITEXT(ICNT)=' '
28015      NCTEXT(ICNT)=0
28016      AVALUE(ICNT)=0.0
28017      IDIGIT(ICNT)=-1
28018C
28019      ICNT=ICNT+1
28020      ITEXT(ICNT)='Method of Zero Frequency and Mean:'
28021      NCTEXT(ICNT)=34
28022      AVALUE(ICNT)=0.0
28023      IDIGIT(ICNT)=-1
28024      ICNT=ICNT+1
28025      ITEXT(ICNT)='Estimate of Theta:'
28026      NCTEXT(ICNT)=18
28027      AVALUE(ICNT)=THETFR
28028      IDIGIT(ICNT)=NUMDIG
28029      ICNT=ICNT+1
28030      ITEXT(ICNT)='Estimate of Lambda:'
28031      NCTEXT(ICNT)=19
28032      AVALUE(ICNT)=ALAMFR
28033      IDIGIT(ICNT)=NUMDIG
28034      ICNT=ICNT+1
28035      ITEXT(ICNT)='Asymptotic Variance of Theta:'
28036      NCTEXT(ICNT)=29
28037      AVALUE(ICNT)=THETVF
28038      IDIGIT(ICNT)=NUMDIG
28039      ICNT=ICNT+1
28040      ITEXT(ICNT)='Asymptotic Variance of Lambda:'
28041      NCTEXT(ICNT)=30
28042      AVALUE(ICNT)=ALAMVF
28043      IDIGIT(ICNT)=NUMDIG
28044      ICNT=ICNT+1
28045      ITEXT(ICNT)='Asymptotic Covariance of Theta-Lambda:'
28046      NCTEXT(ICNT)=38
28047      AVALUE(ICNT)=COVFR
28048      IDIGIT(ICNT)=NUMDIG
28049      ICNT=ICNT+1
28050      ITEXT(ICNT)=' '
28051      NCTEXT(ICNT)=0
28052      AVALUE(ICNT)=0.0
28053      IDIGIT(ICNT)=-1
28054C
28055      ICNT=ICNT+1
28056      ITEXT(ICNT)='Method of Weighted Discrepancies:'
28057      NCTEXT(ICNT)=33
28058      AVALUE(ICNT)=0.0
28059      IDIGIT(ICNT)=-1
28060      ICNT=ICNT+1
28061      ITEXT(ICNT)='Estimate of Theta:'
28062      NCTEXT(ICNT)=18
28063      AVALUE(ICNT)=THETWD
28064      IDIGIT(ICNT)=NUMDIG
28065      ICNT=ICNT+1
28066      ITEXT(ICNT)='Estimate of Lambda:'
28067      NCTEXT(ICNT)=19
28068      AVALUE(ICNT)=ALAMWD
28069      IDIGIT(ICNT)=NUMDIG
28070      ICNT=ICNT+1
28071      ITEXT(ICNT)=' '
28072      NCTEXT(ICNT)=0
28073      AVALUE(ICNT)=0.0
28074      IDIGIT(ICNT)=-1
28075C
28076      IF(IML.EQ.1)THEN
28077        ICNT=ICNT+1
28078        ITEXT(ICNT)='Method of Maximum Likelihood:'
28079        NCTEXT(ICNT)=29
28080        AVALUE(ICNT)=0.0
28081        IDIGIT(ICNT)=-1
28082        ICNT=ICNT+1
28083        ITEXT(ICNT)='Estimate of Theta:'
28084        NCTEXT(ICNT)=18
28085        AVALUE(ICNT)=THETML
28086        IDIGIT(ICNT)=NUMDIG
28087        ICNT=ICNT+1
28088        ITEXT(ICNT)='Estimate of Lambda:'
28089        NCTEXT(ICNT)=19
28090        AVALUE(ICNT)=ALAMML
28091        IDIGIT(ICNT)=NUMDIG
28092        ICNT=ICNT+1
28093        ITEXT(ICNT)='Asymptotic Variance of Theta:'
28094        NCTEXT(ICNT)=29
28095        AVALUE(ICNT)=THETVL
28096        IDIGIT(ICNT)=NUMDIG
28097        ICNT=ICNT+1
28098        ITEXT(ICNT)='Asymptotic Variance of Lambda:'
28099        NCTEXT(ICNT)=30
28100        AVALUE(ICNT)=ALAMVL
28101        IDIGIT(ICNT)=NUMDIG
28102        ICNT=ICNT+1
28103        ITEXT(ICNT)='Asymptotic Covariance of Theta-Lambda:'
28104        NCTEXT(ICNT)=38
28105        AVALUE(ICNT)=COVML
28106        IDIGIT(ICNT)=NUMDIG
28107        ICNT=ICNT+1
28108        ITEXT(ICNT)=' '
28109        NCTEXT(ICNT)=0
28110        AVALUE(ICNT)=0.0
28111        IDIGIT(ICNT)=-1
28112      ENDIF
28113C
28114      NUMROW=ICNT
28115      DO2410I=1,NUMROW
28116        NTOT(I)=15
28117 2410 CONTINUE
28118C
28119      IFRST=.TRUE.
28120      ILAST=.TRUE.
28121      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
28122     1            AVALUE,IDIGIT,
28123     1            NTOT,NUMROW,
28124     1            ICAPSW,ICAPTY,ILAST,IFRST,
28125     1            ISUBRO,IBUGA3,IERROR)
28126C
28127CCCCC ITITL9=' '
28128      NCTIT9=0
28129      ITITLE(1:42)='Large Sample Normal Confidence Limits for '
28130      ITITLE(43:59)='Theta and Lambda'
28131      NCTITL=59
28132      NUMLIN=3
28133      NUMCOL=5
28134C
28135      ITITL2(1,1)=' '
28136      ITITL2(2,1)='Confidence'
28137      ITITL2(3,1)='Coefficient'
28138      NCTIT2(1,1)=10
28139      NCTIT2(2,1)=10
28140      NCTIT2(3,1)=11
28141C
28142      ITITL2(1,2)=' '
28143      ITITL2(2,2)='Lower'
28144      ITITL2(3,2)='Limit'
28145      NCTIT2(1,2)=0
28146      NCTIT2(2,2)=5
28147      NCTIT2(3,2)=5
28148C
28149      ITITL2(1,3)='Theta'
28150      ITITL2(2,3)='Upper'
28151      ITITL2(3,3)='Limit'
28152      NCTIT2(1,3)=5
28153      NCTIT2(2,3)=5
28154      NCTIT2(3,3)=5
28155C
28156      ITITL2(1,4)=' '
28157      ITITL2(2,4)='Lower'
28158      ITITL2(3,4)='Limit'
28159      NCTIT2(1,4)=0
28160      NCTIT2(2,4)=5
28161      NCTIT2(3,4)=5
28162C
28163      ITITL2(1,5)='Lambda'
28164      ITITL2(2,5)='Upper'
28165      ITITL2(3,5)='Limit'
28166      NCTIT2(1,5)=6
28167      NCTIT2(2,5)=5
28168      NCTIT2(3,5)=5
28169C
28170      NMAX=0
28171      DO2321I=1,NUMCOL
28172CCCCC   VALIGN(I)='b'
28173CCCCC   ALIGN(I)='r'
28174        NTOT(I)=15
28175        NMAX=NMAX+NTOT(I)
28176        IDIGIT(I)=NUMDIG
28177 2321 CONTINUE
28178      IDIGIT(1)=3
28179      DO2323I=1,NUMALP
28180        NCTEXT(I)=0
28181        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
28182        AMAT(I,2)=ALOWTH(I)
28183        AMAT(I,3)=AUPPTH(I)
28184        AMAT(I,4)=ALOWLA(I)
28185        AMAT(I,5)=AUPPLA(I)
28186 2323 CONTINUE
28187      IWHTML(1)=100
28188      IWHTML(2)=150
28189      IWHTML(3)=150
28190      IWHTML(4)=150
28191      IWHTML(5)=150
28192      IWHTML(6)=150
28193      IWRTF(1)=1600
28194      IWRTF(2)=IWRTF(1)+1800
28195      IWRTF(3)=IWRTF(2)+1800
28196      IWRTF(4)=IWRTF(3)+1800
28197      IWRTF(5)=IWRTF(4)+1800
28198      IFRST=.TRUE.
28199      ILAST=.TRUE.
28200C
28201C     THE CI FOR THETA IS NOT MAKING SENSE, SO COMMENT OUT
28202C     FOR NOW.
28203C
28204CCCCC CALL DPDTA2(ITITL9,NCTIT9,
28205CCCCC1            ITITLE,NCTITL,ITITL2,NCTIT2,
28206CCCCC1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
28207CCCCC1            ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
28208CCCCC1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
28209CCCCC1            ICAPSW,ICAPTY,IFRST,ILAST,
28210CCCCC1            ISUBRO,IBUGA3,IERROR)
28211C
28212C               *****************
28213C               **  STEP 90--  **
28214C               **  EXIT       **
28215C               *****************
28216C
28217 9000 CONTINUE
28218      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLP')THEN
28219        WRITE(ICOUT,999)
28220        CALL DPWRST('XXX','WRIT')
28221        WRITE(ICOUT,9011)
28222 9011   FORMAT('***** AT THE END       OF DPMLLP--')
28223        CALL DPWRST('XXX','WRIT')
28224        WRITE(ICOUT,9012)N,IBUGA3,IERROR
28225 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
28226        CALL DPWRST('XXX','WRIT')
28227      ENDIF
28228C
28229      RETURN
28230      END
28231      SUBROUTINE DPMLLS(Y,X,N,NVAR,
28232     1                  TEMP1,TEMP2,TEMP3,MAXNXT,
28233     1                  RHAT,PHAT,
28234     1                  AIC,AICC,BIC,
28235     1                  ICAPSW,ICAPTY,IFORSW,
28236     1                  ISUBRO,IBUGA3,IERROR)
28237C
28238C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
28239C              ESTIMATES FOR THE LOST GAMES DISTRIBUTION.
28240C              THE MAXIMUM LIKELIHOOD ESTIMATES ARE:
28241C
28242C              1) USE THE MINIMUM VALUE AS THE ESTIMATE OF
28243C                 R.
28244C
28245C              2) THEN USE
28246C
28247C                   PHAT = XMEAN/(2*XMEAN-XMIN)
28248C
28249C                 AS THE ESTIMATE OF P.
28250C
28251C              THERE ARE TWO CASES:
28252C
28253C              1) ONE VARIABLE CASE: Y IS RAW DATA
28254C              2) TWO VARIABLE CASE: Y IS FREQUENCY, X IS CLASS
28255C                 MID-POINT.
28256C
28257C     EXAMPLE--LOST GAMES MAXIMUM LIKELIHOOD Y
28258C            --LOST GAMES MAXIMUM LIKELIHOOD Y X
28259C     REFERENCES--JOHNSON, KOTZ, AND KEMP (1992).  "UNIVARIATE
28260C                 DISCRETE DISTRIBUTIONS", SECOND EDITION,
28261C                 WILEY, PP. 445-447.
28262C               --LUC DEVROYE (1986), "NON-UNIFORM RANDOM VARIATE
28263C                 GENERATION", SPRINGER-VERLANG, PP. 758-759.
28264C               --KEMP AND KEMP (1968), "ON A DISTRIBUTION ASSOCIATED
28265C                 WITH CERTAIN STOCHASTIC PROCESSES", JOURNAL OF
28266C                 THE ROYAL STATISTICAL SOCIETY, SERIES B, 30,
28267C                 PP. 401-410.
28268C               --HAIGHT (1961), "A DISTRIBUTION ANALOGOUS TO THE
28269C                 BOREL-TANNER", BIOMETRIKA, 48, PP. 167-173.
28270C     WRITTEN BY--ALAN HECKERT
28271C                 STATISTICAL ENGINEERING DIVISION
28272C                 INFORMATION TECHNOLOGY LABORATORY
28273C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
28274C                 GAITHERSBUG, MD 20899-8980
28275C                 PHONE--301-975-2899
28276C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
28277C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
28278C     LANGUAGE--ANSI FORTRAN (1977)
28279C     VERSION NUMBER--2006/6
28280C     ORIGINAL VERSION--JUNE      2006.
28281C     UPDATED         --APRIL     2011. USE DPDTA1 TO PRINT THE OUTPUT
28282C
28283C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-----------------
28284C
28285      CHARACTER*4 ICAPSW
28286      CHARACTER*4 ICAPTY
28287      CHARACTER*4 IFORSW
28288      CHARACTER*4 ISUBRO
28289      CHARACTER*4 IBUGA3
28290      CHARACTER*4 IERROR
28291C
28292      CHARACTER*4 IWRITE
28293      CHARACTER*4 ISUBN1
28294      CHARACTER*4 ISUBN2
28295      CHARACTER*4 ISTEPN
28296C
28297C-------------------------------------------------------------------
28298C
28299      DIMENSION Y(*)
28300      DIMENSION X(*)
28301      DIMENSION TEMP1(*)
28302      DIMENSION TEMP2(*)
28303      DIMENSION TEMP3(*)
28304C
28305      PARAMETER (MAXROW=20)
28306      CHARACTER*60 ITITLE
28307      CHARACTER*1  ITITLZ
28308      CHARACTER*40 IDIST
28309      CHARACTER*40 ITEXT(MAXROW)
28310      REAL         AVALUE(MAXROW)
28311      INTEGER      NCTEXT(MAXROW)
28312      INTEGER      IDIGIT(MAXROW)
28313      INTEGER      NTOT(MAXROW)
28314      LOGICAL      IFRST
28315      LOGICAL      ILAST
28316C
28317C-------------------------------------------------------------------
28318C
28319      INCLUDE 'DPCOP2.INC'
28320C
28321C-----START POINT---------------------------------------------------
28322C
28323      ISUBN1='DPML'
28324      ISUBN2='LS  '
28325      IERROR='NO'
28326      IWRITE='OFF'
28327C
28328      RHAT=CPUMIN
28329      PHAT=CPUMIN
28330      AIC=CPUMIN
28331      AICC=CPUMIN
28332      BIC=CPUMIN
28333C
28334      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLS')THEN
28335        WRITE(ICOUT,999)
28336  999   FORMAT(1X)
28337        CALL DPWRST('XXX','WRIT')
28338        WRITE(ICOUT,51)
28339   51   FORMAT('**** AT THE BEGINNING OF DPMLLS--')
28340        CALL DPWRST('XXX','WRIT')
28341        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR
28342   52   FORMAT('IBUGA3,ISUBRO,N,NVAR = ',2(A4,2X),2I8)
28343        CALL DPWRST('XXX','WRIT')
28344        IF(NVAR.EQ.1)THEN
28345          DO56I=1,MIN(N,100)
28346            WRITE(ICOUT,57)I,Y(I)
28347   57       FORMAT('I,Y(I) = ',I8,G15.7)
28348            CALL DPWRST('XXX','WRIT')
28349   56     CONTINUE
28350        ELSE
28351          DO61I=1,N
28352            WRITE(ICOUT,62)I,X(I),Y(I)
28353   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
28354            CALL DPWRST('XXX','WRIT')
28355   61     CONTINUE
28356        ENDIF
28357      ENDIF
28358C
28359C               ********************************************
28360C               **  STEP 11--                             **
28361C               **  1) ROUND DATA TO INTEGER VALUES       **
28362C               **  2) COMPUTE SUMMARY STATISTICS         **
28363C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
28364C               **     INSUFFICIENT SAMPLE SIZE           **
28365C               ********************************************
28366C
28367      ISTEPN='11'
28368      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLLS')
28369     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
28370C
28371      IDIST='LOST GAMES'
28372C
28373      NPERC=0
28374      MAXGRP=MAXNXT/2
28375      NMIN=2
28376      IF(NVAR.EQ.1)THEN
28377        DO1105I=1,N
28378          ITEMP=INT(Y(I)+0.5)
28379          Y(I)=REAL(ITEMP)
28380 1105   CONTINUE
28381        CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
28382        IF(IERROR.EQ.'YES')GOTO9000
28383C
28384        IFLAG=1
28385        CALL SUMRAW(Y,N,IDIST,IFLAG,
28386     1              XMEAN,XVAR,XSD,XMIN,XMAX,
28387     1              ISUBRO,IBUGA3,IERROR)
28388        IF(IERROR.EQ.'YES')GOTO9000
28389        NTOTZZ=N
28390C
28391      ELSE
28392        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
28393     1              ISUBRO,IBUGA3,IERROR)
28394        IF(IERROR.EQ.'YES')GOTO9000
28395        IFLAG1=1
28396        IFLAG2=1
28397        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
28398     1              TEMP1,TEMP2,TEMP3,MAXNXT,
28399     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
28400     1              ISUBRO,IBUGA3,IERROR)
28401        IF(IERROR.EQ.'YES')GOTO9000
28402      ENDIF
28403C
28404      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLLS')THEN
28405        WRITE(ICOUT,999)
28406        CALL DPWRST('XXX','WRIT')
28407        WRITE(ICOUT,1151)
28408 1151   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
28409        CALL DPWRST('XXX','WRIT')
28410        WRITE(ICOUT,1152)XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ
28411 1152   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ = ',5G15.7,I10)
28412        CALL DPWRST('XXX','WRIT')
28413      ENDIF
28414C
28415C               *****************************************
28416C               **  STEP 21--                          **
28417C               **  CARRY OUT CALCULATIONS             **
28418C               **  FOR LOST GAMES MLE ESTIMATION      **
28419C               *****************************************
28420C
28421      ISTEPN='21'
28422      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLLS')
28423     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
28424C
28425      RHAT=XMIN
28426      PHAT=XMEAN/(2.0*XMEAN - RHAT)
28427C
28428C               ***********************************************
28429C               **   STEP 42--                               **
28430C               **   WRITE OUT EVERYTHING                    **
28431C               **   FOR LOST GAMES MLE ESTIMATION           **
28432C               ***********************************************
28433C
28434      ISTEPN='42'
28435      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNM')
28436     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
28437C
28438C     PRINT SUMMARY STATISTICS TABLE
28439C
28440      NUMDIG=7
28441      IF(IFORSW.EQ.'1')NUMDIG=1
28442      IF(IFORSW.EQ.'2')NUMDIG=2
28443      IF(IFORSW.EQ.'3')NUMDIG=3
28444      IF(IFORSW.EQ.'4')NUMDIG=4
28445      IF(IFORSW.EQ.'5')NUMDIG=5
28446      IF(IFORSW.EQ.'6')NUMDIG=6
28447      IF(IFORSW.EQ.'7')NUMDIG=7
28448      IF(IFORSW.EQ.'8')NUMDIG=8
28449      IF(IFORSW.EQ.'9')NUMDIG=9
28450      IF(IFORSW.EQ.'0')NUMDIG=0
28451      IF(IFORSW.EQ.'E')NUMDIG=-2
28452      IF(IFORSW.EQ.'-2')NUMDIG=-2
28453      IF(IFORSW.EQ.'-3')NUMDIG=-3
28454      IF(IFORSW.EQ.'-4')NUMDIG=-4
28455      IF(IFORSW.EQ.'-5')NUMDIG=-5
28456      IF(IFORSW.EQ.'-6')NUMDIG=-6
28457      IF(IFORSW.EQ.'-7')NUMDIG=-7
28458      IF(IFORSW.EQ.'-8')NUMDIG=-8
28459      IF(IFORSW.EQ.'-9')NUMDIG=-9
28460C
28461      ITITLE='Lost Games Parameter Estimation'
28462      NCTITL=31
28463      ITITLZ=' '
28464      NCTITZ=0
28465C
28466      ICNT=1
28467      ITEXT(ICNT)='Summary Statistics:'
28468      NCTEXT(ICNT)=19
28469      AVALUE(ICNT)=0.0
28470      IDIGIT(ICNT)=-1
28471      ICNT=ICNT+1
28472      ITEXT(ICNT)='Number of Observations:'
28473      NCTEXT(ICNT)=23
28474      AVALUE(ICNT)=REAL(NTOTZZ)
28475      IDIGIT(ICNT)=0
28476      ICNT=ICNT+1
28477      ITEXT(ICNT)='Sample Mean:'
28478      NCTEXT(ICNT)=12
28479      AVALUE(ICNT)=XMEAN
28480      IDIGIT(ICNT)=NUMDIG
28481      ICNT=ICNT+1
28482      ITEXT(ICNT)='Sample Standard Deviation:'
28483      NCTEXT(ICNT)=26
28484      AVALUE(ICNT)=XSD
28485      IDIGIT(ICNT)=NUMDIG
28486      ICNT=ICNT+1
28487      ITEXT(ICNT)='Sample Minimum:'
28488      NCTEXT(ICNT)=15
28489      AVALUE(ICNT)=XMIN
28490      IDIGIT(ICNT)=NUMDIG
28491      ICNT=ICNT+1
28492      ITEXT(ICNT)='Sample Maximum:'
28493      NCTEXT(ICNT)=15
28494      AVALUE(ICNT)=XMAX
28495      IDIGIT(ICNT)=NUMDIG
28496      ICNT=ICNT+1
28497      ITEXT(ICNT)=' '
28498      NCTEXT(ICNT)=0
28499      AVALUE(ICNT)=0.0
28500      IDIGIT(ICNT)=-1
28501C
28502      ICNT=ICNT+1
28503      ITEXT(ICNT)='Maximum Likelihood Estimates:'
28504      NCTEXT(ICNT)=29
28505      AVALUE(ICNT)=0.0
28506      IDIGIT(ICNT)=-1
28507      ICNT=ICNT+1
28508      ITEXT(ICNT)='Estimate of R:'
28509      NCTEXT(ICNT)=18
28510      AVALUE(ICNT)=RHAT
28511      IDIGIT(ICNT)=NUMDIG
28512      ICNT=ICNT+1
28513      ITEXT(ICNT)='Estimate of P:'
28514      NCTEXT(ICNT)=18
28515      AVALUE(ICNT)=PHAT
28516      IDIGIT(ICNT)=NUMDIG
28517C
28518      NUMROW=ICNT
28519      DO2310I=1,NUMROW
28520        NTOT(I)=15
28521 2310 CONTINUE
28522C
28523      IFRST=.TRUE.
28524      ILAST=.TRUE.
28525      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
28526     1            AVALUE,IDIGIT,
28527     1            NTOT,NUMROW,
28528     1            ICAPSW,ICAPTY,ILAST,IFRST,
28529     1            ISUBRO,IBUGA3,IERROR)
28530C
28531C               *****************
28532C               **  STEP 90--  **
28533C               **  EXIT       **
28534C               *****************
28535C
28536 9000 CONTINUE
28537      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLS')THEN
28538        WRITE(ICOUT,999)
28539        CALL DPWRST('XXX','WRIT')
28540        WRITE(ICOUT,9011)
28541 9011   FORMAT('***** AT THE END       OF DPMLLS--')
28542        CALL DPWRST('XXX','WRIT')
28543        WRITE(ICOUT,9012)RHAT,PHAT
28544 9012   FORMAT('RHAT,PHAT = ',2G15.7)
28545        CALL DPWRST('XXX','WRIT')
28546      ENDIF
28547C
28548      RETURN
28549      END
28550      SUBROUTINE DPMLMX(Y,N,ICASPL,
28551     1                  DTEMP1,MAXNXT,
28552     1                  ALOCMO,SCALMO,SCALSE,
28553     1                  ALOCML,SCALML,
28554     1                  ICAPSW,ICAPTY,IFORSW,
28555     1                  ISUBRO,IBUGA3,IERROR)
28556C
28557C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
28558C              ESTIMATES FOR THE MAXWELL DISTRIBUTION.
28559C              NOTE THAT EITHER THE 1-PARAMETER CASE OR THE
28560C              2-PARAMETER CASE CAN BE REQUESTED.  CURRENTLY, ONLY
28561C              MOMENT ESTIMATES ARE GENERATED FOR 2-PARAMETER CASE.
28562C     EXAMPLE--MAXWELL MAXIMUM LIKELIHOOD Y
28563C              1-PARAMETER MAXWELL MAXIMUM LIKELIHOOD Y
28564C     REFERENCE--COHEN AND WHITTEN (1988), "PARAMETER ESTIMATION IN
28565C                RELIABILITY AND LIFE SPAN MODELS", MARCEL DEKKER, INC.,
28566C                CHAPTER 10.
28567C              --"CONTINUOUS UNIVARIATE DISTRIBUTIONS--VOLUME 1",
28568C                SECOND EDITION, JOHNSON, KOTZ, AND BALAKRISHNAN,
28569C                WILEY, 1994, P. 453.
28570C     WRITTEN BY--ALAN HECKERT
28571C                 STATISTICAL ENGINEERING DIVISION
28572C                 INFORMATION TECHNOLOGY LABORATORY
28573C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
28574C                 GAITHERSBURG, MD 20899-8980
28575C                 PHONE--301-975-2899
28576C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
28577C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
28578C     LANGUAGE--ANSI FORTRAN (1977)
28579C     VERSION NUMBER--2004/6
28580C     ORIGINAL VERSION--JUNE      2004.
28581C     UPDATED         --JULY      2010. EXTRACT ESTIMATION TO
28582C                                       SEPARATE SUBROUTINE
28583C     UPDATED         --JULY      2010. CALL DPDTA1 TO PRINT OUTPUT
28584C                                       (THIS ALSO ADDS RTF FORMAT
28585C                                       OUTPUT)
28586C     UPDATED         --JULY      2010. ADD LIKELIHOOD/AIC TO OUTPUT
28587C     UPDATED         --JULY      2010. DISTINGUISH BETWEEN 1-PARAMETER
28588C                                       2-PARAMETER CASES
28589C
28590C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
28591C
28592      CHARACTER*4 ICASPL
28593      CHARACTER*4 ICAPSW
28594      CHARACTER*4 ICAPTY
28595      CHARACTER*4 IFORSW
28596      CHARACTER*4 ISUBRO
28597      CHARACTER*4 IBUGA3
28598      CHARACTER*4 IERROR
28599C
28600      CHARACTER*4 IWRITE
28601      CHARACTER*4 ISUBN1
28602      CHARACTER*4 ISUBN2
28603      CHARACTER*4 ISTEPN
28604      CHARACTER*4 ICASE
28605      CHARACTER*4 INORM
28606C
28607C---------------------------------------------------------------------
28608C
28609      DIMENSION Y(*)
28610      DOUBLE PRECISION DTEMP1(*)
28611C
28612      PARAMETER (NUMALP=8)
28613      DIMENSION ALPHA(NUMALP)
28614      DIMENSION ALOWLO(NUMALP)
28615      DIMENSION AUPPLO(NUMALP)
28616      DIMENSION ALOWSC(NUMALP)
28617      DIMENSION AUPPSC(NUMALP)
28618      DIMENSION QP(1)
28619C
28620      INCLUDE 'DPCOST.INC'
28621C
28622      PARAMETER (MAXROW=30)
28623      CHARACTER*60 ITITLE
28624      CHARACTER*60 ITITLZ
28625      CHARACTER*40 ITEXT(MAXROW)
28626      REAL         AVALUE(MAXROW)
28627      INTEGER      NCTEXT(MAXROW)
28628      INTEGER      IDIGIT(MAXROW)
28629      INTEGER      NTOT(MAXROW)
28630      LOGICAL IFRST
28631      LOGICAL ILAST
28632C
28633C---------------------------------------------------------------------
28634C
28635      INCLUDE 'DPCOP2.INC'
28636C
28637      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
28638C
28639C-----START POINT-----------------------------------------------------
28640C
28641      ISUBN1='DPML'
28642      ISUBN2='MX  '
28643      IERROR='NO'
28644C
28645      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLMX')THEN
28646        WRITE(ICOUT,999)
28647  999   FORMAT(1X)
28648        CALL DPWRST('XXX','WRIT')
28649        WRITE(ICOUT,51)
28650   51   FORMAT('**** AT THE BEGINNING OF DPMLMX--')
28651        CALL DPWRST('XXX','WRIT')
28652        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,MAXNXT
28653   52   FORMAT('IBUGA3,ISUBRO,N,MAXNXT = ',2(A4,2X),2I8)
28654        CALL DPWRST('XXX','WRIT')
28655        DO56I=1,MIN(N,100)
28656          WRITE(ICOUT,57)I,Y(I)
28657   57     FORMAT('I,Y(I) = ',I8,G15.7)
28658          CALL DPWRST('XXX','WRIT')
28659   56   CONTINUE
28660      ENDIF
28661C
28662C               ********************************************
28663C               **  STEP 11--                             **
28664C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
28665C               ********************************************
28666C
28667      ISTEPN='11'
28668      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLMX')
28669     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
28670C
28671      NPERC=0
28672      NMIN=2
28673      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
28674      IF(IERROR.EQ.'YES')GOTO9000
28675C
28676C               **************************************
28677C               **  STEP 21--                       **
28678C               **  CARRY OUT CALCULATIONS FOR      **
28679C               **  MAXWELL MLE (FULL SAMPLE CASE)  **
28680C               **************************************
28681C
28682      ISTEPN='21'
28683      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLMX')
28684     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
28685C
28686      IERROR='NO'
28687      IWRITE='OFF'
28688C
28689      ICASE='2'
28690      IF(ICASPL.EQ.'1MAX')ICASE='1'
28691      CALL MAXML1(Y,N,ICASE,
28692     1            DTEMP1,
28693     1            XMEAN,XSD,XMIN,XMAX,
28694     1            ALOCML,SCALML,SCALSE,
28695     1            ALOCMO,SCALMO,
28696     1            ISUBRO,IBUGA3,IERROR)
28697      IF(ICASPL.EQ.'1MAX')THEN
28698        ALOCML=0.0
28699        CALL MAXLI1(Y,N,ICASE,
28700     1              ALOCML,SCALML,
28701     1              ALIK,AIC,AICC,BIC,
28702     1              ISUBRO,IBUGA3,IERROR)
28703        CALL MAXLI1(Y,N,ICASE,
28704     1              ALOCML,SCALMO,
28705     1              ALIKMO,AICMO,AICCMO,BICMO,
28706     1              ISUBRO,IBUGA3,IERROR)
28707      ELSE
28708CCCCC   CALL MAXLI1(Y,N,ICASE,
28709CCCCC1              ALOCML,SCALML,
28710CCCCC1              ALIK,AIC,AICC,BIC,
28711CCCCC1              ISUBRO,IBUGA3,IERROR)
28712        CALL MAXLI1(Y,N,ICASE,
28713     1              ALOCMO,SCALMO,
28714     1              ALIKMO,AICMO,AICCMO,BICMO,
28715     1              ISUBRO,IBUGA3,IERROR)
28716      ENDIF
28717C
28718      IF(ICASPL.EQ.'1MAX')THEN
28719        NU=2*N
28720        DTERM1=DBLE(N)*2.0D0*DBLE(SCALML)**2
28721        DO2120I=1,NUMALP
28722          ALP=ALPHA(I)
28723          P=1.0-(ALP/2.0)
28724          CALL CHSPPF(P,NU,PPF1)
28725          P=ALP/2.0
28726          CALL CHSPPF(P,NU,PPF2)
28727          ALOWSC(I)=SQRT(REAL(DTERM1)/PPF1)
28728          AUPPSC(I)=SQRT(REAL(DTERM1)/PPF2)
28729 2120   CONTINUE
28730      ENDIF
28731C
28732C               *************************************
28733C               **   STEP 42--                     **
28734C               **   WRITE OUT EVERYTHING          **
28735C               **   FOR MAXWELL MLE ESTIMATE      **
28736C               *************************************
28737C
28738      ISTEPN='42'
28739      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLMX')
28740     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
28741C
28742      IF(IPRINT.EQ.'OFF')GOTO9000
28743C
28744      NUMDIG=7
28745      IF(IFORSW.EQ.'1')NUMDIG=1
28746      IF(IFORSW.EQ.'2')NUMDIG=2
28747      IF(IFORSW.EQ.'3')NUMDIG=3
28748      IF(IFORSW.EQ.'4')NUMDIG=4
28749      IF(IFORSW.EQ.'5')NUMDIG=5
28750      IF(IFORSW.EQ.'6')NUMDIG=6
28751      IF(IFORSW.EQ.'7')NUMDIG=7
28752      IF(IFORSW.EQ.'8')NUMDIG=8
28753      IF(IFORSW.EQ.'9')NUMDIG=9
28754      IF(IFORSW.EQ.'0')NUMDIG=0
28755      IF(IFORSW.EQ.'E')NUMDIG=-2
28756      IF(IFORSW.EQ.'-2')NUMDIG=-2
28757      IF(IFORSW.EQ.'-3')NUMDIG=-3
28758      IF(IFORSW.EQ.'-4')NUMDIG=-4
28759      IF(IFORSW.EQ.'-5')NUMDIG=-5
28760      IF(IFORSW.EQ.'-6')NUMDIG=-6
28761      IF(IFORSW.EQ.'-7')NUMDIG=-7
28762      IF(IFORSW.EQ.'-8')NUMDIG=-8
28763      IF(IFORSW.EQ.'-9')NUMDIG=-9
28764C
28765      IF(ICASPL.EQ.'1MAX')THEN
28766        ITITLE='1-Parameter Maxwell Parameter Estimation'
28767        NCTITL=40
28768      ELSE
28769        ITITLE='2-Parameter Maxwell Parameter Estimation'
28770        NCTITL=40
28771      ENDIF
28772      ITITLZ=' '
28773      NCTITZ=0
28774      ICNT=1
28775      ITEXT(ICNT)='Summary Statistics:'
28776      NCTEXT(ICNT)=19
28777      AVALUE(ICNT)=0.0
28778      IDIGIT(ICNT)=-1
28779      ICNT=ICNT+1
28780      ITEXT(ICNT)='Number of Observations:'
28781      NCTEXT(ICNT)=23
28782      AVALUE(ICNT)=REAL(N)
28783      IDIGIT(ICNT)=0
28784      ICNT=ICNT+1
28785      ITEXT(ICNT)='Sample Mean:'
28786      NCTEXT(ICNT)=12
28787      AVALUE(ICNT)=XMEAN
28788      IDIGIT(ICNT)=NUMDIG
28789      ICNT=ICNT+1
28790      ITEXT(ICNT)='Sample Standard Deviation:'
28791      NCTEXT(ICNT)=26
28792      AVALUE(ICNT)=XSD
28793      IDIGIT(ICNT)=NUMDIG
28794      ICNT=ICNT+1
28795      ITEXT(ICNT)='Sample Minimum:'
28796      NCTEXT(ICNT)=15
28797      AVALUE(ICNT)=XMIN
28798      IDIGIT(ICNT)=NUMDIG
28799      ICNT=ICNT+1
28800      ITEXT(ICNT)='Sample Maximum:'
28801      NCTEXT(ICNT)=15
28802      AVALUE(ICNT)=XMAX
28803      IDIGIT(ICNT)=NUMDIG
28804      ICNT=ICNT+1
28805      ITEXT(ICNT)=' '
28806      NCTEXT(ICNT)=0
28807      AVALUE(ICNT)=0.0
28808      IDIGIT(ICNT)=-1
28809C
28810      ICNT=ICNT+1
28811      ITEXT(ICNT)='Moments:'
28812      NCTEXT(ICNT)=8
28813      AVALUE(ICNT)=0.0
28814      IDIGIT(ICNT)=-1
28815      IF(ICASPL.EQ.'MAXW')THEN
28816        ICNT=ICNT+1
28817        ITEXT(ICNT)='Estimate of Location:'
28818        NCTEXT(ICNT)=21
28819        AVALUE(ICNT)=ALOCMO
28820        IDIGIT(ICNT)=NUMDIG
28821      ENDIF
28822      ICNT=ICNT+1
28823      ITEXT(ICNT)='Estimate of Scale:'
28824      NCTEXT(ICNT)=18
28825      AVALUE(ICNT)=SCALMO
28826      IDIGIT(ICNT)=NUMDIG
28827      ICNT=ICNT+1
28828      ITEXT(ICNT)='Log-likelihood:'
28829      NCTEXT(ICNT)=15
28830      AVALUE(ICNT)=ALIKMO
28831      IDIGIT(ICNT)=-7
28832      ICNT=ICNT+1
28833      ITEXT(ICNT)='AIC:'
28834      NCTEXT(ICNT)=4
28835      AVALUE(ICNT)=AICMO
28836      IDIGIT(ICNT)=-7
28837      ICNT=ICNT+1
28838      ITEXT(ICNT)='AICc:'
28839      NCTEXT(ICNT)=5
28840      AVALUE(ICNT)=AICCMO
28841      IDIGIT(ICNT)=-7
28842      ICNT=ICNT+1
28843      ITEXT(ICNT)='BIC:'
28844      NCTEXT(ICNT)=4
28845      AVALUE(ICNT)=BICMO
28846      IDIGIT(ICNT)=-7
28847      ICNT=ICNT+1
28848      ITEXT(ICNT)=' '
28849      NCTEXT(ICNT)=0
28850      AVALUE(ICNT)=0.0
28851      IDIGIT(ICNT)=-1
28852C
28853      IF(ICASPL.EQ.'1MAX')THEN
28854        ICNT=ICNT+1
28855        ITEXT(ICNT)='Maximum Likelihood:'
28856        NCTEXT(ICNT)=19
28857        AVALUE(ICNT)=0.0
28858        IDIGIT(ICNT)=-1
28859C
28860CCCCC   ICNT=ICNT+1
28861CCCCC   ITEXT(ICNT)='Estimate of Location:'
28862CCCCC   NCTEXT(ICNT)=21
28863CCCCC   AVALUE(ICNT)=ALOCML
28864CCCCC   IDIGIT(ICNT)=NUMDIG
28865C
28866        ICNT=ICNT+1
28867        ITEXT(ICNT)='Estimate of Scale:'
28868        NCTEXT(ICNT)=18
28869        AVALUE(ICNT)=SCALML
28870        IDIGIT(ICNT)=NUMDIG
28871        ICNT=ICNT+1
28872        ITEXT(ICNT)='Standard Error of Scale:'
28873        NCTEXT(ICNT)=24
28874        AVALUE(ICNT)=SCALSE
28875        IDIGIT(ICNT)=NUMDIG
28876C
28877        ICNT=ICNT+1
28878        ITEXT(ICNT)='Log-likelihood:'
28879        NCTEXT(ICNT)=15
28880        AVALUE(ICNT)=ALIK
28881        IDIGIT(ICNT)=-7
28882        ICNT=ICNT+1
28883        ITEXT(ICNT)='AIC:'
28884        NCTEXT(ICNT)=4
28885        AVALUE(ICNT)=AIC
28886        IDIGIT(ICNT)=-7
28887        ICNT=ICNT+1
28888        ITEXT(ICNT)='AICc:'
28889        NCTEXT(ICNT)=5
28890        AVALUE(ICNT)=AICC
28891        IDIGIT(ICNT)=-7
28892        ICNT=ICNT+1
28893        ITEXT(ICNT)='BIC:'
28894        NCTEXT(ICNT)=4
28895        AVALUE(ICNT)=BIC
28896        IDIGIT(ICNT)=-7
28897      ENDIF
28898C
28899      NUMROW=ICNT
28900      DO2320I=1,NUMROW
28901        NTOT(I)=15
28902 2320 CONTINUE
28903C
28904      IFRST=.FALSE.
28905      ILAST=.FALSE.
28906      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
28907     1            AVALUE,IDIGIT,
28908     1            NTOT,NUMROW,
28909     1            ICAPSW,ICAPTY,ILAST,IFRST,
28910     1            ISUBRO,IBUGA3,IERROR)
28911C
28912      IF(N.GT.1 .AND. ICASPL.EQ.'1MAX')THEN
28913        INORM='OFF'
28914        ALOWLO(1)=CPUMIN
28915        CALL DPDTA7(ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,NUMALP,
28916     1              ICAPSW,ICAPTY,NUMDIG,INORM,
28917     1              ISUBRO,IBUGA3,IERROR)
28918      ENDIF
28919C
28920C               *****************
28921C               **  STEP 90--  **
28922C               **  EXIT       **
28923C               *****************
28924C
28925 9000 CONTINUE
28926      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLMX')THEN
28927        WRITE(ICOUT,999)
28928        CALL DPWRST('XXX','WRIT')
28929        WRITE(ICOUT,9011)
28930 9011   FORMAT('***** AT THE END       OF DPMLMX--')
28931        CALL DPWRST('XXX','WRIT')
28932        WRITE(ICOUT,9012)N,IBUGA3,IERROR
28933 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
28934        CALL DPWRST('XXX','WRIT')
28935        WRITE(ICOUT,9015)N
28936 9015   FORMAT('N = ',I8)
28937        CALL DPWRST('XXX','WRIT')
28938      ENDIF
28939C
28940      RETURN
28941      END
28942      SUBROUTINE DPMLLX(Y,N,
28943     1                  XTEMP,DTEMP,ITEMP,MAXNXT,
28944     1                  SCALSV,SHAPSV,
28945     1                  SCALML,SCALSE,SHAPML,SHAPSE,COVSE,
28946     1                  ICAPSW,ICAPTY,IFORSW,
28947     1                  ISUBRO,IBUGA3,IERROR)
28948C
28949C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
28950C              ESTIMATES FOR THE LOGISTIC-EXPONENTIAL DISTRIBUTION
28951C              FOR THE FULL SAMPLE CASE.
28952C     NOTE--THE MAXIMIUM LIKELIHOOD ESTIMATES ARE THE SOLUTIONS
28953C           TO THE FOLLOWING EQUATIONS:
28954C
28955C             (N/BETA) + SUM[i=1 to N][LOG(EXP(ALPHA*X(i)) - 1) -
28956C             2*SUM[i=1 to N][(EXP(ALPHA*X(I) - 1)**BETA*
28957C             LOG(EXP(ALPHA*X(i)) -1)/{1 + (EXP(ALPHA*X(i)) - 1)**BETA}
28958C             = 0
28959C
28960C             (N/ALPHA) + SUM[i=1 to N][(BETA-1)*X(i)*EXP(ALPHA*X(i))/
28961C             (EXP(ALHA*X(i)) - 1) + SUM[i=1 to N][X(i)] -
28962C             2*SUM[i=1 to N][BETA*(EXP(ALPHA*X(I) - 1)**(BETA - 1)*
28963C             X9I)*EXP(ALPHA*X(i))/{1 + (EXP(ALPHA*X(i)) - 1)**BETA}
28964C             = 0
28965C
28966C           WHERE
28967C
28968C             BETA     = SHAPE PARAMETER
28969C             ALPHA    = SCALE PARAMETER
28970C
28971C     EXAMPLE--LOGISTIC-EXPONENTIAL MAXIMUM LIKELIHOOD Y
28972C     REFERENCE--LEEMIS AND MCQUESTION (2008), "UNIVARIATE DISTRIBUTION
28973C                RELATIONSHIPS", THE AMERICAN STATISTICIAN, VOL. 62,
28974C                NO. 1, PP. 45-53.
28975C              --LAN AND LEEMIS (2007), "THE LOGISTIC-EXPONENTIAL
28976C                SURVIVAL DISTRIBUTION", TECHNICAL REPORT, THE
28977C                COLLEGE OF WILLIAM AND MARY, DEPARTMENT OF
28978C                MATHEMATICS.
28979C     WRITTEN BY--JAMES J. FILLIBEN
28980C                 STATISTICAL ENGINEERING DIVISION
28981C                 INFORMATION TECHNOLOGY LABORATORY
28982C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
28983C                 GAITHERSBURG, MD 20899-8980
28984C                 PHONE--301-975-2855
28985C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
28986C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
28987C     LANGUAGE--ANSI FORTRAN (1977)
28988C     VERSION NUMBER--2008/2
28989C     ORIGINAL VERSION--FEBRUARY  2008.
28990C
28991C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
28992C
28993      CHARACTER*4 ICAPSW
28994      CHARACTER*4 ICAPTY
28995      CHARACTER*4 IFORSW
28996C
28997      CHARACTER*4 ISUBRO
28998      CHARACTER*4 IBUGA3
28999      CHARACTER*4 IERROR
29000      CHARACTER*4 ISUBN1
29001      CHARACTER*4 ISUBN2
29002      CHARACTER*4 ISTEPN
29003C
29004C---------------------------------------------------------------------
29005C
29006      PARAMETER (NUMALP=8)
29007CCCCC DIMENSION ALPHA(NUMALP)
29008CCCCC DIMENSION ALOWSC(NUMALP)
29009CCCCC DIMENSION AUPPSC(NUMALP)
29010CCCCC DIMENSION ALOWBE(NUMALP)
29011CCCCC DIMENSION AUPPBE(NUMALP)
29012C
29013      DIMENSION QP(1)
29014CCCCC DIMENSION FISH(2,2)
29015CCCCC DIMENSION COV(2,2)
29016C
29017      DIMENSION Y(*)
29018      DIMENSION XTEMP(*)
29019      DOUBLE PRECISION DTEMP(*)
29020      INTEGER ITEMP(*)
29021C
29022      INCLUDE 'DPCOST.INC'
29023C
29024      PARAMETER (MAXROW=10)
29025      CHARACTER*60 ITITLE
29026      CHARACTER*60 ITITLZ
29027      CHARACTER*40 ITEXT(MAXROW)
29028      REAL         AVALUE(MAXROW)
29029      INTEGER      NCTEXT(MAXROW)
29030      INTEGER      IDIGIT(MAXROW)
29031      INTEGER      NTOT(MAXROW)
29032      LOGICAL IFRST
29033      LOGICAL ILAST
29034C
29035C---------------------------------------------------------------------
29036C
29037      INCLUDE 'DPCOP2.INC'
29038C
29039CCCCC DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
29040C
29041C-----START POINT-----------------------------------------------------
29042C
29043      ISUBN1='DPML'
29044      ISUBN2='LX  '
29045      IERROR='NO'
29046C
29047      SCALSE=CPUMIN
29048      SHAPSE=CPUMIN
29049      COVSE=CPUMIN
29050C
29051      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLX')THEN
29052        WRITE(ICOUT,999)
29053  999   FORMAT(1X)
29054        CALL DPWRST('XXX','WRIT')
29055        WRITE(ICOUT,51)
29056   51   FORMAT('**** AT THE BEGINNING OF DPMLLX--')
29057        CALL DPWRST('XXX','WRIT')
29058        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,MAXNXT,ITEMP(1)
29059   52   FORMAT('IBUGA3,ISUBRO,N,MAXNXT,ITEMP(1) = ',2(A4,2X),3I8)
29060        CALL DPWRST('XXX','WRIT')
29061        WRITE(ICOUT,55)N,SCALSV,SHAPSV
29062   55   FORMAT('N,SCALSV,SHAPSV = ',I8,2G15.7)
29063        CALL DPWRST('XXX','WRIT')
29064        DO56I=1,MIN(N,100)
29065          WRITE(ICOUT,57)I,Y(I)
29066   57     FORMAT('I,Y(I) = ',I8,G15.7)
29067          CALL DPWRST('XXX','WRIT')
29068   56   CONTINUE
29069      ENDIF
29070C
29071C               *************************************
29072C               **  STEP 21--                      **
29073C               **  CARRY OUT CALCULATIONS         **
29074C               **  FOR LOGISTIC-EXPONENTIAL MLE   **
29075C               **  ESTIMATE (FULL SAMPLE CASE)    **
29076C               *************************************
29077C
29078      ISTEPN='21'
29079      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLX')
29080     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
29081C
29082      NMIN=3
29083      NPERC=0
29084      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
29085      IF(IERROR.EQ.'YES')GOTO9000
29086C
29087      CALL LEXML1(Y,N,MAXNXT,
29088     1            XTEMP,DTEMP,
29089     1            XMEAN,XSD,XVAR,XMIN,XMAX,XSUM,
29090     1            SCALSV,SHAPSV,SCALML,SHAPML,
29091     1            ISUBRO,IBUGA3,IERROR)
29092C
29093C  COMPUTE STANDARD ERRORS
29094C
29095CCCCC DN=DBLE(N)
29096CCCCC DALPHA=XPAR(2)
29097CCCCC DBETA=DBLE(BETAML)
29098C
29099CCCCC DSUM1=0.0D0
29100CCCCC DSUM2=0.0D0
29101CCCCC DO2160I=1,N
29102C
29103CCCCC   DX=DBLE(Y(I))
29104CCCCC   DA=DLOG(DX)
29105CCCCC   DB=(DALPHA*DX)**DBETA
29106CCCCC   DC=DLOG(DALPHA*DX)
29107C
29108CCCCC   DTERM1=(DC**2)*DB
29109CCCCC   DSUM1=DSUM1 + DTERM1*(DB+1.0D0)*DEXP(DB)
29110CCCCC   DSUM2=DSUM2 + DTERM1
29111C
29112C2160 CONTINUE
29113C
29114CCCCC DTERM1=-DN/DBETA**2
29115CCCCC FISH(1,1)=-REAL(DTERM1 - DSUM1 + DSUM2)
29116C
29117CCCCC DSUM1=0.0D0
29118CCCCC DSUM2=0.0D0
29119CCCCC DO2170I=1,N
29120C
29121CCCCC   DX=DBLE(Y(I))
29122CCCCC   DA=DLOG(DX)
29123CCCCC   DB=(DALPHA*DX)**DBETA
29124CCCCC   DC=DLOG(DALPHA*DX)
29125C
29126CCCCC   DSUM1=DSUM1 + DEXP(DB)*((DBETA-1.0D0)*DB + DB**2*DBETA)
29127CCCCC   DSUM2=DSUM2 + DB
29128C
29129C2170 CONTINUE
29130C
29131CCCCC DTERM1=-DBETA*DN/DALPHA**2
29132CCCCC DTERM2=DBETA/DALPHA**2
29133CCCCC DTERM3=DBETA*(DBETA-1.0D0)/DALPHA**2
29134CCCCC FISH(2,2)=-REAL(DTERM1 - DTERM2*DSUM1 + DTERM3*DSUM2)
29135C
29136CCCCC DSUM1=0.0D0
29137CCCCC DSUM2=0.0D0
29138CCCCC DO2180I=1,N
29139C
29140CCCCC   DX=DBLE(Y(I))
29141CCCCC   DA=DLOG(DX)
29142CCCCC   DB=(DALPHA*DX)**DBETA
29143CCCCC   DC=DLOG(DALPHA*DX)
29144C
29145CCCCC   DSUM1=DSUM1 + DB*DEXP(DB)*(1.0D0 + DBETA*DLOG(DALPHA) +
29146CCCCC1                DBETA*DA + DBETA*DB*DC)
29147CCCCC   DSUM2=DSUM2 + DB*(1.0D0 + DBETA*DLOG(DALPHA) + DBETA*DA)
29148C
29149C2180 CONTINUE
29150C
29151CCCCC DTERM1=DN/DALPHA
29152CCCCC DTERM2=1.0D0/DALPHA
29153CCCCC FISH(1,2)=-REAL(DTERM1 - DTERM2*DSUM1 + DTERM2*DSUM2)
29154CCCCC FISH(2,1)=FISH(1,2)
29155C
29156CCCCC CALL SGECO(FISH,2,2,ITEMP,RCOND,XTEMP)
29157CCCCC IJOB=1
29158CCCCC CALL SGEDI(FISH,2,2,ITEMP,XTEMP,XTEMP(MAXNXT/2),IJOB)
29159CCCCC DO2810J=1,3
29160CCCCC   DO2815I=1,3
29161CCCCC     COV(I,J)=FISH(I,J)
29162C2815   CONTINUE
29163C2810 CONTINUE
29164C
29165CCCCC BETASE=SQRT(COV(1,1))
29166CCCCC ALPHSE=SQRT(COV(2,2))
29167CCCCC COVSE=COV(2,1)
29168C
29169C  CONFIDENCE INTERVALS FOR PARAMETERS BASED ON NORMAL
29170C  APPROXIMATION.
29171C
29172CCCCC DO2220I=1,NUMALP
29173CCCCC   ALP=ALPHA(I)
29174CCCCC   P=1.0-(ALP/2.0)
29175CCCCC   CALL NORPPF(P,PPF)
29176CCCCC   ALOWSC(I)=ALPHML - PPF*ALPHSE
29177CCCCC   AUPPSC(I)=ALPHML + PPF*ALPHSE
29178CCCCC   ALOWBE(I)=BETAML - PPF*BETASE
29179CCCCC   AUPPBE(I)=BETAML + PPF*BETASE
29180C2220 CONTINUE
29181C
29182C               ***********************************************
29183C               **   STEP 42--                              **
29184C               **   WRITE OUT EVERYTHING                   **
29185C               **   FOR LOGISTIC-EXPONENTIAL MLE ESTIMATE  **
29186C               **********************************************
29187C
29188      ISTEPN='42'
29189      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLX')
29190     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
29191C
29192C     PRINT SUMMARY STATISTICS TABLE
29193C
29194      IF(IPRINT.EQ.'OFF')GOTO9000
29195C
29196      NUMDIG=7
29197      IF(IFORSW.EQ.'1')NUMDIG=1
29198      IF(IFORSW.EQ.'2')NUMDIG=2
29199      IF(IFORSW.EQ.'3')NUMDIG=3
29200      IF(IFORSW.EQ.'4')NUMDIG=4
29201      IF(IFORSW.EQ.'5')NUMDIG=5
29202      IF(IFORSW.EQ.'6')NUMDIG=6
29203      IF(IFORSW.EQ.'7')NUMDIG=7
29204      IF(IFORSW.EQ.'8')NUMDIG=8
29205      IF(IFORSW.EQ.'9')NUMDIG=9
29206      IF(IFORSW.EQ.'0')NUMDIG=0
29207      IF(IFORSW.EQ.'E')NUMDIG=-2
29208      IF(IFORSW.EQ.'-2')NUMDIG=-2
29209      IF(IFORSW.EQ.'-3')NUMDIG=-3
29210      IF(IFORSW.EQ.'-4')NUMDIG=-4
29211      IF(IFORSW.EQ.'-5')NUMDIG=-5
29212      IF(IFORSW.EQ.'-6')NUMDIG=-6
29213      IF(IFORSW.EQ.'-7')NUMDIG=-7
29214      IF(IFORSW.EQ.'-8')NUMDIG=-8
29215      IF(IFORSW.EQ.'-9')NUMDIG=-9
29216C
29217      ITITLE='Two-Parameter Logistic Exponential Parameter Estimation'
29218      NCTITL=55
29219      ITITLZ='Full Sample Case'
29220      NCTITZ=16
29221      ITEXT(1)='Summary Statistics:'
29222      NCTEXT(1)=19
29223      AVALUE(1)=0.0
29224      IDIGIT(1)=0
29225      ITEXT(2)='Number of Observations:'
29226      NCTEXT(2)=23
29227      AVALUE(2)=REAL(N)
29228      IDIGIT(2)=0
29229      ITEXT(3)='Sample Mean:'
29230      NCTEXT(3)=12
29231      AVALUE(3)=XMEAN
29232      IDIGIT(3)=NUMDIG
29233      ITEXT(4)='Sample Standard Deviation:'
29234      NCTEXT(4)=26
29235      AVALUE(4)=XSD
29236      IDIGIT(4)=NUMDIG
29237      ITEXT(5)='Sample Minimum:'
29238      NCTEXT(5)=15
29239      AVALUE(5)=XMIN
29240      IDIGIT(5)=NUMDIG
29241      ITEXT(6)='Sample Maximum:'
29242      NCTEXT(6)=15
29243      AVALUE(6)=XMAX
29244      IDIGIT(6)=NUMDIG
29245      NUMROW=6
29246      DO2310I=1,NUMROW
29247        NTOT(I)=15
29248 2310 CONTINUE
29249      NTOT(2)=8
29250C
29251      IFRST=.TRUE.
29252      ILAST=.FALSE.
29253      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
29254     1            NCTEXT,AVALUE,IDIGIT,
29255     1            NTOT,NUMROW,
29256     1            ICAPSW,ICAPTY,ILAST,IFRST,
29257     1            ISUBRO,IBUGA3,IERROR)
29258      IFRST=.FALSE.
29259      ITITLE=' '
29260      NCTITL=0
29261C
29262      ITEXT(1)='Maximum Likelihood:'
29263      NCTEXT(1)=19
29264      AVALUE(1)=0.0
29265      IDIGIT(1)=-1
29266      ITEXT(2)='Estimate of Shape (Beta):'
29267      NCTEXT(2)=25
29268      AVALUE(2)=SHAPML
29269      IDIGIT(2)=NUMDIG
29270      ITEXT(3)='Estimate of Scale:'
29271      NCTEXT(3)=18
29272      AVALUE(3)=SCALML
29273      IDIGIT(3)=NUMDIG
29274C
29275      ICNT=3
29276C
29277CCCCC ICNT=ICNT+1
29278CCCCC ITEXT(ICNT)='Log-likelihood:'
29279CCCCC NCTEXT(ICNT)=15
29280CCCCC AVALUE(ICNT)=ALIK
29281CCCCC IDIGIT(ICNT)=-7
29282CCCCC ICNT=ICNT+1
29283CCCCC ITEXT(ICNT)='AIC:'
29284CCCCC NCTEXT(ICNT)=4
29285CCCCC AVALUE(ICNT)=AIC
29286CCCCC IDIGIT(ICNT)=-7
29287CCCCC ICNT=ICNT+1
29288CCCCC ITEXT(ICNT)='AICc:'
29289CCCCC NCTEXT(ICNT)=5
29290CCCCC AVALUE(ICNT)=AICC
29291CCCCC IDIGIT(ICNT)=-7
29292CCCCC ICNT=ICNT+1
29293CCCCC ITEXT(ICNT)='BIC:'
29294CCCCC NCTEXT(ICNT)=4
29295CCCCC AVALUE(ICNT)=BIC
29296CCCCC IDIGIT(ICNT)=-7
29297C
29298      NUMROW=ICNT
29299      DO2320I=1,NUMROW
29300        NTOT(I)=15
29301 2320 CONTINUE
29302C
29303      IFRST=.FALSE.
29304      ILAST=.FALSE.
29305      ITITLZ=' '
29306      NCTITZ=0
29307      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
29308     1            AVALUE,IDIGIT,
29309     1            NTOT,NUMROW,
29310     1            ICAPSW,ICAPTY,ILAST,IFRST,
29311     1            ISUBRO,IBUGA3,IERROR)
29312C
29313C               *****************
29314C               **  STEP 90--  **
29315C               **  EXIT       **
29316C               *****************
29317C
29318 9000 CONTINUE
29319      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLX')THEN
29320        WRITE(ICOUT,999)
29321        CALL DPWRST('XXX','WRIT')
29322        WRITE(ICOUT,9011)
29323 9011   FORMAT('***** AT THE END       OF DPMLLX--')
29324        CALL DPWRST('XXX','WRIT')
29325      ENDIF
29326C
29327      RETURN
29328      END
29329      SUBROUTINE DPMLN1(Y,N,ICASE,
29330     1                  QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,NPERC,
29331     1                  XMEAN,XSD,XSDMEA,XSDSD,
29332     1                  AIC,AICC,BIC,ALIKE,
29333     1                  ICAPSW,ICAPTY,IFORSW,
29334     1                  IOUNI1,IOUNI2,ALPHAP,
29335     1                  ISUBRO,IBUGA3,IERROR)
29336C
29337C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
29338C              ESTIMATES FOR NORMAL DISTRIBUTION.  THIS SUBROUTINE
29339C              COMPUTES THE UNGROUPED AND UNCENSORED CASE.
29340C     EXAMPLE--NORMAL MAXIMUM LIKELIHOOD Y
29341C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN ENGINEERING",
29342C                CAMBRIDGE UNIVERSITY PRESS, 1999, CHAPTER 10.
29343C     WRITTEN BY--ALAN HECKERT
29344C                 STATISTICAL ENGINEERING DIVISION
29345C                 INFORMATION TECHNOLOGY LABORATORY
29346C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
29347C                 GAITHERSBURG, MD 20899-8980
29348C                 PHONE--301-975-2899
29349C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
29350C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
29351C     LANGUAGE--ANSI FORTRAN (1977)
29352C     VERSION NUMBER--2009/8
29353C     ORIGINAL VERSION--AUGUST    2009. EXTRACTED FROM DPMLNO
29354C
29355C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
29356C
29357      CHARACTER*4 ICAPSW
29358      CHARACTER*4 ICAPTY
29359      CHARACTER*4 IFORSW
29360      CHARACTER*4 ISUBRO
29361      CHARACTER*4 IBUGA3
29362      CHARACTER*4 IERROR
29363C
29364      CHARACTER*4 IWRITE
29365      CHARACTER*4 ILIKFL
29366      CHARACTER*4 INORM
29367      CHARACTER*4 ISUBN1
29368      CHARACTER*4 ISUBN2
29369      CHARACTER*4 ISTEPN
29370C
29371C---------------------------------------------------------------------
29372C
29373      DIMENSION Y(*)
29374      DIMENSION QP(*)
29375      DIMENSION XQPHAT(*)
29376      DIMENSION XQPSE(*)
29377      DIMENSION XQPLCL(*)
29378      DIMENSION XQPUCL(*)
29379C
29380      PARAMETER (NUMALP=8)
29381      DIMENSION ALPHA(NUMALP)
29382      DIMENSION ALOWSC(NUMALP)
29383      DIMENSION AUPPSC(NUMALP)
29384      DIMENSION ALOWLO(NUMALP)
29385      DIMENSION AUPPLO(NUMALP)
29386C
29387      INCLUDE 'DPCOST.INC'
29388C
29389      PARAMETER (MAXROW=50)
29390      CHARACTER*60 ITITLE
29391      CHARACTER*1  ITITLZ
29392      CHARACTER*40 ITEXT(MAXROW)
29393      REAL         AVALUE(MAXROW)
29394      INTEGER      NCTEXT(MAXROW)
29395      INTEGER      IDIGIT(MAXROW)
29396      INTEGER      NTOT(MAXROW)
29397      LOGICAL IFRST
29398      LOGICAL ILAST
29399C
29400C---------------------------------------------------------------------
29401C
29402      INCLUDE 'DPCOP2.INC'
29403C
29404      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
29405C
29406C-----START POINT-----------------------------------------------------
29407C
29408      ISUBN1='DPML'
29409      ISUBN2='N1  '
29410      IERROR='NO'
29411C
29412      ALIKE=CPUMIN
29413C
29414      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLN1')THEN
29415        WRITE(ICOUT,999)
29416  999   FORMAT(1X)
29417        CALL DPWRST('XXX','WRIT')
29418        WRITE(ICOUT,51)
29419   51   FORMAT('**** AT THE BEGINNING OF DPMLN1--')
29420        CALL DPWRST('XXX','WRIT')
29421        WRITE(ICOUT,52)IBUGA3
29422   52   FORMAT('IBUGA3 = ',A4)
29423        CALL DPWRST('XXX','WRIT')
29424        WRITE(ICOUT,55)N,NUMV,NPERC,IOUNI2
29425   55   FORMAT('N,NUMV,NPERC,IOUNI2 = ',4I8)
29426        CALL DPWRST('XXX','WRIT')
29427        DO56I=1,MIN(N,100)
29428          WRITE(ICOUT,57)I,Y(I)
29429   57     FORMAT('I,Y(I) = ',I8,G15.7)
29430          CALL DPWRST('XXX','WRIT')
29431   56   CONTINUE
29432        IF(NPERC.GT.0)THEN
29433          DO66I=1,NPERC
29434            WRITE(ICOUT,67)I,QP(I)
29435   67       FORMAT('I,QP(I) = ',I8,G15.7)
29436            CALL DPWRST('XXX','WRIT')
29437   66     CONTINUE
29438        ENDIF
29439      ENDIF
29440C
29441C               ********************************************
29442C               **  STEP 11--                             **
29443C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
29444C               ********************************************
29445C
29446      ISTEPN='11'
29447      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLN1')
29448     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
29449C
29450      NMIN=2
29451      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
29452      IF(IERROR.EQ.'YES')GOTO9000
29453C
29454C               ******************************
29455C               **  STEP 2--                **
29456C               **  CARRY OUT CALCULATIONS  **
29457C               **  FOR NORMAL MLE ESTIMATE **
29458C               ******************************
29459C
29460      ISTEPN='2'
29461      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLN1')
29462     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
29463C
29464      IERROR='NO'
29465      IWRITE='OFF'
29466      AN=REAL(N)
29467C
29468      CALL NORML1(Y,N,ICASE,
29469     1            ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,NUMALP,NUMOUT,
29470     1            XMEAN,XSD,XVAR,XMIN,XMAX,XSDMEA,XSDSD,
29471     1            ISUBRO,IBUGA3,IERROR)
29472C
29473      CALL NORLI1(Y,N,XMEAN,XSD,
29474     1            ALIKE,AIC,AICC,BIC,
29475     1            ISUBRO,IBUGA3,IERROR)
29476C
29477C               **********************************************
29478C               **  STEP 3--                                **
29479C               **  ESTIMATE CONFIDENCE LIMITS FOR SELECTED **
29480C               **  PERCENTILES.  FOR FULL SAMPLE CASE,     **
29481C               **  PERCENTILE ESTIMATES BASED ON           **
29482C               **  NON-CENTRAL T DISTRIBUTION.             **
29483C               **********************************************
29484C
29485      ISTEPN='3'
29486      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLN1')
29487     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
29488C
29489      IF(NPERC.GE.1)THEN
29490C
29491        CALL NORPE1(Y,N,NPERC,XMEAN,XSD,IOUNI1,IDTYPR,
29492     1              QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,
29493     1              ALPHAP,NUMALP,
29494     1              ISUBRO,IBUGA3,IERROR)
29495      ENDIF
29496C
29497C               *********************************
29498C               **   STEP 42--                 **
29499C               **   WRITE OUT EVERYTHING      **
29500C               **   FOR NORMAL MLE ESTIMATE   **
29501C               **********************************
29502C
29503      ISTEPN='42'
29504      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLN1')
29505     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
29506C
29507C     PRINT SUMMARY STATISTICS TABLE
29508C
29509      IF(IPRINT.EQ.'OFF')GOTO9000
29510C
29511      NUMDIG=7
29512      IF(IFORSW.EQ.'1')NUMDIG=1
29513      IF(IFORSW.EQ.'2')NUMDIG=2
29514      IF(IFORSW.EQ.'3')NUMDIG=3
29515      IF(IFORSW.EQ.'4')NUMDIG=4
29516      IF(IFORSW.EQ.'5')NUMDIG=5
29517      IF(IFORSW.EQ.'6')NUMDIG=6
29518      IF(IFORSW.EQ.'7')NUMDIG=7
29519      IF(IFORSW.EQ.'8')NUMDIG=8
29520      IF(IFORSW.EQ.'9')NUMDIG=9
29521      IF(IFORSW.EQ.'0')NUMDIG=0
29522      IF(IFORSW.EQ.'E')NUMDIG=-2
29523      IF(IFORSW.EQ.'-2')NUMDIG=-2
29524      IF(IFORSW.EQ.'-3')NUMDIG=-3
29525      IF(IFORSW.EQ.'-4')NUMDIG=-4
29526      IF(IFORSW.EQ.'-5')NUMDIG=-5
29527      IF(IFORSW.EQ.'-6')NUMDIG=-6
29528      IF(IFORSW.EQ.'-7')NUMDIG=-7
29529      IF(IFORSW.EQ.'-8')NUMDIG=-8
29530      IF(IFORSW.EQ.'-9')NUMDIG=-9
29531C
29532      ITITLE='Normal Parameter Estimation'
29533      NCTITL=27
29534      ITEXT(1)='Summary Statistics:'
29535      NCTEXT(1)=19
29536      AVALUE(1)=0.0
29537      IDIGIT(1)=-1
29538      ITEXT(2)='Number of Observations:'
29539      NCTEXT(2)=23
29540      AVALUE(2)=REAL(N)
29541      IDIGIT(2)=0
29542      ITEXT(3)='Sample Minimum:'
29543      NCTEXT(3)=15
29544      AVALUE(3)=XMIN
29545      IDIGIT(3)=NUMDIG
29546      ITEXT(4)='Sample Maximum:'
29547      NCTEXT(4)=15
29548      AVALUE(4)=XMAX
29549      IDIGIT(4)=NUMDIG
29550      NUMROW=4
29551      DO2310I=1,NUMROW
29552        NTOT(I)=15
29553 2310 CONTINUE
29554C
29555      IFRST=.TRUE.
29556      ILAST=.TRUE.
29557      NCTITZ=0
29558      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
29559     1            NCTEXT,AVALUE,IDIGIT,
29560     1            NTOT,NUMROW,
29561     1            ICAPSW,ICAPTY,ILAST,IFRST,
29562     1            ISUBRO,IBUGA3,IERROR)
29563      IFRST=.FALSE.
29564      ITITLE=' '
29565      NCTITL=0
29566C
29567      ITEXT(1)='Maximum Likelihood:'
29568      NCTEXT(1)=19
29569      AVALUE(1)=0.0
29570      IDIGIT(1)=-1
29571      ITEXT(2)='Estimate of Location (Mean):'
29572      NCTEXT(2)=28
29573      AVALUE(2)=XMEAN
29574      IDIGIT(2)=NUMDIG
29575      ITEXT(3)='Standard Error of Location:'
29576      NCTEXT(3)=27
29577      AVALUE(3)=XSDMEA
29578      IDIGIT(3)=NUMDIG
29579      ICNT=3
29580      ITEXT(4)='Estimate of Scale (SD):'
29581      NCTEXT(4)=28
29582      AVALUE(4)=XSD
29583      IDIGIT(4)=NUMDIG
29584      ITEXT(5)='Standard Error of Scale:'
29585      NCTEXT(5)=24
29586      AVALUE(5)=XSDSD
29587      IDIGIT(5)=NUMDIG
29588      ICNT=5
29589      ICNT=ICNT+1
29590      ITEXT(ICNT)='Log-likelihood:'
29591      NCTEXT(ICNT)=15
29592      AVALUE(ICNT)=ALIKE
29593      IDIGIT(ICNT)=-7
29594      ICNT=ICNT+1
29595      ITEXT(ICNT)='AIC:'
29596      NCTEXT(ICNT)=4
29597      AVALUE(ICNT)=AIC
29598      IDIGIT(ICNT)=-7
29599      ICNT=ICNT+1
29600      ITEXT(ICNT)='AICc:'
29601      NCTEXT(ICNT)=5
29602      AVALUE(ICNT)=AICC
29603      IDIGIT(ICNT)=-7
29604      ICNT=ICNT+1
29605      ITEXT(ICNT)='BIC:'
29606      NCTEXT(ICNT)=4
29607      AVALUE(ICNT)=BIC
29608      IDIGIT(ICNT)=-7
29609      NUMROW=ICNT
29610      DO2320I=1,NUMROW
29611        NTOT(I)=15
29612 2320 CONTINUE
29613C
29614      IFRST=.TRUE.
29615      ILAST=.TRUE.
29616      NCTITZ=0
29617      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
29618     1            AVALUE,IDIGIT,
29619     1            NTOT,NUMROW,
29620     1            ICAPSW,ICAPTY,ILAST,IFRST,
29621     1            ISUBRO,IBUGA3,IERROR)
29622C
29623      IF(NUMOUT.GT.1)THEN
29624        INORM='YES'
29625        CALL DPDTA7(ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,NUMALP,
29626     1              ICAPSW,ICAPTY,NUMDIG,INORM,
29627     1              ISUBRO,IBUGA3,IERROR)
29628      ENDIF
29629C
29630      IF(NPERC.GT.1)THEN
29631        ILIKFL='OFF'
29632CCCCC   XQPSE(1)=CPUMIN
29633        CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
29634     1              ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
29635     1              ISUBRO,IBUGA3,IERROR)
29636
29637      ENDIF
29638C
29639C               *****************
29640C               **  STEP 90--  **
29641C               **  EXIT       **
29642C               *****************
29643C
29644 9000 CONTINUE
29645      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLN1')THEN
29646        WRITE(ICOUT,999)
29647        CALL DPWRST('XXX','WRIT')
29648        WRITE(ICOUT,9011)
29649 9011   FORMAT('***** AT THE END       OF DPMLN1--')
29650        CALL DPWRST('XXX','WRIT')
29651        WRITE(ICOUT,9012)N,IBUGA3,IERROR
29652 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
29653        CALL DPWRST('XXX','WRIT')
29654      ENDIF
29655C
29656      RETURN
29657      END
29658      SUBROUTINE DPMLN2(Y,X,N,
29659     1                  XTEMP,DTEMP1,ITEMP1,MAXNXT,
29660     1                  QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,NPERC,
29661     1                  XMEAN,XSD,
29662     1                  AIC,AICC,BIC,ALIKE,
29663     1                  ICAPSW,ICAPTY,IFORSW,
29664     1                  IOUNI1,IOUNI2,ALPHAP,
29665     1                  ISUBRO,IBUGA3,IERROR)
29666C
29667C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
29668C              ESTIMATES FOR NORMAL DISTRIBUTION.  THIS SUBROUTINE
29669C              COMPUTES THE UNGROUPED AND MULTIPLY RIGHT CENSORED
29670C              CASE.
29671C     EXAMPLE--NORMAL MAXIMUM LIKELIHOOD Y X
29672C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN ENGINEERING",
29673C                CAMBRIDGE UNIVERSITY PRESS, 1999, CHAPTER 10.
29674C              --CLIFFORD COHEN, "TRUNCATED AND CENSORED SAMPLES:
29675C                THEORY AND APPLICATIONS", DEKKER, 1991.
29676C     WRITTEN BY--ALAN HECKERT
29677C                 STATISTICAL ENGINEERING DIVISION
29678C                 INFORMATION TECHNOLOGY LABORATORY
29679C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
29680C                 GAITHERSBURG, MD 20899-8980
29681C                 PHONE--301-975-2899
29682C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
29683C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
29684C     LANGUAGE--ANSI FORTRAN (1977)
29685C     VERSION NUMBER--2009/8
29686C     ORIGINAL VERSION--SEPTEMBER 2009. EXTRACTED FROM DPMLNO
29687C
29688C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
29689C
29690      CHARACTER*4 ICAPSW
29691      CHARACTER*4 ICAPTY
29692      CHARACTER*4 IFORSW
29693      CHARACTER*4 ISUBRO
29694      CHARACTER*4 IBUGA3
29695      CHARACTER*4 IERROR
29696C
29697      CHARACTER*4 IWRITE
29698      CHARACTER*4 ILIKFL
29699      CHARACTER*4 INORM
29700      CHARACTER*4 ISUBN1
29701      CHARACTER*4 ISUBN2
29702      CHARACTER*4 ISTEPN
29703C
29704C---------------------------------------------------------------------
29705C
29706      DIMENSION Y(*)
29707      DIMENSION X(*)
29708      DIMENSION XTEMP(*)
29709      DIMENSION QP(*)
29710      DIMENSION XQPHAT(*)
29711      DIMENSION XQPSE(*)
29712      DIMENSION XQPLCL(*)
29713      DIMENSION XQPUCL(*)
29714      INTEGER          ITEMP1(*)
29715      DOUBLE PRECISION DTEMP1(*)
29716C
29717      PARAMETER (NUMALP=8)
29718      DIMENSION ALPHA(NUMALP)
29719      DIMENSION ALOWSC(NUMALP)
29720      DIMENSION AUPPSC(NUMALP)
29721      DIMENSION ALOWLO(NUMALP)
29722      DIMENSION AUPPLO(NUMALP)
29723C
29724      DIMENSION COV(2,2)
29725C
29726      INCLUDE 'DPCOST.INC'
29727C
29728      PARAMETER (MAXROW=50)
29729      CHARACTER*60 ITITLE
29730      CHARACTER*1  ITITLZ
29731      CHARACTER*40 ITEXT(MAXROW)
29732      REAL         AVALUE(MAXROW)
29733      INTEGER      NCTEXT(MAXROW)
29734      INTEGER      IDIGIT(MAXROW)
29735      INTEGER      NTOT(MAXROW)
29736      LOGICAL IFRST
29737      LOGICAL ILAST
29738C
29739C---------------------------------------------------------------------
29740C
29741      INCLUDE 'DPCOP2.INC'
29742C
29743      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
29744C
29745C-----START POINT-----------------------------------------------------
29746C
29747      ISUBN1='DPML'
29748      ISUBN2='N2  '
29749      IERROR='NO'
29750C
29751      ALIKE=CPUMIN
29752C
29753      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLN2')THEN
29754        WRITE(ICOUT,999)
29755  999   FORMAT(1X)
29756        CALL DPWRST('XXX','WRIT')
29757        WRITE(ICOUT,51)
29758   51   FORMAT('**** AT THE BEGINNING OF DPMLN2--')
29759        CALL DPWRST('XXX','WRIT')
29760        WRITE(ICOUT,52)IBUGA3
29761   52   FORMAT('IBUGA3 = ',A4)
29762        CALL DPWRST('XXX','WRIT')
29763        WRITE(ICOUT,55)N,NUMV,NPERC
29764   55   FORMAT('N,NUMV,NPERC = ',3I8)
29765        CALL DPWRST('XXX','WRIT')
29766        DO56I=1,MIN(N,100)
29767          WRITE(ICOUT,57)I,Y(I),X(I)
29768   57     FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
29769          CALL DPWRST('XXX','WRIT')
29770   56   CONTINUE
29771        IF(NPERC.GT.0)THEN
29772          DO66I=1,NPERC
29773            WRITE(ICOUT,67)I,QP(I)
29774   67       FORMAT('I,QP(I) = ',I8,G15.7)
29775            CALL DPWRST('XXX','WRIT')
29776   66     CONTINUE
29777        ENDIF
29778      ENDIF
29779C
29780C               ********************************************
29781C               **  STEP 11--                             **
29782C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
29783C               ********************************************
29784C
29785      ISTEPN='11'
29786      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLN2')
29787     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
29788C
29789      NMIN=2
29790      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
29791      IF(IERROR.EQ.'YES')GOTO9000
29792C
29793C               ******************************
29794C               **  STEP 2--                **
29795C               **  CARRY OUT CALCULATIONS  **
29796C               **  FOR NORMAL MLE ESTIMATE **
29797C               ******************************
29798C
29799      ISTEPN='2'
29800      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLN2')
29801     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
29802C
29803      IERROR='NO'
29804      IWRITE='OFF'
29805      AN=REAL(N)
29806C
29807      CALL NORML2(Y,X,N,IR,
29808     1            XTEMP,DTEMP1,ITEMP1,MAXNXT,IOUNI2,
29809     1            ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,NUMALP,NUMOUT,
29810     1            XMEAN,XSD,XVAR,XMIN,XMAX,XSDMEA,XSDSD,XCOV,COV,
29811     1            ISUBRO,IBUGA3,IERROR)
29812C
29813      CALL NORLI2(Y,X,N,IR,XMEAN,XSD,
29814     1            ALIKE,AIC,AICC,BIC,
29815     1            ISUBRO,IBUGA3,IERROR)
29816C
29817C               **********************************************
29818C               **  STEP 3--                                **
29819C               **  ESTIMATE CONFIDENCE LIMITS FOR SELECTED **
29820C               **  PERCENTILES.                            **
29821C               **********************************************
29822C
29823      ISTEPN='3'
29824      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLN2')
29825     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
29826C
29827      IF(NPERC.GE.1)THEN
29828C
29829        CALL NORPE2(Y,X,N,IR,NPERC,IDTYPR,
29830     1              XMEAN,XSD,COV,IOUNI1,
29831     1              QP,XQPHAT,XQPLCL,XQPUCL,
29832     1              ALPHAP,NUMALP,
29833     1              ISUBRO,IBUGA3,IERROR)
29834      ENDIF
29835C
29836C               **************************************
29837C               **   STEP 42--                      **
29838C               **   WRITE OUT EVERYTHING FOR       **
29839C               **   CENSORED NORMAL MLE ESTIMATE   **
29840C               **************************************
29841C
29842      ISTEPN='42'
29843      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLN2')
29844     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
29845C
29846C     PRINT SUMMARY STATISTICS TABLE
29847C
29848      IF(IPRINT.EQ.'OFF')GOTO9000
29849C
29850      NUMDIG=7
29851      IF(IFORSW.EQ.'1')NUMDIG=1
29852      IF(IFORSW.EQ.'2')NUMDIG=2
29853      IF(IFORSW.EQ.'3')NUMDIG=3
29854      IF(IFORSW.EQ.'4')NUMDIG=4
29855      IF(IFORSW.EQ.'5')NUMDIG=5
29856      IF(IFORSW.EQ.'6')NUMDIG=6
29857      IF(IFORSW.EQ.'7')NUMDIG=7
29858      IF(IFORSW.EQ.'8')NUMDIG=8
29859      IF(IFORSW.EQ.'9')NUMDIG=9
29860      IF(IFORSW.EQ.'0')NUMDIG=0
29861      IF(IFORSW.EQ.'E')NUMDIG=-2
29862      IF(IFORSW.EQ.'-2')NUMDIG=-2
29863      IF(IFORSW.EQ.'-3')NUMDIG=-3
29864      IF(IFORSW.EQ.'-4')NUMDIG=-4
29865      IF(IFORSW.EQ.'-5')NUMDIG=-5
29866      IF(IFORSW.EQ.'-6')NUMDIG=-6
29867      IF(IFORSW.EQ.'-7')NUMDIG=-7
29868      IF(IFORSW.EQ.'-8')NUMDIG=-8
29869      IF(IFORSW.EQ.'-9')NUMDIG=-9
29870C
29871      ITITLE='Normal Parameter Estimation: Multiply Censored Case'
29872      NCTITL=51
29873      ITEXT(1)='Summary Statistics:'
29874      NCTEXT(1)=19
29875      AVALUE(1)=0.0
29876      IDIGIT(1)=-1
29877      ITEXT(2)='Total Number of Observations:'
29878      NCTEXT(2)=29
29879      AVALUE(2)=REAL(N)
29880      IDIGIT(2)=0
29881      ITEXT(3)='Number of Failure Times:'
29882      NCTEXT(3)=24
29883      AVALUE(3)=REAL(IR)
29884      IDIGIT(3)=0
29885      ITEXT(4)='Number of Censoring Times:'
29886      NCTEXT(4)=26
29887      AVALUE(4)=REAL(N-IR)
29888      IDIGIT(4)=0
29889      ITEXT(5)='Sample Minimum:'
29890      NCTEXT(5)=15
29891      AVALUE(5)=XMIN
29892      IDIGIT(5)=NUMDIG
29893      ITEXT(6)='Sample Maximum:'
29894      NCTEXT(6)=15
29895      AVALUE(6)=XMAX
29896      IDIGIT(6)=NUMDIG
29897      ITEXT(7)='Sample Mean of Failure Times:'
29898      NCTEXT(7)=29
29899      AVALUE(7)=XMEAN
29900      IDIGIT(7)=NUMDIG
29901      ITEXT(8)='Sample SD of Failure Times:'
29902      NCTEXT(8)=27
29903      AVALUE(8)=XSD
29904      IDIGIT(8)=NUMDIG
29905      NUMROW=8
29906      DO2310I=1,NUMROW
29907        NTOT(I)=15
29908 2310 CONTINUE
29909C
29910      IFRST=.TRUE.
29911      ILAST=.FALSE.
29912      NCTITZ=0
29913      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
29914     1            AVALUE,IDIGIT,
29915     1            NTOT,NUMROW,
29916     1            ICAPSW,ICAPTY,ILAST,IFRST,
29917     1            ISUBRO,IBUGA3,IERROR)
29918      IFRST=.FALSE.
29919      ITITLE=' '
29920      NCTITL=0
29921C
29922      ITEXT(1)='Maximum Likelihood:'
29923      NCTEXT(1)=19
29924      AVALUE(1)=0.0
29925      IDIGIT(1)=0
29926      ITEXT(2)='Estimate of Location:'
29927      NCTEXT(2)=28
29928      AVALUE(2)=XMEAN
29929      IDIGIT(2)=NUMDIG
29930      ITEXT(3)='Standard Error of Location:'
29931      NCTEXT(3)=27
29932      AVALUE(3)=XSDMEA
29933      IDIGIT(3)=NUMDIG
29934      ICNT=3
29935      ITEXT(4)='Estimate of Scale (SD):'
29936      NCTEXT(4)=28
29937      AVALUE(4)=XSD
29938      IDIGIT(4)=NUMDIG
29939      ITEXT(5)='Standard Error of Scale:'
29940      NCTEXT(5)=24
29941      AVALUE(5)=XSDSD
29942      IDIGIT(5)=NUMDIG
29943      ITEXT(6)='Covariance:'
29944      NCTEXT(6)=11
29945      AVALUE(6)=XCOV
29946      IDIGIT(6)=NUMDIG
29947      ICNT=6
29948      ICNT=ICNT+1
29949      ITEXT(ICNT)='Log-likelihood:'
29950      NCTEXT(ICNT)=15
29951      AVALUE(ICNT)=ALIKE
29952      IDIGIT(ICNT)=-7
29953      ICNT=ICNT+1
29954      ITEXT(ICNT)='AIC:'
29955      NCTEXT(ICNT)=4
29956      AVALUE(ICNT)=AIC
29957      IDIGIT(ICNT)=-7
29958      ICNT=ICNT+1
29959      ITEXT(ICNT)='AICc:'
29960      NCTEXT(ICNT)=5
29961      AVALUE(ICNT)=AICC
29962      IDIGIT(ICNT)=-7
29963      ICNT=ICNT+1
29964      ITEXT(ICNT)='BIC:'
29965      NCTEXT(ICNT)=4
29966      AVALUE(ICNT)=BIC
29967      IDIGIT(ICNT)=-7
29968      NUMROW=ICNT
29969      DO2320I=1,NUMROW
29970        NTOT(I)=15
29971 2320 CONTINUE
29972C
29973      IFRST=.FALSE.
29974      ILAST=.FALSE.
29975      NCTITZ=0
29976      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
29977     1            AVALUE,IDIGIT,
29978     1            NTOT,NUMROW,
29979     1            ICAPSW,ICAPTY,ILAST,IFRST,
29980     1            ISUBRO,IBUGA3,IERROR)
29981C
29982      IF(NUMOUT.GT.1)THEN
29983        INORM='YES'
29984        CALL DPDTA7(ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,NUMALP,
29985     1              ICAPSW,ICAPTY,NUMDIG,INORM,
29986     1              ISUBRO,IBUGA3,IERROR)
29987      ENDIF
29988C
29989      IF(NPERC.GT.1)THEN
29990        ILIKFL='OFF'
29991        XQPSE(1)=CPUMIN
29992        CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
29993     1              ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
29994     1              ISUBRO,IBUGA3,IERROR)
29995
29996      ENDIF
29997C
29998C               *****************
29999C               **  STEP 90--  **
30000C               **  EXIT       **
30001C               *****************
30002C
30003 9000 CONTINUE
30004      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLN2')THEN
30005        WRITE(ICOUT,999)
30006        CALL DPWRST('XXX','WRIT')
30007        WRITE(ICOUT,9011)
30008 9011   FORMAT('***** AT THE END       OF DPMLN2--')
30009        CALL DPWRST('XXX','WRIT')
30010        WRITE(ICOUT,9012)N,IBUGA3,IERROR
30011 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
30012        CALL DPWRST('XXX','WRIT')
30013      ENDIF
30014C
30015      RETURN
30016      END
30017      SUBROUTINE DPMLNB(Y,X,N,NVAR,
30018     1                  AK,AKSV,PSV,
30019     1                  XTEMP,TEMP2,TEMP3,DTEMP,ITEMP1,MAXNXT,
30020     1                  PMOM,AKMOM,PML,PMLBC,PMLBCV,AKML,
30021     1                  PSE,AKSE,COVSE,
30022     1                  AIC,AICC,BIC,ALIK,
30023     1                  ICAPSW,ICAPTY,IFORSW,
30024     1                  IDIST2,
30025     1                  ISUBRO,IBUGA3,IERROR)
30026C
30027C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
30028C              ESTIMATES AND METHOD OF MOMENT ESTIMATES FOR
30029C              NEGATIVE BINOMIAL DISTRIBUTION.  THE METHOD OF
30030C              MOMENT ESTIMATES ARE:
30031C                 PHAT = XBAR/S**2
30032C                 KHAT = XBAR**2/(S**2 - XBAR)
30033C              WITH XBAR AND S**2 DENOTING THE SAMPLE MEAN AND
30034C              VARIANCE, RESPECTIVELY.  THE MAXIMUM LIKELIHOOD
30035C              ESTIMATE OF P (ASSUMING K IS KNOWN) IS:
30036C                  PHAT = XBAR/(K + XBAR)
30037C              FOR THE K UNKNOWN CASE, WE USE THE METHOD GIVEN
30038C              IN THE BURY REFERENCE.
30039C     EXAMPLE--NEGATIVE BINOMIAL MAXIMUM LIKELIHOOD Y
30040C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN ENGINEERING",
30041C                CAMBRIDGE UNIVERSITY PRESS, 1999, CHAPTER 10.
30042C              --JOHNSON, KEMP, AND KOTZ.  "UNIVARIATE DISCRETE
30043C                DISTRIBUTIONS", THIRD EDITION, WILEY, 2005, CHAPTER 5.
30044C     WRITTEN BY--ALAN HECKERT
30045C                 STATISTICAL ENGINEERING DIVISION
30046C                 INFORMATION TECHNOLOGY LABORATORY
30047C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
30048C                 GAITHERSBURG, MD 20899-8980
30049C                 PHONE--301-975-2899
30050C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
30051C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
30052C     LANGUAGE--ANSI FORTRAN (1977)
30053C     VERSION NUMBER--2004/3
30054C     ORIGINAL VERSION--MARCH     2004.
30055C     UPDATED         --AUGUST    2005. REFORMAT OUTPUT FOR
30056C                                       CONSISTENCY WITH OTHER ML
30057C                                       ROUTINES
30058C     UPDATED         --MARCH     2009. CORRECT METHOD OF MOMENTS
30059C                                       FORMULA, ALSO CHECK THAT
30060C                                       S**2 > XBAR
30061C     UPDATED         --MARCH     2009. MODULARIZE THE CODE
30062C                                       (CREATE SUBROUTINES FOR
30063C                                       THE ESTIMATION AND PRINT
30064C                                       TABLE OUTPUT USING SUBROUTINES)
30065C     UPDATED         --MARCH     2009. ALLOW USER-SPECIFIED STARTING
30066C                                       VALUES, ONLY DO K KNOWN OR
30067C                                       UNKNOWN CASE, BUT NOT BOTH
30068C     UPDATED         --MARCH     2009. INCLUDE SUPPORT FOR GROUPED
30069C                                       DATA
30070C     UPDATED         --JULY      2009. INCORPORATE GEOMETRIC CASE
30071C
30072C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
30073C
30074      CHARACTER*17 IDIST2
30075      CHARACTER*4 ICAPSW
30076      CHARACTER*4 ICAPTY
30077      CHARACTER*4 IFORSW
30078      CHARACTER*4 ISUBRO
30079      CHARACTER*4 IBUGA3
30080      CHARACTER*4 IERROR
30081C
30082      CHARACTER*4 ISUBN1
30083      CHARACTER*4 ISUBN2
30084      CHARACTER*4 ISTEPN
30085C
30086      CHARACTER*40 IDIST
30087C
30088      PARAMETER (NUMALP=8)
30089      DIMENSION ALPHA(NUMALP)
30090      DIMENSION ALOWP1(NUMALP)
30091      DIMENSION AUPPP1(NUMALP)
30092      DIMENSION ALOWK1(NUMALP)
30093      DIMENSION AUPPK1(NUMALP)
30094C
30095      INTEGER IFLAG
30096      LOGICAL IFRST
30097      LOGICAL ILAST
30098C
30099C---------------------------------------------------------------------
30100C
30101      DIMENSION Y(*)
30102      DIMENSION X(*)
30103      DIMENSION XTEMP(*)
30104      DIMENSION TEMP2(*)
30105      DIMENSION TEMP3(*)
30106      DOUBLE PRECISION DTEMP(*)
30107      INTEGER          ITEMP1(*)
30108C
30109      DOUBLE PRECISION DTEMP2
30110C
30111      INCLUDE 'DPCOST.INC'
30112C
30113      PARAMETER (MAXROW=15)
30114      CHARACTER*60 ITITLE
30115      CHARACTER*1  ITITLZ
30116      CHARACTER*1  ITITL9
30117      CHARACTER*40 ITEXT(MAXROW)
30118      CHARACTER*4  ALIGN(NUMALP)
30119      CHARACTER*4  VALIGN(NUMALP)
30120      REAL         AVALUE(MAXROW)
30121      INTEGER      NCTEXT(MAXROW)
30122      INTEGER      IDIGIT(MAXROW)
30123      INTEGER      NTOT(MAXROW)
30124C
30125      PARAMETER(NUMCLI=3)
30126      PARAMETER(MAXLIN=2)
30127      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
30128      INTEGER      NCTIT2(MAXLIN,NUMCLI)
30129      INTEGER      IWHTML(NUMALP)
30130      INTEGER      IWRTF(NUMALP)
30131      REAL         AMAT(MAXROW,NUMCLI)
30132C
30133C---------------------------------------------------------------------
30134C
30135      INCLUDE 'DPCOP2.INC'
30136C
30137      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
30138C
30139C-----START POINT-----------------------------------------------------
30140C
30141      ISUBN1='DPML'
30142      ISUBN2='NB  '
30143      IERROR='NO'
30144C
30145      PMOM=-99.0
30146      AKMOM=-99.0
30147      PML=-99.0
30148      PMLVAR=-99.0
30149      PMLBC=-99.0
30150      PMLBCV=-99.0
30151      AKML2=-99.0
30152      PML2=-99.0
30153      PML2BC=-99.0
30154      ALIK=CPUMIN
30155      AIC=-99.0
30156      AICC=-99.0
30157      BIC=-99.0
30158      COVSE=CPUMIN
30159      ICASE=0
30160C
30161      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLNB')THEN
30162        WRITE(ICOUT,999)
30163  999   FORMAT(1X)
30164        CALL DPWRST('XXX','WRIT')
30165        WRITE(ICOUT,51)
30166   51   FORMAT('**** AT THE BEGINNING OF DPMLNB--')
30167        CALL DPWRST('XXX','WRIT')
30168        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR
30169   52   FORMAT('IBUGA3,ISUBRO,N,NVAR = ',2(A4,2X),2I8)
30170        CALL DPWRST('XXX','WRIT')
30171        IF(NVAR.EQ.1)THEN
30172          DO56I=1,MIN(N,100)
30173            WRITE(ICOUT,57)I,Y(I)
30174   57       FORMAT('I,Y(I) = ',I8,G15.7)
30175            CALL DPWRST('XXX','WRIT')
30176   56     CONTINUE
30177        ELSE
30178          DO61I=1,N
30179            WRITE(ICOUT,62)I,X(I),Y(I)
30180   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
30181            CALL DPWRST('XXX','WRIT')
30182   61     CONTINUE
30183        ENDIF
30184      ENDIF
30185C
30186C               ********************************************
30187C               **  STEP 11--                             **
30188C               **  1) ROUND DATA TO INTEGER VALUES       **
30189C               **  2) COMPUTE SUMMARY STATISTICS         **
30190C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
30191C               **     INSUFFICIENT SAMPLE SIZE           **
30192C               ********************************************
30193C
30194      ISTEPN='11'
30195      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNB')
30196     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
30197C
30198      IDIST=' '
30199      IDIST(1:17)=IDIST2(1:17)
30200C
30201      NPERC=0
30202      MAXGRP=MAXNXT/2
30203      NMIN=2
30204      IERROR='NO'
30205      IF(NVAR.EQ.1)THEN
30206        DO1105I=1,N
30207          ITEMP=INT(Y(I)+0.5)
30208          Y(I)=REAL(ITEMP)
30209 1105   CONTINUE
30210        CALL CKDIST(Y,N,NMIN,XTEMP,NPERC,ISUBRO,IBUGA3,IERROR)
30211        IF(IERROR.EQ.'YES')GOTO9000
30212C
30213        IFLAG=1
30214        CALL SUMRAW(Y,N,IDIST,IFLAG,
30215     1              XMEAN,XVAR,XSD,XMIN,XMAX,
30216     1              ISUBRO,IBUGA3,IERROR)
30217        IF(IERROR.EQ.'YES')GOTO9000
30218        NTOTZZ=N
30219C
30220      ELSE
30221        CALL CKDIS2(Y,X,XTEMP,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
30222     1              ISUBRO,IBUGA3,IERROR)
30223        IF(IERROR.EQ.'YES')GOTO9000
30224        IFLAG1=1
30225        IFLAG2=1
30226        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
30227     1              XTEMP,TEMP2,TEMP3,MAXNXT,
30228     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
30229     1              ISUBRO,IBUGA3,IERROR)
30230        IF(IERROR.EQ.'YES')GOTO9000
30231      ENDIF
30232C
30233      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNB')THEN
30234        WRITE(ICOUT,999)
30235        CALL DPWRST('XXX','WRIT')
30236        WRITE(ICOUT,1151)
30237 1151   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
30238        CALL DPWRST('XXX','WRIT')
30239        WRITE(ICOUT,1152)XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ
30240 1152   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ = ',5G15.7,I10)
30241        CALL DPWRST('XXX','WRIT')
30242      ENDIF
30243C
30244      IF(IERROR.EQ.'YES')GOTO9000
30245C
30246C               ******************************************
30247C               **  STEP 21--                           **
30248C               **  CARRY OUT CALCULATIONS              **
30249C               **  FOR NEGATIVE BINOMIAL MLE ESTIMATE  **
30250C               ******************************************
30251C
30252      ISTEPN='21'
30253      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLNB')
30254     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
30255C
30256      IERFLG=0
30257      IF(XVAR.LE.0.0)THEN
30258        IERFLG=1
30259      ELSE
30260        ARATIO=XMEAN/XVAR
30261        AMXRAT=0.97
30262        IF(ARATIO.GT.AMXRAT)THEN
30263          IERFLG=1
30264        ENDIF
30265      ENDIF
30266C
30267      IF(IERFLG.EQ.1 .AND. AK.GT.0.0)THEN
30268        WRITE(ICOUT,999)
30269        CALL DPWRST('XXX','WRIT')
30270        WRITE(ICOUT,2111)IDIST2
30271 2111   FORMAT('***** ERROR IN ',A17,' MAXIMUM LIKELIHOOD--')
30272        CALL DPWRST('XXX','WRIT')
30273        WRITE(ICOUT,2123)ARATIO
30274 2123   FORMAT('      THE RATIO OF THE SAMPLE MEAN TO THE SAMPLE ',
30275     1         'VARIANCE (= ',G15.7,')')
30276        CALL DPWRST('XXX','WRIT')
30277        WRITE(ICOUT,2125)AMXRAT
30278 2125   FORMAT('      IS GREATER THAN ',F8.3,'.  THE MOMENT AND ')
30279        CALL DPWRST('XXX','WRIT')
30280        WRITE(ICOUT,2126)
30281 2126   FORMAT('      MAXIMUM LIKELIHOOD ESTIMATORS WILL NOT BE ',
30282     1         'COMPUTED.')
30283        CALL DPWRST('XXX','WRIT')
30284        WRITE(ICOUT,2127)
30285 2127   FORMAT('      A POISSON OR BINOMIAL MODEL MIGHT BE MORE ',
30286     1         'APPROPRIATE.')
30287        CALL DPWRST('XXX','WRIT')
30288        WRITE(ICOUT,2128)XMEAN
30289 2128   FORMAT('      THE SAMPLE MEAN     = ',G15.7)
30290        CALL DPWRST('XXX','WRIT')
30291        WRITE(ICOUT,2129)XVAR
30292 2129   FORMAT('      THE SAMPLE VARIANCE = ',G15.7)
30293        CALL DPWRST('XXX','WRIT')
30294        IERROR='YES'
30295        GOTO9000
30296      ELSEIF(IERFLG.EQ.1 .AND. AK.LE.0.0)THEN
30297        WRITE(ICOUT,999)
30298        CALL DPWRST('XXX','WRIT')
30299        WRITE(ICOUT,2141)IDIST2
30300 2141   FORMAT('***** WARNING IN ',A17,' MAXIMUM LIKELIHOOD--')
30301        CALL DPWRST('XXX','WRIT')
30302        WRITE(ICOUT,2123)ARATIO
30303        CALL DPWRST('XXX','WRIT')
30304        WRITE(ICOUT,2145)AMXRAT
30305 2145   FORMAT('      IS GREATER THAN ',F8.3,'.')
30306        CALL DPWRST('XXX','WRIT')
30307        WRITE(ICOUT,2127)
30308        CALL DPWRST('XXX','WRIT')
30309        WRITE(ICOUT,2128)XMEAN
30310        CALL DPWRST('XXX','WRIT')
30311        WRITE(ICOUT,2129)XVAR
30312        CALL DPWRST('XXX','WRIT')
30313      ENDIF
30314C
30315      IF(AK.GT.0.0)THEN
30316        ICASE=1
30317        IF(IDIST2.EQ.'GEOMETRIC')THEN
30318          PML=1.0/(XMEAN+1.0)
30319          PMLVAR=PML*PML*(1.0-PML)/REAL(N)
30320          PMLBC=CPUMIN
30321          AN=REAL(N)
30322          DO2160I=1,NUMALP
30323C
30324            ALP=ALPHA(I)
30325            P1=ALP/2.0
30326            P2=1.0-(ALP/2.0)
30327C
30328            CALL NBPPF(DBLE(P1),DBLE(PML),DBLE(AN),DTEMP2)
30329            SL=DTEMP2
30330            CALL NBPPF(DBLE(P2),DBLE(PML),DBLE(AN),DTEMP2)
30331            SU=DTEMP2
30332            ALOWP1(I)=1.0/((SU/AN)+1.0)
30333            AUPPP1(I)=1.0/((SL/AN)+1.0)
30334 2160     CONTINUE
30335          NUMOUT=NUMALP
30336        ELSE
30337          CALL NBML2(NTOTZZ,XMEAN,XVAR,AK,
30338     1               ALOWP1,AUPPP1,ALPHA,NUMALP,NUMOUT,
30339     1               PML,PMLBC,PMLBCV,IERFLG,
30340     1               ISUBRO,IBUGA3,IERROR)
30341        ENDIF
30342C
30343        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNB')THEN
30344          WRITE(ICOUT,999)
30345          CALL DPWRST('XXX','WRIT')
30346          WRITE(ICOUT,2151)
30347 2151     FORMAT('AFTER COMPUTE ML (K KNOWN CASE)--')
30348          CALL DPWRST('XXX','WRIT')
30349          WRITE(ICOUT,2152)PML,PMLBC,PMLBCV,NUMALP
30350 2152     FORMAT('PML,PMLBC,PMLBCV,NUMALP = ',4G15.7,I5)
30351          CALL DPWRST('XXX','WRIT')
30352        ENDIF
30353C
30354        IF(IERFLG.GT.0)THEN
30355          WRITE(ICOUT,999)
30356          CALL DPWRST('XXX','WRIT')
30357          WRITE(ICOUT,2111)IDIST2
30358          CALL DPWRST('XXX','WRIT')
30359          WRITE(ICOUT,2201)
30360 2201     FORMAT('      UNABLE TO COMPUTE THE MAXIMUM LIKELIHOOD ',
30361     1           'ESTIMATE FOR THE K KNOWN CASE.')
30362          CALL DPWRST('XXX','WRIT')
30363          IERROR='YES'
30364          GOTO9000
30365        ENDIF
30366C
30367        IF(NVAR.EQ.1)THEN
30368          PTEMP=PMLBC
30369          IF(PMLBCV.LE.0.0)PTEMP=PML
30370          CALL NBLIK1(Y,N,PTEMP,AK,
30371     1                ALIK,AIC,AICC,BIC,
30372     1                ISUBRO,IBUGA3,IERROR)
30373        ELSE
30374          PTEMP=PMLBC
30375          IF(PMLBCV.LE.0.0)PTEMP=PML
30376          CALL NBLIK2(Y,X,N,PTEMP,AK,
30377     1                ALIK,AIC,AICC,BIC,
30378     1                ISUBRO,IBUGA3,IERROR)
30379        ENDIF
30380C
30381      ELSEIF(AK.LT.0.0 .AND. NVAR.EQ.1)THEN
30382C
30383        ICASE=2
30384        AKMOM=XMEAN*XMEAN/(XVAR - XMEAN)
30385        PMOM=XMEAN/XVAR
30386        IF(AKSV.LE.0.0)AKSV=AKMOM
30387        IF(PSV.LE.0.0)PSV=PMOM
30388C
30389        CALL NBML1(Y,N,XMEAN,XVAR,PSV,AKSV,
30390     1             XTEMP,DTEMP,ITEMP1,MAXNXT,
30391     1             ALOWP1,AUPPP1,ALOWK1,AUPPK1,ALPHA,NUMALP,NUMOUT,
30392     1             AKML,PML,PMLBC,PSE,AKSE,COVSE,IERFLG,
30393     1             ISUBRO,IBUGA3,IERROR)
30394C
30395        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNB')THEN
30396          WRITE(ICOUT,999)
30397          CALL DPWRST('XXX','WRIT')
30398          WRITE(ICOUT,2251)
30399 2251     FORMAT('AFTER COMPUTE ML (K UNKNOWN CASE)--')
30400          CALL DPWRST('XXX','WRIT')
30401          WRITE(ICOUT,2252)PML,PMLBC,AKML
30402 2252     FORMAT('PML,PMLBC,AKML = ',3G15.7)
30403          CALL DPWRST('XXX','WRIT')
30404          WRITE(ICOUT,2253)PMOM,AKMOM
30405 2253     FORMAT('PMOM,AKMOM = ',2G15.7)
30406          CALL DPWRST('XXX','WRIT')
30407        ENDIF
30408C
30409        IF(IERFLG.EQ.2)THEN
30410C
30411          WRITE(ICOUT,999)
30412          CALL DPWRST('XXX','BUG ')
30413          WRITE(ICOUT,111)
30414  111     FORMAT('***** WARNING FROM NEGATIVE BINOMIAL MAXIMUM ',
30415     1           'LIKELIHOOD--')
30416          CALL DPWRST('XXX','BUG ')
30417          WRITE(ICOUT,113)
30418  113     FORMAT('      ESTIMATE OF K MAY NOT BE COMPUTED TO ',
30419     1           'DESIRED TOLERANCE.')
30420          CALL DPWRST('XXX','BUG ')
30421        ELSEIF(IERFLG.EQ.3)THEN
30422          WRITE(ICOUT,999)
30423          CALL DPWRST('XXX','BUG ')
30424          WRITE(ICOUT,111)
30425          CALL DPWRST('XXX','BUG ')
30426          WRITE(ICOUT,123)
30427  123     FORMAT('      ESTIMATE OF K MAY BE NEAR A SINGULAR POINT.')
30428          CALL DPWRST('XXX','BUG ')
30429        ELSEIF(IERFLG.EQ.4)THEN
30430          WRITE(ICOUT,999)
30431          CALL DPWRST('XXX','BUG ')
30432          WRITE(ICOUT,2111)
30433          CALL DPWRST('XXX','BUG ')
30434          WRITE(ICOUT,133)
30435  133     FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
30436          CALL DPWRST('XXX','BUG ')
30437          IERROR='YES'
30438          GOTO9000
30439        ELSEIF(IERFLG.EQ.5)THEN
30440          WRITE(ICOUT,999)
30441          CALL DPWRST('XXX','BUG ')
30442          WRITE(ICOUT,2111)
30443          CALL DPWRST('XXX','BUG ')
30444          WRITE(ICOUT,143)
30445  143     FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
30446          CALL DPWRST('XXX','BUG ')
30447          IERROR='YES'
30448          GOTO9000
30449        ENDIF
30450C
30451        CALL NBLIK1(Y,N,PMLBC,AKML,
30452     1              ALIK,AIC,AICC,BIC,
30453     1              ISUBRO,IBUGA3,IERROR)
30454C
30455      ELSEIF(AK.LT.0.0 .AND. NVAR.EQ.2)THEN
30456C
30457        ICASE=2
30458        AKMOM=XMEAN*XMEAN/(XVAR - XMEAN)
30459        PMOM=XMEAN/XVAR
30460        IF(AKSV.LE.0.0)AKSV=AKMOM
30461        IF(PSV.LE.0.0)PSV=PMOM
30462C
30463        CALL NBML3(Y,X,N,XMEAN,XVAR,PSV,AKSV,
30464     1             XTEMP,DTEMP,ITEMP1,MAXNXT,
30465     1             ALOWP1,AUPPP1,ALOWK1,AUPPK1,ALPHA,NUMALP,NUMOUT,
30466     1             AKML,PML,PMLBC,PSE,AKSE,COVSE,IERFLG,
30467     1             ISUBRO,IBUGA3,IERROR)
30468C
30469        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNB')THEN
30470          WRITE(ICOUT,999)
30471          CALL DPWRST('XXX','WRIT')
30472          WRITE(ICOUT,2251)
30473          CALL DPWRST('XXX','WRIT')
30474          WRITE(ICOUT,2252)PML,PMLBC,AKML
30475          CALL DPWRST('XXX','WRIT')
30476          WRITE(ICOUT,2253)PMOM,AKMOM
30477          CALL DPWRST('XXX','WRIT')
30478        ENDIF
30479C
30480        IF(IERFLG.EQ.2)THEN
30481C
30482          WRITE(ICOUT,999)
30483          CALL DPWRST('XXX','BUG ')
30484          WRITE(ICOUT,111)
30485          CALL DPWRST('XXX','BUG ')
30486          WRITE(ICOUT,113)
30487          CALL DPWRST('XXX','BUG ')
30488        ELSEIF(IERFLG.EQ.3)THEN
30489          WRITE(ICOUT,999)
30490          CALL DPWRST('XXX','BUG ')
30491          WRITE(ICOUT,111)
30492          CALL DPWRST('XXX','BUG ')
30493          WRITE(ICOUT,123)
30494          CALL DPWRST('XXX','BUG ')
30495        ELSEIF(IERFLG.EQ.4)THEN
30496          WRITE(ICOUT,999)
30497          CALL DPWRST('XXX','BUG ')
30498          WRITE(ICOUT,2111)
30499          CALL DPWRST('XXX','BUG ')
30500          WRITE(ICOUT,133)
30501          CALL DPWRST('XXX','BUG ')
30502          IERROR='YES'
30503          GOTO9000
30504        ELSEIF(IERFLG.EQ.5)THEN
30505          WRITE(ICOUT,999)
30506          CALL DPWRST('XXX','BUG ')
30507          WRITE(ICOUT,2111)
30508          CALL DPWRST('XXX','BUG ')
30509          WRITE(ICOUT,143)
30510          CALL DPWRST('XXX','BUG ')
30511          IERROR='YES'
30512          GOTO9000
30513C
30514        ELSEIF(IERFLG.EQ.5)THEN
30515          WRITE(ICOUT,999)
30516          CALL DPWRST('XXX','BUG ')
30517          WRITE(ICOUT,2111)
30518          CALL DPWRST('XXX','BUG ')
30519          WRITE(ICOUT,153)
30520  153     FORMAT('      TOO MANY CLASSES.')
30521          CALL DPWRST('XXX','BUG ')
30522          IERROR='YES'
30523          GOTO9000
30524        ENDIF
30525C
30526        CALL NBLIK2(Y,X,N,PMLBC,AKML,
30527     1              ALIK,AIC,AICC,BIC,
30528     1              ISUBRO,IBUGA3,IERROR)
30529C
30530      ENDIF
30531C
30532C               ******************************************
30533C               **   STEP 3--                           **
30534C               **   WRITE OUT EVERYTHING               **
30535C               **   FOR NEGATIVE BINOMIAL MLE ESTIMATE **
30536C               ******************************************
30537C
30538      ISTEPN='3'
30539      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNB')
30540     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
30541C
30542C     PRINT SUMMARY STATISTICS TABLE
30543C
30544      NUMDIG=7
30545      IF(IFORSW.EQ.'1')NUMDIG=1
30546      IF(IFORSW.EQ.'2')NUMDIG=2
30547      IF(IFORSW.EQ.'3')NUMDIG=3
30548      IF(IFORSW.EQ.'4')NUMDIG=4
30549      IF(IFORSW.EQ.'5')NUMDIG=5
30550      IF(IFORSW.EQ.'6')NUMDIG=6
30551      IF(IFORSW.EQ.'7')NUMDIG=7
30552      IF(IFORSW.EQ.'8')NUMDIG=8
30553      IF(IFORSW.EQ.'9')NUMDIG=9
30554      IF(IFORSW.EQ.'0')NUMDIG=0
30555      IF(IFORSW.EQ.'E')NUMDIG=-2
30556      IF(IFORSW.EQ.'-2')NUMDIG=-2
30557      IF(IFORSW.EQ.'-3')NUMDIG=-3
30558      IF(IFORSW.EQ.'-4')NUMDIG=-4
30559      IF(IFORSW.EQ.'-5')NUMDIG=-5
30560      IF(IFORSW.EQ.'-6')NUMDIG=-6
30561      IF(IFORSW.EQ.'-7')NUMDIG=-7
30562      IF(IFORSW.EQ.'-8')NUMDIG=-8
30563      IF(IFORSW.EQ.'-9')NUMDIG=-9
30564C
30565      IF(IDIST2.EQ.'GEOMETRIC')THEN
30566        ITITLE='Geometric Parameter Estimation'
30567        NCTITL=30
30568      ELSE
30569        ITITLE='Negative Binomial Parameter Estimation'
30570        NCTITL=38
30571      ENDIF
30572      ITEXT(1)='Summary Statistics:'
30573      NCTEXT(1)=19
30574      AVALUE(1)=0.0
30575      IDIGIT(1)=-1
30576      ITEXT(2)='Number of Observations:'
30577      NCTEXT(2)=23
30578      AVALUE(2)=REAL(NTOTZZ)
30579      IDIGIT(2)=0
30580      ITEXT(3)='Sample Mean:'
30581      NCTEXT(3)=12
30582      AVALUE(3)=XMEAN
30583      IDIGIT(3)=NUMDIG
30584      ITEXT(4)='Sample Variance:'
30585      NCTEXT(4)=16
30586      AVALUE(4)=XVAR
30587      IDIGIT(4)=NUMDIG
30588      ITEXT(5)='Sample Standard Deviation:'
30589      NCTEXT(5)=26
30590      AVALUE(5)=XSD
30591      IDIGIT(5)=NUMDIG
30592      ITEXT(6)='Sample Minimum:'
30593      NCTEXT(6)=15
30594      AVALUE(6)=XMIN
30595      IDIGIT(6)=NUMDIG
30596      ITEXT(7)='Sample Maximum:'
30597      NCTEXT(7)=15
30598      AVALUE(7)=XMAX
30599      IDIGIT(7)=NUMDIG
30600      NUMROW=7
30601      DO2310I=1,NUMROW
30602        NTOT(I)=15
30603 2310 CONTINUE
30604C
30605      IFRST=.TRUE.
30606      ILAST=.FALSE.
30607      NCTITZ=0
30608      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
30609     1            AVALUE,IDIGIT,
30610     1            NTOT,NUMROW,
30611     1            ICAPSW,ICAPTY,ILAST,IFRST,
30612     1            ISUBRO,IBUGA3,IERROR)
30613      IFRST=.FALSE.
30614      ITITLE=' '
30615      NCTITL=0
30616C
30617      IF(ICASE.EQ.1)THEN
30618        IF(IDIST2.EQ.'GEOMETRIC')THEN
30619          ITEXT(1)='Maximum Likelihood:'
30620          NCTEXT(1)=19
30621          AVALUE(1)=0.0
30622          IDIGIT(1)=-1
30623          ITEXT(2)='Estimate of p:'
30624          NCTEXT(2)=14
30625          AVALUE(2)=PML
30626          IDIGIT(2)=NUMDIG
30627          ITEXT(3)='Standard Error of Estimated p:'
30628          NCTEXT(3)=30
30629          AVALUE(3)=SQRT(PMLVAR)
30630          IDIGIT(3)=NUMDIG
30631          ICNT=3
30632        ELSE
30633          ITEXT(1)='Maximum Likelihood (k known case):'
30634          NCTEXT(1)=34
30635          AVALUE(1)=0.0
30636          IDIGIT(1)=0
30637          ITEXT(2)='User-specified k:'
30638          NCTEXT(2)=17
30639          AVALUE(2)=AK
30640          IDIGIT(2)=NUMDIG
30641          ITEXT(3)='Estimate of p:'
30642          NCTEXT(3)=14
30643          AVALUE(3)=PML
30644          IDIGIT(3)=NUMDIG
30645          ICNT=3
30646        ENDIF
30647        IF(PMLBCV.LE.0.0)THEN
30648          ICNT=ICNT+1
30649          ITEXT(ICNT)='Log-likelihood:'
30650          NCTEXT(ICNT)=15
30651          AVALUE(ICNT)=ALIK
30652          IDIGIT(ICNT)=NUMDIG
30653          ICNT=ICNT+1
30654          ITEXT(ICNT)='AIC:'
30655          NCTEXT(ICNT)=4
30656          AVALUE(ICNT)=AIC
30657          IDIGIT(ICNT)=NUMDIG
30658          ICNT=ICNT+1
30659          ITEXT(ICNT)='AICc:'
30660          NCTEXT(ICNT)=5
30661          AVALUE(ICNT)=AICC
30662          IDIGIT(ICNT)=NUMDIG
30663          ICNT=ICNT+1
30664          ITEXT(ICNT)='BIC:'
30665          NCTEXT(ICNT)=4
30666          AVALUE(ICNT)=BIC
30667          IDIGIT(ICNT)=NUMDIG
30668          NUMROW=ICNT
30669        ELSE
30670          ICNT=ICNT+1
30671          ITEXT(ICNT)='Bias Corrected estimate of p:'
30672          NCTEXT(ICNT)=29
30673          AVALUE(ICNT)=PMLBC
30674          IDIGIT(ICNT)=NUMDIG
30675          ICNT=ICNT+1
30676          ITEXT(ICNT)='Standard error of estimated p:'
30677          NCTEXT(ICNT)=30
30678          AVALUE(ICNT)=SQRT(PMLBCV)
30679          IDIGIT(ICNT)=NUMDIG
30680          ICNT=ICNT+1
30681          ITEXT(ICNT)='Log-likelihood:'
30682          NCTEXT(ICNT)=15
30683          AVALUE(ICNT)=ALIK
30684          IDIGIT(ICNT)=NUMDIG
30685          ICNT=ICNT+1
30686          ITEXT(ICNT)='AIC:'
30687          NCTEXT(ICNT)=4
30688          AVALUE(ICNT)=AIC
30689          IDIGIT(ICNT)=NUMDIG
30690          ICNT=ICNT+1
30691          ITEXT(ICNT)='AICc:'
30692          NCTEXT(ICNT)=5
30693          AVALUE(ICNT)=AICC
30694          IDIGIT(ICNT)=NUMDIG
30695          ICNT=ICNT+1
30696          ITEXT(ICNT)='BIC:'
30697          NCTEXT(ICNT)=4
30698          AVALUE(ICNT)=BIC
30699          IDIGIT(ICNT)=NUMDIG
30700          NUMROW=ICNT
30701        ENDIF
30702        DO2320I=1,NUMROW
30703          NTOT(I)=15
30704 2320   CONTINUE
30705C
30706        ILAST=.TRUE.
30707        NCTITZ=0
30708        CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
30709     1              AVALUE,IDIGIT,
30710     1              NTOT,NUMROW,
30711     1              ICAPSW,ICAPTY,ILAST,IFRST,
30712     1              ISUBRO,IBUGA3,IERROR)
30713C
30714        IF(NUMOUT.GT.1)THEN
30715C
30716          ITITL9=' '
30717          NCTIT9=0
30718          ITITLE(1:43)='Confidence interval (normal approximation) '
30719          ITITLE(44:48)='for p'
30720          NCTITL=48
30721          NUMLIN=2
30722          NUMCOL=3
30723          ITITL2(1,1)='Confidence'
30724          ITITL2(2,1)='Coefficient'
30725          ITITL2(1,2)='Lower'
30726          ITITL2(2,2)='Limit'
30727          ITITL2(1,3)='Upper'
30728          ITITL2(2,3)='Limit'
30729          NCTIT2(1,1)=10
30730          NCTIT2(2,1)=11
30731          NCTIT2(1,2)=5
30732          NCTIT2(2,2)=5
30733          NCTIT2(1,3)=5
30734          NCTIT2(2,3)=5
30735          NMAX=0
30736          DO2321I=1,NUMCOL
30737            VALIGN(I)='b'
30738            ALIGN(I)='r'
30739            NTOT(I)=15
30740            NMAX=NMAX+NTOT(I)
30741            IDIGIT(I)=NUMDIG
30742 2321     CONTINUE
30743          IDIGIT(1)=3
30744          DO2323I=1,NUMALP
30745            NCTEXT(I)=0
30746            AMAT(I,1)=100.0*(1.0 - ALPHA(I))
30747            AMAT(I,2)=ALOWP1(I)
30748            AMAT(I,3)=AUPPP1(I)
30749 2323     CONTINUE
30750          IWHTML(1)=150
30751          IWHTML(2)=150
30752          IWHTML(3)=150
30753          IWHTML(4)=150
30754          IWRTF(1)=2000
30755          IWRTF(2)=IWRTF(1)+2000
30756          IWRTF(3)=IWRTF(2)+2000
30757          IFRST=.FALSE.
30758          ILAST=.TRUE.
30759C
30760          CALL DPDTA2(ITITL9,NCTIT9,
30761     1                ITITLE,NCTITL,ITITL2,NCTIT2,
30762     1                MAXLIN,NUMLIN,NUMCLI,NUMCOL,
30763     1                ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
30764     1                IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
30765     1                ICAPSW,ICAPTY,IFRST,ILAST,
30766     1                ISUBRO,IBUGA3,IERROR)
30767        ENDIF
30768C
30769      ELSE
30770        ITITLE=' '
30771        NCTITL=0
30772        ITEXT(1)='Method of Moments:'
30773        NCTEXT(1)=19
30774        AVALUE(1)=0.0
30775        IDIGIT(1)=-1
30776        ITEXT(2)='Estimate of p:'
30777        NCTEXT(2)=14
30778        AVALUE(2)=PMOM
30779        IDIGIT(2)=NUMDIG
30780        ITEXT(3)='Estimate of k:'
30781        NCTEXT(3)=14
30782        AVALUE(3)=AKMOM
30783        IDIGIT(3)=NUMDIG
30784        NUMROW=3
30785        DO2330I=1,NUMROW
30786          NTOT(I)=15
30787 2330   CONTINUE
30788C
30789        ILAST=.FALSE.
30790        NCTITZ=0
30791        CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
30792     1              AVALUE,IDIGIT,
30793     1              NTOT,NUMROW,
30794     1              ICAPSW,ICAPTY,ILAST,IFRST,
30795     1              ISUBRO,IBUGA3,IERROR)
30796C
30797        ITEXT(1)='Maximum Likelihood (k unknown case):'
30798        NCTEXT(1)=36
30799        AVALUE(1)=0.0
30800        IDIGIT(1)=-1
30801        ITEXT(2)='Estimate of p:'
30802        NCTEXT(2)=14
30803        AVALUE(2)=PML
30804        IDIGIT(2)=NUMDIG
30805        ITEXT(3)='Bias Corrected estimate of p:'
30806        NCTEXT(3)=29
30807        AVALUE(3)=PMLBC
30808        IDIGIT(3)=NUMDIG
30809        ITEXT(4)='Estimate of k:'
30810        NCTEXT(4)=14
30811        AVALUE(4)=AKML
30812        IDIGIT(4)=NUMDIG
30813        ITEXT(5)='Standard error of p:'
30814        NCTEXT(5)=20
30815        AVALUE(5)=PSE
30816        IDIGIT(5)=NUMDIG
30817        ITEXT(6)='Standard error of k:'
30818        NCTEXT(6)=20
30819        AVALUE(6)=AKSE
30820        IDIGIT(6)=NUMDIG
30821        ITEXT(7)='Covariance of p and k:'
30822        NCTEXT(7)=22
30823        AVALUE(7)=COVSE
30824        IDIGIT(7)=NUMDIG
30825        ITEXT(8)='Log-likelihood:'
30826        NCTEXT(8)=15
30827        AVALUE(8)=ALIK
30828        IDIGIT(8)=NUMDIG
30829        ITEXT(9)='AIC:'
30830        NCTEXT(9)=4
30831        AVALUE(9)=AIC
30832        IDIGIT(9)=NUMDIG
30833        ITEXT(10)='AICc:'
30834        NCTEXT(10)=5
30835        AVALUE(10)=AICC
30836        IDIGIT(10)=NUMDIG
30837        ITEXT(11)='BIC:'
30838        NCTEXT(11)=4
30839        AVALUE(11)=BIC
30840        IDIGIT(11)=NUMDIG
30841        NUMROW=11
30842        DO2340I=1,NUMROW
30843          NTOT(I)=15
30844 2340   CONTINUE
30845C
30846        ILAST=.TRUE.
30847        ITITLZ=' '
30848        NCTITZ=0
30849        CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
30850     1              AVALUE,IDIGIT,
30851     1              NTOT,NUMROW,
30852     1              ICAPSW,ICAPTY,ILAST,IFRST,
30853     1              ISUBRO,IBUGA3,IERROR)
30854C
30855        IF(NUMOUT.GT.1)THEN
30856C
30857          ITITL9=' '
30858          NCTIT9=0
30859          ITITLE(1:43)='Confidence interval (normal approximation) '
30860          ITITLE(44:48)='for p'
30861          NCTITL=48
30862          NUMLIN=2
30863          NUMCOL=3
30864          ITITL2(1,1)='Confidence'
30865          ITITL2(2,1)='Coefficient'
30866          ITITL2(1,2)='Lower'
30867          ITITL2(2,2)='Limit'
30868          ITITL2(1,3)='Upper'
30869          ITITL2(2,3)='Limit'
30870          NCTIT2(1,1)=10
30871          NCTIT2(2,1)=11
30872          NCTIT2(1,2)=5
30873          NCTIT2(2,2)=5
30874          NCTIT2(1,3)=5
30875          NCTIT2(2,3)=5
30876          NMAX=0
30877          DO2421I=1,NUMCOL
30878            VALIGN(I)='b'
30879            ALIGN(I)='r'
30880            NTOT(I)=15
30881            NMAX=NMAX+NTOT(I)
30882            IDIGIT(I)=NUMDIG
30883 2421     CONTINUE
30884          IDIGIT(1)=3
30885          DO2423I=1,NUMALP
30886            NCTEXT(I)=0
30887            AMAT(I,1)=100.0*(1.0 - ALPHA(I))
30888            AMAT(I,2)=ALOWP1(I)
30889            AMAT(I,3)=AUPPP1(I)
30890 2423     CONTINUE
30891          IWHTML(1)=150
30892          IWHTML(2)=150
30893          IWHTML(3)=150
30894          IWHTML(4)=150
30895          IWRTF(1)=2000
30896          IWRTF(2)=IWRTF(1)+2000
30897          IWRTF(3)=IWRTF(2)+2000
30898          IFRST=.TRUE.
30899          ILAST=.FALSE.
30900C
30901          CALL DPDTA2(ITITL9,NCTIT9,
30902     1                ITITLE,NCTITL,ITITL2,NCTIT2,
30903     1                MAXLIN,NUMLIN,NUMCLI,NUMCOL,
30904     1                ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
30905     1                IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
30906     1                ICAPSW,ICAPTY,IFRST,ILAST,
30907     1                ISUBRO,IBUGA3,IERROR)
30908C
30909          ITITLE(1:43)='Confidence interval (normal approximation) '
30910          ITITLE(44:48)='for k'
30911          NCTITL=48
30912          NUMLIN=2
30913          NUMCOL=3
30914          ITITL2(1,1)='Confidence'
30915          ITITL2(2,1)='Coefficient'
30916          ITITL2(1,2)='Lower'
30917          ITITL2(2,2)='Limit'
30918          ITITL2(1,3)='Upper'
30919          ITITL2(2,3)='Limit'
30920          NCTIT2(1,1)=10
30921          NCTIT2(2,1)=11
30922          NCTIT2(1,2)=5
30923          NCTIT2(2,2)=5
30924          NCTIT2(1,3)=5
30925          NCTIT2(2,3)=5
30926          NMAX=0
30927          DO2521I=1,NUMCOL
30928            VALIGN(I)='b'
30929            ALIGN(I)='r'
30930            NTOT(I)=15
30931            NMAX=NMAX+NTOT(I)
30932            IDIGIT(I)=NUMDIG
30933 2521     CONTINUE
30934          IDIGIT(1)=3
30935          DO2523I=1,NUMALP
30936            NCTEXT(I)=0
30937            AMAT(I,1)=100.0*(1.0 - ALPHA(I))
30938            AMAT(I,2)=ALOWK1(I)
30939            AMAT(I,3)=AUPPK1(I)
30940 2523     CONTINUE
30941          IWHTML(1)=150
30942          IWHTML(2)=150
30943          IWHTML(3)=150
30944          IWHTML(4)=150
30945          IWRTF(1)=2000
30946          IWRTF(2)=IWRTF(1)+2000
30947          IWRTF(3)=IWRTF(2)+2000
30948          IFRST=.FALSE.
30949          ILAST=.TRUE.
30950C
30951          CALL DPDTA2(ITITL9,NCTIT9,
30952     1                ITITLE,NCTITL,ITITL2,NCTIT2,
30953     1                MAXLIN,NUMLIN,NUMCLI,NUMCOL,
30954     1                ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
30955     1                IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
30956     1                ICAPSW,ICAPTY,IFRST,ILAST,
30957     1                ISUBRO,IBUGA3,IERROR)
30958C
30959        ENDIF
30960      ENDIF
30961C
30962C               *****************
30963C               **  STEP 90--  **
30964C               **  EXIT       **
30965C               *****************
30966C
30967 9000 CONTINUE
30968      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLNB')THEN
30969        WRITE(ICOUT,999)
30970        CALL DPWRST('XXX','WRIT')
30971        WRITE(ICOUT,9011)
30972 9011   FORMAT('***** AT THE END       OF DPMLNB--')
30973        CALL DPWRST('XXX','WRIT')
30974        WRITE(ICOUT,9012)N,IBUGA3,IERROR
30975 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
30976        CALL DPWRST('XXX','WRIT')
30977        WRITE(ICOUT,9015)N
30978 9015   FORMAT('N = ',I8)
30979        CALL DPWRST('XXX','WRIT')
30980      ENDIF
30981C
30982      RETURN
30983      END
30984      SUBROUTINE DPMLNM(Y,X,N,NVAR,Y2,X2,N2,
30985     1                  TEMP1,TEMP2,WORK,ITEMP1,MAXNXT,
30986     1                  CLLIMI,CLWIDT,NCOMP,
30987     1                  TEMP3,IHSTCW,MAXOBV,
30988     1                  ICAPSW,ICAPTY,IFORSW,
30989     1                  U1,SD1,U2,SD2,PMIX,
30990     1                  ISUBRO,IBUGA3,IERROR)
30991C
30992C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
30993C              ESTIMATES FOR THE NORMAL MIXTURE DISTRIBUTION.
30994C              IT USES APPLIED STATISTICS ALGORITHM 203 TO
30995C              PERFORM THE MAXIMUM LIKELIHOOD ESTIMATION.
30996C
30997C              THERE ARE TWO CASES:
30998C
30999C              1) ONE VARIABLE CASE: Y IS RAW DATA
31000C                 A) CALL DPBIN TO BIN DATA
31001C                 B) IF USER HAS SPECIFIED CLASS LIMITS OR WIDTH,
31002C                    PASS TO DPBIN.
31003C              2) TWO VARIABLE CASE: Y IS FREQUENCY, X IS CLASS
31004C                 MID-POINT.
31005C
31006C              NCOMP DEFINES NUMBER OF NORMAL DISTRIBUTIONS BEING
31007C              FIT.  MAXIMUM OF 20 ALLOWED.
31008C
31009C     EXAMPLE--NORMAL MIXTURE MAXIMUM LIKELIHOOD Y
31010C            --NORMAL MIXTURE MAXIMUM LIKELIHOOD Y X
31011C     REFERENCE--"MAXIMUM LIKELIHOOD ESTIMATION OF MIXTURES OF
31012C                DISTRIBUTIONS", M. AGHA AND T. IBRAHIM,
31013C                APPLIED STATISTICS, 1984, VOLUME 33, NO. 3,
31014C                PP. 327-329.
31015C     WRITTEN BY--ALAN HECKERT
31016C                 STATISTICAL ENGINEERING DIVISION
31017C                 INFORMATION TECHNOLOGY LABORATORY
31018C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
31019C                 GAITHERSBUG, MD 20899-8980
31020C                 PHONE--301-975-2899
31021C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
31022C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
31023C     LANGUAGE--ANSI FORTRAN (1977)
31024C     VERSION NUMBER--2004/8
31025C     ORIGINAL VERSION--AUGUST    2004.
31026C     UPDATED         --MARCH     2006. SUPPORT FOR DIFFERENT DEFAULT
31027C                                       BINNING ALGORITHMS
31028C     UPDATED         --MARCH     2011. USE DPDTA1 TO PRINT
31029C     UPDATED         --MARCH     2011. EXTRACT ML TO NMXML1
31030C
31031C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-----------------
31032C
31033      CHARACTER*4 ICAPSW
31034      CHARACTER*4 ICAPTY
31035      CHARACTER*4 IFORSW
31036      CHARACTER*4 ISUBRO
31037      CHARACTER*4 IBUGA3
31038      CHARACTER*4 IERROR
31039C
31040      CHARACTER*4 IWRITE
31041      CHARACTER*4 IHSTCW
31042      CHARACTER*4 ISUBN1
31043      CHARACTER*4 ISUBN2
31044      CHARACTER*4 ISTEPN
31045      CHARACTER*4 IOP
31046C
31047      PARAMETER (MAXROW=50)
31048      CHARACTER*60 ITITLE
31049      CHARACTER*60 ITITLZ
31050      CHARACTER*45 ITEXT(MAXROW)
31051      REAL         AVALUE(MAXROW)
31052      INTEGER      NCTEXT(MAXROW)
31053      INTEGER      IDIGIT(MAXROW)
31054      INTEGER      NTOT(MAXROW)
31055      LOGICAL IFRST
31056      LOGICAL ILAST
31057C
31058C-------------------------------------------------------------------
31059C
31060      PARAMETER (KMAX=20)
31061      PARAMETER (MMAX=200)
31062C
31063      DIMENSION Y(*)
31064      DIMENSION X(*)
31065      DIMENSION Y2(*)
31066      DIMENSION X2(*)
31067      DIMENSION TEMP1(*)
31068      DIMENSION TEMP2(*)
31069      DIMENSION TEMP3(*)
31070      DIMENSION CLLIMI(*)
31071      DIMENSION CLWIDT(*)
31072      INTEGER   ITEMP1(*)
31073C
31074CCCCC REAL TOL
31075C
31076      REAL ALPHA(KMAX)
31077      REAL XMEAN(KMAX)
31078      REAL XSD(KMAX)
31079C
31080C  FOR STORAGE EFFICIENCY, USE SINGLE "WORK" ARRAY FOR FOLLOWING.
31081C  TO AVOID CONFUSION, LEAVE ALPHA, XMEAN, AND XSD AS DISTINCT
31082C  ARRAYS (THESE TAKE A MINIMAL AMOUNT OF STORAGE, SINCE THESE
31083C  REFERENCED IN THIS ROUTINE, KEEP CLARITY IN CODE)
31084C
31085      DIMENSION WORK(*)
31086C
31087C-------------------------------------------------------------------
31088C
31089      INCLUDE 'DPCOP2.INC'
31090C
31091C-----START POINT---------------------------------------------------
31092C
31093      ISUBN1='DPML'
31094      ISUBN2='NM  '
31095      IERROR='NO'
31096C
31097      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLNM')THEN
31098        WRITE(ICOUT,999)
31099  999   FORMAT(1X)
31100        CALL DPWRST('XXX','WRIT')
31101        WRITE(ICOUT,51)
31102   51   FORMAT('**** AT THE BEGINNING OF DPMLNM--')
31103        CALL DPWRST('XXX','WRIT')
31104        WRITE(ICOUT,52)IBUGA3,ISUBRO
31105   52   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
31106        CALL DPWRST('XXX','WRIT')
31107        WRITE(ICOUT,55)N,NCOMP,NVAR,MAXOBV
31108   55   FORMAT('N,NCOMP,NVAR,MAXOBV = ',4I8)
31109        CALL DPWRST('XXX','WRIT')
31110        DO56I=1,N
31111          WRITE(ICOUT,57)I,Y(I),X(I)
31112   57     FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
31113          CALL DPWRST('XXX','WRIT')
31114   56   CONTINUE
31115      ENDIF
31116C
31117C               *****************************************
31118C               **  STEP 21--                          **
31119C               **  CARRY OUT CALCULATIONS             **
31120C               **  FOR NORMAL MIXTURE MLE ESTIMATION  **
31121C               *****************************************
31122C
31123      ISTEPN='21'
31124      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNM')
31125     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
31126C
31127      IERROR='NO'
31128      IWRITE='OFF'
31129C
31130      CALL NMXML1(Y,X,N,NVAR,Y2,X2,N2,
31131     1            TEMP1,TEMP2,TEMP3,WORK,ITEMP1,MAXNXT,
31132     1            CLLIMI,CLWIDT,NCOMP,IHSTCW,
31133     1            ALPHA,XMEAN,XSD,KMAX,NTOT2,ALOGL,
31134     1            AMEAN,ASD,AMIN,AMAX,
31135     1            ISUBRO,IBUGA3,IERROR)
31136      U1=XMEAN(1)
31137      U2=XMEAN(2)
31138      SD1=XSD(1)
31139      SD2=XSD(2)
31140      PMIX=ALPHA(1)
31141      IF(IERROR.EQ.'YES')GOTO9000
31142C
31143      IOP='OPEN'
31144      IFLAG1=1
31145      IFLAG2=0
31146      IFLAG3=0
31147      IFLAG4=0
31148      IFLAG5=0
31149      CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
31150     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
31151     1            IBUGA3,ISUBRO,IERROR)
31152      IF(IERROR.EQ.'YES')GOTO9000
31153C
31154      DO2300I=1,NCOMP
31155        WRITE(IOUNI1,2301)ALPHA(I),XMEAN(I),XSD(I)
31156 2300 CONTINUE
31157 2301 FORMAT(3(E15.7,1X))
31158C
31159      IOP='CLOS'
31160      CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
31161     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
31162     1            IBUGA3,ISUBRO,IERROR)
31163      IF(IERROR.EQ.'YES')GOTO9000
31164C
31165C               ***********************************************
31166C               **   STEP 42--                               **
31167C               **   WRITE OUT EVERYTHING                    **
31168C               **   FOR NORMAL MIXTURE MLE ESTIMATION       **
31169C               ***********************************************
31170C
31171      ISTEPN='42'
31172      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNM')
31173     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
31174C
31175      IF(IPRINT.EQ.'OFF')GOTO9000
31176C
31177      NUMDIG=7
31178      IF(IFORSW.EQ.'1')NUMDIG=1
31179      IF(IFORSW.EQ.'2')NUMDIG=2
31180      IF(IFORSW.EQ.'3')NUMDIG=3
31181      IF(IFORSW.EQ.'4')NUMDIG=4
31182      IF(IFORSW.EQ.'5')NUMDIG=5
31183      IF(IFORSW.EQ.'6')NUMDIG=6
31184      IF(IFORSW.EQ.'7')NUMDIG=7
31185      IF(IFORSW.EQ.'8')NUMDIG=8
31186      IF(IFORSW.EQ.'9')NUMDIG=9
31187      IF(IFORSW.EQ.'0')NUMDIG=0
31188      IF(IFORSW.EQ.'E')NUMDIG=-2
31189      IF(IFORSW.EQ.'-2')NUMDIG=-2
31190      IF(IFORSW.EQ.'-3')NUMDIG=-3
31191      IF(IFORSW.EQ.'-4')NUMDIG=-4
31192      IF(IFORSW.EQ.'-5')NUMDIG=-5
31193      IF(IFORSW.EQ.'-6')NUMDIG=-6
31194      IF(IFORSW.EQ.'-7')NUMDIG=-7
31195      IF(IFORSW.EQ.'-8')NUMDIG=-8
31196      IF(IFORSW.EQ.'-9')NUMDIG=-9
31197C
31198      DO2320I=1,50
31199        NTOT(I)=15
31200 2320 CONTINUE
31201C
31202      ITITLE='Normal Mixture Parameter Estimation'
31203      NCTITL=35
31204      ITITLZ=' '
31205      NCTITZ=0
31206C
31207      ICNT=1
31208      ITEXT(ICNT)='Summary Statistics:'
31209      NCTEXT(ICNT)=19
31210      AVALUE(ICNT)=0.0
31211      IDIGIT(ICNT)=-1
31212      ICNT=ICNT+1
31213      ITEXT(ICNT)='Number of Observations:'
31214      NCTEXT(ICNT)=23
31215      AVALUE(ICNT)=REAL(N)
31216      IF(NVAR.GT.1)AVALUE(ICNT)=REAL(NTOT2)
31217      IDIGIT(ICNT)=0
31218      ICNT=ICNT+1
31219      ITEXT(ICNT)='Sample Mean:'
31220      NCTEXT(ICNT)=12
31221      AVALUE(ICNT)=AMEAN
31222      IDIGIT(ICNT)=NUMDIG
31223      ICNT=ICNT+1
31224      ITEXT(ICNT)='Sample Standard Deviation:'
31225      NCTEXT(ICNT)=26
31226      AVALUE(ICNT)=ASD
31227      IDIGIT(ICNT)=NUMDIG
31228      ICNT=ICNT+1
31229      ITEXT(ICNT)='Sample Minimum:'
31230      NCTEXT(ICNT)=15
31231      AVALUE(ICNT)=AMIN
31232      IDIGIT(ICNT)=NUMDIG
31233      ICNT=ICNT+1
31234      ITEXT(ICNT)='Sample Maximum:'
31235      NCTEXT(ICNT)=15
31236      AVALUE(ICNT)=AMAX
31237      IDIGIT(ICNT)=NUMDIG
31238      ICNT=ICNT+1
31239      ITEXT(ICNT)=' '
31240      NCTEXT(ICNT)=0
31241      AVALUE(ICNT)=0.0
31242      IDIGIT(ICNT)=-1
31243C
31244      DO4230I=1,NCOMP
31245C
31246        IF(ICNT.GT.45)THEN
31247          NUMROW=ICNT
31248          IFRST=.TRUE.
31249          ILAST=.TRUE.
31250          CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
31251     1                AVALUE,IDIGIT,
31252     1                NTOT,NUMROW,
31253     1                ICAPSW,ICAPTY,ILAST,IFRST,
31254     1                ISUBRO,IBUGA3,IERROR)
31255          ICNT=0
31256          ITITLE=' '
31257          NCTITL=0
31258        ENDIF
31259C
31260        ICNT=ICNT+1
31261        ITEXT(ICNT)='Component    Maximum Likelihood Estimates:'
31262        WRITE(ITEXT(ICNT)(11:12),'(I2)')I
31263        NCTEXT(ICNT)=42
31264        AVALUE(ICNT)=0.0
31265        IDIGIT(ICNT)=-1
31266        ICNT=ICNT+1
31267        ITEXT(ICNT)='Mixing Proportion:'
31268        NCTEXT(ICNT)=18
31269        AVALUE(ICNT)=ALPHA(I)
31270        IDIGIT(ICNT)=NUMDIG
31271        ICNT=ICNT+1
31272        ITEXT(ICNT)='Mean:'
31273        NCTEXT(ICNT)=5
31274        AVALUE(ICNT)=XMEAN(I)
31275        IDIGIT(ICNT)=NUMDIG
31276        ICNT=ICNT+1
31277        ITEXT(ICNT)='Standard Deviation:'
31278        NCTEXT(ICNT)=19
31279        AVALUE(ICNT)=XSD(I)
31280        IDIGIT(ICNT)=NUMDIG
31281        ICNT=ICNT+1
31282        ITEXT(ICNT)=' '
31283        NCTEXT(ICNT)=0
31284        AVALUE(ICNT)=0.0
31285        IDIGIT(ICNT)=-1
31286 4230 CONTINUE
31287C
31288      ICNT=ICNT+1
31289      ITEXT(ICNT)='Log-likelihood:'
31290      NCTEXT(ICNT)=15
31291      AVALUE(ICNT)=ALOGL
31292      IDIGIT(ICNT)=-7
31293CCCCC ICNT=ICNT+1
31294CCCCC ITEXT(ICNT)='AIC:'
31295CCCCC NCTEXT(ICNT)=4
31296CCCCC AVALUE(ICNT)=AIC
31297CCCCC IDIGIT(ICNT)=-7
31298CCCCC ICNT=ICNT+1
31299CCCCC ITEXT(ICNT)='AICc:'
31300CCCCC NCTEXT(ICNT)=5
31301CCCCC AVALUE(ICNT)=AICC
31302CCCCC IDIGIT(ICNT)=-7
31303CCCCC ICNT=ICNT+1
31304CCCCC ITEXT(ICNT)='BIC:'
31305CCCCC NCTEXT(ICNT)=4
31306CCCCC AVALUE(ICNT)=BIC
31307CCCCC IDIGIT(ICNT)=-7
31308CCCCC ICNT=ICNT+1
31309CCCCC ITEXT(ICNT)=' '
31310CCCCC NCTEXT(ICNT)=0
31311CCCCC AVALUE(ICNT)=0.0
31312CCCCC IDIGIT(ICNT)=-1
31313C
31314      NUMROW=ICNT
31315      IFRST=.TRUE.
31316      ILAST=.TRUE.
31317      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
31318     1            AVALUE,IDIGIT,
31319     1            NTOT,NUMROW,
31320     1            ICAPSW,ICAPTY,ILAST,IFRST,
31321     1            ISUBRO,IBUGA3,IERROR)
31322C
31323C               *****************
31324C               **  STEP 90--  **
31325C               **  EXIT       **
31326C               *****************
31327C
31328 9000 CONTINUE
31329      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLNM')THEN
31330        WRITE(ICOUT,999)
31331        CALL DPWRST('XXX','WRIT')
31332        WRITE(ICOUT,9011)
31333 9011   FORMAT('***** AT THE END       OF DPMLNM--')
31334        CALL DPWRST('XXX','WRIT')
31335        WRITE(ICOUT,9012)N,IBUGA3,IERROR
31336 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
31337        CALL DPWRST('XXX','WRIT')
31338        WRITE(ICOUT,9015)N
31339 9015   FORMAT('N = ',I8)
31340        CALL DPWRST('XXX','WRIT')
31341      ENDIF
31342C
31343      RETURN
31344      END
31345      SUBROUTINE DPMLP1(Y,N,
31346     1                  DTEMP1,MAXNXT,
31347     1                  SHAPML,AML,SHAPSE,AMLSE,
31348     1                  SHAPMM,AMM,SHAPMO,AMOM,
31349     1                  QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,NPERC,ALPHAP,
31350     1                  ICAPSW,ICAPTY,IFORSW,
31351     1                  ISUBRO,IBUGA3,IERROR)
31352C
31353C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
31354C              ESTIMATES FOR PARETO DISTRIBUTION
31355C     EXAMPLE--PARETO MAXIMUM LIKELIHOOD Y
31356C     REFERENCE--COHEN AND WHITTEN (1988), "PARAMETER ESTIMATION IN
31357C                RELIABILITY AND LIFE SPAN MODELS", MARCEL DEKKER, INC.,
31358C                CHAPTER 11.
31359C     WRITTEN BY--ALAN HECKERT
31360C                 STATISTICAL ENGINEERING DIVISION
31361C                 INFORMATION TECHNOLOGY LABORATORY
31362C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
31363C                 GAITHERSBURG, MD 20899-8980
31364C                 PHONE--301-975-2899
31365C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
31366C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
31367C     LANGUAGE--ANSI FORTRAN (1977)
31368C     VERSION NUMBER--98/5
31369C     ORIGINAL VERSION--MAY       1998.
31370C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML, LATEX OUTPUT
31371C     UPDATED         --OCTOBER   2003. CONFIDENCE INTERVAL FOR SHAPE
31372C                                       PARAMETER
31373C     UPDATED         --DECEMBER  2004. MODIFY FORMAT OF OUTPUT
31374C     UPDATED         --JULY      2010. USE DPDTA1, DPDT8A, AND DPDTA9
31375C                                       TO PRINT OUTPUT
31376C     UPDATED         --JULY      2010. EXTRACT POINT ESTIMATES TO
31377C                                       PARML1
31378C
31379C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
31380C
31381      CHARACTER*4 ICAPSW
31382      CHARACTER*4 ICAPTY
31383      CHARACTER*4 IFORSW
31384      CHARACTER*4 ISUBRO
31385      CHARACTER*4 IBUGA3
31386      CHARACTER*4 IERROR
31387C
31388      CHARACTER*4 IWRITE
31389C
31390      CHARACTER*4 ISUBN1
31391      CHARACTER*4 ISUBN2
31392      CHARACTER*4 ISTEPN
31393C
31394C---------------------------------------------------------------------
31395C
31396CCCCC DOUBLE PRECISION DSUM
31397CCCCC DOUBLE PRECISION DTERM1
31398C
31399      PARAMETER (NUMALP=8)
31400      DIMENSION ALPHA(NUMALP)
31401      DIMENSION ALOWGA(NUMALP)
31402      DIMENSION AUPPGA(NUMALP)
31403      DIMENSION ALOWLO(NUMALP)
31404      DIMENSION AUPPLO(NUMALP)
31405      DIMENSION ALOWSC(NUMALP)
31406      DIMENSION AUPPSC(NUMALP)
31407C
31408      DIMENSION Y(*)
31409      DOUBLE PRECISION DTEMP1(*)
31410C
31411      DIMENSION QP(*)
31412      DIMENSION XQPHAT(*)
31413      DIMENSION XQPSE(*)
31414      DIMENSION XQPLCL(*)
31415      DIMENSION XQPUCL(*)
31416C
31417      PARAMETER (MAXROW=40)
31418      CHARACTER*60 ITITLE
31419      CHARACTER*60 ITITLZ
31420      CHARACTER*50 ITEXT(MAXROW)
31421      REAL         AVALUE(MAXROW)
31422      INTEGER      NCTEXT(MAXROW)
31423      INTEGER      IDIGIT(MAXROW)
31424      INTEGER      NTOT(MAXROW)
31425      LOGICAL IFRST
31426      LOGICAL ILAST
31427C
31428      CHARACTER*4 ILIKFL
31429      CHARACTER*4 ILOCFL
31430      CHARACTER*4 ISCAFL
31431      CHARACTER*8 ISHAP1
31432      CHARACTER*8 ISHAP2
31433C
31434C---------------------------------------------------------------------
31435C
31436      INCLUDE 'DPCOP2.INC'
31437C
31438      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
31439C
31440C-----START POINT-----------------------------------------------------
31441C
31442      ISUBN1='DPML'
31443      ISUBN2='P1  '
31444      IWRITE='NO'
31445      IERROR='NO'
31446C
31447      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLP1')THEN
31448        WRITE(ICOUT,999)
31449  999   FORMAT(1X)
31450        CALL DPWRST('XXX','WRIT')
31451        WRITE(ICOUT,51)
31452   51   FORMAT('**** AT THE BEGINNING OF DPMLPA--')
31453        CALL DPWRST('XXX','WRIT')
31454        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NPERC,MAXNXT
31455   52   FORMAT('IBUGA3,ISUBRO,N,NPERC,MAXNXT = ',2(A4,2X),3I8)
31456        CALL DPWRST('XXX','WRIT')
31457        DO56I=1,MIN(N,100)
31458          WRITE(ICOUT,57)I,Y(I)
31459   57     FORMAT('I,Y(I) = ',I8,G15.7)
31460          CALL DPWRST('XXX','WRIT')
31461   56   CONTINUE
31462      ENDIF
31463C
31464C               ********************************************
31465C               **  STEP 11--                             **
31466C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
31467C               ********************************************
31468C
31469      ISTEPN='11'
31470      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLP1')
31471     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
31472C
31473      NMIN=3
31474      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
31475      IF(IERROR.EQ.'YES')GOTO9000
31476C
31477C     STEP 1: OBTAIN POINT ESTIMATES AND STANDARD ERRORS
31478C
31479      CALL PARML1(Y,N,
31480     1            DTEMP1,
31481     1            XMEAN,XSD,XMIN,XMAX,
31482     1            AMOM,SHAPMO,
31483     1            AMM,SHAPMM,
31484     1            AML,SHAPML,AMLSE,SHAPSE,
31485     1            ISUBRO,IBUGA3,IERROR)
31486      IF(IERROR.EQ.'YES')GOTO9000
31487C
31488      CALL PARLI1(Y,N,
31489     1            AMOM,SHAPMO,
31490     1            ALIKMO,AICMO,AICCMO,BICMO,
31491     1            ISUBRO,IBUGA3,IERROR)
31492C
31493      CALL PARLI1(Y,N,
31494     1            AMM,SHAPMM,
31495     1            ALIKMM,AICMM,AICCMM,BICMM,
31496     1            ISUBRO,IBUGA3,IERROR)
31497C
31498      CALL PARLI1(Y,N,
31499     1            AML,SHAPML,
31500     1            ALIKML,AICML,AICCML,BICML,
31501     1            ISUBRO,IBUGA3,IERROR)
31502C
31503C     NOW GENERATE CONFIDENCE INTERVALS FOR MODIFIED MAXIMUM
31504C     LIKELIHOOD
31505C
31506      NU=2*(N-1)
31507C
31508      DO4120I=1,NUMALP
31509        ALP=ALPHA(I)
31510        PL=ALP/2.0
31511        PU=1.0-(ALP/2.0)
31512        CALL CHSPPF(PL,NU,PPF1)
31513        CALL CHSPPF(PU,NU,PPF2)
31514        CALL NORPPF(PU,PPF3)
31515        ALOWGA(I)=SHAPML*PPF1/REAL(2*N)
31516        AUPPGA(I)=SHAPML*PPF2/REAL(2*N)
31517        IF(AMLSE.GT.0.0)THEN
31518          ALOWLO(I)=AML - PPF3*AMLSE
31519          AUPPLO(I)=AML + PPF3*AMLSE
31520          IF(AUPPLO(I).GT.XMIN)AUPPLO(I)=XMIN
31521        ELSE
31522          ALOWLO(I)=CPUMIN
31523          AUPPLO(I)=CPUMIN
31524        ENDIF
31525 4120 CONTINUE
31526C
31527C      CONFIDENCE INTERVALS FOR SELECTED PERCENTILES.
31528C
31529C      METHOD OF ASTRABADI AS DESCRIBED ON PP. 591-592 OF JOHNSON,
31530C      KOTZ, AND BALAKRISHNAN (SEE REFERENCE ABOVE).  THESE ARE
31531C      APPROXIMATE INTERVALS.  THIS STILL NEEDS ADDITIONAL
31532C      ALGORITHMIC WORK, SO COMMENT OUT FOR NOW.
31533C
31534      NPERC=0
31535      IF(NPERC.GE.1)THEN
31536C
31537        ALPHL=ALPHAP/2.0
31538        ALPHU=1.0 - ALPHAP/2.0
31539        NUTEMP=2*N
31540        CALL CHSPPF(ALPHL,NUTEMP,ZLOW)
31541        CALL CHSPPF(ALPHU,NUTEMP,ZUPP)
31542C
31543CCCCC   WRITE(IOUNI1,4131)
31544CCCCC   WRITE(IOUNI1,4132)
31545        DO4139I=1,NPERC
31546          QPTEMP=QP(I)/100.0
31547          CALL PARPPF(QPTEMP,SHAPML,AML,APPF)
31548          XQPHAT(I)=APPF
31549C
31550          TERM1=2.0*SHAPML*LOG(APPF/AML)/ZLOW
31551          TERM2=TERM1**(AN-1.0)
31552          TERM3=(1.0 - TERM1)**(AN-1.0)
31553          XQPLCL(I)=1.0 - TERM2
31554          XQPUCL(I)=1.0 - TERM3
31555CCCCC     WRITE(IOUNI1,'(4E15.7)')
31556CCCCC1         QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I)
31557 4139   CONTINUE
31558C4131   FORMAT(15X,'       POINT     ','     LOWER     ',
31559CCCCC1         '     UPPER')
31560C4132   FORMAT('    PERCENTILE ','     ESTIMATE   ',
31561CCCCC1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
31562C
31563      ENDIF
31564C
31565C               *********************************
31566C               **   STEP 42--                 **
31567C               **   WRITE OUT EVERYTHING      **
31568C               **   FOR PARETO MLE ESTIMATE   **
31569C               **********************************
31570C
31571      ISTEPN='42'
31572      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLP1')
31573     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
31574C
31575      IF(IPRINT.EQ.'OFF')GOTO9000
31576C
31577      NUMDIG=7
31578      IF(IFORSW.EQ.'1')NUMDIG=1
31579      IF(IFORSW.EQ.'2')NUMDIG=2
31580      IF(IFORSW.EQ.'3')NUMDIG=3
31581      IF(IFORSW.EQ.'4')NUMDIG=4
31582      IF(IFORSW.EQ.'5')NUMDIG=5
31583      IF(IFORSW.EQ.'6')NUMDIG=6
31584      IF(IFORSW.EQ.'7')NUMDIG=7
31585      IF(IFORSW.EQ.'8')NUMDIG=8
31586      IF(IFORSW.EQ.'9')NUMDIG=9
31587      IF(IFORSW.EQ.'0')NUMDIG=0
31588      IF(IFORSW.EQ.'E')NUMDIG=-2
31589      IF(IFORSW.EQ.'-2')NUMDIG=-2
31590      IF(IFORSW.EQ.'-3')NUMDIG=-3
31591      IF(IFORSW.EQ.'-4')NUMDIG=-4
31592      IF(IFORSW.EQ.'-5')NUMDIG=-5
31593      IF(IFORSW.EQ.'-6')NUMDIG=-6
31594      IF(IFORSW.EQ.'-7')NUMDIG=-7
31595      IF(IFORSW.EQ.'-8')NUMDIG=-8
31596      IF(IFORSW.EQ.'-9')NUMDIG=-9
31597C
31598      ITITLE='Pareto Parameter Estimation'
31599      NCTITL=27
31600      ITITLZ='Full Sample Case'
31601      NCTITZ=16
31602      ICNT=1
31603      ITEXT(ICNT)='Summary Statistics:'
31604      NCTEXT(ICNT)=19
31605      AVALUE(ICNT)=0.0
31606      IDIGIT(ICNT)=-1
31607      ICNT=ICNT+1
31608      ITEXT(ICNT)='Number of Observations:'
31609      NCTEXT(ICNT)=23
31610      AVALUE(ICNT)=REAL(N)
31611      IDIGIT(ICNT)=0
31612      ICNT=ICNT+1
31613      ITEXT(ICNT)='Sample Mean:'
31614      NCTEXT(ICNT)=12
31615      AVALUE(ICNT)=XMEAN
31616      IDIGIT(ICNT)=NUMDIG
31617      ICNT=ICNT+1
31618      ITEXT(ICNT)='Sample Standard Deviation:'
31619      NCTEXT(ICNT)=26
31620      AVALUE(ICNT)=XSD
31621      IDIGIT(ICNT)=NUMDIG
31622      ICNT=ICNT+1
31623      ITEXT(ICNT)='Sample Minimum:'
31624      NCTEXT(ICNT)=15
31625      AVALUE(ICNT)=XMIN
31626      IDIGIT(ICNT)=NUMDIG
31627      ICNT=ICNT+1
31628      ITEXT(ICNT)='Sample Maximum:'
31629      NCTEXT(ICNT)=15
31630      AVALUE(ICNT)=XMAX
31631      IDIGIT(ICNT)=NUMDIG
31632      ICNT=ICNT+1
31633      ITEXT(ICNT)=' '
31634      NCTEXT(ICNT)=0
31635      AVALUE(ICNT)=0.0
31636      IDIGIT(ICNT)=-1
31637C
31638      IF(AMOM.GT.0.0)THEN
31639        ICNT=ICNT+1
31640        ITEXT(ICNT)='Moments:'
31641        NCTEXT(ICNT)=8
31642        AVALUE(ICNT)=0.0
31643        IDIGIT(ICNT)=-1
31644        ICNT=ICNT+1
31645        ITEXT(ICNT)='Estimate of Threshold (A):'
31646        NCTEXT(ICNT)=26
31647        AVALUE(ICNT)=AMOM
31648        IDIGIT(ICNT)=NUMDIG
31649        ICNT=ICNT+1
31650        ITEXT(ICNT)='Estimate of Shape (Gamma):'
31651        NCTEXT(ICNT)=26
31652        AVALUE(ICNT)=SHAPMO
31653        IDIGIT(ICNT)=NUMDIG
31654        ICNT=ICNT+1
31655        ITEXT(ICNT)='Log-likelihood:'
31656        NCTEXT(ICNT)=15
31657        AVALUE(ICNT)=ALIKMO
31658        IDIGIT(ICNT)=-7
31659        ICNT=ICNT+1
31660        ITEXT(ICNT)='AIC:'
31661        NCTEXT(ICNT)=4
31662        AVALUE(ICNT)=AICMO
31663        IDIGIT(ICNT)=-7
31664        ICNT=ICNT+1
31665        ITEXT(ICNT)='AICc:'
31666        NCTEXT(ICNT)=5
31667        AVALUE(ICNT)=AICCMO
31668        IDIGIT(ICNT)=-7
31669        ICNT=ICNT+1
31670        ITEXT(ICNT)='BIC:'
31671        NCTEXT(ICNT)=4
31672        AVALUE(ICNT)=BICMO
31673        IDIGIT(ICNT)=-7
31674        ICNT=ICNT+1
31675        ITEXT(ICNT)=' '
31676        NCTEXT(ICNT)=0
31677        AVALUE(ICNT)=0.0
31678        IDIGIT(ICNT)=-1
31679      ENDIF
31680C
31681      ICNT=ICNT+1
31682      ITEXT(ICNT)='Modified Moments:'
31683      NCTEXT(ICNT)=17
31684      AVALUE(ICNT)=0.0
31685      IDIGIT(ICNT)=-1
31686      ICNT=ICNT+1
31687      ITEXT(ICNT)='Estimate of Threshold (A):'
31688      NCTEXT(ICNT)=26
31689      AVALUE(ICNT)=AMM
31690      IDIGIT(ICNT)=NUMDIG
31691      ICNT=ICNT+1
31692      ITEXT(ICNT)='Estimate of Shape (Gamma):'
31693      NCTEXT(ICNT)=26
31694      AVALUE(ICNT)=SHAPMM
31695      IDIGIT(ICNT)=NUMDIG
31696      ICNT=ICNT+1
31697      ITEXT(ICNT)='Log-likelihood:'
31698      NCTEXT(ICNT)=15
31699      AVALUE(ICNT)=ALIKMM
31700      IDIGIT(ICNT)=-7
31701      ICNT=ICNT+1
31702      ITEXT(ICNT)='AIC:'
31703      NCTEXT(ICNT)=4
31704      AVALUE(ICNT)=AICMM
31705      IDIGIT(ICNT)=-7
31706      ICNT=ICNT+1
31707      ITEXT(ICNT)='AICc:'
31708      NCTEXT(ICNT)=5
31709      AVALUE(ICNT)=AICCMM
31710      IDIGIT(ICNT)=-7
31711      ICNT=ICNT+1
31712      ITEXT(ICNT)='BIC:'
31713      NCTEXT(ICNT)=4
31714      AVALUE(ICNT)=BICMM
31715      IDIGIT(ICNT)=-7
31716      ICNT=ICNT+1
31717      ITEXT(ICNT)=' '
31718      NCTEXT(ICNT)=0
31719      AVALUE(ICNT)=0.0
31720      IDIGIT(ICNT)=-1
31721C
31722      ICNT=ICNT+1
31723      ITEXT(ICNT)='Modified Maximum Likelihood:'
31724      NCTEXT(ICNT)=28
31725      AVALUE(ICNT)=0.0
31726      IDIGIT(ICNT)=-1
31727      ICNT=ICNT+1
31728      ITEXT(ICNT)='Estimate of Threshold (A):'
31729      NCTEXT(ICNT)=26
31730      AVALUE(ICNT)=AML
31731      IDIGIT(ICNT)=NUMDIG
31732      IF(AMLSE.GT.0.0)THEN
31733        ICNT=ICNT+1
31734        ITEXT(ICNT)='Standard Error of Threshold:'
31735        NCTEXT(ICNT)=28
31736        AVALUE(ICNT)=AMLSE
31737        IDIGIT(ICNT)=NUMDIG
31738      ENDIF
31739      ICNT=ICNT+1
31740      ITEXT(ICNT)='Estimate of Shape (Gamma):'
31741      NCTEXT(ICNT)=26
31742      AVALUE(ICNT)=SHAPML
31743      IDIGIT(ICNT)=NUMDIG
31744      IF(SHAPSE.GT.0.0)THEN
31745        ICNT=ICNT+1
31746        ITEXT(ICNT)='Standard Error of Gamma:'
31747        NCTEXT(ICNT)=24
31748        AVALUE(ICNT)=SHAPSE
31749        IDIGIT(ICNT)=NUMDIG
31750      ENDIF
31751C
31752      ICNT=ICNT+1
31753      ITEXT(ICNT)='Log-likelihood:'
31754      NCTEXT(ICNT)=15
31755      AVALUE(ICNT)=ALIKML
31756      IDIGIT(ICNT)=-7
31757      ICNT=ICNT+1
31758      ITEXT(ICNT)='AIC:'
31759      NCTEXT(ICNT)=4
31760      AVALUE(ICNT)=AICML
31761      IDIGIT(ICNT)=-7
31762      ICNT=ICNT+1
31763      ITEXT(ICNT)='AICc:'
31764      NCTEXT(ICNT)=5
31765      AVALUE(ICNT)=AICCML
31766      IDIGIT(ICNT)=-7
31767      ICNT=ICNT+1
31768      ITEXT(ICNT)='BIC:'
31769      NCTEXT(ICNT)=4
31770      AVALUE(ICNT)=BICML
31771      IDIGIT(ICNT)=-7
31772C
31773      NUMROW=ICNT
31774      DO2320I=1,NUMROW
31775        NTOT(I)=15
31776 2320 CONTINUE
31777C
31778      IFRST=.TRUE.
31779      ILAST=.TRUE.
31780      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
31781     1            AVALUE,IDIGIT,
31782     1            NTOT,NUMROW,
31783     1            ICAPSW,ICAPTY,ILAST,IFRST,
31784     1            ISUBRO,IBUGA3,IERROR)
31785C
31786      ALOWSC(1)=CPUMIN
31787      ILIKFL='EXAC'
31788      ILOCFL='OFF'
31789      ISCAFL='OFF'
31790      ISHAP1='A'
31791      NCSHA1=1
31792      ISHAP2='Gamma'
31793      NCSHA2=5
31794      CALL DPDT8A(ALOWSC,AUPPSC,ALOWSC,AUPPSC,
31795     1            ALOWLO,AUPPLO,ALOWLO,AUPPLO,
31796     1            ALOWGA,AUPPGA,ALOWGA,AUPPGA,
31797     1            ALPHA,NUMALP,
31798     1            ICAPSW,ICAPTY,NUMDIG,
31799     1            ILOCFL,ISCAFL,ILIKFL,
31800     1            ISHAP1,NCSHA1,ISHAP2,NCSHA2,
31801     1            ISUBRO,IBUGA3,IERROR)
31802C
31803      IF(NPERC.GE.1)THEN
31804        ILIKFL='PARE'
31805        XQPSE(1)=CPUMIN
31806        CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
31807     1              ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
31808     1              ISUBRO,IBUGA3,IERROR)
31809      ENDIF
31810C
31811C               *****************
31812C               **  STEP 90--  **
31813C               **  EXIT       **
31814C               *****************
31815C
31816 9000 CONTINUE
31817      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLP1')THEN
31818        WRITE(ICOUT,999)
31819        CALL DPWRST('XXX','WRIT')
31820        WRITE(ICOUT,9011)
31821 9011   FORMAT('***** AT THE END       OF DPMLP1--')
31822        CALL DPWRST('XXX','WRIT')
31823        WRITE(ICOUT,9012)N,IBUGA3,IERROR
31824 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
31825        CALL DPWRST('XXX','WRIT')
31826      ENDIF
31827C
31828      RETURN
31829      END
31830      SUBROUTINE DPMLPL(Y1,N,X1,NGROUP,XCEN,NCENS,NUMV,
31831     1                  XIDTEM,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,
31832     1                  TEMP7,TEMP8,MAXNXT,
31833     1                  TEND,
31834     1                  ICAPSW,ICAPTY,IFORSW,
31835     1                  IOUNI1,IOUNI2,ALPHAP,
31836     1                  AHAT,BHAT,AMTBF,
31837     1                  ISUBRO,IBUGA3,IERROR)
31838C
31839C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
31840C              ESTIMATES FOR A NON-HOMOGENEOUS POISSON PROCESS
31841C              THAT FOLLOWS THE "POWER LAW" MODEL.
31842C
31843C              THE POWER LAW MODEL IS:
31844C
31845C                  M(t) = a*t**b
31846C
31847C              WHERE
31848C
31849C               M(t) = CUMULATIVE REPAIR FUNCTION
31850C               t    = TIME TO FAILURE
31851C               a, b = PARAMETERS TO BE ESTIMATED
31852C
31853C               THE POWER LAW OFTEN APPLIES WHEN WE HAVE
31854C               MONOTONICALLY INCREASING OR DECREASING TRENDS
31855C               IN THE REPAIR DATA.
31856C
31857C              THE INPUT IS ASSUMED TO BE REPAIR TIMES.  WE CAN
31858C              OPTIONALLY HAVE A XCENORING VARIABLE (THERE SHOULD
31859C              BE AT MOST ONE XCENORING TIME).
31860C
31861C              FOR THE CASE WHERE THE TEST IS TERMINATED AT THE
31862C              NTH FAILURE, THE MAXIMUM LIKELIHOOD ESTIMATES ARE:
31863C
31864C                  bhat = (n-1)/SUM[i=1 to n-1][LOG(t(n)/t(i))]
31865C                  ahat = n/t(n)**bhat
31866C
31867C              FOR THE CASE WHERE THE TEST IS TERMINATED AT A FIXED
31868C              TIME T, THE MAXIMUM LIKELIHOOD ESTIMATES ARE:
31869C
31870C                  bhat = (n-1)/SUM[i=1 to n][LOG(T/t(i))]
31871C                  ahat = n/T**bhat
31872C
31873C              IF THERE ARE K COPIES OF THE SYSTEM, THEN THE
31874C              WE CAN COMBINE THE ESTIMATES TO OBTAIN:
31875C
31876C                 bhat = (N(s) - 1)/(SUM[q=1 tp k][SUM[i=1 to q]
31877C                        [LOG(T(q)/t(iq)]
31878C                 ahat = SUM[q=1 to k][n(q)]/SUM[q=1 to k][T(q)**bhat]
31879C
31880C              WHERE
31881C
31882C                 T(q)    = TRUNCATION TIME FOR QTH SYSTEM
31883C                 n(q)    = NUMBER OF FAILURE TIMES FOR QTH SYSTEM
31884C                 N(q)    = n(q) IF WE HAVE A XCENORING TIME
31885C                           n(q) - 1 IF THERE IS NO XCENORING TIME
31886C                 t(iq)   = ITH FAILURE TIME FOR QTH SYSTEM
31887C                 N(s)    = SUM[q=1 to k][N(q)][N(q)]
31888C
31889C     EXAMPLE--EXPONENTIAL MAXIMUM LIKELIHOOD Y
31890C     REFERENCE--TOBIAS AND TRINDADE, "APPLIED RELIABILITY", SECOND
31891C                EDITION, PP. 357-358.
31892C     WRITTEN BY--ALAN HECKERT
31893C                 STATISTICAL ENGINEERING DIVISION
31894C                 INFORMATION TECHNOLOGY LABORATORY
31895C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
31896C                 GAITHERSBURG, MD 20899-8980
31897C                 PHONE--301-975-2899
31898C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
31899C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
31900C     LANGUAGE--ANSI FORTRAN (1977)
31901C     VERSION NUMBER--2006/10
31902C     ORIGINAL VERSION--OCTOBER   2006.
31903C     UPDATED         --APRIL     2011. USE DPDTA1 TO PRINT OUTPUT
31904C
31905C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
31906C
31907      CHARACTER*4 ICAPSW
31908      CHARACTER*4 ICAPTY
31909      CHARACTER*4 IFORSW
31910      CHARACTER*4 ISUBRO
31911      CHARACTER*4 IBUGA3
31912      CHARACTER*4 IERROR
31913C
31914      CHARACTER*4 IWRITE
31915      CHARACTER*4 ISUBN1
31916      CHARACTER*4 ISUBN2
31917      CHARACTER*4 ISTEPN
31918C
31919      DOUBLE PRECISION DSUM
31920      DOUBLE PRECISION DSUM1
31921CCCCC DOUBLE PRECISION DSUM2
31922      DOUBLE PRECISION DTERM1
31923      DOUBLE PRECISION DTERM2
31924C
31925C---------------------------------------------------------------------
31926C
31927      PARAMETER (NUMALP=6)
31928      PARAMETER (NUMAL2=5)
31929      DIMENSION ALPHA(NUMALP)
31930CCCCC DIMENSION ALPHA2(5)
31931      DIMENSION A2LOWB(NUMALP)
31932      DIMENSION A2UPPB(NUMALP)
31933C
31934      DIMENSION Y1(*)
31935      DIMENSION X1(*)
31936      DIMENSION XCEN(*)
31937      DIMENSION XIDTEM(*)
31938      DIMENSION TEMP2(*)
31939      DIMENSION TEMP3(*)
31940      DIMENSION TEMP4(*)
31941      DIMENSION TEMP5(*)
31942      DIMENSION TEMP6(*)
31943      DIMENSION TEMP7(*)
31944      DIMENSION TEMP8(*)
31945C
31946      PARAMETER (MAXROW=100)
31947      PARAMETER(NUMCLI=4)
31948      PARAMETER(MAXLIN=3)
31949C
31950      CHARACTER*60 ITITLE
31951      CHARACTER*60 ITITLZ
31952      CHARACTER*60 ITITL9
31953      CHARACTER*50 ITEXT(MAXROW)
31954      CHARACTER*4  ALIGN(MAXROW)
31955      CHARACTER*4  VALIGN(MAXROW)
31956      CHARACTER*4  ITYPCO(NUMCLI)
31957      REAL         AVALUE(MAXROW)
31958      INTEGER      NCTEXT(MAXROW)
31959      INTEGER      IDIGIT(MAXROW)
31960      INTEGER      NTOT(MAXROW)
31961      LOGICAL      IFRST
31962      LOGICAL      ILAST
31963      LOGICAL      IFLAGS
31964      LOGICAL      IFLAGE
31965C
31966      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
31967      CHARACTER*15 IVALUE(NUMALP,NUMCLI)
31968      INTEGER      NCTIT2(MAXLIN,NUMCLI)
31969      INTEGER      NCVALU(NUMALP,NUMCLI)
31970      INTEGER      IWHTML(NUMCLI+1)
31971      INTEGER      IWRTF(NUMCLI)
31972      REAL         AMAT(NUMALP,NUMCLI)
31973C
31974C---------------------------------------------------------------------
31975C
31976      INCLUDE 'DPCOP2.INC'
31977C
31978      DATA ALPHA  /0.50, 0.20, 0.10, 0.05, 0.01, 0.001/
31979CCCCC DATA ALPHA2 /0.20, 0.15, 0.10, 0.05, 0.01/
31980C
31981C-----START POINT-----------------------------------------------------
31982C
31983      ISUBN1='DPML'
31984      ISUBN2='PL  '
31985      IERROR='NO'
31986      IWRITE='OFF'
31987C
31988      NUMDIG=7
31989      IF(IFORSW.EQ.'1')NUMDIG=1
31990      IF(IFORSW.EQ.'2')NUMDIG=2
31991      IF(IFORSW.EQ.'3')NUMDIG=3
31992      IF(IFORSW.EQ.'4')NUMDIG=4
31993      IF(IFORSW.EQ.'5')NUMDIG=5
31994      IF(IFORSW.EQ.'6')NUMDIG=6
31995      IF(IFORSW.EQ.'7')NUMDIG=7
31996      IF(IFORSW.EQ.'8')NUMDIG=8
31997      IF(IFORSW.EQ.'9')NUMDIG=9
31998      IF(IFORSW.EQ.'0')NUMDIG=0
31999      IF(IFORSW.EQ.'E')NUMDIG=-2
32000      IF(IFORSW.EQ.'-2')NUMDIG=-2
32001      IF(IFORSW.EQ.'-3')NUMDIG=-3
32002      IF(IFORSW.EQ.'-4')NUMDIG=-4
32003      IF(IFORSW.EQ.'-5')NUMDIG=-5
32004      IF(IFORSW.EQ.'-6')NUMDIG=-6
32005      IF(IFORSW.EQ.'-7')NUMDIG=-7
32006      IF(IFORSW.EQ.'-8')NUMDIG=-8
32007      IF(IFORSW.EQ.'-9')NUMDIG=-9
32008C
32009      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPL')THEN
32010        WRITE(ICOUT,999)
32011  999   FORMAT(1X)
32012        CALL DPWRST('XXX','WRIT')
32013        WRITE(ICOUT,51)
32014   51   FORMAT('**** AT THE BEGINNING OF DPMLPL--')
32015        CALL DPWRST('XXX','WRIT')
32016        WRITE(ICOUT,52)IBUGA3,IOUNI1,IOUNI2,MAXNXT
32017   52   FORMAT('IBUGA3,IOUNI1,IOUNI2,MAXNXT = ',A4,2X,3I8)
32018        CALL DPWRST('XXX','WRIT')
32019        WRITE(ICOUT,55)N,NGROUP,NCENS,NUMV,TEND,ALPHAP
32020   55   FORMAT('N,NGROUP,NCENS,NUMV,TEND,ALPHAP = ',4I8,2G15.7)
32021        CALL DPWRST('XXX','WRIT')
32022        DO56I=1,MIN(N,100)
32023          WRITE(ICOUT,57)I,Y1(I),X1(I),XCEN(I)
32024   57     FORMAT('I,Y1(I),X1(I),XCEN(I) = ',I8,3G15.7)
32025          CALL DPWRST('XXX','WRIT')
32026   56   CONTINUE
32027      ENDIF
32028C
32029C               ********************************************
32030C               **  STEP 11--                             **
32031C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
32032C               ********************************************
32033C
32034      ISTEPN='11'
32035      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPL')
32036     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
32037C
32038      IF(N.LT.2)THEN
32039        WRITE(ICOUT,999)
32040        CALL DPWRST('XXX','WRIT')
32041        WRITE(ICOUT,1111)
32042 1111   FORMAT('***** ERROR IN POWER LAW MAXIMUM LIKELIHOOD--')
32043        CALL DPWRST('XXX','WRIT')
32044        WRITE(ICOUT,1112)
32045 1112   FORMAT('      THE NUMBER OF OBSERVATIONS IS < 2')
32046        CALL DPWRST('XXX','WRIT')
32047        WRITE(ICOUT,1113)N
32048 1113   FORMAT('      SAMPLE SIZE = ',I8)
32049        CALL DPWRST('XXX','WRIT')
32050        IERROR='YES'
32051        GOTO9000
32052      ENDIF
32053C
32054      DO1135I=2,N
32055        IF(Y1(I).LE.0.0)THEN
32056          WRITE(ICOUT,999)
32057          CALL DPWRST('XXX','WRIT')
32058          WRITE(ICOUT,1111)
32059          CALL DPWRST('XXX','WRIT')
32060          WRITE(ICOUT,1132)I
32061 1132     FORMAT('      FAILURE TIME ',I8,' IS NON-POSITIVE.')
32062          CALL DPWRST('XXX','WRIT')
32063          WRITE(ICOUT,1134)Y1(I)
32064 1134     FORMAT('      FAILURE TIME = ',G15.7)
32065          CALL DPWRST('XXX','WRIT')
32066          IERROR='YES'
32067          GOTO9000
32068        ENDIF
32069 1135 CONTINUE
32070C
32071C               **********************************
32072C               **  STEP 41--                   **
32073C               **  CARRY OUT CALCULATIONS      **
32074C               **  FOR POWER LAW MLE           **
32075C               **  ESTIMATE (FULL SAMPLE CASE) **
32076C               **********************************
32077C
32078      ISTEPN='41'
32079      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPL')
32080     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
32081C
32082      AN=REAL(N)
32083C
32084C     CASE 1: NO GROUP OR CENSORING VARIABLE
32085C
32086      IF(NGROUP.EQ.0 .AND. NCENS.EQ.0)THEN
32087        CALL SORT(Y1,N,Y1)
32088        IF(TEND.LE.Y1(N))TEND=0.0
32089        IF(TEND.LE.0.0)THEN
32090          NFAIL=N
32091          NUMCEN=0
32092          DSUM=0.0D0
32093          ICNT=0
32094          DTERM2=DBLE(Y1(N))
32095          DO4110I=1,N-1
32096            DTERM1=DBLE(Y1(I))
32097            DSUM=DSUM + DLOG(DTERM2/DTERM1)
32098            ICNT=ICNT+1
32099            TEMP8(ICNT)=DTERM1/DTERM2
32100 4110     CONTINUE
32101          BHAT=DBLE(N-1)/DSUM
32102          AHAT=DBLE(N)/DTERM2**DBLE(BHAT)
32103          AMTBF=Y1(N)/(AN*BHAT)
32104          DO4115I=1,NUMALP
32105            ALP=ALPHA(I)
32106            P=1.0 - (ALP/2.0)
32107            CALL NORPPF(P,PPF)
32108            ANUM=AN*(AN-1.0)
32109            TERM1=AN + PPF**2/4.0
32110            TERM2=SQRT(AN*PPF**2/2.0 + PPF**4/16.0)
32111            ADEN=(TERM1 + TERM2)**2
32112            A2LOWB(I)=AMTBF*ANUM/ADEN
32113            TERM1=AN - PPF*SQRT(AN/2.0)
32114            ADEN=TERM1**2
32115            A2UPPB(I)=AMTBF*ANUM/ADEN
32116 4115     CONTINUE
32117        ELSE
32118          NFAIL=N
32119          NUMCEN=1
32120          DSUM=0.0D0
32121          ICNT=0
32122          DTERM2=DBLE(TEND)
32123          DO4120I=1,N
32124            DTERM1=DBLE(Y1(I))
32125            DSUM=DSUM + DLOG(DBLE(DTERM2/DTERM1))
32126            ICNT=ICNT+1
32127            TEMP8(ICNT)=DTERM1/DTERM2
32128 4120     CONTINUE
32129          BHAT=DBLE(N-1)/DSUM
32130          AHAT=DBLE(N)/DTERM2**DBLE(BHAT)
32131          AMTBF=TEND/(AN*BHAT)
32132          DO4125I=1,NUMALP
32133            ALP=ALPHA(I)
32134            P=1.0 - (ALP/2.0)
32135            CALL NORPPF(P,PPF)
32136            ANUM=AN*(AN-1.0)
32137            TERM1=AN + PPF**2/4.0
32138            TERM2=SQRT(AN*PPF**2/2.0 + PPF**4/16.0)
32139            ADEN=(TERM1 + TERM2)**2
32140            A2LOWB(I)=AMTBF*ANUM/ADEN
32141            TERM1=AN - PPF*SQRT(AN/2.0)
32142            ADEN=TERM1**2
32143            A2UPPB(I)=AMTBF*ANUM/ADEN
32144 4125     CONTINUE
32145        ENDIF
32146C
32147C     PRINT TABLE
32148C
32149      ITITLE='Power Law Maximum Likelihood Estimation (M(t) = a*t**b)'
32150      NCTITL=55
32151      IF(NUMCEN.EQ.0)THEN
32152        ITITLZ='Single System, Failure Truncated Case'
32153        NCTITZ=37
32154      ELSE
32155        ITITLZ='Single System, Time Truncated Case'
32156        NCTITZ=34
32157      ENDIF
32158C
32159      ICNT=1
32160      ITEXT(ICNT)='Summary Statistics:'
32161      NCTEXT(ICNT)=19
32162      AVALUE(ICNT)=0.0
32163      IDIGIT(ICNT)=-1
32164      ICNT=ICNT+1
32165      ITEXT(ICNT)='Number of Failure Times:'
32166      NCTEXT(ICNT)=24
32167      AVALUE(ICNT)=REAL(NFAIL)
32168      IDIGIT(ICNT)=0
32169      IF(TEND.GT.0.0)THEN
32170        ICNT=ICNT+1
32171        ITEXT(ICNT)='Censoring Time:'
32172        NCTEXT(ICNT)=15
32173        AVALUE(ICNT)=TEND
32174        IDIGIT(ICNT)=NUMDIG
32175      ENDIF
32176      ICNT=ICNT+1
32177      ITEXT(ICNT)=' '
32178      NCTEXT(ICNT)=0
32179      AVALUE(ICNT)=0.0
32180      IDIGIT(ICNT)=-1
32181C
32182      ICNT=ICNT+1
32183      ITEXT(ICNT)='Parameter Estimates:'
32184      NCTEXT(ICNT)=20
32185      AVALUE(ICNT)=0.0
32186      IDIGIT(ICNT)=-1
32187      ICNT=ICNT+1
32188      ITEXT(ICNT)='Estimate of B:'
32189      NCTEXT(ICNT)=14
32190      AVALUE(ICNT)=BHAT
32191      IDIGIT(ICNT)=NUMDIG
32192      ICNT=ICNT+1
32193      ITEXT(ICNT)='Estimate of A:'
32194      NCTEXT(ICNT)=14
32195      AVALUE(ICNT)=AHAT
32196      IDIGIT(ICNT)=NUMDIG
32197      ICNT=ICNT+1
32198      ITEXT(ICNT)='Estimate of Reliability Growth Slope:'
32199      NCTEXT(ICNT)=37
32200      AVALUE(ICNT)=1.0 - BHAT
32201      IDIGIT(ICNT)=NUMDIG
32202      ICNT=ICNT+1
32203      ITEXT(ICNT)='Estimate of MTBF at End of Test:'
32204      NCTEXT(ICNT)=32
32205      AVALUE(ICNT)=AMTBF
32206      IDIGIT(ICNT)=NUMDIG
32207      ICNT=ICNT+1
32208      ITEXT(ICNT)=' '
32209      NCTEXT(ICNT)=0
32210      AVALUE(ICNT)=0.0
32211      IDIGIT(ICNT)=-1
32212C
32213      NUMROW=ICNT
32214      DO2310I=1,NUMROW
32215        NTOT(I)=15
32216 2310 CONTINUE
32217C
32218      IFRST=.TRUE.
32219      ILAST=.TRUE.
32220      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
32221     1            AVALUE,IDIGIT,
32222     1            NTOT,NUMROW,
32223     1            ICAPSW,ICAPTY,ILAST,IFRST,
32224     1            ISUBRO,IBUGA3,IERROR)
32225C
32226      ITITL9='Approximate Confidence Interval for End of Test MTBF'
32227      NCTIT9=52
32228      ITITLE=' '
32229      NCTITL=0
32230C
32231      NUMLIN=2
32232      NUMCOL=3
32233      ITITL2(1,1)='Confidence'
32234      ITITL2(2,1)='Value (%)'
32235      NCTIT2(1,1)=10
32236      NCTIT2(2,1)=9
32237C
32238      ITITL2(1,2)='Lower'
32239      ITITL2(2,2)='Limit'
32240      NCTIT2(1,2)=5
32241      NCTIT2(2,2)=5
32242C
32243      ITITL2(1,3)='Upper'
32244      ITITL2(2,3)='Limit'
32245      NCTIT2(1,3)=5
32246      NCTIT2(2,3)=5
32247C
32248      NMAX=0
32249      DO2521I=1,NUMCOL
32250        VALIGN(I)='b'
32251        ALIGN(I)='r'
32252        NTOT(I)=15
32253        NMAX=NMAX+NTOT(I)
32254        IDIGIT(I)=NUMDIG
32255 2521 CONTINUE
32256      IDIGIT(1)=3
32257      DO2523I=1,NUMALP
32258        NCTEXT(I)=0
32259        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
32260        AMAT(I,2)=A2LOWB(I)
32261        AMAT(I,3)=A2UPPB(I)
32262 2523 CONTINUE
32263      IWHTML(1)=150
32264      IWHTML(2)=150
32265      IWHTML(3)=150
32266      IWHTML(4)=150
32267      IWRTF(1)=2000
32268      IWRTF(2)=IWRTF(1)+2000
32269      IWRTF(3)=IWRTF(2)+2000
32270      IFRST=.TRUE.
32271      ILAST=.TRUE.
32272C
32273      CALL DPDTA2(ITITL9,NCTIT9,
32274     1            ITITLE,NCTITL,ITITL2,NCTIT2,
32275     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
32276     1            ITEXT,NCTEXT,AMAT,NUMALP,NUMALP,
32277     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
32278     1            ICAPSW,ICAPTY,IFRST,ILAST,
32279     1            ISUBRO,IBUGA3,IERROR)
32280C
32281C       CASE 2: GROUP VARIABLE, BUT NO CENSORING VARIABLE
32282C
32283      ELSEIF(NCENS.EQ.0)THEN
32284C
32285C       STEP 1: DETERMINE UNIQUE GROUPS
32286C
32287        NUMSET=0
32288        NS=0
32289        DSUM1=0.0D0
32290C
32291        DO4301I=1,N
32292          IF(NUMSET.EQ.0)GOTO4303
32293          DO4302J=1,NUMSET
32294            IF(X1(I).EQ.XIDTEM(J))GOTO4301
32295 4302     CONTINUE
32296 4303     CONTINUE
32297          NUMSET=NUMSET+1
32298          XIDTEM(NUMSET)=X1(I)
32299 4301   CONTINUE
32300        CALL SORT(XIDTEM,NUMSET,XIDTEM)
32301C
32302C       STEP 2: MAXIMUM LIKELIHOOD COMPUTATIONS
32303C
32304        ITITLE='Power Law Maximum Likelihood Estimation (M(t) = a*t**b)'
32305        NCTITL=55
32306        ITITLZ='Multiple Systems'
32307        NCTITZ=16
32308        ICNT=1
32309        ITEXT(ICNT)='Summary Statistics:'
32310        NCTEXT(ICNT)=19
32311        AVALUE(ICNT)=0.0
32312        IDIGIT(ICNT)=-1
32313        ICNT=1
32314        ITEXT(ICNT)='Number of Systems:'
32315        NCTEXT(ICNT)=18
32316        AVALUE(ICNT)=REAL(NUMSET)
32317        IDIGIT(ICNT)=-1
32318C
32319        J=0
32320        TENDSV=TEND
32321        DO4310ISET=1,NUMSET
32322C
32323          K=0
32324          DO4311I=1,N
32325            IF(X1(I).EQ.XIDTEM(ISET))THEN
32326              K=K+1
32327              TEMP2(K)=Y1(I)
32328            ENDIF
32329 4311     CONTINUE
32330          NI=K
32331          CALL SORT(TEMP2,NI,TEMP2)
32332C
32333C         CHECK FOR ERRORS:
32334C
32335C            1) REQUIRE AT LEAST 2 FAILURE TIMES
32336C            2) ALL FAILURE TIMES SHOULD BE LESS THAN TEND
32337C
32338          IF(NI.LT.2)THEN
32339            WRITE(ICOUT,999)
32340            CALL DPWRST('XXX','WRIT')
32341            WRITE(ICOUT,4313)
32342 4313       FORMAT('***** WARNING IN POWER LAW MAXIMUM LIKELIHOOD--')
32343            CALL DPWRST('XXX','WRIT')
32344            WRITE(ICOUT,4314)ISET
32345 4314       FORMAT('      FOR SYSTEM ',I8,' THE NUMBER OF ',
32346     1             'REPAIR TIMES IS < 2')
32347            CALL DPWRST('XXX','WRIT')
32348            WRITE(ICOUT,4315)N
32349 4315       FORMAT('      NUMBER OF REPAIR TIMES = ',I8)
32350            CALL DPWRST('XXX','WRIT')
32351            WRITE(ICOUT,4316)
32352 4316       FORMAT('      THIS SYSTEM WILL BE OMITTED FROM THE ',
32353     1             'ANALYSIS')
32354            CALL DPWRST('XXX','WRIT')
32355            TEMP4(ISET)=0.0
32356            GOTO4310
32357          ENDIF
32358          IF(TEMP2(NI).GE.TENDSV)THEN
32359            TEND=0.0
32360          ELSE
32361            TEND=TENDSV
32362          ENDIF
32363C
32364          IF(TEND.LE.0.0)THEN
32365            NS=NS + (NI-1)
32366            DSUM=0.0D0
32367            ICNT=0
32368            DTERM2=DBLE(TEMP2(NI))
32369            DO4330I=1,NI-1
32370              DTERM1=DBLE(TEMP2(I))
32371              DSUM=DSUM + DLOG(DTERM2/DTERM1)
32372              ICNT=ICNT+1
32373              TEMP8(ICNT)=REAL(DTERM1/DTERM2)
32374 4330       CONTINUE
32375            DSUM1=DSUM1 + DSUM
32376            TEMP4(ISET)=REAL(NI-1)
32377            TEMP5(ISET)=REAL(DTERM2)
32378          ELSE
32379            NS=NS + NI
32380            DSUM=0.0D0
32381            ICNT=0
32382            DTERM2=DBLE(TEND)
32383            DO4340I=1,NI
32384              DTERM1=DBLE(TEMP2(I))
32385              DSUM=DSUM + DLOG(DBLE(DTERM2/DTERM1))
32386              ICNT=ICNT+1
32387              TEMP8(ICNT)=REAL(DTERM1/DTERM2)
32388 4340       CONTINUE
32389            DSUM1=DSUM1 + DSUM
32390            TEMP4(ISET)=REAL(NI)
32391            TEMP5(ISET)=REAL(DTERM2)
32392          ENDIF
32393C
32394          IF(TEND.LE.0.0)THEN
32395            ICNT=ICNT+1
32396            ITEXT(ICNT)='System (Failure Censored):'
32397            NCTEXT(ICNT)=26
32398            AVALUE(ICNT)=REAL(ISET)
32399            IDIGIT(ICNT)=0
32400            ICNT=ICNT+1
32401            ITEXT(ICNT)='Last Repair Time:'
32402            NCTEXT(ICNT)=17
32403            AVALUE(ICNT)=TEMP2(NI)
32404            IDIGIT(ICNT)=NUMDIG
32405          ELSE
32406            ICNT=ICNT+1
32407            ITEXT(ICNT)='System (Time Censored):'
32408            NCTEXT(ICNT)=23
32409            AVALUE(ICNT)=REAL(ISET)
32410            IDIGIT(ICNT)=0
32411            ICNT=ICNT+1
32412            ITEXT(ICNT)='Censoring Time:'
32413            NCTEXT(ICNT)=15
32414            AVALUE(ICNT)=TEND
32415            IDIGIT(ICNT)=NUMDIG
32416          ENDIF
32417          ICNT=ICNT+1
32418          ITEXT(ICNT)='Number of Repair Times:'
32419          NCTEXT(ICNT)=23
32420          AVALUE(ICNT)=REAL(NI)
32421          IDIGIT(ICNT)=0
32422C
32423 4310   CONTINUE
32424C
32425        BHAT=DBLE(NS-1)/DSUM1
32426        DSUM=0.0D0
32427        DO4350ISET=1,NUMSET
32428          IF(TEMP4(ISET).GT.0.5)THEN
32429            DSUM=DSUM + TEMP5(ISET)**BHAT
32430          ENDIF
32431 4350   CONTINUE
32432        AHAT=DBLE(NS)/DSUM
32433CCCCC   AMTBF=Y1(N)/(AN*BHAT)
32434CCCCC   DO4335I=1,NUMALP
32435CCCCC     ALP=ALPHA(I)
32436CCCCC     P=1.0 - (ALP/2.0)
32437CCCCC     CALL NORPPF(P,PPF)
32438CCCCC     ANUM=AN*(AN-1.0)
32439CCCCC     TERM1=AN + PPF**2/4.0
32440CCCCC     TERM2=SQRT(AN*PPF**2/2.0 + PPF**4/16.0)
32441CCCCC     ADEN=(TERM1 + TERM2)**2
32442CCCCC     A2LOWB(I)=AMTBF*ANUM/ADEN
32443CCCCC     TERM1=AN - PPF*SQRT(AN/2.0)
32444CCCCC     ADEN=TERM1**2
32445CCCCC     A2UPPB(I)=AMTBF*ANUM/ADEN
32446C4355   CONTINUE
32447C
32448        ICNT=ICNT+1
32449        ITEXT(ICNT)='Estimate of A:'
32450        NCTEXT(ICNT)=14
32451        AVALUE(ICNT)=AHAT
32452        IDIGIT(ICNT)=NUMDIG
32453        ICNT=ICNT+1
32454        ITEXT(ICNT)='Estimate of B:'
32455        NCTEXT(ICNT)=14
32456        AVALUE(ICNT)=BHAT
32457        IDIGIT(ICNT)=NUMDIG
32458C
32459        NUMROW=ICNT
32460        DO4360I=1,NUMROW
32461          NTOT(I)=15
32462 4360   CONTINUE
32463C
32464        IFRST=.TRUE.
32465        ILAST=.TRUE.
32466        CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
32467     1              AVALUE,IDIGIT,
32468     1              NTOT,NUMROW,
32469     1              ICAPSW,ICAPTY,ILAST,IFRST,
32470     1              ISUBRO,IBUGA3,IERROR)
32471C
32472C       CASE 3: BOTH GROUP VARIABLE AND CENSORING VARIABLE
32473C
32474      ELSE
32475C
32476C       STEP 1: DETERMINE UNIQUE GROUPS
32477C
32478        NUMSET=0
32479        DO4601I=1,N
32480          IF(NUMSET.EQ.0)GOTO4603
32481          DO4602J=1,NUMSET
32482            IF(X1(I).EQ.XIDTEM(J))GOTO4601
32483 4602     CONTINUE
32484 4603     CONTINUE
32485          NUMSET=NUMSET+1
32486          XIDTEM(NUMSET)=X1(I)
32487 4601   CONTINUE
32488        CALL SORT(XIDTEM,NUMSET,XIDTEM)
32489C
32490C       STEP 2A: EXTRACT RESPONSE AND CENSORING DATA FOR EACH
32491C                GROUP
32492C
32493        J=0
32494        ISETMX=NUMSET
32495        NS=0
32496        ICNT=0
32497        DSUM1=0.0D0
32498C
32499        DO4690ISET=1,NUMSET
32500C
32501          K=0
32502          DO4611I=1,N
32503            IF(X1(I).EQ.XIDTEM(ISET))THEN
32504              K=K+1
32505              TEMP2(K)=Y1(I)
32506              TEMP3(K)=XCEN(I)
32507            ENDIF
32508 4611     CONTINUE
32509          NI=K
32510C
32511C       STEP 2B: PROCESS THE CENSORING VARIABLE.  THERE CAN
32512C                BE AT MOST ONE CENSORING POINT FOR EACH
32513C                GROUP.
32514C
32515          CALL SORTC(TEMP2,TEMP3,NI,TEMP4,TEMP5)
32516          DO4620I=1,NI
32517            TEMP2(I)=TEMP4(I)
32518            TEMP3(I)=TEMP5(I)
32519 4620     CONTINUE
32520          AREP=TEMP3(1)
32521          ACEN=TEMP3(NI)
32522C
32523          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPL')THEN
32524            WRITE(ICOUT,4621)ISET,NI,AREP,ACEN
32525 4621       FORMAT('ISET,NI,AREP,ACEN = ',2I10,2G15.7)
32526            CALL DPWRST('XXX','BUG ')
32527          ENDIF
32528C
32529          IF(NI.LE.1)THEN
32530            NTEMPR=1
32531            NTEMPC=0
32532          ELSE
32533            IF(AREP.EQ.ACEN)THEN
32534              NTEMPR=NI
32535              NTEMPC=0
32536              TEND=0.0
32537              DO4630I=1,NI
32538                IF(TEMP3(I).NE.AREP)THEN
32539                  WRITE(ICOUT,999)
32540                  CALL DPWRST('XXX','BUG ')
32541                  WRITE(ICOUT,1111)
32542                  CALL DPWRST('XXX','BUG ')
32543                  WRITE(ICOUT,4631)
32544                  CALL DPWRST('XXX','BUG ')
32545                  WRITE(ICOUT,4632)
32546                  CALL DPWRST('XXX','BUG ')
32547                  WRITE(ICOUT,4633)
32548                  CALL DPWRST('XXX','BUG ')
32549                  WRITE(ICOUT,4634)XIDTEM(ISET)
32550                  CALL DPWRST('XXX','BUG ')
32551                  IERROR='YES'
32552                  GOTO9000
32553                ENDIF
32554 4630         CONTINUE
32555            ELSEIF(TEMP2(NI).EQ.TEMP2(NI-1))THEN
32556              NTEMPR=NI-1
32557              NI=NTEMPR
32558              NTEMPC=0
32559              TEND=0.0
32560              DO4635I=1,NTEMPR
32561                IF(TEMP3(I).NE.AREP)THEN
32562                  WRITE(ICOUT,999)
32563                  CALL DPWRST('XXX','BUG ')
32564                  WRITE(ICOUT,1111)
32565                  CALL DPWRST('XXX','BUG ')
32566                  WRITE(ICOUT,4631)
32567                  CALL DPWRST('XXX','BUG ')
32568                  WRITE(ICOUT,4632)
32569                  CALL DPWRST('XXX','BUG ')
32570                  WRITE(ICOUT,4633)
32571                  CALL DPWRST('XXX','BUG ')
32572                  WRITE(ICOUT,4634)XIDTEM(ISET)
32573                  CALL DPWRST('XXX','BUG ')
32574                  IERROR='YES'
32575                  GOTO9000
32576                ENDIF
32577 4635         CONTINUE
32578            ELSE
32579              NTEMPR=NI-1
32580              NTEMPC=1
32581              TEND=TEMP2(NI)
32582              DO4640I=1,NTEMPR
32583                IF(TEMP3(I).NE.AREP)THEN
32584                  WRITE(ICOUT,999)
32585                  CALL DPWRST('XXX','BUG ')
32586                  WRITE(ICOUT,1111)
32587                  CALL DPWRST('XXX','BUG ')
32588                  WRITE(ICOUT,4631)
32589                  CALL DPWRST('XXX','BUG ')
32590                  WRITE(ICOUT,4632)
32591                  CALL DPWRST('XXX','BUG ')
32592                  WRITE(ICOUT,4633)
32593                  CALL DPWRST('XXX','BUG ')
32594                  WRITE(ICOUT,4634)XIDTEM(ISET)
32595                  CALL DPWRST('XXX','BUG ')
32596                  IERROR='YES'
32597                  GOTO9000
32598                ENDIF
32599 4640         CONTINUE
32600            ENDIF
32601          ENDIF
32602 4631     FORMAT('      FOR EACH SYSTEM, THERE SHOULD BE AT MOST')
32603 4632     FORMAT('      ONE CENSORING TIME AND IT MUST BE THE ',
32604     1           'MAXIMUM')
32605 4633     FORMAT('      VALUE FOR THAT SYSTEM.')
32606 4634     FORMAT('      SUCH WAS NOT THE CASE FOR SYSTEM ',G15.7)
32607C
32608          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPL')THEN
32609            WRITE(ICOUT,4641)NTEMPR,NTEMPC,TEND
32610 4641       FORMAT('NTEMPR,NTEMPC,TEND = ',2I10,G15.7)
32611            CALL DPWRST('XXX','BUG ')
32612          ENDIF
32613C
32614          IF(ISET.EQ.1)THEN
32615            ITITLE=
32616     1      'Power Law Maximum Likelihood Estimation (M(t) = a*t**b)'
32617            NCTITL=55
32618            ITITLZ='Multiple Systems'
32619            NCTITZ=16
32620            ICNT=1
32621            ITEXT(ICNT)='Number of Systems:'
32622            NCTEXT(ICNT)=18
32623            AVALUE(ICNT)=REAL(NUMSET)
32624            IDIGIT(ICNT)=-1
32625          ENDIF
32626C
32627          IF(TEND.LE.0.0)THEN
32628            ICNT=ICNT+1
32629            ITEXT(ICNT)='System (Failure Censored):'
32630            NCTEXT(ICNT)=26
32631            AVALUE(ICNT)=REAL(ISET)
32632            IDIGIT(ICNT)=0
32633            ICNT=ICNT+1
32634            ITEXT(ICNT)='Last Repair Time:'
32635            NCTEXT(ICNT)=17
32636            AVALUE(ICNT)=TEMP2(NTEMPR)
32637            IDIGIT(ICNT)=NUMDIG
32638          ELSE
32639            ICNT=ICNT+1
32640            ITEXT(ICNT)='System (Time Censored):'
32641            NCTEXT(ICNT)=23
32642            AVALUE(ICNT)=REAL(ISET)
32643            IDIGIT(ICNT)=0
32644            ICNT=ICNT+1
32645            ITEXT(ICNT)='Censoring Time:'
32646            NCTEXT(ICNT)=15
32647            AVALUE(ICNT)=TEND
32648            IDIGIT(ICNT)=NUMDIG
32649          ENDIF
32650          ICNT=ICNT+1
32651          ITEXT(ICNT)='Number of Repair Times:'
32652          NCTEXT(ICNT)=23
32653          AVALUE(ICNT)=REAL(NTEMPR)
32654          IDIGIT(ICNT)=0
32655C
32656C         STEP 2C: MAXIMUM LIKELIHOOD COMPUTATIONS
32657C
32658C                  CHECK FOR ERRORS:
32659C
32660C                  1) REQUIRE AT LEAST 2 FAILURE TIMES
32661C                  2) ALL FAILURE TIMES SHOULD BE LESS THAN TEND
32662C
32663          IF(NI.LT.2)THEN
32664            WRITE(ICOUT,999)
32665            CALL DPWRST('XXX','WRIT')
32666            WRITE(ICOUT,4613)
32667 4613       FORMAT('***** WARNING IN POWER LAW MAXIMUM LIKELIHOOD--')
32668            CALL DPWRST('XXX','WRIT')
32669            WRITE(ICOUT,4614)ISET
32670 4614       FORMAT('      FOR SYSTEM ',I8,' THE NUMBER OF ',
32671     1             'REPAIR TIMES IS < 2')
32672            CALL DPWRST('XXX','WRIT')
32673            WRITE(ICOUT,4615)N
32674 4615       FORMAT('      NUMBER OF REPAIR TIMES = ',I8)
32675            CALL DPWRST('XXX','WRIT')
32676            WRITE(ICOUT,4616)
32677 4616       FORMAT('      THIS SYSTEM WILL BE OMITTED FROM THE ',
32678     1             'ANALYSIS')
32679            CALL DPWRST('XXX','WRIT')
32680            TEMP6(ISET)=0.0
32681            GOTO4690
32682          ENDIF
32683C
32684          IF(TEND.LE.0.0)THEN
32685            NS=NS + (NTEMPR-1)
32686            DSUM=0.0D0
32687            DTERM2=DBLE(TEMP2(NI))
32688            DO4680I=1,NTEMPR-1
32689              DTERM1=DBLE(TEMP2(I))
32690              DSUM=DSUM + DLOG(DTERM2/DTERM1)
32691              ICNT=ICNT+1
32692              TEMP8(ICNT)=REAL(DTERM1/DTERM2)
32693 4680       CONTINUE
32694            DSUM1=DSUM1 + DSUM
32695            TEMP6(ISET)=REAL(NTEMPR-1)
32696            TEMP7(ISET)=REAL(DTERM2)
32697          ELSE
32698            NS=NS + NTEMPR
32699            DSUM=0.0D0
32700            DTERM2=DBLE(TEND)
32701            DO4685I=1,NTEMPR
32702              DTERM1=DBLE(TEMP2(I))
32703              DSUM=DSUM + DLOG(DBLE(DTERM2/DTERM1))
32704              ICNT=ICNT+1
32705              TEMP8(ICNT)=REAL(DTERM1/DTERM2)
32706 4685       CONTINUE
32707            DSUM1=DSUM1 + DSUM
32708            TEMP6(ISET)=REAL(NTEMPR)
32709            TEMP7(ISET)=REAL(DTERM2)
32710          ENDIF
32711C
32712          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPL')THEN
32713            WRITE(ICOUT,4686)NS,DSUM
32714 4686       FORMAT('NS,DSUM = ',I10,G15.7)
32715            CALL DPWRST('XXX','BUG ')
32716          ENDIF
32717C
32718 4690   CONTINUE
32719C
32720        BHAT=DBLE(NS-1)/DSUM1
32721        DSUM=0.0D0
32722        DO4688ISET=1,NUMSET
32723C
32724          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPL')THEN
32725            WRITE(ICOUT,4689)ISET,TEMP5(ISET),TEMP7(ISET)
32726 4689       FORMAT('ISET,TEMP5(ISET),TEMP7(ISET) = ',I10,2G15.7)
32727            CALL DPWRST('XXX','BUG ')
32728          ENDIF
32729C
32730          IF(TEMP6(ISET).GT.0.5)THEN
32731            DSUM=DSUM + TEMP7(ISET)**BHAT
32732          ENDIF
32733 4688   CONTINUE
32734        AHAT=DBLE(NS)/DSUM
32735C
32736        ICNT=ICNT+1
32737        ITEXT(ICNT)='Estimate of A:'
32738        NCTEXT(ICNT)=14
32739        AVALUE(ICNT)=AHAT
32740        IDIGIT(ICNT)=NUMDIG
32741        ICNT=ICNT+1
32742        ITEXT(ICNT)='Estimate of B:'
32743        NCTEXT(ICNT)=14
32744        AVALUE(ICNT)=BHAT
32745        IDIGIT(ICNT)=NUMDIG
32746C
32747        NUMROW=ICNT
32748        DO2410I=1,NUMROW
32749          NTOT(I)=15
32750 2410   CONTINUE
32751C
32752        IFRST=.TRUE.
32753        ILAST=.TRUE.
32754        CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
32755     1              AVALUE,IDIGIT,
32756     1              NTOT,NUMROW,
32757     1              ICAPSW,ICAPTY,ILAST,IFRST,
32758     1              ISUBRO,IBUGA3,IERROR)
32759C
32760      ENDIF
32761C
32762      CALL SORT(TEMP8,ICNT,TEMP8)
32763      ACNT=REAL(ICNT)
32764      DSUM=0.0D0
32765      DO4810I=1,ICNT
32766        AI=REAL(I)
32767        DTERM1=DBLE(TEMP8(I)**BHAT - (2.0*AI-1.0)/(2.0*ACNT))**2
32768        DSUM=DSUM + DTERM1
32769 4810 CONTINUE
32770      CNS=(1.0/(12.0*ACNT)) + REAL(DSUM)
32771C
32772      IF(ICNT.EQ.2)THEN
32773        CV020=0.138
32774        CV015=0.149
32775        CV010=0.162
32776        CV005=0.175
32777        CV001=0.186
32778      ELSEIF(ICNT.EQ.3)THEN
32779        CV020=0.121
32780        CV015=0.135
32781        CV010=0.154
32782        CV005=0.184
32783        CV001=0.230
32784      ELSEIF(ICNT.EQ.4)THEN
32785        CV020=0.121
32786        CV015=0.134
32787        CV010=0.155
32788        CV005=0.191
32789        CV001=0.280
32790      ELSEIF(ICNT.EQ.5)THEN
32791        CV020=0.121
32792        CV015=0.137
32793        CV010=0.160
32794        CV005=0.199
32795        CV001=0.300
32796      ELSEIF(ICNT.EQ.6)THEN
32797        CV020=0.123
32798        CV015=0.139
32799        CV010=0.162
32800        CV005=0.204
32801        CV001=0.310
32802      ELSEIF(ICNT.EQ.7)THEN
32803        CV020=0.124
32804        CV015=0.140
32805        CV010=0.165
32806        CV005=0.208
32807        CV001=0.320
32808      ELSEIF(ICNT.EQ.8)THEN
32809        CV020=0.124
32810        CV015=0.141
32811        CV010=0.165
32812        CV005=0.208
32813        CV001=0.320
32814      ELSEIF(ICNT.EQ.9)THEN
32815        CV020=0.124
32816        CV015=0.142
32817        CV010=0.167
32818        CV005=0.212
32819        CV001=0.320
32820      ELSEIF(ICNT.EQ.10)THEN
32821        CV020=0.125
32822        CV015=0.142
32823        CV010=0.167
32824        CV005=0.212
32825        CV001=0.320
32826      ELSEIF(ICNT.EQ.11)THEN
32827        CV020=0.126
32828        CV015=0.143
32829        CV010=0.169
32830        CV005=0.214
32831        CV001=0.320
32832      ELSEIF(ICNT.EQ.12)THEN
32833        CV020=0.126
32834        CV015=0.144
32835        CV010=0.169
32836        CV005=0.214
32837        CV001=0.320
32838      ELSEIF(ICNT.EQ.13)THEN
32839        CV020=0.126
32840        CV015=0.144
32841        CV010=0.169
32842        CV005=0.214
32843        CV001=0.330
32844      ELSEIF(ICNT.EQ.14)THEN
32845        CV020=0.126
32846        CV015=0.144
32847        CV010=0.169
32848        CV005=0.214
32849        CV001=0.330
32850      ELSEIF(ICNT.EQ.15)THEN
32851        CV020=0.126
32852        CV015=0.144
32853        CV010=0.169
32854        CV005=0.215
32855        CV001=0.330
32856      ELSEIF(ICNT.EQ.16)THEN
32857        CV020=0.127
32858        CV015=0.145
32859        CV010=0.171
32860        CV005=0.216
32861        CV001=0.330
32862      ELSEIF(ICNT.EQ.17)THEN
32863        CV020=0.127
32864        CV015=0.145
32865        CV010=0.171
32866        CV005=0.217
32867        CV001=0.330
32868      ELSEIF(ICNT.EQ.18)THEN
32869        CV020=0.127
32870        CV015=0.146
32871        CV010=0.171
32872        CV005=0.217
32873        CV001=0.330
32874      ELSEIF(ICNT.EQ.19)THEN
32875        CV020=0.127
32876        CV015=0.146
32877        CV010=0.171
32878        CV005=0.217
32879        CV001=0.330
32880      ELSEIF(ICNT.GE.20 .AND. ICNT.LE.25)THEN
32881        CV020=0.128
32882        CV015=0.146
32883        CV010=0.172
32884        CV005=0.217
32885        CV001=0.330
32886      ELSEIF(ICNT.GE.26 .AND. ICNT.LE.45)THEN
32887        CV020=0.128
32888        CV015=0.146
32889        CV010=0.172
32890        CV005=0.218
32891        CV001=0.330
32892      ELSEIF(ICNT.GE.46 .AND. ICNT.LE.80)THEN
32893        CV020=0.128
32894        CV015=0.146
32895        CV010=0.173
32896        CV005=0.220
32897        CV001=0.330
32898      ELSE
32899        CV020=0.129
32900        CV015=0.147
32901        CV010=0.173
32902        CV005=0.220
32903        CV001=0.34
32904      ENDIF
32905C
32906      ITITLE='Power Law Goodness Of Fit Test'
32907      NCTITL=30
32908      ITITLZ=' '
32909      NCTITZ=0
32910C
32911      ICNT=1
32912      ITEXT(ICNT)='H0: Repair Times Follow a Power Law Model'
32913      NCTEXT(ICNT)=41
32914      AVALUE(ICNT)=0.0
32915      IDIGIT(ICNT)=-1
32916      ICNT=ICNT+1
32917      ITEXT(ICNT)='Ha: Repair Times Do Not Follow a Power Law Model'
32918      NCTEXT(ICNT)=48
32919      AVALUE(ICNT)=0.0
32920      IDIGIT(ICNT)=-1
32921      ICNT=ICNT+1
32922      ITEXT(ICNT)='Value of Ns:'
32923      NCTEXT(ICNT)=12
32924      AVALUE(ICNT)=REAL(NS)
32925      IDIGIT(ICNT)=0
32926      ICNT=ICNT+1
32927      ITEXT(ICNT)='Value of Test Statistic:'
32928      NCTEXT(ICNT)=24
32929      AVALUE(ICNT)=CNS
32930      IDIGIT(ICNT)=NUMDIG
32931C
32932      NUMROW=ICNT
32933      DO2610I=1,NUMROW
32934        NTOT(I)=15
32935 2610 CONTINUE
32936C
32937      IFRST=.TRUE.
32938      ILAST=.TRUE.
32939      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
32940     1            AVALUE,IDIGIT,
32941     1            NTOT,NUMROW,
32942     1            ICAPSW,ICAPTY,ILAST,IFRST,
32943     1            ISUBRO,IBUGA3,IERROR)
32944C
32945      ITITLE='Upper One-Tailed Test'
32946      NCTITL=21
32947      ITITL9='H0: Power Law, Ha: Not Power Law'
32948      NCTIT9=32
32949C
32950      DO2830J=1,4
32951        DO2840I=1,3
32952          ITITL2(I,J)=' '
32953          NCTIT2(I,J)=0
32954 2840   CONTINUE
32955 2830 CONTINUE
32956C
32957      ITITL2(2,1)='Confidence'
32958      NCTIT2(2,1)=11
32959      ITITL2(3,1)='Value (%)'
32960      NCTIT2(3,1)=9
32961C
32962      ITITL2(2,2)='Test '
32963      NCTIT2(2,2)=4
32964      ITITL2(3,2)='Statistic'
32965      NCTIT2(3,2)=9
32966C
32967      ITITL2(2,3)='Critical'
32968      NCTIT2(2,3)=8
32969      ITITL2(3,3)='Value (>)'
32970      NCTIT2(3,3)=9
32971C
32972      ITITL2(1,4)='Null'
32973      NCTIT2(1,4)=4
32974      ITITL2(2,4)='Hypothesis'
32975      NCTIT2(2,4)=10
32976      ITITL2(3,4)='Conclusion'
32977      NCTIT2(3,4)=10
32978C
32979      NMAX=0
32980      NUMCOL=4
32981      DO2150I=1,NUMCOL
32982        VALIGN(I)='b'
32983        ALIGN(I)='r'
32984        NTOT(I)=15
32985        NMAX=NMAX+NTOT(I)
32986        ITYPCO(I)='NUME'
32987        IDIGIT(I)=NUMDIG
32988        IF(I.EQ.1 .OR. I.EQ.4)THEN
32989          ITYPCO(I)='ALPH'
32990        ENDIF
32991 2150 CONTINUE
32992C
32993      IWHTML(1)=125
32994      IWHTML(2)=175
32995      IWHTML(3)=175
32996      IWHTML(4)=175
32997      IINC=1800
32998      IINC2=1400
32999      IWRTF(1)=IINC
33000      IWRTF(2)=IWRTF(1)+IINC
33001      IWRTF(3)=IWRTF(2)+IINC
33002      IWRTF(4)=IWRTF(3)+IINC
33003C
33004      DO2860J=1,NUMAL2
33005C
33006        AMAT(J,2)=CNS
33007        IF(J.EQ.1)THEN
33008          AMAT(J,3)=CV020
33009        ELSEIF(J.EQ.2)THEN
33010          AMAT(J,3)=CV015
33011        ELSEIF(J.EQ.3)THEN
33012          AMAT(J,3)=CV010
33013        ELSEIF(J.EQ.4)THEN
33014          AMAT(J,3)=CV005
33015        ELSEIF(J.EQ.5)THEN
33016          AMAT(J,3)=CV001
33017        ENDIF
33018        IVALUE(J,4)(1:6)='REJECT'
33019        IF(ABS(CNS).LT.AMAT(J,3))THEN
33020          IVALUE(J,4)(1:6)='ACCEPT'
33021        ENDIF
33022        NCVALU(J,4)=6
33023C
33024        ALPHAT=100.0*(1.0 - ALPHA(J))
33025        WRITE(IVALUE(J,1)(1:4),'(F4.1)')ALPHAT
33026        IVALUE(J,1)(5:5)='%'
33027        NCVALU(J,1)=5
33028 2860 CONTINUE
33029C
33030      ICNT=NUMAL2
33031      NUMLIN=3
33032      NUMCOL=4
33033      IFRST=.TRUE.
33034      ILAST=.TRUE.
33035      IFLAGS=.TRUE.
33036      IFLAGE=.TRUE.
33037      CALL DPDTA5(ITITLE,NCTITL,
33038     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
33039     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
33040     1            IVALUE,NCVALU,AMAT,ITYPCO,NUMALP,NUMAL2,
33041     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
33042     1            ICAPSW,ICAPTY,IFRST,ILAST,
33043     1            IFLAGS,IFLAGE,
33044     1            ISUBRO,IBUGA3,IERROR)
33045C
33046C               *****************
33047C               **  STEP 90--  **
33048C               **  EXIT       **
33049C               *****************
33050C
33051 9000 CONTINUE
33052      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPL')THEN
33053        WRITE(ICOUT,999)
33054        CALL DPWRST('XXX','WRIT')
33055        WRITE(ICOUT,9011)
33056 9011   FORMAT('***** AT THE END       OF DPMLPL--')
33057        CALL DPWRST('XXX','WRIT')
33058        WRITE(ICOUT,9015)BHAT,AHAT,AMTBF,IERROR
33059 9015   FORMAT('BHAT,AHAT,AMTBF,IERROR = ',3G15.7,2X,A4)
33060        CALL DPWRST('XXX','WRIT')
33061      ENDIF
33062C
33063      RETURN
33064      END
33065      SUBROUTINE DPMLPN(TIMEL,TIMEU,RLNGTH,N,
33066     1                  YTEMP1,DTEMP1,DTEMP2,IINDEX,
33067     1                  ILOG,IPRNT,ICAPTY,ICAPSW,
33068     1                  ISUBRO,IBUGA3,IERROR)
33069C
33070C     TIMEL   = LOWER INTERVAL FOR FAILURE TIME
33071C     TIMEU   = UPPER INTERVAL FOR FAILURE TIME
33072C     RLNGTH  = LENGTH VARIABLE
33073C     N       = NUMBER OF OBSERVATIONS
33074C
33075C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
33076C              ESTIMATES FOR THE POWER NORMAL DISTRIBUTION
33077C     EXAMPLE--POWER NORMAL MAXIMUM LIKELIHOOD Y
33078C     REFERENCE--WAYNE NELSON AND NECIP DOGANAKSOY, "A COMPUTER
33079C                PROGRAM POWNOR FOR FITTING THE POWER-NORMAL AND
33080C                -LOGNORMAL MODELS TO LIFE OR STRENGTH DATA FROM
33081C                SPECIMENS OF VARIOUS SIZES", NISTIR 4760, 3/1992.
33082C                PROJECT: 1990-91 ASA/NIST/NSF FELLOWSHIP
33083C     NOTE--DATAPLOT USES THE POWNOR SOFTWARE TO COMPUTE THE MAXIMUM
33084C           LIKELIHOOD ESTIMATES.  THIS CODE HAS BEEN MODIFIED SLIGHTLY
33085C           FOR INCORPORATION INTO DATAPLOT (THE BASIC NUMERICS HAVE
33086C           NOT BEEN MODIFIED).
33087C     WRITTEN BY--ALAN HECKERT
33088C                 STATISTICAL ENGINEERING DIVISION
33089C                 INFORMATION TECHNOLOGY LABORATORY
33090C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
33091C                 GAITHERSBURG, MD 20899-8980
33092C                 PHONE--301-975-2899
33093C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
33094C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
33095C     LANGUAGE--ANSI FORTRAN (1977)
33096C     VERSION NUMBER--2019/04
33097C     ORIGINAL VERSION--APRIL     2019.
33098C
33099      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
33100C
33101      DOUBLE PRECISION YTEMP1(*)
33102      DOUBLE PRECISION TIMEL(*)
33103      DOUBLE PRECISION TIMEU(*)
33104      DOUBLE PRECISION RLNGTH(*)
33105      DOUBLE PRECISION DTEMP1(*)
33106      DOUBLE PRECISION DTEMP2(*)
33107C
33108      PARAMETER (NPAR=3)
33109C
33110      DOUBLE PRECISION X(NPAR)
33111      DOUBLE PRECISION E(NPAR)
33112      DOUBLE PRECISION SCL(NPAR)
33113      DOUBLE PRECISION STPSZ(NPAR)
33114      DOUBLE PRECISION FNBR(NPAR)
33115      DOUBLE PRECISION COV(NPAR,NPAR)
33116      DOUBLE PRECISION CORR(NPAR,NPAR)
33117      DOUBLE PRECISION H(NPAR,NPAR)
33118      DOUBLE PRECISION SLENGT(15)
33119C
33120      INTEGER IINDEX(*)
33121C
33122      LOGICAL TRANS
33123      LOGICAL ALLFIX
33124C
33125      CHARACTER*4 IBUGA3
33126      CHARACTER*4 ISUBRO
33127      CHARACTER*4 ICAPTY
33128      CHARACTER*4 ICAPSW
33129      CHARACTER*4 IERROR
33130      CHARACTER*4 IFOUND
33131C
33132      CHARACTER*4 ISTEPN
33133      CHARACTER*4 ISUBN1
33134      CHARACTER*4 ISUBN2
33135      CHARACTER*4 IOP
33136C
33137      CHARACTER*24 GDATE
33138      CHARACTER*24 GTIME
33139C
33140      CHARACTER*40 ITITLE
33141C
33142      INCLUDE 'DPCOPA.INC'
33143      INCLUDE 'DPCOF2.INC'
33144C
33145      COMMON /PNRDAT/ ISS
33146      COMMON /PNRFVA/ RMUFIX,RLNSFX,RLNLNF
33147      COMMON /PNRVAR/ MUTYPE,LNSGTY,LNLNTY
33148      COMMON /LENGTH/ SLENGT,NOLENG
33149      COMMON /LSTD/ TRANS
33150      COMMON /IO/INPUT,IOUT
33151C
33152      DOUBLE PRECISION PNRFUN
33153      EXTERNAL PNRFUN
33154      EXTERNAL POWELD
33155      EXTERNAL HESS
33156C
33157      INCLUDE 'DPCOP2.INC'
33158C
33159      GTIME=' '
33160      GDATE=' '
33161      CALL DPTIME(GTIME,NCURRT,GDATE,NCURRD,
33162     1            IBUGA3,ISUBRO,IFOUND,IERROR)
33163      ZERO=0.D0
33164      NLEFTC=0
33165      NRGHTC=0
33166      NINTC=0
33167      NCOMP=0
33168C
33169C               ********************************************
33170C               **  STEP 11--                             **
33171C               **  CHECK INPUT FOR ERRORS.               **
33172C               ********************************************
33173C
33174      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPN')THEN
33175        ISTEPN='1'
33176        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
33177        WRITE(ICOUT,11)MAXOBV
33178   11   FORMAT('DPMLPN: MAXOBV = ',I8)
33179        CALL DPWRST('XXX','BUG')
33180      ENDIF
33181C
33182      DO1118I=1,N
33183        IF(TIMEL(I).EQ.TIMEU(I).AND.TIMEL(I).EQ.-1E10)THEN
33184          CALL PNRERR(4,I)
33185        ELSEIF (TIMEL(I).EQ.TIMEU(I).AND.TIMEL(I).EQ.1E10)THEN
33186          CALL PNRERR(4,I)
33187        ELSEIF (TIMEL(I).EQ.-1E10.AND.TIMEU(I).EQ.1E10)THEN
33188          CALL PNRERR(4,I)
33189        ELSEIF (TIMEL(I).LT.-1E10.OR.TIMEU(I).GT.1E10)THEN
33190          CALL PNRERR(4,I)
33191        ELSEIF (TIMEL(I).GT.TIMEU(I))THEN
33192          CALL PNRERR(4,I)
33193        ELSEIF (ILOG.EQ.1) THEN
33194          IF (TIMEL(I).NE.-1E10.AND.TIMEL(I).LE.0.D0)THEN
33195            CALL PNRERR(4,I)
33196          ELSEIF (TIMEU(I).LE.0.D0)THEN
33197            CALL PNRERR(4,I)
33198          ENDIF
33199        ENDIF
33200C
33201        IF (TIMEL(I).EQ.TIMEU(I))THEN
33202           IF (ILOG.EQ.1)TIMEL(I)=LOG(TIMEL(I))
33203           IF (ILOG.EQ.1)TIMEU(I)=LOG(TIMEU(I))
33204           NCOMP=NCOMP+1
33205           GOTO 1118
33206        ENDIF
33207C
33208        IF (TIMEL(I).EQ.-1E10)THEN
33209           IF (ILOG.EQ.1) TIMEU(I)=LOG(TIMEU(I))
33210           NLEFTC=NLEFTC+1
33211           GOTO 1118
33212        ENDIF
33213C
33214        IF (TIMEU(I).EQ.1E10)THEN
33215           IF (ILOG.EQ.1)TIMEL(I)=LOG(TIMEL(I))
33216           NRGHTC=NRGHTC+1
33217           GOTO 1118
33218        ENDIF
33219C
33220        IF (TIMEL(I).LT.TIMEU(I))THEN
33221           IF (ILOG.EQ.1)TIMEL(I)=LOG(TIMEL(I))
33222           IF (ILOG.EQ.1)TIMEU(I)=LOG(TIMEU(I))
33223           NINTC=NINTC+1
33224           GOTO 1118
33225        ENDIF
33226C
33227 1118 CONTINUE
33228C
33229C               ********************************************
33230C               **  STEP 12--                             **
33231C               **  OPEN "ITERATIONS" FILE.               **
33232C               ********************************************
33233C
33234      ISTEPN='12'
33235      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPN')
33236     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
33237C
33238      IF(IPRNT.EQ.1)THEN
33239        IOP='OPEN'
33240        IFLAG1=1
33241        IFLAG2=0
33242        IFLAG3=0
33243        IFLAG4=0
33244        IFLAG5=0
33245        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
33246     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
33247     1              IBUGA3,ISUBRO,IERROR)
33248        IF(IERROR.EQ.'YES')GOTO9000
33249      ENDIF
33250C
33251      ISS=I-1
33252      IF (ALLFIX) THEN
33253         IPRNT=0
33254         TRANS=.FALSE.
33255         F=PNRFUN(X,NPAR,TIMEL,TIMEU,RLNGTH)
33256         GOTO 177
33257      ENDIF
33258C
33259      IF(IPRNT.EQ.1)THEN
33260        WRITE(IOUNI1,*) 'ITERATIONS:                   ',GDATE,
33261     1                  '  ',GTIME
33262        WRITE(IOUNI1,*)
33263      ENDIF
33264C
33265C               ********************************************
33266C               **  STEP 21--                             **
33267C               **  ML ESTIMATION OF PARAMETERS VIA       **
33268C               **  POWELL ALGORITHM.                     **
33269C               ********************************************
33270C
33271      ISTEPN='21'
33272      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPN')
33273     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
33274C
33275      DO 334 I=1,NPAR
33276         E(I)=0.0001D0
33277  334 CONTINUE
33278      ESCALE=1000.D0
33279      ICON=1
33280      MAXIT=100
33281C
33282      CALL POWELD(X,E,NPAR,F,ESCALE,IPRNT,ICON,MAXIT,PNRFUN,
33283     1            TIMEL,TIMEU,RLNGTH)
33284      TRANS=.FALSE.
33285      F=PNRFUN(X,NPAR,TIMEL,TIMEU,RLNGTH)
33286C
33287C               ********************************************
33288C               **  STEP 22--                             **
33289C               **  LOCAL ESTIMATE OF THE INFORMATION     **
33290C               **  MATRIX VIA NUMERICAL PERTURBATION     **
33291C               ********************************************
33292C
33293      ISTEPN='22'
33294      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPN')
33295     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
33296C
33297      DO 77 I=1,NPAR
33298         SCL(I)=1./DABS(X(I))
33299   77 CONTINUE
33300      TRANS=.FALSE.
33301      CALL HESS(PNRFUN,X,NPAR,SCL,STPSZ,FNBR,H,TIMEL,TIMEU,RLNGTH)
33302C
33303C               **********************************************
33304C               **  STEP 23--                               **
33305C               **  COVARIANCE MATRIX OF ESTIMATES BY       **
33306C               **  INVERTING THE LOCAL INFORMATION MATRIX  **
33307C               **********************************************
33308C
33309      ISTEPN='23'
33310      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPN')
33311     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
33312C
33313CCCCC CALL ERSET(0,0,0)
33314CCCCC CALL DLINDS (NPAR,H,NPAR,COV,NPAR)
33315CCCCC ICODE=IERCD()
33316CCCCC IF (ICODE.NE.0)CALL PNRERR(6,0)
33317CCCCC CALL ERSET(0,2,2)
33318C
33319      DO2511I=1,NPAR
33320        DO2512J=1,NPAR
33321          COV(I,J)=H(I,J)
33322 2512   CONTINUE
33323 2511 CONTINUE
33324C
33325      CALL DGECO(COV,NPAR,NPAR,IINDEX,RCOND,YTEMP1)
33326      EPS=1.0E-20
33327      IF(RCOND.LE.EPS)THEN
33328        WRITE(ICOUT,999)
33329        CALL DPWRST('XXX','BUG ')
33330        WRITE(ICOUT,2571)
33331 2571   FORMAT('****** ERROR IN POWER NORMAL MAXIMUM LIKELIHOOD--')
33332        CALL DPWRST('XXX','ERRO ')
33333        WRITE(ICOUT,2572)
33334 2572   FORMAT('       THE FISHER INFORMATION MATRIX IS SINGULAR.')
33335        CALL DPWRST('XXX','ERRO ')
33336        WRITE(ICOUT,2573)
33337 2573   FORMAT('       UNABLE TO COMPUTE THE COVARIANCE MATRIX.')
33338        CALL DPWRST('XXX','ERRO ')
33339        DO2581I=1,NPAR
33340          DO2582J=1,NPAR
33341            COV(I,J)=0.0D0
33342 2582     CONTINUE
33343 2581   CONTINUE
33344      ELSE
33345        IJOB=1
33346        CALL DGEDI(COV,NPAR,NPAR,IINDEX,DTEMP1,DTEMP2,IJOB)
33347      END IF
33348C
33349C               **********************************************
33350C               **  STEP 24--                               **
33351C               **  CORRELATION MATRIX OF ESTIMATES BY      **
33352C               **  INVERTING THE LOCAL INFORMATION MATRIX  **
33353C               **********************************************
33354C
33355      ISTEPN='24'
33356      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPN')
33357     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
33358C
33359      DO 179 I=1,NPAR
33360         DO 180 J=1,NPAR
33361            IF (I.EQ.J) THEN
33362                CORR(I,J)=1.D0
33363            ELSE
33364                CORR(I,J)=COV(I,J)*((COV(I,I)*COV(J,J))**(-.5D0))
33365            ENDIF
33366180      CONTINUE
33367179   CONTINUE
33368C
33369C               **********************************************
33370C               **  STEP 31--                               **
33371C               **  PRINT OUT RESULTS                       **
33372C               **********************************************
33373C
33374      ISTEPN='31'
33375      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPN')
33376     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
33377C
33378  177 CONTINUE
33379      IF(IPRINT.EQ.'ON')THEN
33380      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
33381      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
33382      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
33383      ELSE
33384        WRITE(ICOUT,999)
33385  999   FORMAT(1X)
33386        CALL DPWRST('XXX','WRIT')
33387        WRITE(ICOUT,4011)GDATE,GTIME
33388 4011   FORMAT('POWNOR VERSION 1.0     ',A24,'  ',A24)
33389        CALL DPWRST('XXX','WRIT')
33390        WRITE(ICOUT,999)
33391        CALL DPWRST('XXX','WRIT')
33392        WRITE(ICOUT,4013)
33393 4013   FORMAT('DEVELOPED BY NECIP DOGANAKSOY AND WAYNE NELSON UNDER ',
33394     1         '1991 FELLOWSHIP')
33395        WRITE(ICOUT,4015)
33396 4015   FORMAT('GRANT FROM ASA/NSF/NIST. THE PROGRAM IS DOCUMENTED ',
33397     1         'IN NIST-IR 4760.')
33398        WRITE(ICOUT,999)
33399        CALL DPWRST('XXX','WRIT')
33400        WRITE(ICOUT,999)
33401        CALL DPWRST('XXX','WRIT')
33402        WRITE(ICOUT,4021) ISS
33403 4021   FORMAT('TOTAL NUMBER OF DATA CASES       = ',I8)
33404        CALL DPWRST('XXX','WRIT')
33405        WRITE(ICOUT,4023)NCOMP
33406 4023   FORMAT('EXACT OBSERVASTIONS              = ',I8)
33407        CALL DPWRST('XXX','WRIT')
33408        WRITE(ICOUT,4025)NRGHTC
33409 4025   FORMAT('LEFT CENSORED OBSERVATIONS       = ',I8)
33410        CALL DPWRST('XXX','WRIT')
33411        WRITE(ICOUT,4027)NLEFTC
33412 4027   FORMAT('LEFT CENSORED OBSERVATIONS       = ',I8)
33413        CALL DPWRST('XXX','WRIT')
33414        WRITE(ICOUT,4028)NINTC
33415 4028   FORMAT('INTERVAL CENSORED OBSERVATIONS   = ',I8)
33416        CALL DPWRST('XXX','WRIT')
33417        WRITE(ICOUT,999)
33418        CALL DPWRST('XXX','WRIT')
33419        WRITE(ICOUT,999)
33420        CALL DPWRST('XXX','WRIT')
33421C
33422        IF(ALLFIX) THEN
33423          WRITE(ICOUT,4031) -F
33424 4031     FORMAT('LOG-LIKELIHOOD                   =  ',F10.4)
33425          CALL DPWRST('XXX','WRIT')
33426        ELSE
33427          WRITE(ICOUT,4033) -F
33428 4033     FORMAT('MAXIMIZED LOG-LIKELIHOOD           = ',F10.4)
33429          CALL DPWRST('XXX','WRIT')
33430        ENDIF
33431C
33432        WRITE(ICOUT,999)
33433        CALL DPWRST('XXX','WRIT')
33434        IF(ALLFIX) THEN
33435          WRITE(ICOUT,4041)
33436 4041     FORMAT('PARAMETER ESTIMATES')
33437          CALL DPWRST('XXX','WRIT')
33438        ELSE
33439          WRITE(ICOUT,4043)
33440 4043     FORMAT('MAXIMUM LIKELIHOOD ESTIMATES FOR DISTRIBUTION ',
33441     1           'PARAMETERS')
33442          CALL DPWRST('XXX','WRIT')
33443          WRITE(ICOUT,4045)
33444 4045     FORMAT('WITH APPROXIMATE 95% CONFIDENCE LIMITS')
33445          CALL DPWRST('XXX','WRIT')
33446        ENDIF
33447C
33448        WRITE(ICOUT,999)
33449        CALL DPWRST('XXX','WRIT')
33450        IF(ALLFIX) THEN
33451          WRITE(ICOUT,4047)
33452 4047     FORMAT('PARAMETER                 ESTIMATE')
33453          CALL DPWRST('XXX','WRIT')
33454        ELSE
33455          WRITE(ICOUT,4049)
33456 4049     FORMAT('PARAMETER              ML ESTIMATE    LOWER LIMIT',
33457     1           'UPPER LIMIT     STD. ERROR')
33458          CALL DPWRST('XXX','WRIT')
33459        ENDIF
33460C
33461    5   FORMAT(I1,A18,3X,F12.4,3X,F12.4,3X,F12.4,3X,F12.4)
33462    6   FORMAT(A19,3X,F12.4,2X,A12)
33463        IF (MUTYPE.EQ.0) THEN
33464           I1=I1+1
33465           STDERR=(COV(I1,I1))**(.5D0)
33466           RLOWCL=X(I1)-1.96D0*STDERR
33467           RUPCL=X(I1)+1.96D0*STDERR
33468           WRITE(ICOUT,5) I1,' MU               ',
33469     1                    X(I1),RLOWCL,RUPCL,STDERR
33470           CALL DPWRST('XXX','WRIT')
33471           P1=X(I1)
33472           VP1=COV(I1,I1)
33473        ELSE
33474           P1=RMUFIX
33475           VP1=0.D0
33476           WRITE(ICOUT,6) '  MU               ',RMUFIX,
33477     1                    '     *FIXED*'
33478           CALL DPWRST('XXX','WRIT')
33479        ENDIF
33480
33481        IF (LNSGTY.EQ.0) THEN
33482           I1=I1+1
33483           STDERR=(COV(I1,I1))**(.5D0)
33484           RLOWCL=X(I1)-1.96D0*STDERR
33485           RUPCL=X(I1)+1.96D0*STDERR
33486           WRITE(ICOUT,5) I1,' LN(SIGMA)        ',
33487     1                    X(I1),RLOWCL,RUPCL,STDERR
33488           CALL DPWRST('XXX','WRIT')
33489           TP2=X(I1)
33490           VTP2=COV(I1,I1)
33491        ELSE
33492           TP2=RLNSFX
33493           VTP2=0.D0
33494           WRITE(ICOUT,6) '  LN(SIGMA)        ',RLNSFX,
33495     1                    '     *FIXED*'
33496           CALL DPWRST('XXX','WRIT')
33497        ENDIF
33498C
33499        IF (LNLNTY.EQ.0) THEN
33500           I1=I1+1
33501           STDERR=(COV(I1,I1))**(.5D0)
33502           RLOWCL=X(I1)-1.96D0*STDERR
33503           RUPCL=X(I1)+1.96D0*STDERR
33504           WRITE(ICOUT,5) I1,' LN(NORMAL LENGTH)',X(I1),
33505     1                    RLOWCL,RUPCL,STDERR
33506           CALL DPWRST('XXX','WRIT')
33507           TP3=X(I1)
33508           VTP3=COV(I1,I1)
33509        ELSE
33510           TP3=RLNLNF
33511           VTP3=0.D0
33512           WRITE(ICOUT,6) '  LN(NORMAL LENGTH)',RLNLNF,
33513     1                    '     *FIXED*'
33514           CALL DPWRST('XXX','WRIT')
33515        ENDIF
33516C
33517        CP1TP2=0.D0
33518        CP1TP3=0.D0
33519        CTP2T3=0.D0
33520C
33521        IF(MUTYPE.EQ.0.AND.LNSGTY.EQ.0.AND.LNLNTY.EQ.0)THEN
33522          CP1TP2=COV(1,2)
33523          CP1TP3=COV(1,3)
33524          CTP2T3=COV(2,3)
33525        ENDIF
33526C
33527        IF(MUTYPE.EQ.1.AND.LNSGTY.EQ.0.AND.LNLNTY.EQ.0)THEN
33528          CTP2T3=COV(1,2)
33529        ELSEIF(MUTYPE.EQ.0.AND.LNSGTY.EQ.1.AND.LNLNTY.EQ.0)THEN
33530          CP1TP3=COV(1,2)
33531        ELSEIF(MUTYPE.EQ.0.AND.LNSGTY.EQ.0.AND.LNLNTY.EQ.1)THEN
33532          CP1TP2=COV(1,2)
33533        ENDIF
33534C
33535        IF(NPAR.EQ.1)GOTO 1799
33536CCCCC   CALL UMACH(-2,12)
33537CCCCC   CALL WROPT(-6,1,1)
33538        WRITE(ICOUT,999)
33539        CALL DPWRST('XXX','WRIT')
33540C
33541CCCCC   CALL DWRRRN ('ESTIMATED INFORMATION MATRIX',NPAR,NPAR,H,NPAR,0)
33542        ITITLE='ESTIMATED INFORMATION MATRIX'
33543        CALL PNRWMA(ITITLE,NPAR,H,ICAPSW,ICAPTY)
33544        WRITE(ICOUT,999)
33545        CALL DPWRST('XXX','WRIT')
33546C
33547CCCCC   CALL DWRRRN ('ESTIMATED COVARIANCE MATRIX',NPAR,NPAR,COV,NPAR,0)
33548        ITITLE='ESTIMATED COVARIANCE MATRIX'
33549        CALL PNRWMA(ITITLE,NPAR,COV,ICAPSW,ICAPTY)
33550        WRITE(ICOUT,999)
33551        CALL DPWRST('XXX','WRIT')
33552C
33553CCCCC   CALL DWRRRN ('ESTIMATED CORRELATION MATRIX',NPAR,NPAR,CORR,NPAR,0)
33554        ITITLE='ESTIMATED CORRELATION MATRIX'
33555        CALL PNRWMA(ITITLE,NPAR,CORR,ICAPSW,ICAPTY)
33556        WRITE(ICOUT,999)
33557        CALL DPWRST('XXX','WRIT')
33558C
33559      ENDIF
33560      ENDIF
33561C
335621799  CONTINUE
33563      CALL PNRPER(P1,TP2,TP3,VP1,VTP2,VTP3,CP1TP2,CP1TP3,CTP2T3,
33564     1            SLENGT,NOLENG,ALLFIX,
33565     1            ICAPTY,ICAPSW)
33566C
33567 9000 CONTINUE
33568C
33569      IOP='CLOS'
33570      CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
33571     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
33572     1            IBUGA3,ISUBRO,IERROR)
33573C
33574      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPN')THEN
33575      ENDIF
33576C
33577      RETURN
33578      END
33579      SUBROUTINE DPMLPO(Y,X,N,NVAR,
33580     1                  TEMP1,TEMP2,TEMP3,MAXNXT,
33581     1                  ALAMB,ALMBSE,XMIN,
33582     1                  ICAPSW,ICAPTY,IFORSW,
33583     1                  ISUBRO,IBUGA3,IERROR)
33584C
33585C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
33586C              ESTIMATES FOR POISSON DISTRIBUTION
33587C     EXAMPLE--POISSON MAXIMUM LIKELIHOOD Y
33588C     WRITTEN BY--ALAN HECKERT
33589C                 STATISTICAL ENGINEERING DIVISION
33590C                 INFORMATION TECHNOLOGY LABORATORY
33591C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
33592C                 GAITHERSBURG, MD 20899-8980
33593C                 PHONE--301-975-2899
33594C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
33595C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
33596C     LANGUAGE--ANSI FORTRAN (1977)
33597C     VERSION NUMBER--98/3
33598C     ORIGINAL VERSION--MARCH     1998.
33599C     UPDATED         --MARCH     2004. SUPPORT FOR HTML, LATEX
33600C     UPDATED         --AUGUST    2005. REFORMAT FOR CONSISTENCY WITH
33601C                                       OTHER ML ROUTINES
33602C     UPDATED         --SEPTEMBER 2005. CONFIDENCE INTERVALS FOR
33603C                                       LAMBDA
33604C     UPDATED         --APRIL     2011. USE DPDTA1 AND DPDTA4 TO PRINT
33605C                                       OUTPUT
33606C
33607C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
33608C
33609      CHARACTER*4 ICAPSW
33610      CHARACTER*4 ICAPTY
33611      CHARACTER*4 IFORSW
33612      CHARACTER*4 ISUBRO
33613      CHARACTER*4 IBUGA3
33614      CHARACTER*4 IERROR
33615C
33616      CHARACTER*4 IWRITE
33617      CHARACTER*4 ISUBN1
33618      CHARACTER*4 ISUBN2
33619      CHARACTER*4 ISTEPN
33620C
33621      PARAMETER (NUMALP=8)
33622      DIMENSION ALPHA(NUMALP)
33623      DIMENSION ALOWNO(NUMALP)
33624      DIMENSION AUPPNO(NUMALP)
33625C
33626      REAL POIFUN
33627      EXTERNAL POIFUN
33628      COMMON/POICOM/XSUM,CONST,NTEMP
33629C
33630C---------------------------------------------------------------------
33631C
33632      DIMENSION Y(*)
33633      DIMENSION X(*)
33634      DIMENSION TEMP1(*)
33635      DIMENSION TEMP2(*)
33636      DIMENSION TEMP3(*)
33637C
33638      PARAMETER (MAXROW=15)
33639      CHARACTER*60 ITITLE
33640      CHARACTER*60 ITITLZ
33641      CHARACTER*60 ITITL9
33642      CHARACTER*40 IDIST
33643      CHARACTER*40 ITEXT(MAXROW)
33644      CHARACTER*4  ALIGN(MAXROW)
33645      CHARACTER*4  VALIGN(MAXROW)
33646      REAL         AVALUE(MAXROW)
33647      INTEGER      NCTEXT(MAXROW)
33648      INTEGER      IDIGIT(MAXROW)
33649      INTEGER      NTOT(MAXROW)
33650      LOGICAL      IFRST
33651      LOGICAL      ILAST
33652C
33653      PARAMETER(NUMCLI=3)
33654      PARAMETER(MAXLIN=2)
33655      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
33656      INTEGER      NCTIT2(MAXLIN,NUMCLI)
33657      INTEGER      IWHTML(NUMCLI+1)
33658      INTEGER      IWRTF(NUMCLI)
33659      REAL         AMAT(NUMALP,NUMCLI)
33660C
33661C---------------------------------------------------------------------
33662C
33663      INCLUDE 'DPCOP2.INC'
33664C
33665CCCCC DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
33666      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
33667C
33668C-----START POINT-----------------------------------------------------
33669C
33670      ISUBN1='DPML'
33671      ISUBN2='PO  '
33672      IERROR='NO'
33673C
33674      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPO')THEN
33675        WRITE(ICOUT,999)
33676  999   FORMAT(1X)
33677        CALL DPWRST('XXX','WRIT')
33678        WRITE(ICOUT,51)
33679   51   FORMAT('**** AT THE BEGINNING OF DPMLPO--')
33680        CALL DPWRST('XXX','WRIT')
33681        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR
33682   52   FORMAT('IBUGA3,ISUBRO,N,NVAR = ',2(A4,2X),2I8)
33683        CALL DPWRST('XXX','WRIT')
33684        IF(NVAR.EQ.1)THEN
33685          DO56I=1,MIN(N,100)
33686            WRITE(ICOUT,57)I,Y(I)
33687   57       FORMAT('I,Y(I) = ',I8,G15.7)
33688            CALL DPWRST('XXX','WRIT')
33689   56     CONTINUE
33690        ELSE
33691          DO61I=1,N
33692            WRITE(ICOUT,62)I,X(I),Y(I)
33693   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
33694            CALL DPWRST('XXX','WRIT')
33695   61     CONTINUE
33696        ENDIF
33697      ENDIF
33698C
33699C               ********************************************
33700C               **  STEP 11--                             **
33701C               **  1) ROUND DATA TO INTEGER VALUES       **
33702C               **  2) COMPUTE SUMMARY STATISTICS         **
33703C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
33704C               **     INSUFFICIENT SAMPLE SIZE           **
33705C               ********************************************
33706C
33707      ISTEPN='11'
33708      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPO')
33709     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
33710C
33711      IDIST='POISSON'
33712C
33713      NPERC=0
33714      MAXGRP=MAXNXT/2
33715      NMIN=2
33716      IF(NVAR.EQ.1)THEN
33717        DO1105I=1,N
33718          ITEMP=INT(Y(I)+0.5)
33719          Y(I)=REAL(ITEMP)
33720 1105   CONTINUE
33721        CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
33722        IF(IERROR.EQ.'YES')GOTO9000
33723C
33724        IFLAG=1
33725        CALL SUMRAW(Y,N,IDIST,IFLAG,
33726     1              XMEAN,XVAR,XSD,XMIN,XMAX,
33727     1              ISUBRO,IBUGA3,IERROR)
33728        IF(IERROR.EQ.'YES')GOTO9000
33729        CALL SUMDP(Y,N,IWRITE,XSUM,IBUGA3,IERROR)
33730        NTOTZZ=N
33731      ELSE
33732        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
33733     1              ISUBRO,IBUGA3,IERROR)
33734        IF(IERROR.EQ.'YES')GOTO9000
33735        IFLAG1=1
33736        IFLAG2=1
33737        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
33738     1              TEMP1,TEMP2,TEMP3,MAXNXT,
33739     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
33740     1              ISUBRO,IBUGA3,IERROR)
33741        XSUM=0.0
33742        DO1211I=1,N
33743          XSUM=XSUM + Y(I)*X(I)
33744 1211   CONTINUE
33745      ENDIF
33746      IF(IERROR.EQ.'YES')GOTO9000
33747C
33748      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPO')THEN
33749        WRITE(ICOUT,999)
33750        CALL DPWRST('XXX','WRIT')
33751        WRITE(ICOUT,1311)
33752 1311   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
33753        CALL DPWRST('XXX','WRIT')
33754        WRITE(ICOUT,1312)XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ
33755 1312   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ = ',5G15.7,I10)
33756        CALL DPWRST('XXX','WRIT')
33757      ENDIF
33758C
33759C               *******************************
33760C               **  STEP 41--                **
33761C               **  CARRY OUT CALCULATIONS   **
33762C               **  FOR POISON MLE ESTIMATE  **
33763C               *******************************
33764C
33765      ALAMB=XMEAN
33766      ALMBSE=SQRT(ALAMB/REAL(NTOTZZ))
33767C
33768      NTEMP=NTOTZZ
33769      AE=1.E-5
33770      RE=1.E-5
33771      IFLAG=0
33772C
33773      DO2210I=1,NUMALP
33774C
33775        ALP=ALPHA(I)
33776        P1=ALP/2.0
33777        P2=1.0-(ALP/2.0)
33778C
33779        ITER=0
33780        CONST=P2
33781        ALOWLI=ALAMB - 5.0*ALMBSE
33782        IF(ALOWLI.LE.0.0)ALOWLI=0.00001
33783        AUPPLI=ALAMB
33784        ALOWSV=ALAMB - 5.0*ALMBSE
33785        ALAHAT=(AUPPLI+ALOWLI)/2.0
33786 2201   CONTINUE
33787        IFLAG=0
33788        CALL FZERO(POIFUN,ALOWLI,AUPPLI,ALAHAT,RE,AE,IFLAG)
33789        ALOWNO(I)=ALOWLI
33790        IF(IFLAG.EQ.2)THEN
33791C
33792          WRITE(ICOUT,999)
33793          CALL DPWRST('XXX','BUG ')
33794          WRITE(ICOUT,2211)
33795 2211     FORMAT('***** WARNING FROM POISSON MAXIMUM LIKELIHOOD--')
33796          CALL DPWRST('XXX','BUG ')
33797          WRITE(ICOUT,2213)
33798 2213     FORMAT('      ESTIMATE OF LOWER CONFIDENCE VALUE FOR ',
33799     1           'LAMBDA MAY NOT BE COMPUTED TO DESIRED TOLERANCE.')
33800          CALL DPWRST('XXX','BUG ')
33801        ELSEIF(IFLAG.EQ.3)THEN
33802          WRITE(ICOUT,999)
33803          CALL DPWRST('XXX','BUG ')
33804          WRITE(ICOUT,2211)
33805          CALL DPWRST('XXX','BUG ')
33806          WRITE(ICOUT,2223)
33807 2223     FORMAT('      ESTIMATE OF LOWER CONFIDENCE VALUE FOR ',
33808     1             'LAMBDA MAY BE NEAR A SINGULAR POINT.')
33809          CALL DPWRST('XXX','BUG ')
33810        ELSEIF(IFLAG.EQ.4)THEN
33811          ITER=ITER+1
33812          ALOWLI=ALOWSV/2.0
33813          AUPPLI=ALAMB
33814          ALAHAT=(AUPPLI+ALOWLI)/2.0
33815          IF(ITER.LT.10)GOTO2201
33816          WRITE(ICOUT,999)
33817          CALL DPWRST('XXX','BUG ')
33818          WRITE(ICOUT,2211)
33819          CALL DPWRST('XXX','BUG ')
33820          WRITE(ICOUT,2233)
33821 2233     FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
33822          CALL DPWRST('XXX','BUG ')
33823        ELSEIF(IFLAG.EQ.5)THEN
33824          WRITE(ICOUT,999)
33825          CALL DPWRST('XXX','BUG ')
33826          WRITE(ICOUT,2211)
33827          CALL DPWRST('XXX','BUG ')
33828          WRITE(ICOUT,2243)
33829 2243     FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
33830          CALL DPWRST('XXX','BUG ')
33831        ENDIF
33832C
33833        ITER=0
33834        IFLAG=0
33835        CONST=P1
33836        ALAHAT=ALAMB
33837        ALOWLI=ALAHAT
33838        IF(ALOWLI.LE.0.0)ALOWLI=0.00001
33839        AUPPLI=ALAHAT + 5.0*ALMBSE
33840        AUPPSV=AUPPLI
33841        AUPPLI=ALAMB + 5.0*ALMBSE
33842        ALOWLI=ALAMB
33843        AUPPSV=ALAMB + 5.0*ALMBSE
33844        ALAHAT=(AUPPLI+ALOWLI)/2.0
338452251    CONTINUE
33846        IFLAG=0
33847        CALL FZERO(POIFUN,ALOWLI,AUPPLI,ALAHAT,RE,AE,IFLAG)
33848        AUPPNO(I)=ALOWLI
33849        IF(IFLAG.EQ.2)THEN
33850C
33851          WRITE(ICOUT,999)
33852          CALL DPWRST('XXX','BUG ')
33853          WRITE(ICOUT,2211)
33854          CALL DPWRST('XXX','BUG ')
33855          WRITE(ICOUT,2263)
33856 2263     FORMAT('      ESTIMATE OF UPPER CONFIDENCE VALUE FOR P ',
33857     1           'MAY NOT BE COMPUTED TO DESIRED TOLERANCE.')
33858          CALL DPWRST('XXX','BUG ')
33859        ELSEIF(IFLAG.EQ.3)THEN
33860          WRITE(ICOUT,999)
33861          CALL DPWRST('XXX','BUG ')
33862          WRITE(ICOUT,2211)
33863          CALL DPWRST('XXX','BUG ')
33864          WRITE(ICOUT,2273)
33865 2273     FORMAT('      ESTIMATE OF UPPER CONFIDENCE VALUE FOR P ',
33866     1           'MAY BE NEAR A SINGULAR POINT.')
33867          CALL DPWRST('XXX','BUG ')
33868        ELSEIF(IFLAG.EQ.4)THEN
33869          ITER=ITER+1
33870          AHIGLI=AHIGLI*2.0
33871          ALOWLI=ALAMB
33872          ALAHAT=ALAMB
33873          AUPPLI=AUPPSV*2.0
33874          IF(ITER.LT.1)GOTO2251
33875          WRITE(ICOUT,999)
33876          CALL DPWRST('XXX','BUG ')
33877          WRITE(ICOUT,2211)
33878          CALL DPWRST('XXX','BUG ')
33879          WRITE(ICOUT,2277)
33880 2277     FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
33881          CALL DPWRST('XXX','BUG ')
33882        ELSEIF(IFLAG.EQ.5)THEN
33883          WRITE(ICOUT,999)
33884          CALL DPWRST('XXX','BUG ')
33885          WRITE(ICOUT,2211)
33886          CALL DPWRST('XXX','BUG ')
33887          WRITE(ICOUT,2283)
33888 2283     FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
33889          CALL DPWRST('XXX','BUG ')
33890        ENDIF
33891C
33892 2210 CONTINUE
33893C
33894C               *********************************
33895C               **   STEP 42--                 **
33896C               **   WRITE OUT EVERYTHING      **
33897C               **   FOR POISSON MLE ESTIMATE  **
33898C               **********************************
33899C
33900      ISTEPN='42'
33901      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPO')
33902     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
33903C
33904C     PRINT SUMMARY STATISTICS TABLE
33905C
33906      NUMDIG=7
33907      IF(IFORSW.EQ.'1')NUMDIG=1
33908      IF(IFORSW.EQ.'2')NUMDIG=2
33909      IF(IFORSW.EQ.'3')NUMDIG=3
33910      IF(IFORSW.EQ.'4')NUMDIG=4
33911      IF(IFORSW.EQ.'5')NUMDIG=5
33912      IF(IFORSW.EQ.'6')NUMDIG=6
33913      IF(IFORSW.EQ.'7')NUMDIG=7
33914      IF(IFORSW.EQ.'8')NUMDIG=8
33915      IF(IFORSW.EQ.'9')NUMDIG=9
33916      IF(IFORSW.EQ.'0')NUMDIG=0
33917      IF(IFORSW.EQ.'E')NUMDIG=-2
33918      IF(IFORSW.EQ.'-2')NUMDIG=-2
33919      IF(IFORSW.EQ.'-3')NUMDIG=-3
33920      IF(IFORSW.EQ.'-4')NUMDIG=-4
33921      IF(IFORSW.EQ.'-5')NUMDIG=-5
33922      IF(IFORSW.EQ.'-6')NUMDIG=-6
33923      IF(IFORSW.EQ.'-7')NUMDIG=-7
33924      IF(IFORSW.EQ.'-8')NUMDIG=-8
33925      IF(IFORSW.EQ.'-9')NUMDIG=-9
33926C
33927      ITITLE='Poisson Parameter Estimation'
33928      NCTITL=28
33929      ITITLZ=' '
33930      NCTITZ=0
33931C
33932      ICNT=1
33933      ITEXT(ICNT)='Summary Statistics:'
33934      NCTEXT(ICNT)=19
33935      AVALUE(ICNT)=0.0
33936      IDIGIT(ICNT)=-1
33937      ICNT=ICNT+1
33938      ITEXT(ICNT)='Number of Observations:'
33939      NCTEXT(ICNT)=23
33940      AVALUE(ICNT)=REAL(NTOTZZ)
33941      IDIGIT(ICNT)=0
33942      ICNT=ICNT+1
33943      ITEXT(ICNT)='Sample Mean:'
33944      NCTEXT(ICNT)=12
33945      AVALUE(ICNT)=XMEAN
33946      IDIGIT(ICNT)=NUMDIG
33947      ICNT=ICNT+1
33948      ITEXT(ICNT)='Sample Standard Deviation:'
33949      NCTEXT(ICNT)=26
33950      AVALUE(ICNT)=XSD
33951      IDIGIT(ICNT)=NUMDIG
33952      ICNT=ICNT+1
33953      ITEXT(ICNT)='Sample Minimum:'
33954      NCTEXT(ICNT)=15
33955      AVALUE(ICNT)=XMIN
33956      IDIGIT(ICNT)=NUMDIG
33957      ICNT=ICNT+1
33958      ITEXT(ICNT)='Sample Maximum:'
33959      NCTEXT(ICNT)=15
33960      AVALUE(ICNT)=XMAX
33961      IDIGIT(ICNT)=NUMDIG
33962      ICNT=ICNT+1
33963      ITEXT(ICNT)=' '
33964      NCTEXT(ICNT)=0
33965      AVALUE(ICNT)=0.0
33966      IDIGIT(ICNT)=-1
33967C
33968      ICNT=ICNT+1
33969      ITEXT(ICNT)='Method of Maximum Likelihood:'
33970      NCTEXT(ICNT)=29
33971      AVALUE(ICNT)=0.0
33972      IDIGIT(ICNT)=-1
33973      ICNT=ICNT+1
33974      ITEXT(ICNT)='Estimate of Lambda:'
33975      NCTEXT(ICNT)=19
33976      AVALUE(ICNT)=ALAMB
33977      IDIGIT(ICNT)=NUMDIG
33978      ICNT=ICNT+1
33979      ITEXT(ICNT)='Standard Error of Lambda:'
33980      NCTEXT(ICNT)=25
33981      AVALUE(ICNT)=ALMBSE
33982      IDIGIT(ICNT)=NUMDIG
33983C
33984      NUMROW=ICNT
33985      DO2410I=1,NUMROW
33986        NTOT(I)=15
33987 2410 CONTINUE
33988C
33989      IFRST=.TRUE.
33990      ILAST=.TRUE.
33991      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
33992     1            AVALUE,IDIGIT,
33993     1            NTOT,NUMROW,
33994     1            ICAPSW,ICAPTY,ILAST,IFRST,
33995     1            ISUBRO,IBUGA3,IERROR)
33996C
33997      ITITL9='Confidence Interval for Lambda Parameter'
33998      NCTIT9=40
33999      ITITLE=' '
34000      NCTITL=0
34001C
34002      NUMLIN=2
34003      NUMCOL=3
34004      DO2510J=1,NUMCLI
34005        DO2520I=1,NUMLIN
34006          ITITL2(I,J)=' '
34007          NCTIT2(I,J)=0
34008 2520   CONTINUE
34009 2510 CONTINUE
34010C
34011      ITITL2(1,1)='Confidence'
34012      ITITL2(2,1)='Value (%)'
34013      NCTIT2(1,1)=10
34014      NCTIT2(2,1)=9
34015C
34016      ITITL2(1,2)='Lower'
34017      ITITL2(2,2)='Limit'
34018      NCTIT2(1,2)=5
34019      NCTIT2(2,2)=5
34020C
34021      ITITL2(1,3)='Upper'
34022      ITITL2(2,3)='Limit'
34023      NCTIT2(1,3)=5
34024      NCTIT2(2,3)=5
34025C
34026      NMAX=0
34027      DO2321I=1,NUMCOL
34028        VALIGN(I)='b'
34029        ALIGN(I)='r'
34030        NTOT(I)=15
34031        NMAX=NMAX+NTOT(I)
34032        IDIGIT(I)=NUMDIG
34033 2321 CONTINUE
34034      IDIGIT(1)=3
34035      DO2323I=1,NUMALP
34036        NCTEXT(I)=0
34037        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
34038        AMAT(I,2)=ALOWNO(I)
34039        AMAT(I,3)=AUPPNO(I)
34040 2323 CONTINUE
34041      IWHTML(1)=100
34042      IWHTML(2)=150
34043      IWHTML(3)=150
34044      IWHTML(4)=150
34045      IWRTF(1)=1600
34046      IWRTF(2)=IWRTF(1)+1800
34047      IWRTF(3)=IWRTF(2)+1800
34048      IFRST=.TRUE.
34049      ILAST=.TRUE.
34050C
34051      CALL DPDTA2(ITITL9,NCTIT9,
34052     1            ITITLE,NCTITL,ITITL2,NCTIT2,
34053     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
34054     1            ITEXT,NCTEXT,AMAT,NUMALP,NUMALP,
34055     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
34056     1            ICAPSW,ICAPTY,IFRST,ILAST,
34057     1            ISUBRO,IBUGA3,IERROR)
34058C
34059C               *****************
34060C               **  STEP 90--  **
34061C               **  EXIT       **
34062C               *****************
34063C
34064 9000 CONTINUE
34065      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPO')THEN
34066        WRITE(ICOUT,999)
34067        CALL DPWRST('XXX','WRIT')
34068        WRITE(ICOUT,9011)
34069 9011   FORMAT('***** AT THE END       OF DPMLPO--')
34070        CALL DPWRST('XXX','WRIT')
34071        WRITE(ICOUT,9012)IERROR,ALAMB,ALMBSE
34072 9012   FORMAT('IERROR,ALAMB,ALMBSE = ',A4,2X,2G15.7)
34073        CALL DPWRST('XXX','WRIT')
34074      ENDIF
34075C
34076      RETURN
34077      END
34078      SUBROUTINE DPMLPW(Y,X,X2,N,NUMVAR,ITYPE,A,B,
34079     1                  TEMP1,TEMP2,TEMP3,MAXNXT,
34080     1                  SHAPML,SHAPMO,SHAPSE,
34081     1                  ALIK,AIC,AICC,BIC,
34082     1                  ICAPSW,ICAPTY,IFORSW,
34083     1                  ISUBRO,IBUGA3,IERROR)
34084C
34085C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
34086C              ESTIMATES FOR THE POWER DISTRIBUTION (OR THE
34087C              REFLECTED POWER DISTRIBUTION).  IT HANDLES EITHER
34088C              UNBINNED OR BINNED DATA.
34089C     EXAMPLE--POWER MAXIMUM LIKELIHOOD Y
34090C            --REFLECTED POWER MAXIMUM LIKELIHOOD Y
34091C            --POWER MAXIMUM LIKELIHOOD Y X
34092C     REFERENCE--EVANS, HASTINGS, AND PEACOCK (2000), "STATISTICAL
34093C                DISTRIBUTIONS", THIRD EDITION, WILEY, CHAPTER 33.
34094C     WRITTEN BY--ALAN HECKERT
34095C                 STATISTICAL ENGINEERING DIVISION
34096C                 INFORMATION TECHNOLOGY LABORATORY
34097C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
34098C                 GAITHERSBURG, MD 20899-8980
34099C                 PHONE--301-975-2855
34100C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
34101C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
34102C     LANGUAGE--ANSI FORTRAN (1977)
34103C     VERSION NUMBER--98/6
34104C     ORIGINAL VERSION--JUNE      1998.
34105C     UPDATED         --MARCH     2004. SUPPORT FOR HTML, LATEX
34106C     UPDATED         --AUGUST    2005. REFORMAT OUTPUT FOR CONSISTENCY
34107C                                       WITH OTHER ML ROUTINES
34108C     UPDATED         --DECEMBER  2007. SCALE DATA TO (0,1) INTERVAL
34109C                                       BEFORE OBTAINING ML ESTIMATE
34110C     UPDATED         --MARCH     2008. SUPPORT FOR REFLECTED POWER
34111C                                       DISTRIBUTION
34112C     UPDATED         --MARCH     2008. SUPPORT FOR EQUI-SPACED
34113C                                       GROUPED DATA
34114C     UPDATED         --JULY      2010. USE DPDTA1 TO PRINT
34115C     UPDATED         --JULY      2010. EXTRACT ML TO POWML1 AND
34116C                                       POWML2
34117C
34118C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
34119C
34120      CHARACTER*4 ICAPSW
34121      CHARACTER*4 ICAPTY
34122      CHARACTER*4 IFORSW
34123      CHARACTER*4 ISUBRO
34124      CHARACTER*4 IBUGA3
34125      CHARACTER*4 IERROR
34126C
34127      CHARACTER*4 ITYPE
34128      CHARACTER*4 ILIKFL
34129C
34130      CHARACTER*4 IWRITE
34131      CHARACTER*4 ISUBN1
34132      CHARACTER*4 ISUBN2
34133      CHARACTER*4 ISTEPN
34134C
34135      PARAMETER (NUMALP=8)
34136      DIMENSION ALPHA(NUMALP)
34137      DIMENSION ALOWSC(NUMALP)
34138      DIMENSION ALOWSH(NUMALP)
34139      DIMENSION AUPPSH(NUMALP)
34140C
34141C---------------------------------------------------------------------
34142C
34143      DIMENSION Y(*)
34144      DIMENSION X(*)
34145      DIMENSION X2(*)
34146      DIMENSION TEMP1(*)
34147      DIMENSION TEMP2(*)
34148      DIMENSION TEMP3(*)
34149C
34150      INCLUDE 'DPCOST.INC'
34151C
34152      PARAMETER (MAXROW=20)
34153      CHARACTER*60 ITITLE
34154      CHARACTER*60 ITITLZ
34155      CHARACTER*40 ITEXT(MAXROW)
34156      REAL         AVALUE(MAXROW)
34157      INTEGER      NCTEXT(MAXROW)
34158      INTEGER      IDIGIT(MAXROW)
34159      INTEGER      NTOT(MAXROW)
34160      LOGICAL IFRST
34161      LOGICAL ILAST
34162C
34163C---------------------------------------------------------------------
34164C
34165      INCLUDE 'DPCOP2.INC'
34166C
34167      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
34168C
34169C-----START POINT-----------------------------------------------------
34170C
34171      ISUBN1='DPML'
34172      ISUBN2='PW  '
34173      IERROR='NO'
34174C
34175      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPW')THEN
34176        WRITE(ICOUT,999)
34177  999   FORMAT(1X)
34178        CALL DPWRST('XXX','WRIT')
34179        WRITE(ICOUT,51)
34180   51   FORMAT('**** AT THE BEGINNING OF DPMLPW--')
34181        CALL DPWRST('XXX','WRIT')
34182        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NUMVAR,A,B
34183   52   FORMAT('IBUGA3,ISUBRO,N,NUMVAR = ',2(A4,2X),2I8,2G15.7)
34184        CALL DPWRST('XXX','WRIT')
34185        DO56I=1,MIN(N,100)
34186          WRITE(ICOUT,57)I,Y(I),X(I),X2(I)
34187   57     FORMAT('I,Y(I),X(I),X2(I) = ',I8,3G15.7)
34188          CALL DPWRST('XXX','WRIT')
34189   56   CONTINUE
34190      ENDIF
34191C
34192C               ********************************************
34193C               **  STEP 11--                             **
34194C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
34195C               ********************************************
34196C
34197      ISTEPN='11'
34198      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPO')
34199     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
34200C
34201      IERROR='NO'
34202      IWRITE='OFF'
34203C
34204      NPERC=0
34205      NMIN=3
34206      IF(NUMVAR.EQ.1)THEN
34207        CALL CKDIST(Y,N,NMIN,TEMP2,NPERC,ISUBRO,IBUGA3,IERROR)
34208        IF(IERROR.EQ.'YES')GOTO9000
34209      ELSEIF(NUMVAR.EQ.2)THEN
34210        CALL CKDIS2(Y,X,TEMP1,N,MAXNXT,NMIN,TEMP2,NPERC,NTOT2,
34211     1              ISUBRO,IBUGA3,IERROR)
34212        IF(IERROR.EQ.'YES')GOTO9000
34213      ELSEIF(NUMVAR.EQ.3)THEN
34214        CALL CKDIS3(Y,X,X2,TEMP1,N,MAXNXT,NMIN,TEMP2,NPERC,NTOT2,
34215     1              ISUBRO,IBUGA3,IERROR)
34216        IF(IERROR.EQ.'YES')GOTO9000
34217      ENDIF
34218C
34219C               **********************************
34220C               **  STEP 41--                   **
34221C               **  CARRY OUT CALCULATIONS      **
34222C               **  FOR POWER              MLE  **
34223C               **********************************
34224C
34225      ISTEPN='21'
34226      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPO')
34227     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
34228C
34229      ALIK=CPUMIN
34230      AIC=CPUMIN
34231      AICC=CPUMIN
34232      BIC=CPUMIN
34233C
34234      ZMIN=CPUMIN
34235      ZMAX=CPUMAX
34236      IF(A.NE.CPUMIN)ZMIN=A
34237      IF(B.NE.CPUMIN)ZMAX=B
34238      IF(NUMVAR.EQ.1)THEN
34239        DO1010I=1,N
34240          TEMP1(I)=Y(I)
34241 1010   CONTINUE
34242        CALL POWML1(TEMP1,N,ITYPE,
34243     1              XMIN,XMAX,XMEAN,XSD,
34244     1              SHAPMO,SHAPML,ZMIN,ZMAX,
34245     1              ISUBRO,IBUGA3,IERROR)
34246        IF(IERROR.EQ.'YES')GOTO9000
34247        SHAPSE=SHAPML/SQRT(REAL(N))
34248        CALL POWLI1(Y,N,TEMP1,SHAPML,ZMIN,ZMAX,ITYPE,
34249     1              ALIK,AIC,AICC,BIC,
34250     1              ISUBRO,IBUGA3,IERROR)
34251      ELSEIF(NUMVAR.EQ.2 .OR. NUMVAR.EQ.3)THEN
34252        CALL POWML2(Y,X,X2,N,NUMVAR,ITYPE,
34253     1              TEMP1,TEMP2,TEMP3,
34254     1              XMIN,XMAX,XMEAN,XSD,NTOT2,
34255     1              SHAPMO,SHAPML,ZMIN,ZMAX,
34256     1              ISUBRO,IBUGA3,IERROR)
34257        SHAPSE=SHAPML/SQRT(REAL(NTOT2))
34258      ENDIF
34259C
34260C     STEP 2: CONFIDENCE INTERVAL FOR C BASED ON NORMAL APPROXIMATION
34261C
34262      DO2220I=1,NUMALP
34263        ALP=ALPHA(I)
34264        P=1.0-(ALP/2.0)
34265        CALL NORPPF(P,PPF)
34266        ALOWSC(I)=CPUMIN
34267        ALOWSH(I)=SHAPML - PPF*SHAPSE
34268        AUPPSH(I)=SHAPML + PPF*SHAPSE
34269 2220 CONTINUE
34270C
34271C               ***********************************************
34272C               **   STEP 42--                               **
34273C               **   WRITE OUT EVERYTHING                    **
34274C               **   FOR POWER MLE ESTIMATION                **
34275C               ***********************************************
34276C
34277      ISTEPN='42'
34278      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPW')
34279     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
34280C
34281      IF(IPRINT.EQ.'OFF')GOTO9000
34282C
34283      NUMDIG=7
34284      IF(IFORSW.EQ.'1')NUMDIG=1
34285      IF(IFORSW.EQ.'2')NUMDIG=2
34286      IF(IFORSW.EQ.'3')NUMDIG=3
34287      IF(IFORSW.EQ.'4')NUMDIG=4
34288      IF(IFORSW.EQ.'5')NUMDIG=5
34289      IF(IFORSW.EQ.'6')NUMDIG=6
34290      IF(IFORSW.EQ.'7')NUMDIG=7
34291      IF(IFORSW.EQ.'8')NUMDIG=8
34292      IF(IFORSW.EQ.'9')NUMDIG=9
34293      IF(IFORSW.EQ.'0')NUMDIG=0
34294      IF(IFORSW.EQ.'E')NUMDIG=-2
34295      IF(IFORSW.EQ.'-2')NUMDIG=-2
34296      IF(IFORSW.EQ.'-3')NUMDIG=-3
34297      IF(IFORSW.EQ.'-4')NUMDIG=-4
34298      IF(IFORSW.EQ.'-5')NUMDIG=-5
34299      IF(IFORSW.EQ.'-6')NUMDIG=-6
34300      IF(IFORSW.EQ.'-7')NUMDIG=-7
34301      IF(IFORSW.EQ.'-8')NUMDIG=-8
34302      IF(IFORSW.EQ.'-9')NUMDIG=-9
34303C
34304      IF(ITYPE.EQ.'POWE')THEN
34305        ITITLE='Power Parameter Estimation'
34306        NCTITL=26
34307      ELSE
34308        ITITLE='Reflected Power Parameter Estimation'
34309        NCTITL=36
34310      ENDIF
34311      ITITLZ=' '
34312      NCTITZ=0
34313      ICNT=1
34314      ITEXT(ICNT)='Summary Statistics:'
34315      NCTEXT(ICNT)=19
34316      AVALUE(ICNT)=0.0
34317      IDIGIT(ICNT)=-1
34318      ICNT=ICNT+1
34319      ITEXT(ICNT)='Number of Observations:'
34320      NCTEXT(ICNT)=23
34321      AVALUE(ICNT)=REAL(N)
34322      IF(NUMVAR.GT.1)AVALUE(ICNT)=REAL(NTOT2)
34323      IDIGIT(ICNT)=0
34324      ICNT=ICNT+1
34325      ITEXT(ICNT)='Sample Mean:'
34326      NCTEXT(ICNT)=12
34327      AVALUE(ICNT)=XMEAN
34328      IDIGIT(ICNT)=NUMDIG
34329      ICNT=ICNT+1
34330      ITEXT(ICNT)='Sample Standard Deviation:'
34331      NCTEXT(ICNT)=26
34332      AVALUE(ICNT)=XSD
34333      IDIGIT(ICNT)=NUMDIG
34334      ICNT=ICNT+1
34335      ITEXT(ICNT)='Sample Minimum:'
34336      NCTEXT(ICNT)=15
34337      AVALUE(ICNT)=XMIN
34338      IDIGIT(ICNT)=NUMDIG
34339      ICNT=ICNT+1
34340      ITEXT(ICNT)='Sample Maximum:'
34341      NCTEXT(ICNT)=15
34342      AVALUE(ICNT)=XMAX
34343      IDIGIT(ICNT)=NUMDIG
34344      ICNT=ICNT+1
34345      ITEXT(ICNT)='Value Used for Lower Limit:'
34346      NCTEXT(ICNT)=27
34347      AVALUE(ICNT)=ZMIN
34348      IDIGIT(ICNT)=NUMDIG
34349      ICNT=ICNT+1
34350      ITEXT(ICNT)='Value Used for Upper Limit:'
34351      NCTEXT(ICNT)=27
34352      AVALUE(ICNT)=ZMAX
34353      IDIGIT(ICNT)=NUMDIG
34354      ICNT=ICNT+1
34355      ITEXT(ICNT)=' '
34356      NCTEXT(ICNT)=0
34357      AVALUE(ICNT)=0.0
34358      IDIGIT(ICNT)=-1
34359C
34360      ICNT=ICNT+1
34361      ITEXT(ICNT)='Moments:'
34362      NCTEXT(ICNT)=8
34363      AVALUE(ICNT)=0.0
34364      IDIGIT(ICNT)=-1
34365      ICNT=ICNT+1
34366      ITEXT(ICNT)='Estimate of Shape (C):'
34367      NCTEXT(ICNT)=22
34368      AVALUE(ICNT)=SHAPMO
34369      IDIGIT(ICNT)=NUMDIG
34370      ICNT=ICNT+1
34371      ITEXT(ICNT)=' '
34372      NCTEXT(ICNT)=0
34373      AVALUE(ICNT)=0.0
34374      IDIGIT(ICNT)=-1
34375C
34376      ICNT=ICNT+1
34377      ITEXT(ICNT)='Maximum Likelihood:'
34378      NCTEXT(ICNT)=19
34379      AVALUE(ICNT)=0.0
34380      IDIGIT(ICNT)=-1
34381      ICNT=ICNT+1
34382      ITEXT(ICNT)='Estimate of Shape (C):'
34383      NCTEXT(ICNT)=22
34384      AVALUE(ICNT)=SHAPML
34385      IDIGIT(ICNT)=NUMDIG
34386      ICNT=ICNT+1
34387      ITEXT(ICNT)='Standard Error of Shape (C):'
34388      NCTEXT(ICNT)=28
34389      AVALUE(ICNT)=SHAPSE
34390      IDIGIT(ICNT)=NUMDIG
34391C
34392      IF(ALIK.NE.CPUMIN)THEN
34393        ICNT=ICNT+1
34394        ITEXT(ICNT)='Log-likelihood:'
34395        NCTEXT(ICNT)=15
34396        AVALUE(ICNT)=ALIK
34397        IDIGIT(ICNT)=-7
34398        ICNT=ICNT+1
34399        ITEXT(ICNT)='AIC:'
34400        NCTEXT(ICNT)=4
34401        AVALUE(ICNT)=AIC
34402        IDIGIT(ICNT)=-7
34403        ICNT=ICNT+1
34404        ITEXT(ICNT)='AICc:'
34405        NCTEXT(ICNT)=5
34406        AVALUE(ICNT)=AICC
34407        IDIGIT(ICNT)=-7
34408        ICNT=ICNT+1
34409        ITEXT(ICNT)='BIC:'
34410        NCTEXT(ICNT)=4
34411        AVALUE(ICNT)=BIC
34412        IDIGIT(ICNT)=-7
34413      ENDIF
34414C
34415      NUMROW=ICNT
34416      DO2320I=1,NUMROW
34417        NTOT(I)=15
34418 2320 CONTINUE
34419C
34420      IFRST=.FALSE.
34421      ILAST=.FALSE.
34422      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
34423     1            AVALUE,IDIGIT,
34424     1            NTOT,NUMROW,
34425     1            ICAPSW,ICAPTY,ILAST,IFRST,
34426     1            ISUBRO,IBUGA3,IERROR)
34427C
34428      ILIKFL='OFF'
34429      CALL DPDTA8(ALOWSC,ALOWSC,ALOWSC,ALOWSC,
34430     1            ALOWSH,AUPPSH,ALOWSH,AUPPSH,ALPHA,NUMALP,
34431     1            ICAPSW,ICAPTY,NUMDIG,ILIKFL,
34432     1            ISUBRO,IBUGA3,IERROR)
34433C
34434C               *****************
34435C               **  STEP 90--  **
34436C               **  EXIT       **
34437C               *****************
34438C
34439 9000 CONTINUE
34440      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPW')THEN
34441        WRITE(ICOUT,999)
34442        CALL DPWRST('XXX','WRIT')
34443        WRITE(ICOUT,9011)
34444 9011   FORMAT('***** AT THE END       OF DPMLPW--')
34445        CALL DPWRST('XXX','WRIT')
34446        WRITE(ICOUT,9012)N,IBUGA3,IERROR
34447 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
34448        CALL DPWRST('XXX','WRIT')
34449        WRITE(ICOUT,9015)N
34450 9015   FORMAT('N = ',I8)
34451        CALL DPWRST('XXX','WRIT')
34452      ENDIF
34453C
34454      RETURN
34455      END
34456      SUBROUTINE DPMLPX(Y,N,MAXNXT,
34457     1                  TEMP1,TEMP2,DISPAR,DTEMP1,ITEMP,
34458     1                  SCALSV,BETASV,
34459     1                  SCALML,SCALSE,BETAML,BETASE,COVSE,
34460     1                  ICAPSW,ICAPTY,IFORSW,
34461     1                  ISUBRO,IBUGA3,IERROR)
34462C
34463C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
34464C              ESTIMATES FOR THE EXPONENTIAL POWER DISTRIBUTION
34465C              FOR THE FULL SAMPLE CASE.
34466C     EXAMPLE--EXPONENTIAL POWER MAXIMUM LIKELIHOOD Y
34467C     REFERENCE--DHILLON (1981), "LIFE DISTRIBUTIONS", IEEE
34468C                TRANSACTIONS ON RELIABILITY, VOL. R-30, NO. 5,
34469C                PP. 457-459.
34470C     WRITTEN BY--ALAN HECKERT
34471C                 STATISTICAL ENGINEERING DIVISION
34472C                 INFORMATION TECHNOLOGY LABORATORY
34473C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
34474C                 GAITHERSBURG, MD 20899-8980
34475C                 PHONE--301-975-2899
34476C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
34477C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
34478C     LANGUAGE--ANSI FORTRAN (1977)
34479C     VERSION NUMBER--2007/11
34480C     ORIGINAL VERSION--NOVEMBER  2007.
34481C     UPDATED         --JULY      2010. USE DPDTA1 TO PRINT OUTPUT
34482C
34483C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
34484C
34485      CHARACTER*4 ICAPSW
34486      CHARACTER*4 ICAPTY
34487      CHARACTER*4 IFORSW
34488C
34489      CHARACTER*4 ISUBRO
34490      CHARACTER*4 IBUGA3
34491      CHARACTER*4 IERROR
34492      CHARACTER*4 IWRITE
34493      CHARACTER*4 ILIKFL
34494C
34495      CHARACTER*4 ISUBN1
34496      CHARACTER*4 ISUBN2
34497      CHARACTER*4 ISTEPN
34498C
34499C---------------------------------------------------------------------
34500C
34501      PARAMETER (NUMALP=8)
34502      DIMENSION ALPHA(NUMALP)
34503      DIMENSION ALOWSC(NUMALP)
34504      DIMENSION AUPPSC(NUMALP)
34505      DIMENSION ALOWBE(NUMALP)
34506      DIMENSION AUPPBE(NUMALP)
34507      DIMENSION ALOWS2(1)
34508      DIMENSION AUPPS2(1)
34509      DIMENSION ALOWB2(1)
34510      DIMENSION AUPPB2(1)
34511C
34512      DIMENSION QP(1)
34513      DIMENSION FISH(2,2)
34514      DIMENSION COV(2,2)
34515C
34516      DIMENSION Y(*)
34517      DIMENSION TEMP1(*)
34518      DIMENSION TEMP2(*)
34519      DIMENSION DISPAR(*)
34520      DOUBLE PRECISION DTEMP1(*)
34521      INTEGER ITEMP(*)
34522C
34523      EXTERNAL PEXFUN
34524C
34525      DOUBLE PRECISION DTERM1
34526      DOUBLE PRECISION DTERM2
34527      DOUBLE PRECISION DTERM3
34528      DOUBLE PRECISION DSUM1
34529      DOUBLE PRECISION DSUM2
34530      DOUBLE PRECISION DA
34531      DOUBLE PRECISION DB
34532      DOUBLE PRECISION DC
34533      DOUBLE PRECISION DX
34534      DOUBLE PRECISION DN
34535      DOUBLE PRECISION DALPHA
34536      DOUBLE PRECISION DBETA
34537C
34538CCCCC DOUBLE PRECISION TOL
34539CCCCC DOUBLE PRECISION XPAR(2)
34540CCCCC DOUBLE PRECISION FVEC(2)
34541C
34542      INCLUDE 'DPCOST.INC'
34543C
34544      PARAMETER (MAXROW=20)
34545      CHARACTER*40 ITITLE
34546      CHARACTER*1  ITITLZ
34547      CHARACTER*40 ITEXT(MAXROW)
34548      REAL         AVALUE(MAXROW)
34549      INTEGER      NCTEXT(MAXROW)
34550      INTEGER      IDIGIT(MAXROW)
34551      INTEGER      NTOT(MAXROW)
34552      LOGICAL IFRST
34553      LOGICAL ILAST
34554C
34555C---------------------------------------------------------------------
34556C
34557      INCLUDE 'DPCOP2.INC'
34558C
34559      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
34560C
34561C-----START POINT-----------------------------------------------------
34562C
34563      ISUBN1='DPML'
34564      ISUBN2='PX  '
34565      IERROR='NO'
34566C
34567      BETAML=CPUMIN
34568      BETASE=CPUMIN
34569      SCALML=CPUMIN
34570      SCALSE=CPUMIN
34571C
34572      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPX')THEN
34573        WRITE(ICOUT,999)
34574  999   FORMAT(1X)
34575        CALL DPWRST('XXX','WRIT')
34576        WRITE(ICOUT,51)
34577   51   FORMAT('**** AT THE BEGINNING OF DPMLPX--')
34578        CALL DPWRST('XXX','WRIT')
34579        WRITE(ICOUT,52)IBUGA3,ISUBRO,N
34580   52   FORMAT('IBUGA3,ISUBRO,N = ',A4,2X,A4,2X,I8)
34581        CALL DPWRST('XXX','WRIT')
34582        WRITE(ICOUT,55)SCALSV,BETASV
34583   55   FORMAT('SCALSV,BETASV = ',2G15.7)
34584        CALL DPWRST('XXX','WRIT')
34585        DO56I=1,MIN(N,100)
34586          WRITE(ICOUT,57)I,Y(I)
34587   57     FORMAT('I,Y(I) = ',I8,G15.7)
34588          CALL DPWRST('XXX','WRIT')
34589   56   CONTINUE
34590      ENDIF
34591C
34592C               ********************************************
34593C               **  STEP 11--                             **
34594C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
34595C               ********************************************
34596C
34597      ISTEPN='11'
34598      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPX')
34599     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
34600C
34601      NPERC=0
34602      NMIN=3
34603      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
34604      IF(IERROR.EQ.'YES')GOTO9000
34605C
34606C               **********************************
34607C               **  STEP 21--                   **
34608C               **  CARRY OUT CALCULATIONS      **
34609C               **  FOR EXPONENTIAL POWER MLE   **
34610C               **  ESTIMATE (FULL SAMPLE CASE) **
34611C               **********************************
34612C
34613      ISTEPN='21'
34614      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPX')
34615     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
34616C
34617      IERROR='NO'
34618      IWRITE='OFF'
34619C
34620      CALL PEXML1(Y,N,BETASV,SCALSV,MAXNXT,
34621     1            TEMP1,TEMP2,DISPAR,DTEMP1,
34622     1            XMEAN,XSD,XVAR,XMIN,XMAX,
34623     1            BETAML,SCALML,
34624     1            ISUBRO,IBUGA3,IERROR)
34625      IF(IERROR.EQ.'YES')GOTO9000
34626C
34627C     COMPUTE STANDARD ERRORS
34628C
34629      DN=DBLE(N)
34630      DALPHA=1.0D0/SCALML
34631      DBETA=DBLE(BETAML)
34632C
34633      DSUM1=0.0D0
34634      DSUM2=0.0D0
34635      DO2160I=1,N
34636C
34637        DX=DBLE(Y(I))
34638        DA=DLOG(DX)
34639        DB=(DALPHA*DX)**DBETA
34640        DC=DLOG(DALPHA*DX)
34641C
34642        DTERM1=(DC**2)*DB
34643        DSUM1=DSUM1 + DTERM1*(DB+1.0D0)*DEXP(DB)
34644        DSUM2=DSUM2 + DTERM1
34645C
34646 2160 CONTINUE
34647C
34648      DTERM1=-DN/DBETA**2
34649      FISH(1,1)=-REAL(DTERM1 - DSUM1 + DSUM2)
34650C
34651      DSUM1=0.0D0
34652      DSUM2=0.0D0
34653      DO2170I=1,N
34654C
34655        DX=DBLE(Y(I))
34656        DA=DLOG(DX)
34657        DB=(DALPHA*DX)**DBETA
34658        DC=DLOG(DALPHA*DX)
34659C
34660        DSUM1=DSUM1 + DEXP(DB)*((DBETA-1.0D0)*DB + DB**2*DBETA)
34661        DSUM2=DSUM2 + DB
34662C
34663 2170 CONTINUE
34664C
34665      DTERM1=-DBETA*DN/DALPHA**2
34666      DTERM2=DBETA/DALPHA**2
34667      DTERM3=DBETA*(DBETA-1.0D0)/DALPHA**2
34668      FISH(2,2)=-REAL(DTERM1 - DTERM2*DSUM1 + DTERM3*DSUM2)
34669C
34670      DSUM1=0.0D0
34671      DSUM2=0.0D0
34672      DO2180I=1,N
34673C
34674        DX=DBLE(Y(I))
34675        DA=DLOG(DX)
34676        DB=(DALPHA*DX)**DBETA
34677        DC=DLOG(DALPHA*DX)
34678C
34679        DSUM1=DSUM1 + DB*DEXP(DB)*(1.0D0 + DBETA*DLOG(DALPHA) +
34680     1                DBETA*DA + DBETA*DB*DC)
34681        DSUM2=DSUM2 + DB*(1.0D0 + DBETA*DLOG(DALPHA) + DBETA*DA)
34682C
34683 2180 CONTINUE
34684C
34685      DTERM1=DN/DALPHA
34686      DTERM2=1.0D0/DALPHA
34687      FISH(1,2)=-REAL(DTERM1 - DTERM2*DSUM1 + DTERM2*DSUM2)
34688      FISH(2,1)=FISH(1,2)
34689C
34690      CALL SGECO(FISH,2,2,ITEMP,RCOND,TEMP1)
34691      IJOB=1
34692      CALL SGEDI(FISH,2,2,ITEMP,TEMP1,TEMP1(MAXNXT/2),IJOB)
34693      COV(1:2,1:2)=FISH(1:2,1:2)
34694CCCCC DO2810J=1,3
34695CCCCC   DO2815I=1,3
34696CCCCC     COV(I,J)=FISH(I,J)
34697C2815   CONTINUE
34698c2810 CONTINUE
34699C
34700      BETASE=SQRT(COV(1,1))
34701      SCALSE=SQRT(COV(2,2))
34702      COVSE=COV(2,1)
34703C
34704C  CONFIDENCE INTERVALS FOR PARAMETERS BASED ON NORMAL
34705C  APPROXIMATION.
34706C
34707      DO2220I=1,NUMALP
34708        ALP=ALPHA(I)
34709        P=1.0-(ALP/2.0)
34710        CALL NORPPF(P,PPF)
34711        ALOWSC(I)=SCALML - PPF*SCALSE
34712        AUPPSC(I)=SCALML + PPF*SCALSE
34713        ALOWBE(I)=BETAML - PPF*BETASE
34714        AUPPBE(I)=BETAML + PPF*BETASE
34715 2220 CONTINUE
34716C
34717C               *******************************************
34718C               **   STEP 42--                           **
34719C               **   WRITE OUT EVERYTHING                **
34720C               **   FOR EXPONENTIAL POWER MLE ESTIMATE  **
34721C               *******************************************
34722C
34723      ISTEPN='42'
34724      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPX')
34725     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
34726C
34727      IF(IPRINT.EQ.'OFF')GOTO9000
34728C
34729      NUMDIG=7
34730      IF(IFORSW.EQ.'1')NUMDIG=1
34731      IF(IFORSW.EQ.'2')NUMDIG=2
34732      IF(IFORSW.EQ.'3')NUMDIG=3
34733      IF(IFORSW.EQ.'4')NUMDIG=4
34734      IF(IFORSW.EQ.'5')NUMDIG=5
34735      IF(IFORSW.EQ.'6')NUMDIG=6
34736      IF(IFORSW.EQ.'7')NUMDIG=7
34737      IF(IFORSW.EQ.'8')NUMDIG=8
34738      IF(IFORSW.EQ.'9')NUMDIG=9
34739      IF(IFORSW.EQ.'0')NUMDIG=0
34740      IF(IFORSW.EQ.'E')NUMDIG=-2
34741      IF(IFORSW.EQ.'-2')NUMDIG=-2
34742      IF(IFORSW.EQ.'-3')NUMDIG=-3
34743      IF(IFORSW.EQ.'-4')NUMDIG=-4
34744      IF(IFORSW.EQ.'-5')NUMDIG=-5
34745      IF(IFORSW.EQ.'-6')NUMDIG=-6
34746      IF(IFORSW.EQ.'-7')NUMDIG=-7
34747      IF(IFORSW.EQ.'-8')NUMDIG=-8
34748      IF(IFORSW.EQ.'-9')NUMDIG=-9
34749C
34750      ITITLE='Exponential Power Parameter Estimation'
34751      NCTITL=38
34752      ITITLZ=' '
34753      NCTITZ=0
34754      ICNT=1
34755      ITEXT(ICNT)='Summary Statistics:'
34756      NCTEXT(ICNT)=19
34757      AVALUE(ICNT)=0.0
34758      IDIGIT(ICNT)=-1
34759      ICNT=ICNT+1
34760      ITEXT(ICNT)='Number of Observations:'
34761      NCTEXT(ICNT)=23
34762      AVALUE(ICNT)=REAL(N)
34763      IDIGIT(ICNT)=0
34764      ICNT=ICNT+1
34765      ITEXT(ICNT)='Sample Mean:'
34766      NCTEXT(ICNT)=12
34767      AVALUE(ICNT)=XMEAN
34768      IDIGIT(ICNT)=NUMDIG
34769      ICNT=ICNT+1
34770      ITEXT(ICNT)='Sample Standard Deviation:'
34771      NCTEXT(ICNT)=26
34772      AVALUE(ICNT)=XSD
34773      IDIGIT(ICNT)=NUMDIG
34774      ICNT=ICNT+1
34775      ITEXT(ICNT)='Sample Minimum:'
34776      NCTEXT(ICNT)=15
34777      AVALUE(ICNT)=XMIN
34778      IDIGIT(ICNT)=NUMDIG
34779      ICNT=ICNT+1
34780      ITEXT(ICNT)='Sample Maximum:'
34781      NCTEXT(ICNT)=15
34782      AVALUE(ICNT)=XMAX
34783      IDIGIT(ICNT)=NUMDIG
34784      ICNT=ICNT+1
34785      ITEXT(ICNT)=' '
34786      NCTEXT(ICNT)=0
34787      AVALUE(ICNT)=0.0
34788      IDIGIT(ICNT)=-1
34789C
34790      ICNT=ICNT+1
34791      ITEXT(ICNT)='Maximum Likelihood:'
34792      NCTEXT(ICNT)=19
34793      AVALUE(ICNT)=0.0
34794      IDIGIT(ICNT)=-1
34795      ICNT=ICNT+1
34796      ITEXT(ICNT)='Estimate of Shape (Beta):'
34797      NCTEXT(ICNT)=25
34798      AVALUE(ICNT)=BETAML
34799      IDIGIT(ICNT)=NUMDIG
34800      ICNT=ICNT+1
34801      ITEXT(ICNT)='Estimate of Scale:'
34802      NCTEXT(ICNT)=18
34803      AVALUE(ICNT)=SCALML
34804      IDIGIT(ICNT)=NUMDIG
34805      ICNT=ICNT+1
34806      ITEXT(ICNT)='Standard Deviation of Beta:'
34807      NCTEXT(ICNT)=27
34808      AVALUE(ICNT)=BETASE
34809      IDIGIT(ICNT)=NUMDIG
34810      ICNT=ICNT+1
34811      ITEXT(ICNT)='Standard Deviation of Scale:'
34812      NCTEXT(ICNT)=28
34813      AVALUE(ICNT)=SCALSE
34814      IDIGIT(ICNT)=NUMDIG
34815      ICNT=ICNT+1
34816      ITEXT(ICNT)='Beta/Scale Covariance:'
34817      NCTEXT(ICNT)=22
34818      AVALUE(ICNT)=COVSE
34819      IDIGIT(ICNT)=NUMDIG
34820C
34821CCCCC ICNT=ICNT+1
34822CCCCC ITEXT(ICNT)='Log-likelihood:'
34823CCCCC NCTEXT(ICNT)=15
34824CCCCC AVALUE(ICNT)=ALIKML
34825CCCCC IDIGIT(ICNT)=-7
34826CCCCC ICNT=ICNT+1
34827CCCCC ITEXT(ICNT)='AIC:'
34828CCCCC NCTEXT(ICNT)=4
34829CCCCC AVALUE(ICNT)=AICML
34830CCCCC IDIGIT(ICNT)=-7
34831CCCCC ICNT=ICNT+1
34832CCCCC ITEXT(ICNT)='AICc:'
34833CCCCC NCTEXT(ICNT)=5
34834CCCCC AVALUE(ICNT)=AICCML
34835CCCCC IDIGIT(ICNT)=-7
34836CCCCC ICNT=ICNT+1
34837CCCCC ITEXT(ICNT)='BIC:'
34838CCCCC NCTEXT(ICNT)=4
34839CCCCC AVALUE(ICNT)=BICML
34840CCCCC IDIGIT(ICNT)=-7
34841C
34842      NUMROW=ICNT
34843      DO2320I=1,NUMROW
34844        NTOT(I)=15
34845 2320 CONTINUE
34846C
34847      IFRST=.FALSE.
34848      ILAST=.FALSE.
34849      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
34850     1            AVALUE,IDIGIT,
34851     1            NTOT,NUMROW,
34852     1            ICAPSW,ICAPTY,ILAST,IFRST,
34853     1            ISUBRO,IBUGA3,IERROR)
34854C
34855      ILIKFL='OFF'
34856      CALL DPDTA8(ALOWSC,AUPPSC,ALOWS2,AUPPS2,
34857     1            ALOWBE,AUPPBE,ALOWB2,AUPPB2,ALPHA,NUMALP,
34858     1            ICAPSW,ICAPTY,NUMDIG,ILIKFL,
34859     1            ISUBRO,IBUGA3,IERROR)
34860C
34861C               *****************
34862C               **  STEP 90--  **
34863C               **  EXIT       **
34864C               *****************
34865C
34866 9000 CONTINUE
34867      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPX')THEN
34868        WRITE(ICOUT,999)
34869        CALL DPWRST('XXX','WRIT')
34870        WRITE(ICOUT,9011)
34871 9011   FORMAT('***** AT THE END       OF DPMLPX--')
34872        CALL DPWRST('XXX','WRIT')
34873        WRITE(ICOUT,9012)N,IBUGA3,IERROR
34874 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
34875        CALL DPWRST('XXX','WRIT')
34876        WRITE(ICOUT,9015)N
34877 9015   FORMAT('N = ',I8)
34878        CALL DPWRST('XXX','WRIT')
34879      ENDIF
34880C
34881      RETURN
34882      END
34883      SUBROUTINE DPMLP3(Y,N,
34884     1                  DTEMP1,XMOM,MAXNXT,
34885     1                  SHAPML,SCALML,ALOCML,
34886     1                  ICAPSW,ICAPTY,IFORSW,
34887     1                  ISUBRO,IBUGA3,IERROR)
34888C
34889C     PURPOSE--THIS ROUTINE COMPUTES THE L-MOMENT ESTIMATES
34890C              FOR THE PEARSON TYPE 3 DISTRIBUTION
34891C     EXAMPLE--PEARSON TYPE 3 MAXIMUM LIKELIHOOD Y
34892C     REFERENCE--FORTRAN CODE WRITTEN FOR INCLUSION IN IBM
34893C                RESEARCH REPORT RC20525, 'FORTRAN ROUTINES FOR
34894C                USE WITH THE METHOD OF L-MOMENTS, VERSION 3',
34895C                J. R. M. HOSKING, IBM RESEARCH DIVISION,
34896C                T. J. WATSON RESEARCH CENTER, YORKTOWN HEIGHTS
34897C                NEW YORK 10598, U.S.A., VERSION 3     AUGUST 1996
34898C     WRITTEN BY--JAMES J. FILLIBEN
34899C                 STATISTICAL ENGINEERING DIVISION
34900C                 INFORMATION TECHNOLOGY LABORATORY
34901C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
34902C                 GAITHERSBUG, MD 20899-8980
34903C                 PHONE--301-975-2855
34904C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
34905C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
34906C     LANGUAGE--ANSI FORTRAN (1977)
34907C     VERSION NUMBER--2008/6
34908C     ORIGINAL VERSION--JUNE      2008.
34909C     UPDATED         --JULY      2010. EXTRACT POINT ESTIMATES TO
34910C                                       PE3ML1
34911C     UPDATED         --JULY      2010. USE DPDTA1 TO PRINT OUTPUT
34912C
34913C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
34914C
34915      CHARACTER*4 ICAPSW
34916      CHARACTER*4 ICAPTY
34917      CHARACTER*4 IFORSW
34918      CHARACTER*4 ISUBRO
34919      CHARACTER*4 IBUGA3
34920      CHARACTER*4 IERROR
34921C
34922      CHARACTER*4 ISUBN1
34923      CHARACTER*4 ISUBN2
34924      CHARACTER*4 ISTEPN
34925C
34926C---------------------------------------------------------------------
34927C
34928      DIMENSION Y(*)
34929      DOUBLE PRECISION DTEMP1(*)
34930      DOUBLE PRECISION XMOM(*)
34931      DIMENSION QP(1)
34932C
34933CCCCC PARAMETER (NUMALP=6)
34934CCCCC DIMENSION ALPHA(NUMALP)
34935CCCCC DIMENSION ALOWLO(NUMALP)
34936CCCCC DIMENSION AUPPLO(NUMALP)
34937CCCCC DIMENSION ALOWSC(NUMALP)
34938CCCCC DIMENSION AUPPSC(NUMALP)
34939CCCCC DIMENSION ALOWSH(NUMALP)
34940CCCCC DIMENSION AUPPSH(NUMALP)
34941C
34942      PARAMETER (MAXROW=20)
34943      CHARACTER*60 ITITLE
34944      CHARACTER*60 ITITLZ
34945      CHARACTER*40 ITEXT(MAXROW)
34946      REAL         AVALUE(MAXROW)
34947      INTEGER      NCTEXT(MAXROW)
34948      INTEGER      IDIGIT(MAXROW)
34949      INTEGER      NTOT(MAXROW)
34950      LOGICAL IFRST
34951      LOGICAL ILAST
34952C
34953C---------------------------------------------------------------------
34954C
34955      INCLUDE 'DPCOP2.INC'
34956C
34957CCCCC DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
34958C
34959C-----START POINT-----------------------------------------------------
34960C
34961      ISUBN1='DPML'
34962      ISUBN2='P3  '
34963      IERROR='NO'
34964C
34965      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLP3')THEN
34966        WRITE(ICOUT,999)
34967  999   FORMAT(1X)
34968        CALL DPWRST('XXX','WRIT')
34969        WRITE(ICOUT,51)
34970   51   FORMAT('**** AT THE BEGINNING OF DPMLP3--')
34971        CALL DPWRST('XXX','WRIT')
34972        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,MAXNXT
34973   52   FORMAT('IBUGA3,ISUBRO,N,MAXNXT = ',2(A4,2X),2I8)
34974        CALL DPWRST('XXX','WRIT')
34975        DO56I=1,MIN(N,100)
34976          WRITE(ICOUT,57)I,Y(I)
34977   57     FORMAT('I,Y(I) = ',I8,G15.7)
34978          CALL DPWRST('XXX','WRIT')
34979   56   CONTINUE
34980      ENDIF
34981C
34982C               ***************************************************
34983C               **  STEP 21--                                    **
34984C               **  CARRY OUT CALCULATIONS                       **
34985C               **  FOR PEARSON TYPE 3 L-MOMENT ESTIMATION       **
34986C               ***************************************************
34987C
34988      ISTEPN='21'
34989      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLP3')
34990     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
34991C
34992      NPERC=0
34993      NMIN=3
34994      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
34995      IF(IERROR.EQ.'YES')GOTO9000
34996C
34997      CALL PE3ML1(Y,N,
34998     1            DTEMP1,XMOM,NMOM,
34999     1            XMEAN,XSD,XVAR,XMIN,XMAX,
35000     1            ALOCML,SCALML,SHAPML,
35001     1            ISUBRO,IBUGA3,IERROR)
35002      IF(IERROR.EQ.'YES')GOTO9000
35003C
35004C               ***********************************************
35005C               **   STEP 42--                               **
35006C               **   WRITE OUT EVERYTHING                    **
35007C               **   FOR PEARSON TYPE 3 MLE ESTIMATION       **
35008C               ***********************************************
35009C
35010      ISTEPN='42'
35011      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLP3')
35012     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
35013C
35014      IF(IPRINT.EQ.'OFF')GOTO9000
35015C
35016      NUMDIG=7
35017      IF(IFORSW.EQ.'1')NUMDIG=1
35018      IF(IFORSW.EQ.'2')NUMDIG=2
35019      IF(IFORSW.EQ.'3')NUMDIG=3
35020      IF(IFORSW.EQ.'4')NUMDIG=4
35021      IF(IFORSW.EQ.'5')NUMDIG=5
35022      IF(IFORSW.EQ.'6')NUMDIG=6
35023      IF(IFORSW.EQ.'7')NUMDIG=7
35024      IF(IFORSW.EQ.'8')NUMDIG=8
35025      IF(IFORSW.EQ.'9')NUMDIG=9
35026      IF(IFORSW.EQ.'0')NUMDIG=0
35027      IF(IFORSW.EQ.'E')NUMDIG=-2
35028      IF(IFORSW.EQ.'-2')NUMDIG=-2
35029      IF(IFORSW.EQ.'-3')NUMDIG=-3
35030      IF(IFORSW.EQ.'-4')NUMDIG=-4
35031      IF(IFORSW.EQ.'-5')NUMDIG=-5
35032      IF(IFORSW.EQ.'-6')NUMDIG=-6
35033      IF(IFORSW.EQ.'-7')NUMDIG=-7
35034      IF(IFORSW.EQ.'-8')NUMDIG=-8
35035      IF(IFORSW.EQ.'-9')NUMDIG=-9
35036C
35037      ITITLE='Three-Parameter Pearson Type 3 Parameter Estimation:'
35038      NCTITL=52
35039      ITITLZ='Full Sample Case'
35040      NCTITZ=16
35041      ICNT=1
35042      ITEXT(ICNT)='Summary Statistics:'
35043      NCTEXT(ICNT)=19
35044      AVALUE(ICNT)=0.0
35045      IDIGIT(ICNT)=-1
35046      ICNT=ICNT+1
35047      ITEXT(ICNT)='Number of Observations:'
35048      NCTEXT(ICNT)=23
35049      AVALUE(ICNT)=REAL(N)
35050      IDIGIT(ICNT)=0
35051      ICNT=ICNT+1
35052      ITEXT(ICNT)='Sample Mean:'
35053      NCTEXT(ICNT)=12
35054      AVALUE(ICNT)=XMEAN
35055      IDIGIT(ICNT)=NUMDIG
35056      ICNT=ICNT+1
35057      ITEXT(ICNT)='Sample Standard Deviation:'
35058      NCTEXT(ICNT)=26
35059      AVALUE(ICNT)=XSD
35060      IDIGIT(ICNT)=NUMDIG
35061      ICNT=ICNT+1
35062      ITEXT(ICNT)='Sample Minimum:'
35063      NCTEXT(ICNT)=15
35064      AVALUE(ICNT)=XMIN
35065      IDIGIT(ICNT)=NUMDIG
35066      ICNT=ICNT+1
35067      ITEXT(ICNT)='Sample Maximum:'
35068      NCTEXT(ICNT)=15
35069      AVALUE(ICNT)=XMAX
35070      IDIGIT(ICNT)=NUMDIG
35071      ICNT=ICNT+1
35072      ITEXT(ICNT)=' '
35073      NCTEXT(ICNT)=0
35074      AVALUE(ICNT)=0.0
35075      IDIGIT(ICNT)=-1
35076C
35077      ICNT=ICNT+1
35078      ITEXT(ICNT)='First Sample L-Moment:'
35079      NCTEXT(ICNT)=22
35080      AVALUE(ICNT)=REAL(XMOM(1))
35081      IDIGIT(ICNT)=NUMDIG
35082      ICNT=ICNT+1
35083      ITEXT(ICNT)='Second Sample L-Moment:'
35084      NCTEXT(ICNT)=23
35085      AVALUE(ICNT)=REAL(XMOM(2))
35086      IDIGIT(ICNT)=NUMDIG
35087      ICNT=ICNT+1
35088      ITEXT(ICNT)='Third Sample L-Moment:'
35089      NCTEXT(ICNT)=22
35090      AVALUE(ICNT)=REAL(XMOM(3))
35091      IDIGIT(ICNT)=NUMDIG
35092      ICNT=ICNT+1
35093      ITEXT(ICNT)=' '
35094      NCTEXT(ICNT)=0
35095      AVALUE(ICNT)=0.0
35096      IDIGIT(ICNT)=-1
35097C
35098      ICNT=ICNT+1
35099      ITEXT(ICNT)='Method of L-Moments:'
35100      NCTEXT(ICNT)=20
35101      AVALUE(ICNT)=0.0
35102      IDIGIT(ICNT)=-1
35103      ICNT=ICNT+1
35104      ITEXT(ICNT)='Estimate of Location:'
35105      NCTEXT(ICNT)=22
35106      AVALUE(ICNT)=ALOCML
35107      IDIGIT(ICNT)=NUMDIG
35108      ICNT=ICNT+1
35109      ITEXT(ICNT)='Estimate of Scale:'
35110      NCTEXT(ICNT)=18
35111      AVALUE(ICNT)=SCALML
35112      IDIGIT(ICNT)=NUMDIG
35113      ICNT=ICNT+1
35114      ITEXT(ICNT)='Estimate of Shape (Gamma):'
35115      NCTEXT(ICNT)=26
35116      AVALUE(ICNT)=SHAPML
35117      IDIGIT(ICNT)=NUMDIG
35118      ICNT=ICNT+1
35119      ITEXT(ICNT)=' '
35120      NCTEXT(ICNT)=0
35121      AVALUE(ICNT)=0.0
35122      IDIGIT(ICNT)=-1
35123C
35124CCCCC ICNT=ICNT+1
35125CCCCC ITEXT(ICNT)='Log-likelihood:'
35126CCCCC NCTEXT(ICNT)=15
35127CCCCC AVALUE(ICNT)=ALIK
35128CCCCC IDIGIT(ICNT)=-7
35129CCCCC ICNT=ICNT+1
35130CCCCC ITEXT(ICNT)='AIC:'
35131CCCCC NCTEXT(ICNT)=4
35132CCCCC AVALUE(ICNT)=AIC
35133CCCCC IDIGIT(ICNT)=-7
35134CCCCC ICNT=ICNT+1
35135CCCCC ITEXT(ICNT)='AICc:'
35136CCCCC NCTEXT(ICNT)=5
35137CCCCC AVALUE(ICNT)=AICC
35138CCCCC IDIGIT(ICNT)=-7
35139CCCCC ICNT=ICNT+1
35140CCCCC ITEXT(ICNT)='BIC:'
35141CCCCC NCTEXT(ICNT)=4
35142CCCCC AVALUE(ICNT)=BIC
35143CCCCC IDIGIT(ICNT)=-7
35144C
35145      NUMROW=ICNT
35146      DO2320I=1,NUMROW
35147        NTOT(I)=15
35148 2320 CONTINUE
35149C
35150      IFRST=.TRUE.
35151      ILAST=.TRUE.
35152      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
35153     1            AVALUE,IDIGIT,
35154     1            NTOT,NUMROW,
35155     1            ICAPSW,ICAPTY,ILAST,IFRST,
35156     1            ISUBRO,IBUGA3,IERROR)
35157C
35158C               *****************
35159C               **  STEP 90--  **
35160C               **  EXIT       **
35161C               *****************
35162C
35163 9000 CONTINUE
35164      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLP3')THEN
35165        WRITE(ICOUT,999)
35166        CALL DPWRST('XXX','WRIT')
35167        WRITE(ICOUT,9011)
35168 9011   FORMAT('***** AT THE END       OF DPMLP3--')
35169        CALL DPWRST('XXX','WRIT')
35170        WRITE(ICOUT,9012)N,IBUGA3,IERROR
35171 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
35172        CALL DPWRST('XXX','WRIT')
35173        WRITE(ICOUT,9015)N
35174 9015   FORMAT('N = ',I8)
35175        CALL DPWRST('XXX','WRIT')
35176      ENDIF
35177C
35178      RETURN
35179      END
35180      SUBROUTINE DPMLQB(Y,X,N,NVAR,
35181     1                  TEMP1,TEMP2,TEMP3,DTEMP1,
35182     1                  XTEMP,ITEMP1,
35183     1                  PSTART,PHISTR,
35184     1                  PML,PHIML,AM,PVAR,PHIVAR,PPHCOV,
35185     1                  ICAPSW,ICAPTY,IFORSW,MAXNXT,
35186     1                  ISUBRO,IBUGA3,IERROR)
35187C
35188C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
35189C              ESTIMATES FOR THE QUASI BINOMIAL TYPE I
35190C              DISTRIBUTION.
35191C
35192C              THE MAXIMUM LIKELIHOOD ESTIMATES ARE THE SOLUTIONS
35193C              TO THE EQUATIONS:
35194C
35195C                 SUM[i=1 to N][(m-X(i))/(1 - P - X9i)*PHI] - M*N = 0
35196C
35197C                 SUM[i=1 to N][(X(i)*(X(i) - 1)/(p + X(i)*PHI) -
35198C                 SUM[i=1 to N][(M - X(i))/(1 - P - X(i)*PHI)] = 0
35199C
35200C              NOTE THAT M IS ASSUMED FIXED AND KNOWN AND WE ARE
35201C              SOLVING FOR P AND PHI.
35202C
35203C              WHEN THE DATA IS BINNED, THE MAXIMUM LIKELIHOOD
35204C              EQUATIONS BECOME
35205C
35206C                  SUM[i=1 to k][N(i)*(i-1)*i/(p+i*PHI)] -
35207C                  SUM[i=1 to k][N(i)*(M-i)*i/(1-p-i*PHI)] = 0
35208C
35209C                  (N/P) - SUM[i=1 to k][N(i)*(i-1)/(p+i*PHI)] -
35210C                  SUM[i=1 to k][N(i)*(i-1)/(P+i*PHI) -
35211C                  SUM[i=1 to k][N(i)*(M-i)/(1-P-i*PHI)] = 0
35212C
35213C              THERE ARE TWO CASES:
35214C
35215C              1) ONE VARIABLE CASE: Y IS RAW DATA
35216C              2) TWO VARIABLE CASE: Y IS FREQUENCY, X IS CLASS
35217C                 MID-POINT.
35218C
35219C     EXAMPLE--QUASI BINOMIAL TYPE I MAXIMUM LIKELIHOOD Y
35220C            --QUASI BINOMIAL TYPE I MAXIMUM LIKELIHOOD Y X
35221C     REFERENCES--CONSUL AND FAMOYE (2006), "LAGRANGIAN PROBABILITY
35222C                 DISTRIBUTIONS", BIRKHAUSER, PP. 70-80.
35223C     WRITTEN BY--ALAN HECKERT
35224C                 STATISTICAL ENGINEERING DIVISION
35225C                 INFORMATION TECHNOLOGY LABORATORY
35226C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
35227C                 GAITHERSBUG, MD 20899-8980
35228C                 PHONE--301-975-2899
35229C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
35230C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
35231C     LANGUAGE--ANSI FORTRAN (1977)
35232C     VERSION NUMBER--2006/7
35233C     ORIGINAL VERSION--JULY      2006.
35234C     UPDATED         --APRIL     2011. USED DPDTA1 TO PRINT OUTPUT
35235C
35236C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-----------------
35237C
35238      CHARACTER*4 ICAPSW
35239      CHARACTER*4 ICAPTY
35240      CHARACTER*4 IFORSW
35241      CHARACTER*4 ISUBRO
35242      CHARACTER*4 IBUGA3
35243      CHARACTER*4 IERROR
35244C
35245      CHARACTER*4 IWRITE
35246      CHARACTER*4 ISUBN1
35247      CHARACTER*4 ISUBN2
35248      CHARACTER*4 ISTEPN
35249      CHARACTER*4 IRELAT
35250      CHARACTER*4 IRHSTG
35251C
35252      PARAMETER (MAXROW=30)
35253      CHARACTER*60 ITITLE
35254      CHARACTER*1  ITITLZ
35255      CHARACTER*40 IDIST
35256      CHARACTER*40 ITEXT(MAXROW)
35257      REAL         AVALUE(MAXROW)
35258      INTEGER      NCTEXT(MAXROW)
35259      INTEGER      IDIGIT(MAXROW)
35260      INTEGER      NTOT(MAXROW)
35261      LOGICAL      IFRST
35262      LOGICAL      ILAST
35263C
35264C-------------------------------------------------------------------
35265C
35266      DIMENSION Y(*)
35267      DIMENSION X(*)
35268      DIMENSION TEMP1(*)
35269      DIMENSION TEMP2(*)
35270      DIMENSION TEMP3(*)
35271      DIMENSION XTEMP(*)
35272      DIMENSION ITEMP1(*)
35273      DOUBLE PRECISION DTEMP1(*)
35274C
35275      DOUBLE PRECISION TOL
35276      DOUBLE PRECISION XPAR(3)
35277      DOUBLE PRECISION FVEC(2)
35278C
35279CCCCC DOUBLE PRECISION AE
35280CCCCC DOUBLE PRECISION RE
35281CCCCC DOUBLE PRECISION XLOW
35282CCCCC DOUBLE PRECISION XUP
35283CCCCC DOUBLE PRECISION XMID
35284CCCCC DOUBLE PRECISION DSUM
35285CCCCC DOUBLE PRECISION DTERM1
35286CCCCC DOUBLE PRECISION DTERM2
35287CCCCC DOUBLE PRECISION DA
35288C
35289      DIMENSION FISH(2,2)
35290      DIMENSION COV(2,2)
35291C
35292      DOUBLE PRECISION QBIFUN
35293      EXTERNAL QBIFUN
35294      DOUBLE PRECISION DM
35295      DOUBLE PRECISION F0FREQ
35296      COMMON/QBICOM/DM,F0FREQ,MAXRO2,NTOT2
35297C
35298C-------------------------------------------------------------------
35299C
35300      INCLUDE 'DPCOP2.INC'
35301C
35302C-----START POINT---------------------------------------------------
35303C
35304      ISUBN1='DPML'
35305      ISUBN2='QB  '
35306      IERROR='NO'
35307      IWRITE='OFF'
35308C
35309      PML=CPUMIN
35310      PHIML=CPUMIN
35311      PVAR=CPUMIN
35312      PHIVAR=CPUMIN
35313      PPHCOV=CPUMIN
35314C
35315      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLQB')THEN
35316        WRITE(ICOUT,999)
35317  999   FORMAT(1X)
35318        CALL DPWRST('XXX','WRIT')
35319        WRITE(ICOUT,51)
35320   51   FORMAT('**** AT THE BEGINNING OF DPMLQB--')
35321        CALL DPWRST('XXX','WRIT')
35322        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR
35323   52   FORMAT('IBUGA3,ISUBRO,N,NVAR = ',2(A4,2X),2I8)
35324        CALL DPWRST('XXX','WRIT')
35325        IF(NVAR.EQ.1)THEN
35326          DO56I=1,MIN(N,100)
35327            WRITE(ICOUT,57)I,Y(I)
35328   57       FORMAT('I,Y(I) = ',I8,G15.7)
35329            CALL DPWRST('XXX','WRIT')
35330   56     CONTINUE
35331        ELSE
35332          DO61I=1,N
35333            WRITE(ICOUT,62)I,X(I),Y(I)
35334   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
35335            CALL DPWRST('XXX','WRIT')
35336   61     CONTINUE
35337        ENDIF
35338      ENDIF
35339C
35340C               ********************************************
35341C               **  STEP 11--                             **
35342C               **  1) ROUND DATA TO INTEGER VALUES       **
35343C               **  2) COMPUTE SUMMARY STATISTICS         **
35344C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
35345C               **     INSUFFICIENT SAMPLE SIZE           **
35346C               ********************************************
35347C
35348      ISTEPN='11'
35349      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLQB')
35350     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
35351C
35352      IDIST='QUASI BINOMIAL TYPE I'
35353C
35354      NPERC=0
35355      MAXGRP=MAXNXT/2
35356      NMIN=2
35357      IF(NVAR.EQ.1)THEN
35358        DO1105I=1,N
35359          ITEMP=INT(Y(I)+0.5)
35360          Y(I)=REAL(ITEMP)
35361 1105   CONTINUE
35362        CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
35363        IF(IERROR.EQ.'YES')GOTO9000
35364C
35365        IFLAG=1
35366        CALL SUMRAW(Y,N,IDIST,IFLAG,
35367     1              XMEAN,XVAR,XSD,XMIN,XMAX,
35368     1              ISUBRO,IBUGA3,IERROR)
35369        IF(IERROR.EQ.'YES')GOTO9000
35370        NTOTZZ=N
35371C
35372C       NOW BIN THE DATA FOR USE BY THE ESTIMATION METHOD BELOW
35373C
35374        IRELAT='OFF'
35375        IRHSTG='OFF'
35376        XSTART=XMIN-0.5
35377        XSTOP=XMAX+0.5
35378        CLWID=1.0
35379        CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
35380     1              TEMP1,X,N2,IBUGA3,IERROR)
35381        ICNT=0
35382        DO1121I=1,N2
35383          IF(TEMP1(I).GT.0.0)THEN
35384            ICNT=ICNT+1
35385            Y(ICNT)=TEMP1(I)
35386            X(ICNT)=X(I)
35387          ENDIF
353881121    CONTINUE
35389        N2=ICNT
35390      ELSE
35391        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
35392     1              ISUBRO,IBUGA3,IERROR)
35393        IF(IERROR.EQ.'YES')GOTO9000
35394        IFLAG1=1
35395        IFLAG2=1
35396        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
35397     1              TEMP1,TEMP2,TEMP3,MAXNXT,
35398     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
35399     1              ISUBRO,IBUGA3,IERROR)
35400        ICNT=0
35401        DO1211I=1,N
35402          IF(Y(I).GT.0.0)THEN
35403            ICNT=ICNT+1
35404            Y(ICNT)=Y(I)
35405            X(ICNT)=X(I)
35406          ENDIF
354071211    CONTINUE
35408        N2=ICNT
35409      ENDIF
35410      IF(IERROR.EQ.'YES')GOTO9000
35411C
35412      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLQB')THEN
35413        WRITE(ICOUT,999)
35414        CALL DPWRST('XXX','WRIT')
35415        WRITE(ICOUT,1311)
35416 1311   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
35417        CALL DPWRST('XXX','WRIT')
35418        WRITE(ICOUT,1312)XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ
35419 1312   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ = ',5G15.7,I10)
35420        CALL DPWRST('XXX','WRIT')
35421      ENDIF
35422C
35423C               *********************************************
35424C               **  STEP 21--                              **
35425C               **  CARRY OUT CALCULATIONS                 **
35426C               **  FOR QUASI BINOMIAL TYPE I MLE          **
35427C               **  ESTIMATION                             **
35428C               *********************************************
35429C
35430      ISTEPN='21'
35431      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLQB')
35432     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
35433C
35434      F0=Y(1)/REAL(NTOTZZ)
35435      F1=Y(2)/REAL(NTOTZZ)
35436      F2=Y(3)/REAL(NTOTZZ)
35437      IINDX=MAXNXT/2
35438      IF(N2.LE.IINDX)THEN
35439        IML=0
35440        DO2210I=1,N2
35441          NTOT=NTOT+INT(Y(I)+0.1)
35442          TEMP3(I)=Y(I)
35443          TEMP3(IINDX+I)=X(I)
35444 2210   CONTINUE
35445        IK=N
35446      ELSE
35447        IML=1
35448      ENDIF
35449C
35450      IF(AM.LT.XMAX)THEN
35451        WRITE(ICOUT,999)
35452        CALL DPWRST('XXX','WRIT')
35453        WRITE(ICOUT,1131)
35454 1131   FORMAT('******ERROR IN QUASI BINOMIAL TYPE I ',
35455     1         'MAXIMUM LIKELIHOOD ESTIMATION--')
35456        CALL DPWRST('XXX','WRIT')
35457        WRITE(ICOUT,1401)
35458 1401   FORMAT('      USER-SPECIFIED VALUE OF THE M PARAMETER')
35459        CALL DPWRST('XXX','WRIT')
35460        WRITE(ICOUT,1403)
35461 1403   FORMAT('      IS LESS THAN THE DATA MAXIMUM.')
35462        CALL DPWRST('XXX','WRIT')
35463        WRITE(ICOUT,1405)AM
35464 1405   FORMAT('      VALUE OF M =        ',G15.7)
35465        CALL DPWRST('XXX','WRIT')
35466        WRITE(ICOUT,1407)XMAX
35467 1407   FORMAT('      DATA MAXIMUM =      ',G15.7)
35468        CALL DPWRST('XXX','WRIT')
35469        IERROR='YES'
35470        GOTO9000
35471      ENDIF
35472C
35473      IM=INT(AM+0.5)
35474      IF(IM.EQ.1)THEN
35475        PML=1.0 - F0
35476        PHIML=0.0
35477      ELSEIF(IM.EQ.2)THEN
35478        PML=1.0 - SQRT(F0)
35479        AN=REAL(NTOTZZ)
35480        AN0=AN*F0
35481        AN1=AN*F1
35482        AN2=AN*F2
35483        PHIML=((AN2 + 0.5*AN1)*SQRT(F0) - AN1/2.0)/(AN1+AN2)
35484      ELSE
35485        DM=DBLE(AM)
35486        F0FREQ=DBLE(F0)
35487        NTOT2=NTOTZZ
35488        IOPT=2
35489        TOL=1.0D-5
35490        NPAR=2
35491        NPRINT=-1
35492        INFO=0
35493        LWA=MAXNXT
35494        MAXRO2=MAXNXT
35495C
35496        ALOWLM=-0.999/AM
35497        AUPPLM=(1.0 - 0.001)/AM
35498        IF((PSTART.GT.0.0 .AND. PSTART.LT.1.0) .AND.
35499     1     (PHISTR.GT.ALOWLM .AND. PHISTR.LT.AUPPLM))THEN
35500          XPAR(1)=PSTART
35501          XPAR(2)=PHISTR
35502        ELSE
35503          XPAR(1)=1.0D0 - (F0FREQ)**(1.0D0/DM)
35504          XPAR(2)=(1.0D0/(2.0D0*(DM-2.0D0)))*(-1.0D0 +
35505     1            DSQRT(1.0D0+4.0D0*(DM-2.0D0)*
35506     1            (-1.0D0+DBLE(XMEAN)/(DM*XPAR(1)))/
35507     1            (DM-1.0D0)))
35508        ENDIF
35509        CALL DNSQE(QBIFUN,JAC,IOPT,NPAR,XPAR,FVEC,TOL,NPRINT,INFO,
35510     1             DTEMP1,LWA,TEMP3,IK)
35511C
35512        PML=REAL(XPAR(1))
35513        PHIML=REAL(XPAR(2))
35514      ENDIF
35515C
35516      AN=REAL(NTOTZZ)
35517C
35518      ANUM=AN*AM*(AM-1.0)*PML*(2.0 + (AM - 3.0)*PML)
35519      ADEN=(PML + 2.0*PHIML)*(1.0 - PML - AM*PHIML + PHIML)
35520      FISH(1,1)=ANUM/ADEN
35521C
35522      ANUM=AN*AM*(AM-1.0)*PML*(1.0 - (AM - 1.0)*PHIML)
35523      FISH(1,2)=ANUM/ADEN
35524      FISH(2,1)=FISH(1,2)
35525C
35526      ANUM=AN*AM*(PML-(AM-3.0)*PHIML+(AM-1.0)*(AM-3.0)*PHIML**2)
35527      FISH(2,2)=-(AN*AM/PML) - ANUM/ADEN
35528C
35529      NDIM=2
35530      CALL SGECO(FISH,NDIM,NDIM,ITEMP1,RCOND,XTEMP)
35531      IJOB=1
35532      CALL SGEDI(FISH,NDIM,NDIM,ITEMP1,XTEMP,XTEMP(MAXNXT/2),IJOB)
35533      DO2810J=1,NDIM
35534        DO2815I=1,NDIM
35535          COV(I,J)=FISH(I,J)
35536 2815   CONTINUE
35537 2810 CONTINUE
35538C
35539      PVAR=COV(1,1)
35540      PHIVAR=COV(2,2)
35541      PPHCOV=COV(2,1)
35542C
35543C               ***********************************************
35544C               **   STEP 42--                               **
35545C               **   WRITE OUT EVERYTHING                    **
35546C               **   FOR QUASI BINOMIAL TYPE I MLE           **
35547C               **   ESTIMATION                              **
35548C               ***********************************************
35549C
35550      ISTEPN='42'
35551      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLQB')
35552     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
35553C
35554C     PRINT SUMMARY STATISTICS TABLE
35555C
35556      NUMDIG=7
35557      IF(IFORSW.EQ.'1')NUMDIG=1
35558      IF(IFORSW.EQ.'2')NUMDIG=2
35559      IF(IFORSW.EQ.'3')NUMDIG=3
35560      IF(IFORSW.EQ.'4')NUMDIG=4
35561      IF(IFORSW.EQ.'5')NUMDIG=5
35562      IF(IFORSW.EQ.'6')NUMDIG=6
35563      IF(IFORSW.EQ.'7')NUMDIG=7
35564      IF(IFORSW.EQ.'8')NUMDIG=8
35565      IF(IFORSW.EQ.'9')NUMDIG=9
35566      IF(IFORSW.EQ.'0')NUMDIG=0
35567      IF(IFORSW.EQ.'E')NUMDIG=-2
35568      IF(IFORSW.EQ.'-2')NUMDIG=-2
35569      IF(IFORSW.EQ.'-3')NUMDIG=-3
35570      IF(IFORSW.EQ.'-4')NUMDIG=-4
35571      IF(IFORSW.EQ.'-5')NUMDIG=-5
35572      IF(IFORSW.EQ.'-6')NUMDIG=-6
35573      IF(IFORSW.EQ.'-7')NUMDIG=-7
35574      IF(IFORSW.EQ.'-8')NUMDIG=-8
35575      IF(IFORSW.EQ.'-9')NUMDIG=-9
35576C
35577      ITITLE='Quasi Binomial TYpe I Parameter Estimation'
35578      NCTITL=42
35579      ITITLZ=' '
35580      NCTITZ=0
35581C
35582      ICNT=1
35583      ITEXT(ICNT)='Summary Statistics:'
35584      NCTEXT(ICNT)=19
35585      AVALUE(ICNT)=0.0
35586      IDIGIT(ICNT)=-1
35587      ICNT=ICNT+1
35588      ITEXT(ICNT)='Number of Observations:'
35589      NCTEXT(ICNT)=23
35590      AVALUE(ICNT)=REAL(NTOTZZ)
35591      IDIGIT(ICNT)=0
35592      ICNT=ICNT+1
35593      ITEXT(ICNT)='Sample Mean:'
35594      NCTEXT(ICNT)=12
35595      AVALUE(ICNT)=XMEAN
35596      IDIGIT(ICNT)=NUMDIG
35597      ICNT=ICNT+1
35598      ITEXT(ICNT)='Sample Standard Deviation:'
35599      NCTEXT(ICNT)=26
35600      AVALUE(ICNT)=XSD
35601      IDIGIT(ICNT)=NUMDIG
35602      ICNT=ICNT+1
35603      ITEXT(ICNT)='Sample Minimum:'
35604      NCTEXT(ICNT)=15
35605      AVALUE(ICNT)=XMIN
35606      IDIGIT(ICNT)=NUMDIG
35607      ICNT=ICNT+1
35608      ITEXT(ICNT)='Sample Maximum:'
35609      NCTEXT(ICNT)=15
35610      AVALUE(ICNT)=XMAX
35611      IDIGIT(ICNT)=NUMDIG
35612      ICNT=ICNT+1
35613      ITEXT(ICNT)='Sample Zero-Class Frequency:'
35614      NCTEXT(ICNT)=28
35615      AVALUE(ICNT)=F0
35616      IDIGIT(ICNT)=NUMDIG
35617      ICNT=ICNT+1
35618      ITEXT(ICNT)=' '
35619      NCTEXT(ICNT)=0
35620      AVALUE(ICNT)=0.0
35621      IDIGIT(ICNT)=-1
35622C
35623      ICNT=ICNT+1
35624      ITEXT(ICNT)='Method of Maximum Likelihood:'
35625      NCTEXT(ICNT)=29
35626      AVALUE(ICNT)=0.0
35627      IDIGIT(ICNT)=-1
35628      ICNT=ICNT+1
35629      ITEXT(ICNT)='User-Specified Value for M:'
35630      NCTEXT(ICNT)=27
35631      AVALUE(ICNT)=AM
35632      IDIGIT(ICNT)=NUMDIG
35633      ICNT=ICNT+1
35634      ITEXT(ICNT)='Estimate of P:'
35635      NCTEXT(ICNT)=14
35636      AVALUE(ICNT)=PML
35637      IDIGIT(ICNT)=NUMDIG
35638      ICNT=ICNT+1
35639      ITEXT(ICNT)='Estimate of Phi:'
35640      NCTEXT(ICNT)=16
35641      AVALUE(ICNT)=PHIML
35642      IDIGIT(ICNT)=NUMDIG
35643      ICNT=ICNT+1
35644      ITEXT(ICNT)='Standard Error of P:'
35645      NCTEXT(ICNT)=20
35646      AVALUE(ICNT)=COV(1,1)
35647      IDIGIT(ICNT)=NUMDIG
35648      ICNT=ICNT+1
35649      ITEXT(ICNT)='Standard Error of Phi:'
35650      NCTEXT(ICNT)=22
35651      AVALUE(ICNT)=COV(2,2)
35652      IDIGIT(ICNT)=NUMDIG
35653      ICNT=ICNT+1
35654      ITEXT(ICNT)='Covariance Between P and Phi:'
35655      NCTEXT(ICNT)=29
35656      AVALUE(ICNT)=COV(2,1)
35657      IDIGIT(ICNT)=NUMDIG
35658      ICNT=ICNT+1
35659      ITEXT(ICNT)=' '
35660      NCTEXT(ICNT)=0
35661      AVALUE(ICNT)=0.0
35662      IDIGIT(ICNT)=-1
35663C
35664      NUMROW=ICNT
35665      DO2310I=1,NUMROW
35666        NTOT(I)=15
35667 2310 CONTINUE
35668C
35669      IFRST=.TRUE.
35670      ILAST=.TRUE.
35671      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
35672     1            AVALUE,IDIGIT,
35673     1            NTOT,NUMROW,
35674     1            ICAPSW,ICAPTY,ILAST,IFRST,
35675     1            ISUBRO,IBUGA3,IERROR)
35676C
35677C               *****************
35678C               **  STEP 90--  **
35679C               **  EXIT       **
35680C               *****************
35681C
35682 9000 CONTINUE
35683      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLQB')THEN
35684        WRITE(ICOUT,999)
35685        CALL DPWRST('XXX','WRIT')
35686        WRITE(ICOUT,9011)
35687 9011   FORMAT('***** AT THE END       OF DPMLQB--')
35688        CALL DPWRST('XXX','WRIT')
35689        WRITE(ICOUT,9012)IERROR
35690 9012   FORMAT('IERROR = ',A4)
35691        CALL DPWRST('XXX','WRIT')
35692      ENDIF
35693C
35694      RETURN
35695      END
35696      SUBROUTINE DPMLRA(Y,N,ICASPL,
35697     1                  DTEMP1,MAXNXT,
35698     1                  ALOCML,SCALML,SCALSE,SCALMM,
35699     1                  ICAPSW,ICAPTY,IFORSW,
35700     1                  QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,NPERC,
35701     1                  IOUNI1,IOUNI2,ALPHAP,
35702     1                  ISUBRO,IBUGA3,IERROR)
35703C
35704C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
35705C              ESTIMATES FOR THE RAYLEIGH DISTRIBUTION.
35706C              NOTE THAT EITHER THE 1-PARAMETER CASE OR THE
35707C              2-PARAMETER CASE CAN BE REQUESTED.
35708C     EXAMPLE--RAYLEIGH MAXIMUM LIKELIHOOD Y
35709C              1-PARAMETER RAYLEIGH MAXIMUM LIKELIHOOD Y
35710C     REFERENCE--COHEN AND WHITTEN (1988), "PARAMETER ESTIMATION IN
35711C                RELIABILITY AND LIFE SPAN MODELS", MARCEL DEKKER, INC.,
35712C                CHAPTER 10.
35713C              --KARL BURY, "STATISTICAL DISTRIBUTIONS IN
35714C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
35715C                1999, PP. 331-332.
35716C              --"CONTINUOUS UNIVARIATE DISTRIBUTIONS--VOLUME 1",
35717C                SECOND EDITION, JOHNSON, KOTZ, AND BALAKRISHNAN,
35718C                WILEY, 1994, P. 453.
35719C              --DEY, DEY, AND KUNDU (xxxx), "TWO-PARAMETER RAYLEIGH
35720C                DISTRIBUTION: DIFFERENT METHODS OF ESTIMATION",
35721C                SUBMITTED.
35722C              --MAHDI (2006), "IMPROVED PARAMETER ESTIMATION IN
35723C                RAYLEIGH MODEL", METODOLOSKIZVEZKI, VOL. 3,
35724C                NO. 1, PP. 63-74.
35725C     WRITTEN BY--ALAN HECKERT
35726C                 STATISTICAL ENGINEERING DIVISION
35727C                 INFORMATION TECHNOLOGY LABORATORY
35728C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
35729C                 GAITHERSBURG, MD 20899-8980
35730C                 PHONE--301-975-2899
35731C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
35732C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
35733C     LANGUAGE--ANSI FORTRAN (1977)
35734C     VERSION NUMBER--2004/6
35735C     ORIGINAL VERSION--JUNE      2004.
35736C     UPDATED         --AUGUST    2005. MODIFY FORMAT OF OUTPUT
35737C     UPDATED         --JULY      2010. EXTRACT ESTIMATION TO
35738C                                       SEPARATE SUBROUTINE
35739C     UPDATED         --JULY      2010. CALL DPDTA1 TO PRINT OUTPUT
35740C                                       (THIS ALSO ADDS RTF FORMAT
35741C                                       OUTPUT)
35742C     UPDATED         --JULY      2010. ADD LIKELIHOOD/AIC TO OUTPUT
35743C     UPDATED         --JULY      2010. DISTINGUISH BETWEEN 1-PARAMETER
35744C                                       2-PARAMETER CASES
35745C     UPDATED         --MAY       2014. CONFIDENCE INTERVAL FOR
35746C                                       1-PARAMETER MODEL.
35747C     UPDATED         --MAY       2014. ADDITIONAL ESTIMATORS FOR
35748C                                       2-PARAMETER MODEL
35749C
35750C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
35751C
35752      CHARACTER*4 ICASPL
35753      CHARACTER*4 ICAPSW
35754      CHARACTER*4 ICAPTY
35755      CHARACTER*4 IFORSW
35756      CHARACTER*4 ISUBRO
35757      CHARACTER*4 IBUGA3
35758      CHARACTER*4 IERROR
35759C
35760      CHARACTER*4 IWRITE
35761      CHARACTER*4 ISUBN1
35762      CHARACTER*4 ISUBN2
35763      CHARACTER*4 ISTEPN
35764      CHARACTER*4 ICASE
35765      CHARACTER*4 INORM
35766      CHARACTER*4 ILIKFL
35767C
35768C---------------------------------------------------------------------
35769C
35770      DIMENSION Y(*)
35771      DIMENSION QP(*)
35772      DIMENSION XQPHAT(*)
35773      DIMENSION XQPSE(*)
35774      DIMENSION XQPLCL(*)
35775      DIMENSION XQPUCL(*)
35776      DOUBLE PRECISION DTEMP1(*)
35777C
35778      PARAMETER (NUMALP=8)
35779      DIMENSION ALPHA(NUMALP)
35780      DIMENSION ALOWLO(NUMALP)
35781      DIMENSION AUPPLO(NUMALP)
35782      DIMENSION ALOWSC(NUMALP)
35783      DIMENSION AUPPSC(NUMALP)
35784C
35785      INCLUDE 'DPCOST.INC'
35786C
35787      PARAMETER (MAXROW=50)
35788      CHARACTER*60 ITITLE
35789      CHARACTER*60 ITITLZ
35790      CHARACTER*40 ITEXT(MAXROW)
35791      REAL         AVALUE(MAXROW)
35792      INTEGER      NCTEXT(MAXROW)
35793      INTEGER      IDIGIT(MAXROW)
35794      INTEGER      NTOT(MAXROW)
35795      LOGICAL IFRST
35796      LOGICAL ILAST
35797C
35798      DOUBLE PRECISION COV(2,2)
35799      DOUBLE PRECISION DSUM
35800      DOUBLE PRECISION DP
35801      DOUBLE PRECISION D1
35802      DOUBLE PRECISION DVAR
35803      DOUBLE PRECISION DSE
35804C
35805C---------------------------------------------------------------------
35806C
35807      INCLUDE 'DPCOP2.INC'
35808C
35809      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
35810C
35811C-----START POINT-----------------------------------------------------
35812C
35813      ISUBN1='DPML'
35814      ISUBN2='RA  '
35815      IERROR='NO'
35816C
35817      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLRA')THEN
35818        WRITE(ICOUT,999)
35819  999   FORMAT(1X)
35820        CALL DPWRST('XXX','WRIT')
35821        WRITE(ICOUT,51)
35822   51   FORMAT('**** AT THE BEGINNING OF DPMLRA--')
35823        CALL DPWRST('XXX','WRIT')
35824        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,MAXNXT,IOUNI2,ALPHAP
35825   52   FORMAT('IBUGA3,ISUBRO,N,MAXNXT,IOUNI2,ALPHAP = ',
35826     1         2(A4,2X),3I8,G15.7)
35827        CALL DPWRST('XXX','WRIT')
35828        DO56I=1,MIN(N,100)
35829          WRITE(ICOUT,57)I,Y(I)
35830   57     FORMAT('I,Y(I) = ',I8,G15.7)
35831          CALL DPWRST('XXX','WRIT')
35832   56   CONTINUE
35833      ENDIF
35834C
35835C               ********************************************
35836C               **  STEP 11--                             **
35837C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
35838C               ********************************************
35839C
35840      ISTEPN='11'
35841      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLRA')
35842     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
35843C
35844      NMIN=2
35845      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
35846      IF(IERROR.EQ.'YES')GOTO9000
35847C
35848C               **************************************
35849C               **  STEP 21--                       **
35850C               **  CARRY OUT CALCULATIONS FOR      **
35851C               **  RAYLEIGH MLE (FULL SAMPLE CASE) **
35852C               **************************************
35853C
35854      ISTEPN='21'
35855      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLRA')
35856     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
35857C
35858      IERROR='NO'
35859      IWRITE='OFF'
35860C
35861      ICASE='2'
35862      IF(ICASPL.EQ.'1RAY')ICASE='1'
35863      CALL RAYML1(Y,N,ICASE,
35864     1            DTEMP1,
35865     1            XMEAN,XSD,XMIN,XMAX,
35866     1            ALOCML,SCALML,SCALSE,
35867     1            ALOCMM,SCALMM,SCA2SE,
35868     1            ALOCMO,SCALMO,ALOCLM,SCALLM,ALOCPE,SCALPE,
35869     1            ALOCSE,ALAMBA,ALAMSE,
35870     1            ISUBRO,IBUGA3,IERROR)
35871      IF(ICASPL.EQ.'1RAY')THEN
35872        ALOCML=0.0
35873        CALL RAYLI1(Y,N,ICASE,
35874     1              ALOCML,SCALML,
35875     1              ALIK,AIC,AICC,BIC,
35876     1              ISUBRO,IBUGA3,IERROR)
35877      ELSE
35878        IF(ALOCML.LT.XMIN)THEN
35879          CALL RAYLI1(Y,N,ICASE,
35880     1                ALOCML,SCALML,
35881     1                ALIK,AIC,AICC,BIC,
35882     1                ISUBRO,IBUGA3,IERROR)
35883        ELSE
35884          ALIK=CPUMIN
35885          AIC=CPUMIN
35886          AICC=CPUMIN
35887          BIC=CPUMIN
35888        ENDIF
35889C
35890        IF(ALOCMM.LT.XMIN)THEN
35891          CALL RAYLI1(Y,N,ICASE,
35892     1                ALOCMM,SCALMM,
35893     1                ALIK2,AIC2,AICC2,BIC2,
35894     1                ISUBRO,IBUGA3,IERROR)
35895        ELSE
35896          ALIK2=CPUMIN
35897          AIC2=CPUMIN
35898          AICC2=CPUMIN
35899          BIC2=CPUMIN
35900        ENDIF
35901C
35902        IF(ALOCMO.LT.XMIN)THEN
35903          CALL RAYLI1(Y,N,ICASE,
35904     1                ALOCMO,SCALMO,
35905     1                ALIK3,AIC3,AICC3,BIC3,
35906     1                ISUBRO,IBUGA3,IERROR)
35907        ELSE
35908          ALIK3=CPUMIN
35909          AIC3=CPUMIN
35910          AICC3=CPUMIN
35911          BIC3=CPUMIN
35912        ENDIF
35913C
35914        IF(ALOCLM.LT.XMIN)THEN
35915          CALL RAYLI1(Y,N,ICASE,
35916     1                ALOCLM,SCALLM,
35917     1                ALIK4,AIC4,AICC4,BIC4,
35918     1                ISUBRO,IBUGA3,IERROR)
35919        ELSE
35920          ALIK4=CPUMIN
35921          AIC4=CPUMIN
35922          AICC4=CPUMIN
35923          BIC4=CPUMIN
35924        ENDIF
35925C
35926        IF(ALOCPE.LT.XMIN)THEN
35927          CALL RAYLI1(Y,N,ICASE,
35928     1                ALOCPE,SCALPE,
35929     1                ALIK5,AIC5,AICC5,BIC5,
35930     1                ISUBRO,IBUGA3,IERROR)
35931        ELSE
35932          ALIK5=CPUMIN
35933          AIC5=CPUMIN
35934          AICC5=CPUMIN
35935          BIC5=CPUMIN
35936        ENDIF
35937C
35938      ENDIF
35939C
35940      IF(ICASPL.EQ.'1RAY')THEN
35941        NU=2*N
35942        DTERM1=DBLE(N)*2.0D0*DBLE(SCALML)**2
35943        DO2120I=1,NUMALP
35944          ALP=ALPHA(I)
35945          P=1.0-(ALP/2.0)
35946          CALL CHSPPF(P,NU,PPF1)
35947          P=ALP/2.0
35948          CALL CHSPPF(P,NU,PPF2)
35949          ALOWSC(I)=SQRT(REAL(DTERM1)/PPF1)
35950          AUPPSC(I)=SQRT(REAL(DTERM1)/PPF2)
35951 2120   CONTINUE
35952C
35953        IF(NPERC.GE.1)THEN
35954C
35955          IF(IDTYPR.EQ.'LOWE')THEN
35956            ALPHL=ALPHAP
35957            ALPHU=1.0 - ALPHAP
35958            CALL NORPPF(ALPHL,Z95)
35959            Z95=-Z95
35960          ELSEIF(IDTYPR.EQ.'UPPE')THEN
35961            ALPHL=ALPHAP
35962            ALPHU=1.0 - ALPHAP
35963            CALL NORPPF(ALPHU,Z95)
35964          ELSE
35965            ALPHL=ALPHAP/2.0
35966            ALPHU=1.0 - ALPHAP/2.0
35967            CALL NORPPF(ALPHU,Z95)
35968          ENDIF
35969C
35970          WRITE(IOUNI1,4131)
35971 4131     FORMAT(15X,'          POINT','       STANDARD',
35972     1           '          LOWER','          UPPER')
35973          WRITE(IOUNI1,4132)
35974 4132     FORMAT('     PERCENTILE','       ESTIMATE','         ERROR',
35975     1           '     CONF LIMIT','     CONF LIMIT')
35976          DO4119I=1,NPERC
35977            QPTEMP=QP(I)/100.0
35978            CALL RAYPPF(QPTEMP,APPF)
35979            XQPHAT(I)=SCALML*APPF
35980C
35981            DP=DBLE(QPTEMP)
35982            D1=DSQRT(2.0D0)*DSQRT(DLOG(1.0D0/(1.0D0 - DP)))
35983            DVAR=D1**2*DBLE(SCALSE)**2
35984            DSE=DSQRT(DVAR)
35985            XQPSE(I)=REAL(DSE)
35986            IF(IDTYPR.EQ.'UPPE')THEN
35987              XQPLCL(I)=CPUMIN
35988            ELSE
35989              XQPLCL(I)=XQPHAT(I) - Z95*XQPSE(I)
35990            ENDIF
35991            IF(IDTYPR.EQ.'LOWE')THEN
35992              XQPUCL(I)=CPUMIN
35993            ELSE
35994              XQPUCL(I)=XQPHAT(I) + Z95*XQPSE(I)
35995            ENDIF
35996C
35997            WRITE(IOUNI1,'(5E15.7)')
35998     1           QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
35999C
36000 4119     CONTINUE
36001        ENDIF
36002      ELSE
36003        DO4120I=1,NUMALP
36004          ALP=ALPHA(I)
36005          P=1.0-(ALP/2.0)
36006          CALL NORPPF(P,PPF1)
36007          ALOWLO(I)=ALOCML - PPF1*ALOCSE
36008          AUPPLO(I)=ALOCML + PPF1*ALOCSE
36009C
36010C         CONFIDENCE INTERVALS BASED ON STANDARD
36011C         ERROR OF LAMBDA (I.E., OBTAIN INTERVAL FOR
36012C         LAMBDA AND THEN TRANSFORM LOWER/UPPER LIMITS
36013C         TO SCALE PARAMETER).
36014C
36015C         NOTE THAT THESE SEEM TO GIVE MORE CREDIBLE
36016C         INTERVALS THAN USING THE MAHDI ESTIMATE OF THE
36017C         SCALE STANDARD ERROR.
36018C
36019          ALOW=ALAMBA - PPF1*ALAMSE
36020          IF(ALOW.LT.0.0)ALOW=0.0
36021          ALOW=SQRT(1.0/(2.0*ALOW))
36022          AUPP=ALAMBA + PPF1*ALAMSE
36023          IF(AUPP.LT.0.0)AUPP=0.0
36024          AUPP=SQRT(1.0/(2.0*AUPP))
36025          ALOWSC(I)=MIN(ALOW,AUPP)
36026          AUPPSC(I)=MAX(ALOW,AUPP)
36027C
36028C         CONFIDENCE INTERVALS BASED ON STANDARD
36029C         ERROR OF SCALE PARAMETER (FROM MAHDI PAPER).
36030C
36031CCCCC     ALOW=SCALML - PPF1*SCALSE
36032CCCCC     IF(ALOW.LT.0.0)ALOW=0.0
36033CCCCC     AUPP=SCALML + PPF1*SCALSE
36034CCCCC     IF(AUPP.LT.0.0)AUPP=0.0
36035CCCCC     ALOWSC(I)=MIN(ALOW,AUPP)
36036CCCCC     AUPPSC(I)=MAX(ALOW,AUPP)
36037 4120   CONTINUE
36038C
36039        IF(NPERC.GE.1)THEN
36040C
36041          IF(IDTYPR.EQ.'LOWE')THEN
36042            ALPHL=ALPHAP
36043            ALPHU=1.0 - ALPHAP
36044            CALL NORPPF(ALPHL,Z95)
36045            Z95=-Z95
36046          ELSEIF(IDTYPR.EQ.'UPPE')THEN
36047            ALPHL=ALPHAP
36048            ALPHU=1.0 - ALPHAP
36049            CALL NORPPF(ALPHU,Z95)
36050          ELSE
36051            ALPHL=ALPHAP/2.0
36052            ALPHU=1.0 - ALPHAP/2.0
36053            CALL NORPPF(ALPHU,Z95)
36054          ENDIF
36055C
36056C         THIS CURRENTLY IGNORES COVARIANCE TERM.  ACCORDING TO
36057C         KUNDU, THE LOCATION AND LAMBDA PARAMETERS ARE
36058C         ASYMPTOTICALLY INDPENDENT.
36059C
36060          WRITE(IOUNI1,4131)
36061          WRITE(IOUNI1,4132)
36062          COV(1,1)=DBLE(ALOCSE**2)
36063          COV(2,2)=DBLE(ALAMSE**2)
36064          COV(1,2)=0.0D0
36065          COV(2,1)=0.0D0
36066C
36067          DO4319I=1,NPERC
36068C
36069            QPTEMP=QP(I)/100.0
36070            CALL RAYPPF(QPTEMP,APPF)
36071            XQPHAT(I)=ALOCML + SCALML*APPF
36072C
36073            DP=DBLE(QPTEMP)
36074            DTEMP1(1)=1.0D0
36075            DTERM1=0.5D0*DLOG(1.0D0 - DP)
36076            DTERM2=DSQRT(-DLOG(1.0D0 - DP)/DBLE(ALAMBA))
36077            DTEMP1(2)=DTERM1/(DBLE(ALAMBA)**2*DTERM2)
36078C
36079            DSUM=0.0D0
36080            DO4360II=1,2
36081              DO4370JJ=1,2
36082                DSUM=DSUM + DTEMP1(II)*DTEMP1(JJ)*COV(II,JJ)
36083 4370         CONTINUE
36084 4360       CONTINUE
36085            DSE=DSQRT(DSUM)
36086            XQPSE(I)=REAL(DSE)
36087            IF(IDTYPR.EQ.'UPPE')THEN
36088              XQPLCL(I)=CPUMIN
36089            ELSE
36090              XQPLCL(I)=XQPHAT(I) - Z95*XQPSE(I)
36091            ENDIF
36092            IF(IDTYPR.EQ.'LOWE')THEN
36093              XQPUCL(I)=CPUMIN
36094            ELSE
36095              XQPUCL(I)=XQPHAT(I) + Z95*XQPSE(I)
36096            ENDIF
36097C
36098            WRITE(IOUNI1,'(5E15.7)')
36099     1           QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
36100C
36101 4319     CONTINUE
36102        ENDIF
36103      ENDIF
36104C
36105C               *************************************
36106C               **   STEP 42--                     **
36107C               **   WRITE OUT EVERYTHING          **
36108C               **   FOR RAYLEIGH MLE ESTIMATE     **
36109C               *************************************
36110C
36111      ISTEPN='42'
36112      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLRA')
36113     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
36114C
36115      IF(IPRINT.EQ.'OFF')GOTO9000
36116C
36117      NUMDIG=7
36118      IF(IFORSW.EQ.'1')NUMDIG=1
36119      IF(IFORSW.EQ.'2')NUMDIG=2
36120      IF(IFORSW.EQ.'3')NUMDIG=3
36121      IF(IFORSW.EQ.'4')NUMDIG=4
36122      IF(IFORSW.EQ.'5')NUMDIG=5
36123      IF(IFORSW.EQ.'6')NUMDIG=6
36124      IF(IFORSW.EQ.'7')NUMDIG=7
36125      IF(IFORSW.EQ.'8')NUMDIG=8
36126      IF(IFORSW.EQ.'9')NUMDIG=9
36127      IF(IFORSW.EQ.'0')NUMDIG=0
36128      IF(IFORSW.EQ.'E')NUMDIG=-2
36129      IF(IFORSW.EQ.'-2')NUMDIG=-2
36130      IF(IFORSW.EQ.'-3')NUMDIG=-3
36131      IF(IFORSW.EQ.'-4')NUMDIG=-4
36132      IF(IFORSW.EQ.'-5')NUMDIG=-5
36133      IF(IFORSW.EQ.'-6')NUMDIG=-6
36134      IF(IFORSW.EQ.'-7')NUMDIG=-7
36135      IF(IFORSW.EQ.'-8')NUMDIG=-8
36136      IF(IFORSW.EQ.'-9')NUMDIG=-9
36137C
36138      IF(ICASPL.EQ.'1RAY')THEN
36139        ITITLE='1-Parameter Rayleigh Parameter Estimation'
36140        NCTITL=41
36141      ELSE
36142        ITITLE='2-Parameter Rayleigh Parameter Estimation'
36143        NCTITL=41
36144      ENDIF
36145      ITITLZ=' '
36146      NCTITZ=0
36147      ICNT=1
36148      ITEXT(ICNT)='Summary Statistics:'
36149      NCTEXT(ICNT)=19
36150      AVALUE(ICNT)=0.0
36151      IDIGIT(ICNT)=-1
36152      ICNT=ICNT+1
36153      ITEXT(ICNT)='Number of Observations:'
36154      NCTEXT(ICNT)=23
36155      AVALUE(ICNT)=REAL(N)
36156      IDIGIT(ICNT)=0
36157      ICNT=ICNT+1
36158      ITEXT(ICNT)='Sample Mean:'
36159      NCTEXT(ICNT)=12
36160      AVALUE(ICNT)=XMEAN
36161      IDIGIT(ICNT)=NUMDIG
36162      ICNT=ICNT+1
36163      ITEXT(ICNT)='Sample Standard Deviation:'
36164      NCTEXT(ICNT)=26
36165      AVALUE(ICNT)=XSD
36166      IDIGIT(ICNT)=NUMDIG
36167      ICNT=ICNT+1
36168      ITEXT(ICNT)='Sample Minimum:'
36169      NCTEXT(ICNT)=15
36170      AVALUE(ICNT)=XMIN
36171      IDIGIT(ICNT)=NUMDIG
36172      ICNT=ICNT+1
36173      ITEXT(ICNT)='Sample Maximum:'
36174      NCTEXT(ICNT)=15
36175      AVALUE(ICNT)=XMAX
36176      IDIGIT(ICNT)=NUMDIG
36177      ICNT=ICNT+1
36178      ITEXT(ICNT)=' '
36179      NCTEXT(ICNT)=0
36180      AVALUE(ICNT)=0.0
36181      IDIGIT(ICNT)=-1
36182C
36183      IF(ICASPL.EQ.'RAYL')THEN
36184        ICNT=ICNT+1
36185        ITEXT(ICNT)='Moments:'
36186        NCTEXT(ICNT)=8
36187        AVALUE(ICNT)=0.0
36188        IDIGIT(ICNT)=-1
36189        ICNT=ICNT+1
36190        ITEXT(ICNT)='Estimate of Location:'
36191        NCTEXT(ICNT)=21
36192        AVALUE(ICNT)=ALOCMO
36193        IDIGIT(ICNT)=NUMDIG
36194        ICNT=ICNT+1
36195        ITEXT(ICNT)='Estimate of Scale:'
36196        NCTEXT(ICNT)=18
36197        AVALUE(ICNT)=SCALMO
36198        IDIGIT(ICNT)=NUMDIG
36199C
36200        IF(ALIK3.NE.CPUMIN)THEN
36201          ICNT=ICNT+1
36202          ITEXT(ICNT)='Log-likelihood:'
36203          NCTEXT(ICNT)=15
36204          AVALUE(ICNT)=ALIK3
36205          IDIGIT(ICNT)=-7
36206          ICNT=ICNT+1
36207          ITEXT(ICNT)='AIC:'
36208          NCTEXT(ICNT)=4
36209          AVALUE(ICNT)=AIC3
36210          IDIGIT(ICNT)=-7
36211          ICNT=ICNT+1
36212          ITEXT(ICNT)='AICc:'
36213          NCTEXT(ICNT)=5
36214          AVALUE(ICNT)=AICC3
36215          IDIGIT(ICNT)=-7
36216          ICNT=ICNT+1
36217          ITEXT(ICNT)='BIC:'
36218          NCTEXT(ICNT)=4
36219          AVALUE(ICNT)=BIC3
36220          IDIGIT(ICNT)=-7
36221        ENDIF
36222        ICNT=ICNT+1
36223        ITEXT(ICNT)=' '
36224        NCTEXT(ICNT)=0
36225        AVALUE(ICNT)=0.0
36226        IDIGIT(ICNT)=-1
36227C
36228        ICNT=ICNT+1
36229        ITEXT(ICNT)='L-Moments:'
36230        NCTEXT(ICNT)=10
36231        AVALUE(ICNT)=0.0
36232        IDIGIT(ICNT)=-1
36233        ICNT=ICNT+1
36234        ITEXT(ICNT)='Estimate of Location:'
36235        NCTEXT(ICNT)=21
36236        AVALUE(ICNT)=ALOCLM
36237        IDIGIT(ICNT)=NUMDIG
36238        ICNT=ICNT+1
36239        ITEXT(ICNT)='Estimate of Scale:'
36240        NCTEXT(ICNT)=18
36241        AVALUE(ICNT)=SCALLM
36242        IDIGIT(ICNT)=NUMDIG
36243        IF(ALIK4.NE.CPUMIN)THEN
36244          ICNT=ICNT+1
36245          ITEXT(ICNT)='Log-likelihood:'
36246          NCTEXT(ICNT)=15
36247          AVALUE(ICNT)=ALIK4
36248          IDIGIT(ICNT)=-7
36249          ICNT=ICNT+1
36250          ITEXT(ICNT)='AIC:'
36251          NCTEXT(ICNT)=4
36252          AVALUE(ICNT)=AIC4
36253          IDIGIT(ICNT)=-7
36254          ICNT=ICNT+1
36255          ITEXT(ICNT)='AICc:'
36256          NCTEXT(ICNT)=5
36257          AVALUE(ICNT)=AICC4
36258          IDIGIT(ICNT)=-7
36259          ICNT=ICNT+1
36260          ITEXT(ICNT)='BIC:'
36261          NCTEXT(ICNT)=4
36262          AVALUE(ICNT)=BIC4
36263          IDIGIT(ICNT)=-7
36264        ENDIF
36265        ICNT=ICNT+1
36266        ITEXT(ICNT)=' '
36267        NCTEXT(ICNT)=0
36268        AVALUE(ICNT)=0.0
36269        IDIGIT(ICNT)=-1
36270C
36271        ICNT=ICNT+1
36272        ITEXT(ICNT)='Percentile:'
36273        NCTEXT(ICNT)=11
36274        AVALUE(ICNT)=0.0
36275        IDIGIT(ICNT)=-1
36276        ICNT=ICNT+1
36277        ITEXT(ICNT)='Estimate of Location:'
36278        NCTEXT(ICNT)=21
36279        AVALUE(ICNT)=ALOCPE
36280        IDIGIT(ICNT)=NUMDIG
36281        ICNT=ICNT+1
36282        ITEXT(ICNT)='Estimate of Scale:'
36283        NCTEXT(ICNT)=18
36284        AVALUE(ICNT)=SCALPE
36285        IDIGIT(ICNT)=NUMDIG
36286        IF(ALIK5.NE.CPUMIN)THEN
36287          ICNT=ICNT+1
36288          ITEXT(ICNT)='Log-likelihood:'
36289          NCTEXT(ICNT)=15
36290          AVALUE(ICNT)=ALIK5
36291          IDIGIT(ICNT)=-7
36292          ICNT=ICNT+1
36293          ITEXT(ICNT)='AIC:'
36294          NCTEXT(ICNT)=4
36295          AVALUE(ICNT)=AIC5
36296          IDIGIT(ICNT)=-7
36297          ICNT=ICNT+1
36298          ITEXT(ICNT)='AICc:'
36299          NCTEXT(ICNT)=5
36300          AVALUE(ICNT)=AICC5
36301          IDIGIT(ICNT)=-7
36302          ICNT=ICNT+1
36303          ITEXT(ICNT)='BIC:'
36304          NCTEXT(ICNT)=4
36305          AVALUE(ICNT)=BIC5
36306          IDIGIT(ICNT)=-7
36307        ENDIF
36308        ICNT=ICNT+1
36309        ITEXT(ICNT)=' '
36310        NCTEXT(ICNT)=0
36311        AVALUE(ICNT)=0.0
36312        IDIGIT(ICNT)=-1
36313C
36314        ICNT=ICNT+1
36315        ITEXT(ICNT)='Modified Moments:'
36316        NCTEXT(ICNT)=17
36317        AVALUE(ICNT)=0.0
36318        IDIGIT(ICNT)=-1
36319        ICNT=ICNT+1
36320        ITEXT(ICNT)='Estimate of Location:'
36321        NCTEXT(ICNT)=21
36322        AVALUE(ICNT)=ALOCMM
36323        IDIGIT(ICNT)=NUMDIG
36324        ICNT=ICNT+1
36325        ITEXT(ICNT)='Estimate of Scale:'
36326        NCTEXT(ICNT)=18
36327        AVALUE(ICNT)=SCALMM
36328        IDIGIT(ICNT)=NUMDIG
36329        IF(ALIK2.NE.CPUMIN)THEN
36330          ICNT=ICNT+1
36331          ITEXT(ICNT)='Log-likelihood:'
36332          NCTEXT(ICNT)=15
36333          AVALUE(ICNT)=ALIK2
36334          IDIGIT(ICNT)=-7
36335          ICNT=ICNT+1
36336          ITEXT(ICNT)='AIC:'
36337          NCTEXT(ICNT)=4
36338          AVALUE(ICNT)=AIC2
36339          IDIGIT(ICNT)=-7
36340          ICNT=ICNT+1
36341          ITEXT(ICNT)='AICc:'
36342          NCTEXT(ICNT)=5
36343          AVALUE(ICNT)=AICC2
36344          IDIGIT(ICNT)=-7
36345          ICNT=ICNT+1
36346          ITEXT(ICNT)='BIC:'
36347          NCTEXT(ICNT)=4
36348          AVALUE(ICNT)=BIC2
36349          IDIGIT(ICNT)=-7
36350        ENDIF
36351        ICNT=ICNT+1
36352        ITEXT(ICNT)=' '
36353        NCTEXT(ICNT)=0
36354        AVALUE(ICNT)=0.0
36355        IDIGIT(ICNT)=-1
36356      ENDIF
36357C
36358      ICNT=ICNT+1
36359      ITEXT(ICNT)='Maximum Likelihood:'
36360      NCTEXT(ICNT)=19
36361      AVALUE(ICNT)=0.0
36362      IDIGIT(ICNT)=-1
36363C
36364      IF(ICASPL.EQ.'RAYL')THEN
36365        ICNT=ICNT+1
36366        ITEXT(ICNT)='Estimate of Location:'
36367        NCTEXT(ICNT)=21
36368        AVALUE(ICNT)=ALOCML
36369        IDIGIT(ICNT)=NUMDIG
36370        ICNT=ICNT+1
36371        ITEXT(ICNT)='Standard Error of Location:'
36372        NCTEXT(ICNT)=27
36373        AVALUE(ICNT)=ALOCSE
36374        IDIGIT(ICNT)=NUMDIG
36375      ENDIF
36376C
36377      ICNT=ICNT+1
36378      ITEXT(ICNT)='Estimate of Scale:'
36379      NCTEXT(ICNT)=18
36380      AVALUE(ICNT)=SCALML
36381      IDIGIT(ICNT)=NUMDIG
36382C
36383      IF(ICASPL.EQ.'1RAY')THEN
36384        ICNT=ICNT+1
36385        ITEXT(ICNT)='Standard Error of Scale:'
36386        NCTEXT(ICNT)=24
36387        AVALUE(ICNT)=SCALSE
36388        IDIGIT(ICNT)=NUMDIG
36389      ENDIF
36390C
36391      IF(ALIK.NE.CPUMIN)THEN
36392        ICNT=ICNT+1
36393        ITEXT(ICNT)='Log-likelihood:'
36394        NCTEXT(ICNT)=15
36395        AVALUE(ICNT)=ALIK
36396        IDIGIT(ICNT)=-7
36397        ICNT=ICNT+1
36398        ITEXT(ICNT)='AIC:'
36399        NCTEXT(ICNT)=4
36400        AVALUE(ICNT)=AIC
36401        IDIGIT(ICNT)=-7
36402        ICNT=ICNT+1
36403        ITEXT(ICNT)='AICc:'
36404        NCTEXT(ICNT)=5
36405        AVALUE(ICNT)=AICC
36406        IDIGIT(ICNT)=-7
36407        ICNT=ICNT+1
36408        ITEXT(ICNT)='BIC:'
36409        NCTEXT(ICNT)=4
36410        AVALUE(ICNT)=BIC
36411        IDIGIT(ICNT)=-7
36412      ENDIF
36413C
36414      NUMROW=ICNT
36415      DO2320I=1,NUMROW
36416        NTOT(I)=15
36417 2320 CONTINUE
36418C
36419      IFRST=.FALSE.
36420      ILAST=.FALSE.
36421      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
36422     1            AVALUE,IDIGIT,
36423     1            NTOT,NUMROW,
36424     1            ICAPSW,ICAPTY,ILAST,IFRST,
36425     1            ISUBRO,IBUGA3,IERROR)
36426C
36427      IF(ICASPL.EQ.'1RAY')THEN
36428        INORM='OFF'
36429        ALOWLO(1)=CPUMIN
36430        CALL DPDTA7(ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,NUMALP,
36431     1              ICAPSW,ICAPTY,NUMDIG,INORM,
36432     1              ISUBRO,IBUGA3,IERROR)
36433C
36434        IF(NPERC.GT.1)THEN
36435          ILIKFL='OFF'
36436          CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
36437     1                ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
36438     1                ISUBRO,IBUGA3,IERROR)
36439        ENDIF
36440      ELSE
36441        INORM='YES'
36442        CALL DPDTA7(ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,NUMALP,
36443     1              ICAPSW,ICAPTY,NUMDIG,INORM,
36444     1              ISUBRO,IBUGA3,IERROR)
36445C
36446        IF(NPERC.GT.1)THEN
36447          ILIKFL='OFF'
36448          CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
36449     1                ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
36450     1                ISUBRO,IBUGA3,IERROR)
36451        ENDIF
36452      ENDIF
36453C
36454C               *****************
36455C               **  STEP 90--  **
36456C               **  EXIT       **
36457C               *****************
36458C
36459 9000 CONTINUE
36460      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLRA')THEN
36461        WRITE(ICOUT,999)
36462        CALL DPWRST('XXX','WRIT')
36463        WRITE(ICOUT,9011)
36464 9011   FORMAT('***** AT THE END       OF DPMLRA--')
36465        CALL DPWRST('XXX','WRIT')
36466        WRITE(ICOUT,9012)N,IBUGA3,IERROR
36467 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
36468        CALL DPWRST('XXX','WRIT')
36469        WRITE(ICOUT,9015)N
36470 9015   FORMAT('N = ',I8)
36471        CALL DPWRST('XXX','WRIT')
36472      ENDIF
36473C
36474      RETURN
36475      END
36476      SUBROUTINE DPMLRG(Y,XLOW,XHIGH,N,NVAR,
36477     1                  TEMP1,TEMP2,TEMP3,TEMP4,DTEMP1,MAXNXT,
36478     1                  ALPHSV,A,B,
36479     1                  ALPHML,BETAML,ALOWML,AUPPML,
36480     1                  ICAPSW,ICAPTY,IFORSW,
36481     1                  ISUBRO,IBUGA3,IERROR)
36482C
36483C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
36484C              ESTIMATES FOR THE REFLECTED GENERALIZED TOPP
36485C              AND LEONE DISTRIBUTION.  THIS ESTIMATES THE
36486C              SHAPE PARAMETERS (I.E., LOWER/UPPER LIMIT PARAMETERS
36487C              ASSUMED KNOWN AND FIXED).
36488C
36489C              NOTE THAT THIS ALGORITHM WILL HANDLE
36490C              EITHER GROUPED OR UNGROUPED DATA.
36491C     EXAMPLE--REFLECTED GENERALIZED TOPP AND LEONE MLE Y
36492C              REFLECTED GENERALIZED TOPP AND LEONE MLE Y X
36493C              REFLECTED GENERALIZED TOPP AND LEONE MLE Y XLOW XHIGH
36494C     REFERENCE --KOTZ AND VAN DORP (2004), "BEYOND BETA: OTHER
36495C                 CONTINUOUS FAMILIES OF DISTRIBUTIONS WITH
36496C                 BOUNDED SUPPORT AND APPLICATIONS", WORLD
36497C                 SCIENTIFIC PUBLISHING CO., PP. 211-213.
36498C     WRITTEN BY--ALAN HECKERT
36499C                 STATISTICAL ENGINEERING DIVISION
36500C                 INFORMATION TECHNOLOGY LABORATORY
36501C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
36502C                 GAITHERSBURG, MD 20899-8980
36503C                 PHONE--301-975-2899
36504C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
36505C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
36506C     LANGUAGE--ANSI FORTRAN (1977)
36507C     VERSION NUMBER--2007/7
36508C     ORIGINAL VERSION--JULY      2007.
36509C     UPDATED         --JULY      2010. USE DPDTA1 TO PRINT
36510C     UPDATED         --JULY      2010. EXTRACT POINT ESTIMATES TO
36511C                                       RGTML1
36512C
36513C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
36514C
36515      CHARACTER*4 ICAPSW
36516      CHARACTER*4 ICAPTY
36517      CHARACTER*4 IFORSW
36518      CHARACTER*4 ISUBRO
36519      CHARACTER*4 IBUGA3
36520      CHARACTER*4 IERROR
36521C
36522      CHARACTER*4 ISUBN1
36523      CHARACTER*4 ISUBN2
36524      CHARACTER*4 ISTEPN
36525C
36526C---------------------------------------------------------------------
36527C
36528      DIMENSION Y(*)
36529      DIMENSION XLOW(*)
36530      DIMENSION XHIGH(*)
36531      DIMENSION TEMP1(*)
36532      DIMENSION TEMP2(*)
36533      DIMENSION TEMP3(*)
36534      DIMENSION TEMP4(*)
36535      DOUBLE PRECISION DTEMP1(*)
36536C
36537      INCLUDE 'DPCOST.INC'
36538C
36539      PARAMETER (MAXROW=20)
36540      CHARACTER*60 ITITLE
36541      CHARACTER*60 ITITLZ
36542      CHARACTER*40 ITEXT(MAXROW)
36543      REAL         AVALUE(MAXROW)
36544      INTEGER      NCTEXT(MAXROW)
36545      INTEGER      IDIGIT(MAXROW)
36546      INTEGER      NTOT(MAXROW)
36547      LOGICAL IFRST
36548      LOGICAL ILAST
36549C
36550C---------------------------------------------------------------------
36551C
36552      INCLUDE 'DPCOP2.INC'
36553C
36554C-----START POINT-----------------------------------------------------
36555C
36556      ISUBN1='DPML'
36557      ISUBN2='RG  '
36558      IERROR='NO'
36559C
36560      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLRG')THEN
36561        WRITE(ICOUT,999)
36562  999   FORMAT(1X)
36563        CALL DPWRST('XXX','WRIT')
36564        WRITE(ICOUT,51)
36565   51   FORMAT('**** AT THE BEGINNING OF DPMRGT--')
36566        CALL DPWRST('XXX','WRIT')
36567        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR
36568   52   FORMAT('IBUGA3,ISUBRO,N,NVAR = ',2(A4,2X),2I8)
36569        CALL DPWRST('XXX','WRIT')
36570        DO56I=1,MIN(N,100)
36571          WRITE(ICOUT,57)I,Y(I),XLOW(I),XHIGH(I)
36572   57     FORMAT('I,Y(I),XLOW(I),XHIGH(I) = ',I8,3G15.7)
36573          CALL DPWRST('XXX','WRIT')
36574   56   CONTINUE
36575      ENDIF
36576C
36577C               ********************************************
36578C               **  STEP 11--                             **
36579C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
36580C               ********************************************
36581C
36582      ISTEPN='11'
36583      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLRG')
36584     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
36585C
36586C     NOTE: THERE ARE 3 POSSIBLE CASES.
36587C
36588C     1. UNBINNED DATA
36589C     2. GROUPED DATA, BIN MID-POINTS PROVIDED
36590C     3. GROUPED DATA, BIN LOWER/UPPER LIMITS
36591C        PROVIDED (I.E., UNEQUAL SIZE BINS)
36592C
36593      NPERC=0
36594      MAXGRP=MAXNXT/2
36595      NMIN=4
36596      IF(NVAR.EQ.1)THEN
36597        CALL CKDIST(Y,N,NMIN,TEMP2,NPERC,ISUBRO,IBUGA3,IERROR)
36598        IF(IERROR.EQ.'YES')GOTO9000
36599        NTOT2=N
36600        NCLASS=N
36601      ELSEIF(NVAR.EQ.2)THEN
36602        CALL CKDIS2(Y,XLOW,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOT2,
36603     1              ISUBRO,IBUGA3,IERROR)
36604        IF(IERROR.EQ.'YES')GOTO9000
36605      ELSEIF(NVAR.EQ.3)THEN
36606        CALL CKDIS3(Y,XLOW,XHIGH,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOT2,
36607     1              ISUBRO,IBUGA3,IERROR)
36608        IF(IERROR.EQ.'YES')GOTO9000
36609      ELSE
36610        WRITE(ICOUT,999)
36611        CALL DPWRST('XXX','WRIT')
36612        WRITE(ICOUT,111)
36613  111   FORMAT('***** ERROR IN REFLECTED GENERALIZED TOPP AND ',
36614     1         'LEONE MAXIMUM LIKELIHOOD--')
36615        CALL DPWRST('XXX','WRIT')
36616        WRITE(ICOUT,390)
36617  390   FORMAT('      MORE THAN THREE RESPONSE VARIABLES WERE ',
36618     1         'SPECIFIED.')
36619        CALL DPWRST('XXX','WRIT')
36620        IERROR='YES'
36621        GOTO9000
36622      ENDIF
36623C
36624C               ***************************************************
36625C               **  STEP 21--                                    **
36626C               **  CARRY OUT CALCULATIONS FOR THE               **
36627C               **  REFLECTED GENERALIZED TOPP AND LEONE    MLE  **
36628C               ***************************************************
36629C
36630      ISTEPN='21'
36631      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLRG')
36632     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
36633C
36634      IERROR='NO'
36635C
36636      CALL RGTML1(Y,XLOW,XHIGH,N,NVAR,MAXNXT,NTOT2,
36637     1            DTEMP1,TEMP1,TEMP2,TEMP3,TEMP4,
36638     1            XMIN,XMAX,XMEAN,XSD,
36639     1            ALPHSV,A,B,
36640     1            ALPHML,BETAML,ALOWML,AUPPML,
36641     1            ISUBRO,IBUGA3,IERROR)
36642      IF(IERROR.EQ.'YES')GOTO9000
36643C
36644      ALIK=CPUMIN
36645      AIC=CPUMIN
36646      AICC=CPUMIN
36647      BIC=CPUMIN
36648      IF(NVAR.EQ.1)THEN
36649        CALL RGTLI1(Y,N,
36650     1              ALOWML,AUPPML,ALPHML,BETAML,
36651     1              ALIK,AIC,AICC,BIC,
36652     1            ISUBRO,IBUGA3,IERROR)
36653      ENDIF
36654C
36655C               ***************************************************
36656C               **   STEP 42--                                   **
36657C               **   WRITE OUT EVERYTHING FOR REFLECTED          **
36658C               **   GENERALIZED TOPP AND LEONE  MLE ESTIMATION  **
36659C               ***************************************************
36660C
36661      ISTEPN='42'
36662      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLRG')
36663     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
36664C
36665      IF(IPRINT.EQ.'OFF')GOTO9000
36666C
36667      NUMDIG=7
36668      IF(IFORSW.EQ.'1')NUMDIG=1
36669      IF(IFORSW.EQ.'2')NUMDIG=2
36670      IF(IFORSW.EQ.'3')NUMDIG=3
36671      IF(IFORSW.EQ.'4')NUMDIG=4
36672      IF(IFORSW.EQ.'5')NUMDIG=5
36673      IF(IFORSW.EQ.'6')NUMDIG=6
36674      IF(IFORSW.EQ.'7')NUMDIG=7
36675      IF(IFORSW.EQ.'8')NUMDIG=8
36676      IF(IFORSW.EQ.'9')NUMDIG=9
36677      IF(IFORSW.EQ.'0')NUMDIG=0
36678      IF(IFORSW.EQ.'E')NUMDIG=-2
36679      IF(IFORSW.EQ.'-2')NUMDIG=-2
36680      IF(IFORSW.EQ.'-3')NUMDIG=-3
36681      IF(IFORSW.EQ.'-4')NUMDIG=-4
36682      IF(IFORSW.EQ.'-5')NUMDIG=-5
36683      IF(IFORSW.EQ.'-6')NUMDIG=-6
36684      IF(IFORSW.EQ.'-7')NUMDIG=-7
36685      IF(IFORSW.EQ.'-8')NUMDIG=-8
36686      IF(IFORSW.EQ.'-9')NUMDIG=-9
36687C
36688      ITITLE='Reflected Generalized Topp and Leone Parameter Estimation'
36689      NCTITL=58
36690      ITITLZ='Full Sample Case'
36691      NCTITZ=16
36692      ICNT=1
36693      ITEXT(ICNT)='Summary Statistics:'
36694      NCTEXT(ICNT)=19
36695      AVALUE(ICNT)=0.0
36696      IDIGIT(ICNT)=-1
36697      ICNT=ICNT+1
36698      ITEXT(ICNT)='Number of Observations:'
36699      NCTEXT(ICNT)=23
36700      AVALUE(ICNT)=REAL(NTOT2)
36701      IDIGIT(ICNT)=0
36702      ICNT=ICNT+1
36703      ITEXT(ICNT)='Sample Mean:'
36704      NCTEXT(ICNT)=12
36705      AVALUE(ICNT)=XMEAN
36706      IDIGIT(ICNT)=NUMDIG
36707      ICNT=ICNT+1
36708      ITEXT(ICNT)='Sample Standard Deviation:'
36709      NCTEXT(ICNT)=26
36710      AVALUE(ICNT)=XSD
36711      IDIGIT(ICNT)=NUMDIG
36712      ICNT=ICNT+1
36713      ITEXT(ICNT)='Sample Minimum:'
36714      NCTEXT(ICNT)=15
36715      AVALUE(ICNT)=XMIN
36716      IDIGIT(ICNT)=NUMDIG
36717      ICNT=ICNT+1
36718      ITEXT(ICNT)='Sample Maximum:'
36719      NCTEXT(ICNT)=15
36720      AVALUE(ICNT)=XMAX
36721      IDIGIT(ICNT)=NUMDIG
36722      ICNT=ICNT+1
36723      ITEXT(ICNT)=' '
36724      NCTEXT(ICNT)=0
36725      AVALUE(ICNT)=0.0
36726      IDIGIT(ICNT)=-1
36727C
36728      ICNT=ICNT+1
36729      ITEXT(ICNT)='Maximum Likelihood:'
36730      NCTEXT(ICNT)=19
36731      AVALUE(ICNT)=0.0
36732      IDIGIT(ICNT)=-1
36733      ICNT=ICNT+1
36734      ITEXT(ICNT)='Value Used for Lower Limit:'
36735      NCTEXT(ICNT)=27
36736      AVALUE(ICNT)=ALOWML
36737      IDIGIT(ICNT)=NUMDIG
36738      ICNT=ICNT+1
36739      ITEXT(ICNT)='Value Used for Upper Limit:'
36740      NCTEXT(ICNT)=27
36741      AVALUE(ICNT)=AUPPML
36742      IDIGIT(ICNT)=NUMDIG
36743      ICNT=ICNT+1
36744      ITEXT(ICNT)='Estimate of Shape (Alpha):'
36745      NCTEXT(ICNT)=25
36746      AVALUE(ICNT)=ALPHML
36747      IDIGIT(ICNT)=NUMDIG
36748      ICNT=ICNT+1
36749      ITEXT(ICNT)='Estimate of Shape (Beta):'
36750      NCTEXT(ICNT)=24
36751      AVALUE(ICNT)=BETAML
36752      IDIGIT(ICNT)=NUMDIG
36753C
36754      IF(ALIK.NE.CPUMIN)THEN
36755        ICNT=ICNT+1
36756        ITEXT(ICNT)='Log-likelihood:'
36757        NCTEXT(ICNT)=15
36758        AVALUE(ICNT)=ALIK
36759        IDIGIT(ICNT)=-7
36760        ICNT=ICNT+1
36761        ITEXT(ICNT)='AIC:'
36762        NCTEXT(ICNT)=4
36763        AVALUE(ICNT)=AIC
36764        IDIGIT(ICNT)=-7
36765        ICNT=ICNT+1
36766        ITEXT(ICNT)='AICc:'
36767        NCTEXT(ICNT)=5
36768        AVALUE(ICNT)=AICC
36769        IDIGIT(ICNT)=-7
36770        ICNT=ICNT+1
36771        ITEXT(ICNT)='BIC:'
36772        NCTEXT(ICNT)=4
36773        AVALUE(ICNT)=BIC
36774        IDIGIT(ICNT)=-7
36775      ENDIF
36776C
36777      NUMROW=ICNT
36778      DO2320I=1,NUMROW
36779        NTOT(I)=15
36780 2320 CONTINUE
36781C
36782      IFRST=.TRUE.
36783      ILAST=.TRUE.
36784      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
36785     1            AVALUE,IDIGIT,
36786     1            NTOT,NUMROW,
36787     1            ICAPSW,ICAPTY,ILAST,IFRST,
36788     1            ISUBRO,IBUGA3,IERROR)
36789C
36790C               *****************
36791C               **  STEP 90--  **
36792C               **  EXIT       **
36793C               *****************
36794C
36795 9000 CONTINUE
36796      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLRG')THEN
36797        WRITE(ICOUT,999)
36798        CALL DPWRST('XXX','WRIT')
36799        WRITE(ICOUT,9011)
36800 9011   FORMAT('***** AT THE END       OF DPMRGT--')
36801        CALL DPWRST('XXX','WRIT')
36802        WRITE(ICOUT,9012)N,IBUGA3,IERROR
36803 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
36804        CALL DPWRST('XXX','WRIT')
36805        WRITE(ICOUT,9015)N
36806 9015   FORMAT('N = ',I8)
36807        CALL DPWRST('XXX','WRIT')
36808      ENDIF
36809C
36810      RETURN
36811      END
36812      SUBROUTINE DPMLSL(Y,N,
36813     1                  TEMP1,TEMP2,TEMP3,DTEMP1,MAXNXT,
36814     1                  ALOC,ASCALE,
36815     1                  ICAPSW,ICAPTY,IFORSW,
36816     1                  ISUBRO,IBUGA3,IERROR)
36817C
36818C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
36819C              ESTIMATES FOR SLASH DISTRIBUTION
36820C     EXAMPLE--SLASH MAXIMUM LIKELIHOOD Y
36821C     REFERENCE--KAREN KAFADAR, (1982), "A BIWEIGHT APPROACH TO
36822C                THE ONE-SAMPLE PROBLEM", JOURNAL OF THE
36823C                AMERICAN STATISTICAL ASSOCIATION, VOL. 77,
36824C                NO. 378, PP. 416-424.
36825C     WRITTEN BY--ALAN HECKERT
36826C                 STATISTICAL ENGINEERING DIVISION
36827C                 INFORMATION TECHNOLOGY LABORATORY
36828C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
36829C                 GAITHERSBURG, MD 20899-8980
36830C                 PHONE--301-975-2899
36831C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
36832C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
36833C     LANGUAGE--ANSI FORTRAN (1977)
36834C     VERSION NUMBER--2007/6
36835C     ORIGINAL VERSION--JUNE      2007.
36836C     UPDATED         --OCTOBER   2009. EXTRACT ESTIMATION TO
36837C                                       SEPARATE SUBROUTINE
36838C     UPDATED         --OCTOBER   2009. CALL DPDTA1 TO PRINT OUTPUT
36839C                                       (THIS ALSO ADDS RTF FORMAT
36840C                                       OUTPUT)
36841C
36842C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
36843C
36844      CHARACTER*4 ICAPSW
36845      CHARACTER*4 ICAPTY
36846      CHARACTER*4 IFORSW
36847C
36848      CHARACTER*4 ISUBRO
36849      CHARACTER*4 IBUGA3
36850      CHARACTER*4 IERROR
36851      CHARACTER*4 IWRITE
36852C
36853      CHARACTER*4 ISUBN1
36854      CHARACTER*4 ISUBN2
36855      CHARACTER*4 ISTEPN
36856C
36857C---------------------------------------------------------------------
36858C
36859      DIMENSION Y(*)
36860      DIMENSION TEMP1(*)
36861      DIMENSION TEMP2(*)
36862      DIMENSION TEMP3(*)
36863      DOUBLE PRECISION DTEMP1(*)
36864C
36865      INCLUDE 'DPCOST.INC'
36866C
36867      PARAMETER (NUMALP=8)
36868CCCCC REAL ALPHA(NUMALP)
36869C
36870      PARAMETER (MAXROW=25)
36871      CHARACTER*60 ITITLE
36872      CHARACTER*1  ITITLZ
36873      CHARACTER*40 ITEXT(MAXROW)
36874      REAL         AVALUE(MAXROW)
36875      INTEGER      NCTEXT(MAXROW)
36876      INTEGER      IDIGIT(MAXROW)
36877      INTEGER      NTOT(MAXROW)
36878      LOGICAL IFRST
36879      LOGICAL ILAST
36880C
36881C---------------------------------------------------------------------
36882C
36883      INCLUDE 'DPCOP2.INC'
36884C
36885CCCCC DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
36886C
36887C-----START POINT-----------------------------------------------------
36888C
36889      ISUBN1='DPML'
36890      ISUBN2='SL  '
36891      IERROR='NO'
36892      IWRITE='OFF'
36893C
36894      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLSL')THEN
36895        WRITE(ICOUT,999)
36896  999   FORMAT(1X)
36897        CALL DPWRST('XXX','WRIT')
36898        WRITE(ICOUT,51)
36899   51   FORMAT('**** AT THE BEGINNING OF DPMLSL--')
36900        CALL DPWRST('XXX','WRIT')
36901        WRITE(ICOUT,52)IBUGA3,ISUBRO,ICAPTY,ICAPSW,IFORSW
36902   52   FORMAT('IBUGA3,ISUBRO,ICAPTY,ICAPSW,IFORSW = ',5(A4,2X),A4)
36903        CALL DPWRST('XXX','WRIT')
36904        WRITE(ICOUT,55)N
36905   55   FORMAT('N = ',I8)
36906        CALL DPWRST('XXX','WRIT')
36907        DO56I=1,N
36908          WRITE(ICOUT,57)I,Y(I)
36909   57     FORMAT('I,Y(I) = ',I8,G15.7)
36910          CALL DPWRST('XXX','WRIT')
36911   56   CONTINUE
36912      ENDIF
36913C
36914C               ********************************************
36915C               **  STEP 11--                             **
36916C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
36917C               ********************************************
36918C
36919      ISTEPN='11'
36920      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLSL')
36921     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
36922C
36923      NPERC=0
36924      NMIN=3
36925      CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
36926      IF(IERROR.EQ.'YES')GOTO9000
36927C
36928C               ********************************
36929C               **  STEP 41--                 **
36930C               **  CARRY OUT CALCULATIONS    **
36931C               **  FOR SLASH MLE ESTIMATE    **
36932C               ********************************
36933C
36934      ISTEPN='40'
36935      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLSL')
36936     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
36937C
36938      CALL SLAML1(Y,N,MAXNXT,
36939     1            TEMP1,TEMP2,TEMP3,DTEMP1,
36940     1            XMEAN,XSD,XMIN,XMAX,XMED,XMAD,
36941     1            ALOC,ASCALE,
36942     1            ISUBRO,IBUGA3,IERROR)
36943C
36944      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLSL')THEN
36945        ISTEPN='41'
36946        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
36947        WRITE(ICOUT,1201)ALOC,ASCALE
36948 1201   FORMAT('AFTER CALL SLAML1: ALOC,ASCALE = ',2G15.7)
36949        CALL DPWRST('XXX','WRIT')
36950        WRITE(ICOUT,1203)XMEAN,XSD,XMIN,XMAX,XMED,XMAD
36951 1203   FORMAT('XMEAN,XSD,XMIN,XMAX,XMED,XMAD = ',6G15.7)
36952        CALL DPWRST('XXX','WRIT')
36953      ENDIF
36954C
36955      CALL SLALI1(Y,TEMP1,N,ALOC,ASCALE,
36956     1            ALIK,AIC,AICC,BIC,
36957     1            ISUBRO,IBUGA3,IERROR)
36958C
36959      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLSL')THEN
36960        ISTEPN='42'
36961        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
36962        WRITE(ICOUT,1205)ALIK,AIC,AICC,BIC,ALOC,ASCALE
36963 1205   FORMAT('ALIK,AIC,AICC,BIC,ALOC,ASCALE = ',6G15.7)
36964        CALL DPWRST('XXX','WRIT')
36965      ENDIF
36966C
36967      IF(IERROR.EQ.'YES')GOTO9000
36968C
36969C               *********************************
36970C               **   STEP 42--                 **
36971C               **   WRITE OUT EVERYTHING      **
36972C               **   FOR SLASH MLE ESTIMATE    **
36973C               **********************************
36974C
36975      ISTEPN='42'
36976      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLSL')
36977     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
36978C
36979C     PRINT SUMMARY STATISTICS TABLE
36980C
36981      IF(IPRINT.EQ.'OFF')GOTO9000
36982C
36983      NUMDIG=7
36984      IF(IFORSW.EQ.'1')NUMDIG=1
36985      IF(IFORSW.EQ.'2')NUMDIG=2
36986      IF(IFORSW.EQ.'3')NUMDIG=3
36987      IF(IFORSW.EQ.'4')NUMDIG=4
36988      IF(IFORSW.EQ.'5')NUMDIG=5
36989      IF(IFORSW.EQ.'6')NUMDIG=6
36990      IF(IFORSW.EQ.'7')NUMDIG=7
36991      IF(IFORSW.EQ.'8')NUMDIG=8
36992      IF(IFORSW.EQ.'9')NUMDIG=9
36993      IF(IFORSW.EQ.'0')NUMDIG=0
36994      IF(IFORSW.EQ.'E')NUMDIG=-2
36995      IF(IFORSW.EQ.'-2')NUMDIG=-2
36996      IF(IFORSW.EQ.'-3')NUMDIG=-3
36997      IF(IFORSW.EQ.'-4')NUMDIG=-4
36998      IF(IFORSW.EQ.'-5')NUMDIG=-5
36999      IF(IFORSW.EQ.'-6')NUMDIG=-6
37000      IF(IFORSW.EQ.'-7')NUMDIG=-7
37001      IF(IFORSW.EQ.'-8')NUMDIG=-8
37002      IF(IFORSW.EQ.'-9')NUMDIG=-9
37003C
37004      ITITLE='Slash Parameter Estimation'
37005      NCTITL=26
37006      ITEXT(1)='Summary Statistics:'
37007      NCTEXT(1)=19
37008      AVALUE(1)=0.0
37009      IDIGIT(1)=0
37010      ITEXT(2)='Number of Observations:'
37011      NCTEXT(2)=23
37012      AVALUE(2)=REAL(N)
37013      IDIGIT(2)=0
37014      ITEXT(3)='Sample Mean:'
37015      NCTEXT(3)=12
37016      AVALUE(3)=XMEAN
37017      IDIGIT(3)=NUMDIG
37018      ITEXT(4)='Sample Standard Deviation:'
37019      NCTEXT(4)=26
37020      AVALUE(4)=XSD
37021      IDIGIT(4)=NUMDIG
37022      ITEXT(5)='Sample Median:'
37023      NCTEXT(5)=14
37024      AVALUE(5)=XMED
37025      IDIGIT(5)=NUMDIG
37026      ITEXT(6)='Sample Median Absolute Deviation:'
37027      NCTEXT(6)=33
37028      AVALUE(6)=XMAD
37029      IDIGIT(6)=NUMDIG
37030      ITEXT(7)='Sample Minimum:'
37031      NCTEXT(7)=15
37032      AVALUE(7)=XMIN
37033      IDIGIT(7)=NUMDIG
37034      ITEXT(8)='Sample Maximum:'
37035      NCTEXT(8)=15
37036      AVALUE(8)=XMAX
37037      IDIGIT(8)=NUMDIG
37038      ITEXT(9)=' '
37039      NCTEXT(9)=0
37040      AVALUE(9)=0.0
37041      IDIGIT(9)=-1
37042      ICNT=9
37043C
37044      ICNT=ICNT+1
37045      ITEXT(ICNT)='Maximum Likelihood:'
37046      NCTEXT(ICNT)=19
37047      AVALUE(ICNT)=0.0
37048      IDIGIT(ICNT)=-1
37049      ICNT=ICNT+1
37050      ITEXT(ICNT)='Estimate of Location:'
37051      NCTEXT(ICNT)=21
37052      AVALUE(ICNT)=ALOC
37053      IDIGIT(ICNT)=NUMDIG
37054      ICNT=ICNT+1
37055      ITEXT(ICNT)='Estimate of Scale:'
37056      NCTEXT(ICNT)=23
37057      AVALUE(ICNT)=ASCALE
37058      IDIGIT(ICNT)=NUMDIG
37059      ICNT=ICNT+1
37060      ITEXT(ICNT)='Log-likelihood:'
37061      NCTEXT(ICNT)=15
37062      AVALUE(ICNT)=ALIK
37063      IDIGIT(ICNT)=NUMDIG
37064      ICNT=ICNT+1
37065      ITEXT(ICNT)='AIC:'
37066      NCTEXT(ICNT)=4
37067      AVALUE(ICNT)=AIC
37068      IDIGIT(ICNT)=NUMDIG
37069      ICNT=ICNT+1
37070      ITEXT(ICNT)='AICc:'
37071      NCTEXT(ICNT)=5
37072      AVALUE(ICNT)=AICC
37073      IDIGIT(ICNT)=NUMDIG
37074      ICNT=ICNT+1
37075      ITEXT(ICNT)='BIC:'
37076      NCTEXT(ICNT)=4
37077      AVALUE(ICNT)=BIC
37078      IDIGIT(ICNT)=NUMDIG
37079      NUMROW=ICNT
37080      DO2320I=1,NUMROW
37081        NTOT(I)=15
37082 2320 CONTINUE
37083C
37084      IFRST=.TRUE.
37085      ILAST=.TRUE.
37086      NCTITZ=0
37087      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
37088     1            AVALUE,IDIGIT,
37089     1            NTOT,NUMROW,
37090     1            ICAPSW,ICAPTY,ILAST,IFRST,
37091     1            ISUBRO,IBUGA3,IERROR)
37092C
37093C               *****************
37094C               **  STEP 90--  **
37095C               **  EXIT       **
37096C               *****************
37097C
37098 9000 CONTINUE
37099      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLSL')THEN
37100        WRITE(ICOUT,999)
37101        CALL DPWRST('XXX','WRIT')
37102        WRITE(ICOUT,9011)
37103 9011   FORMAT('***** AT THE END       OF DPMLSL--')
37104        CALL DPWRST('XXX','WRIT')
37105        WRITE(ICOUT,9012)N,IBUGA3,IERROR
37106 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
37107        CALL DPWRST('XXX','WRIT')
37108      ENDIF
37109C
37110      RETURN
37111      END
37112      SUBROUTINE DPMLTP(Y,N,IR,DTEMP1,MAXNXT,
37113     1                  GAMMML,AML,ANUML,
37114     1                  ICAPSW,ICAPTY,IFORSW,
37115     1                  ISUBRO,IBUGA3,IERROR)
37116C
37117C     PURPOSE--THIS ROUTINE COMPUTES THE CONDITIONAL MAXIMUM
37118C              LIKELIHOOD ESTIMATES FOR THE TRUNCATED PARETO
37119C              DISTRIBUTION.
37120C
37121C              THE CONDITIONAL MAXIMUM LIKELIHOOD ESTIMATE OF
37122C              NU IS THE DATA MAXIMUM.
37123C
37124C              TO FIND THIS ESTIMATE, SORT THE DATA FROM LARGEST
37125C              TO SMALLEST VALUE.  IF THERE ARE R+1 POINTS, THE
37126C              MAXIMUM LIKELIHOOD ESTIMATE OF GAMMA IS THE SOLUTION
37127C              OF THE EQUATION
37128C
37129C              (R/GAMMAHAT) +
37130C              R*(X(R+1)/X(X(1))**GAMMAHAT*LOG(X(R+1)/X(1))/
37131C              1 - (X(R+1)/X(1))**GAMMAHAT) -
37132C              SUM[i=1 TO R][LOG(X(i) - LN(X(R+1))] = 0
37133C
37134C              THIS TERMINOLOGY IS USED BY ABAN, MEERSCHAERT, AND
37135C              PANORSKA.  THEY BASE THIS ON TAKING THE LARGEST
37136C              R+1 POINTS OUT OF N (I.E., THE TRUNCATED PARETO
37137C              IS FIT TO THE TAILS OF THE DATA).  IN DATAPLOT,
37138C              IF R IS SPECIFIED, IT IS ASUMED THAT WE ARE FITTING
37139C              THE ENTIRE DATA SET.  SO IN THE ABOVE FORMULA,
37140C              X(1) IS THE MAXIMUM AND X(R+1) IS THE MINIMUM
37141C              POINT INCLUDED IN THE COMPUTATION.
37142C
37143C
37144C              ONCE WE HAVE THE ESTIMATE OF GAMMA, THE ESTIMATE
37145C              OF THE LOWER BOUND PARAMETER IS:
37146C
37147C              AHAT = R**(1/GAMMAHAT)*(X(R+1))*
37148C              [N - (N - R)*(X(R+1_/X(1))**GAMMAHAT]**(-1/GAMMAHAT)
37149C
37150C     EXAMPLE--TRUNCATED PARETO MLE Y
37151C     REFERENCES--ABAN, MEERSCHAERT, AND PANORSKA (2006), "PARAMETER
37152C                 ESTIMATION FOR THE TRUNCATED PARETO DISTRIBUTION",
37153C                 JOURNAL OF THE AMERICAN STATISTICAL ASSOCIATION,
37154C                 VOL. 101, NO. 473, PP. 270-277.
37155C     WRITTEN BY--ALAN HECKERT
37156C                 STATISTICAL ENGINEERING DIVISION
37157C                 INFORMATION TECHNOLOGY LABORATORY
37158C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
37159C                 GAITHERSBURG, MD 20899-8980
37160C                 PHONE--301-975-2899
37161C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
37162C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
37163C     LANGUAGE--ANSI FORTRAN (1977)
37164C     VERSION NUMBER--2008/3
37165C     ORIGINAL VERSION--MARCH     2008.
37166C
37167C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
37168C
37169      CHARACTER*4 ICAPSW
37170      CHARACTER*4 ICAPTY
37171      CHARACTER*4 IFORSW
37172      CHARACTER*4 ISUBRO
37173      CHARACTER*4 IBUGA3
37174      CHARACTER*4 IERROR
37175C
37176      CHARACTER*4 ISUBN1
37177      CHARACTER*4 ISUBN2
37178      CHARACTER*4 ISTEPN
37179C
37180C---------------------------------------------------------------------
37181C
37182      DIMENSION Y(*)
37183      DOUBLE PRECISION DTEMP1(*)
37184      DIMENSION QP(1)
37185C
37186      PARAMETER (MAXROW=20)
37187      CHARACTER*60 ITITLE
37188      CHARACTER*1  ITITLZ
37189      CHARACTER*40 ITEXT(MAXROW)
37190      REAL         AVALUE(MAXROW)
37191      INTEGER      NCTEXT(MAXROW)
37192      INTEGER      IDIGIT(MAXROW)
37193      INTEGER      NTOT(MAXROW)
37194      LOGICAL IFRST
37195      LOGICAL ILAST
37196C
37197C---------------------------------------------------------------------
37198C
37199      INCLUDE 'DPCOP2.INC'
37200C
37201C-----START POINT-----------------------------------------------------
37202C
37203      ISUBN1='DPML'
37204      ISUBN2='TP  '
37205      IERROR='NO'
37206C
37207      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLTP')THEN
37208        WRITE(ICOUT,999)
37209  999   FORMAT(1X)
37210        CALL DPWRST('XXX','WRIT')
37211        WRITE(ICOUT,51)
37212   51   FORMAT('**** AT THE BEGINNING OF DPMLTP--')
37213        CALL DPWRST('XXX','WRIT')
37214        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,MAXNXT
37215   52   FORMAT('IBUGA3,ISUBRO,N,MAXNXT = ',2(A4,2X),2I8)
37216        CALL DPWRST('XXX','WRIT')
37217        DO56I=1,MIN(N,100)
37218          WRITE(ICOUT,57)I,Y(I)
37219   57     FORMAT('I,Y(I) = ',I8,G15.7)
37220          CALL DPWRST('XXX','WRIT')
37221   56   CONTINUE
37222      ENDIF
37223C
37224C               ********************************************
37225C               **  STEP 11--                             **
37226C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
37227C               ********************************************
37228C
37229      ISTEPN='11'
37230      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLTP')
37231     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
37232C
37233      NPERC=0
37234      NMIN=4
37235      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
37236      IF(IERROR.EQ.'YES')GOTO9000
37237C
37238      CALL TNPML1(Y,N,IR,DTEMP1,
37239     1            XMEAN,XSD,XMIN,XMAX,
37240     1            AML,ANUML,GAMMML,
37241     1            ISUBRO,IBUGA3,IERROR)
37242C
37243C     PRINT SUMMARY STATISTICS TABLE
37244C
37245      IF(IPRINT.EQ.'OFF')GOTO9000
37246C
37247      NUMDIG=7
37248      IF(IFORSW.EQ.'1')NUMDIG=1
37249      IF(IFORSW.EQ.'2')NUMDIG=2
37250      IF(IFORSW.EQ.'3')NUMDIG=3
37251      IF(IFORSW.EQ.'4')NUMDIG=4
37252      IF(IFORSW.EQ.'5')NUMDIG=5
37253      IF(IFORSW.EQ.'6')NUMDIG=6
37254      IF(IFORSW.EQ.'7')NUMDIG=7
37255      IF(IFORSW.EQ.'8')NUMDIG=8
37256      IF(IFORSW.EQ.'9')NUMDIG=9
37257      IF(IFORSW.EQ.'0')NUMDIG=0
37258      IF(IFORSW.EQ.'E')NUMDIG=-2
37259      IF(IFORSW.EQ.'-2')NUMDIG=-2
37260      IF(IFORSW.EQ.'-3')NUMDIG=-3
37261      IF(IFORSW.EQ.'-4')NUMDIG=-4
37262      IF(IFORSW.EQ.'-5')NUMDIG=-5
37263      IF(IFORSW.EQ.'-6')NUMDIG=-6
37264      IF(IFORSW.EQ.'-7')NUMDIG=-7
37265      IF(IFORSW.EQ.'-8')NUMDIG=-8
37266      IF(IFORSW.EQ.'-9')NUMDIG=-9
37267C
37268      ITITLE='Truncated Pareto Parameter Estimation'
37269      NCTITL=37
37270      ITEXT(1)='Summary Statistics:'
37271      NCTEXT(1)=19
37272      AVALUE(1)=0.0
37273      IDIGIT(1)=0
37274      ITEXT(2)='Number of Observations:'
37275      NCTEXT(2)=23
37276      AVALUE(2)=REAL(N)
37277      IDIGIT(2)=0
37278      ITEXT(3)='Sample Mean:'
37279      NCTEXT(3)=12
37280      AVALUE(3)=XMEAN
37281      IDIGIT(3)=NUMDIG
37282      ITEXT(4)='Sample Standard Deviation:'
37283      NCTEXT(4)=26
37284      AVALUE(4)=XSD
37285      IDIGIT(4)=NUMDIG
37286      ITEXT(5)='Sample Minimum:'
37287      NCTEXT(5)=15
37288      AVALUE(5)=XMIN
37289      IDIGIT(5)=NUMDIG
37290      ITEXT(6)='Sample Minimum:'
37291      NCTEXT(6)=15
37292      AVALUE(6)=XMAX
37293      IDIGIT(6)=NUMDIG
37294      ITEXT(7)=' '
37295      NCTEXT(7)=0
37296      AVALUE(7)=0.0
37297      IDIGIT(7)=-1
37298C
37299      ICNT=8
37300      ITEXT(ICNT)='Conditional Maximum Likelihood:'
37301      NCTEXT(ICNT)=31
37302      AVALUE(ICNT)=0.0
37303      IDIGIT(ICNT)=0
37304      ICNT=ICNT+1
37305      ITEXT(ICNT)='Estimate of Lower Bound (A):'
37306      NCTEXT(ICNT)=28
37307      AVALUE(ICNT)=AML
37308      IDIGIT(ICNT)=NUMDIG
37309      ICNT=ICNT+1
37310      ITEXT(ICNT)='Estimate of Upper Truncation (NU):'
37311      NCTEXT(ICNT)=34
37312      AVALUE(ICNT)=ANUML
37313      IDIGIT(ICNT)=NUMDIG
37314      ICNT=ICNT+1
37315      ITEXT(ICNT)='Estimate of Shape Parameter (Gamma):'
37316      NCTEXT(ICNT)=36
37317      AVALUE(ICNT)=GAMMML
37318      IDIGIT(ICNT)=NUMDIG
37319CCCCC ICNT=ICNT+1
37320CCCCC ITEXT(ICNT)='Log-likelihood:'
37321CCCCC NCTEXT(ICNT)=15
37322CCCCC AVALUE(ICNT)=ALIK
37323CCCCC IDIGIT(ICNT)=NUMDIG
37324CCCCC ICNT=ICNT+1
37325CCCCC ITEXT(ICNT)='AIC:'
37326CCCCC NCTEXT(ICNT)=4
37327CCCCC AVALUE(ICNT)=AIC
37328CCCCC IDIGIT(ICNT)=NUMDIG
37329CCCCC ICNT=ICNT+1
37330CCCCC ITEXT(ICNT)='AICc:'
37331CCCCC NCTEXT(ICNT)=5
37332CCCCC AVALUE(ICNT)=AICC
37333CCCCC IDIGIT(ICNT)=NUMDIG
37334CCCCC ICNT=ICNT+1
37335CCCCC ITEXT(ICNT)='BIC:'
37336CCCCC NCTEXT(ICNT)=4
37337CCCCC AVALUE(ICNT)=BIC
37338CCCCC IDIGIT(ICNT)=NUMDIG
37339      NUMROW=ICNT
37340      DO2320I=1,NUMROW
37341        NTOT(I)=15
37342 2320 CONTINUE
37343C
37344      IFRST=.TRUE.
37345      ILAST=.TRUE.
37346      NCTITZ=0
37347      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
37348     1            AVALUE,IDIGIT,
37349     1            NTOT,NUMROW,
37350     1            ICAPSW,ICAPTY,ILAST,IFRST,
37351     1            ISUBRO,IBUGA3,IERROR)
37352C
37353C               *****************
37354C               **  STEP 90--  **
37355C               **  EXIT       **
37356C               *****************
37357C
37358 9000 CONTINUE
37359      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLTP')THEN
37360        WRITE(ICOUT,999)
37361        CALL DPWRST('XXX','WRIT')
37362        WRITE(ICOUT,9011)
37363 9011   FORMAT('***** AT THE END       OF DPMLTP--')
37364        CALL DPWRST('XXX','WRIT')
37365        WRITE(ICOUT,9012)N,IBUGA3,IERROR
37366 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
37367        CALL DPWRST('XXX','WRIT')
37368        WRITE(ICOUT,9015)N
37369 9015   FORMAT('N = ',I8)
37370        CALL DPWRST('XXX','WRIT')
37371      ENDIF
37372C
37373      RETURN
37374      END
37375      SUBROUTINE DPMLTR(Y,N,
37376     1                  XTEMP,Z,DTEMP1,MAXNXT,
37377     1                  A,B,ALOWQN,AUPPQN,
37378     1                  CML,AML,BML,AQUANT,BQUANT,
37379     1                  ICAPSW,ICAPTY,IFORSW,
37380     1                  ISUBRO,IBUGA3,IERROR)
37381C
37382C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
37383C              FOR THE TRIANGULAR DISTRIBUTION
37384C     EXAMPLE--TRIANGULAR MAXIMUM LIKELIHOOD Y
37385C     REFERENCE--KOTZ AND VAN DORP (2004), "BEYOND BETA: OTHER
37386C                CONTINUOUS FAMILIES OF DISTRIBUTIONS WITH BOUNDED
37387C                SUPPORT AND APPLICATIONS", WORLD SCIENTIFIC,
37388C                CHAPTER 1.
37389C     WRITTEN BY--ALAN HECKERT
37390C                 STATISTICAL ENGINEERING DIVISION
37391C                 INFORMATION TECHNOLOGY LABORATORY
37392C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
37393C                 GAITHERSBUG, MD 20899-8980
37394C                 PHONE--301-975-2899
37395C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
37396C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
37397C     LANGUAGE--ANSI FORTRAN (1977)
37398C     VERSION NUMBER--2007/5
37399C     ORIGINAL VERSION--MAY       2007.
37400C     UPDATED         --JULY      2007. USE ML FOR ESTIMATES
37401C                                       OF LOWER/UPPER BOUNDS
37402C     UPDATED         --JULY      2010. ADD LIKELIHOOD/AIC TO OUTPUT
37403C
37404C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
37405C
37406      CHARACTER*4 ICAPSW
37407      CHARACTER*4 ICAPTY
37408      CHARACTER*4 IFORSW
37409      CHARACTER*4 ISUBRO
37410      CHARACTER*4 IBUGA3
37411      CHARACTER*4 IERROR
37412C
37413      CHARACTER*4 ISUBN1
37414      CHARACTER*4 ISUBN2
37415      CHARACTER*4 ISTEPN
37416C
37417C---------------------------------------------------------------------
37418C
37419      DIMENSION Y(*)
37420      DIMENSION Z(*)
37421      DIMENSION XTEMP(*)
37422      DIMENSION QP(1)
37423      DOUBLE PRECISION DTEMP1(*)
37424C
37425      INCLUDE 'DPCOST.INC'
37426C
37427      PARAMETER (MAXROW=30)
37428      CHARACTER*60 ITITLE
37429      CHARACTER*60 ITITLZ
37430      CHARACTER*40 ITEXT(MAXROW)
37431      REAL         AVALUE(MAXROW)
37432      INTEGER      NCTEXT(MAXROW)
37433      INTEGER      IDIGIT(MAXROW)
37434      INTEGER      NTOT(MAXROW)
37435      LOGICAL IFRST
37436      LOGICAL ILAST
37437C
37438C---------------------------------------------------------------------
37439C
37440      INCLUDE 'DPCOP2.INC'
37441C
37442C-----START POINT-----------------------------------------------------
37443C
37444      ISUBN1='DPML'
37445      ISUBN2='TR  '
37446      IERROR='NO'
37447C
37448      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLTR')THEN
37449        WRITE(ICOUT,999)
37450  999   FORMAT(1X)
37451        CALL DPWRST('XXX','WRIT')
37452        WRITE(ICOUT,51)
37453   51   FORMAT('**** AT THE BEGINNING OF DPMLTR--')
37454        CALL DPWRST('XXX','WRIT')
37455        WRITE(ICOUT,52)IBUGA3,ISUBRO,N
37456   52   FORMAT('IBUGA3,ISUBRO,N = ',A4,2X,A4,2X,I8)
37457        CALL DPWRST('XXX','WRIT')
37458        DO56I=1,MIN(N,100)
37459          WRITE(ICOUT,57)I,Y(I)
37460   57     FORMAT('I,Y(I) = ',I8,G15.7)
37461          CALL DPWRST('XXX','WRIT')
37462   56   CONTINUE
37463      ENDIF
37464C
37465C               ********************************************
37466C               **  STEP 11--                             **
37467C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
37468C               ********************************************
37469C
37470      ISTEPN='11'
37471      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLTR')
37472     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
37473C
37474CCCCC NPERC=3
37475      NPERC=0
37476      NMIN=3
37477      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
37478      IF(IERROR.EQ.'YES')GOTO9000
37479C
37480C               ***************************************************
37481C               **  STEP 21--                                    **
37482C               **  CARRY OUT CALCULATIONS                       **
37483C               **  FOR TRIANGULAR MLE ESTIMATION                **
37484C               ***************************************************
37485C
37486      ISTEPN='21'
37487      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLTR')
37488     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
37489C
37490      CALL TRIML1(Y,N,MAXNXT,
37491     1            Z,XTEMP,DTEMP1,
37492     1            XMIN,XMAX,XMEAN,XSD,
37493     1            A,B,ALOWQN,AUPPQN,
37494     1            AQUANT,BQUANT,
37495     1            AML,BML,CML,
37496     1            ISUBRO,IBUGA3,IERROR)
37497C
37498C               ***********************************************
37499C               **   STEP 42--                               **
37500C               **   WRITE OUT EVERYTHING                    **
37501C               **   FOR TRIANGULAR MLE ESTIMATION           **
37502C               ***********************************************
37503C
37504      ISTEPN='42'
37505      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLTR')
37506     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
37507C
37508      IF(IPRINT.EQ.'OFF')GOTO9000
37509C
37510      NUMDIG=7
37511      IF(IFORSW.EQ.'1')NUMDIG=1
37512      IF(IFORSW.EQ.'2')NUMDIG=2
37513      IF(IFORSW.EQ.'3')NUMDIG=3
37514      IF(IFORSW.EQ.'4')NUMDIG=4
37515      IF(IFORSW.EQ.'5')NUMDIG=5
37516      IF(IFORSW.EQ.'6')NUMDIG=6
37517      IF(IFORSW.EQ.'7')NUMDIG=7
37518      IF(IFORSW.EQ.'8')NUMDIG=8
37519      IF(IFORSW.EQ.'9')NUMDIG=9
37520      IF(IFORSW.EQ.'0')NUMDIG=0
37521      IF(IFORSW.EQ.'E')NUMDIG=-2
37522      IF(IFORSW.EQ.'-2')NUMDIG=-2
37523      IF(IFORSW.EQ.'-3')NUMDIG=-3
37524      IF(IFORSW.EQ.'-4')NUMDIG=-4
37525      IF(IFORSW.EQ.'-5')NUMDIG=-5
37526      IF(IFORSW.EQ.'-6')NUMDIG=-6
37527      IF(IFORSW.EQ.'-7')NUMDIG=-7
37528      IF(IFORSW.EQ.'-8')NUMDIG=-8
37529      IF(IFORSW.EQ.'-9')NUMDIG=-9
37530C
37531      ITITLE='Triangular Parameter Estimation'
37532      NCTITL=31
37533      ITITLZ=' '
37534      NCTITZ=0
37535      ICNT=1
37536      ITEXT(ICNT)='Summary Statistics:'
37537      NCTEXT(ICNT)=19
37538      AVALUE(ICNT)=0.0
37539      IDIGIT(ICNT)=-1
37540      ICNT=ICNT+1
37541      ITEXT(ICNT)='Number of Observations:'
37542      NCTEXT(ICNT)=23
37543      AVALUE(ICNT)=REAL(N)
37544      IDIGIT(ICNT)=0
37545      ICNT=ICNT+1
37546      ITEXT(ICNT)='Sample Mean:'
37547      NCTEXT(ICNT)=12
37548      AVALUE(ICNT)=XMEAN
37549      IDIGIT(ICNT)=NUMDIG
37550      ICNT=ICNT+1
37551      ITEXT(ICNT)='Sample Standard Deviation:'
37552      NCTEXT(ICNT)=26
37553      AVALUE(ICNT)=XSD
37554      IDIGIT(ICNT)=NUMDIG
37555      ICNT=ICNT+1
37556      ITEXT(ICNT)='Sample Minimum:'
37557      NCTEXT(ICNT)=15
37558      AVALUE(ICNT)=XMIN
37559      IDIGIT(ICNT)=NUMDIG
37560      ICNT=ICNT+1
37561      ITEXT(ICNT)='Sample Maximum:'
37562      NCTEXT(ICNT)=15
37563      AVALUE(ICNT)=XMAX
37564      IDIGIT(ICNT)=NUMDIG
37565      ICNT=ICNT+1
37566      ITEXT(ICNT)=' '
37567      NCTEXT(ICNT)=0
37568      AVALUE(ICNT)=0.0
37569      IDIGIT(ICNT)=-1
37570C
37571      ICNT=ICNT+1
37572      ITEXT(ICNT)='Quantile Method for Lower/Upper Limits:'
37573      NCTEXT(ICNT)=39
37574      AVALUE(ICNT)=0.0
37575      IDIGIT(ICNT)=-1
37576      ICNT=ICNT+1
37577      ITEXT(ICNT)='Estimate of Lower Limit:'
37578      NCTEXT(ICNT)=24
37579      AVALUE(ICNT)=AQUANT
37580      IDIGIT(ICNT)=NUMDIG
37581      ICNT=ICNT+1
37582      ITEXT(ICNT)='Estimate of Upper Limit:'
37583      NCTEXT(ICNT)=24
37584      AVALUE(ICNT)=BQUANT
37585      IDIGIT(ICNT)=NUMDIG
37586      ICNT=ICNT+1
37587      ITEXT(ICNT)=' '
37588      NCTEXT(ICNT)=0
37589      AVALUE(ICNT)=0.0
37590      IDIGIT(ICNT)=-1
37591C
37592      ICNT=ICNT+1
37593      ITEXT(ICNT)='Maximum Likelihood:'
37594      NCTEXT(ICNT)=19
37595      AVALUE(ICNT)=0.0
37596      IDIGIT(ICNT)=-1
37597      ICNT=ICNT+1
37598      ITEXT(ICNT)='Estimate of Lower Limit:'
37599      NCTEXT(ICNT)=24
37600      AVALUE(ICNT)=AML
37601      IDIGIT(ICNT)=NUMDIG
37602      ICNT=ICNT+1
37603      ITEXT(ICNT)='Estimate of Upper Limit:'
37604      NCTEXT(ICNT)=24
37605      AVALUE(ICNT)=BML
37606      IDIGIT(ICNT)=NUMDIG
37607      ICNT=ICNT+1
37608      ITEXT(ICNT)='Estimate of Shape:'
37609      NCTEXT(ICNT)=18
37610      AVALUE(ICNT)=CML
37611      IDIGIT(ICNT)=NUMDIG
37612C
37613CCCCC ICNT=ICNT+1
37614CCCCC ITEXT(ICNT)='Log-likelihood:'
37615CCCCC NCTEXT(ICNT)=15
37616CCCCC AVALUE(ICNT)=ALIK
37617CCCCC IDIGIT(ICNT)=-7
37618CCCCC ICNT=ICNT+1
37619CCCCC ITEXT(ICNT)='AIC:'
37620CCCCC NCTEXT(ICNT)=4
37621CCCCC AVALUE(ICNT)=AIC
37622CCCCC IDIGIT(ICNT)=-7
37623CCCCC ICNT=ICNT+1
37624CCCCC ITEXT(ICNT)='AICc:'
37625CCCCC NCTEXT(ICNT)=5
37626CCCCC AVALUE(ICNT)=AICC
37627CCCCC IDIGIT(ICNT)=-7
37628CCCCC ICNT=ICNT+1
37629CCCCC ITEXT(ICNT)='BIC:'
37630CCCCC NCTEXT(ICNT)=4
37631CCCCC AVALUE(ICNT)=BIC
37632CCCCC IDIGIT(ICNT)=-7
37633C
37634      NUMROW=ICNT
37635      DO2320I=1,NUMROW
37636        NTOT(I)=15
37637 2320 CONTINUE
37638C
37639      IFRST=.FALSE.
37640      ILAST=.FALSE.
37641      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
37642     1            AVALUE,IDIGIT,
37643     1            NTOT,NUMROW,
37644     1            ICAPSW,ICAPTY,ILAST,IFRST,
37645     1            ISUBRO,IBUGA3,IERROR)
37646C
37647C               *****************
37648C               **  STEP 90--  **
37649C               **  EXIT       **
37650C               *****************
37651C
37652 9000 CONTINUE
37653      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLTR')THEN
37654        WRITE(ICOUT,999)
37655        CALL DPWRST('XXX','WRIT')
37656        WRITE(ICOUT,9011)
37657 9011   FORMAT('***** AT THE END       OF DPMLTR--')
37658        CALL DPWRST('XXX','WRIT')
37659        WRITE(ICOUT,9012)N,IBUGA3,IERROR
37660 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
37661        CALL DPWRST('XXX','WRIT')
37662        WRITE(ICOUT,9015)N
37663 9015   FORMAT('N = ',I8)
37664        CALL DPWRST('XXX','WRIT')
37665      ENDIF
37666C
37667      RETURN
37668      END
37669      SUBROUTINE DPMLTS(Y,N,ANSV,MAXNXT,
37670     1                  XTEMP,TEMP1,TEMP2,TEMP3,DTEMP1,
37671     1                  THETML,ANML,AML,BML,
37672     1                  ICAPSW,ICAPTY,IFORSW,
37673     1                  ISUBRO,IBUGA3,IERROR)
37674C
37675C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
37676C              ESTIMATES FOR THE TWO-SIDED POWER DISTRIBUTION
37677C     EXAMPLE--TWO-SIDED POWER MAXIMUM LIKELIHOOD Y
37678C     REFERENCES--"THE STANDARD TWO-SIDED POWER DISTRIBUTION AND
37679C                 ITS PROPERTIES WITH APPLICATIONS IN FINANCIAL
37680C                 ENGINEERING", J. RENE VAN DORP AND SAMUEL KOTZ,
37681C                 AMERICAN STATISTICIAN, VOLUME 56,
37682C                 NUMBER 2, MAY, 2002.
37683C               --KOTZ AND VAN DORP (2004), "BEYOND BETA: OTHER
37684C                 CONTINUOUS FAMILIES OF DISTRIBUTIONS WITH BOUNDED
37685C                 SUPPORT AND APPLICATIONS", WORLD SCIENTIFIC,
37686C                 CHAPTER 1.
37687C     WRITTEN BY--JAMES J. FILLIBEN
37688C                 STATISTICAL ENGINEERING DIVISION
37689C                 INFORMATION TECHNOLOGY LABORATORY
37690C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
37691C                 GAITHERSBURG, MD 20899-8980
37692C                 PHONE--301-975-2855
37693C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
37694C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
37695C     LANGUAGE--ANSI FORTRAN (1977)
37696C     VERSION NUMBER--2002/5
37697C     ORIGINAL VERSION--MAY       2002.
37698C     UPDATED         --MARCH     2004. SUPPORT FOR HTML/LATEX OUTPUT
37699C     UPDATED         --AUGUST    2005. REFORMAT OUTPUT FOR CONSISTENCY
37700C                                       WITH OTHER ML ROUTINES
37701C     UPDATED         --JULY      2007. 1) SUPPORT FOR LOWER/UPPER
37702C                                          LIMIT PARAMETERS
37703C                                       2) DIFFERENT ALGORITHMS FOR
37704C                                          CASES WHERE AN <= 1 AND
37705C                                          AN > 1
37706C     UPDATED         --JULY      2010. USE DPDTA1 TO PRINT OUTPUT
37707C     UPDATED         --JULY      2010. EXTRACT POINT ESTIMATES TO
37708C                                       TSPML1
37709C
37710C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
37711C
37712      CHARACTER*4 ICAPSW
37713      CHARACTER*4 ICAPTY
37714      CHARACTER*4 IFORSW
37715      CHARACTER*4 ISUBRO
37716      CHARACTER*4 IBUGA3
37717      CHARACTER*4 IERROR
37718C
37719      CHARACTER*4 ISUBN1
37720      CHARACTER*4 ISUBN2
37721      CHARACTER*4 ISTEPN
37722      CHARACTER*4 IWRITE
37723C
37724C---------------------------------------------------------------------
37725C
37726      DIMENSION Y(*)
37727      DIMENSION XTEMP(*)
37728      DIMENSION TEMP1(*)
37729      DIMENSION TEMP2(*)
37730      DIMENSION TEMP3(*)
37731      DOUBLE PRECISION DTEMP1(*)
37732C
37733      DIMENSION QP(1)
37734C
37735      PARAMETER (MAXROW=20)
37736      CHARACTER*60 ITITLE
37737      CHARACTER*60 ITITLZ
37738      CHARACTER*50 ITEXT(MAXROW)
37739      REAL         AVALUE(MAXROW)
37740      INTEGER      NCTEXT(MAXROW)
37741      INTEGER      IDIGIT(MAXROW)
37742      INTEGER      NTOT(MAXROW)
37743      LOGICAL IFRST
37744      LOGICAL ILAST
37745C
37746C---------------------------------------------------------------------
37747C
37748      INCLUDE 'DPCOP2.INC'
37749C
37750C-----START POINT-----------------------------------------------------
37751C
37752      ISUBN1='DPML'
37753      ISUBN2='TS  '
37754      IERROR='NO'
37755C
37756      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLTS')THEN
37757        WRITE(ICOUT,999)
37758  999   FORMAT(1X)
37759        CALL DPWRST('XXX','WRIT')
37760        WRITE(ICOUT,51)
37761   51   FORMAT('**** AT THE BEGINNING OF DPMLTS--')
37762        CALL DPWRST('XXX','WRIT')
37763        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,MAXNXT,ANSV
37764   52   FORMAT('IBUGA3,ISUBRO,N,ANSV = ',2(A4,2X),2I8,G15.7)
37765        CALL DPWRST('XXX','WRIT')
37766        DO56I=1,MIN(N,100)
37767          WRITE(ICOUT,57)I,Y(I)
37768   57     FORMAT('I,Y(I) = ',I8,G15.7)
37769          CALL DPWRST('XXX','WRIT')
37770   56   CONTINUE
37771      ENDIF
37772C
37773C               ********************************************
37774C               **  STEP 11--                             **
37775C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
37776C               ********************************************
37777C
37778      ISTEPN='11'
37779      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLTS')
37780     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
37781C
37782      NPERC=0
37783      NMIN=4
37784      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
37785      IF(IERROR.EQ.'YES')GOTO9000
37786C
37787CCCCC JULY 2007.  ROUTINE WILL NOW ESTIMATE LOWER/UPPER BOUNDS
37788CCCCC             VIA MAXIMUM LIKELIHOOD.
37789C
37790CCCCC DO1145I=1,N
37791CCCCC   IF(Y(I).LE.A .OR. Y(I).GE.B)THEN
37792CCCCC     WRITE(ICOUT,999)
37793CCCCC     CALL DPWRST('XXX','WRIT')
37794CCCCC     WRITE(ICOUT,1141)
37795C1141     FORMAT('***** ERROR FROM TWO-SIDED POWER MAXIMUM ',
37796CCCCC1           'LIKELIHOOD--')
37797CCCCC     CALL DPWRST('XXX','WRIT')
37798CCCCC     WRITE(ICOUT,1142)I
37799C1142     FORMAT('      ELEMENT ',I8,' OF THE INPUT VARIABLE')
37800CCCCC     CALL DPWRST('XXX','WRIT')
37801CCCCC     WRITE(ICOUT,1143)A,B
37802C1143     FORMAT('      IS OUTSIDE THE ALLOWABLE (',
37803CCCCC1           G15.7,',',G15.7,') ','INTERVAL.')
37804CCCCC     CALL DPWRST('XXX','WRIT')
37805CCCCC     WRITE(ICOUT,1144)Y(I)
37806C1144     FORMAT('      IT HAS THE VALUE ',E15.7)
37807CCCCC     CALL DPWRST('XXX','WRIT')
37808CCCCC     IERROR='YES'
37809CCCCC     GOTO9000
37810CCCCC   ENDIF
37811C1145 CONTINUE
37812C
37813C               **********************************
37814C               **  STEP 21--                   **
37815C               **  CARRY OUT CALCULATIONS      **
37816C               **  FOR TWO-SIDED POWER    MLE  **
37817C               **  ESTIMATE (FULL SAMPLE CASE) **
37818C               **********************************
37819C
37820      ISTEPN='41'
37821      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLTS')
37822     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
37823C
37824      IWRITE='NO'
37825      IERROR='NO'
37826C
37827      CALL TSPML1(Y,N,XTEMP,TEMP1,TEMP2,TEMP3,DTEMP1,
37828     1            XMIN,XMAX,XMEAN,XSD,
37829     1            AML,BML,THETML,ANML,
37830     1            ISUBRO,IBUGA3,IERROR)
37831C
37832C               ********************************************
37833C               **   STEP 42--                            **
37834C               **   WRITE OUT EVERYTHING                 **
37835C               **   FOR TWO-SIDED POWER MLE ESTIMATION   **
37836C               ********************************************
37837C
37838      ISTEPN='42'
37839      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLTS')
37840     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
37841C
37842      IF(IPRINT.EQ.'OFF')GOTO9000
37843C
37844      NUMDIG=7
37845      IF(IFORSW.EQ.'1')NUMDIG=1
37846      IF(IFORSW.EQ.'2')NUMDIG=2
37847      IF(IFORSW.EQ.'3')NUMDIG=3
37848      IF(IFORSW.EQ.'4')NUMDIG=4
37849      IF(IFORSW.EQ.'5')NUMDIG=5
37850      IF(IFORSW.EQ.'6')NUMDIG=6
37851      IF(IFORSW.EQ.'7')NUMDIG=7
37852      IF(IFORSW.EQ.'8')NUMDIG=8
37853      IF(IFORSW.EQ.'9')NUMDIG=9
37854      IF(IFORSW.EQ.'0')NUMDIG=0
37855      IF(IFORSW.EQ.'E')NUMDIG=-2
37856      IF(IFORSW.EQ.'-2')NUMDIG=-2
37857      IF(IFORSW.EQ.'-3')NUMDIG=-3
37858      IF(IFORSW.EQ.'-4')NUMDIG=-4
37859      IF(IFORSW.EQ.'-5')NUMDIG=-5
37860      IF(IFORSW.EQ.'-6')NUMDIG=-6
37861      IF(IFORSW.EQ.'-7')NUMDIG=-7
37862      IF(IFORSW.EQ.'-8')NUMDIG=-8
37863      IF(IFORSW.EQ.'-9')NUMDIG=-9
37864C
37865      ITITLE='4-Parameter Two-Sided Power Parameter Estimation:'
37866      NCTITL=49
37867      ITITLZ='Full Sample Case'
37868      NCTITZ=16
37869      ICNT=1
37870      ITEXT(ICNT)='Summary Statistics:'
37871      NCTEXT(ICNT)=19
37872      AVALUE(ICNT)=0.0
37873      IDIGIT(ICNT)=-1
37874      ICNT=ICNT+1
37875      ITEXT(ICNT)='Number of Observations:'
37876      NCTEXT(ICNT)=23
37877      AVALUE(ICNT)=REAL(N)
37878      IDIGIT(ICNT)=0
37879      ICNT=ICNT+1
37880      ITEXT(ICNT)='Sample Mean:'
37881      NCTEXT(ICNT)=12
37882      AVALUE(ICNT)=XMEAN
37883      IDIGIT(ICNT)=NUMDIG
37884      ICNT=ICNT+1
37885      ITEXT(ICNT)='Sample Standard Deviation:'
37886      NCTEXT(ICNT)=26
37887      AVALUE(ICNT)=XSD
37888      IDIGIT(ICNT)=NUMDIG
37889      ICNT=ICNT+1
37890      ITEXT(ICNT)='Sample Minimum:'
37891      NCTEXT(ICNT)=15
37892      AVALUE(ICNT)=XMIN
37893      IDIGIT(ICNT)=NUMDIG
37894      ICNT=ICNT+1
37895      ITEXT(ICNT)='Sample Maximum:'
37896      NCTEXT(ICNT)=15
37897      AVALUE(ICNT)=XMAX
37898      IDIGIT(ICNT)=NUMDIG
37899      ICNT=ICNT+1
37900      ITEXT(ICNT)=' '
37901      NCTEXT(ICNT)=0
37902      AVALUE(ICNT)=0.0
37903      IDIGIT(ICNT)=-1
37904C
37905      ICNT=ICNT+1
37906      ITEXT(ICNT)='Maximum Likelihood:'
37907      NCTEXT(ICNT)=19
37908      AVALUE(ICNT)=0.0
37909      IDIGIT(ICNT)=-1
37910      ICNT=ICNT+1
37911      ITEXT(ICNT)='Estimate of Lower Limit:'
37912      NCTEXT(ICNT)=24
37913      AVALUE(ICNT)=AML
37914      IDIGIT(ICNT)=NUMDIG
37915      ICNT=ICNT+1
37916      ITEXT(ICNT)='Estimate of Upper Limit:'
37917      NCTEXT(ICNT)=24
37918      AVALUE(ICNT)=BML
37919      IDIGIT(ICNT)=NUMDIG
37920      ICNT=ICNT+1
37921      ITEXT(ICNT)='Estimate of Shape Parameter Theta:'
37922      NCTEXT(ICNT)=34
37923      AVALUE(ICNT)=THETML
37924      IDIGIT(ICNT)=NUMDIG
37925      ICNT=ICNT+1
37926      ITEXT(ICNT)='Estimate of Shape Parameter Nu:'
37927      NCTEXT(ICNT)=31
37928      AVALUE(ICNT)=ANML
37929      IDIGIT(ICNT)=NUMDIG
37930      ICNT=ICNT+1
37931      ITEXT(ICNT)=' '
37932      NCTEXT(ICNT)=0
37933      AVALUE(ICNT)=0.0
37934      IDIGIT(ICNT)=-1
37935C
37936CCCCC ICNT=ICNT+1
37937CCCCC ITEXT(ICNT)='Log-likelihood:'
37938CCCCC NCTEXT(ICNT)=15
37939CCCCC AVALUE(ICNT)=ALIKML
37940CCCCC IDIGIT(ICNT)=-7
37941CCCCC ICNT=ICNT+1
37942CCCCC ITEXT(ICNT)='AIC:'
37943CCCCC NCTEXT(ICNT)=4
37944CCCCC AVALUE(ICNT)=AICML
37945CCCCC IDIGIT(ICNT)=-7
37946CCCCC ICNT=ICNT+1
37947CCCCC ITEXT(ICNT)='AICc:'
37948CCCCC NCTEXT(ICNT)=5
37949CCCCC AVALUE(ICNT)=AICCML
37950CCCCC IDIGIT(ICNT)=-7
37951CCCCC ICNT=ICNT+1
37952CCCCC ITEXT(ICNT)='BIC:'
37953CCCCC NCTEXT(ICNT)=4
37954CCCCC AVALUE(ICNT)=BICML
37955CCCCC IDIGIT(ICNT)=-7
37956C
37957      NUMROW=ICNT
37958      DO2320I=1,NUMROW
37959        NTOT(I)=15
37960 2320 CONTINUE
37961C
37962      IFRST=.TRUE.
37963      ILAST=.TRUE.
37964      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
37965     1            AVALUE,IDIGIT,
37966     1            NTOT,NUMROW,
37967     1            ICAPSW,ICAPTY,ILAST,IFRST,
37968     1            ISUBRO,IBUGA3,IERROR)
37969C
37970C               *****************
37971C               **  STEP 90--  **
37972C               **  EXIT       **
37973C               *****************
37974C
37975 9000 CONTINUE
37976      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLTS')THEN
37977        WRITE(ICOUT,999)
37978        CALL DPWRST('XXX','WRIT')
37979        WRITE(ICOUT,9011)
37980 9011   FORMAT('***** AT THE END       OF DPMLTS--')
37981        CALL DPWRST('XXX','WRIT')
37982        WRITE(ICOUT,9012)N,IBUGA3,IERROR
37983 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
37984        CALL DPWRST('XXX','WRIT')
37985        WRITE(ICOUT,9015)N
37986 9015   FORMAT('N = ',I8)
37987        CALL DPWRST('XXX','WRIT')
37988      ENDIF
37989C
37990      RETURN
37991      END
37992      SUBROUTINE DPMLTO(Y,N,TEMP1,A,B,
37993     1                  SHAPML,
37994     1                  ICAPSW,ICAPTY,IFORSW,
37995     1                  ISUBRO,IBUGA3,IERROR)
37996C
37997C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
37998C              ESTIMATES FOR THE TOPP AND LEONE DISTRIBUTION
37999C     EXAMPLE--TOPP AND LEONE MAXIMUM LIKELIHOOD Y
38000C     REFERENCE --KOTZ AND VAN DORP (2004), "BEYOND BETA: OTHER
38001C                 CONTINUOUS FAMILIES OF DISTRIBUTIONS WITH
38002C                 BOUNDED SUPPORT AND APPLICATIONS", WORLD
38003C                 SCIENTIFIC PUBLISHING CO., PP. 33-43.
38004C     WRITTEN BY--ALAN HECKERT
38005C                 STATISTICAL ENGINEERING DIVISION
38006C                 INFORMATION TECHNOLOGY LABORATORY
38007C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
38008C                 GAITHERSBURG, MD 20899-8980
38009C                 PHONE--301-975-2899
38010C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
38011C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
38012C     LANGUAGE--ANSI FORTRAN (1977)
38013C     VERSION NUMBER--2007/2
38014C     ORIGINAL VERSION--FEBRUARY  2007.
38015C     UPDATED         --JULY      2010. ADD LIKELIHOOD/AIC TO OUTPUT
38016C
38017C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
38018C
38019      CHARACTER*4 ICAPSW
38020      CHARACTER*4 ICAPTY
38021      CHARACTER*4 IFORSW
38022      CHARACTER*4 ISUBRO
38023      CHARACTER*4 IBUGA3
38024      CHARACTER*4 IERROR
38025C
38026      CHARACTER*4 ISUBN1
38027      CHARACTER*4 ISUBN2
38028      CHARACTER*4 ISTEPN
38029      CHARACTER*4 IWRITE
38030C
38031C---------------------------------------------------------------------
38032C
38033      DIMENSION Y(*)
38034      DIMENSION TEMP1(*)
38035      DIMENSION QP(1)
38036C
38037      INCLUDE 'DPCOST.INC'
38038C
38039      PARAMETER (MAXROW=20)
38040      CHARACTER*60 ITITLE
38041      CHARACTER*60 ITITLZ
38042      CHARACTER*40 ITEXT(MAXROW)
38043      REAL         AVALUE(MAXROW)
38044      INTEGER      NCTEXT(MAXROW)
38045      INTEGER      IDIGIT(MAXROW)
38046      INTEGER      NTOT(MAXROW)
38047      LOGICAL IFRST
38048      LOGICAL ILAST
38049C
38050C---------------------------------------------------------------------
38051C
38052      INCLUDE 'DPCOP2.INC'
38053C
38054C-----START POINT-----------------------------------------------------
38055C
38056      ISUBN1='DPML'
38057      ISUBN2='TO  '
38058      IERROR='NO'
38059C
38060      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLTO')THEN
38061        WRITE(ICOUT,999)
38062  999   FORMAT(1X)
38063        CALL DPWRST('XXX','WRIT')
38064        WRITE(ICOUT,51)
38065   51   FORMAT('**** AT THE BEGINNING OF DPMLTO--')
38066        CALL DPWRST('XXX','WRIT')
38067        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,A,B
38068   52   FORMAT('IBUGA3,ISUBRO,N,A,B = ',2(A4,2X),I8,2G15.7)
38069        CALL DPWRST('XXX','WRIT')
38070        DO56I=1,MIN(N,100)
38071          WRITE(ICOUT,57)I,Y(I)
38072   57     FORMAT('I,Y(I) = ',I8,E15.7)
38073          CALL DPWRST('XXX','WRIT')
38074   56   CONTINUE
38075      ENDIF
38076C
38077C               ********************************************
38078C               **  STEP 11--                             **
38079C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
38080C               ********************************************
38081C
38082      ISTEPN='11'
38083      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLTO')
38084     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
38085C
38086      NPERC=0
38087      NMIN=3
38088      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
38089      IF(IERROR.EQ.'YES')GOTO9000
38090C
38091C               **********************************
38092C               **  STEP 21--                   **
38093C               **  CARRY OUT CALCULATIONS      **
38094C               **  FOR TOPP AND LEONE    MLE   **
38095C               **  ESTIMATE (FULL SAMPLE CASE) **
38096C               **********************************
38097C
38098      ISTEPN='41'
38099      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLTO')
38100     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
38101C
38102      IERROR='NO'
38103      IWRITE='OFF'
38104C
38105      DO1010I=1,N
38106        TEMP1(I)=Y(I)
381071010  CONTINUE
38108      CALL TOPML1(TEMP1,N,A,B,
38109     1            XMIN,XMAX,XMEAN,XSD,
38110     1            SHAPML,ZLOC,ZSCALE,
38111     1            ISUBRO,IBUGA3,IERROR)
38112      ALOC=ZLOC
38113      ASCALE=ZLOC + ZSCALE
38114      IF(ASCALE.LE.0.0 .OR. SHAPML.LE.0.0)IERROR='YES'
38115      IF(IERROR.EQ.'YES')GOTO9000
38116C
38117      ALIK=CPUMIN
38118      AIC=CPUMIN
38119      AICC=CPUMIN
38120      BIC=CPUMIN
38121C
38122      CALL TOPLI1(Y,N,TEMP1,SHAPML,ALOC,ASCALE,
38123     1            ALIK,AIC,AICC,BIC,
38124     1            ISUBRO,IBUGA3,IERROR)
38125C
38126C               ***********************************************
38127C               **   STEP 42--                               **
38128C               **   WRITE OUT EVERYTHING                    **
38129C               **   FOR TOPP AND LEONE MLE ESTIMATION       **
38130C               ***********************************************
38131C
38132      ISTEPN='42'
38133      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLTO')
38134     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
38135C
38136      IF(IPRINT.EQ.'OFF')GOTO9000
38137C
38138      NUMDIG=7
38139      IF(IFORSW.EQ.'1')NUMDIG=1
38140      IF(IFORSW.EQ.'2')NUMDIG=2
38141      IF(IFORSW.EQ.'3')NUMDIG=3
38142      IF(IFORSW.EQ.'4')NUMDIG=4
38143      IF(IFORSW.EQ.'5')NUMDIG=5
38144      IF(IFORSW.EQ.'6')NUMDIG=6
38145      IF(IFORSW.EQ.'7')NUMDIG=7
38146      IF(IFORSW.EQ.'8')NUMDIG=8
38147      IF(IFORSW.EQ.'9')NUMDIG=9
38148      IF(IFORSW.EQ.'0')NUMDIG=0
38149      IF(IFORSW.EQ.'E')NUMDIG=-2
38150      IF(IFORSW.EQ.'-2')NUMDIG=-2
38151      IF(IFORSW.EQ.'-3')NUMDIG=-3
38152      IF(IFORSW.EQ.'-4')NUMDIG=-4
38153      IF(IFORSW.EQ.'-5')NUMDIG=-5
38154      IF(IFORSW.EQ.'-6')NUMDIG=-6
38155      IF(IFORSW.EQ.'-7')NUMDIG=-7
38156      IF(IFORSW.EQ.'-8')NUMDIG=-8
38157      IF(IFORSW.EQ.'-9')NUMDIG=-9
38158C
38159      ITITLE='Topp and Leone Parameter Estimation'
38160      NCTITL=35
38161      ITITLZ=' '
38162      NCTITZ=0
38163      ICNT=1
38164      ITEXT(ICNT)='Summary Statistics:'
38165      NCTEXT(ICNT)=19
38166      AVALUE(ICNT)=0.0
38167      IDIGIT(ICNT)=-1
38168      ICNT=ICNT+1
38169      ITEXT(ICNT)='Number of Observations:'
38170      NCTEXT(ICNT)=23
38171      AVALUE(ICNT)=REAL(N)
38172      IDIGIT(ICNT)=0
38173      ICNT=ICNT+1
38174      ITEXT(ICNT)='Sample Mean:'
38175      NCTEXT(ICNT)=12
38176      AVALUE(ICNT)=XMEAN
38177      IDIGIT(ICNT)=NUMDIG
38178      ICNT=ICNT+1
38179      ITEXT(ICNT)='Sample Standard Deviation:'
38180      NCTEXT(ICNT)=26
38181      AVALUE(ICNT)=XSD
38182      IDIGIT(ICNT)=NUMDIG
38183      ICNT=ICNT+1
38184      ITEXT(ICNT)='Sample Minimum:'
38185      NCTEXT(ICNT)=15
38186      AVALUE(ICNT)=XMIN
38187      IDIGIT(ICNT)=NUMDIG
38188      ICNT=ICNT+1
38189      ITEXT(ICNT)='Sample Maximum:'
38190      NCTEXT(ICNT)=15
38191      AVALUE(ICNT)=XMAX
38192      IDIGIT(ICNT)=NUMDIG
38193      ICNT=ICNT+1
38194      ITEXT(ICNT)='Value Used for Lower Limit:'
38195      NCTEXT(ICNT)=27
38196      AVALUE(ICNT)=ALOC
38197      IDIGIT(ICNT)=NUMDIG
38198      ICNT=ICNT+1
38199      ITEXT(ICNT)='Value Used for Upper Limit:'
38200      NCTEXT(ICNT)=27
38201      AVALUE(ICNT)=ASCALE
38202      IDIGIT(ICNT)=NUMDIG
38203      ICNT=ICNT+1
38204      ITEXT(ICNT)=' '
38205      NCTEXT(ICNT)=0
38206      AVALUE(ICNT)=0.0
38207      IDIGIT(ICNT)=-1
38208C
38209      ICNT=ICNT+1
38210      ITEXT(ICNT)='Maximum Likelihood:'
38211      NCTEXT(ICNT)=19
38212      AVALUE(ICNT)=0.0
38213      IDIGIT(ICNT)=-1
38214      ICNT=ICNT+1
38215      ITEXT(ICNT)='Estimate of Shape (Beta):'
38216      NCTEXT(ICNT)=25
38217      AVALUE(ICNT)=SHAPML
38218      IDIGIT(ICNT)=NUMDIG
38219C
38220      IF(ALIK.NE.CPUMIN)THEN
38221        ICNT=ICNT+1
38222        ITEXT(ICNT)='Log-likelihood:'
38223        NCTEXT(ICNT)=15
38224        AVALUE(ICNT)=ALIK
38225        IDIGIT(ICNT)=-7
38226        ICNT=ICNT+1
38227        ITEXT(ICNT)='AIC:'
38228        NCTEXT(ICNT)=4
38229        AVALUE(ICNT)=AIC
38230        IDIGIT(ICNT)=-7
38231        ICNT=ICNT+1
38232        ITEXT(ICNT)='AICc:'
38233        NCTEXT(ICNT)=5
38234        AVALUE(ICNT)=AICC
38235        IDIGIT(ICNT)=-7
38236        ICNT=ICNT+1
38237        ITEXT(ICNT)='BIC:'
38238        NCTEXT(ICNT)=4
38239        AVALUE(ICNT)=BIC
38240        IDIGIT(ICNT)=-7
38241      ENDIF
38242C
38243      NUMROW=ICNT
38244      DO2320I=1,NUMROW
38245        NTOT(I)=15
38246 2320 CONTINUE
38247C
38248      IFRST=.FALSE.
38249      ILAST=.FALSE.
38250      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
38251     1            AVALUE,IDIGIT,
38252     1            NTOT,NUMROW,
38253     1            ICAPSW,ICAPTY,ILAST,IFRST,
38254     1            ISUBRO,IBUGA3,IERROR)
38255C
38256C               *****************
38257C               **  STEP 90--  **
38258C               **  EXIT       **
38259C               *****************
38260C
38261 9000 CONTINUE
38262      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLTO')THEN
38263        WRITE(ICOUT,999)
38264        CALL DPWRST('XXX','WRIT')
38265        WRITE(ICOUT,9011)
38266 9011   FORMAT('***** AT THE END       OF DPMLTO--')
38267        CALL DPWRST('XXX','WRIT')
38268        WRITE(ICOUT,9012)N,IBUGA3,IERROR
38269 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
38270        CALL DPWRST('XXX','WRIT')
38271        WRITE(ICOUT,9015)N
38272 9015   FORMAT('N = ',I8)
38273        CALL DPWRST('XXX','WRIT')
38274      ENDIF
38275C
38276      RETURN
38277      END
38278      SUBROUTINE DPMLUN(Y,N,
38279     1                  XTEMP,MAXNXT,
38280     1                  ALOWLI,AUPPLI,ALOCML,ASCAML,AHAT,HHAT,
38281     1                  ALOWL2,AUPPL2,ALOCMO,ASCAMO,
38282     1                  ICAPSW,ICAPTY,IFORSW,
38283     1                  ISUBRO,IBUGA3,IERROR)
38284C
38285C     PURPOSE--THIS ROUTINE COMPUTES THE METHOD OF MOMENT AND
38286C              MAXIMUM LIKELIHOOD ESTIMATES FOR THE LOWER AND UPPER
38287C              LIMITS OF THE UNIFORM DISTRIBUTION
38288C     EXAMPLE--UNIFORM MOMENTS Y
38289C     REFERENCE--EVANS, HASTINGS, AND PEACOCK.  "STATISTICAL
38290C                DISTRIBUTIONS", THIRD EDITION, WILEY, 2000,
38291C                PP. 170-174
38292C                JOHNSON, KOTZ, AND BALAKRISHNAN.  "CONTINUOUS
38293C                UNIVARIATE DISTRIBUTIONS, VOLUME II", SECOND
38294C                EDITION, WILEY, 1994.
38295C     WRITTEN BY--ALAN HECKERT
38296C                 STATISTICAL ENGINEERING DIVISION
38297C                 INFORMATION TECHNOLOGY LABORATORY
38298C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
38299C                 GAITHERSBURG, MD 20899-8980
38300C                 PHONE--301-975-2899
38301C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
38302C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
38303C     LANGUAGE--ANSI FORTRAN (1977)
38304C     VERSION NUMBER--2003/10
38305C     ORIGINAL VERSION--OCTOBER   2003.
38306C     UPDATED         --JULY      2005. ADD LOCATION/SCALE ESTIMATES
38307C                                       TO OUTPUT
38308C     UPDATED         --OCTOBER   2009. EXTRACTED SOME CODE TO UNIML1
38309C                                       (MAKE IT EASIER FOR OTHER
38310C                                       ROUTINES TO OBTAIN THE ML
38311C                                       ESTIMATES)
38312C     UPDATED         --OCTOBER   2009. USE DPDTA1, DPDTA2 TO PRINT
38313C                                       ML OUTPUT
38314C
38315C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
38316C
38317      CHARACTER*4 ICAPSW
38318      CHARACTER*4 ICAPTY
38319      CHARACTER*4 IFORSW
38320      CHARACTER*4 ISUBRO
38321      CHARACTER*4 IBUGA3
38322      CHARACTER*4 IERROR
38323C
38324      CHARACTER*4 IWRITE
38325C
38326      CHARACTER*4 ISUBN1
38327      CHARACTER*4 ISUBN2
38328      CHARACTER*4 ISTEPN
38329C
38330C---------------------------------------------------------------------
38331C
38332CCCCC DOUBLE PRECISION DSUM
38333CCCCC DOUBLE PRECISION DTERM1
38334C
38335      DIMENSION Y(*)
38336      DIMENSION XTEMP(*)
38337C
38338      INCLUDE 'DPCOST.INC'
38339C
38340      PARAMETER (NUMALP=8)
38341CCCCC REAL ALPHA(NUMALP)
38342      REAL QP(1)
38343C
38344      PARAMETER (MAXROW=50)
38345      CHARACTER*60 ITITLE
38346      CHARACTER*1  ITITLZ
38347      CHARACTER*40 ITEXT(MAXROW)
38348      REAL         AVALUE(MAXROW)
38349      INTEGER      NCTEXT(MAXROW)
38350      INTEGER      IDIGIT(MAXROW)
38351      INTEGER      NTOT(MAXROW)
38352      LOGICAL IFRST
38353      LOGICAL ILAST
38354C
38355C---------------------------------------------------------------------
38356C
38357      INCLUDE 'DPCOP2.INC'
38358C
38359CCCCC DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
38360C
38361C-----START POINT-----------------------------------------------------
38362C
38363      ISUBN1='DPML'
38364      ISUBN2='UN  '
38365      IERROR='NO'
38366C
38367      ALOWL2=CPUMIN
38368      AUPPL2=CPUMIN
38369      XTEMP(1)=0.0
38370C
38371      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLUN')THEN
38372        WRITE(ICOUT,999)
38373  999   FORMAT(1X)
38374        CALL DPWRST('XXX','WRIT')
38375        WRITE(ICOUT,51)
38376   51   FORMAT('**** AT THE BEGINNING OF DPMLUN--')
38377        CALL DPWRST('XXX','WRIT')
38378        WRITE(ICOUT,52)IBUGA3,N,MAXNXT
38379   52   FORMAT('IBUGA3,N,MAXNXT = ',A4,2X,2I8)
38380        CALL DPWRST('XXX','WRIT')
38381        DO56I=1,MIN(N,100)
38382          WRITE(ICOUT,57)I,Y(I)
38383   57     FORMAT('I,Y(I) = ',I8,E15.7)
38384          CALL DPWRST('XXX','WRIT')
38385   56   CONTINUE
38386      ENDIF
38387C
38388C               ********************************************
38389C               **  STEP 11--                             **
38390C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
38391C               ********************************************
38392C
38393      ISTEPN='11'
38394      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLUN')
38395     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
38396C
38397      NMIN=2
38398      NPERC=0
38399      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
38400      IF(IERROR.EQ.'YES')GOTO9000
38401C
38402C               *******************************
38403C               **  STEP 41--                **
38404C               **  CARRY OUT CALCULATIONS   **
38405C               **  FOR UNIFORM MLE ESTIMATE **
38406C               *******************************
38407C
38408      ISTEPN='41'
38409      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLUN')
38410     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
38411C
38412      IERROR='NO'
38413      IWRITE='OFF'
38414      CALL UNIML1(Y,N,
38415     1            XMIN,XMAX,XMEAN,XSD,XRANG,XMIDR,
38416     1            ALOWLI,AUPPLI,AHAT,HHAT,ALO2LI,AUP2LI,
38417     1            ALOCMO,ASCAMO,ALOCML,ASCAML,
38418     1            ISUBRO,IBUGA3,IERROR)
38419C
38420      CALL UNILI1(Y,N,ALOWLI,AUPPLI,
38421     1            ALIK,AIC,AICC,BIC,
38422     1            ISUBRO,IBUGA3,IERROR)
38423C
38424C               *********************************
38425C               **   STEP 42--                 **
38426C               **   WRITE OUT EVERYTHING      **
38427C               **   FOR UNIFORM MLE ESTIMATE   **
38428C               **********************************
38429C
38430      ISTEPN='42'
38431      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLUN')
38432     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
38433C
38434C     PRINT SUMMARY STATISTICS TABLE
38435C
38436      IF(IPRINT.EQ.'OFF')GOTO9000
38437C
38438      NUMDIG=7
38439      IF(IFORSW.EQ.'1')NUMDIG=1
38440      IF(IFORSW.EQ.'2')NUMDIG=2
38441      IF(IFORSW.EQ.'3')NUMDIG=3
38442      IF(IFORSW.EQ.'4')NUMDIG=4
38443      IF(IFORSW.EQ.'5')NUMDIG=5
38444      IF(IFORSW.EQ.'6')NUMDIG=6
38445      IF(IFORSW.EQ.'7')NUMDIG=7
38446      IF(IFORSW.EQ.'8')NUMDIG=8
38447      IF(IFORSW.EQ.'9')NUMDIG=9
38448      IF(IFORSW.EQ.'0')NUMDIG=0
38449      IF(IFORSW.EQ.'E')NUMDIG=-2
38450      IF(IFORSW.EQ.'-2')NUMDIG=-2
38451      IF(IFORSW.EQ.'-3')NUMDIG=-3
38452      IF(IFORSW.EQ.'-4')NUMDIG=-4
38453      IF(IFORSW.EQ.'-5')NUMDIG=-5
38454      IF(IFORSW.EQ.'-6')NUMDIG=-6
38455      IF(IFORSW.EQ.'-7')NUMDIG=-7
38456      IF(IFORSW.EQ.'-8')NUMDIG=-8
38457      IF(IFORSW.EQ.'-9')NUMDIG=-9
38458C
38459      ITITLE='Uniform Parameter Estimation'
38460      NCTITL=28
38461      ITEXT(1)='Summary Statistics:'
38462      NCTEXT(1)=19
38463      AVALUE(1)=0.0
38464      IDIGIT(1)=0
38465      ITEXT(2)='Number of Observations:'
38466      NCTEXT(2)=23
38467      AVALUE(2)=REAL(N)
38468      IDIGIT(2)=0
38469      ITEXT(3)='Sample Mean:'
38470      NCTEXT(3)=12
38471      AVALUE(3)=XMEAN
38472      IDIGIT(3)=NUMDIG
38473      ITEXT(4)='Sample Standard Deviation:'
38474      NCTEXT(4)=26
38475      AVALUE(4)=XSD
38476      IDIGIT(4)=NUMDIG
38477      ITEXT(5)='Sample Minimum:'
38478      NCTEXT(5)=15
38479      AVALUE(5)=XMIN
38480      IDIGIT(5)=NUMDIG
38481      ITEXT(6)='Sample Maximum:'
38482      NCTEXT(6)=15
38483      AVALUE(6)=XMAX
38484      IDIGIT(6)=NUMDIG
38485      ITEXT(7)='Sample Range:'
38486      NCTEXT(7)=13
38487      AVALUE(7)=XRANG
38488      IDIGIT(7)=NUMDIG
38489      NUMROW=7
38490      DO2310I=1,NUMROW
38491        NTOT(I)=15
38492 2310 CONTINUE
38493      NTOT(2)=8
38494C
38495      IFRST=.TRUE.
38496      ILAST=.FALSE.
38497      NCTITZ=0
38498      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
38499     1            NCTEXT,AVALUE,IDIGIT,
38500     1            NTOT,NUMROW,
38501     1            ICAPSW,ICAPTY,ILAST,IFRST,
38502     1            ISUBRO,IBUGA3,IERROR)
38503C
38504      ITITLE=' '
38505      NCTITL=0
38506C
38507      ITEXT(1)='Method of Moments:'
38508      NCTEXT(1)=18
38509      AVALUE(1)=0.0
38510      IDIGIT(1)=0
38511      ITEXT(2)='Estimate of Lower Limit:'
38512      NCTEXT(2)=24
38513      AVALUE(2)=ALO2LI
38514      IDIGIT(2)=NUMDIG
38515      ITEXT(3)='Estimate of Upper Limit:'
38516      NCTEXT(3)=24
38517      AVALUE(3)=AUP2LI
38518      IDIGIT(3)=NUMDIG
38519      ITEXT(4)='Estimate of Location:'
38520      NCTEXT(4)=20
38521      AVALUE(4)=ALOCMO
38522      IDIGIT(4)=NUMDIG
38523      ITEXT(5)='Estimate of Scale:'
38524      NCTEXT(5)=18
38525      AVALUE(5)=ASCAMO
38526      IDIGIT(5)=NUMDIG
38527      ITEXT(6)=' '
38528      NCTEXT(6)=1
38529      AVALUE(6)=0.0
38530      IDIGIT(6)=-1
38531C
38532      ITEXT(7)='Maximum Likelihood:'
38533      NCTEXT(7)=19
38534      AVALUE(7)=0.0
38535      IDIGIT(7)=-1
38536      ITEXT(8)='Estimate of A (Midrange):'
38537      NCTEXT(8)=25
38538      AVALUE(8)=AHAT
38539      IDIGIT(8)=NUMDIG
38540      ITEXT(9)='Estimate of H (Range/2):'
38541      NCTEXT(9)=25
38542      AVALUE(9)=HHAT
38543      IDIGIT(9)=NUMDIG
38544      ITEXT(10)='Estimate of Lower Limit:'
38545      NCTEXT(10)=24
38546      AVALUE(10)=ALOWLI
38547      IDIGIT(10)=NUMDIG
38548      ITEXT(11)='Estimate of Upper Limit:'
38549      NCTEXT(11)=24
38550      AVALUE(11)=AUPPLI
38551      IDIGIT(11)=NUMDIG
38552      ITEXT(12)='Estimate of Location:'
38553      NCTEXT(12)=21
38554      AVALUE(12)=ALOCML
38555      IDIGIT(12)=NUMDIG
38556      ITEXT(13)='Estimate of Scale:'
38557      NCTEXT(13)=18
38558      AVALUE(13)=ASCAML
38559      IDIGIT(13)=NUMDIG
38560      ICNT=13
38561      ICNT=ICNT+1
38562      ITEXT(ICNT)='Log-likelihood:'
38563      NCTEXT(ICNT)=15
38564      AVALUE(ICNT)=ALIK
38565      IDIGIT(ICNT)=NUMDIG
38566      ICNT=ICNT+1
38567      ITEXT(ICNT)='AIC:'
38568      NCTEXT(ICNT)=4
38569      AVALUE(ICNT)=AIC
38570      IDIGIT(ICNT)=NUMDIG
38571      ICNT=ICNT+1
38572      ITEXT(ICNT)='AICc:'
38573      NCTEXT(ICNT)=5
38574      AVALUE(ICNT)=AICC
38575      IDIGIT(ICNT)=NUMDIG
38576      ICNT=ICNT+1
38577      ITEXT(ICNT)='BIC:'
38578      NCTEXT(ICNT)=4
38579      AVALUE(ICNT)=BIC
38580      IDIGIT(ICNT)=NUMDIG
38581      NUMROW=ICNT
38582      DO2320I=1,NUMROW
38583        NTOT(I)=15
38584 2320 CONTINUE
38585C
38586      IFRST=.FALSE.
38587      ILAST=.FALSE.
38588      NCTITZ=0
38589      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
38590     1            AVALUE,IDIGIT,
38591     1            NTOT,NUMROW,
38592     1            ICAPSW,ICAPTY,ILAST,IFRST,
38593     1            ISUBRO,IBUGA3,IERROR)
38594C
38595C               *****************
38596C               **  STEP 90--  **
38597C               **  EXIT       **
38598C               *****************
38599C
38600 9000 CONTINUE
38601      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLUN')THEN
38602        WRITE(ICOUT,999)
38603        CALL DPWRST('XXX','WRIT')
38604        WRITE(ICOUT,9011)
38605 9011   FORMAT('***** AT THE END       OF DPMLUN--')
38606        CALL DPWRST('XXX','WRIT')
38607        WRITE(ICOUT,9012)N,IBUGA3,IERROR
38608 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
38609        CALL DPWRST('XXX','WRIT')
38610      ENDIF
38611C
38612      RETURN
38613      END
38614      SUBROUTINE DPMLVM(Y,N,MAXNXT,
38615     1                  SHAPML,ALOCML,
38616     1                  ICAPSW,ICAPTY,IFORSW,
38617     1                  ISUBRO,IBUGA3,IERROR)
38618C
38619C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
38620C              ESTIMATES FOR VON MISES DISTRIBUTION
38621C     EXAMPLE--VON MISES MAXIMUM LIKELIHOOD Y
38622C     REFERENCE--EVANS, HASTINGS, AND PEACOCK (2000), "STATISTICAL
38623C                DISTRIBUTIONS", THRID EDITION, WILEY, CHAPTER 41.
38624C              --HILL (1981), "STATISTICS FOR VON MISES' AND
38625C                FISHER'S DISTRIBUTIONS", ACM TRANSACTIONS ON
38626C                MATHEMATICAL SOFTWARE.
38627C     WRITTEN BY--JAMES J. FILLIBEN
38628C                 STATISTICAL ENGINEERING DIVISION
38629C                 INFORMATION TECHNOLOGY LABORATORY
38630C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
38631C                 GAITHERSBURG, MD 20899-8980
38632C                 PHONE--301-975-2855
38633C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
38634C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
38635C     LANGUAGE--ANSI FORTRAN (1977)
38636C     VERSION NUMBER--2008/7
38637C     ORIGINAL VERSION--JULY      2008.
38638C
38639C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
38640C
38641CCCCC DOUBLE PRECISION DSUM1
38642CCCCC DOUBLE PRECISION DSUM2
38643CCCCC DOUBLE PRECISION CBAR
38644CCCCC DOUBLE PRECISION SBAR
38645CCCCC DOUBLE PRECISION DTERM1
38646CCCCC REAL KAPPA
38647C
38648      CHARACTER*4 IFORSW
38649      CHARACTER*4 ICAPTY
38650      CHARACTER*4 ICAPSW
38651      CHARACTER*4 ISUBRO
38652      CHARACTER*4 IBUGA3
38653      CHARACTER*4 IERROR
38654      CHARACTER*4 IWRITE
38655      CHARACTER*4 ISUBN1
38656      CHARACTER*4 ISUBN2
38657      CHARACTER*4 ISTEPN
38658C
38659C---------------------------------------------------------------------
38660C
38661      DIMENSION Y(*)
38662      DIMENSION QP(1)
38663C
38664      PARAMETER (MAXROW=20)
38665      CHARACTER*60 ITITLE
38666      CHARACTER*1  ITITLZ
38667      CHARACTER*40 ITEXT(MAXROW)
38668      REAL         AVALUE(MAXROW)
38669      INTEGER      NCTEXT(MAXROW)
38670      INTEGER      IDIGIT(MAXROW)
38671      INTEGER      NTOT(MAXROW)
38672      LOGICAL IFRST
38673      LOGICAL ILAST
38674C
38675C---------------------------------------------------------------------
38676C
38677      INCLUDE 'DPCOP2.INC'
38678C
38679C-----START POINT-----------------------------------------------------
38680C
38681      ISUBN1='DPML'
38682      ISUBN2='VM  '
38683      IERROR='NO'
38684C
38685      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLVM')THEN
38686        WRITE(ICOUT,999)
38687  999   FORMAT(1X)
38688        CALL DPWRST('XXX','BUG ')
38689        WRITE(ICOUT,51)
38690   51   FORMAT('**** AT THE BEGINNING OF DPMLVM--')
38691        CALL DPWRST('XXX','BUG ')
38692        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,MAXNXT
38693   52   FORMAT('IBUGA3,ISUBRO,N,MAXNXT = ',2(A4,2X),2I8)
38694        CALL DPWRST('XXX','BUG ')
38695        DO56I=1,MIN(N,100)
38696          WRITE(ICOUT,57)I,Y(I)
38697   57     FORMAT('I,Y(I) = ',I8,E15.7)
38698          CALL DPWRST('XXX','BUG ')
38699   56   CONTINUE
38700      ENDIF
38701C
38702C               ********************************************
38703C               **  STEP 11--                             **
38704C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
38705C               ********************************************
38706C
38707      ISTEPN='11'
38708      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLVM')
38709     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
38710C
38711      NPERC=0
38712      NMIN=3
38713      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
38714      IF(IERROR.EQ.'YES')GOTO9000
38715C
38716C               ****************************************
38717C               **  STEP 41--                         **
38718C               **  CARRY OUT CALCULATIONS            **
38719C               **  FOR VON MISES MLE ESTIMATE        **
38720C               ****************************************
38721C
38722      ISTEPN='21'
38723      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLVM')
38724     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
38725C
38726      IWRITE='OFF'
38727      CALL VONML1(Y,N,
38728     1            XMEAN,XSD,XVAR,XMIN,XMAX,
38729     1            ALOCML,SHAPML,
38730     1            ISUBRO,IBUGA3,IERROR)
38731C
38732C               *******************************************
38733C               **   STEP 42--                           **
38734C               **   WRITE OUT EVERYTHING                **
38735C               **   FOR VON MISES MLE ESTIMATE          **
38736C               *******************************************
38737C
38738      ISTEPN='42'
38739      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLVM')
38740     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
38741C
38742C     PRINT SUMMARY STATISTICS TABLE
38743C
38744      IF(IPRINT.EQ.'OFF')GOTO9000
38745C
38746      NUMDIG=7
38747      IF(IFORSW.EQ.'1')NUMDIG=1
38748      IF(IFORSW.EQ.'2')NUMDIG=2
38749      IF(IFORSW.EQ.'3')NUMDIG=3
38750      IF(IFORSW.EQ.'4')NUMDIG=4
38751      IF(IFORSW.EQ.'5')NUMDIG=5
38752      IF(IFORSW.EQ.'6')NUMDIG=6
38753      IF(IFORSW.EQ.'7')NUMDIG=7
38754      IF(IFORSW.EQ.'8')NUMDIG=8
38755      IF(IFORSW.EQ.'9')NUMDIG=9
38756      IF(IFORSW.EQ.'0')NUMDIG=0
38757      IF(IFORSW.EQ.'E')NUMDIG=-2
38758      IF(IFORSW.EQ.'-2')NUMDIG=-2
38759      IF(IFORSW.EQ.'-3')NUMDIG=-3
38760      IF(IFORSW.EQ.'-4')NUMDIG=-4
38761      IF(IFORSW.EQ.'-5')NUMDIG=-5
38762      IF(IFORSW.EQ.'-6')NUMDIG=-6
38763      IF(IFORSW.EQ.'-7')NUMDIG=-7
38764      IF(IFORSW.EQ.'-8')NUMDIG=-8
38765      IF(IFORSW.EQ.'-9')NUMDIG=-9
38766C
38767      ITITLE='Von Mises Parameter Estimation'
38768      NCTITL=30
38769      ITEXT(1)='Summary Statistics:'
38770      NCTEXT(1)=19
38771      AVALUE(1)=0.0
38772      IDIGIT(1)=0
38773      ITEXT(2)='Number of Observations:'
38774      NCTEXT(2)=23
38775      AVALUE(2)=REAL(N)
38776      IDIGIT(2)=0
38777      ITEXT(3)='Sample Mean:'
38778      NCTEXT(3)=12
38779      AVALUE(3)=XMEAN
38780      IDIGIT(3)=NUMDIG
38781      ITEXT(4)='Sample Standard Deviation:'
38782      NCTEXT(4)=26
38783      AVALUE(4)=XSD
38784      IDIGIT(4)=NUMDIG
38785      ITEXT(5)='Sample Minimum:'
38786      NCTEXT(5)=15
38787      AVALUE(5)=XMIN
38788      IDIGIT(5)=NUMDIG
38789      ITEXT(6)='Sample Minimum:'
38790      NCTEXT(6)=15
38791      AVALUE(6)=XMAX
38792      IDIGIT(6)=NUMDIG
38793      ITEXT(7)=' '
38794      NCTEXT(7)=0
38795      AVALUE(7)=0.0
38796      IDIGIT(7)=-1
38797C
38798      ICNT=8
38799      ITEXT(ICNT)='Maximum Likelihood:'
38800      NCTEXT(ICNT)=19
38801      AVALUE(ICNT)=0.0
38802      IDIGIT(ICNT)=0
38803      ICNT=ICNT+1
38804      ITEXT(ICNT)='Estimate of Location:'
38805      NCTEXT(ICNT)=21
38806      AVALUE(ICNT)=ALOCML
38807      IDIGIT(ICNT)=NUMDIG
38808      ICNT=ICNT+1
38809      ITEXT(ICNT)='Estimate of Shape (Kappa):'
38810      NCTEXT(ICNT)=26
38811      AVALUE(ICNT)=SHAPML
38812      IDIGIT(ICNT)=NUMDIG
38813CCCCC ICNT=ICNT+1
38814CCCCC ITEXT(ICNT)='Log-likelihood:'
38815CCCCC NCTEXT(ICNT)=15
38816CCCCC AVALUE(ICNT)=ALIK
38817CCCCC IDIGIT(ICNT)=NUMDIG
38818CCCCC ICNT=ICNT+1
38819CCCCC ITEXT(ICNT)='AIC:'
38820CCCCC NCTEXT(ICNT)=4
38821CCCCC AVALUE(ICNT)=AIC
38822CCCCC IDIGIT(ICNT)=NUMDIG
38823CCCCC ICNT=ICNT+1
38824CCCCC ITEXT(ICNT)='AICc:'
38825CCCCC NCTEXT(ICNT)=5
38826CCCCC AVALUE(ICNT)=AICC
38827CCCCC IDIGIT(ICNT)=NUMDIG
38828CCCCC ICNT=ICNT+1
38829CCCCC ITEXT(ICNT)='BIC:'
38830CCCCC NCTEXT(ICNT)=4
38831CCCCC AVALUE(ICNT)=BIC
38832CCCCC IDIGIT(ICNT)=NUMDIG
38833      NUMROW=ICNT
38834      DO2320I=1,NUMROW
38835        NTOT(I)=15
38836 2320 CONTINUE
38837C
38838      IFRST=.TRUE.
38839      ILAST=.TRUE.
38840      NCTITZ=0
38841      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
38842     1            AVALUE,IDIGIT,
38843     1            NTOT,NUMROW,
38844     1            ICAPSW,ICAPTY,ILAST,IFRST,
38845     1            ISUBRO,IBUGA3,IERROR)
38846C
38847C               *****************
38848C               **  STEP 90--  **
38849C               **  EXIT       **
38850C               *****************
38851C
38852 9000 CONTINUE
38853      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLVM')GOTO9090
38854      WRITE(ICOUT,999)
38855      CALL DPWRST('XXX','BUG ')
38856      WRITE(ICOUT,9011)
38857 9011 FORMAT('***** AT THE END       OF DPMLVM--')
38858      CALL DPWRST('XXX','BUG ')
38859      WRITE(ICOUT,9012)N,IBUGA3,IERROR
38860 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
38861      CALL DPWRST('XXX','BUG ')
38862      WRITE(ICOUT,9015)N
38863 9015 FORMAT('N = ',I8)
38864      CALL DPWRST('XXX','BUG ')
38865 9090 CONTINUE
38866C
38867      RETURN
38868      END
38869      SUBROUTINE DPMLWE(XTEMP1,MAXNXT,
38870     1                  ICAPSW,IFORSW,
38871     1                  MINMAX,ISEED,
38872     1                  ICASAN,IBUGA2,IBUGA3,IBUGQ,ISUBRO,
38873     1                  IFOUND,IERROR)
38874C
38875C     PURPOSE--COMPUTE MAXIMUM LIKELIHOOD ESTIMATES FOR VARIOUS
38876C              DISTRIBUTIONS
38877C     EXAMPLE--WEIBULL MAXIMUM LIKELIHOOD Y
38878C     WRITTEN BY--ALAN HECKERT
38879C                 STATISTICAL ENGINEERING DIVISION
38880C                 INFORMATION TECHNOLOGY LABORATORY
38881C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
38882C                 GAITHERSBURG, MD 20899-8980
38883C                 PHONE--301-975-2899
38884C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
38885C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
38886C     LANGUAGE--ANSI FORTRAN (1977)
38887C     VERSION NUMBER--98/3
38888C     ORIGINAL VERSION--MARCH     1998.
38889C     UPDATED         --MAY       1998. ADD SUPPORT FOR OTHER
38890C                                       DISTRIBUTIONS:
38891C                                          EXPONENTIAL
38892C                                          NORMAL
38893C                                          LOG-NORMAL
38894C                                          INVERSE GAUSSIAN
38895C                                          GUMBEL (EV1)
38896C                                          PARETO
38897C                                          GENERALIZED PARETO
38898C                                          BINOMIAL
38899C                                          POISSON
38900C     UPDATED         --MAY       1998. FOR GENERALIZED PARETO, ADD
38901C                                       DEHAAN AND CME
38902C     UPDATED         --JUNE      1998. ADD CENSORING VARIABLE FOR
38903C                                       EXPONENTIAL CASE
38904C     UPDATED         --JUNE      1998. ADD GAMMA CASE
38905C     UPDATED         --JUNE      1998. ADD POWER CASE
38906C     UPDATED         --JUNE      1998. ADD DOUBLE EXPONENTIAL CASE
38907C     UPDATED         --MARCH     1999. ADD GENERALIZED EXTREME VALUE
38908C     UPDATED         --MARCH     1999. ADD SUPPORT FOR WEIBULL
38909C                                       CENSORED CASE AND ADD CI
38910C                                       FOR WEIBULL
38911C     UPDATED         --MAY       2002. ADD SUPPORT FOR TWO-SIDED
38912C                                       POWER
38913C     UPDATED         --JULY      2003. ADD SUPPORT FOR JOHNSON SB
38914C                                       AND JOHNSON SU MOMENT
38915C                                       ESTIMATORS
38916C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML/LATEX OUTPUT
38917C     UPDATED         --OCTOBER   2003. SUPPORT FOR LOGISTIC
38918C     UPDATED         --OCTOBER   2003. SUPPORT FOR CAUCHY
38919C     UPDATED         --OCTOBER   2003. SUPPORT FOR BETA
38920C     UPDATED         --OCTOBER   2003. SUPPORT FOR UNIFORM
38921C     UPDATED         --NOVEMBER  2003. GENERALIZED PARETO
38922C                                       NOTE: THIS ONE STILL NEEDS SOME
38923C                                       ALGORITHMIC WORK, SO DON'T DOCUMENT
38924C                                       YET.
38925C     UPDATED         --MARCH     2004. LOGARITHMIC SERIES
38926C     UPDATED         --MARCH     2004. GEOMETRIC
38927C     UPDATED         --MARCH     2004. FATIGE LIFE
38928C     UPDATED         --MARCH     2004. GEOMETRIC EXTREME EXPONENTIAL
38929C     UPDATED         --MARCH     2004. FOLDED NORMAL
38930C     UPDATED         --MARCH     2004. UPDATE CAUCHY CASE
38931C     UPDATED         --MARCH     2004. CONFIDENCE INTERVAL FOR
38932C                                       BINOMIAL
38933C     UPDATED         --MARCH     2004. CONFIDENCE INTERVAL FOR
38934C                                       LOGNORMAL
38935C     UPDATED         --MARCH     2004. NEGATIVE BINOMIAL
38936C     UPDATED         --MARCH     2004. ADD BETA-BINOMIAL/POLYA
38937C     UPDATED         --MARCH     2004. HYPERGEOMETRIC
38938C     UPDATED         --APRIL     2004. HERMITE
38939C     UPDATED         --APRIL     2004. YULE
38940C     UPDATED         --APRIL     2004. WARING
38941C                                       THIS ONE STILL NEEDS SOME WORK
38942C     UPDATED         --APRIL     2004. ADD SUPPORT FOR JOHNSON SB/SU
38943C                                       PERCENTILE ESTIMATORS
38944C     UPDATED         --JUNE      2004. IGEPDF FOR GENERALIZED PARETO
38945C     UPDATED         --JUNE      2004. RAYLEIGH, MAXWELL
38946C     UPDATED         --AUGUST    2004. ASYMETRIC LAPLACE
38947C     UPDATED         --AUGUST    2004. NORMAL MIXTURE
38948C     UPDATED         --OCTOBER   2004. CENSORED NORMAL
38949C     UPDATED         --OCTOBER   2004. ESTIMATE CONFIDENCE INTERVALS
38950C                                       FOR PERCENTILES FOR SELECT
38951C                                       DISTRIBUTIONS (NORMAL,
38952C                                       EXPONENTIAL)
38953C     UPDATED         --OCTOBER   2004. SUPPORT EXPONENTIAL MLE FOR
38954C                                       GROUPED DATA
38955C     UPDATED         --MAY       2005. FRECHET
38956C     UPDATED         --AUGUST    2005. INVERTED WEIBULL
38957C     UPDATED         --FEBRUARY  2006. L-MOMENT ESTIMATES FOR
38958C                                       GENERALIZED LOGISTIC
38959C     UPDATED         --MARCH     2006. CALL LIST TO DPMLNM
38960C     UPDATED         --MAY       2006. BOREL-TANNER
38961C     UPDATED         --MAY       2006. BETA-GEOMETRIC
38962C     UPDATED         --MAY       2006. ZETA
38963C     UPDATED         --JUNE      2006. LAGRANGE-POISSON
38964C     UPDATED         --JUNE      2006. POLYA-AEPPLI
38965C     UPDATED         --JUNE      2006. LOST GAMES
38966C     UPDATED         --JULY      2006. GENERALIZED LOGARITHMIC SERIES
38967C     UPDATED         --JULY      2006. GENERALIZED NEGATIVE BINOMIAL
38968C     UPDATED         --JULY      2006. GEETA
38969C     UPDATED         --JULY      2006. QUASI BINOMIAL TYPE I
38970C     UPDATED         --AUGUST    2006. CONSUL
38971C     UPDATED         --AUGUST    2006. LAGRANGE KATZ (NOT ACTIVE)
38972C     UPDATED         --OCTOBER   2006. POWER LAW
38973C     UPDATED         --DECEMBER  2006. GENERALIZED LOST GAMES
38974C     UPDATED         --JANUARY   2007. GOMPERTZ (STILL BEING TESTED)
38975C     UPDATED         --JANUARY   2007. GENERALIZED GAMMA (STILL BEING
38976C                                       TESTED)
38977C     UPDATED         --FEBRUARY  2007. TOPP AND LEONE
38978C     UPDATED         --FEBRUARY  2007. EXPONENTIAL LAW
38979C     UPDATED         --MARCH     2007. KATZ
38980C     UPDATED         --MAY       2007. TRIANGULAR
38981C     UPDATED         --JUNE      2007. LOG BETA
38982C     UPDATED         --JUNE      2007. FOUR PARAMETER BETA
38983C     UPDATED         --JUNE      2007. SLASH
38984C     UPDATED         --JUNE      2007. BETA NORMAL
38985C     UPDATED         --JULY      2007. REFLECTED GENERALIZED
38986C                                       TOPP AND LEONE
38987C     UPDATED         --OCTOBER   2007. BURR TYPE 10
38988C     UPDATED         --OCTOBER   2007. WAKEBY (L-MOMENTS)
38989C     UPDATED         --NOVEMBER  2007. EXPONENTIAL POWER
38990C     UPDATED         --DECEMBER  2007. ALPHA
38991C     UPDATED         --FEBRUARY  2008. LOGISTIC-EXPONENTIAL
38992C     UPDATED         --MARCH     2008. TRUNCATED PARETO
38993C     UPDATED         --MARCH     2008. REFLECTED POWER
38994C     UPDATED         --MARCH     2008. BRITTLE FRACTURE (STILL
38995C                                       BEING TESTED)
38996C     UPDATED         --APRIL     2008. CALL LIST TO DPMLGV
38997C                                       (CORRECTS MINIMUM CASE)
38998C     UPDATED         --APRIL     2008. ADD MINMAX TO CALL LIST FOR
38999C                                       DPMLFR (ADDS SUPPORT FOR
39000C                                       MINIMUM CASE)
39001C     UPDATED         --JUNE      2008. KAPPA (L-MOMENTS)
39002C     UPDATED         --JUNE      2008. PEARSON TYPE 3 (L-MOMENTS)
39003C     UPDATED         --JULY      2008. INVERTED GAMMA
39004C     UPDATED         --JULY      2008. VON MISES
39005C     UPDATED         --JULY      2008. POWER NORMAL (UNDER DEVELOPMENT)
39006C     UPDATED         --APRIL     2010. 3-PARAMETER WEIBULL
39007C     UPDATED         --NOVEMBER  2010. 2-PARAMETER BRITTLE FIBER WEIBULL
39008C     UPDATED         --MARCH     2014. CALL LIST TO DPMLBI
39009C     UPDATED         --APRIL     2014. 3-PARAMETER LOGNORMAL
39010C     UPDATED         --APRIL     2014. 3-PARAMETER GAMMA
39011C     UPDATED         --APRIL     2014. 3-PARAMETER INVERSE GAUSSIAN
39012C     UPDATED         --SEPTEMBER 2014. 3-PARAMETER FRECHET
39013C     UPDATED         --APRIL     2019. POWER NORMAL
39014C     UPDATED         --JULY      2019. TWEAK SCRATCH STORAGE
39015C
39016C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
39017C
39018      CHARACTER*4 ICAPSW
39019      CHARACTER*4 IFORSW
39020      CHARACTER*4 ICASAN
39021C
39022      CHARACTER*4 IBUGA2
39023      CHARACTER*4 IBUGA3
39024      CHARACTER*4 IBUGQ
39025      CHARACTER*4 ISUBRO
39026      CHARACTER*4 IFOUND
39027      CHARACTER*4 IERROR
39028C
39029      CHARACTER*4 ICASE
39030      CHARACTER*4 MESSAG
39031      CHARACTER*4 ICASE3
39032      CHARACTER*4 IHWUSE
39033      CHARACTER*4 IH41
39034      CHARACTER*4 IH42
39035      CHARACTER*4 ISUBN1
39036      CHARACTER*4 ISUBN2
39037      CHARACTER*4 ISTEPN
39038      CHARACTER*4 IH
39039      CHARACTER*4 IH2
39040      CHARACTER*4 IHP
39041      CHARACTER*4 IHP2
39042CCCCC CHARACTER*4 LOWLTY
39043CCCCC CHARACTER*4 UPPLTY
39044      CHARACTER*4 ITYPML
39045      CHARACTER*4 IWEIFL
39046      CHARACTER*4 IGAMFL
39047      CHARACTER*4 ICFLAG
39048      CHARACTER*4 ICENSO
39049      CHARACTER*4 IOP
39050      CHARACTER*4 IREPL
39051      CHARACTER*4 IMULT
39052C
39053      CHARACTER*60 IDIST
39054      CHARACTER*17 IDIST2
39055      CHARACTER*40 INAME
39056C
39057      PARAMETER (MAXSPN=30)
39058      CHARACTER*4 IVARN1(MAXSPN)
39059      CHARACTER*4 IVARN2(MAXSPN)
39060      CHARACTER*4 IVARTY(MAXSPN)
39061      REAL PVAR(MAXSPN)
39062      INTEGER ILIS(MAXSPN)
39063      INTEGER NRIGHT(MAXSPN)
39064      INTEGER ICOLR(MAXSPN)
39065C
39066C
39067      CHARACTER*4 INAME1(60)
39068      CHARACTER*4 INAME2(60)
39069      REAL AVAL(60)
39070C
39071      LOGICAL MLGEV
39072C
39073C---------------------------------------------------------------------
39074C
39075      DIMENSION XTEMP1(*)
39076C
39077C-----COMMON----------------------------------------------------------
39078C
39079      INCLUDE 'DPCOPA.INC'
39080      INCLUDE 'DPCOHK.INC'
39081      INCLUDE 'DPCOSU.INC'
39082      INCLUDE 'DPCOST.INC'
39083      INCLUDE 'DPCODA.INC'
39084C
39085      DIMENSION QP(MAXOBV)
39086      DIMENSION XQPHAT(MAXOBV)
39087      DIMENSION XQPLCL(MAXOBV)
39088      DIMENSION XQPUCL(MAXOBV)
39089      DIMENSION XQPLC2(MAXOBV)
39090      DIMENSION XQPUC2(MAXOBV)
39091      DIMENSION XQPHTZ(MAXOBV)
39092      DIMENSION XQPLCZ(MAXOBV)
39093      DIMENSION XQPUCZ(MAXOBV)
39094      DIMENSION XQPSE(MAXOBV)
39095      DIMENSION TEMP1(MAXOBV)
39096      DIMENSION TEMP2(MAXOBV)
39097      DIMENSION TEMP3(MAXOBV)
39098      DIMENSION TEMP4(MAXOBV)
39099      DIMENSION TEMP5(MAXOBV)
39100      DIMENSION TEMP6(MAXOBV)
39101      INTEGER ITEMP1(MAXOBV)
39102      INTEGER ITEMP2(MAXOBV)
39103      INTEGER ITEMP3(MAXOBV,3)
39104      DOUBLE PRECISION DTEMP1(MAXOBV)
39105      DOUBLE PRECISION DTEMP2(MAXOBV)
39106      DOUBLE PRECISION DTEMP3(MAXOBV)
39107      DOUBLE PRECISION DTEMP4(MAXOBV)
39108      DOUBLE PRECISION DTEMP5(MAXOBV)
39109      DOUBLE PRECISION DTEMP6(MAXOBV)
39110C
39111CCCCC DOUBLE PRECISION PAR(3)
39112CCCCC DOUBLE PRECISION VARCOV(6)
39113C
39114      INCLUDE 'DPCOZZ.INC'
39115      INCLUDE 'DPCOZD.INC'
39116      INCLUDE 'DPCOZI.INC'
39117      EQUIVALENCE (GARBAG(IGARB1),TEMP1(1))
39118      EQUIVALENCE (GARBAG(IGARB2),TEMP2(1))
39119      EQUIVALENCE (GARBAG(IGARB3),TEMP3(1))
39120      EQUIVALENCE (GARBAG(IGARB4),TEMP4(1))
39121      EQUIVALENCE (GARBAG(IGARB5),QP(1))
39122      EQUIVALENCE (GARBAG(IGARB6),XQPHAT(1))
39123      EQUIVALENCE (GARBAG(IGARB7),XQPLCL(1))
39124      EQUIVALENCE (GARBAG(IGARB8),XQPUCL(1))
39125      EQUIVALENCE (GARBAG(IGARB9),XQPHTZ(1))
39126      EQUIVALENCE (GARBAG(IGAR10),XQPLCZ(1))
39127      EQUIVALENCE (GARBAG(JGAR11),XQPUCZ(1))
39128      EQUIVALENCE (GARBAG(JGAR12),XQPLC2(1))
39129      EQUIVALENCE (GARBAG(JGAR13),XQPUC2(1))
39130      EQUIVALENCE (GARBAG(JGAR14),XQPSE(1))
39131      EQUIVALENCE (GARBAG(JGAR15),TEMP5(1))
39132      EQUIVALENCE (GARBAG(JGAR16),TEMP6(1))
39133C
39134      EQUIVALENCE (IGARBG(IIGAR1),ITEMP1(1))
39135      EQUIVALENCE (IGARBG(IIGAR2),ITEMP2(1))
39136      EQUIVALENCE (IGARBG(IIGAR3),ITEMP3(1,1))
39137      EQUIVALENCE (DGARBG(IDGAR1),DTEMP1(1))
39138      EQUIVALENCE (DGARBG(IDGAR2),DTEMP2(1))
39139      EQUIVALENCE (DGARBG(IDGAR3),DTEMP3(1))
39140      EQUIVALENCE (DGARBG(IDGAR4),DTEMP4(1))
39141      EQUIVALENCE (DGARBG(IDGAR5),DTEMP5(1))
39142      EQUIVALENCE (DGARBG(IDGAR6),DTEMP6(1))
39143C
39144C-----COMMON VARIABLES (GENERAL)--------------------------------------
39145C
39146      INCLUDE 'DPCOP2.INC'
39147C
39148C-----START POINT-----------------------------------------------------
39149C
39150      IERROR='NO'
39151      ICASAN='    '
39152      ICENSO='OFF'
39153      IREPL='OFF'
39154      IMULT='OFF'
39155      ISUBN1='DPML'
39156      ISUBN2='WE  '
39157C
39158      IMAX=0
39159      NUMDEF=0
39160      NSAMP=0
39161      NPOP=0
39162C
39163      MAXCP1=MAXCOL+1
39164      MAXCP2=MAXCOL+2
39165      MAXCP3=MAXCOL+3
39166      MAXCP4=MAXCOL+4
39167      MAXCP5=MAXCOL+5
39168      MAXCP6=MAXCOL+6
39169C
39170C               *****************************************
39171C               **  TREAT THE MAXIMUM LIKELIHOOD CASE  **
39172C               *****************************************
39173C
39174      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MLWE')THEN
39175        WRITE(ICOUT,999)
39176  999   FORMAT(1X)
39177        CALL DPWRST('XXX','BUG ')
39178        WRITE(ICOUT,51)
39179   51   FORMAT('***** AT THE BEGINNING OF DPMLWE--')
39180        CALL DPWRST('XXX','BUG ')
39181        WRITE(ICOUT,53)IBUGA2,IBUGA3,IBUGQ,ISUBRO
39182   53   FORMAT('IBUGA2,IBUGA3,IBUGQ,ISUBRO = ',3(A4,2X),A4)
39183        CALL DPWRST('XXX','BUG ')
39184      ENDIF
39185C
39186C               *********************************************************
39187C               **  STEP 1--                                           **
39188C               **  EXTRACT THE COMMAND                                **
39189C               **  LOOK FOR ONE OF THE FOLLOWING COMMANDS:            **
39190C               **    1) <DIST> MAXIMUM LIKELIHOOD Y                   **
39191C               **    2) <DIST> MAXIMUM LIKELIHOOD Y X                 **
39192C               **    3) <DIST> MAXIMUM LIKELIHOOD Y XLOW XHIGH        **
39193C               **                                                     **
39194C               **    4) <DIST> CENSORED MAXIMUM LIKELIHOOD Y X        **
39195C               **    5) <DIST> CENSORED MAXIMUM LIKELIHOOD Y X XMID   **
39196C               **    6) <DIST> CENSORED MAXIMUM LIKELIHOOD Y X        **
39197C               **                                          XLOW XHIGH **
39198C               **                                                     **
39199C               **    7) <DIST> MULTIPLE MAXIMUM LIKELIHOOD Y1 ... YK  **
39200C               *********************************************************
39201C
39202C     LOOK FOR THE WORD "MAXIMUM LIKELIHOOD" (ERROR IF NOT FOUND).
39203C     ALSO LOOK FOR OPTIONAL KEYWORDS "CENSOR" AND "MULTIPLE".
39204C
39205      ISTEPN='1'
39206      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')
39207     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
39208C
39209      IF(ICOM.EQ.'FLUC' .OR. ICOM.EQ.'TABU')THEN
39210        IFOUND='NO'
39211        GOTO9000
39212      ENDIF
39213C
39214      ILASTC=9999
39215      ILASTZ=9999
39216      IFOUND='NO'
39217      DO100I=1,NUMARG-1
39218        IF(IHARG(I).EQ.'MAXI' .AND. IHARG(I+1).EQ.'LIKE')THEN
39219          IFOUND='YES'
39220          ILASTC=MIN(ILASTC,I-1)
39221          ILASTZ=I+1
39222        ELSEIF(IHARG(I).EQ.'MLE ')THEN
39223          IFOUND='YES'
39224          ILASTC=MIN(ILASTC,I-1)
39225          ILASTZ=I
39226        ELSEIF(IHARG(I).EQ.'CENS')THEN
39227          ICENSO='ON'
39228          ILASTC=MIN(ILASTC,I-1)
39229        ELSEIF(IHARG(I).EQ.'MULT')THEN
39230          IMULT='ON'
39231          ILASTC=MIN(ILASTC,I-1)
39232        ENDIF
39233  100 CONTINUE
39234C
39235      IF(IFOUND.EQ.'NO')GOTO9000
39236C
39237C               ***************************************************
39238C               **  STEP 2--EXTRACT THE DISTRIBUTION NAME        **
39239C               ***************************************************
39240C
39241      ISTEPN='2'
39242      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')THEN
39243        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
39244        WRITE(ICOUT,211)IMULT,ICENSO,ILASTC,ILASTZ
39245  211   FORMAT('IMULT,ICENSO,ILASTC,ILASTZ = ',2(A4,2X),2I5)
39246        CALL DPWRST('XXX','BUG ')
39247      ENDIF
39248C
39249      JMIN=0
39250      JMAX=ILASTC
39251C
39252      CALL EXTDIS(ICOM,ICOM2,IHARG,IHARG2,NUMARG,JMIN,JMAX,
39253     1            ICASAN,IDIST,NUMSHA,IFOUND,ILOCV,
39254     1            ISUBRO,IBUGA3,IERROR)
39255C
39256      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')THEN
39257        WRITE(ICOUT,999)
39258        CALL DPWRST('XXX','BUG ')
39259        WRITE(ICOUT,251)
39260  251   FORMAT('***** AFTER CALL EXTDIS--')
39261        CALL DPWRST('XXX','BUG ')
39262        WRITE(ICOUT,252)ICASAN,NUMSHA,IDIST
39263  252   FORMAT('ICASAN,NUMSHA,IDIST = ',A4,2X,I8,2X,A60)
39264        CALL DPWRST('XXX','BUG ')
39265      ENDIF
39266C
39267      IF(IFOUND.EQ.'NO')THEN
39268        WRITE(ICOUT,999)
39269        CALL DPWRST('XXX','BUG ')
39270        WRITE(ICOUT,101)
39271  101   FORMAT('***** ERROR IN MAXIMUM LIKELIHOOD--')
39272        CALL DPWRST('XXX','BUG ')
39273        WRITE(ICOUT,262)
39274  262   FORMAT('      NO MATCH FOUND FOR DISTRIBUTION NAME.')
39275        CALL DPWRST('XXX','BUG ')
39276        IERROR='YES'
39277        GOTO9000
39278      ELSE
39279        CALL ADJUST(ILASTZ,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
39280      ENDIF
39281C
39282C               *********************************
39283C               **  STEP 4--                   **
39284C               **  EXTRACT THE VARIABLE LIST  **
39285C               *********************************
39286C
39287      ISTEPN='4'
39288      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')
39289     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
39290C
39291      INAME='MAXIMUM LIKELIHOOD'
39292      MINNA=1
39293      MAXNA=100
39294      MINNVA=1
39295      MAXNVA=3
39296      MINN2=3
39297      IFLAGE=1
39298      IFLAGM=1
39299      IF(IMULT.EQ.'ON')THEN
39300        IFLAGE=0
39301        MAXNVA=30
39302      ELSEIF(ICENSO.EQ.'ON')THEN
39303        IFLAGM=0
39304        MAXNVA=4
39305      ENDIF
39306      IFLAGP=0
39307      JMIN=1
39308      JMAX=NUMARG
39309C
39310      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
39311     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
39312     1            JMIN,JMAX,
39313     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
39314     1            IVARN1,IVARN2,IVARTY,PVAR,
39315     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
39316     1            MINNVA,MAXNVA,
39317     1            IFLAGM,IFLAGP,
39318     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
39319      IF(IERROR.EQ.'YES')GOTO9000
39320C
39321      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')THEN
39322        WRITE(ICOUT,999)
39323        CALL DPWRST('XXX','BUG ')
39324        WRITE(ICOUT,281)
39325  281   FORMAT('***** AFTER CALL DPPARS--')
39326        CALL DPWRST('XXX','BUG ')
39327        WRITE(ICOUT,282)NQ,NUMVAR
39328  282   FORMAT('NQ,NUMVAR = ',2I8)
39329        CALL DPWRST('XXX','BUG ')
39330        IF(NUMVAR.GT.0)THEN
39331          DO285I=1,NUMVAR
39332            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
39333     1                      ICOLR(I)
39334  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
39335     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
39336            CALL DPWRST('XXX','BUG ')
39337  285     CONTINUE
39338        ENDIF
39339      ENDIF
39340C
39341C               ******************************************************
39342C               **  STEP 16--                                       **
39343C               **  CHECK TO SEE IF A "PERCENTILES" VARIABLE HAS    **
39344C               **  BEEN SPECIFIED (VIA THE SET MAXIMIM LIKELIHOOD  **
39345C               **  PERCENTILES COMMAND).  IF SO, EXTRACT THE NAME. **
39346C               ******************************************************
39347C
39348      ISTEPN='16'
39349      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')
39350     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
39351C
39352      IF(IQUAVR.EQ.'NONE')THEN
39353        NPERC=0
39354      ELSEIF(IQUAVR.EQ.'DEFAULT')THEN
39355        QP(1)=0.5
39356        QP(2)=1.0
39357        QP(3)=5.0
39358        QP(4)=10.0
39359        QP(5)=20.0
39360        QP(6)=30.0
39361        QP(7)=40.0
39362        QP(8)=50.0
39363        QP(9)=60.0
39364        QP(10)=70.0
39365        QP(11)=80.0
39366        QP(12)=90.0
39367        QP(13)=95.0
39368        QP(14)=97.5
39369        QP(15)=99.0
39370        QP(16)=99.5
39371        NPERC=16
39372      ELSE
39373        IH41=IQUAVR(1:4)
39374        IH42=IQUAVR(5:8)
39375        IHWUSE='V'
39376        MESSAG='NO'
39377        CALL CHECKN(IH41,IH42,IHWUSE,
39378     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
39379     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
39380C
39381        IF(IERROR.EQ.'YES')THEN
39382          NPERC=0
39383        ELSE
39384          ICOLQP=IVALUE(ILOCV)
39385          NPERC=IN(ILOCV)
39386          ICNT=0
39387          DO4180I=1,NPERC
39388            IJ=MAXN*(ICOLQP-1)+I
39389            ICNT=ICNT+1
39390            IF(ICOLQP.LE.MAXCOL)QP(ICNT)=V(IJ)
39391            IF(ICOLQP.EQ.MAXCP1)QP(ICNT)=PRED(I)
39392            IF(ICOLQP.EQ.MAXCP2)QP(ICNT)=RES(I)
39393            IF(ICOLQP.EQ.MAXCP3)QP(ICNT)=YPLOT(I)
39394            IF(ICOLQP.EQ.MAXCP4)QP(ICNT)=XPLOT(I)
39395            IF(ICOLQP.EQ.MAXCP5)QP(ICNT)=X2PLOT(I)
39396            IF(ICOLQP.EQ.MAXCP6)QP(ICNT)=TAGPLO(I)
39397            IF(QP(ICNT).LE.0.0 .OR. QP(ICNT).GE.100.0)THEN
39398              ICNT=ICNT-1
39399            ENDIF
39400 4180     CONTINUE
39401          NPERC=ICNT
39402C
39403        ENDIF
39404      ENDIF
39405C
39406C     FOR DISTRIBUTIONS THAT COMPUTE PERCENTILE CONFIDENCE LIMTIS,
39407C     NEED VALUE FOR ALPHA.
39408C
39409      IHP='ALPH'
39410      IHP2='A   '
39411      IHWUSE='P'
39412      MESSAG='NO'
39413      CALL CHECKN(IHP,IHP2,IHWUSE,
39414     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
39415     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
39416      ALPHA=0.05
39417      IF(IERROR.EQ.'NO')ALPHA=VALUE(ILOCP)
39418      IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)THEN
39419        ALPHA=0.05
39420      ELSEIF(ALPHA.GT.0.50)THEN
39421        ALPHA=1.0-ALPHA
39422      ENDIF
39423C
39424      IF(ICASAN.EQ.'HYPG' .AND. IMAX.LT.0)THEN
39425        Y(1)=REAL(NUMDEF)
39426        ITEMP2(1)=NSAMP
39427        IF(IHYPTY.EQ.'ACCE')THEN
39428          ITEMP1(1)=NPOP
39429        ELSE
39430          ITEMP1(1)=NK
39431        ENDIF
39432        NS1=1
39433      ENDIF
39434C
39435C               ***********************************
39436C               **  STEP 52--                    **
39437C               **  DO THE MLE ESTIMATION        **
39438C               ***********************************
39439C
39440C     NOTE THAT "MULTIPLE" OPTION ONLY SUPPORTED FOR UNGROUPED,
39441C     UNCENSORED CASE (I.E., THERE IS A SINGLE RESPONSE VARIABLE.
39442C
39443      NLOOP=1
39444      IF(IMULT.EQ.'ON')NLOOP=NVAR
39445C
39446      DO8000IRESP=1,NLOOP
39447C
39448      ISTEPN='52'
39449      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MLWE')THEN
39450        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
39451        WRITE(ICOUT,999)
39452        CALL DPWRST('XXX','BUG ')
39453        WRITE(ICOUT,5211)
39454 5211   FORMAT('***** FROM DPMLWE, START OF 8000 LOOP')
39455        CALL DPWRST('XXX','BUG ')
39456      ENDIF
39457C
39458      IF(IMULT.EQ.'ON')THEN
39459        ICOL=IRESP
39460        NUMVA2=1
39461        NUMV=1
39462      ELSE
39463        ICOL=1
39464        NUMVA2=NUMVAR
39465        IF(NUMVAR.EQ.4)NUMVA2=3
39466        NUMV=NUMVAR
39467      ENDIF
39468C
39469      CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
39470     1            INAME,IVARN1,IVARN2,IVARTY,
39471     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
39472     1            MAXCOL,MAXCP1,MAXCP2,MAXCP3,
39473     1            MAXCP4,MAXCP5,MAXCP6,
39474     1            V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
39475     1            Y,TEMP1,TEMP2,NS1,NLOCAL,NLOCAL,ICASE,
39476     1            IBUGA3,ISUBRO,IFOUND,IERROR)
39477C
39478C     GROUPED, CENSORED DATA CAN POTENTIALLY HAVE 4 VARIABLES.
39479C
39480      IF(IMULT.EQ.'OFF' .AND. NUMVAR.EQ.4)THEN
39481        ICOL=4
39482        NUMVA2=1
39483        CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
39484     1              INAME,IVARN1,IVARN2,IVARTY,
39485     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
39486     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
39487     1              MAXCP4,MAXCP5,MAXCP6,
39488     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
39489     1              TEMP3,TEMP3,TEMP3,NLOCAL,NLOCAL,NLOCAL,ICASE,
39490     1              IBUGA3,ISUBRO,IFOUND,IERROR)
39491      ENDIF
39492C
39493C     NOW LOOP THROUGH THE SPECIFIC SUPPORTED DISTRIBUTIONS.
39494C
39495      IF(ICASAN.EQ.'WEIB' .OR. ICASAN.EQ.'IWEI')THEN
39496C
39497        IOP='OPEN'
39498        IFLAG1=1
39499        IFLAG2=1
39500        IFLAG3=0
39501        IFLAG4=0
39502        IFLAG5=0
39503        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
39504     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
39505     1              IBUGA3,ISUBRO,IERROR)
39506        IF(IERROR.EQ.'YES')GOTO9000
39507C
39508        IF(IWEIGL.EQ.'ON')THEN
39509          IHP='L   '
39510          IHP2='    '
39511          IHWUSE='P'
39512          MESSAG='NO'
39513          CALL CHECKN(IHP,IHP2,IHWUSE,
39514     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
39515     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
39516          AL=CPUMIN
39517          IF(IERROR.EQ.'NO')AL=VALUE(ILOCP)
39518          IF(AL.LE.0.0)THEN
39519            AL=CPUMIN
39520          ENDIF
39521        ELSE
39522          AL=CPUMIN
39523        ENDIF
39524C
39525        IF(ICASAN.EQ.'WEIB')THEN
39526          IWEIFL='WEIB'
39527        ELSEIF(ICASAN.EQ.'IWEI')THEN
39528          IWEIFL='IWEI'
39529        ELSE
39530          IWEIFL='WEIB'
39531        ENDIF
39532C
39533        IF(NUMV.EQ.1)THEN
39534          CALL DPMLW1(Y,NS1,
39535     1                XTEMP1,DTEMP1,MAXNXT,
39536     1                SCALE,SCALSE,GAMMA,GAMMSE,GAMMBC,GABCSE,
39537     1                COVSE,COBCSE,
39538     1                AIC,AICC,BIC,ALIKE,
39539     1                AICBC,AICCBC,BICBC,ALIKBC,
39540     1                NUMV,MINMAX,IWEIFL,AL,
39541     1                ICAPSW,ICAPTY,IFORSW,
39542     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
39543     1                IOUNI1,IOUNI2,ALPHA,
39544     1                ISUBRO,IBUGA3,IERROR)
39545        ELSEIF(NUMV.EQ.2 .AND. ICENTY.NE.'2')THEN
39546          CALL DPMLW2(Y,TEMP1,NS1,
39547     1                XTEMP1,DTEMP1,ITEMP1,MAXNXT,
39548     1                SCALE,SCALSE,GAMMA,GAMMSE,GAMMBC,GABCSE,
39549     1                COVSE,COBCSE,
39550     1                NUMV,MINMAX,
39551     1                ICAPSW,ICAPTY,IFORSW,IWEIFL,AL,
39552     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
39553     1                IOUNI1,IOUNI2,ALPHA,
39554     1                ISUBRO,IBUGA3,IERROR)
39555        ELSE
39556          IF(NUMV.EQ.1)THEN
39557            IWBCAS=3
39558          ELSEIF(NUMV.EQ.2)THEN
39559            IWBCAS=2
39560            IF(ICENTY.EQ.'3')IWBCAS=1
39561          ELSE
39562            IWBCAS=3
39563          ENDIF
39564          DO810I=1,NS1
39565            IF(Y(I).LT.0.0)THEN
39566              WRITE(ICOUT,999)
39567              CALL DPWRST('XXX','BUG ')
39568              WRITE(ICOUT,813)
39569              CALL DPWRST('XXX','BUG ')
39570              IERROR='YES'
39571              GOTO9000
39572            ENDIF
39573            DTEMP1(I)=DBLE(Y(I))
39574            IF(IWBCAS.EQ.3)THEN
39575              ITEMP1(I)=1
39576            ELSE
39577              ITEMP1(I)=INT(TEMP4(I)+0.5)
39578            ENDIF
39579            IF(ITEMP1(I).LE.0)ITEMP1(I)=0
39580            IF(ITEMP1(I).GE.1)ITEMP1(I)=1
39581  810     CONTINUE
39582          IERROR='NO'
39583  813     FORMAT('***** ERROR FOR WEIBULL MLE.  NEGATIVE NUMBER ',
39584     1           'ENCOUNTERED.')
39585          CALL WEICEN(DTEMP1,ITEMP1,DTEMP2,DTEMP3,IWBCAS,NS1,
39586     1                GAMMA,SCALE,
39587     1                ICAPSW,ICAPTY,IFORSW,
39588     1                ISUBRO,IBUGA3,IERROR)
39589        ENDIF
39590        IF(IERROR.EQ.'YES')GOTO8000
39591        IOP='CLOS'
39592        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
39593     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
39594     1              IBUGA3,ISUBRO,IERROR)
39595C
39596        INAME1(1)='GAMM'
39597        INAME2(1)='AML '
39598        AVAL(1)=GAMMA
39599        INAME1(2)='GAMM'
39600        INAME2(2)='ASE '
39601        AVAL(2)=GAMMSE
39602        INAME1(3)='ALPH'
39603        INAME2(3)='AML '
39604        AVAL(3)=SCALE
39605        INAME1(4)='ALPH'
39606        INAME2(4)='ASE '
39607        AVAL(4)=SCALSE
39608        NPAR=4
39609C
39610        IF(NUMV.LE.1)THEN
39611          INAME1(5)='GAMM'
39612          INAME2(5)='ABC '
39613          AVAL(5)=GAMMBC
39614          INAME1(6)='GAMM'
39615          INAME2(6)='BCSE'
39616          AVAL(6)=GABCSE
39617          INAME1(7)='COVS'
39618          INAME2(7)='E   '
39619          AVAL(7)=COVSE
39620          INAME1(8)='COVB'
39621          INAME2(8)='CSE '
39622          AVAL(8)=COBCSE
39623          INAME1(9)='LIKE'
39624          INAME2(9)='MLBC'
39625          AVAL(9)=ALIKBC
39626          INAME1(10)='AICB'
39627          INAME2(10)='C   '
39628          AVAL(10)=AICBC
39629          INAME1(11)='AICC'
39630          INAME2(11)='BC  '
39631          AVAL(11)=AICCBC
39632          INAME1(12)='BICB'
39633          INAME2(12)='C   '
39634          AVAL(12)=BICBC
39635          NPAR=12
39636        ENDIF
39637        GOTO8100
39638      ELSEIF(ICASAN.EQ.'3WEI' .OR. ICASAN.EQ.'3IWE')THEN
39639C
39640        IOP='OPEN'
39641        IFLAG1=1
39642        IFLAG2=1
39643        IFLAG3=0
39644        IFLAG4=0
39645        IFLAG5=0
39646        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
39647     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
39648     1              IBUGA3,ISUBRO,IERROR)
39649        IF(IERROR.EQ.'YES')GOTO9000
39650C
39651        IF(IWEIGL.EQ.'ON')THEN
39652          IHP='L   '
39653          IHP2='    '
39654          IHWUSE='P'
39655          MESSAG='NO'
39656          CALL CHECKN(IHP,IHP2,IHWUSE,
39657     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
39658     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
39659          AL=CPUMIN
39660          IF(IERROR.EQ.'NO')AL=VALUE(ILOCP)
39661          IF(ALPHA.LE.0.0)THEN
39662            AL=CPUMIN
39663          ENDIF
39664        ELSE
39665          AL=CPUMIN
39666        ENDIF
39667C
39668        IF(ICASAN.EQ.'3WEI')THEN
39669          IWEIFL='WEIB'
39670        ELSEIF(ICASAN.EQ.'3IWE')THEN
39671          IWEIFL='IWEI'
39672        ELSE
39673          IWEIFL='WEIB'
39674        ENDIF
39675C
39676        IF(NUMV.EQ.1)THEN
39677          CALL DPMLW3(Y,TEMP1,NS1,
39678     1                XTEMP1,TEMP2,TEMP3,TEMP4,TEMP5,
39679     1                DTEMP1,ITEMP1,MAXNXT,
39680     1                ALOCML,SCALML,SHAPML,ALOCS4,SCALS4,SHAPS4,
39681     1                ALOCMO,SCALMO,SHAPMO,ALOCS3,SCALS3,SHAPS3,
39682     1                ALOCM2,SCALM2,SHAPM2,ALOCS5,SCALS5,SHAPS5,
39683     1                ALOCPE,SCALPE,SHAPPE,ALOCS1,SCALS1,SHAPS1,
39684     1                ALOCWB,SCALWB,SHAPWB,ALOCS2,SCALS2,SHAPS2,
39685     1                ALOCLM,SCALLM,SHAPLM,ALOCS6,SCALS6,SHAPS6,
39686     1                ALOCEP,SCALEP,SHAPEP,ALOCS7,SCALS7,SHAPS7,
39687     1                AICML,AICCML,BICML,ALIKML,
39688     1                AICMO,AICCMO,BICMO,ALIKMO,
39689     1                AICM2,AICCM2,BICM2,ALIKM2,
39690     1                AICPE,AICCPE,BICPE,ALIKPE,
39691     1                AICWB,AICCWB,BICWB,ALIKWB,
39692     1                AICLM,AICCLM,BICLM,ALIKLM,
39693     1                AICEP,AICCEP,BICEP,ALIKEP,
39694     1                NUMV,MINMAX,IWEIFL,AL,
39695     1                ICAPSW,ICAPTY,IFORSW,ISEED,
39696     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
39697     1                IOUNI1,IOUNI2,ALPHA,
39698     1                ISUBRO,IBUGA3,IERROR)
39699C
39700        ENDIF
39701C
39702        INAME1(1)='SHAP'
39703        INAME2(1)='EML '
39704        AVAL(1)=SHAPML
39705        INAME1(2)='SCAL'
39706        INAME2(2)='EML '
39707        AVAL(2)=SCALML
39708        INAME1(3)='LOCM'
39709        INAME2(3)='L   '
39710        AVAL(3)=ALOCML
39711        INAME1(4)='SHAP'
39712        INAME2(4)='ESE '
39713        AVAL(4)=SHAPS4
39714        INAME1(5)='SCAL'
39715        INAME2(5)='ESE '
39716        AVAL(5)=SCALS4
39717        INAME1(6)='LOCS'
39718        INAME2(6)='E   '
39719        AVAL(6)=ALOCS4
39720        INAME1(7)='SHAP'
39721        INAME2(7)='EMMO'
39722        AVAL(7)=SHAPMO
39723        INAME1(8)='SCAL'
39724        INAME2(8)='EMMO'
39725        AVAL(8)=SCALMO
39726        INAME1(9)='LOCM'
39727        INAME2(9)='MOM '
39728        AVAL(9)=ALOCMO
39729        INAME1(10)='LIKE'
39730        INAME2(10)='MMOM'
39731        AVAL(10)=ALIKMO
39732        INAME1(11)='AICM'
39733        INAME2(11)='MOM '
39734        AVAL(11)=AICMO
39735        INAME1(12)='AICC'
39736        INAME2(12)='MMOM'
39737        AVAL(12)=AICCMO
39738        INAME1(13)='BICM'
39739        INAME2(13)='MOM '
39740        AVAL(13)=BICMO
39741        INAME1(14)='SHAP'
39742        INAME2(14)='SEMM'
39743        AVAL(14)=SHAPS3
39744        INAME1(15)='SCAL'
39745        INAME2(15)='SEMM'
39746        AVAL(15)=SCALS3
39747        INAME1(16)='LOCS'
39748        INAME2(16)='EMM '
39749        AVAL(16)=ALOCS3
39750        INAME1(17)='SHAP'
39751        INAME2(17)='EWBE'
39752        AVAL(17)=SHAPWB
39753        INAME1(18)='SCAL'
39754        INAME2(18)='EWBE'
39755        AVAL(18)=SCALWB
39756        INAME1(19)='LOCW'
39757        INAME2(19)='BE  '
39758        AVAL(19)=ALOCWB
39759        INAME1(20)='LIKE'
39760        INAME2(20)='WBE '
39761        AVAL(20)=ALIKWB
39762        INAME1(21)='AICW'
39763        INAME2(21)='BE  '
39764        AVAL(21)=AICWB
39765        INAME1(22)='AICC'
39766        INAME2(22)='WBE '
39767        AVAL(22)=AICCWB
39768        INAME1(23)='BICW'
39769        INAME2(23)='BE  '
39770        AVAL(23)=BICWB
39771        INAME1(24)='SHAP'
39772        INAME2(24)='SEWB'
39773        AVAL(24)=SHAPS2
39774        INAME1(25)='SCAL'
39775        INAME2(25)='SEWB'
39776        AVAL(25)=SCALS2
39777        INAME1(26)='LOCS'
39778        INAME2(26)='EWBE'
39779        AVAL(26)=ALOCS2
39780        INAME1(27)='SHAP'
39781        INAME2(27)='EPE '
39782        AVAL(27)=SHAPPE
39783        INAME1(28)='SCAL'
39784        INAME2(28)='EPE '
39785        AVAL(28)=SCALPE
39786        INAME1(29)='LOCP'
39787        INAME2(29)='E   '
39788        AVAL(29)=ALOCPE
39789        INAME1(30)='LIKE'
39790        INAME2(30)='PE  '
39791        AVAL(30)=ALIKPE
39792        INAME1(31)='AICP'
39793        INAME2(31)='E   '
39794        AVAL(31)=AICPE
39795        INAME1(32)='AICC'
39796        INAME2(32)='PE  '
39797        AVAL(32)=AICCPE
39798        INAME1(33)='BICP'
39799        INAME2(33)='E   '
39800        AVAL(33)=BICPE
39801        INAME1(34)='SHAP'
39802        INAME2(34)='SEPE'
39803        AVAL(34)=SHAPS1
39804        INAME1(35)='SCAL'
39805        INAME2(35)='SEPE'
39806        AVAL(35)=SCALS1
39807        INAME1(36)='LOCS'
39808        INAME2(36)='EPE '
39809        AVAL(36)=ALOCS1
39810        INAME1(37)='LOCL'
39811        INAME2(37)='MOM '
39812        AVAL(37)=ALOCLM
39813        INAME1(38)='SCAL'
39814        INAME2(38)='LMOM'
39815        AVAL(38)=SCALLM
39816        INAME1(39)='SHAP'
39817        INAME2(39)='LMOM'
39818        AVAL(39)=SHAPLM
39819        INAME1(40)='AICL'
39820        INAME2(40)='MOM '
39821        AVAL(40)=AICLM
39822        INAME1(41)='BICL'
39823        INAME2(41)='MOM '
39824        AVAL(41)=BICLM
39825        INAME1(42)='AICC'
39826        INAME2(42)='LMOM'
39827        AVAL(42)=AICCLM
39828        INAME1(43)='LOCE'
39829        INAME2(43)='PERC'
39830        AVAL(43)=ALOCEP
39831        INAME1(44)='SCAL'
39832        INAME2(44)='EPER'
39833        AVAL(44)=SCALEP
39834        INAME1(45)='SHAP'
39835        INAME2(45)='EPER'
39836        AVAL(45)=SHAPEP
39837        INAME1(46)='AICE'
39838        INAME2(46)='PERC'
39839        AVAL(46)=AICEP
39840        INAME1(47)='BICE'
39841        INAME2(47)='PERC'
39842        AVAL(47)=BICEP
39843        INAME1(48)='AICC'
39844        INAME2(48)='EPER'
39845        AVAL(48)=AICCEP
39846        NPAR=48
39847C
39848        IOP='CLOS'
39849        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
39850     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
39851     1              IBUGA3,ISUBRO,IERROR)
39852C
39853        GOTO8100
39854C
39855      ELSEIF(ICASAN.EQ.'BFWE')THEN
39856C
39857        IF(NUMV.EQ.1)THEN
39858          IHP='L   '
39859          IHP2='    '
39860          IHWUSE='P'
39861          MESSAG='NO'
39862          CALL CHECKN(IHP,IHP2,IHWUSE,
39863     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
39864     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
39865C
39866          AL=1.0
39867          IF(IERROR.EQ.'NO')AL=VALUE(ILOCP)
39868          IF(AL.LE.0.0)THEN
39869            AL=0.05
39870          ENDIF
39871C
39872          DO5341I=1,NS1
39873            TEMP4(I)=AL
39874 5341     CONTINUE
39875        ENDIF
39876C
39877        IHP='SCAL'
39878        IHP2='ESV '
39879        IHWUSE='P'
39880        MESSAG='NO'
39881        CALL CHECKN(IHP,IHP2,IHWUSE,
39882     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
39883     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
39884        SCALSV=CPUMIN
39885        IF(IERROR.EQ.'NO')SCALSV=VALUE(ILOCP)
39886        IF(SCALSV.LE.0.0)THEN
39887          SCALSV=CPUMIN
39888        ENDIF
39889C
39890        IHP='SHAP'
39891        IHP2='ESV '
39892        IHWUSE='P'
39893        MESSAG='NO'
39894        CALL CHECKN(IHP,IHP2,IHWUSE,
39895     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
39896     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
39897        SHAPSV=CPUMIN
39898        IF(IERROR.EQ.'NO')SHAPSV=VALUE(ILOCP)
39899        IF(SHAPSV.LE.0.0)THEN
39900          SHAPSV=CPUMIN
39901        ENDIF
39902C
39903        CALL DPMBFW(Y,TEMP1,NS1,
39904     1              XTEMP1,TEMP2,DTEMP1,MAXNXT,
39905     1              SCALSV,SHAPSV,SCALML,SHAPML,
39906     1              AIC,AICC,BIC,ALIKE,
39907     1              ICAPSW,ICAPTY,IFORSW,
39908     1              ISUBRO,IBUGA3,IERROR)
39909C
39910        INAME1(1)='SHAP'
39911        INAME2(1)='EML '
39912        AVAL(1)=SHAPML
39913        INAME1(2)='SCAL'
39914        INAME2(2)='EML '
39915        AVAL(2)=SCALML
39916        NPAR=2
39917        GOTO8100
39918C
39919      ELSEIF(ICASAN.EQ.'EV2 ')THEN
39920C
39921        IOP='OPEN'
39922        IFLAG1=1
39923        IFLAG2=1
39924        IFLAG3=0
39925        IFLAG4=0
39926        IFLAG5=0
39927        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
39928     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
39929     1              IBUGA3,ISUBRO,IERROR)
39930        IF(IERROR.EQ.'YES')GOTO9000
39931C
39932        IF(NUMV.EQ.1)THEN
39933          CALL DPMLFR(Y,NS1,
39934     1                XTEMP1,DTEMP1,MAXNXT,MINMAX,
39935     1                SCALE,SCALSE,GAMMA,GAMMSE,GAMMBC,GABCSE,
39936     1                COVSE,COBCSE,
39937     1                ICAPSW,ICAPTY,IFREBC,
39938     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
39939     1                IOUNI1,IOUNI2,ALPHA,
39940     1                ISUBRO,IBUGA3,IERROR)
39941        ELSEIF(NUMV.EQ.2 .AND. ICENTY.NE.'2')THEN
39942C
39943C         CENSORED CASE NOT CURRENTLY SUPPORTED.
39944C
39945        ENDIF
39946C
39947        IOP='CLOS'
39948        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
39949     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
39950     1              IBUGA3,ISUBRO,IERROR)
39951        IF(IERROR.EQ.'YES')GOTO9000
39952C
39953        INAME1(1)='GAMM'
39954        INAME2(1)='AML '
39955        AVAL(1)=GAMMA
39956        INAME1(2)='GAMM'
39957        INAME2(2)='ASE '
39958        AVAL(2)=GAMMSE
39959        INAME1(3)='ALPH'
39960        INAME2(3)='AML '
39961        AVAL(3)=SCALE
39962        INAME1(4)='ALPH'
39963        INAME2(4)='ASE '
39964        AVAL(4)=SCALSE
39965        NPAR=4
39966C
39967        IF(NUMV.LE.1)THEN
39968          INAME1(5)='GAMM'
39969          INAME2(5)='ABC '
39970          AVAL(5)=GAMMBC
39971          INAME1(6)='GAMM'
39972          INAME2(6)='BCSE'
39973          AVAL(6)=GABCSE
39974          INAME1(7)='COVS'
39975          INAME2(7)='E   '
39976          AVAL(7)=COVSE
39977          INAME1(8)='COVB'
39978          INAME2(8)='CSE '
39979          AVAL(8)=COBCSE
39980          NPAR=8
39981        ENDIF
39982        GOTO8900
39983C
39984      ELSEIF(ICASAN.EQ.'3EV2' .OR. ICASAN.EQ.'3FRE')THEN
39985C
39986CCCCC   IOP='OPEN'
39987CCCCC   IFLAG1=1
39988CCCCC   IFLAG2=1
39989CCCCC   IFLAG3=0
39990CCCCC   IFLAG4=0
39991CCCCC   IFLAG5=0
39992CCCCC   CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
39993CCCCC1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
39994CCCCC1              IBUGA3,ISUBRO,IERROR)
39995CCCCC   IF(IERROR.EQ.'YES')GOTO9000
39996C
39997        IF(NUMV.EQ.1)THEN
39998          CALL DPMLF3(Y,NS1,ICASAN,MAXNXT,MINMAX,
39999     1                TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,
40000     1                DTEMP1,DTEMP2,
40001     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
40002     1                ALOCLM,SCALLM,SHAPLM,
40003     1                ALOCEP,SCALEP,SHAPEP,
40004     1                ALOCML,SCALML,SHAPML,
40005     1                ICAPSW,ICAPTY,IFORSW,
40006     1                IOUNI1,IOUNI2,ISEED,ALPHA,
40007     1                MLGEV,ISUBRO,IBUGA3,IERROR)
40008C
40009        ENDIF
40010C
40011        INAME1(1)='SHAP'
40012        INAME2(1)='EML '
40013        AVAL(1)=SHAPML
40014        INAME1(2)='SCAL'
40015        INAME2(2)='EML '
40016        AVAL(2)=SCALML
40017        INAME1(3)='LOCM'
40018        INAME2(3)='L   '
40019        AVAL(3)=ALOCS1
40020        INAME1(4)='LOCL'
40021        INAME2(4)='MOM '
40022        AVAL(4)=ALOCLM
40023        INAME1(5)='SCAL'
40024        INAME2(5)='LMOM'
40025        AVAL(5)=SCALLM
40026        INAME1(6)='SHAP'
40027        INAME2(6)='LMOM'
40028        AVAL(6)=SHAPLM
40029        INAME1(7)='AICL'
40030        INAME2(7)='MOM '
40031        AVAL(7)=AICLM
40032        INAME1(8)='BICL'
40033        INAME2(8)='MOM '
40034        AVAL(8)=BICLM
40035        INAME1(9)='AICC'
40036        INAME2(9)='LMOM'
40037        AVAL(9)=AICCLM
40038        INAME1(10)='LOCE'
40039        INAME2(10)='PERC'
40040        AVAL(10)=ALOCEP
40041        INAME1(11)='SCAL'
40042        INAME2(11)='EPER'
40043        AVAL(11)=SCALEP
40044        INAME1(12)='SHAP'
40045        INAME2(12)='EPER'
40046        AVAL(12)=SHAPEP
40047        INAME1(13)='AICE'
40048        INAME2(13)='PERC'
40049        AVAL(13)=AICEP
40050        INAME1(14)='BICE'
40051        INAME2(14)='PERC'
40052        AVAL(14)=BICEP
40053        INAME1(15)='AICC'
40054        INAME2(15)='EPER'
40055        AVAL(15)=AICCEP
40056        NPAR=15
40057C
40058CCCCC   IOP='CLOS'
40059CCCCC   CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
40060CCCCC1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
40061CCCCC1              IBUGA3,ISUBRO,IERROR)
40062C
40063        GOTO8100
40064C
40065      ELSEIF(ICASAN.EQ.'NORM')THEN
40066C
40067        IOP='OPEN'
40068        IFLAG1=1
40069        IFLAG2=0
40070        IF(NUMV.GT.1)IFLAG2=1
40071        IFLAG3=0
40072        IFLAG4=0
40073        IFLAG5=0
40074        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
40075     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
40076     1              IBUGA3,ISUBRO,IERROR)
40077        IF(IERROR.EQ.'YES')GOTO9000
40078C
40079        IF(NUMV.LE.1)THEN
40080          ICASET=1
40081          CALL DPMLN1(Y,NS1,ICASET,
40082     1                QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,NPERC,
40083     1                XMEAN,XSD,XMEASD,XSDSD,
40084     1                AIC,AICC,BIC,ALIKE,
40085     1                ICAPSW,ICAPTY,IFORSW,
40086     1                IOUNI1,IOUNI2,ALPHA,
40087     1                ISUBRO,IBUGA3,IERROR)
40088C
40089        ELSE
40090          CALL DPMLN2(Y,TEMP1,NS1,
40091     1                XTEMP1,DTEMP1,ITEMP1,MAXNXT,
40092     1                QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,NPERC,
40093     1                XMEAN,XSD,
40094     1                AIC,AICC,BIC,ALIKE,
40095     1                ICAPSW,ICAPTY,IFORSW,
40096     1                IOUNI1,IOUNI2,ALPHA,
40097     1                ISUBRO,IBUGA3,IERROR)
40098        ENDIF
40099C
40100        IOP='CLOS'
40101        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
40102     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
40103     1              IBUGA3,ISUBRO,IERROR)
40104        IF(IERROR.EQ.'YES')GOTO9000
40105C
40106        INAME1(1)='XMEA'
40107        INAME2(1)='N   '
40108        AVAL(1)=XMEAN
40109        INAME1(2)='XSD '
40110        INAME2(2)='    '
40111        AVAL(2)=XSD
40112        NPAR=2
40113C
40114        IF(NUMV.EQ.1)THEN
40115          INAME1(3)='XMEA'
40116          INAME2(3)='NSE '
40117          AVAL(3)=XMEASD
40118          INAME1(4)='XSDS'
40119          INAME2(4)='E   '
40120          AVAL(4)=XSDSD
40121          NPAR=4
40122        ENDIF
40123        GOTO8100
40124C
40125      ELSEIF(ICASAN.EQ.'NORX')THEN
40126C
40127        IHP='NCOM'
40128        IHP2='P   '
40129        IHWUSE='P'
40130        MESSAG='NO'
40131        CALL CHECKN(IHP,IHP2,IHWUSE,
40132     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
40133     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
40134        NCOMP=2
40135        IF(IERROR.EQ.'NO')NCOMP=INT(VALUE(ILOCP)+0.5)
40136C
40137        IF(NCOMP.LT.2)NCOMP=2
40138        CALL DPMLNM(Y,TEMP1,NS1,NUMV,XTEMP1,TEMP2,N2,
40139     1              TEMP3,TEMP4,TEMP5,ITEMP1,MAXNXT,
40140     1              CLLIMI,CLWIDT,NCOMP,
40141     1              TEMP5,IHSTCW,MAXOBV,
40142     1              ICAPSW,ICAPTY,IFORSW,
40143     1              U1,SD1,U2,SD2,PMIX,
40144     1              ISUBRO,IBUGA3,IERROR)
40145        IF(IERROR.EQ.'YES')GOTO9000
40146C
40147C       FOR COMMON 2-COMPONENT MIXTURE CASE, SAVE PARAMETERS
40148C
40149        IF(NCOMP.EQ.2)THEN
40150          INAME1(1)='U1  '
40151          INAME2(1)='    '
40152          AVAL(1)=U1
40153          INAME1(2)='SD1 '
40154          INAME2(2)='    '
40155          AVAL(2)=SD1
40156          INAME1(3)='U2  '
40157          INAME2(3)='    '
40158          AVAL(3)=U2
40159          INAME1(4)='SD2 '
40160          INAME2(4)='    '
40161          AVAL(4)=SD2
40162          INAME1(5)='P   '
40163          INAME2(5)='    '
40164          AVAL(5)=PMIX
40165          NPAR=5
40166          GOTO8900
40167        ENDIF
40168C
40169      ELSEIF(ICASAN.EQ.'BTAN')THEN
40170C
40171        CALL DPMLBT(Y,TEMP1,NS1,NUMV,
40172     1              TEMP2,TEMP3,TEMP4,MAXNXT,
40173     1              AKHAT,ALAMML,
40174     1              AIC,AICC,BIC,
40175     1              ICAPSW,ICAPTY,IFORSW,
40176     1              ISUBRO,IBUGA3,IERROR)
40177        IF(IERROR.EQ.'YES')GOTO9000
40178C
40179        INAME1(1)='KML '
40180        INAME2(1)='    '
40181        AVAL(1)=AKHAT
40182        INAME1(2)='LAMB'
40183        INAME2(2)='DAML'
40184        AVAL(2)=ALAMML
40185        NPAR=2
40186        GOTO8900
40187C
40188      ELSEIF(ICASAN.EQ.'LPOI')THEN
40189C
40190        CALL DPMLLP(Y,TEMP1,NS1,NUMV,
40191     1              TEMP2,TEMP3,TEMP4,DTEMP1,
40192     1              THETMO,ALAMMO,THETVM,ALAMVM,COVMOM,
40193     1              THETFR,ALAMFR,THETVF,ALAMVF,COVFR,
40194     1              THETWD,ALAMWD,
40195     1              THETML,ALAMML,THETVL,ALAMVL,COVML,
40196     1              AICMO,AICCMO,BICMO,
40197     1              AICML,AICCML,BICML,
40198     1              AICFR,AICCFR,BICFR,
40199     1              AICWD,AICCWD,BICWD,
40200     1              ICAPSW,ICAPTY,IFORSW,MAXNXT,
40201     1              ISUBRO,IBUGA3,IERROR)
40202        IF(IERROR.EQ.'YES')GOTO9000
40203C
40204        INAME1(1)='THET'
40205        INAME2(1)='AMOM'
40206        AVAL(1)=THETMO
40207        INAME1(2)='LAMB'
40208        INAME2(2)='DAMO'
40209        AVAL(2)=ALAMMO
40210        INAME1(3)='THET'
40211        INAME2(3)='MOMV'
40212        AVAL(3)=THETVM
40213        INAME1(4)='LAMB'
40214        INAME2(4)='MOMV'
40215        AVAL(4)=ALAMVM
40216        INAME1(5)='COVM'
40217        INAME2(5)='OM  '
40218        AVAL(5)=COVMOM
40219        INAME1(6)='THET'
40220        INAME2(6)='AFR '
40221        AVAL(6)=THETFR
40222        INAME1(7)='LAMB'
40223        INAME2(7)='DAFR'
40224        AVAL(7)=ALAMFR
40225        INAME1(8)='THET'
40226        INAME2(8)='FREV'
40227        AVAL(8)=THETVF
40228        INAME1(9)='LAMB'
40229        INAME2(9)='FREV'
40230        AVAL(9)=ALAMVF
40231        INAME1(10)='COVF'
40232        INAME2(10)='REQ '
40233        AVAL(10)=COVFR
40234        INAME1(11)='THET'
40235        INAME2(11)='AWD '
40236        AVAL(11)=THETWD
40237        INAME1(12)='LAMB'
40238        INAME2(12)='DAWD'
40239        AVAL(12)=ALAMWD
40240        INAME1(13)='THET'
40241        INAME2(13)='AML '
40242        AVAL(13)=THETML
40243        INAME1(14)='LAMB'
40244        INAME2(14)='DAML'
40245        AVAL(14)=ALAMML
40246        INAME1(15)='THET'
40247        INAME2(15)='MLV '
40248        AVAL(15)=THETVL
40249        INAME1(16)='LAMB'
40250        INAME2(16)='MLV '
40251        AVAL(16)=ALAMVL
40252        INAME1(17)='COVM'
40253        INAME2(17)='L   '
40254        AVAL(17)=COVML
40255        NPAR=17
40256        GOTO8900
40257C
40258      ELSEIF(ICASAN.EQ.'GLOS')THEN
40259C
40260        CALL DPMLGS(Y,TEMP1,NS1,NUMV,
40261     1              TEMP2,TEMP3,TEMP4,DTEMP1,
40262     1              THETMO,BETAMO,THETFR,BETAFR,THETML,BETAML,
40263     1              ICAPSW,ICAPTY,IFORSW,MAXNXT,
40264     1              ISUBRO,IBUGA3,IERROR)
40265        IF(IERROR.EQ.'YES')GOTO9000
40266C
40267        INAME1(1)='THET'
40268        INAME2(1)='AMOM'
40269        AVAL(1)=THETMO
40270        INAME1(2)='BETA'
40271        INAME2(2)='MOM '
40272        AVAL(2)=BETAMO
40273        INAME1(3)='THET'
40274        INAME2(3)='AFR '
40275        AVAL(3)=THETFR
40276        INAME1(4)='BETA'
40277        INAME2(4)='FR  '
40278        AVAL(4)=BETAFR
40279        INAME1(5)='THET'
40280        INAME2(5)='AML '
40281        AVAL(5)=THETML
40282        INAME1(6)='BETA'
40283        INAME2(6)='ML  '
40284        AVAL(6)=BETAML
40285        NPAR=6
40286        GOTO8900
40287C
40288      ELSEIF(ICASAN.EQ.'GEET')THEN
40289C
40290        CALL DPMGET(Y,TEMP1,NS1,NUMV,
40291     1              TEMP2,TEMP3,TEMP4,DTEMP1,
40292     1              AMUMOM,BETAMO,AMUFR,BETAFR,AMUML,BETAML,
40293     1              ICAPSW,ICAPTY,IFORSW,MAXNXT,
40294     1              IGETDF,
40295     1              ISUBRO,IBUGA3,IERROR)
40296        IF(IERROR.EQ.'YES')GOTO9000
40297C
40298        INAME1(1)='MUMO'
40299        INAME2(1)='M   '
40300        AVAL(1)=AMUMOM
40301        INAME1(2)='BETA'
40302        INAME2(2)='MOM '
40303        AVAL(2)=BETAMO
40304        INAME1(3)='MUFR'
40305        INAME2(3)='    '
40306        AVAL(3)=AMUFR
40307        INAME1(4)='BETA'
40308        INAME2(4)='FR  '
40309        AVAL(4)=BETAFR
40310        INAME1(5)='MUML'
40311        INAME2(5)='    '
40312        AVAL(5)=AMUML
40313        INAME1(6)='BETA'
40314        INAME2(6)='ML  '
40315        AVAL(6)=BETAML
40316        NPAR=6
40317        GOTO8900
40318C
40319      ELSEIF(ICASAN.EQ.'CONS')THEN
40320C
40321        CALL DPMLCN(Y,TEMP1,NS1,NUMV,
40322     1              TEMP2,TEMP3,TEMP4,DTEMP1,
40323     1              AMUMOM,AMMO,AMUFR,AMFR,AMUML,AMML,
40324     1              ICAPSW,ICAPTY,IFORSW,MAXNXT,
40325     1              ICONDF,
40326     1              ISUBRO,IBUGA3,IERROR)
40327        IF(IERROR.EQ.'YES')GOTO9000
40328C
40329        INAME1(1)='MUMO'
40330        INAME2(1)='M   '
40331        AVAL(1)=AMUMOM
40332        INAME1(2)='MMOM'
40333        INAME2(2)='    '
40334        AVAL(2)=AMMOM
40335        INAME1(3)='MUFR'
40336        INAME2(3)='    '
40337        AVAL(3)=AMUFR
40338        INAME1(4)='MFR '
40339        INAME2(4)='    '
40340        AVAL(4)=AMFR
40341        INAME1(5)='MUML'
40342        INAME2(5)='    '
40343        AVAL(5)=AMUML
40344        INAME1(6)='MML '
40345        INAME2(6)='    '
40346        AVAL(6)=AMML
40347        NPAR=6
40348        GOTO8900
40349C
40350      ELSEIF(ICASAN.EQ.'GNBI')THEN
40351C
40352        CALL DPMGNB(Y,TEMP1,NS1,NUMV,
40353     1              TEMP2,TEMP3,TEMP4,DTEMP1,
40354     1              THETMO,BETAMO,AMMOM,
40355     1              THETFR,BETAFR,AMFR,
40356     1              THETF2,BETAF2,AMF2,
40357     1              THETML,BETAML,AMML,
40358     1              ICAPSW,ICAPTY,IFORSW,MAXNXT,
40359     1              ISUBRO,IBUGA3,IERROR)
40360        IF(IERROR.EQ.'YES')GOTO9000
40361C
40362        INAME1(1)='THET'
40363        INAME2(1)='AMOM'
40364        AVAL(1)=THETMO
40365        INAME1(2)='BETA'
40366        INAME2(2)='MOM '
40367        AVAL(2)=BETAMO
40368        INAME1(3)='MMOM'
40369        INAME2(3)='    '
40370        AVAL(3)=AMMOM
40371        INAME1(4)='THET'
40372        INAME2(4)='AFR '
40373        AVAL(4)=THETFR
40374        INAME1(5)='BETA'
40375        INAME2(5)='FR  '
40376        AVAL(5)=BETAFR
40377        INAME1(6)='MFR '
40378        INAME2(6)='    '
40379        AVAL(6)=AMFR
40380        INAME1(7)='THET'
40381        INAME2(7)='AZF '
40382        AVAL(7)=THETF2
40383        INAME1(8)='BETA'
40384        INAME2(8)='ZF  '
40385        AVAL(8)=BETAF2
40386        INAME1(9)='MZF '
40387        INAME2(9)='    '
40388        AVAL(9)=AMF2
40389        INAME1(10)='THET'
40390        INAME2(10)='AML '
40391        AVAL(10)=THETML
40392        INAME1(11)='BETA'
40393        INAME2(11)='ML  '
40394        AVAL(11)=BETAML
40395        INAME1(12)='MML '
40396        INAME2(12)='    '
40397        AVAL(12)=AMML
40398        NPAR=12
40399        GOTO8900
40400C
40401      ELSEIF(ICASAN.EQ.'KATZ')THEN
40402C
40403        CALL DPMLKA(Y,TEMP1,NS1,NUMV,
40404     1              TEMP2,TEMP3,TEMP4,
40405     1              ALPHMO,BETAMO,ALPHML,BETAML,
40406     1              AICMO,AICCMO,BICMO,
40407     1              AICML,AICCML,BICML,
40408     1              ICAPSW,ICAPTY,IFORSW,MAXNXT,
40409     1              ISUBRO,IBUGA3,IERROR)
40410        IF(IERROR.EQ.'YES')GOTO9000
40411C
40412        INAME1(1)='ALPH'
40413        INAME2(1)='AMOM'
40414        AVAL(1)=ALPHMO
40415        INAME1(2)='BETA'
40416        INAME2(2)='MOM '
40417        AVAL(2)=BETAMO
40418        NPAR=2
40419        GOTO8900
40420C
40421      ELSEIF(ICASAN.EQ.'LKAT')THEN
40422C
40423        CALL DPMLLK(Y,TEMP1,NS1,NUMV,
40424     1              TEMP2,TEMP3,TEMP4,DTEMP1,
40425     1              AMOM,BETAMO,BMOM,
40426     1              AFR,BETAFR,BFR,
40427     1              AML,BETAML,BML,
40428     1              ICAPSW,ICAPTY,IFORSW,MAXNXT,
40429     1              ISUBRO,IBUGA3,IERROR)
40430        IF(IERROR.EQ.'YES')GOTO9000
40431C
40432        INAME1(1)='AMOM'
40433        INAME2(1)='    '
40434        AVAL(1)=AMOM
40435        INAME1(2)='BETA'
40436        INAME2(2)='MOM '
40437        AVAL(2)=BETAMO
40438        INAME1(3)='BMOM'
40439        INAME2(3)='    '
40440        AVAL(3)=BMOM
40441        INAME1(4)='AFR '
40442        INAME2(4)='    '
40443        AVAL(4)=AFR
40444        INAME1(5)='BETA'
40445        INAME2(5)='FR  '
40446        AVAL(5)=BETAFR
40447        INAME1(6)='BFR '
40448        INAME2(6)='    '
40449        AVAL(6)=BFR
40450        INAME1(7)='AML '
40451        INAME2(7)='    '
40452        AVAL(7)=AML
40453        INAME1(8)='BETA'
40454        INAME2(8)='ML  '
40455        AVAL(8)=BETAML
40456        INAME1(9)='BML '
40457        INAME2(9)='    '
40458        AVAL(9)=BML
40459        NPAR=9
40460        GOTO8900
40461C
40462      ELSEIF(ICASAN.EQ.'QBIN')THEN
40463C
40464        IHP='M   '
40465        IHP2='    '
40466        IHWUSE='P'
40467        MESSAG='YES'
40468        CALL CHECKN(IHP,IHP2,IHWUSE,
40469     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
40470     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
40471        IF(IERROR.EQ.'YES')GOTO9000
40472        AM=VALUE(ILOCP)
40473C
40474        IHP='PSTA'
40475        IHP2='RT  '
40476        IHWUSE='P'
40477        MESSAG='NO'
40478        CALL CHECKN(IHP,IHP2,IHWUSE,
40479     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
40480     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
40481        IF(IERROR.EQ.'YES')THEN
40482          PSTART=-1.0
40483        ELSE
40484          PSTART=VALUE(ILOCP)
40485        ENDIF
40486C
40487        IHP='PHIS'
40488        IHP2='TART'
40489        IHWUSE='P'
40490        MESSAG='NO'
40491        CALL CHECKN(IHP,IHP2,IHWUSE,
40492     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
40493     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
40494        IF(IERROR.EQ.'YES')THEN
40495          PHISTR=-1.0
40496        ELSE
40497          PHISTR=VALUE(ILOCP)
40498        ENDIF
40499C
40500        CALL DPMLQB(Y,TEMP1,NS1,NUMV,
40501     1              TEMP2,TEMP3,TEMP4,DTEMP1,
40502     1              TEMP5,ITEMP1,
40503     1              PSTART,PHISTR,
40504     1              PML,PHIML,AM,PVARXX,PHIVAR,PPHCOV,
40505     1              ICAPSW,ICAPTY,IFORSW,MAXNXT,
40506     1              ISUBRO,IBUGA3,IERROR)
40507        IF(IERROR.EQ.'YES')GOTO9000
40508C
40509        INAME1(1)='PML '
40510        INAME2(1)='    '
40511        AVAL(1)=PML
40512        INAME1(2)='PHIM'
40513        INAME2(2)='L   '
40514        AVAL(2)=PHIML
40515        INAME1(3)='PVAR'
40516        INAME2(3)='    '
40517        AVAL(3)=PVARXX
40518        INAME1(4)='PHIV'
40519        INAME2(4)='AR  '
40520        AVAL(4)=PHIVAR
40521        INAME1(5)='PPHI'
40522        INAME2(5)='COV '
40523        AVAL(5)=PPHCOV
40524        NPAR=5
40525        GOTO8900
40526C
40527      ELSEIF(ICASAN.EQ.'LOST')THEN
40528C
40529        CALL DPMLLS(Y,TEMP1,NS1,NUMV,
40530     1              TEMP2,TEMP3,TEMP4,MAXNXT,
40531     1              RHAT,PHAT,
40532     1              AIC,AICC,BIC,
40533     1              ICAPSW,ICAPTY,IFORSW,
40534     1              ISUBRO,IBUGA3,IERROR)
40535        IF(IERROR.EQ.'YES')GOTO9000
40536C
40537        INAME1(1)='RML '
40538        INAME2(1)='    '
40539        AVAL(1)=RHAT
40540        INAME1(2)='PML '
40541        INAME2(2)='    '
40542        AVAL(2)=PHAT
40543        NPAR=2
40544        GOTO8900
40545C
40546      ELSEIF(ICASAN.EQ.'GLGP')THEN
40547C
40548        CALL DPMLGG(Y,TEMP1,NS1,NUMV,
40549     1              TEMP2,TEMP3,TEMP4,DTEMP1,
40550     1              PMOM,AMOM,PML,AML,PVARML,AVARML,COVML,
40551     1              ICAPSW,ICAPTY,IFORSW,MAXNXT,
40552     1              ISUBRO,IBUGA3,IERROR)
40553        IF(IERROR.EQ.'YES')GOTO9000
40554C
40555        INAME1(1)='PML '
40556        INAME2(1)='    '
40557        AVAL(1)=PML
40558        INAME1(2)='AML '
40559        INAME2(2)='    '
40560        AVAL(2)=AML
40561        INAME1(3)='PMOM'
40562        INAME2(3)='    '
40563        AVAL(3)=PMOM
40564        INAME1(4)='AMOM'
40565        INAME2(4)='    '
40566        AVAL(4)=AMOM
40567        NPAR=4
40568        GOTO8900
40569C
40570      ELSEIF(ICASAN.EQ.'AEPP')THEN
40571C
40572        CALL DPMLAE(Y,TEMP1,NS1,NUMV,
40573     1              TEMP2,TEMP3,TEMP4,DTEMP1,
40574     1              THETMO,PMO,THETFR,PFR,THETF2,PF2,THETML,PML,
40575     1              ICAPSW,ICAPTY,IFORSW,MAXNXT,
40576     1              ISUBRO,IBUGA3,IERROR)
40577        IF(IERROR.EQ.'YES')GOTO9000
40578C
40579        INAME1(1)='THET'
40580        INAME2(1)='AMOM'
40581        AVAL(1)=THETMO
40582        INAME1(2)='PMOM'
40583        INAME2(2)='    '
40584        AVAL(2)=PMOM
40585        INAME1(3)='THET'
40586        INAME2(3)='AFR '
40587        AVAL(3)=THETFR
40588        INAME1(4)='PFR '
40589        INAME2(4)='    '
40590        AVAL(4)=PFR
40591        INAME1(5)='THET'
40592        INAME2(5)='AF2 '
40593        AVAL(5)=THETF2
40594        INAME1(6)='PF2 '
40595        INAME2(6)='    '
40596        AVAL(6)=PF2
40597        INAME1(7)='THET'
40598        INAME2(7)='AML '
40599        AVAL(7)=THETML
40600        INAME1(8)='PML '
40601        INAME2(8)='    '
40602        AVAL(8)=PML
40603        NPAR=8
40604        GOTO8900
40605C
40606      ELSEIF(ICASAN.EQ.'LOGN')THEN
40607C
40608        IOP='OPEN'
40609        IFLAG1=1
40610        IFLAG2=0
40611        IFLAG3=0
40612        IFLAG4=0
40613        IFLAG5=0
40614        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
40615     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
40616     1              IBUGA3,ISUBRO,IERROR)
40617        IF(IERROR.EQ.'YES')GOTO9000
40618C
40619        IF(NUMV.EQ.1)THEN
40620          CALL DPMLL1(Y,NS1,MAXNXT,TEMP1,
40621     1                SIGMA,SIGMSE,SCALE,SCALSE,UHAT,UHATSE,
40622     1                NUMV,
40623     1                ICAPSW,ICAPTY,IFORSW,
40624     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
40625     1                IOUNI1,IOUNI2,ALPHA,
40626     1                ISUBRO,IBUGA3,IERROR)
40627          COVSE=0.0
40628          IF(IERROR.EQ.'YES')GOTO9000
40629        ELSEIF(NUMV.EQ.2)THEN
40630          CALL DPMLL2(Y,TEMP1,NS1,
40631     1                TEMP2,TEMP3,DTEMP1,ITEMP1,MAXNXT,
40632     1                SIGMA,SIGMSE,SCALE,SCALSE,UHAT,UHATSE,COVSE,
40633     1                NUMV,TEND,
40634     1                ICAPSW,ICAPTY,IFORSW,
40635     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPLC2,XQPUC2,XQPSE,NPERC,
40636     1                IOUNI1,IOUNI2,ALPHA,
40637     1                ISUBRO,IBUGA3,IERROR)
40638          IF(IERROR.EQ.'YES')GOTO9000
40639        ENDIF
40640C
40641        IOP='CLOS'
40642        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
40643     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
40644     1              IBUGA3,ISUBRO,IERROR)
40645C
40646        INAME1(1)='SIGM'
40647        INAME2(1)='AML '
40648        AVAL(1)=SIGMA
40649        INAME1(2)='SIGM'
40650        INAME2(2)='ASE '
40651        AVAL(2)=SIGMSE
40652        INAME1(3)='SCAL'
40653        INAME2(3)='EML '
40654        AVAL(3)=SCALE
40655        INAME1(4)='SCAL'
40656        INAME2(4)='ESE '
40657        AVAL(4)=SCALSE
40658        INAME1(5)='UHAT'
40659        INAME2(5)='ML  '
40660        AVAL(5)=UHAT
40661        INAME1(6)='UHAT'
40662        INAME2(6)='SE  '
40663        AVAL(6)=UHATSE
40664        INAME1(7)='COVS'
40665        INAME2(7)='E   '
40666        AVAL(7)=COVSE
40667        NPAR=7
40668        GOTO8900
40669C
40670      ELSEIF(ICASAN.EQ.'3LGN')THEN
40671C
40672        IOP='OPEN'
40673        IFLAG1=1
40674        IFLAG2=0
40675        IFLAG3=0
40676        IFLAG4=0
40677        IFLAG5=0
40678        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
40679     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
40680     1              IBUGA3,ISUBRO,IERROR)
40681        IF(IERROR.EQ.'YES')GOTO9000
40682C
40683        IF(NUMV.EQ.1)THEN
40684          CALL DPMLL3(Y,TEMP1,NS1,
40685     1                XTEMP1,DTEMP1,ITEMP1,MAXNXT,
40686     1                ALOCML,SCALML,SHAPML,UHATML,
40687     1                ALOCSE,SCALSE,SHAPSE,UHATSE,
40688     1                ALOCMO,SCALMO,SHAPMO,UHATMO,
40689     1                ALOCMM,SCALMM,SHAPMM,UHATMM,
40690     1                ALOCS2,SCALS2,SHAPS2,UHATS2,
40691     1                AICML,AICCML,BICML,ALIKML,
40692     1                AICMO,AICCMO,BICMO,ALIKMO,
40693     1                AICMM,AICCMM,BICMM,ALIKMM,
40694     1                NUMV,
40695     1                ICAPSW,ICAPTY,IFORSW,
40696     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
40697     1                IOUNI1,IOUNI2,ALPHA,
40698     1                ISUBRO,IBUGA3,IERROR)
40699C
40700          INAME1(1)='SIGM'
40701          INAME2(1)='AML '
40702          AVAL(1)=SHAPML
40703          INAME1(2)='SIGM'
40704          INAME2(2)='ASE '
40705          AVAL(2)=SHAPSE
40706          INAME1(3)='SCAL'
40707          INAME2(3)='EML '
40708          AVAL(3)=SCALML
40709          INAME1(4)='SCAL'
40710          INAME2(4)='ESE '
40711          AVAL(4)=SCALSE
40712          INAME1(5)='UHAT'
40713          INAME2(5)='ML  '
40714          AVAL(5)=UHATML
40715          INAME1(6)='UHAT'
40716          INAME2(6)='SE  '
40717          AVAL(6)=UHATSE
40718          INAME1(7)='LOCM'
40719          INAME2(7)='L   '
40720          AVAL(7)=ALOCML
40721          INAME1(8)='LOCS'
40722          INAME2(8)='E   '
40723          AVAL(8)=ALOCSE
40724          INAME1(9)='SIGM'
40725          INAME2(9)='AMM '
40726          AVAL(9)=SHAPMM
40727          INAME1(10)='SIGM'
40728          INAME2(10)='ASE2'
40729          AVAL(10)=SHAPS2
40730          INAME1(11)='SCAL'
40731          INAME2(11)='EMM '
40732          AVAL(11)=SCALMM
40733          INAME1(12)='SCAL'
40734          INAME2(12)='ESE2'
40735          AVAL(12)=SCALS2
40736          INAME1(13)='UHAT'
40737          INAME2(13)='MM  '
40738          AVAL(13)=UHATMM
40739          INAME1(14)='UHAT'
40740          INAME2(14)='SE2 '
40741          AVAL(14)=UHATS2
40742          INAME1(15)='LOCM'
40743          INAME2(15)='M   '
40744          AVAL(15)=ALOCMM
40745          INAME1(16)='LOCS'
40746          INAME2(16)='E2  '
40747          AVAL(16)=ALOCS2
40748          INAME1(17)='SIGM'
40749          INAME2(17)='AMOM'
40750          AVAL(17)=SHAPMO
40751          INAME1(18)='SCAL'
40752          INAME2(18)='EMOM'
40753          AVAL(18)=SCALMO
40754          INAME1(19)='LOCM'
40755          INAME2(19)='OM  '
40756          AVAL(19)=ALOCMO
40757          INAME1(20)='UHAT'
40758          INAME2(20)='MOM '
40759          AVAL(20)=UHATMO
40760          NPAR=20
40761          GOTO8100
40762        ENDIF
40763      ELSEIF(ICASAN.EQ.'EXPO' .OR. ICASAN.EQ.'1EXP')THEN
40764C
40765        IOP='OPEN'
40766        IFLAG1=1
40767        IFLAG2=1
40768        IFLAG3=0
40769        IFLAG4=0
40770        IFLAG5=0
40771        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
40772     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
40773     1              IBUGA3,ISUBRO,IERROR)
40774        IF(IERROR.EQ.'YES')GOTO9000
40775C
40776        IHP='TEND'
40777        IHP2='    '
40778        IHWUSE='P'
40779        MESSAG='NO'
40780        CALL CHECKN(IHP,IHP2,IHWUSE,
40781     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
40782     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
40783        TEND=0.0
40784        IF(IERROR.EQ.'NO')TEND=VALUE(ILOCP)
40785C
40786CCCCC   FULL SAMPLE CASE
40787C
40788        IF(NUMV.LE.1 .AND. (ICASAN.EQ.'EXPO' .OR. ICASAN.EQ.'1EXP'))THEN
40789          CALL DPMLE1(Y,NS1,ICASAN,
40790     1                TEMP1,MAXNXT,
40791     1                U,B1,B1SE,NUMV,
40792     1                ICAPSW,ICAPTY,IFORSW,
40793     1                QP,XQPHAT,XQPLCL,XQPUCL,NPERC,
40794     1                XQPHTZ,XQPLCZ,XQPUCZ,XQPSE,
40795     1                IOUNI1,IOUNI2,ALPHA,
40796     1                ISUBRO,IBUGA3,IERROR)
40797C
40798CCCCC   TIME CENSORED CASE
40799C
40800        ELSEIF(NUMV.EQ.2 .AND. ICENTY.EQ.'1'.AND. ICENSO.EQ.'ON' .AND.
40801     1         (ICASAN.EQ.'EXPO' .OR. ICASAN.EQ.'1EXP'))THEN
40802          CALL DPMLE2(Y,TEMP1,NS1,ICASAN,
40803     1                TEMP2,MAXNXT,
40804     1                U,B1,B1SE,NUMV,TEND,
40805     1                ICAPSW,ICAPTY,IFORSW,
40806     1                QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,NPERC,
40807     1                XQPHTZ,XQPLCZ,XQPUCZ,
40808     1                IOUNI1,IOUNI2,ALPHA,
40809     1                ISUBRO,IBUGA3,IERROR)
40810C
40811CCCCC   NUMBER OF FAILURES CENSORED CASE
40812C
40813        ELSEIF(NUMV.EQ.2 .AND. ICENTY.EQ.'2'.AND. ICENSO.EQ.'ON' .AND.
40814     1         (ICASAN.EQ.'1EXP' .OR. ICASAN.EQ.'EXPO'))THEN
40815          CALL DPMLE3(Y,TEMP1,NS1,ICASAN,
40816     1                TEMP2,MAXNXT,
40817     1                U,B1,B1SE,NUMV,TEND,
40818     1                ICAPSW,ICAPTY,IFORSW,
40819     1                QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,NPERC,
40820     1                XQPHTZ,XQPLCZ,XQPUCZ,
40821     1                IOUNI1,IOUNI2,ALPHA,
40822     1                ISUBRO,IBUGA3,IERROR)
40823C
40824CCCCC   GROUPED DATA CASE
40825C
40826        ELSEIF(NUMV.GE.2 .AND. ICENSO.EQ.'OFF')THEN
40827          NPERC=0
40828          CALL DPMLE4(Y,TEMP1,TEMP2,NS1,
40829     1                TEMP3,TEMP4,TEMP5,MAXNXT,
40830     1                U,B1,B1SE,NUMV,TEND,
40831     1                ICAPSW,ICAPTY,IFORSW,
40832     1                QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,NPERC,
40833     1                IOUNI1,IOUNI2,ALPHA,
40834     1                ISUBRO,IBUGA3,IERROR)
40835        ENDIF
40836C
40837        IOP='CLOS'
40838        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
40839     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
40840     1              IBUGA3,ISUBRO,IERROR)
40841        IF(IERROR.EQ.'YES')GOTO9000
40842C
40843        INAME1(1)='SCAL'
40844        INAME2(1)='EML '
40845        AVAL(1)=B1
40846        INAME1(2)='SCAL'
40847        INAME2(2)='ESE '
40848        AVAL(2)=B1SE
40849        INAME1(3)='LOCM'
40850        INAME2(3)='L   '
40851        AVAL(3)=U
40852        NPAR=3
40853        GOTO8900
40854      ELSEIF(ICASAN.EQ.'DEXP')THEN
40855C
40856        CALL DPMLDE(Y,NS1,
40857     1              XTEMP1,MAXNXT,
40858     1              ALOC,SCALE,ALOCSE,SCALESE,
40859     1              ICAPSW,ICAPTY,IFORSW,
40860     1              ISUBRO,IBUGA3,IERROR)
40861        IF(IERROR.EQ.'YES')GOTO9000
40862C
40863        INAME1(1)='SCAL'
40864        INAME2(1)='EML '
40865        AVAL(1)=SCALE
40866        INAME1(2)='LOCM'
40867        INAME2(2)='L   '
40868        AVAL(2)=ALOC
40869        INAME1(3)='LOCS'
40870        INAME2(3)='E   '
40871        AVAL(3)=ALOCSE
40872        INAME1(4)='SCAL'
40873        INAME2(4)='ESE '
40874        AVAL(4)=SCALSE
40875        NPAR=4
40876        GOTO8900
40877C
40878      ELSEIF(ICASAN.EQ.'POWL')THEN
40879C
40880        IOP='OPEN'
40881        IFLAG1=1
40882        IFLAG2=1
40883        IFLAG3=0
40884        IFLAG4=0
40885        IFLAG5=0
40886        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
40887     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
40888     1              IBUGA3,ISUBRO,IERROR)
40889        IF(IERROR.EQ.'YES')GOTO9000
40890C
40891        IHP='TEND'
40892        IHP2='    '
40893        IHWUSE='P'
40894        MESSAG='NO'
40895        CALL CHECKN(IHP,IHP2,IHWUSE,
40896     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
40897     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
40898        TEND=0.0
40899        IF(IERROR.EQ.'NO')TEND=VALUE(ILOCP)
40900C
40901        NGROUP=0
40902        NCENS=0
40903        IF(NUMV.GE.2)NGROUP=NS1
40904        IF(NUMV.GE.3)NCENS=NS1
40905        CALL DPMLPL(Y,NS1,TEMP2,NGROUP,TEMP3,NCENS,NUMV,
40906     1              TEMP4,TEMP5,TEMP6,XTEMP1,
40907     1              QP,XQPHAT,XQPLCL,XQPSE,
40908     1              MAXNXT,
40909     1              TEND,
40910     1              ICAPSW,ICAPTY,IFORSW,
40911     1              IOUNI1,IOUNI2,ALPHA,
40912     1              AHAT,BHAT,AMTBF,
40913     1              ISUBRO,IBUGA3,IERROR)
40914C
40915        IOP='CLOS'
40916        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
40917     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
40918     1              IBUGA3,ISUBRO,IERROR)
40919        IF(IERROR.EQ.'YES')GOTO9000
40920C
40921        INAME1(1)='AHAT'
40922        INAME2(1)='    '
40923        AVAL(1)=AHAT
40924        INAME1(2)='BHAT'
40925        INAME2(2)='    '
40926        AVAL(2)=BHAT
40927        INAME1(3)='MTBF'
40928        INAME2(3)='HAT '
40929        AVAL(3)=AMTBF
40930        NPAR=3
40931        GOTO8900
40932C
40933      ELSEIF(ICASAN.EQ.'ELML')THEN
40934C
40935        IHP='TEND'
40936        IHP2='    '
40937        IHWUSE='P'
40938        MESSAG='NO'
40939        CALL CHECKN(IHP,IHP2,IHWUSE,
40940     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
40941     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
40942        TEND=0.0
40943        IF(IERROR.EQ.'NO')TEND=VALUE(ILOCP)
40944C
40945        CALL DPMLEL(Y,NS1,
40946     1              TEND,
40947     1              ICAPSW,ICAPTY,IFORSW,
40948     1              AHAT,BHAT,
40949     1              ISUBRO,IBUGA3,IERROR)
40950C
40951        IF(IERROR.EQ.'YES')GOTO9000
40952C
40953        INAME1(1)='AHAT'
40954        INAME2(1)='    '
40955        AVAL(1)=AHAT
40956        INAME1(2)='BHAT'
40957        INAME2(2)='    '
40958        AVAL(2)=BHAT
40959        NPAR=2
40960        GOTO8900
40961C
40962      ELSEIF(ICASAN.EQ.'ADEX')THEN
40963C
40964        CALL DPMLAD(Y,NS1,MAXOBV,
40965     1              TEMP1,ITEMP1,DTEMP1,DTEMP2,DTEMP3,
40966     1              AKML,ALOCML,SCALML,
40967     1              ICAPSW,ICAPTY,IFORSW,
40968     1              ISUBRO,IBUGA3,IERROR)
40969C
40970C       UPDATE PARAMETERS EVEN IF ERROR.  ML DOES NOT EXIST FOR
40971C       SOME DATA SETS, DPMLAD WILL SET PARAMETERS TO CPUMIN
40972C       IF THIS DETECTED.  SETTING PARAMETER WILL ALLOW USER
40973C       EXPLICITLY CHECK (USEFUL FOR AUTOMATING IN BATCH JOBS).
40974C
40975CCCCC   IF(IERROR.EQ.'YES')GOTO9000
40976C
40977        INAME1(1)='SCAL'
40978        INAME2(1)='EML '
40979        AVAL(1)=SCALML
40980        INAME1(2)='LOCM'
40981        INAME2(2)='L   '
40982        AVAL(2)=ALOCML
40983        INAME1(3)='KML '
40984        INAME2(3)='    '
40985        AVAL(3)=AKML
40986        NPAR=3
40987        GOTO8900
40988C
40989      ELSEIF(ICASAN.EQ.'VONM')THEN
40990C
40991        CALL DPMLVM(Y,NS1,MAXNXT,
40992     1              XKAPPA,ALOC,
40993     1              ICAPSW,ICAPTY,IFORSW,
40994     1              ISUBRO,IBUGA3,IERROR)
40995        IF(IERROR.EQ.'YES')GOTO9000
40996C
40997        INAME1(1)='KAPP'
40998        INAME2(1)='AML '
40999        AVAL(1)=XKAPPA
41000        INAME1(2)='LOCM'
41001        INAME2(2)='L   '
41002        AVAL(2)=ALOC
41003        NPAR=2
41004        GOTO8900
41005C
41006      ELSEIF(ICASAN.EQ.'EV1 ')THEN
41007C
41008        IOP='OPEN'
41009        IFLAG1=1
41010        IFLAG2=1
41011        IFLAG3=0
41012        IFLAG4=0
41013        IFLAG5=0
41014        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
41015     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
41016     1              IBUGA3,ISUBRO,IERROR)
41017        IF(IERROR.EQ.'YES')GOTO9000
41018C
41019        IF(NUMV.EQ.1)THEN
41020          CALL DPMGU1(Y,NS1,
41021     1                TEMP1,DTEMP1,MAXNXT,
41022     1                SCALML,SCALSE,SCALMO,SCMOSE,
41023     1                UHATML,UHATSE,UHATMO,UMOMSE,COVSE,
41024     1                NUMV,
41025     1                ICAPSW,ICAPTY,IFORSW,MINMAX,
41026     1                QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,NPERC,
41027     1                XQPHTZ,XQPLCZ,XQPUCZ,
41028     1                IOUNI1,IOUNI2,ALPHA,
41029     1                ISUBRO,IBUGA3,IERROR)
41030        ELSEIF(NUMV.EQ.2)THEN
41031CCCCC     CALL DPMGU2(Y,TEMP1,N,
41032CCCCC1                TEMP2,DTEMP1,MAXNXT,
41033CCCCC1                SCALML,SCA2ML,SCALSE,SCALMO,UHAT,UHATSE,UHATMO,
41034CCCCC1                NUMV,ICENTY,TEND,
41035CCCCC1                ICAPSW,ICAPTY,IGUMBC,MINMAX,
41036CCCCC1                QP,XQPHAT,XQPLCL,XQPUCL,NPERC,
41037CCCCC1                XQPHTZ,XQPLCZ,XQPUCZ,
41038CCCCC1                IOUNI1,IOUNI2,ALPHA,
41039CCCCC1                ISUBRO,IBUGA3,IERROR)
41040        ENDIF
41041        IOP='CLOS'
41042        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
41043     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
41044     1              IBUGA3,ISUBRO,IERROR)
41045        IF(IERROR.EQ.'YES')GOTO9000
41046C
41047        INAME1(1)='SCAL'
41048        INAME2(1)='EML '
41049        AVAL(1)=SCALML
41050        INAME1(2)='SCAL'
41051        INAME2(2)='ESE '
41052        AVAL(2)=SCALSE
41053        INAME1(3)='SCAL'
41054        INAME2(3)='EMOM'
41055        AVAL(3)=SCALMO
41056        INAME1(4)='SCAM'
41057        INAME2(4)='OMSE'
41058        AVAL(4)=SCMOSE
41059        INAME1(5)='COVS'
41060        INAME2(5)='E   '
41061        AVAL(5)=COVSE
41062        INAME1(6)='UHAT'
41063        INAME2(6)='ML  '
41064        AVAL(6)=UHATML
41065        INAME1(7)='UHAT'
41066        INAME2(7)='SE  '
41067        AVAL(7)=UHATSE
41068        INAME1(8)='UHAT'
41069        INAME2(8)='MOM '
41070        AVAL(8)=UHATMO
41071        INAME1(9)='UMOM'
41072        INAME2(9)='SE  '
41073        AVAL(9)=UMOMSE
41074        INAME1(10)='COVS'
41075        INAME2(10)='E   '
41076        AVAL(10)=COVSE
41077        NPAR=10
41078        GOTO8900
41079C
41080      ELSEIF(ICASAN.EQ.'LOGI')THEN
41081C
41082        CALL DPMLLO(Y,NS1,
41083     1              TEMP1,DTEMP1,MAXNXT,
41084     1              ALOC,SCALE,
41085     1              ICAPSW,ICAPTY,IFORSW,
41086     1              ISUBRO,IBUGA3,IERROR)
41087        IF(IERROR.EQ.'YES')GOTO9000
41088C
41089        INAME1(1)='LOCM'
41090        INAME2(1)='L   '
41091        AVAL(1)=ALOC
41092        INAME1(2)='SCAL'
41093        INAME2(2)='EML '
41094        AVAL(2)=SCALE
41095        NPAR=2
41096        GOTO8900
41097C
41098      ELSEIF(ICASAN.EQ.'SLAS')THEN
41099C
41100        CALL DPMLSL(Y,NS1,
41101     1              TEMP1,TEMP2,TEMP3,DTEMP1,MAXNXT,
41102     1              ALOC,SCALE,
41103     1              ICAPSW,ICAPTY,IFORSW,
41104     1              ISUBRO,IBUGA3,IERROR)
41105        IF(IERROR.EQ.'YES')GOTO9000
41106C
41107        INAME1(1)='LOCM'
41108        INAME2(1)='L   '
41109        AVAL(1)=ALOC
41110        INAME1(2)='SCAL'
41111        INAME2(2)='EML '
41112        AVAL(2)=SCALE
41113        NPAR=2
41114        GOTO8900
41115C
41116      ELSEIF(ICASAN.EQ.'CAUC')THEN
41117C
41118        CALL DPMLCA(Y,NS1,
41119     1              TEMP1,TEMP2,DTEMP1,MAXNXT,
41120     1              ALOC,SCALE,ALOCOS,ASCLOS,ALOWOS,SCAWOS,
41121     1              ICAPSW,ICAPTY,IFORSW,
41122     1              ISUBRO,IBUGA3,IERROR)
41123        IF(IERROR.EQ.'YES')GOTO9000
41124C
41125        INAME1(1)='LOCM'
41126        INAME2(1)='L   '
41127        AVAL(1)=ALOC
41128        INAME1(2)='SCAL'
41129        INAME2(2)='EML '
41130        AVAL(2)=SCALE
41131        INAME1(3)='LOCO'
41132        INAME2(3)='S   '
41133        AVAL(3)=ALOCOS
41134        INAME1(4)='SCAL'
41135        INAME2(4)='EOS '
41136        AVAL(4)=ASCLOS
41137        INAME1(5)='LOCW'
41138        INAME2(5)='OS  '
41139        AVAL(5)=ALOWOS
41140        INAME1(6)='SCAL'
41141        INAME2(6)='EWOS'
41142        AVAL(6)=SCAWOS
41143        NPAR=6
41144        GOTO8900
41145      ELSEIF(ICASAN.EQ.'BBIN' .OR. ICASAN.EQ.'POLY')THEN
41146C
41147        IF(NTRIAL.LE.0)THEN
41148          IHP='NTRI'
41149          IHP2='AL  '
41150          IHWUSE='P'
41151          MESSAG='YES'
41152          CALL CHECKN(IHP,IHP2,IHWUSE,
41153     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41154     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41155          IF(IERROR.EQ.'YES')GOTO9000
41156        ENDIF
41157C
41158        CALL DPMLBB(Y,TEMP1,NS1,NUMV,NTRIAL,
41159     1              TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,
41160     1              DTEMP1,DTEMP2,ITEMP1,ITEMP2,ITEMP3,MAXNXT,
41161     1              AMUML,THETML,ALPHML,BETAML,
41162     1              ICASAN,ICAPSW,ICAPTY,IFORSW,
41163     1              ISUBRO,IBUGA3,IERROR)
41164        IF(IERROR.EQ.'YES')GOTO9000
41165C
41166        INAME1(1)='ALPH'
41167        INAME2(1)='AML '
41168        AVAL(1)=ALPHML
41169        INAME1(2)='BETA'
41170        INAME2(2)='ML  '
41171        AVAL(2)=BETAML
41172        INAME1(3)='MUML'
41173        INAME2(3)='    '
41174        AVAL(3)=REAL(AMUML)
41175        INAME1(4)='THET'
41176        INAME2(4)='AML '
41177        AVAL(4)=REAL(THETML)
41178        NPAR=4
41179        GOTO8900
41180C
41181      ELSEIF(ICASAN.EQ.'PARE')THEN
41182C
41183        CALL DPMLP1(Y,NS1,
41184     1              DTEMP1,MAXNXT,
41185     1              SHAPML,AML,SHAPSE,AMLSE,
41186     1              SHAPMM,AMM,SHAPMO,AMOM,
41187     1              QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,NPERC,ALPHA,
41188     1              ICAPSW,ICAPTY,IFORSW,
41189     1              ISUBRO,IBUGA3,IERROR)
41190        IF(IERROR.EQ.'YES')GOTO9000
41191C
41192        INAME1(1)='GAMM'
41193        INAME2(1)='AML '
41194        AVAL(1)=SHAPML
41195        INAME1(2)='GAMM'
41196        INAME2(2)='ASE '
41197        AVAL(2)=SHAPSE
41198        INAME1(3)='AML '
41199        INAME2(3)='    '
41200        AVAL(3)=AML
41201        INAME1(4)='AMLS'
41202        INAME2(4)='E   '
41203        AVAL(4)=AMLSE
41204        INAME1(5)='GAMM'
41205        INAME2(5)='AMM '
41206        AVAL(5)=SHAPMM
41207        INAME1(6)='AMOD'
41208        INAME2(6)='MOM '
41209        AVAL(6)=AMM
41210        INAME1(7)='GAMM'
41211        INAME2(7)='AMOM'
41212        AVAL(7)=SHAPMO
41213        INAME1(8)='AMOM'
41214        INAME2(8)='    '
41215        AVAL(8)=AMOM
41216        NPAR=8
41217        GOTO8900
41218C
41219      ELSEIF(ICASAN.EQ.'UNIF')THEN
41220        CALL DPMLUN(Y,NS1,
41221     1              TEMP1,MAXNXT,
41222     1              ALOWLI,AUPPLI,ALOCML,ASCAML,AHAT,HHAT,
41223     1              ALOWL2,AUPPL2,ALOCMO,ASCAMO,
41224     1              ICAPSW,ICAPTY,IFORSW,
41225     1              ISUBRO,IBUGA3,IERROR)
41226        IF(IERROR.EQ.'YES')GOTO9000
41227C
41228        INAME1(1)='LOWL'
41229        INAME2(1)='IMIT'
41230        AVAL(1)=ALOWLI
41231        INAME1(2)='UPPL'
41232        INAME2(2)='IMIT'
41233        AVAL(2)=AUPPLI
41234        INAME1(3)='LOWL'
41235        INAME2(3)='IMI2'
41236        AVAL(3)=ALOWL2
41237        INAME1(4)='UPPL'
41238        INAME2(4)='IMI2'
41239        AVAL(4)=AUPPL2
41240        INAME1(5)='AHAT'
41241        INAME2(5)='    '
41242        AVAL(5)=AHAT
41243        INAME1(6)='HHAT'
41244        INAME2(6)='    '
41245        AVAL(6)=HHAT
41246        INAME1(7)='LOCM'
41247        INAME2(7)='L   '
41248        AVAL(7)=ALOCML
41249        INAME1(8)='SCAL'
41250        INAME2(8)='EML '
41251        AVAL(8)=ASCAML
41252        INAME1(9)='LOCM'
41253        INAME2(9)='OM  '
41254        AVAL(9)=ALOCMO
41255        INAME1(10)='SCAL'
41256        INAME2(10)='EMOM'
41257        AVAL(10)=ASCAMO
41258        NPAR=10
41259        GOTO8900
41260C
41261      ELSEIF(ICASAN.EQ.'BETA')THEN
41262C
41263        IHP='BETA'
41264        IHP2='LL  '
41265        IHWUSE='P'
41266        MESSAG='NO'
41267        CALL CHECKN(IHP,IHP2,IHWUSE,
41268     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41269     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41270        AUSER=CPUMIN
41271        IF(IERROR.EQ.'NO')AUSER=VALUE(ILOCP)
41272C
41273        IHP='BETA'
41274        IHP2='UL  '
41275        IHWUSE='P'
41276        MESSAG='NO'
41277        CALL CHECKN(IHP,IHP2,IHWUSE,
41278     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41279     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41280        BUSER=CPUMIN
41281        IF(IERROR.EQ.'NO')BUSER=VALUE(ILOCP)
41282C
41283        IF(AUSER.EQ.CPUMIN .AND. BUSER.EQ.CPUMIN)THEN
41284          IHP='LOWL'
41285          IHP2='IMIT'
41286          IHWUSE='P'
41287          MESSAG='NO'
41288          CALL CHECKN(IHP,IHP2,IHWUSE,
41289     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41290     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41291          IF(IERROR.EQ.'NO')AUSER=VALUE(ILOCP)
41292C
41293          IHP='UPPL'
41294          IHP2='IMIT'
41295          IHWUSE='P'
41296          MESSAG='NO'
41297          CALL CHECKN(IHP,IHP2,IHWUSE,
41298     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41299     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41300          IF(IERROR.EQ.'NO')BUSER=VALUE(ILOCP)
41301        ENDIF
41302C
41303        IOP='OPEN'
41304        IFLAG1=1
41305        IFLAG2=1
41306        IFLAG3=0
41307        IFLAG4=0
41308        IFLAG5=0
41309        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
41310     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
41311     1              IBUGA3,ISUBRO,IERROR)
41312        IF(IERROR.EQ.'YES')GOTO9000
41313C
41314        CALL DPMLBE(Y,NS1,
41315     1              TEMP1,DTEMP1,MAXNXT,
41316     1              AUSER,BUSER,
41317     1              A,B,ALPHAM,BETAM,ALPHA,BETA,
41318     1              ALPHSE,BETASE,COVSE,
41319     1              QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
41320     1              IOUNI1,IOUNI2,ALPHA,
41321     1              ICAPSW,ICAPTY,IFORSW,
41322     1              ISUBRO,IBUGA3,IERROR)
41323        IOP='CLOS'
41324        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
41325     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
41326     1              IBUGA3,ISUBRO,IERROR)
41327        IF(IERROR.EQ.'YES')GOTO9000
41328C
41329        INAME1(1)='LOWL'
41330        INAME2(1)='IMIT'
41331        AVAL(1)=A
41332        INAME1(2)='UPPL'
41333        INAME2(2)='IMIT'
41334        AVAL(2)=B
41335        INAME1(3)='ALPH'
41336        INAME2(3)='AML '
41337        AVAL(3)=ALPHA
41338        INAME1(4)='ALPH'
41339        INAME2(4)='ASE '
41340        AVAL(4)=ALPHSE
41341        INAME1(5)='BETA'
41342        INAME2(5)='ML  '
41343        AVAL(5)=BETA
41344        INAME1(6)='BETA'
41345        INAME2(6)='SE  '
41346        AVAL(6)=BETASE
41347        INAME1(7)='COVS'
41348        INAME2(7)='E   '
41349        AVAL(7)=COVSE
41350        INAME1(8)='ALPH'
41351        INAME2(8)='AMOM'
41352        AVAL(8)=ALPHAM
41353        INAME1(9)='BETA'
41354        INAME2(9)='MOM '
41355        AVAL(9)=BETAM
41356        NPAR=9
41357        GOTO8900
41358C
41359      ELSEIF(ICASAN.EQ.'4BET')THEN
41360C
41361        CALL DPMLB4(Y,NS1,
41362     1              TEMP1,DTEMP1,MAXNXT,
41363     1              AMOM,BMOM,ALPHMO,BETAMO,
41364     1              AML,BML,ALPHML,BETAML,ICONF,
41365     1              QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
41366     1              IOUNI1,IOUNI2,ALPHA,
41367     1              ICAPSW,ICAPTY,IFORSW,MLFLAG,
41368     1              ISUBRO,IBUGA3,IERROR)
41369C
41370        IF(IERROR.EQ.'YES')GOTO9000
41371C
41372        INAME1(1)='AMOM'
41373        INAME2(1)='    '
41374        AVAL(1)=AMOM
41375        INAME1(2)='BMOM'
41376        INAME2(2)='    '
41377        AVAL(2)=BMOM
41378        INAME1(3)='ALPH'
41379        INAME2(3)='AMOM'
41380        AVAL(3)=ALPHMO
41381        INAME1(4)='BETA'
41382        INAME2(4)='MOM '
41383        AVAL(4)=BETAMO
41384        INAME1(5)='AML '
41385        INAME2(5)='    '
41386        AVAL(5)=AML
41387        INAME1(6)='BML '
41388        INAME2(6)='    '
41389        AVAL(6)=BML
41390        INAME1(7)='ALPH'
41391        INAME2(7)='AML '
41392        AVAL(7)=ALPHML
41393        INAME1(8)='BETA'
41394        INAME2(8)='ML  '
41395        AVAL(8)=BETAML
41396        INAME1(9)='BETA'
41397        INAME2(9)='CONV'
41398        AVAL(9)=REAL(ICONF)
41399        NPAR=9
41400        GOTO8900
41401C
41402      ELSEIF(ICASAN.EQ.'BNOR')THEN
41403C
41404        IHP='MUSV'
41405        IHP2='    '
41406        IHWUSE='P'
41407        MESSAG='NO'
41408        CALL CHECKN(IHP,IHP2,IHWUSE,
41409     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41410     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41411        AMUSV=CPUMIN
41412        IF(IERROR.EQ.'NO')AMUSV=VALUE(ILOCP)
41413C
41414        IHP='SIGM'
41415        IHP2='ASV '
41416        IHWUSE='P'
41417        MESSAG='NO'
41418        CALL CHECKN(IHP,IHP2,IHWUSE,
41419     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41420     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41421        SIGMSV=CPUMIN
41422        IF(IERROR.EQ.'NO')SIGMSV=VALUE(ILOCP)
41423C
41424        IHP='ALPH'
41425        IHP2='ASV '
41426        IHWUSE='P'
41427        MESSAG='NO'
41428        CALL CHECKN(IHP,IHP2,IHWUSE,
41429     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41430     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41431        ALPHSV=CPUMIN
41432        IF(IERROR.EQ.'NO')ALPHSV=VALUE(ILOCP)
41433C
41434        IHP='BETA'
41435        IHP2='SV  '
41436        IHWUSE='P'
41437        MESSAG='NO'
41438        CALL CHECKN(IHP,IHP2,IHWUSE,
41439     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41440     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41441        BETASV=CPUMIN
41442        IF(IERROR.EQ.'NO')BETASV=VALUE(ILOCP)
41443C
41444        CALL DPMLBN(Y,NS1,
41445     1              TEMP1,DTEMP1,MAXNXT,
41446     1              AMUSV,SIGMSV,ALPHSV,BETASV,
41447     1              AMUML,SIGMML,ALPHML,BETAML,
41448     1              ICAPSW,ICAPTY,IFORSW,
41449     1              ISUBRO,IBUGA3,IERROR)
41450C
41451        IF(IERROR.EQ.'YES')GOTO9000
41452C
41453        INAME1(1)='MUML'
41454        INAME2(1)='    '
41455        AVAL(1)=AMUML
41456        INAME1(2)='SIGM'
41457        INAME2(2)='AML '
41458        AVAL(2)=SIGMML
41459        INAME1(3)='ALPH'
41460        INAME2(3)='AML '
41461        AVAL(3)=ALPHML
41462        INAME1(4)='BETA'
41463        INAME2(4)='ML  '
41464        AVAL(4)=BETAML
41465        NPAR=4
41466        GOTO8900
41467C
41468      ELSEIF(ICASAN.EQ.'LBET')THEN
41469C
41470        IOP='OPEN'
41471        IFLAG1=1
41472        IFLAG2=1
41473        IFLAG3=0
41474        IFLAG4=0
41475        IFLAG5=0
41476        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
41477     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
41478     1              IBUGA3,ISUBRO,IERROR)
41479        IF(IERROR.EQ.'YES')GOTO9000
41480C
41481        IHP='CUSE'
41482        IHP2='R   '
41483        IHWUSE='P'
41484        MESSAG='NO'
41485        CALL CHECKN(IHP,IHP2,IHWUSE,
41486     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41487     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41488        CUSER=CPUMIN
41489        IF(IERROR.EQ.'NO')CUSER=VALUE(ILOCP)
41490C
41491        IHP='DUSE'
41492        IHP2='R   '
41493        IHWUSE='P'
41494        MESSAG='NO'
41495        CALL CHECKN(IHP,IHP2,IHWUSE,
41496     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41497     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41498        DUSER=CPUMIN
41499        IF(IERROR.EQ.'NO')DUSER=VALUE(ILOCP)
41500C
41501        IHP='ALPH'
41502        IHP2='ASV '
41503        IHWUSE='P'
41504        MESSAG='NO'
41505        CALL CHECKN(IHP,IHP2,IHWUSE,
41506     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41507     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41508        ALPHSV=CPUMIN
41509        IF(IERROR.EQ.'NO')ALPHSV=VALUE(ILOCP)
41510C
41511        IHP='BETA'
41512        IHP2='SV  '
41513        IHWUSE='P'
41514        MESSAG='NO'
41515        CALL CHECKN(IHP,IHP2,IHWUSE,
41516     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41517     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41518        BETASV=CPUMIN
41519        IF(IERROR.EQ.'NO')BETASV=VALUE(ILOCP)
41520C
41521        IHP='CSV '
41522        IHP2='    '
41523        IHWUSE='P'
41524        MESSAG='NO'
41525        CALL CHECKN(IHP,IHP2,IHWUSE,
41526     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41527     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41528        CSV=CPUMIN
41529        IF(IERROR.EQ.'NO')CSV=VALUE(ILOCP)
41530C
41531        IHP='DSV '
41532        IHP2='    '
41533        IHWUSE='P'
41534        MESSAG='NO'
41535        CALL CHECKN(IHP,IHP2,IHWUSE,
41536     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41537     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41538        DSV=CPUMIN
41539        IF(IERROR.EQ.'NO')DSV=VALUE(ILOCP)
41540C
41541        CALL DPMLLB(Y,NS1,
41542     1              TEMP1,TEMP2,MAXNXT,CUSER,DUSER,
41543     1              ALPHSV,BETASV,CSV,DSV,
41544     1              A,B,ALPHA,BETA,ALPHAM,BETAM,
41545     1              ALPHSE,BETASE,COVSE,
41546     1              QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
41547     1              IOUNI1,IOUNI2,ALPHA,
41548     1              ICAPSW,ICAPTY,IFORSW,DTEMP1,
41549     1              ISUBRO,IBUGA3,IERROR)
41550        IOP='CLOS'
41551        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
41552     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
41553     1              IBUGA3,ISUBRO,IERROR)
41554        IF(IERROR.EQ.'YES')GOTO9000
41555C
41556        INAME1(1)='LOWL'
41557        INAME2(1)='IMIT'
41558        AVAL(1)=A
41559        INAME1(2)='UPPL'
41560        INAME2(2)='IMIT'
41561        AVAL(2)=B
41562        INAME1(3)='ALPH'
41563        INAME2(3)='AML '
41564        AVAL(3)=ALPHA
41565        INAME1(4)='ALPH'
41566        INAME2(4)='ASE '
41567        AVAL(4)=ALPHSE
41568        INAME1(5)='BETA'
41569        INAME2(5)='ML  '
41570        AVAL(5)=BETA
41571        INAME1(6)='BETA'
41572        INAME2(6)='SE  '
41573        AVAL(6)=BETASE
41574        INAME1(7)='COVS'
41575        INAME2(7)='E   '
41576        AVAL(7)=COVSE
41577        INAME1(8)='ALPH'
41578        INAME2(8)='AMOM'
41579        AVAL(8)=ALPHAM
41580        INAME1(9)='BETA'
41581        INAME2(9)='MOM '
41582        AVAL(9)=BETAM
41583        NPAR=9
41584        GOTO8900
41585C
41586      ELSEIF(ICASAN.EQ.'POWN')THEN
41587C
41588C     1. RAW DATA, NO CENSORING: SET DTEMP1 AND DTEMP2 EQUAL
41589C        TO THE RAW DATA VALUE.
41590C
41591C     2. INTERVAL DATA:
41592C
41593C          SET DTEMP1 A
41594C
41595        CALL DPMLPN(DTEMP1,DTEMP2,DTEMP3,N,
41596     1              DTEMP4,DTEMP5,DTEMP6,ITEMP1,
41597     1              ILOG,IPRNT,ICAPTY,ICAPSW,
41598     1              ISUBRO,IBUGA3,IERROR)
41599C
41600      ELSEIF(ICASAN.EQ.'PLGN')THEN
41601      ELSEIF(ICASAN.EQ.'POWF' .OR. ICASAN.EQ.'RPOW')THEN
41602C
41603        IHP='LOWL'
41604        IHP2='IMIT'
41605        IHWUSE='P'
41606        MESSAG='NO'
41607        CALL CHECKN(IHP,IHP2,IHWUSE,
41608     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41609     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41610        A=CPUMIN
41611        IF(IERROR.EQ.'NO')A=VALUE(ILOCP)
41612C
41613        IHP='UPPL'
41614        IHP2='IMIT'
41615        IHWUSE='P'
41616        MESSAG='NO'
41617        CALL CHECKN(IHP,IHP2,IHWUSE,
41618     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41619     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41620        B=CPUMIN
41621        IF(IERROR.EQ.'NO')B=VALUE(ILOCP)
41622C
41623        ITYPML='POWE'
41624        IF(ICASAN.EQ.'RPOW')ITYPML='RPOW'
41625        CALL DPMLPW(Y,TEMP5,TEMP6,NS1,NUMV,ITYPML,A,B,
41626     1              XTEMP1,TEMP3,TEMP4,MAXNXT,
41627     1              CML,CMOM,CSE,
41628     1              ALIK,AIC,AICC,BIC,
41629     1              ICAPSW,ICAPTY,IFORSW,
41630     1              ISUBRO,IBUGA3,IERROR)
41631        IF(IERROR.EQ.'YES')GOTO9000
41632C
41633        INAME1(1)='CML '
41634        INAME2(1)='    '
41635        AVAL(1)=CML
41636        INAME1(2)='CSE '
41637        INAME2(2)='    '
41638        AVAL(2)=CSE
41639        INAME1(3)='CMOM'
41640        INAME2(3)='    '
41641        AVAL(3)=CMOM
41642        NPAR=3
41643        GOTO8100
41644C
41645      ELSEIF(ICASAN.EQ.'GAMM' .OR. ICASAN.EQ.'IGAM')THEN
41646C
41647        IOP='OPEN'
41648        IFLAG1=1
41649        IFLAG2=1
41650        IFLAG3=0
41651        IFLAG4=0
41652        IFLAG5=0
41653        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
41654     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
41655     1              IBUGA3,ISUBRO,IERROR)
41656        IF(IERROR.EQ.'YES')GOTO9000
41657C
41658        IGAMFL='GAMM'
41659        IF(ICASAN.EQ.'IGAM')IGAMFL='IGAM'
41660C
41661        IF(NUMV.EQ.1)THEN
41662          CALL DPMLG1(Y,NS1,
41663     1                TEMP1,DTEMP1,MAXNXT,
41664     1                SCALMO,GAMMMO,SCALML,SCALSE,GAMMML,GAMMSE,COVSE,
41665     1                AIC,AICC,BIC,ALIKE,
41666     1                ICAPSW,ICAPTY,IGAMFL,IFORSW,
41667     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
41668     1                IOUNI1,IOUNI2,ALPHA,
41669     1                ISUBRO,IBUGA3,IERROR)
41670        ELSEIF(NUMV.EQ.2)THEN
41671          CALL DPMLG2(Y,TEMP1,NS1,
41672     1                TEMP2,TEMP3,TEMP4,DTEMP1,ITEMP1,MAXNXT,
41673     1                SCALMO,GAMMMO,SCALML,SCALSE,GAMMML,GAMMSE,COVSE,
41674     1                NUMV,TEND,
41675     1                ICAPSW,ICAPTY,IFORSW,IGAMFL,
41676     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
41677     1                IOUNI1,IOUNI2,ALPHA,
41678     1                ISUBRO,IBUGA3,IERROR)
41679        ENDIF
41680        IOP='CLOS'
41681        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
41682     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
41683     1              IBUGA3,ISUBRO,IERROR)
41684        IF(IERROR.EQ.'YES')GOTO9000
41685C
41686        INAME1(1)='GAMM'
41687        INAME2(1)='AML '
41688        AVAL(1)=GAMMML
41689        INAME1(2)='GAMM'
41690        INAME2(2)='ASE '
41691        AVAL(2)=GAMMSE
41692        INAME1(3)='SCAL'
41693        INAME2(3)='EML '
41694        AVAL(3)=SCALML
41695        INAME1(4)='SCAL'
41696        INAME2(4)='ESE '
41697        AVAL(4)=SCALSE
41698        INAME1(5)='COVS'
41699        INAME2(5)='E   '
41700        AVAL(5)=COVSE
41701        NPAR=5
41702        IF(NUMV.EQ.1)THEN
41703          INAME1(6)='GAMM'
41704          INAME2(6)='AMOM'
41705          AVAL(6)=GAMMMO
41706          INAME1(7)='SCAL'
41707          INAME2(7)='EMOM'
41708          AVAL(7)=SCALMO
41709          NPAR=7
41710          GOTO8100
41711        ELSE
41712          GOTO8900
41713        ENDIF
41714C
41715      ELSEIF(ICASAN.EQ.'3GAM')THEN
41716C
41717        IOP='OPEN'
41718        IFLAG1=1
41719        IFLAG2=0
41720        IFLAG3=0
41721        IFLAG4=0
41722        IFLAG5=0
41723        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
41724     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
41725     1              IBUGA3,ISUBRO,IERROR)
41726        IF(IERROR.EQ.'YES')GOTO9000
41727C
41728        IF(NUMV.EQ.1)THEN
41729          CALL DPMLG3(Y,NS1,
41730     1                TEMP1,DTEMP1,ITEMP1,MAXNXT,
41731     1                ALOCML,SCALML,SHAPML,
41732     1                ALOCSE,SCALSE,SHAPSE,
41733     1                ALOCMO,SCALMO,SHAPMO,
41734     1                ALOCMM,SCALMM,SHAPMM,
41735     1                ALOCS2,SCALS2,SHAPS2,
41736     1                AIC,AICC,BIC,ALIKE,
41737     1                AICMO,AICCMO,BICMO,ALIKMO,
41738     1                AICMM,AICCMM,BICMM,ALIKMM,
41739     1                NUMV,
41740     1                ICAPSW,ICAPTY,IFORSW,
41741     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
41742     1                IOUNI1,IOUNI2,ALPHA,
41743     1                ISUBRO,IBUGA3,IERROR)
41744C
41745          INAME1(1)='SHAP'
41746          INAME2(1)='EML '
41747          AVAL(1)=SHAPML
41748          INAME1(2)='SHAP'
41749          INAME2(2)='ESE '
41750          AVAL(2)=SHAPSE
41751          INAME1(3)='SCAL'
41752          INAME2(3)='EML '
41753          AVAL(3)=SCALML
41754          INAME1(4)='SCAL'
41755          INAME2(4)='ESE '
41756          AVAL(4)=SCALSE
41757          INAME1(5)='LOCM'
41758          INAME2(5)='L   '
41759          AVAL(5)=ALOCML
41760          INAME1(6)='LOCS'
41761          INAME2(6)='E   '
41762          AVAL(6)=ALOCSE
41763          INAME1(7)='SHAP'
41764          INAME2(7)='EMM '
41765          AVAL(7)=SHAPMM
41766          INAME1(8)='SHAP'
41767          INAME2(8)='ESE2'
41768          AVAL(8)=SHAPS2
41769          INAME1(9)='SCAL'
41770          INAME2(9)='EMM '
41771          AVAL(9)=SCALMM
41772          INAME1(10)='SCAL'
41773          INAME2(10)='ESE2'
41774          AVAL(10)=SCALS2
41775          INAME1(11)='LOCM'
41776          INAME2(11)='M   '
41777          AVAL(11)=ALOCMM
41778          INAME1(12)='LOCS'
41779          INAME2(12)='E2  '
41780          AVAL(12)=ALOCS2
41781          INAME1(13)='SHAP'
41782          INAME2(13)='EMOM'
41783          AVAL(13)=SHAPMO
41784          INAME1(14)='SCAL'
41785          INAME2(14)='EMOM'
41786          AVAL(14)=SCALMO
41787          INAME1(15)='LOCM'
41788          INAME2(15)='OM  '
41789          AVAL(15)=ALOCMO
41790          NPAR=15
41791          GOTO8100
41792        ENDIF
41793C
41794      ELSEIF(ICASAN.EQ.'INGA' .OR. ICASAN.EQ.'3IGA')THEN
41795C
41796        IF(NUMV.GE.1)THEN
41797          CALL DPMLIG(Y,TEMP1,TEMP2,NS1,NUMV,ICASAN,
41798     1                TEMP3,TEMP4,TEMP5,DTEMP1,ITEMP1,MAXNXT,
41799     1                ALOCML,SIGMML,AMUML,GAMMML,
41800     1                ALOCSE,SIGMSE,AMUSE,GAMMSE,
41801     1                ALOCMM,SIGMMM,AMUMM,GAMMMM,
41802     1                ALOCMO,SIGMMO,AMUMO,GAMMMO,
41803     1                AIC,AICC,BIC,ALIKE,
41804     1                AICMM,AICCMM,BICMM,ALIKMM,
41805     1                AICMO,AICCMO,BICMO,ALIKMO,
41806     1                ICAPSW,ICAPTY,IFORSW,
41807     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
41808     1                ALPHA,
41809     1                ISUBRO,IBUGA3,IERROR)
41810C
41811          IF(IGAUDF.EQ.'CHAN')THEN
41812            INAME1(1)='SIGM'
41813            INAME2(1)='AML '
41814            AVAL(1)=SIGMML
41815            INAME1(2)='SIGM'
41816            INAME2(2)='ASE '
41817            AVAL(2)=SIGMSE
41818            INAME1(3)='SIGM'
41819            INAME2(3)='AMMO'
41820            AVAL(3)=SIGMMM
41821            INAME1(4)='SIGM'
41822            INAME2(4)='AMOM'
41823            AVAL(4)=SIGMMO
41824          ELSEIF(IGAUDF.EQ.'TWEE')THEN
41825            INAME1(1)='GAMM'
41826            INAME2(1)='AML '
41827            AVAL(1)=GAMMML
41828            INAME1(2)='GAMM'
41829            INAME2(2)='ASE '
41830            AVAL(2)=GAMMSE
41831            INAME1(3)='GAMM'
41832            INAME2(3)='AMMO'
41833            AVAL(3)=GAMMMM
41834            INAME1(4)='GAMM'
41835            INAME2(4)='AMOM'
41836            AVAL(4)=GAMMMO
41837          ENDIF
41838C
41839          INAME1(5)='MUML'
41840          INAME2(5)='    '
41841          AVAL(5)=AMUML
41842          INAME1(6)='MUSE'
41843          INAME2(6)='    '
41844          AVAL(6)=AMUSE
41845          INAME1(7)='MUMM'
41846          INAME2(7)='OM  '
41847          AVAL(7)=AMUMM
41848          INAME1(8)='MUMO'
41849          INAME2(8)='M   '
41850          AVAL(8)=AMUMO
41851          NPAR=8
41852C
41853          IF(ICASAN.EQ.'3IGA')THEN
41854            INAME1(9)='LOCM'
41855            INAME2(9)='L   '
41856            AVAL(9)=ALOCML
41857            INAME1(10)='LOCS'
41858            INAME2(10)='E   '
41859            AVAL(10)=ALOCSE
41860            INAME1(11)='LOCM'
41861            INAME2(11)='MOM '
41862            AVAL(11)=ALOCMM
41863            INAME1(12)='LOCM'
41864            INAME2(12)='OM  '
41865            AVAL(12)=ALOCMO
41866            NPAR=12
41867          ENDIF
41868          GOTO8100
41869        ENDIF
41870C
41871      ELSEIF(ICASAN.EQ.'TSPO')THEN
41872C
41873        IHP='NSV '
41874        IHP2='    '
41875        IHWUSE='P'
41876        MESSAG='NO'
41877        CALL CHECKN(IHP,IHP2,IHWUSE,
41878     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41879     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41880        ANSV=2.0
41881        IF(IERROR.EQ.'NO')ANSV=VALUE(ILOCP)
41882        IF(ANSV.LE.0.0)ANSV=2.0
41883C
41884        CALL DPMLTS(Y,NS1,ANSV,MAXNXT,
41885     1              TEMP1,TEMP2,TEMP3,TEMP4,DTEMP1,
41886     1              THETML,ANML,AML,BML,
41887     1              ICAPSW,ICAPTY,IFORSW,
41888     1              ISUBRO,IBUGA3,IERROR)
41889        IF(IERROR.EQ.'YES')GOTO9000
41890C
41891        INAME1(1)='THET'
41892        INAME2(1)='AML '
41893        AVAL(1)=THETML
41894        INAME1(2)='NML '
41895        INAME2(2)='    '
41896        AVAL(2)=ANML
41897        INAME1(3)='AML '
41898        INAME2(3)='    '
41899        AVAL(3)=AML
41900        INAME1(4)='BML '
41901        INAME2(4)='    '
41902        AVAL(4)=BML
41903        NPAR=4
41904        GOTO8900
41905C
41906      ELSEIF(ICASAN.EQ.'TRIA')THEN
41907C
41908        A=CPUMIN
41909        IHP='A   '
41910        IHP2='    '
41911        IHWUSE='P'
41912        MESSAG='NO'
41913        CALL CHECKN(IHP,IHP2,IHWUSE,
41914     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41915     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41916        IF(IERROR.EQ.'NO')A=VALUE(ILOCP)
41917C
41918        B=CPUMIN
41919        IHP='B   '
41920        IHP2='    '
41921        IHWUSE='P'
41922        MESSAG='NO'
41923        CALL CHECKN(IHP,IHP2,IHWUSE,
41924     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41925     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41926        IF(IERROR.EQ.'NO')B=VALUE(ILOCP)
41927C
41928        ALOWQN=CPUMIN
41929        IHP='LOWQ'
41930        IHP2='UANT'
41931        IHWUSE='P'
41932        MESSAG='NO'
41933        CALL CHECKN(IHP,IHP2,IHWUSE,
41934     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41935     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41936        IF(IERROR.EQ.'NO')ALOWQN=VALUE(ILOCP)
41937C
41938        AUPPQN=CPUMIN
41939        IHP='UPPQ'
41940        IHP2='UANT'
41941        IHWUSE='P'
41942        MESSAG='NO'
41943        CALL CHECKN(IHP,IHP2,IHWUSE,
41944     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41945     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41946        IF(IERROR.EQ.'NO')AUPPQN=VALUE(ILOCP)
41947C
41948        CALL DPMLTR(Y,NS1,
41949     1              TEMP1,TEMP2,DTEMP1,MAXNXT,
41950     1              A,B,ALOWQN,AUPPQN,
41951     1              CML,AML,BML,AQUANT,BQUANT,
41952     1              ICAPSW,ICAPTY,IFORSW,
41953     1              ISUBRO,IBUGA3,IERROR)
41954        IF(IERROR.EQ.'YES')GOTO9000
41955C
41956        INAME1(1)='CML '
41957        INAME2(1)='    '
41958        AVAL(1)=CML
41959        INAME1(2)='AML '
41960        INAME2(2)='    '
41961        AVAL(2)=AML
41962        INAME1(3)='BML '
41963        INAME2(3)='    '
41964        AVAL(3)=BML
41965        INAME1(4)='AQUA'
41966        INAME2(4)='NT  '
41967        AVAL(4)=AQUANT
41968        INAME1(5)='BQUA'
41969        INAME2(5)='NT  '
41970        AVAL(5)=BQUANT
41971        NPAR=5
41972        GOTO8900
41973C
41974      ELSEIF(ICASAN.EQ.'TOPL')THEN
41975C
41976        IHP='LOWL'
41977        IHP2='IMIT'
41978        IHWUSE='P'
41979        MESSAG='NO'
41980        CALL CHECKN(IHP,IHP2,IHWUSE,
41981     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41982     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41983        A=CPUMIN
41984        IF(IERROR.EQ.'NO')A=VALUE(ILOCP)
41985C
41986        IHP='UPPL'
41987        IHP2='IMIT'
41988        IHWUSE='P'
41989        MESSAG='NO'
41990        CALL CHECKN(IHP,IHP2,IHWUSE,
41991     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
41992     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
41993        B=CPUMIN
41994        IF(IERROR.EQ.'NO')B=VALUE(ILOCP)
41995C
41996        CALL DPMLTO(Y,NS1,
41997     1              TEMP1,A,B,
41998     1              BETAHT,
41999     1              ICAPSW,ICAPTY,IFORSW,
42000     1              ISUBRO,IBUGA3,IERROR)
42001        IF(IERROR.EQ.'YES')GOTO9000
42002C
42003        INAME1(1)='BETA'
42004        INAME2(1)='ML  '
42005        AVAL(1)=BETAHT
42006        NP=1
42007        GOTO8900
42008C
42009      ELSEIF(ICASAN.EQ.'BINO')THEN
42010C
42011        IOP='OPEN'
42012        IFLAG1=1
42013        IFLAG2=0
42014        IFLAG3=0
42015        IFLAG4=0
42016        IFLAG5=0
42017        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
42018     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
42019     1              IBUGA3,ISUBRO,IERROR)
42020        IF(IERROR.EQ.'YES')GOTO9000
42021C
42022        IH='N   '
42023        IH2='    '
42024        IHWUSE='P'
42025        MESSAG='NO'
42026        CALL CHECKN(IH,IH2,IHWUSE,
42027     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42028     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42029        IF(IERROR.EQ.'YES')THEN
42030          NTRIAL=1
42031        ELSE
42032          NTRIAL=INT(VALUE(ILOCP)+0.5)
42033          IF(NTRIAL.LT.0)NTRIAL=1
42034        ENDIF
42035C
42036        CALL DPMLBI(Y,TEMP1,NS1,NTRIAL,NUMV,
42037     1              TEMP2,TEMP3,TEMP4,MAXNXT,
42038     1              P,PCC,PLCL,PUCL,PSD,PSDCC,
42039     1              ICAPSW,ICAPTY,IFORSW,IBINME,
42040     1              IBINCC,PBINTH,IOUNI1,
42041     1              ISUBRO,IBUGA3,IERROR)
42042        IF(IERROR.EQ.'YES')GOTO9000
42043        IOP='CLOS'
42044        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
42045     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
42046     1              IBUGA3,ISUBRO,IERROR)
42047C
42048        INAME1(1)='PML '
42049        INAME2(1)='    '
42050        AVAL(1)=P
42051        INAME1(2)='PMLC'
42052        INAME2(2)='C   '
42053        AVAL(2)=PCC
42054        INAME1(3)='PSD '
42055        INAME2(3)='    '
42056        AVAL(3)=PSD
42057        INAME1(4)='PSDC'
42058        INAME2(4)='C   '
42059        AVAL(4)=PSDCC
42060        INAME1(5)='PLCL'
42061        INAME2(5)='    '
42062        AVAL(5)=PLCL
42063        INAME1(6)='PUCL'
42064        INAME2(6)='    '
42065        AVAL(6)=PUCL
42066        NPAR=6
42067        GOTO8900
42068C
42069      ELSEIF(ICASAN.EQ.'GPAR')THEN
42070C
42071        IOP='OPEN'
42072        IFLAG1=1
42073        IFLAG2=1
42074        IFLAG3=0
42075        IFLAG4=0
42076        IFLAG5=0
42077        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
42078     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
42079     1              IBUGA3,ISUBRO,IERROR)
42080        IF(IERROR.EQ.'YES')GOTO9000
42081C
42082        IHP='THRE'
42083        IHP2='SHOL'
42084        IHWUSE='P'
42085        MESSAG='NO'
42086        CALL CHECKN(IHP,IHP2,IHWUSE,
42087     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42088     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42089        IF(IERROR.EQ.'YES')THEN
42090          THRESH=CPUMIN
42091        ELSE
42092          THRESH=VALUE(ILOCP)
42093        ENDIF
42094C
42095        IF(IGEPSV.EQ.'USER')THEN
42096          IHP='GAMM'
42097          IHP2='ASV '
42098          IHWUSE='P'
42099          MESSAG='NO'
42100          CALL CHECKN(IHP,IHP2,IHWUSE,
42101     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42102     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42103          IF(IERROR.EQ.'YES')THEN
42104            GAMMSV=0.0
42105          ELSE
42106            GAMMSV=VALUE(ILOCP)
42107          ENDIF
42108C
42109          IHP='SCAL'
42110          IHP2='ESV '
42111          IHWUSE='P'
42112          MESSAG='NO'
42113          CALL CHECKN(IHP,IHP2,IHWUSE,
42114     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42115     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42116          IF(IERROR.EQ.'YES')THEN
42117            SCALSV=1.0
42118          ELSE
42119            SCALSV=VALUE(ILOCP)
42120          ENDIF
42121          IF(SCALSV.LE.0.0)SCALSV=1.0
42122        ELSE
42123          GAMMSV=0.0
42124          SCALSV=1.0
42125        ENDIF
42126C
42127        CALL DPMLGP(Y,NS1,ICASAN,
42128     1              XTEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,
42129     1              DTEMP1,DTEMP2,
42130     1              MAXNXT,THRESH,MINMAX,
42131     1              QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
42132     1              GAMMA1,SCALE1,ALOC1,
42133     1              GAMMA2,SCALE2,ALOC2,
42134     1              ASHALM,ASCALM,ALOCLM,
42135     1              GAMMA3,SCALE3,ALOC3,
42136     1              ICAPSW,ICAPTY,IFORSW,
42137     1              IOUNI1,IOUNI2,ISEED,ALPHA,
42138     1              GAMMSV,SCALSV,
42139     1              ISUBRO,IBUGA3,IERROR)
42140        IOP='CLOS'
42141        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
42142     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
42143     1              IBUGA3,ISUBRO,IERROR)
42144        IF(IERROR.EQ.'YES')GOTO9000
42145C
42146        INAME1(1)='GAMM'
42147        INAME2(1)='AML '
42148        AVAL(1)=GAMMA2
42149        INAME1(2)='SCAL'
42150        INAME2(2)='EML '
42151        AVAL(2)=SCALE2
42152        INAME1(3)='LOCM'
42153        INAME2(3)='L   '
42154        AVAL(3)=ALOC2
42155        INAME1(4)='GAMM'
42156        INAME2(4)='AMOM'
42157        AVAL(4)=GAMMA1
42158        INAME1(5)='SCAL'
42159        INAME2(5)='EMOM'
42160        AVAL(5)=SCALE1
42161        INAME1(6)='LOCM'
42162        INAME2(6)='OM  '
42163        AVAL(6)=ALOC1
42164        INAME1(7)='GAMM'
42165        INAME2(7)='ALMO'
42166        AVAL(7)=ASHALM
42167        INAME1(8)='SCAL'
42168        INAME2(8)='ELMO'
42169        AVAL(8)=ASCALM
42170        INAME1(9)='LOCL'
42171        INAME2(9)='MOM '
42172        AVAL(9)=ALOCLM
42173        INAME1(10)='GAMM'
42174        INAME2(10)='AEPM'
42175        AVAL(10)=GAMMA3
42176        INAME1(11)='SCAL'
42177        INAME2(11)='EEPM'
42178        AVAL(11)=SCALE3
42179        INAME1(12)='LOCE'
42180        INAME2(12)='PM  '
42181        AVAL(12)=ALOC3
42182        NPAR=12
42183        GOTO8900
42184C
42185      ELSEIF(ICASAN.EQ.'BEGO')THEN
42186C
42187        IOP='OPEN'
42188        IFLAG1=1
42189        IFLAG2=1
42190        IFLAG3=0
42191        IFLAG4=0
42192        IFLAG5=0
42193        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
42194     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
42195     1              IBUGA3,ISUBRO,IERROR)
42196        IF(IERROR.EQ.'YES')GOTO9000
42197C
42198        CALL DPMLBG(Y,TEMP1,NS1,NUMV,
42199     1              TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,
42200     1              DTEMP1,MAXNXT,
42201     1              THETML,PIML,ALPHML,BETAML,
42202     1              THETFR,PIFR,ALPHFR,BETAFR,
42203     1              ICAPSW,ICAPTY,IFORSW,
42204     1              IBGEDF,IOUNI1,IOUNI2,ISEED,ALPHA,
42205     1              ISUBRO,IBUGA3,IERROR)
42206        IOP='CLOS'
42207        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
42208     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
42209     1              IBUGA3,ISUBRO,IERROR)
42210        IF(IERROR.EQ.'YES')GOTO9000
42211C
42212        INAME1(1)='THET'
42213        INAME2(1)='AML '
42214        AVAL(1)=THETML
42215        INAME1(2)='PIML'
42216        INAME2(2)='    '
42217        AVAL(2)=PIML
42218        INAME1(3)='ALPH'
42219        INAME2(3)='AML '
42220        AVAL(3)=ALPHML
42221        INAME1(4)='BETA'
42222        INAME2(4)='ML  '
42223        AVAL(4)=BETAML
42224        INAME1(5)='THET'
42225        INAME2(5)='AFR '
42226        AVAL(6)=THETFR
42227        INAME1(7)='PIFR'
42228        INAME2(7)='    '
42229        AVAL(7)=PIFR
42230        INAME1(8)='ALPH'
42231        INAME2(8)='AFR '
42232        AVAL(8)=ALPHFR
42233        INAME1(9)='BETA'
42234        INAME2(9)='FR  '
42235        AVAL(9)=BETAFR
42236        NPAR=9
42237        GOTO8900
42238C
42239      ELSEIF(ICASAN.EQ.'GEV ')THEN
42240C
42241        IOP='OPEN'
42242        IFLAG1=1
42243        IFLAG2=1
42244        IFLAG3=0
42245        IFLAG4=0
42246        IFLAG5=0
42247        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
42248     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
42249     1              IBUGA3,ISUBRO,IERROR)
42250        IF(IERROR.EQ.'YES')GOTO9000
42251C
42252CCCCC GEV MAXIMUM LIKELIHOOD NOT WORKING AS EXPECTED.  SET
42253CCCCC MLGEV TO FALSE TO SUPPRESS ML ESTIMATION.
42254C
42255CCCCC 4/2008: MINMAX ARGUMENT HAD A TYPO, WHICH PREVENTED
42256CCCCC         MINIMUM CASE FROM BEING COMPUTED.
42257C
42258        MLGEV=.FALSE.
42259        CALL DPMLGV(Y,NS1,ICASAN,MAXNXT,MINMAX,
42260     1              TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,
42261     1              DTEMP1,DTEMP2,
42262     1              QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
42263     1              ALOCLM,SCALLM,SHAPLM,
42264     1              ALOCEP,SCALEP,SHAPEP,
42265     1              ALOCML,SCALML,SHAPML,
42266     1              AICLM,BICLM,AICCLM,
42267     1              AICEP,BICEP,AICCEP,
42268     1              AICML,BICML,AICCML,
42269     1              ICAPSW,ICAPTY,IFORSW,
42270     1              IOUNI1,IOUNI2,ISEED,ALPHA,
42271     1              MLGEV,ISUBRO,IBUGA3,IERROR)
42272        IOP='CLOS'
42273        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
42274     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
42275     1              IBUGA3,ISUBRO,IERROR)
42276        IF(IERROR.EQ.'YES')GOTO9000
42277C
42278        INAME1(1)='GAMM'
42279        INAME2(1)='ALMO'
42280        AVAL(1)=SHAPLM
42281        INAME1(2)='SCAL'
42282        INAME2(2)='ELMO'
42283        AVAL(2)=SCALLM
42284        INAME1(3)='LOCL'
42285        INAME2(3)='MOM '
42286        AVAL(3)=ALOCLM
42287        INAME1(4)='GAMM'
42288        INAME2(4)='AEPM'
42289        AVAL(4)=SHAPEP
42290        INAME1(5)='SCAL'
42291        INAME2(5)='EEPM'
42292        AVAL(5)=SCALEP
42293        INAME1(6)='LOCE'
42294        INAME2(6)='PM  '
42295        AVAL(6)=ALOCEP
42296        INAME1(7)='AICL'
42297        INAME2(7)='MOM '
42298        AVAL(7)=AICLM
42299        INAME1(8)='AICC'
42300        INAME2(8)='LMOM'
42301        AVAL(8)=AICCLM
42302        INAME1(9)='BICL'
42303        INAME2(9)='MOM '
42304        AVAL(9)=BICLM
42305        INAME1(10)='AICE'
42306        INAME2(10)='P   '
42307        AVAL(10)=AICEP
42308        INAME1(11)='AICC'
42309        INAME2(11)='EP  '
42310        AVAL(11)=AICCEP
42311        INAME1(12)='BICE'
42312        INAME2(12)='P   '
42313        AVAL(12)=BICEP
42314        NPAR=12
42315C
42316        IF(MLGEV)THEN
42317          INAME1(13)='GAMM'
42318          INAME2(13)='AML '
42319          AVAL(13)=SHAPML
42320          INAME1(14)='SCAL'
42321          INAME2(14)='EML '
42322          AVAL(14)=SCALML
42323          INAME1(15)='LOCM'
42324          INAME2(15)='L   '
42325          AVAL(15)=ALOCML
42326          INAME1(16)='AICM'
42327          INAME2(16)='L   '
42328          AVAL(16)=AICML
42329          INAME1(17)='AICC'
42330          INAME2(17)='ML  '
42331          AVAL(17)=AICCML
42332          INAME1(18)='BICM'
42333          INAME2(18)='L   '
42334          AVAL(18)=BICML
42335          NPAR=18
42336        ENDIF
42337C
42338        GOTO8900
42339C
42340      ELSEIF(ICASAN.EQ.'FATL')THEN
42341C
42342        CALL DPMLFL(Y,NS1,
42343     1              TEMP1,DTEMP1,MAXNXT,
42344     1              GAMMA1,SCALE1,GAMMA2,SCALE2,
42345     1              ICAPSW,ICAPTY,IFORSW,
42346     1              ISUBRO,IBUGA3,IERROR)
42347        IF(IERROR.EQ.'YES')GOTO9000
42348C
42349        INAME1(1)='GAMM'
42350        INAME2(2)='AML '
42351        AVAL(1)=GAMMA2
42352        INAME1(2)='SCAL'
42353        INAME2(2)='EML '
42354        AVAL(2)=SCALE2
42355        INAME1(3)='GAMM'
42356        INAME2(3)='AMOM'
42357        AVAL(3)=GAMMA1
42358        INAME1(4)='SCAL'
42359        INAME2(4)='EMOM'
42360        AVAL(4)=SCALE1
42361        NPAR=4
42362        GOTO8900
42363C
42364      ELSEIF(ICASAN.EQ.'GEEX')THEN
42365C
42366        IHP='GAMM'
42367        IHP2='ASV '
42368        IHWUSE='P'
42369        MESSAG='NO'
42370        CALL CHECKN(IHP,IHP2,IHWUSE,
42371     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42372     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42373        GAMMSV=CPUMIN
42374        IF(IERROR.EQ.'NO')GAMMSV=VALUE(ILOCP)
42375C
42376        IHP='SCAL'
42377        IHP2='ESV '
42378        IHWUSE='P'
42379        MESSAG='NO'
42380        CALL CHECKN(IHP,IHP2,IHWUSE,
42381     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42382     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42383        SCALSV=CPUMIN
42384        IF(IERROR.EQ.'NO')SCALSV=VALUE(ILOCP)
42385C
42386        CALL DPMLGX(Y,NS1,
42387     1              TEMP1,TEMP2,TEMP3,DTEMP1,MAXNXT,
42388     1              GAMMSV,SCALSV,GAMMA1,SCALE1,
42389     1              ICAPSW,ICAPTY,IFORSW,
42390     1              ISUBRO,IBUGA3,IERROR)
42391        IF(IERROR.EQ.'YES')GOTO9000
42392C
42393        INAME1(1)='GAMM'
42394        INAME2(1)='AML '
42395        AVAL(1)=GAMMA1
42396        INAME1(2)='SCAL'
42397        INAME2(2)='EML '
42398        AVAL(2)=SCALE1
42399        NPAR=2
42400        GOTO8900
42401C
42402      ELSEIF(ICASAN.EQ.'BU10')THEN
42403C
42404        IHP='RSV '
42405        IHP2='    '
42406        IHWUSE='P'
42407        MESSAG='NO'
42408        CALL CHECKN(IHP,IHP2,IHWUSE,
42409     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42410     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42411        RSV=CPUMIN
42412        IF(IERROR.EQ.'NO')RSV=VALUE(ILOCP)
42413C
42414        IHP='SCAL'
42415        IHP2='ESV '
42416        IHWUSE='P'
42417        MESSAG='NO'
42418        CALL CHECKN(IHP,IHP2,IHWUSE,
42419     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42420     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42421        SCALSV=CPUMIN
42422        IF(IERROR.EQ.'NO')SCALSV=VALUE(ILOCP)
42423C
42424        CALL DPMB10(Y,NS1,
42425     1              TEMP1,TEMP2,TEMP3,DTEMP1,MAXNXT,
42426     1              RSV,SCALSV,
42427     1              RML,SCALML,
42428     1              ICAPSW,ICAPTY,IFORSW,
42429     1              ISUBRO,IBUGA3,IERROR)
42430        IF(IERROR.EQ.'YES')GOTO9000
42431C
42432        INAME1(1)='RML '
42433        INAME2(1)='    '
42434        AVAL(1)=RML
42435        INAME1(2)='SCAL'
42436        INAME2(2)='EML '
42437        AVAL(2)=SCALML
42438        NPAR=2
42439        GOTO8900
42440C
42441      ELSEIF(ICASAN.EQ.'GGAM')THEN
42442C
42443C       CHECK FOR STARTING VALUES FOR C, K, AND SCALE
42444C
42445        IHP='CSV '
42446        IHP2='    '
42447        IHWUSE='P'
42448        MESSAG='NO'
42449        CALL CHECKN(IHP,IHP2,IHWUSE,
42450     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42451     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42452        CSV=CPUMIN
42453        IF(IERROR.EQ.'NO')CSV=VALUE(ILOCP)
42454C
42455        IHP='ALPH'
42456        IHP2='ASV '
42457        IHWUSE='P'
42458        MESSAG='NO'
42459        CALL CHECKN(IHP,IHP2,IHWUSE,
42460     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42461     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42462        ALPHSV=CPUMIN
42463        IF(IERROR.EQ.'NO')ALPHSV=VALUE(ILOCP)
42464C
42465        IHP='SCAL'
42466        IHP2='ESV '
42467        IHWUSE='P'
42468        MESSAG='NO'
42469        CALL CHECKN(IHP,IHP2,IHWUSE,
42470     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42471     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42472        SCALSV=CPUMIN
42473        IF(IERROR.EQ.'NO')SCALSV=VALUE(ILOCP)
42474C
42475        CALL DPMLGD(Y,NS1,
42476     1              TEMP1,DTEMP1,MAXNXT,
42477     1              CSV,ALPHSV,SCALSV,
42478     1              CML,ALPHML,SCALML,
42479     1              ICAPSW,ICAPTY,IFORSW,
42480     1              ISUBRO,IBUGA3,IERROR)
42481        IF(IERROR.EQ.'YES')GOTO9000
42482C
42483        INAME1(1)='CML '
42484        INAME2(1)='    '
42485        AVAL(1)=CML
42486        INAME1(2)='ALPH'
42487        INAME2(2)='AML '
42488        AVAL(2)=ALPHML
42489        INAME1(3)='SCAL'
42490        INAME2(3)='EML '
42491        AVAL(3)=SCALML
42492        NPAR=3
42493        GOTO8900
42494C
42495      ELSEIF(ICASAN.EQ.'GOMP')THEN
42496C
42497        ICFLAG='OFF'
42498        IF(ICENSO.EQ.'ON')ICFLAG='ON'
42499        CALL DPMLGZ(Y,TEMP1,TEMP2,TEMP3,NS1,NUMV,
42500     1              TEMP4,TEMP5,TEMP6,N2,
42501     1              XTEMP1,QP,XQPHAT,DTEMP1,ITEMP1,MAXOBV,
42502     1              CLLIMI,CLWIDT,
42503     1              IHSTCW,MAXOBV,
42504     1              IGOMDF,ICFLAG,ALPHAT,AKHAT,
42505     1              ICAPSW,ICAPTY,IFORSW,
42506     1              ISUBRO,IBUGA3,IERROR)
42507        IF(IERROR.EQ.'YES')GOTO9000
42508C
42509        INAME1(1)='ALPH'
42510        INAME2(1)='AML '
42511        AVAL(1)=ALPHAT
42512        INAME1(2)='KML '
42513        INAME2(2)='    '
42514        AVAL(2)=AKHAT
42515        NPAR=2
42516        GOTO8900
42517C
42518      ELSEIF(ICASAN.EQ.'RGTL')THEN
42519C
42520        IHP='ALPH'
42521        IHP2='ASV '
42522        IHWUSE='P'
42523        MESSAG='NO'
42524        CALL CHECKN(IHP,IHP2,IHWUSE,
42525     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42526     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42527        ALPHSV=CPUMIN
42528        IF(IERROR.EQ.'NO')ALPHSV=VALUE(ILOCP)
42529C
42530        IHP='LOWL'
42531        IHP2='IMIT'
42532        IHWUSE='P'
42533        MESSAG='NO'
42534        CALL CHECKN(IHP,IHP2,IHWUSE,
42535     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42536     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42537        A=CPUMIN
42538        IF(IERROR.EQ.'NO')A=VALUE(ILOCP)
42539C
42540        IHP='UPPL'
42541        IHP2='IMIT'
42542        IHWUSE='P'
42543        MESSAG='NO'
42544        CALL CHECKN(IHP,IHP2,IHWUSE,
42545     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42546     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42547        B=CPUMIN
42548        IF(IERROR.EQ.'NO')B=VALUE(ILOCP)
42549C
42550        CALL DPMLRG(Y,TEMP1,TEMP2,NS1,NUMV,
42551     1              TEMP3,TEMP4,TEMP5,TEMP6,DTEMP1,MAXOBV,
42552     1              ALPHSV,A,B,
42553     1              ALPHML,BETAML,ALOWLM,AUPPLM,
42554     1              ICAPSW,ICAPTY,IFORSW,
42555     1              ISUBRO,IBUGA3,IERROR)
42556        IF(IERROR.EQ.'YES')GOTO9000
42557C
42558        INAME1(1)='ALPH'
42559        INAME2(1)='AML '
42560        AVAL(1)=ALPHML
42561        INAME1(2)='BETA'
42562        INAME2(2)='ML  '
42563        AVAL(2)=BETAML
42564        INAME1(3)='LOWL'
42565        INAME2(3)='IMML'
42566        AVAL(3)=ALOWLM
42567        INAME1(4)='UPPL'
42568        INAME1(4)='IMML'
42569        AVAL(4)=AUPPLM
42570        NPAR=4
42571        GOTO8900
42572C
42573      ELSEIF(ICASAN.EQ.'PEXP')THEN
42574C
42575        IHP='ALPH'
42576        IHP2='ASV '
42577        IHWUSE='P'
42578        MESSAG='NO'
42579        CALL CHECKN(IHP,IHP2,IHWUSE,
42580     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42581     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42582        ALPHSV=CPUMIN
42583        IF(IERROR.EQ.'NO')ALPHSV=VALUE(ILOCP)
42584C
42585        IHP='BETA'
42586        IHP2='SV  '
42587        IHWUSE='P'
42588        MESSAG='NO'
42589        CALL CHECKN(IHP,IHP2,IHWUSE,
42590     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42591     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42592        BETASV=CPUMIN
42593        IF(IERROR.EQ.'NO')BETASV=VALUE(ILOCP)
42594C
42595        CALL DPMLPX(Y,NS1,MAXOBV,
42596     1              TEMP1,TEMP2,TEMP3,DTEMP1,ITEMP1,
42597     1              ALPHSV,BETASV,
42598     1              SCALML,SCALSE,BETAML,BETASE,COVSE,
42599     1              ICAPSW,ICAPTY,IFORSW,
42600     1              ISUBRO,IBUGA3,IERROR)
42601        IF(IERROR.EQ.'YES')GOTO9000
42602C
42603        INAME1(1)='ALPH'
42604        INAME2(1)='AML '
42605        AVAL(1)=SCALML
42606        INAME1(2)='BETA'
42607        INAME2(2)='ML  '
42608        AVAL(2)=BETAML
42609        INAME1(3)='BETA'
42610        INAME2(3)='SE  '
42611        AVAL(3)=BETASE
42612        INAME1(4)='ALPH'
42613        INAME2(4)='ASE '
42614        AVAL(4)=SCALSE
42615        INAME1(5)='COVS'
42616        INAME2(5)='E   '
42617        AVAL(5)=COVSE
42618        NPAR=5
42619        GOTO8900
42620C
42621      ELSEIF(ICASAN.EQ.'LEXP')THEN
42622C
42623        IHP='ALPH'
42624        IHP2='ASV '
42625        IHWUSE='P'
42626        MESSAG='NO'
42627        CALL CHECKN(IHP,IHP2,IHWUSE,
42628     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42629     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42630        ALPHSV=CPUMIN
42631        IF(IERROR.EQ.'NO')ALPHSV=VALUE(ILOCP)
42632C
42633        IHP='BETA'
42634        IHP2='SV  '
42635        IHWUSE='P'
42636        MESSAG='NO'
42637        CALL CHECKN(IHP,IHP2,IHWUSE,
42638     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42639     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42640        BETASV=CPUMIN
42641        IF(IERROR.EQ.'NO')BETASV=VALUE(ILOCP)
42642C
42643        CALL DPMLLX(Y,NS1,
42644     1              TEMP1,DTEMP1,ITEMP1,MAXOBV,
42645     1              ALPHSV,BETASV,
42646     1              ALPHML,ALPHSE,BETAML,BETASE,COVSE,
42647     1              ICAPSW,ICAPTY,IFORSW,
42648     1              ISUBRO,IBUGA3,IERROR)
42649        IF(IERROR.EQ.'YES')GOTO9000
42650C
42651        INAME1(1)='ALPH'
42652        INAME2(1)='AML '
42653        AVAL(1)=ALPHML
42654        INAME1(2)='BETA'
42655        INAME2(2)='ML  '
42656        AVAL(2)=BETAML
42657CCCCC   INAME1(3)='BETA'
42658CCCCC   INAME2(3)='SE  '
42659CCCCC   AVAL(3)=BETASE
42660CCCCC   INAME1(4)='ALPH'
42661CCCCC   INAME2(4)='ASE '
42662CCCCC   AVAL(4)=SCALSE
42663CCCCC   INAME1(5)='COVS'
42664CCCCC   INAME2(5)='E   '
42665CCCCC   AVAL(5)=COVSE
42666        NPAR=2
42667        GOTO8900
42668C
42669      ELSEIF(ICASAN.EQ.'BFRA')THEN
42670C
42671        IHP='ALPH'
42672        IHP2='ASV '
42673        IHWUSE='P'
42674        MESSAG='NO'
42675        CALL CHECKN(IHP,IHP2,IHWUSE,
42676     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42677     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42678        ALPHSV=CPUMIN
42679        IF(IERROR.EQ.'NO')ALPHSV=VALUE(ILOCP)
42680C
42681        IHP='BETA'
42682        IHP2='SV  '
42683        IHWUSE='P'
42684        MESSAG='NO'
42685        CALL CHECKN(IHP,IHP2,IHWUSE,
42686     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42687     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42688        BETASV=CPUMIN
42689        IF(IERROR.EQ.'NO')BETASV=VALUE(ILOCP)
42690C
42691        IHP='RSV '
42692        IHP2='    '
42693        IHWUSE='P'
42694        MESSAG='NO'
42695        CALL CHECKN(IHP,IHP2,IHWUSE,
42696     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42697     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42698        RSV=CPUMIN
42699        IF(IERROR.EQ.'NO')RSV=VALUE(ILOCP)
42700C
42701        CALL DPMLBF(Y,NS1,
42702     1              TEMP1,DTEMP1,ITEMP1,MAXOBV,
42703     1              ALPHSV,BETASV,RSV,
42704     1              ALPHML,BETAML,RML,
42705     1              ICAPSW,ICAPTY,IFORSW,
42706     1              ISUBRO,IBUGA3,IERROR)
42707        IF(IERROR.EQ.'YES')GOTO9000
42708C
42709        INAME1(1)='ALPH'
42710        INAME2(1)='AML '
42711        AVAL(1)=ALPHML
42712        INAME1(2)='BETA'
42713        INAME2(2)='ML  '
42714        AVAL(2)=BETAML
42715        INAME1(3)='RML '
42716        INAME2(3)='    '
42717        AVAL(3)=RML
42718        NPAR=3
42719        GOTO8900
42720C
42721      ELSEIF(ICASAN.EQ.'TPAR')THEN
42722C
42723        IHP='R   '
42724        IHP2='    '
42725        IHWUSE='P'
42726        MESSAG='NO'
42727        CALL CHECKN(IHP,IHP2,IHWUSE,
42728     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42729     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42730        IF(IERROR.EQ.'NO')THEN
42731          AR=VALUE(ILOCP)
42732        ELSE
42733          AR=-1.0
42734        ENDIF
42735        IR=INT(AR)
42736C
42737        CALL DPMLTP(Y,NS1,IR,DTEMP1,MAXOBV,
42738     1              GAMMML,AML,ANUML,
42739     1              ICAPSW,ICAPTY,IFORSW,
42740     1              ISUBRO,IBUGA3,IERROR)
42741        IF(IERROR.EQ.'YES')GOTO9000
42742C
42743        INAME1(1)='GAMM'
42744        INAME2(1)='AML '
42745        AVAL(1)=GAMMML
42746        INAME2(1)='AML '
42747        INAME2(2)='    '
42748        AVAL(2)=AML
42749        INAME1(3)='ANUM'
42750        INAME2(3)='L   '
42751        AVAL(3)=ANUML
42752        NPAR=3
42753        GOTO8900
42754C
42755      ELSEIF(ICASAN.EQ.'ALPH')THEN
42756C
42757        IHP='ALPH'
42758        IHP2='ASV '
42759        IHWUSE='P'
42760        MESSAG='NO'
42761        CALL CHECKN(IHP,IHP2,IHWUSE,
42762     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42763     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42764        ALPHSV=CPUMIN
42765        IF(IERROR.EQ.'NO')ALPHSV=VALUE(ILOCP)
42766C
42767        IHP='BETA'
42768        IHP2='SV  '
42769        IHWUSE='P'
42770        MESSAG='NO'
42771        CALL CHECKN(IHP,IHP2,IHWUSE,
42772     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42773     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42774        BETASV=CPUMIN
42775        IF(IERROR.EQ.'NO')BETASV=VALUE(ILOCP)
42776C
42777        CALL DPMLAL(Y,NS1,MAXOBV,
42778     1              TEMP1,TEMP2,TEMP3,DTEMP1,ITEMP1,
42779     1              ALPHSV,BETASV,
42780     1              SCALML,ALPHML,SCALMO,ALPHMO,
42781     1              ICAPSW,ICAPTY,IFORSW,
42782     1              ISUBRO,IBUGA3,IERROR)
42783        IF(IERROR.EQ.'YES')GOTO9000
42784C
42785        INAME1(1)='SCAL'
42786        INAME2(1)='EML '
42787        AVAL(1)=SCALML
42788        INAME1(2)='ALPH'
42789        INAME2(2)='AML '
42790        AVAL(2)=ALPHML
42791        INAME1(3)='SCAL'
42792        INAME2(3)='EMOM'
42793        AVAL(3)=SCALMO
42794        INAME1(4)='ALPH'
42795        INAME2(4)='AMOM'
42796        AVAL(4)=ALPHMO
42797        NPAR=4
42798        GOTO8900
42799C
42800      ELSEIF(ICASAN.EQ.'FNOR')THEN
42801C
42802        CALL DPMLFN(Y,NS1,
42803     1              TEMP1,DTEMP1,ITEMP1,MAXNXT,
42804     1              AMU,SIGMA,THETA,
42805     1              THETSE,SIGMSE,CORTHS,
42806     1              ALIKE,AIC,AICC,BIC,
42807     1              ICAPSW,ICAPTY,IFORSW,
42808     1              ISUBRO,IBUGA3,IERROR)
42809        IF(IERROR.EQ.'YES')GOTO9000
42810C
42811        INAME1(1)='MUML'
42812        INAME2(1)='    '
42813        AVAL(1)=AMU
42814        INAME1(2)='SIGM'
42815        INAME2(2)='AML '
42816        AVAL(2)=SIGMA
42817        INAME1(3)='THET'
42818        INAME2(3)='AML '
42819        AVAL(3)=THETA
42820        INAME1(4)='SIGM'
42821        INAME2(4)='ASE '
42822        AVAL(5)=SIGMSE
42823        INAME1(5)='THET'
42824        INAME2(5)='ASE '
42825        AVAL(5)=THETSE
42826        INAME1(6)='CORR'
42827        INAME2(6)='THSI'
42828        AVAL(6)=THETSE
42829        NPAR=6
42830        GOTO8100
42831      ELSEIF(ICASAN.EQ.'POIS')THEN
42832C
42833        CALL DPMLPO(Y,TEMP1,NS1,NUMV,
42834     1              TEMP2,TEMP3,TEMP4,MAXNXT,
42835     1              ALAMB,ALMBSE,XMIN,
42836     1              ICAPSW,ICAPTY,IFORSW,
42837     1              ISUBRO,IBUGA3,IERROR)
42838        IF(IERROR.EQ.'YES')GOTO9000
42839C
42840        INAME1(1)='LAMB'
42841        INAME2(1)='DAML'
42842        AVAL(1)=ALAMB
42843        INAME1(2)='LAMB'
42844        INAME2(2)='DASE'
42845        AVAL(2)=ALMBSE
42846        NPAR=2
42847        GOTO8900
42848      ELSEIF(ICASAN.EQ.'RAYL' .OR. ICASAN.EQ.'1RAY')THEN
42849C
42850        IOP='OPEN'
42851        IFLAG1=1
42852        IFLAG2=1
42853        IFLAG3=0
42854        IFLAG4=0
42855        IFLAG5=0
42856        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
42857     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
42858     1              IBUGA3,ISUBRO,IERROR)
42859        IF(IERROR.EQ.'YES')GOTO9000
42860C
42861        CALL DPMLRA(Y,NS1,ICASAN,
42862     1              DTEMP1,MAXNXT,
42863     1              ALOCML,SCALML,SCALSE,SCALMM,
42864     1              ICAPSW,ICAPTY,IFORSW,
42865     1              QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,NPERC,
42866     1              IOUNI1,IOUNI2,ALPHA,
42867     1              ISUBRO,IBUGA3,IERROR)
42868        IOP='CLOS'
42869        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
42870     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
42871     1              IBUGA3,ISUBRO,IERROR)
42872        IF(IERROR.EQ.'YES')GOTO9000
42873C
42874        INAME1(1)='SCAL'
42875        INAME2(1)='EML '
42876        AVAL(1)=SCALML
42877        IF(ICASAN.EQ.'RAYL')THEN
42878          INAME1(2)='LOCM'
42879          INAME2(2)='L   '
42880          AVAL(2)=ALOCML
42881          INAME1(3)='LOCM'
42882          INAME2(3)='M   '
42883          AVAL(3)=ALOCMM
42884          INAME1(4)='SCAL'
42885          INAME2(4)='EMM '
42886          AVAL(4)=SCALMM
42887          NPAR=4
42888        ELSEIF(ICASAN.EQ.'1RAY')THEN
42889          INAME1(2)='SCAL'
42890          INAME2(2)='ESE '
42891          AVAL(2)=SCALSE
42892          NPAR=2
42893        ENDIF
42894C
42895      ELSEIF(ICASAN.EQ.'MAXW' .OR. ICASAN.EQ.'1MAX')THEN
42896C
42897        CALL DPMLMX(Y,NS1,ICASAN,
42898     1              DTEMP1,MAXNXT,
42899     1              ALOCMO,SCALMO,SCALSE,
42900     1              ALOCML,SCALML,
42901     1              ICAPSW,ICAPTY,IFORSW,
42902     1              ISUBRO,IBUGA3,IERROR)
42903        IF(IERROR.EQ.'YES')GOTO9000
42904C
42905        INAME1(1)='SCAL'
42906        INAME2(1)='EMOM'
42907        AVAL(1)=SCALMO
42908        IF(ICASAN.EQ.'MAXW')THEN
42909          INAME1(2)='LOCM'
42910          INAME2(2)='OM  '
42911          AVAL(2)=ALOCMO
42912          NPAR=2
42913        ELSEIF(ICASAN.EQ.'1MAX')THEN
42914          INAME1(2)='SCAL'
42915          INAME2(2)='EML '
42916          AVAL(2)=SCALML
42917          INAME1(3)='SCAL'
42918          INAME2(3)='ESE '
42919          AVAL(3)=SCALSE
42920          NPAR=3
42921        ENDIF
42922        GOTO8900
42923C
42924      ELSEIF(ICASAN.EQ.'HNOR' .OR. ICASAN.EQ.'1HNO')THEN
42925C
42926        CALL DPMLHN(Y,NS1,ICASAN,
42927     1              ALOCML,SCALML,
42928     1              ICAPSW,ICAPTY,IFORSW,
42929     1              ISUBRO,IBUGA3,IERROR)
42930        IF(IERROR.EQ.'YES')GOTO9000
42931C
42932        IF(ICASAN.EQ.'HFNO')THEN
42933          INAME1(1)='LOCM'
42934          INAME2(1)='L   '
42935          AVAL(1)=ALOCML
42936          INAME1(2)='SCAL'
42937          INAME2(2)='EML '
42938          AVAL(2)=SCALML
42939          NPAR=2
42940        ELSEIF(ICASAN.EQ.'1HNO')THEN
42941          INAME1(1)='SCAL'
42942          INAME2(1)='EML '
42943          AVAL(1)=SCALML
42944          NPAR=1
42945        ENDIF
42946        GOTO8900
42947C
42948      ELSEIF(ICASAN.EQ.'HALO' .OR. ICASAN.EQ.'1HAL')THEN
42949C
42950        CALL DPMLHL(Y,NS1,ICASAN,
42951     1              TEMP1,DTEMP1,MAXNXT,
42952     1              ALOCML,SCALML,SCALBC,SCALSE,
42953     1              ICAPSW,ICAPTY,IFORSW,
42954     1              ISUBRO,IBUGA3,IERROR)
42955        IF(IERROR.EQ.'YES')GOTO9000
42956C
42957        IF(ICASAN.EQ.'HALO')THEN
42958          INAME1(1)='LOCM'
42959          INAME2(1)='L   '
42960          AVAL(1)=ALOCML
42961          INAME1(2)='SCAL'
42962          INAME2(2)='EML '
42963          AVAL(2)=SCALML
42964          INAME1(3)='SCAL'
42965          INAME2(3)='EBC '
42966          AVAL(3)=SCALBC
42967          NPAR=3
42968        ELSEIF(ICASAN.EQ.'1HAL')THEN
42969          INAME1(1)='SCAL'
42970          INAME2(1)='EML '
42971          AVAL(1)=SCALML
42972          INAME1(2)='SCAL'
42973          INAME2(2)='EBC '
42974          AVAL(2)=SCALBC
42975          NPAR=2
42976        ENDIF
42977        GOTO8900
42978C
42979      ELSEIF(ICASAN.EQ.'GPDE')THEN
42980C
42981        IHP='THRE'
42982        IHP2='SHOL'
42983        IHWUSE='P'
42984        MESSAG='NO'
42985        CALL CHECKN(IHP,IHP2,IHWUSE,
42986     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
42987     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
42988        IF(IERROR.EQ.'YES')THEN
42989          THRESH=0.0
42990        ELSE
42991          THRESH=VALUE(ILOCP)
42992        ENDIF
42993        CALL DPDEGP(Y,NS1,MAXNXT,
42994     1              GAMMA,A,ASD,THRESH,
42995     1              GAMMA2,ALOC,SCALE,
42996     1              ALIKE,AIC,AICC,BIC,
42997     1              ICAPSW,ICAPTY,IFORSW,
42998     1              ISUBRO,IBUGA3,IERROR)
42999        IF(IERROR.EQ.'YES')GOTO9000
43000C
43001        INAME1(1)='GAMM'
43002        INAME2(1)='A   '
43003        AVAL(1)=GAMMA
43004        INAME1(2)='SDGA'
43005        INAME2(2)='MMA '
43006        AVAL(2)=ASD
43007        INAME1(3)='A   '
43008        INAME2(3)='    '
43009        AVAL(3)=A
43010        NPAR=3
43011C
43012        IF(GAMMA.LE.0.0)THEN
43013          INAME1(5)='LOC '
43014          INAME2(5)='    '
43015          AVAL(5)=ALOC
43016          INAME1(6)='SCAL'
43017          INAME2(6)='E   '
43018          AVAL(6)=SCALE
43019          NPAR=6
43020          IF(GAMMA.LT.0.0)THEN
43021            INAME1(7)='GAMM'
43022            INAME2(7)='A2  '
43023            AVAL(7)=GAMMA2
43024            NPAR=7
43025          ENDIF
43026        ENDIF
43027        GOTO8100
43028C
43029      ELSEIF(ICASAN.EQ.'GPCM')THEN
43030C
43031        IHP='THRE'
43032        IHP2='SHOL'
43033        IHWUSE='P'
43034        MESSAG='NO'
43035        CALL CHECKN(IHP,IHP2,IHWUSE,
43036     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
43037     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
43038        IF(IERROR.EQ.'YES')THEN
43039          THRESH=0.0
43040        ELSE
43041          THRESH=VALUE(ILOCP)
43042        ENDIF
43043        CALL DPCMGP(Y,NS1,
43044     1              GAMMA,A,ASD,THRESH,
43045     1              TEMP1,TEMP2,TEMP3,ITEMP1,
43046     1              ALIKE,AIC,AICC,BIC,
43047     1              ICAPSW,ICAPTY,IFORSW,
43048     1              ISUBRO,IBUGA3,IERROR)
43049        IF(IERROR.EQ.'YES')GOTO9000
43050C
43051        INAME1(1)='GAMM'
43052        INAME2(1)='A   '
43053        AVAL(1)=GAMMA
43054        INAME1(2)='A   '
43055        INAME2(2)='    '
43056        AVAL(2)=A
43057        NPAR=2
43058        GOTO8100
43059C
43060      ELSEIF(ICASAN.EQ.'LOGS')THEN
43061C
43062        CALL DPMLDL(Y,TEMP1,NS1,NUMV,
43063     1              TEMP2,TEMP3,TEMP4,MAXNXT,
43064     1              THETA,THETSE,
43065     1              AIC,AICC,BIC,
43066     1              ICAPSW,ICAPTY,IFORSW,
43067     1              ISUBRO,IBUGA3,IERROR)
43068        IF(IERROR.EQ.'YES')GOTO9000
43069C
43070        INAME1(1)='THET'
43071        INAME2(1)='AML '
43072        AVAL(1)=THETA
43073        INAME1(2)='THET'
43074        INAME2(2)='ASE '
43075        AVAL(2)=THETSE
43076        NPAR=2
43077        GOTO8900
43078C
43079      ELSEIF(ICASAN.EQ.'GEOM')THEN
43080C
43081        AK=1.0
43082        AKSV=CPUMIN
43083C
43084        IHP='PSV '
43085        IHP2='    '
43086        IHWUSE='P'
43087        MESSAG='NO'
43088        CALL CHECKN(IHP,IHP2,IHWUSE,
43089     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
43090     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
43091        IF(IERROR.EQ.'YES')THEN
43092          PSV=CPUMIN
43093        ELSE
43094          PSV=VALUE(ILOCP)
43095          IF(PSV.LE.0.0)PSV=CPUMIN
43096        ENDIF
43097C
43098        IDIST2='GEOMETRIC'
43099        CALL DPMLNB(Y,TEMP1,NS1,NUMV,
43100     1              AK,AKSV,PSV,
43101     1              TEMP2,TEMP3,TEMP4,DTEMP1,ITEMP1,MAXNXT,
43102     1              PMOM,AKMOM,PML,PMLBC,PMLBCV,AKML,
43103     1              PSE,AKSE,COV,
43104     1              AIC,AICC,BIC,ALIKE,
43105     1              ICAPSW,ICAPTY,IFORSW,
43106     1              IDIST2,
43107     1              ISUBRO,IBUGA3,IERROR)
43108        IF(IERROR.EQ.'YES')GOTO9000
43109C
43110        INAME1(1)='PMOM'
43111        INAME2(1)='    '
43112        AVAL(1)=PMOM
43113        INAME1(2)='PML '
43114        INAME2(2)='    '
43115        AVAL(2)=PML
43116        INAME1(3)='PMLV'
43117        INAME2(3)='AR  '
43118        AVAL(3)=PMLBCV
43119        INAME1(4)='PMLS'
43120        INAME2(4)='E   '
43121        AVAL(4)=PSE
43122        NPAR=4
43123        GOTO8100
43124C
43125      ELSEIF(ICASAN.EQ.'NEBI')THEN
43126C
43127        IHP='K   '
43128        IHP2='    '
43129        IHWUSE='P'
43130        MESSAG='NO'
43131        CALL CHECKN(IHP,IHP2,IHWUSE,
43132     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
43133     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
43134        IF(IERROR.EQ.'YES')THEN
43135          AK=CPUMIN
43136        ELSE
43137          AK=VALUE(ILOCP)
43138          IF(AK.LE.0.0)AK=CPUMIN
43139        ENDIF
43140C
43141        IHP='KSV '
43142        IHP2='    '
43143        IHWUSE='P'
43144        MESSAG='NO'
43145        CALL CHECKN(IHP,IHP2,IHWUSE,
43146     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
43147     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
43148        IF(IERROR.EQ.'YES')THEN
43149          AKSV=CPUMIN
43150        ELSE
43151          AKSV=VALUE(ILOCP)
43152          IF(AKSV.LE.0.0)AKSV=CPUMIN
43153        ENDIF
43154C
43155        IHP='PSV '
43156        IHP2='    '
43157        IHWUSE='P'
43158        MESSAG='NO'
43159        CALL CHECKN(IHP,IHP2,IHWUSE,
43160     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
43161     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
43162        IF(IERROR.EQ.'YES')THEN
43163          PSV=CPUMIN
43164        ELSE
43165          PSV=VALUE(ILOCP)
43166          IF(PSV.LE.0.0)PSV=CPUMIN
43167        ENDIF
43168C
43169        IDIST2='NEGATIVE BINOMIAL'
43170        CALL DPMLNB(Y,TEMP1,NS1,NUMV,
43171     1              AK,AKSV,PSV,
43172     1              TEMP2,TEMP3,TEMP4,DTEMP1,ITEMP1,MAXNXT,
43173     1              PMOM,AKMOM,PML,PMLBC,PMLBCV,AKML,
43174     1              PSE,AKSE,COV,
43175     1              AIC,AICC,BIC,ALIKE,
43176     1              ICAPSW,ICAPTY,IFORSW,
43177     1              IDIST2,
43178     1              ISUBRO,IBUGA3,IERROR)
43179        IF(IERROR.EQ.'YES')GOTO9000
43180C
43181        INAME1(1)='PMOM'
43182        INAME2(1)='    '
43183        AVAL(1)=PMOM
43184        INAME1(2)='PML '
43185        INAME2(2)='    '
43186        AVAL(2)=PML
43187        INAME1(3)='PMLV'
43188        INAME2(3)='AR  '
43189        AVAL(3)=PMLBCV
43190        INAME1(4)='PMLS'
43191        INAME2(4)='E   '
43192        AVAL(4)=PSE
43193        INAME1(5)='KMOM'
43194        INAME2(5)='    '
43195        AVAL(5)=AKMOM
43196        INAME1(6)='PMLB'
43197        INAME2(6)='C   '
43198        AVAL(6)=PMLBC
43199        INAME1(7)='KML '
43200        INAME2(7)='    '
43201        AVAL(7)=AKML
43202        INAME1(8)='KMLS'
43203        INAME2(8)='E   '
43204        AVAL(8)=AKSE
43205        INAME1(9)='COVP'
43206        INAME2(9)='K   '
43207        AVAL(9)=COV
43208        NPAR=9
43209        GOTO8100
43210C
43211      ELSEIF(ICASAN.EQ.'HYPG')THEN
43212C
43213        IOP='OPEN'
43214        IFLAG1=1
43215        IFLAG2=1
43216        IFLAG3=0
43217        IFLAG4=0
43218        IFLAG5=0
43219        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
43220     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
43221     1              IBUGA3,ISUBRO,IERROR)
43222        IF(IERROR.EQ.'YES')GOTO9000
43223C
43224        IDIST='HYPERGEOMETRIC'
43225        CALL DPMLHY(Y,NS1,ITEMP2,ITEMP1,
43226     1              XTEMP1,MAXNXT,
43227     1              ICAPSW,ICAPTY,IHYPTY,IOUNI1,
43228     1              ISUBRO,IBUGA3,IERROR)
43229C
43230        IOP='CLOS'
43231        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
43232     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
43233     1              IBUGA3,ISUBRO,IERROR)
43234C
43235      ELSEIF(ICASAN.EQ.'JOHN' .OR. ICASAN.EQ.'JOSB' .OR.
43236     1       ICASAN.EQ.'JOSU')THEN
43237C
43238        IHP='Z   '
43239        IHP2='    '
43240        IHWUSE='P'
43241        MESSAG='NO'
43242        CALL CHECKN(IHP,IHP2,IHWUSE,
43243     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
43244     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
43245        Z=0.524
43246        IF(IERROR.EQ.'NO')Z=VALUE(ILOCP)
43247        IF(Z.LT.0.1)Z=0.1
43248        IF(Z.GT.1.0)Z=1.0
43249C
43250        IF(ICASAN.EQ.'JOSB')THEN
43251          ICASE3='SB'
43252        ELSEIF(ICASAN.EQ.'JOSU')THEN
43253          ICASE3='SU'
43254        ELSE
43255          ICASE3='SU'
43256        ENDIF
43257C
43258        CALL DPMLJO(Y,TEMP1,TEMP2,NS1,NUMV,ICASE3,
43259     1              TEMP3,TEMP4,TEMP5,TEMP6,DTEMP1,MAXNXT,
43260     1              ALPHP1,ALPHP2,ALOCPE,SCALPE,IJOHN,Z,
43261     1              ALPHM1,ALPHM2,ALOCMO,SCALMO,
43262     1              ICAPSW,ICAPTY,IFORSW,IQUAME,
43263     1              ISUBRO,IBUGA3,IERROR)
43264C
43265        INAME1(1)='ALPH'
43266        INAME2(1)='A1PE'
43267        AVAL(1)=ALPHP1
43268        INAME1(2)='ALPH'
43269        INAME2(2)='A2PE'
43270        AVAL(2)=ALPHP2
43271        INAME1(3)='LOCP'
43272        INAME1(3)='ERC '
43273        AVAL(3)=ALOCPE
43274        INAME1(4)='SCAL'
43275        INAME2(4)='EPER'
43276        AVAL(4)=SCALPE
43277        INAME1(5)='ALPH'
43278        INAME2(5)='A1MO'
43279        AVAL(5)=ALPHM1
43280        INAME1(6)='ALPH'
43281        INAME2(6)='A2MO'
43282        AVAL(6)=ALPHM2
43283        INAME1(7)='LOCM'
43284        INAME1(7)='OM  '
43285        AVAL(7)=ALOCMO
43286        INAME1(8)='SCAL'
43287        INAME2(8)='EMOM'
43288        AVAL(8)=SCALMO
43289        INAME1(9)='JOHN'
43290        INAME2(9)='DIST'
43291        AVAL(9)=REAL(IJOHN)
43292        NPAR=9
43293        GOTO8900
43294C
43295      ELSEIF(ICASAN.EQ.'HERM')THEN
43296C
43297        IDIST='HERMITE'
43298        ALPHAM=0.0
43299        BETAMO=0.0
43300        ALPHML=0.0
43301        BETAML=0.0
43302        CALL DPMLHE(Y,TEMP1,NS1,NUMV,
43303     1              TEMP2,TEMP3,TEMP4,ITEMP1,MAXNXT,
43304     1              ALPHAM,BETAMO,ALPHML,BETAML,
43305     1              ALPHEP,BETAEP,ALPHZF,BETAZF,
43306     1              ICAPSW,ICAPTY,IFORSW,
43307     1              ISUBRO,IBUGA3,IERROR)
43308C
43309        INAME1(1)='ALPH'
43310        INAME2(1)='AMOM'
43311        AVAL(1)=ALPHAM
43312        INAME1(2)='BETA'
43313        INAME2(2)='MOM '
43314        AVAL(2)=BETAMO
43315        INAME1(3)='ALPH'
43316        INAME2(3)='AML '
43317        AVAL(3)=ALPHML
43318        INAME1(4)='BETA'
43319        INAME2(4)='ML  '
43320        AVAL(4)=BETAML
43321        INAME1(5)='ALPH'
43322        INAME2(5)='AEP '
43323        AVAL(5)=ALPHEP
43324        INAME1(6)='BETA'
43325        INAME2(6)='EP  '
43326        AVAL(6)=BETAEP
43327        INAME1(7)='ALPH'
43328        INAME2(7)='AZF '
43329        AVAL(7)=ALPHZF
43330        INAME1(8)='BETA'
43331        INAME2(8)='ZF  '
43332        AVAL(8)=BETAZF
43333        NPAR=8
43334        GOTO8900
43335C
43336      ELSEIF(ICASAN.EQ.'YULE')THEN
43337C
43338        IDIST='YULE'
43339        PMOM=0.0
43340        PML=0.0
43341        CALL DPMLYU(Y,TEMP1,NS1,NUMV,
43342     1              TEMP2,TEMP3,TEMP4,MAXNXT,
43343     1              PMOM,PFREQ,PML,
43344CCCCC1              AICMO,AICCMO,BICMO,
43345CCCCC1              AICFR,AICCFR,BICFR,
43346CCCCC1              AICML,AICCML,BICML,
43347     1              ICAPSW,ICAPTY,IFORSW,
43348     1              ISUBRO,IBUGA3,IERROR)
43349C
43350        INAME1(1)='PMOM'
43351        INAME2(1)='    '
43352        AVAL(1)=PMOM
43353        INAME1(2)='PML '
43354        INAME2(2)='    '
43355        AVAL(2)=PML
43356CCCCC   INAME1(3)='PFRE'
43357CCCCC   INAME2(3)='Q   '
43358CCCCC   AVAL(3)=PFREQ
43359        NPAR=2
43360        GOTO8900
43361C
43362      ELSEIF(ICASAN.EQ.'ZETA')THEN
43363C
43364        IDIST='ZETA'
43365        ALPHMO=0.0
43366        ALPHML=0.0
43367        ALPHFR=0.0
43368        CALL DPMLZE(Y,TEMP1,NS1,NUMV,
43369     1              TEMP2,TEMP3,TEMP4,
43370     1              ALPHML,ALPHFR,ALPHMO,AFRVAR,AMLVAR,
43371     1              ICAPSW,ICAPTY,IFORSW,MAXNXT,
43372     1              ISUBRO,IBUGA3,IERROR)
43373C
43374        INAME1(1)='ALPH'
43375        INAME2(1)='AMOM'
43376        AVAL(1)=ALPHMO
43377        INAME1(2)='ALPH'
43378        INAME2(2)='AFR '
43379        AVAL(2)=ALPHFR
43380        INAME1(3)='AFRE'
43381        INAME2(3)='QVAR'
43382        AVAL(3)=AFRVAR
43383        INAME1(4)='ALPH'
43384        INAME2(4)='AML '
43385        AVAL(4)=ALPHML
43386        INAME1(5)='AMLV'
43387        INAME2(5)='AR  '
43388        AVAL(5)=AMLVAR
43389        NPAR=5
43390        GOTO8900
43391C
43392      ELSEIF(ICASAN.EQ.'WARI')THEN
43393C
43394        IDIST='WARING'
43395        AMOM=0.0
43396        AML=0.0
43397        CMOM=0.0
43398        CML=0.0
43399        CALL DPMLWA(Y,TEMP1,NS1,NUMV,
43400     1              DTEMP1,TEMP2,TEMP3,TEMP4,MAXNXT,
43401     1              AMOM,AFREQ,AML,CMOM,CFREQ,CML,
43402     1              ICAPSW,ICAPTY,IFORSW,
43403     1              ISUBRO,IBUGA3,IERROR)
43404C
43405        INAME1(1)='AMOM'
43406        INAME2(1)='    '
43407        AVAL(1)=AMOM
43408        INAME1(2)='AFRE'
43409        INAME2(2)='Q   '
43410        AVAL(2)=AFREQ
43411        INAME1(3)='AML '
43412        INAME2(3)='    '
43413        AVAL(3)=AML
43414        INAME1(4)='CMOM'
43415        INAME2(4)='    '
43416        AVAL(4)=CMOM
43417        INAME1(5)='CFRE'
43418        INAME2(5)='Q   '
43419        AVAL(5)=CFREQ
43420        INAME1(6)='CML '
43421        INAME2(6)='    '
43422        AVAL(6)=CML
43423        NPAR=6
43424        GOTO8900
43425C
43426      ELSEIF(ICASAN.EQ.'G5LO')THEN
43427C
43428        CALL DPMLGL(Y,NS1,
43429     1              DTEMP1,DTEMP2,MAXNXT,
43430     1              ASHALM,ASCALM,ALOCLM,
43431     1              ICAPSW,ICAPTY,IFORSW,
43432     1              ISUBRO,IBUGA3,IERROR)
43433        IF(IERROR.EQ.'YES')GOTO9000
43434C
43435        INAME1(1)='GAMM'
43436        INAME2(1)='ALMO'
43437        AVAL(1)=ASHALM
43438        INAME1(2)='SCAL'
43439        INAME2(2)='ELMO'
43440        AVAL(2)=ASCALM
43441        INAME1(3)='LOCL'
43442        INAME2(3)='MOM '
43443        AVAL(3)=ALOCLM
43444        NPAR=3
43445        GOTO8900
43446C
43447      ELSEIF(ICASAN.EQ.'WAKE')THEN
43448C
43449        CALL DPMLWK(Y,NS1,
43450     1              DTEMP1,DTEMP2,MAXNXT,
43451     1              BETALM,GAMMLM,DELTLM,ALPHLM,CHILM,
43452     1              ICAPSW,ICAPTY,IFORSW,
43453     1              ISUBRO,IBUGA3,IERROR)
43454        IF(IERROR.EQ.'YES')GOTO9000
43455C
43456        INAME1(1)='BETA'
43457        INAME2(1)='LMOM'
43458        AVAL(1)=BETALM
43459        INAME1(2)='GAMM'
43460        INAME2(2)='ALMO'
43461        AVAL(2)=GAMMLM
43462        INAME1(3)='DELT'
43463        INAME2(3)='ALMO'
43464        AVAL(3)=DELTLM
43465        INAME1(4)='ALPH'
43466        INAME2(4)='ALMO'
43467        AVAL(4)=ALPHLM
43468        INAME1(5)='CHIL'
43469        INAME2(5)='MOM '
43470        AVAL(5)=CHILM
43471        NPAR=5
43472        GOTO8900
43473C
43474      ELSEIF(ICASAN.EQ.'PEA3')THEN
43475C
43476        CALL DPMLP3(Y,NS1,
43477     1              DTEMP1,DTEMP2,MAXNXT,
43478     1              GAMMLM,SCALLM,ALOCLM,
43479     1              ICAPSW,ICAPTY,IFORSW,
43480     1              ISUBRO,IBUGA3,IERROR)
43481        IF(IERROR.EQ.'YES')GOTO9000
43482C
43483        INAME1(1)='GAMM'
43484        INAME2(1)='ALMO'
43485        AVAL(1)=GAMMLM
43486        INAME1(2)='SCAL'
43487        INAME2(2)='ELMO'
43488        AVAL(2)=SCALLM
43489        INAME1(3)='LOCL'
43490        INAME2(3)='MOM '
43491        AVAL(3)=ALOCLM
43492        NPAR=3
43493        GOTO8900
43494C
43495      ELSEIF(ICASAN.EQ.'KAPP')THEN
43496C
43497        CALL DPMLKP(Y,NS1,
43498     1              DTEMP1,DTEMP2,MAXNXT,
43499     1              AKLM,AHLM,SCALLM,ALOCLM,
43500     1              ICAPSW,ICAPTY,IFORSW,
43501     1              ISUBRO,IBUGA3,IERROR)
43502        IF(IERROR.EQ.'YES')GOTO9000
43503C
43504        INAME1(1)='KLMO'
43505        INAME2(1)='M   '
43506        AVAL(1)=AKLM
43507        INAME1(2)='HLMO'
43508        INAME2(2)='M   '
43509        AVAL(2)=AHLM
43510        INAME1(3)='SCAL'
43511        INAME2(3)='ELMO'
43512        AVAL(3)=SCALLM
43513        INAME1(4)='LOCL'
43514        INAME2(4)='MOM '
43515        AVAL(4)=ALOCLM
43516        NPAR=4
43517        GOTO8900
43518C
43519      ELSE
43520        WRITE(ICOUT,999)
43521        CALL DPWRST('XXX','BUG ')
43522        WRITE(ICOUT,101)
43523        CALL DPWRST('XXX','BUG ')
43524        WRITE(ICOUT,8011)IDIST
43525 8011   FORMAT('      MAXIMUM LIKELIHOOD IS NOT CURRENTLY SUPPORTED ',
43526     1         'FOR DISTRIBUTION ',A40)
43527        CALL DPWRST('XXX','BUG ')
43528        IERROR='YES'
43529        GOTO9000
43530      ENDIF
43531C
43532      GOTO9000
43533C
43534C     UPDATED INTERNAL PARAMETERS
43535C
43536 8100 CONTINUE
43537      NPAR=NPAR+1
43538      INAME1(NPAR)='LIKE'
43539      INAME2(NPAR)='ML  '
43540      AVAL(NPAR)=ALIKE
43541      NPAR=NPAR+1
43542      INAME1(NPAR)='AICM'
43543      INAME2(NPAR)='L   '
43544      AVAL(NPAR)=AIC
43545      NPAR=NPAR+1
43546      INAME1(NPAR)='AICC'
43547      INAME2(NPAR)='ML  '
43548      AVAL(NPAR)=AICC
43549      NPAR=NPAR+1
43550      INAME1(NPAR)='BICM'
43551      INAME2(NPAR)='L   '
43552      AVAL(NPAR)=BIC
43553C
43554 8900 CONTINUE
43555      CALL DPUPPA(INAME1,INAME2,AVAL,NPAR,
43556     1            IBUGA3,ISUBRO,IERROR)
43557C
43558 8000 CONTINUE
43559C
43560C               *****************
43561C               **  STEP 90--  **
43562C               **  EXIT       **
43563C               *****************
43564C
43565 9000 CONTINUE
43566      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')THEN
43567        WRITE(ICOUT,999)
43568        CALL DPWRST('XXX','BUG ')
43569        WRITE(ICOUT,9011)
43570 9011   FORMAT('***** AT THE END       OF DPMLWE--')
43571        CALL DPWRST('XXX','BUG ')
43572        WRITE(ICOUT,9014)NS1,IFOUND,IERROR
43573 9014   FORMAT('NS1,IFOUND,IERROR = ',I8,2(2X,A4))
43574        CALL DPWRST('XXX','BUG ')
43575      ENDIF
43576C
43577      RETURN
43578      END
43579      SUBROUTINE DPMLW1(Y,N,
43580     1                  XTEMP,DTEMP,MAXNXT,
43581     1                  SCALE,SCALSE,GAMMA,GAMMSE,
43582     1                  GAMMBC,GABCSE,COVSE,COBCSE,
43583     1                  AIC,AICC,BIC,ALIKE,
43584     1                  AICBC,AICCBC,BICBC,ALIKBC,
43585     1                  NUMV,MINMAX,IWEIFL,AL,
43586     1                  ICAPSW,ICAPTY,IFORSW,
43587     1                  QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
43588     1                  IOUNI1,IOUNI2,ALPHAP,
43589     1                  ISUBRO,IBUGA3,IERROR)
43590C
43591C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
43592C              FOR WEIBULL DISTRIBUTION FOR THE FULL SAMPLE CASE.
43593C     EXAMPLE--WEIBULL MAXIMUM LIKELIHOOD Y
43594C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
43595C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
43596C                1999, CHAPTER 17.
43597C              --JOHNSON, KOTZ, AND BALAKRISNAN, "CONTINUOUS
43598C                UNIVARIATE DISTRIBUTIONS--VOLUME 1", SECOND EDITION,
43599C                WILEY, 1994, CHAPTER xx.
43600C              --KEATS, LAWRENCE, AND WANG, "WEIBULL MAXIMUM
43601C                LIKELIHOOD PARAMETER ESTIMATES WITH CENSORED
43602C                DATA", JOURNAL OF QUALITY TECHNOLOGY, 29,
43603C                PP. 105-110.
43604C              --MURTHY, XIE, AND JIANG, "WEIBULL MODELS", WILEY,
43605C                2004, PP. 114-118 (FOR INVERTED WEIBULL).
43606C     WRITTEN BY--ALAN HECKERT
43607C                 STATISTICAL ENGINEERING DIVISION
43608C                 INFORMATION TECHNOLOGY LABORATORY
43609C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
43610C                 GAITHERSBURG, MD 20899-8980
43611C                 PHONE--301-975-2899
43612C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
43613C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
43614C     LANGUAGE--ANSI FORTRAN (1977)
43615C     VERSION NUMBER--2004/11
43616C     ORIGINAL VERSION--NOVEMBER  2004. NOTE: THIS REPLACES SOME
43617C                                       EARLIER IMPLEMENTATIONS.
43618C     UPDATED         --AUGUST    2005. UPDATED TO HANDLE THE
43619C                                       INVERTED WEIBULL DISTRIBUTION
43620C     UPDATED         --APRIL     2008. ADD MINMAX TO SUPPORT
43621C                                       MAXIMUM (I.E., REVERSE
43622C                                       WEIBULL CASE)
43623C     UPDATED         --FEBRUARY  2010. PUT POINT ESTIMATES IN A
43624C                                       SEPARATE ROUTINE TO MAKE IT
43625C                                       EASIER TO CALL FROM OTHER
43626C                                       ROUTINES (BOOTSTRAP, GOODNESS
43627C                                       OF FIT)
43628C     UPDATED         --FEBRUARY  2010. USE DPDTA1, DPDTA8, DPDTA9
43629C                                       ROUTINES TO PRINT OUTPUT
43630C     UPDATED         --MARCH     2013. SUPPORT FOR GAUGE LENGTH
43631C                                       PARAMETER (AL)
43632C
43633C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
43634C
43635      CHARACTER*4 ICAPSW
43636      CHARACTER*4 ICAPTY
43637      CHARACTER*4 IFORSW
43638      CHARACTER*4 IWEIFL
43639      CHARACTER*4 ISUBRO
43640      CHARACTER*4 IBUGA3
43641      CHARACTER*4 IERROR
43642C
43643      CHARACTER*4 ISUBN1
43644      CHARACTER*4 ISUBN2
43645      CHARACTER*4 ISTEPN
43646      CHARACTER*4 ILIKFL
43647      CHARACTER*4 ICASPL
43648      CHARACTER*7 ICASE
43649      CHARACTER*40 IDIST
43650C
43651C---------------------------------------------------------------------
43652C
43653      PARAMETER (NUMALP=8)
43654      DIMENSION ALPHA(NUMALP)
43655      DIMENSION ALOWSC(NUMALP)
43656      DIMENSION AUPPSC(NUMALP)
43657      DIMENSION ALOWGA(NUMALP)
43658      DIMENSION AUPPGA(NUMALP)
43659      DIMENSION ALOWS2(NUMALP)
43660      DIMENSION AUPPS2(NUMALP)
43661      DIMENSION ALOWG2(NUMALP)
43662      DIMENSION AUPPG2(NUMALP)
43663C
43664      DIMENSION Y(*)
43665      DIMENSION XTEMP(*)
43666      DIMENSION QP(*)
43667      DIMENSION XQPHAT(*)
43668      DIMENSION XQPSE(*)
43669      DIMENSION XQPLCL(*)
43670      DIMENSION XQPUCL(*)
43671      DOUBLE PRECISION DTEMP(*)
43672C
43673CCCCC DOUBLE PRECISION WEIFUN
43674      DOUBLE PRECISION WEIFU2
43675      DOUBLE PRECISION WEIFU3
43676      EXTERNAL WEIFU2
43677      EXTERNAL WEIFU3
43678C
43679      INTEGER IN2
43680      DOUBLE PRECISION DK
43681      DOUBLE PRECISION DTERM1
43682      DOUBLE PRECISION DTERM2
43683      COMMON/WEICO2/DK,DTERM1,DTERM2,IN2
43684      INTEGER IN3
43685      DOUBLE PRECISION DK2
43686      DOUBLE PRECISION DTERM6
43687      DOUBLE PRECISION DTERM7
43688      DOUBLE PRECISION DGAMMA
43689      COMMON/WEICO3/DK2,DTERM6,DTERM7,DGAMMA,IN3
43690C
43691      DOUBLE PRECISION DN
43692      DOUBLE PRECISION DAE
43693      DOUBLE PRECISION DRE
43694      DOUBLE PRECISION DG
43695      DOUBLE PRECISION DS
43696      DOUBLE PRECISION DT1
43697      DOUBLE PRECISION DSUM1
43698      DOUBLE PRECISION DSUM2
43699      DOUBLE PRECISION DXSTRT
43700      DOUBLE PRECISION DXLOW
43701      DOUBLE PRECISION DXUP
43702CCCCC DOUBLE PRECISION XLOWSV
43703CCCCC DOUBLE PRECISION XUPSV
43704C
43705      INCLUDE 'DPCOST.INC'
43706C
43707      PARAMETER (MAXROW=50)
43708      CHARACTER*60 ITITLE
43709      CHARACTER*60 ITITLZ
43710      CHARACTER*40 ITEXT(MAXROW)
43711      REAL         AVALUE(MAXROW)
43712      INTEGER      NCTEXT(MAXROW)
43713      INTEGER      IDIGIT(MAXROW)
43714      INTEGER      NTOT(MAXROW)
43715      LOGICAL IFRST
43716      LOGICAL ILAST
43717C
43718C---------------------------------------------------------------------
43719C
43720      INCLUDE 'DPCOP2.INC'
43721C
43722      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
43723C
43724C-----START POINT-----------------------------------------------------
43725C
43726      ISUBN1='DPML'
43727      ISUBN2='W1  '
43728      IERROR='NO'
43729C
43730      IF(IWEIFL.EQ.'IWEI')THEN
43731        IDIST='INVERTED WEIBULL'
43732        ICASE='MINIMUM'
43733      ELSE
43734        IDIST='WEIBULL'
43735        ICASE='MINIMUM'
43736        IF(MINMAX.EQ.2)ICASE='MAXIMUM'
43737      ENDIF
43738C
43739      SCALET=CPUMIN
43740      IFLAGL=0
43741C
43742      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW1')THEN
43743        WRITE(ICOUT,999)
43744  999   FORMAT(1X)
43745        CALL DPWRST('XXX','WRIT')
43746        WRITE(ICOUT,51)
43747   51   FORMAT('**** AT THE BEGINNING OF DPMLW1--')
43748        CALL DPWRST('XXX','WRIT')
43749        WRITE(ICOUT,52)IBUGA3,ISUBRO,IWEIFL,IWEIGL
43750   52   FORMAT('IBUGA3,ISUBRO,IWEIFL,IWEIGL = ',3(A4,2X),A4)
43751        CALL DPWRST('XXX','WRIT')
43752        WRITE(ICOUT,55)N,NUMV,NPERC,MINMAX,IOUNI2,MAXNXT,AL
43753   55   FORMAT('N,NUMV,NPERC,MINMAX,IOUNI2,MAXNXT,AL = ',6I8,G15.7)
43754        CALL DPWRST('XXX','WRIT')
43755        DO56I=1,MIN(N,100)
43756          WRITE(ICOUT,57)I,Y(I)
43757   57     FORMAT('I,Y(I) = ',I8,G15.7)
43758          CALL DPWRST('XXX','WRIT')
43759   56   CONTINUE
43760        WRITE(ICOUT,59)IWEIFL,IWEIBC,ICASE,IDIST(1:16)
43761   59   FORMAT('IWEIFL,IWEIBC,ICASE,IDIST = ',2(A4,2X),A7,2X,A16)
43762        CALL DPWRST('XXX','WRIT')
43763      ENDIF
43764C
43765C               ********************************************
43766C               **  STEP 11--                             **
43767C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
43768C               ********************************************
43769C
43770      ISTEPN='11'
43771      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW1')
43772     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
43773C
43774      NMIN=3
43775      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
43776      IF(IERROR.EQ.'YES')GOTO9000
43777C
43778C     STEP 1: OBTAIN POINT ESTIMATES AND STANDARD ERRORS
43779C
43780      CALL WEIML1(Y,N,IWEIBC,IWEIFL,MINMAX,
43781     1            XTEMP,DTEMP,
43782     1            XMEAN,XSD,XVAR,XMIN,XMAX,
43783     1            ZMEAN,ZSD,
43784     1            SCALE,SCALSE,GAMMA,GAMMSE,
43785     1            GAMMBC,GABCSE,COVSE,COBCSE,
43786     1            ISUBRO,IBUGA3,IERROR)
43787       IF(IERROR.EQ.'YES')GOTO9000
43788C
43789CCCCC  2011/8: THIS STEP NOW DONE IN WEIML1
43790CCCCC  IF(IWEIFL.EQ.'IWEI')THEN
43791CCCCC    SCALEZ=1.0/SCALE
43792CCCCC  ENDIF
43793C
43794       ALOC=0.0
43795       ICASPL='WEIB'
43796       CALL WEILI1(Y,N,ICASPL,MINMAX,ALOC,SCALE,GAMMA,
43797     1             ALIKE,AIC,AICC,BIC,
43798     1             ISUBRO,IBUGA3,IERROR)
43799C
43800       CALL WEILI1(Y,N,ICASPL,MINMAX,ALOC,SCALE,GAMMBC,
43801     1             ALIKBC,AICBC,AICCBC,BICBC,
43802     1             ISUBRO,IBUGA3,IERROR)
43803C
43804C     STEP 2: CONFIDENCE INTERVALS FOR PARAMETERS.  CAN BASE ON EITHER
43805C             NORMAL APPROXIMATION OR ON LIKELIHOOD RATIO APPROXIMATION.
43806C
43807C     NORMAL APPROXIMATION FIRST.
43808C
43809C     NOTE 3/2013: ADJUST THE SCALE PARAMETER IF GAUGE LENGTH PARAMETER
43810C                  USED.
43811C
43812      SCALET=SCALE
43813      IFLAGL=0
43814      IF(IWEIGL.EQ.'ON' .AND. AL.GT.0.0 .AND.
43815     1   IWEIFL.EQ.'WEIB')THEN
43816        SCALET=AL**(1.0/GAMMA)*SCALE
43817        IFLAGL=1
43818      ENDIF
43819C
43820      DO2220I=1,NUMALP
43821        ALP=ALPHA(I)
43822        P=1.0-(ALP/2.0)
43823        CALL NORPPF(P,PPF)
43824        ALOWSC(I)=SCALE - PPF*SCALSE
43825        AUPPSC(I)=SCALE + PPF*SCALSE
43826        IF(IWEIBC.EQ.'ON')THEN
43827          ALOWGA(I)=GAMMBC - PPF*GABCSE
43828          AUPPGA(I)=GAMMBC + PPF*GABCSE
43829        ELSE
43830          ALOWGA(I)=GAMMA - PPF*GAMMSE
43831          AUPPGA(I)=GAMMA + PPF*GAMMSE
43832        ENDIF
43833 2220 CONTINUE
43834C
43835C  NOW DO LIKELIHOOD RATIO APPROXIMATION.
43836C  LIKELIHOOD RATIO INTERVALS FOR INVERTED WEIBULL DO NOT SEEM
43837C  CORRECT, SO JUST OMIT FOR NOW.
43838C
43839CCCCC IF(IWEIFL.EQ.'IWEI')GOTO2369
43840      IN2=N
43841      IN3=N
43842      DN=DBLE(N)
43843      DAE=1.D-7
43844      DRE=1.D-7
43845      NUTEMP=1
43846C
43847      DN=DBLE(N)
43848      DG=DBLE(GAMMA)
43849      IF(IWEIFL.EQ.'IWEI')THEN
43850        DS=DBLE(SCALE)
43851      ELSE
43852        DS=DBLE(SCALE)
43853      ENDIF
43854      DT1=DN*DLOG(DBLE(GAMMA)) - DN*DG*DLOG(DS)
43855      DSUM1=0.0D0
43856      DSUM2=0.0D0
43857      DO2325I=1,N
43858        DTEMP(I)=DBLE(Y(I))
43859        DSUM1=DSUM1 + DLOG(DBLE(Y(I)))
43860        DSUM2=DSUM2 + DBLE(Y(I))**DG
43861 2325 CONTINUE
43862      DTERM2=DSUM1
43863      DTERM1=2.0D0*(DT1 + (DG-1.0D0)*DTERM2 - DS**(-DG)*DSUM2)
43864      DTERM7=DTERM2
43865      DTERM6=DTERM1
43866      DGAMMA=DBLE(GAMMA)
43867C
43868      DO2360I=1,NUMALP
43869        ALP=ALPHA(I)
43870        CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
43871        DK=DBLE(APPF)
43872        DK2=DK
43873C
43874        DXSTRT=DBLE(ALOWGA(I))
43875        DXLOW=DXSTRT/5.0D0
43876        DXUP=DBLE(GAMMA)
43877        CALL DFZER2(WEIFU2,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
43878        ALOWG2(I)=REAL(DXLOW)
43879C
43880        DXSTRT=DBLE(AUPPGA(I))
43881        DXUP=DXSTRT*5.0D0
43882        DXLOW=DBLE(GAMMA)
43883        CALL DFZER2(WEIFU2,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
43884        AUPPG2(I)=REAL(DXLOW)
43885C
43886        IF(IWEIFL.EQ.'IWEI')THEN
43887          DXSTRT=MIN(1.0D0/DBLE(ALOWSC(I)),1.0D0/DBLE(AUPPSC(I)))
43888          DXLOW=DXSTRT/5.0D0
43889CCCCC     DXUP=1.0D0/DBLE(SCALEZ)
43890          DXUP=1.0D0/DBLE(SCALE)
43891        ELSE
43892          DXSTRT=DBLE(ALOWSC(I))
43893          DXLOW=DXSTRT/5.0D0
43894          DXUP=DBLE(SCALE)
43895        ENDIF
43896        CALL DFZER2(WEIFU3,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
43897        IF(IWEIFL.EQ.'IWEI')THEN
43898          ALOWS2(I)=REAL(1.0D0/DXLOW)
43899        ELSE
43900          ALOWS2(I)=REAL(DXLOW)
43901        ENDIF
43902C
43903        IF(IWEIFL.EQ.'IWEI')THEN
43904          DXSTRT=MAX(1.0D0/DBLE(ALOWSC(I)),1.0D0/DBLE(AUPPSC(I)))
43905          DXUP=DXSTRT*5.0D0
43906          DXLOW=1.0D0/DBLE(SCALE)
43907        ELSE
43908          DXSTRT=DBLE(AUPPSC(I))
43909          DXUP=DXSTRT*5.0D0
43910          DXLOW=DBLE(SCALE)
43911        ENDIF
43912        CALL DFZER2(WEIFU3,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
43913        IF(IWEIFL.EQ.'IWEI')THEN
43914          AUPPS2(I)=REAL(1.0D0/DXLOW)
43915          IF(AUPPS2(I).LT.ALOWS2(I))THEN
43916            ATEMP=AUPPS2(I)
43917            AUPPS2(I)=ALOWS2(I)
43918            ALOWS2(I)=ATEMP
43919          ENDIF
43920        ELSE
43921          AUPPS2(I)=REAL(DXLOW)
43922        ENDIF
43923 2360 CONTINUE
43924C
43925C  CONFIDENCE INTERVALS FOR SELECTED PERCENTILES.
43926C
43927C  1. STANDARD ERROR USES TECHNIQUE DEMONSTRATED IN EXAMPLE 17.4
43928C     (P. 344) OF BURY.  THIS IS BASED ON PROPOGATION OF ERROR.
43929C
43930C  2. CONFIDENCE INTERVAL IS THEN GENERATED USING NORMAL
43931C     APPROXIMATION (EXAMPLE 17.7 OF BURY).  BURY ALSO DEMONSTRATES
43932C     A LIKELIHOOD RATIO APPROACH, BUT OMIT THIS FOR NOW.
43933C
43934C  3. 2014/03: ONE-SIDED PERCENTILES ARE EQUIVALENT TO ONE-SIDED
43935C     TOLERANCE INTERVALS.  THE COMMAND
43936C
43937C         SET DISTRIBUTIONAL PERCENTILE <LOWER/UPPER/TWO-SIDED>
43938C
43939C     ALLOWS THE USER TO SPECIFY WHAT TYPE OF PERCENTILE INTERVAL IS
43940C     DESIRED.
43941C
43942      IF(NPERC.GE.1)THEN
43943C
43944        IF(IDTYPR.EQ.'LOWE')THEN
43945          ALPHL=ALPHAP
43946          ALPHU=1.0 - ALPHAP
43947        ELSEIF(IDTYPR.EQ.'UPPE')THEN
43948          ALPHL=ALPHAP
43949          ALPHU=1.0 - ALPHAP
43950        ELSE
43951          ALPHL=ALPHAP/2.0
43952          ALPHU=1.0 - ALPHAP/2.0
43953        ENDIF
43954C
43955        CALL NORPPF(ALPHU,Z95)
43956        MINMAX=1
43957C
43958        IF(IWEIBC.EQ.'ON')THEN
43959          G=GAMMBC
43960          GSE=GABCSE
43961          COV=COBCSE
43962        ELSE
43963          G=GAMMA
43964          GSE=GAMMSE
43965          COV=COVSE
43966        ENDIF
43967C
43968        WRITE(IOUNI1,2431)
43969        WRITE(IOUNI1,2432)
43970        DO2429I=1,NPERC
43971          QPTEMP=QP(I)/100.0
43972          CALL WEIPPF(QPTEMP,G,MINMAX,APPF)
43973          XQPHAT(I)=SCALE*APPF
43974C
43975          C=LOG(1.0/(1.0 - QPTEMP))
43976          DA=C**(1.0/G)
43977          DB=-(SCALE*C**(1.0/G)*LOG(C)/(G**2))
43978          TERM1=(DA*SCALSE)**2
43979          TERM2=(DB*GSE)**2
43980          TERM3=2.0*DA*DB*COV*COV
43981          SEXQP=SQRT(TERM1 + TERM2 + TERM3)
43982          XQPSE(I)=SEXQP
43983          IF(IDTYPR.EQ.'UPPE')THEN
43984            XQPLCL(I)=CPUMIN
43985          ELSE
43986            XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
43987          ENDIF
43988          IF(IDTYPR.EQ.'LOWE')THEN
43989            XQPUCL(I)=CPUMIN
43990          ELSE
43991            XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
43992          ENDIF
43993          WRITE(IOUNI1,'(5E15.7)')
43994     1         QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
43995 2429   CONTINUE
43996 2431   FORMAT(15X,'       POINT     ','     LOWER     ',
43997     1         '     UPPER')
43998 2432   FORMAT('    PERCENTILE ','     ESTIMATE   ',
43999     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
44000      ENDIF
44001C
44002      IF(IFLAGL.EQ.1)THEN
44003        AFACT=AL**(1.0/GAMMA)
44004        DO2370I=1,NUMALP
44005          ALP=ALPHA(I)
44006          P=1.0-(ALP/2.0)
44007          CALL NORPPF(P,PPF)
44008          ALOWSC(I)=SCALET - PPF*SCALSE
44009          AUPPSC(I)=SCALET + PPF*SCALSE
44010          ALOWS2(I)=AFACT*ALOWS2(I)
44011          AUPPS2(I)=AFACT*AUPPS2(I)
44012 2370   CONTINUE
44013      ENDIF
44014C
44015C               *************************************
44016C               **   STEP 42--                     **
44017C               **   WRITE OUT EVERYTHING          **
44018C               **   FOR WEIBULL MLE ESTIMATE      **
44019C               *************************************
44020C
44021      ISTEPN='42'
44022      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW1')
44023     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
44024C
44025C     PRINT SUMMARY STATISTICS TABLE
44026C
44027      IF(IPRINT.EQ.'OFF')GOTO9000
44028C
44029      NUMDIG=7
44030      IF(IFORSW.EQ.'1')NUMDIG=1
44031      IF(IFORSW.EQ.'2')NUMDIG=2
44032      IF(IFORSW.EQ.'3')NUMDIG=3
44033      IF(IFORSW.EQ.'4')NUMDIG=4
44034      IF(IFORSW.EQ.'5')NUMDIG=5
44035      IF(IFORSW.EQ.'6')NUMDIG=6
44036      IF(IFORSW.EQ.'7')NUMDIG=7
44037      IF(IFORSW.EQ.'8')NUMDIG=8
44038      IF(IFORSW.EQ.'9')NUMDIG=9
44039      IF(IFORSW.EQ.'0')NUMDIG=0
44040      IF(IFORSW.EQ.'E')NUMDIG=-2
44041      IF(IFORSW.EQ.'-2')NUMDIG=-2
44042      IF(IFORSW.EQ.'-3')NUMDIG=-3
44043      IF(IFORSW.EQ.'-4')NUMDIG=-4
44044      IF(IFORSW.EQ.'-5')NUMDIG=-5
44045      IF(IFORSW.EQ.'-6')NUMDIG=-6
44046      IF(IFORSW.EQ.'-7')NUMDIG=-7
44047      IF(IFORSW.EQ.'-8')NUMDIG=-8
44048      IF(IFORSW.EQ.'-9')NUMDIG=-9
44049C
44050      IF(IWEIFL.EQ.'IWEI')THEN
44051        ITITLE='Two-Parameter Inverted Weibull Parameter Estimation:'
44052        NCTITL=52
44053        ITITLZ='Full Sample Case'
44054        NCTITZ=16
44055      ELSEIF(ICASE.EQ.'MINIMUM')THEN
44056        ITITLE='Two-Parameter Weibull (Minimum) Parameter Estimation:'
44057        NCTITL=53
44058        ITITLZ='Full Sample Case'
44059        NCTITZ=16
44060      ELSEIF(ICASE.EQ.'MAXIMUM')THEN
44061        ITITLE='Two-Parameter Weibull (Maximum) Parameter Estimation:'
44062        NCTITL=53
44063        ITITLZ='Full Sample Case'
44064        NCTITZ=16
44065      ELSE
44066        ITITLE='Two-Parameter Weibull (Minimum) Parameter Estimation:'
44067        NCTITL=53
44068        ITITLZ='Full Sample Case'
44069        NCTITZ=16
44070      ENDIF
44071      ITEXT(1)='Summary Statistics:'
44072      NCTEXT(1)=19
44073      AVALUE(1)=0.0
44074      IDIGIT(1)=0
44075      ITEXT(2)='Number of Observations:'
44076      NCTEXT(2)=23
44077      AVALUE(2)=REAL(N)
44078      IDIGIT(2)=0
44079      ITEXT(3)='Sample Mean:'
44080      NCTEXT(3)=12
44081      AVALUE(3)=XMEAN
44082      IDIGIT(3)=NUMDIG
44083      ITEXT(4)='Sample Standard Deviation:'
44084      NCTEXT(4)=26
44085      AVALUE(4)=XSD
44086      IDIGIT(4)=NUMDIG
44087      ITEXT(5)='Sample Minimum:'
44088      NCTEXT(5)=15
44089      AVALUE(5)=XMIN
44090      IDIGIT(5)=NUMDIG
44091      ITEXT(6)='Sample Maximum:'
44092      NCTEXT(6)=15
44093      AVALUE(6)=XMAX
44094      IDIGIT(6)=NUMDIG
44095      NUMROW=6
44096C
44097      IF(IFLAGL.EQ.1)THEN
44098        NUMROW=NUMROW+1
44099        ITEXT(NUMROW)='Gauge Length:'
44100        NCTEXT(NUMROW)=13
44101        AVALUE(NUMROW)=AL
44102        IDIGIT(NUMROW)=NUMDIG
44103      ENDIF
44104C
44105      DO2310I=1,NUMROW
44106        NTOT(I)=15
44107 2310 CONTINUE
44108C
44109      IFRST=.TRUE.
44110      ILAST=.FALSE.
44111      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
44112     1            NCTEXT,AVALUE,IDIGIT,
44113     1            NTOT,NUMROW,
44114     1            ICAPSW,ICAPTY,ILAST,IFRST,
44115     1            ISUBRO,IBUGA3,IERROR)
44116      IFRST=.FALSE.
44117      ITITLE=' '
44118      NCTITL=0
44119C
44120      ICNT=1
44121      ITEXT(ICNT)='Maximum Likelihood:'
44122      NCTEXT(ICNT)=19
44123      AVALUE(ICNT)=0.0
44124      IDIGIT(ICNT)=-1
44125      ICNT=ICNT+1
44126      ITEXT(ICNT)='Estimate of Scale:'
44127      NCTEXT(ICNT)=18
44128      AVALUE(ICNT)=SCALET
44129      IDIGIT(ICNT)=NUMDIG
44130      ICNT=ICNT+1
44131      ITEXT(ICNT)='Estimate of Shape (Gamma):'
44132      NCTEXT(ICNT)=26
44133      AVALUE(ICNT)=GAMMA
44134      IDIGIT(ICNT)=NUMDIG
44135      ICNT=ICNT+1
44136      ITEXT(ICNT)='Standard Error of Scale:'
44137      NCTEXT(ICNT)=24
44138      AVALUE(ICNT)=SCALSE
44139      IDIGIT(ICNT)=NUMDIG
44140      ICNT=ICNT+1
44141      ITEXT(ICNT)='Standard Error of Shape:'
44142      NCTEXT(ICNT)=24
44143      AVALUE(ICNT)=GAMMSE
44144      IDIGIT(ICNT)=NUMDIG
44145      ICNT=ICNT+1
44146      ITEXT(ICNT)='Shape/Scale Covariance:'
44147      NCTEXT(ICNT)=23
44148      AVALUE(ICNT)=COVSE
44149      IDIGIT(ICNT)=NUMDIG
44150      ICNT=ICNT+1
44151      ITEXT(ICNT)='Log-likelihood:'
44152      NCTEXT(ICNT)=15
44153      AVALUE(ICNT)=ALIKE
44154      IDIGIT(ICNT)=-7
44155      ICNT=ICNT+1
44156      ITEXT(ICNT)='AIC:'
44157      NCTEXT(ICNT)=4
44158      AVALUE(ICNT)=AIC
44159      IDIGIT(ICNT)=-7
44160      ICNT=ICNT+1
44161      ITEXT(ICNT)='AICc:'
44162      NCTEXT(ICNT)=5
44163      AVALUE(ICNT)=AICC
44164      IDIGIT(ICNT)=-7
44165      ICNT=ICNT+1
44166      ITEXT(ICNT)='BIC:'
44167      NCTEXT(ICNT)=4
44168      AVALUE(ICNT)=BIC
44169      IDIGIT(ICNT)=-7
44170C
44171      ICNT=ICNT+1
44172      ITEXT(ICNT)=' '
44173      NCTEXT(ICNT)=0
44174      AVALUE(ICNT)=0.0
44175      IDIGIT(ICNT)=-1
44176      ICNT=ICNT+1
44177      ITEXT(ICNT)='Maximum Likelihood (Bias Corrected):'
44178      NCTEXT(ICNT)=36
44179      AVALUE(ICNT)=0.0
44180      IDIGIT(ICNT)=-1
44181      ICNT=ICNT+1
44182      ITEXT(ICNT)='Estimate of Scale:'
44183      NCTEXT(ICNT)=18
44184      AVALUE(ICNT)=SCALE
44185      IDIGIT(ICNT)=NUMDIG
44186      ICNT=ICNT+1
44187      ITEXT(ICNT)='Estimate of Shape (Gamma):'
44188      NCTEXT(ICNT)=26
44189      AVALUE(ICNT)=GAMMBC
44190      IDIGIT(ICNT)=NUMDIG
44191      ICNT=ICNT+1
44192      ITEXT(ICNT)='Standard Error of Scale:'
44193      NCTEXT(ICNT)=24
44194      AVALUE(ICNT)=SCALSE
44195      IDIGIT(ICNT)=NUMDIG
44196      ICNT=ICNT+1
44197      ITEXT(ICNT)='Standard Error of Shape:'
44198      NCTEXT(ICNT)=24
44199      AVALUE(ICNT)=GABCSE
44200      IDIGIT(ICNT)=NUMDIG
44201      ICNT=ICNT+1
44202      ITEXT(ICNT)='Shape/Scale Covariance:'
44203      NCTEXT(ICNT)=23
44204      AVALUE(ICNT)=COVSE
44205      IDIGIT(ICNT)=NUMDIG
44206      ICNT=ICNT+1
44207      ITEXT(ICNT)='Log-likelihood:'
44208      NCTEXT(ICNT)=15
44209      AVALUE(ICNT)=ALIKBC
44210      IDIGIT(ICNT)=-7
44211      ICNT=ICNT+1
44212      ITEXT(ICNT)='AIC:'
44213      NCTEXT(ICNT)=4
44214      AVALUE(ICNT)=AICBC
44215      IDIGIT(ICNT)=-7
44216      ICNT=ICNT+1
44217      ITEXT(ICNT)='AICc:'
44218      NCTEXT(ICNT)=5
44219      AVALUE(ICNT)=AICCBC
44220      IDIGIT(ICNT)=-7
44221      ICNT=ICNT+1
44222      ITEXT(ICNT)='BIC:'
44223      NCTEXT(ICNT)=4
44224      AVALUE(ICNT)=BICBC
44225      IDIGIT(ICNT)=-7
44226C
44227C
44228      NUMROW=ICNT
44229      DO2320I=1,NUMROW
44230        NTOT(I)=15
44231 2320 CONTINUE
44232C
44233      IFRST=.FALSE.
44234      ILAST=.FALSE.
44235      ITITLZ=' '
44236      NCTITZ=0
44237      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
44238     1            AVALUE,IDIGIT,
44239     1            NTOT,NUMROW,
44240     1            ICAPSW,ICAPTY,ILAST,IFRST,
44241     1            ISUBRO,IBUGA3,IERROR)
44242C
44243      ILIKFL='ON'
44244      CALL DPDTA8(ALOWSC,AUPPSC,ALOWS2,AUPPS2,
44245     1            ALOWGA,AUPPGA,ALOWG2,AUPPG2,ALPHA,NUMALP,
44246     1            ICAPSW,ICAPTY,NUMDIG,ILIKFL,
44247     1            ISUBRO,IBUGA3,IERROR)
44248C
44249      IF(NPERC.GT.1)THEN
44250        ILIKFL='OFF'
44251        CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
44252     1              ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
44253     1              ISUBRO,IBUGA3,IERROR)
44254      ENDIF
44255C
44256C               *****************
44257C               **  STEP 90--  **
44258C               **  EXIT       **
44259C               *****************
44260C
44261 9000 CONTINUE
44262C
44263      IF(IFLAGL.EQ.1)THEN
44264        SCALE=SCALET
44265      ENDIF
44266C
44267      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW1')THEN
44268        WRITE(ICOUT,999)
44269        CALL DPWRST('XXX','WRIT')
44270        WRITE(ICOUT,9011)
44271 9011   FORMAT('***** AT THE END       OF DPMLW1--')
44272        CALL DPWRST('XXX','WRIT')
44273        WRITE(ICOUT,9012)N,IBUGA3,IERROR
44274 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
44275        CALL DPWRST('XXX','WRIT')
44276        WRITE(ICOUT,9015)N
44277 9015   FORMAT('N = ',I8)
44278        CALL DPWRST('XXX','WRIT')
44279      ENDIF
44280C
44281      RETURN
44282      END
44283      SUBROUTINE DPMLW2(Y,TAG,N,
44284     1                  XTEMP,DTEMP,ITEMP,MAXNXT,
44285     1                  SCALE,SCALSE,GAMMA,GAMMSE,
44286     1                  GAMMBC,GABCSE,COVSE,COBCSE,
44287     1                  NUMV,MINMAX,
44288     1                  ICAPSW,ICAPTY,IFORSW,IWEIFL,AL,
44289     1                  QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
44290     1                  IOUNI1,IOUNI2,ALPHAP,
44291     1                  ISUBRO,IBUGA3,IERROR)
44292C
44293C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
44294C              ESTIMATES FOR WEIBULL DISTRIBUTION
44295C              FOR THE TIME CENSORED (SINGY OR MULTIPLY) CASE.
44296C     EXAMPLE--WEIBULL MAXIMUM LIKELIHOOD Y X
44297C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
44298C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
44299C                1999, CHAPTER 17.
44300C              --JOHNSON, KOTZ, AND BALAKRISNAN, "CONTINUOUS
44301C                UNIVARIATE DISTRIBUTIONS--VOLUME 1", SECOND EDITION,
44302C                WILEY, 1994, CHAPTER xx.
44303C              --KEATS, LAWRENCE, AND WANG, "WEIBULL MAXIMUM
44304C                LIKELIHOOD PARAMETER ESTIMATES WITH CENSORED
44305C                DATA", JOURNAL OF QUALITY TECHNOLOGY, 29,
44306C                PP. 105-110.
44307C              --MURTHY, XIE, AND JIANG, "WEIBULL MODELS", WILEY,
44308C                2004, PP. 114-118 (FOR INVERTED WEIBULL).
44309C     WRITTEN BY--ALAN HECKERT
44310C                 STATISTICAL ENGINEERING DIVISION
44311C                 INFORMATION TECHNOLOGY LABORATORY
44312C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
44313C                 GAITHERSBURG, MD 20899-8980
44314C                 PHONE--301-975-2899
44315C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
44316C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
44317C     LANGUAGE--ANSI FORTRAN (1977)
44318C     VERSION NUMBER--2004/11
44319C     ORIGINAL VERSION--NOVEMBER  2004. NOTE: THIS REPLACES SOME
44320C                                       EARLIER IMPLEMENTATIONS.
44321C     UPDATED         --AUGUST    2005. UPDATED TO HANDLE THE
44322C                                       INVERTED WEIBULL DISTRIBUTION.
44323C                                       CURRENTLY, INVERTED WEIBULL WILL
44324C                                       ONLY GENERATE POINT ESTIMATES
44325C                                       SINCE COMPUTATION OF SCALE SE
44326C                                       IS NOT RETURNING A REASONABLE
44327C                                       VALUE.
44328C     UPDATED         --APRIL     2008. ADD MINMAX TO SUPPORT MAXIMUM
44329C                                       CASE
44330C     UPDATED         --FEBRUARY  2010. PRINT TABLES WITH DPDTA1,
44331C                                       DPDTA8, AND DPDTA9
44332C     UPDATED         --MARCH     2013. SUPPORT FOR GAUGE LENGTH
44333C                                       PARAMETER (AL)
44334C
44335C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
44336C
44337      CHARACTER*4 ICAPSW
44338      CHARACTER*4 ICAPTY
44339      CHARACTER*4 IFORSW
44340      CHARACTER*4 IWEIFL
44341C
44342      CHARACTER*4 ISUBRO
44343      CHARACTER*4 IBUGA3
44344      CHARACTER*4 IERROR
44345C
44346      CHARACTER*4 ICASE
44347      CHARACTER*7 ICASE2
44348      CHARACTER*4 IWRITE
44349      CHARACTER*4 ILIKFL
44350      CHARACTER*40 IDIST
44351      CHARACTER*4 ISUBN1
44352      CHARACTER*4 ISUBN2
44353      CHARACTER*4 ISTEPN
44354C
44355C---------------------------------------------------------------------
44356C
44357      PARAMETER (NUMALP=8)
44358      DIMENSION ALPHA(NUMALP)
44359      DIMENSION ALOWSC(NUMALP)
44360      DIMENSION AUPPSC(NUMALP)
44361      DIMENSION ALOWGA(NUMALP)
44362      DIMENSION AUPPGA(NUMALP)
44363      DIMENSION ALOWS2(NUMALP)
44364      DIMENSION AUPPS2(NUMALP)
44365      DIMENSION ALOWG2(NUMALP)
44366      DIMENSION AUPPG2(NUMALP)
44367C
44368      DIMENSION Y(*)
44369      DIMENSION TAG(*)
44370      DIMENSION XTEMP(*)
44371      DIMENSION QP(*)
44372      DIMENSION XQPHAT(*)
44373      DIMENSION XQPSE(*)
44374      DIMENSION XQPLCL(*)
44375      DIMENSION XQPUCL(*)
44376      INTEGER ITEMP(*)
44377      DOUBLE PRECISION DTEMP(*)
44378C
44379      DOUBLE PRECISION WEIFUN
44380      EXTERNAL WEIFUN
44381CCCCC EXTERNAL WEIFU5
44382CCCCC EXTERNAL WEIFU6
44383C
44384      INTEGER IN
44385      DOUBLE PRECISION DWEISM
44386      COMMON/WEICOM/DWEISM,IN
44387C
44388      INTEGER IN2
44389      INTEGER IR2
44390      DOUBLE PRECISION DK
44391      DOUBLE PRECISION DTERM1
44392      DOUBLE PRECISION DTERM2
44393      COMMON/WEICO5/DK,DTERM1,DTERM2,IN2,IR2
44394      INTEGER IN3
44395      INTEGER IR3
44396      DOUBLE PRECISION DK2
44397      DOUBLE PRECISION DTERM6
44398      DOUBLE PRECISION DTERM7
44399      DOUBLE PRECISION DGAMMA
44400      COMMON/WEICO6/DK2,DTERM6,DTERM7,DGAMMA,IN3,IR3
44401C
44402CCCCC DOUBLE PRECISION DN
44403CCCCC DOUBLE PRECISION AE
44404CCCCC DOUBLE PRECISION RE
44405CCCCC DOUBLE PRECISION DG
44406CCCCC DOUBLE PRECISION DS
44407CCCCC DOUBLE PRECISION DT1
44408CCCCC DOUBLE PRECISION DSUM1
44409CCCCC DOUBLE PRECISION DSUM2
44410CCCCC DOUBLE PRECISION XSTART
44411CCCCC DOUBLE PRECISION XLOW
44412CCCCC DOUBLE PRECISION XUP
44413CCCCC DOUBLE PRECISION DX
44414CCCCC DOUBLE PRECISION DSCALE
44415C
44416      INCLUDE 'DPCOST.INC'
44417C
44418      PARAMETER (MAXROW=30)
44419      CHARACTER*60 ITITLE
44420      CHARACTER*60 ITITLZ
44421      CHARACTER*40 ITEXT(MAXROW)
44422      REAL         AVALUE(MAXROW)
44423      INTEGER      NCTEXT(MAXROW)
44424      INTEGER      IDIGIT(MAXROW)
44425      INTEGER      NTOT(MAXROW)
44426      LOGICAL IFRST
44427      LOGICAL ILAST
44428C
44429C---------------------------------------------------------------------
44430C
44431      INCLUDE 'DPCOP2.INC'
44432C
44433      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
44434C
44435C-----START POINT-----------------------------------------------------
44436C
44437      ISUBN1='DPML'
44438      ISUBN2='W2  '
44439      IWRITE='OFF'
44440      IERROR='NO'
44441C
44442      GAMMSE=CPUMIN
44443      GAMMBC=CPUMIN
44444      GABCSE=CPUMIN
44445      COVSE=CPUMIN
44446      COBCSE=CPUMIN
44447C
44448      IF(IWEIFL.EQ.'IWEI')THEN
44449        IDIST='INVERTED WEIBULL'
44450        ICASE2='MINIMUM'
44451      ELSE
44452        IDIST='WEIBULL'
44453        ICASE2='MINIMUM'
44454        IF(MINMAX.EQ.2)ICASE2='MAXIMUM'
44455      ENDIF
44456C
44457      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW2')THEN
44458        WRITE(ICOUT,999)
44459  999   FORMAT(1X)
44460        CALL DPWRST('XXX','WRIT')
44461        WRITE(ICOUT,51)
44462   51   FORMAT('**** AT THE BEGINNING OF DPMLW2--')
44463        CALL DPWRST('XXX','WRIT')
44464        WRITE(ICOUT,52)IBUGA3
44465   52   FORMAT('IBUGA3,ICENTY = ',A4)
44466        CALL DPWRST('XXX','WRIT')
44467        WRITE(ICOUT,55)N,NUMV,NPERC,IOUNI2
44468   55   FORMAT('N,NUMV,NPERC,IOUNI2 = ',4I8)
44469        CALL DPWRST('XXX','WRIT')
44470        DO56I=1,MIN(N,100)
44471          WRITE(ICOUT,57)I,Y(I),TAG(I)
44472   57     FORMAT('I,Y(I),TAG(I) = ',I8,2G15.7)
44473          CALL DPWRST('XXX','WRIT')
44474   56   CONTINUE
44475        WRITE(ICOUT,59)IBUGA3,ICENTY,IWEIBC
44476   59   FORMAT('IBUGA3,ICENTY,IWEIBC = ',2(A4,2X),A4)
44477        CALL DPWRST('XXX','WRIT')
44478      ENDIF
44479C
44480C               ********************************************
44481C               **  STEP 11--                             **
44482C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
44483C               ********************************************
44484C
44485      ISTEPN='11'
44486      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW2')
44487     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
44488C
44489      NMIN=3
44490      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
44491      IF(IERROR.EQ.'YES')GOTO9000
44492C
44493C               ********************************************
44494C               **  STEP 21--                             **
44495C               **  CALL WEIML2 TO OBTAIN THE POINT       **
44496C               **  ESTIMATES AND STANDARD ERRORS.  WEIML2**
44497C               **  ALSO PERFORMS SOME ERROR CHECKING.    **
44498C               ********************************************
44499C
44500      ISTEPN='21'
44501      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW2')
44502     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
44503C
44504      CALL WEIML2(Y,TAG,N,IWEIBC,IWEIFL,MINMAX,MAXNXT,
44505     1            ICASE,ICASE2,IDIST,
44506     1            XTEMP,DTEMP,ITEMP,
44507     1            XMEAN,XSD,XVAR,XMIN,XMAX,
44508     1            ZMEAN,ZSD,
44509     1            SCALML,SCALSE,SHAPML,SHAPSE,
44510     1            SHAPBC,SHABSE,COVSE,COVBSE,
44511     1            IR,
44512     1            ISUBRO,IBUGA3,IERROR)
44513C
44514C     NOTE 3/2013: ADJUST THE SCALE PARAMETER IF GAUGE LENGTH PARAMETER
44515C                  USED.
44516C
44517      SCALET=SCALML
44518      IFLAGL=0
44519      IF(IWEIGL.EQ.'ON' .AND. AL.GT.0.0 .AND.
44520     1   IWEIFL.EQ.'WEIB')THEN
44521        SCALET=AL**(1.0/GAMMA)*SCALML
44522        IFLAGL=1
44523      ENDIF
44524C
44525      IM=N-IR
44526      IR1=IR
44527      IR2=IR
44528      IR3=IR
44529C
44530      AR=REAL(IR)
44531      DR=DBLE(IR)
44532      AN=REAL(N)
44533      AM=REAL(IM)
44534C
44535      IF(IWEIFL.EQ.'IWEI')GOTO3499
44536C
44537C     CONFIDENCE INTERVALS FOR PARAMETERS.  CAN BASE ON EITHER NORMAL
44538C     APPROXIMATION OR ON LIKELIHOOD RATIO APPROXIMATION.
44539C
44540C     NORMAL APPROXIMATION FIRST.
44541C
44542      DO3310I=1,NUMALP
44543        ALP=ALPHA(I)
44544        P=1.0-(ALP/2.0)
44545        CALL NORPPF(P,PPF)
44546        IF(IWEIBC.EQ.'ON')THEN
44547          ALOWSC(I)=SCALML - PPF*SCALSE
44548          AUPPSC(I)=SCALML + PPF*SCALSE
44549          ALOWGA(I)=SHAPBC - PPF*SHABSE
44550          AUPPGA(I)=SHAPBC + PPF*SHABSE
44551        ELSE
44552          ALOWSC(I)=SCALML - PPF*SCALSE
44553          AUPPSC(I)=SCALML + PPF*SCALSE
44554          ALOWGA(I)=SHAPML - PPF*SHAPSE
44555          AUPPGA(I)=SHAPML + PPF*SHAPSE
44556        ENDIF
44557 3310 CONTINUE
44558C
44559C     NOW DO LIKELIHOOD RATIO APPROXIMATION.
44560C
44561C     THIS NEEDS A LITTLE MORE DEBUGGING.
44562C
44563CCCCC IN2=N
44564CCCCC IN3=N
44565CCCCC DN=DBLE(N)
44566CCCCC AE=1.D-7
44567CCCCC RE=1.D-7
44568CCCCC NUTEMP=1
44569C
44570CCCCC DN=DBLE(N)
44571CCCCC DR=DBLE(IR)
44572CCCCC DG=DBLE(GAMMA)
44573CCCCC DS=DBLE(SCALE)
44574CCCCC DT1=DN*DLOG(DBLE(GAMMA)) - DN*DG*DLOG(DS)
44575CCCCC DSUM1=0.0D0
44576CCCCC DSUM2=0.0D0
44577CCCCC DO3325I=1,N
44578CCCCC   DTEMP(I)=DBLE(Y(I))
44579CCCCC   IF(TAG(I).EQ.1.0)DSUM1=DSUM1 + DLOG(DBLE(Y(I)))
44580CCCCC   DSUM2=DSUM2 + DBLE(Y(I))**DG
44581C3325 CONTINUE
44582CCCCC DTERM2=DSUM1
44583CCCCC DTERM1=2.0D0*(DT1 + (DG-1.0D0)*DTERM2 - DS**(-DG)*DSUM2)
44584CCCCC DTERM7=DTERM2
44585CCCCC DTERM6=DTERM1
44586CCCCC DGAMMA=DBLE(GAMMA)
44587C
44588CCCCC DO3340I=1,NUMALP
44589CCCCC   ALP=ALPHA(I)
44590CCCCC   CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
44591CCCCC   DK=DBLE(APPF)
44592CCCCC   DK2=DK
44593C
44594CCCCC   XSTART=DBLE(ALOWGA(I))
44595CCCCC   XLOW=XSTART/5.0D0
44596CCCCC   XUP=DBLE(GAMMA)
44597CCCCC   CALL DFZER2(WEIFU5,XLOW,XUP,XSTART,RE,AE,IFLAG,DTEMP)
44598CCCCC   ALOWG2(I)=REAL(XLOW)
44599C
44600CCCCC   XSTART=DBLE(AUPPGA(I))
44601CCCCC   XUP=XSTART*5.0D0
44602CCCCC   XLOW=DBLE(GAMMA)
44603CCCCC   CALL DFZER2(WEIFU5,XLOW,XUP,XSTART,RE,AE,IFLAG,DTEMP)
44604CCCCC   AUPPG2(I)=REAL(XLOW)
44605C
44606CCCCC   XSTART=DBLE(ALOWSC(I))
44607CCCCC   XLOW=XSTART/5.0D0
44608CCCCC   XUP=DBLE(SCALE)
44609CCCCC   CALL DFZER2(WEIFU6,XLOW,XUP,XSTART,RE,AE,IFLAG,DTEMP)
44610CCCCC   ALOWS2(I)=REAL(XLOW)
44611C
44612CCCCC   XSTART=DBLE(AUPPSC(I))
44613CCCCC   XUP=XSTART*5.0D0
44614CCCCC   XLOW=DBLE(SCALE)
44615CCCCC   CALL DFZER2(WEIFU6,XLOW,XUP,XSTART,RE,AE,IFLAG,DTEMP)
44616CCCCC   AUPPS2(I)=REAL(XLOW)
44617C3340 CONTINUE
44618C
44619C     CONFIDENCE INTERVALS FOR SELECTED PERCENTILES.
44620C
44621C     1. STANDARD ERROR USES TECHNIQUE DEMONSTRATED IN EXAMPLE 17.4
44622C        (P. 344) OF BURY.  THIS IS BASED ON PROPOGATION OF ERROR.
44623C
44624C     2. CONFIDENCE INTERVAL IS THEN GENERATED USING NORMAL
44625C        APPROXIMATION (EXAMPLE 17.7 OF BURY).  BURY ALSO DEMONSTRATES
44626C        A LIKELIHOOD RATIO APPROACH, BUT OMIT THIS FOR NOW.
44627C
44628      IF(NPERC.GE.1)THEN
44629C
44630        ALPHL=ALPHAP/2.0
44631        ALPHU=1.0 - ALPHAP/2.0
44632        CALL NORPPF(ALPHU,Z95)
44633        MINMAX=1
44634C
44635        IF(IWEIBC.EQ.'ON')THEN
44636          G=SHAPBC
44637          GSE=SHABSE
44638          COVZ=COVBSE
44639        ELSE
44640          G=SHAPML
44641          GSE=SHAPSE
44642          COVZ=COVSE
44643        ENDIF
44644C
44645        WRITE(IOUNI1,3431)
44646        WRITE(IOUNI1,3432)
44647        DO3429I=1,NPERC
44648          QPTEMP=QP(I)/100.0
44649          CALL WEIPPF(QPTEMP,G,MINMAX,APPF)
44650          XQPHAT(I)=SCALML*APPF
44651C
44652          C=LOG(1.0/(1.0 - QPTEMP))
44653          DA=C**(1.0/G)
44654          DB=-(SCALML*C**(1.0/G)*LOG(C)/(G**2))
44655          TERM1=(DA*SCALSE)**2
44656          TERM2=(DB*GSE)**2
44657          TERM3=2.0*DA*DB*COVZ*COVZ
44658          SEXQP=SQRT(TERM1 + TERM2 + TERM3)
44659          XQPSE(I)=SEXQP
44660          XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
44661          XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
44662          WRITE(IOUNI1,'(5E15.7)')
44663     1         QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
44664 3429   CONTINUE
44665 3431   FORMAT(15X,'       POINT     ','     LOWER     ',
44666     1         '     UPPER')
44667 3432   FORMAT('    PERCENTILE ','     ESTIMATE   ',
44668     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
44669      ENDIF
44670C
44671 3499 CONTINUE
44672C
44673      IF(IFLAGL.EQ.1)THEN
44674        AFACT=AL**(1.0/GAMMA)
44675        DO2370I=1,NUMALP
44676          ALP=ALPHA(I)
44677          P=1.0-(ALP/2.0)
44678          CALL NORPPF(P,PPF)
44679          ALOWSC(I)=SCALET - PPF*SCALSE
44680          AUPPSC(I)=SCALET + PPF*SCALSE
44681CCCCC     ALOWS2(I)=AFACT*ALOWS2(I)
44682CCCCC     AUPPS2(I)=AFACT*AUPPS2(I)
44683 2370   CONTINUE
44684      ENDIF
44685C
44686C               *************************************
44687C               **   STEP 42--                     **
44688C               **   WRITE OUT EVERYTHING          **
44689C               **   FOR WEIBULL MLE ESTIMATE      **
44690C               *************************************
44691C
44692      ISTEPN='42'
44693      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW2')
44694     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
44695C
44696C     PRINT SUMMARY STATISTICS TABLE
44697C
44698      IF(IPRINT.EQ.'OFF')GOTO9000
44699C
44700      NUMDIG=7
44701      IF(IFORSW.EQ.'1')NUMDIG=1
44702      IF(IFORSW.EQ.'2')NUMDIG=2
44703      IF(IFORSW.EQ.'3')NUMDIG=3
44704      IF(IFORSW.EQ.'4')NUMDIG=4
44705      IF(IFORSW.EQ.'5')NUMDIG=5
44706      IF(IFORSW.EQ.'6')NUMDIG=6
44707      IF(IFORSW.EQ.'7')NUMDIG=7
44708      IF(IFORSW.EQ.'8')NUMDIG=8
44709      IF(IFORSW.EQ.'9')NUMDIG=9
44710      IF(IFORSW.EQ.'0')NUMDIG=0
44711      IF(IFORSW.EQ.'E')NUMDIG=-2
44712      IF(IFORSW.EQ.'-2')NUMDIG=-2
44713      IF(IFORSW.EQ.'-3')NUMDIG=-3
44714      IF(IFORSW.EQ.'-4')NUMDIG=-4
44715      IF(IFORSW.EQ.'-5')NUMDIG=-5
44716      IF(IFORSW.EQ.'-6')NUMDIG=-6
44717      IF(IFORSW.EQ.'-7')NUMDIG=-7
44718      IF(IFORSW.EQ.'-8')NUMDIG=-8
44719      IF(IFORSW.EQ.'-9')NUMDIG=-9
44720C
44721      IF(IWEIFL.EQ.'IWEI')THEN
44722        ITITLE='Two-Parameter Inverted Weibull Parameter Estimation:'
44723        NCTITL=52
44724        ITITLZ='Multiply Censored Case'
44725        NCTITZ=22
44726      ELSEIF(ICASE.EQ.'MINIMUM')THEN
44727        ITITLE='Two-Parameter Weibull (Minimum) Parameter Estimation:'
44728        NCTITL=53
44729        ITITLZ='Multiply Censored Case'
44730        NCTITZ=22
44731      ELSEIF(ICASE.EQ.'MAXIMUM')THEN
44732        ITITLE='Two-Parameter Weibull (Maximum) Parameter Estimation:'
44733        NCTITL=53
44734        ITITLZ='Multiply Censored Case'
44735        NCTITZ=22
44736      ELSE
44737        ITITLE='Two-Parameter Weibull (Minimum) Parameter Estimation:'
44738        NCTITL=53
44739        ITITLZ='Multiply Censored Case'
44740        NCTITZ=22
44741      ENDIF
44742      ICNT=1
44743      ITEXT(ICNT)='Summary Statistics:'
44744      NCTEXT(ICNT)=19
44745      AVALUE(ICNT)=0.0
44746      IDIGIT(ICNT)=-99
44747      ICNT=ICNT+1
44748      ITEXT(ICNT)='Total Number of Observations:'
44749      NCTEXT(ICNT)=29
44750      AVALUE(ICNT)=REAL(N)
44751      IDIGIT(ICNT)=0
44752      ICNT=ICNT+1
44753      ITEXT(ICNT)='Number of Uncensored Observations:'
44754      NCTEXT(ICNT)=34
44755      AVALUE(ICNT)=REAL(IR)
44756      IDIGIT(ICNT)=0
44757      ICNT=ICNT+1
44758      ITEXT(ICNT)='Number of Censored Observations:'
44759      NCTEXT(ICNT)=32
44760      AVALUE(ICNT)=REAL(IM)
44761      IDIGIT(ICNT)=0
44762      ICNT=ICNT+1
44763      ITEXT(ICNT)='Sample Mean:'
44764      NCTEXT(ICNT)=12
44765      AVALUE(ICNT)=XMEAN
44766      IDIGIT(ICNT)=NUMDIG
44767      ICNT=ICNT+1
44768      ITEXT(ICNT)='Sample Standard Deviation:'
44769      NCTEXT(ICNT)=26
44770      AVALUE(ICNT)=XSD
44771      IDIGIT(ICNT)=NUMDIG
44772      ICNT=ICNT+1
44773      ITEXT(ICNT)='Sample Minimum:'
44774      NCTEXT(ICNT)=15
44775      AVALUE(ICNT)=XMIN
44776      IDIGIT(ICNT)=NUMDIG
44777      ICNT=ICNT+1
44778      ITEXT(ICNT)='Sample Maximum:'
44779      NCTEXT(ICNT)=15
44780      AVALUE(ICNT)=XMAX
44781      IDIGIT(ICNT)=NUMDIG
44782C
44783      IF(IFLAGL.EQ.1)THEN
44784        ICNT=ICNT+1
44785        ITEXT(ICNT)='Gauge Length:'
44786        NCTEXT(ICNT)=13
44787        AVALUE(ICNT)=AL
44788        IDIGIT(ICNT)=NUMDIG
44789      ENDIF
44790C
44791      NUMROW=ICNT
44792      DO2310I=1,NUMROW
44793        NTOT(I)=15
44794 2310 CONTINUE
44795      NTOT(2)=8
44796C
44797      IFRST=.TRUE.
44798      ILAST=.FALSE.
44799      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
44800     1            NCTEXT,AVALUE,IDIGIT,
44801     1            NTOT,NUMROW,
44802     1            ICAPSW,ICAPTY,ILAST,IFRST,
44803     1            ISUBRO,IBUGA3,IERROR)
44804      IFRST=.FALSE.
44805      ITITLE=' '
44806      NCTITL=0
44807C
44808      ITEXT(1)='Maximum Likelihood:'
44809      NCTEXT(1)=19
44810      AVALUE(1)=0.0
44811      IDIGIT(1)=-99
44812      ITEXT(2)='Estimate of Shape (Gamma):'
44813      NCTEXT(2)=26
44814      AVALUE(2)=SHAPML
44815      IDIGIT(2)=NUMDIG
44816      ITEXT(3)='Standard Error of Shape:'
44817      NCTEXT(3)=24
44818      AVALUE(3)=SHAPSE
44819      IDIGIT(3)=NUMDIG
44820      ICNT=3
44821      ITEXT(4)='Estimate of Scale:'
44822      NCTEXT(4)=18
44823      AVALUE(4)=SCALET
44824      IDIGIT(4)=NUMDIG
44825      ITEXT(5)='Standard Error of Scale:'
44826      NCTEXT(5)=24
44827      AVALUE(5)=SCALSE
44828      IDIGIT(5)=NUMDIG
44829      ITEXT(6)='Shape/Scale Covariance:'
44830      NCTEXT(6)=23
44831      AVALUE(6)=COVSE
44832      IDIGIT(6)=NUMDIG
44833C
44834      NUMROW=6
44835C
44836      IFRST=.FALSE.
44837      ILAST=.FALSE.
44838      ITITLZ=' '
44839      NCTITZ=0
44840      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
44841     1            AVALUE,IDIGIT,
44842     1            NTOT,NUMROW,
44843     1            ICAPSW,ICAPTY,ILAST,IFRST,
44844     1            ISUBRO,IBUGA3,IERROR)
44845C
44846C
44847CCCCC ICNT=ICNT+1
44848CCCCC ITEXT(ICNT)='Log-likelihood:'
44849CCCCC NCTEXT(ICNT)=15
44850CCCCC AVALUE(ICNT)=ALIK
44851CCCCC IDIGIT(ICNT)=-7
44852CCCCC ICNT=ICNT+1
44853CCCCC ITEXT(ICNT)='AIC:'
44854CCCCC NCTEXT(ICNT)=4
44855CCCCC AVALUE(ICNT)=AIC
44856CCCCC IDIGIT(ICNT)=-7
44857CCCCC ICNT=ICNT+1
44858CCCCC ITEXT(ICNT)='AICc:'
44859CCCCC NCTEXT(ICNT)=5
44860CCCCC AVALUE(ICNT)=AICC
44861CCCCC IDIGIT(ICNT)=-7
44862CCCCC ICNT=ICNT+1
44863CCCCC ITEXT(ICNT)='BIC:'
44864CCCCC NCTEXT(ICNT)=4
44865CCCCC AVALUE(ICNT)=BIC
44866CCCCC IDIGIT(ICNT)=-7
44867C
44868CCCCC ICNT=ICNT+1
44869CCCCC ITEXT(ICNT)=' '
44870CCCCC NCTEXT(ICNT)=0
44871CCCCC AVALUE(ICNT)=0.0
44872CCCCC IDIGIT(ICNT)=0
44873CCCCC ICNT=ICNT+1
44874      ICNT=1
44875      ITEXT(ICNT)='Maximum Likelihood (Bias Corrected):'
44876      NCTEXT(ICNT)=36
44877      AVALUE(ICNT)=0.0
44878      IDIGIT(ICNT)=0
44879      ICNT=ICNT+1
44880      ITEXT(ICNT)='Estimate of Shape (Gamma):'
44881      NCTEXT(ICNT)=26
44882      AVALUE(ICNT)=SHAPBC
44883      IDIGIT(ICNT)=NUMDIG
44884      ICNT=ICNT+1
44885      ITEXT(ICNT)='Standard Error of Shape:'
44886      NCTEXT(ICNT)=24
44887      AVALUE(ICNT)=SHABSE
44888      IDIGIT(ICNT)=NUMDIG
44889      ICNT=ICNT+1
44890      ITEXT(ICNT)='Estimate of Scale:'
44891      NCTEXT(ICNT)=18
44892      AVALUE(ICNT)=SCALE
44893      IDIGIT(ICNT)=NUMDIG
44894      ICNT=ICNT+1
44895      ITEXT(ICNT)='Standard Error of Scale:'
44896      NCTEXT(ICNT)=24
44897      AVALUE(ICNT)=SCALSE
44898      IDIGIT(ICNT)=NUMDIG
44899      ICNT=ICNT+1
44900      ITEXT(ICNT)='Shape/Scale Covariance:'
44901      NCTEXT(ICNT)=23
44902      AVALUE(ICNT)=COVBSE
44903      IDIGIT(ICNT)=NUMDIG
44904C
44905      NUMROW=ICNT
44906      DO2320I=1,NUMROW
44907        NTOT(I)=15
44908 2320 CONTINUE
44909C
44910      IFRST=.FALSE.
44911      ILAST=.FALSE.
44912      ITITLZ=' '
44913      NCTITZ=0
44914      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
44915     1            AVALUE,IDIGIT,
44916     1            NTOT,NUMROW,
44917     1            ICAPSW,ICAPTY,ILAST,IFRST,
44918     1            ISUBRO,IBUGA3,IERROR)
44919C
44920      IF(IWEIFL.EQ.'WEIB')THEN
44921        ILIKFL='OFF'
44922        CALL DPDTA8(ALOWSC,AUPPSC,ALOWS2,AUPPS2,
44923     1              ALOWGA,AUPPGA,ALOWG2,AUPPG2,ALPHA,NUMALP,
44924     1              ICAPSW,ICAPTY,NUMDIG,ILIKFL,
44925     1              ISUBRO,IBUGA3,IERROR)
44926      ENDIF
44927C
44928      IF(NPERC.GT.1)THEN
44929        ILIKFL='OFF'
44930        CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
44931     1              ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
44932     1              ISUBRO,IBUGA3,IERROR)
44933
44934      ENDIF
44935C
44936      IF(IFEEDB.EQ.'ON')THEN
44937        WRITE(ICOUT,4291)
44938 4291   FORMAT('THE FOLLOWING INTERNAL PARAMETERS ARE SAVED:')
44939        CALL DPWRST('XXX','BUG ')
44940        WRITE(ICOUT,4293)
44941 4293   FORMAT('      ALPHAML, ALPHASE, GAMMAML, GAMMASE, ',
44942     1         'CAMMABC, GAMMABCSE,COVSE,COVBCSE')
44943        CALL DPWRST('XXX','BUG ')
44944C
44945        WRITE(ICOUT,999)
44946        CALL DPWRST('XXX','BUG ')
44947        IF(NPERC.GT.0)THEN
44948          WRITE(ICOUT,4943)
44949 4943     FORMAT('PERCENTILE CONFIDENCE LIMITS  WRITTEN TO ',
44950     1           'FILE  dpst1f.dat')
44951          CALL DPWRST('XXX','BUG ')
44952          WRITE(ICOUT,999)
44953          CALL DPWRST('XXX','BUG ')
44954        ENDIF
44955      ENDIF
44956C
44957C               *****************
44958C               **  STEP 90--  **
44959C               **  EXIT       **
44960C               *****************
44961C
44962 9000 CONTINUE
44963      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW2')THEN
44964        WRITE(ICOUT,999)
44965        CALL DPWRST('XXX','WRIT')
44966        WRITE(ICOUT,9011)
44967 9011   FORMAT('***** AT THE END       OF DPMLW2--')
44968        CALL DPWRST('XXX','WRIT')
44969        WRITE(ICOUT,9012)N,IBUGA3,IERROR
44970 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
44971        CALL DPWRST('XXX','WRIT')
44972        WRITE(ICOUT,9015)N
44973 9015   FORMAT('N = ',I8)
44974        CALL DPWRST('XXX','WRIT')
44975      ENDIF
44976C
44977      RETURN
44978      END
44979      SUBROUTINE DPMLW3(Y,TAG,N,
44980     1                  XTEMP,TEMP2,TEMP3,TEMP4,TEMP5,
44981     1                  DTEMP,ITEMP,MAXNXT,
44982     1                  ALOCML,SCALML,SHAPML,ALOCS4,SCALS4,SHAPS4,
44983     1                  ALOCMO,SCALMO,SHAPMO,ALOCS3,SCALS3,SHAPS3,
44984     1                  ALOCM2,SCALM2,SHAPM2,ALOCS5,SCALS5,SHAPS5,
44985     1                  ALOCPE,SCALPE,SHAPPE,ALOCS1,SCALS1,SHAPS1,
44986     1                  ALOCWB,SCALWB,SHAPWB,ALOCS2,SCALS2,SHAPS2,
44987     1                  ALOCLM,SCALLM,SHAPLM,ALOCS6,SCALS6,SHAPS6,
44988     1                  ALOCEP,SCALEP,SHAPEP,ALOCS7,SCALS7,SHAPS7,
44989     1                  AICML,AICCML,BICML,ALIKML,
44990     1                  AICMO,AICCMO,BICMO,ALIKMO,
44991     1                  AICM2,AICCM2,BICM2,ALIKM2,
44992     1                  AICPE,AICCPE,BICPE,ALIKPE,
44993     1                  AICWB,AICCWB,BICWB,ALIKWB,
44994     1                  AICLM,AICCLM,BICLM,ALIKLM,
44995     1                  AICEP,AICCEP,BICEP,ALIKEP,
44996     1                  NUMV,MINMAX,IWEIFL,AL,
44997     1                  ICAPSW,ICAPTY,IFORSW,ISEED,
44998     1                  QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
44999     1                  IOUNI1,IOUNI2,ALPHAP,
45000     1                  ISUBRO,IBUGA3,IERROR)
45001C
45002C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
45003C              FOR THE 3-PARAMETER WEIBULL DISTRIBUTION FOR THE FULL
45004C              SAMPLE CASE.
45005C     EXAMPLE--3-PARAMETER WEIBULL MAXIMUM LIKELIHOOD Y
45006C     REFERENCE--COHEN AND WHITTEN, "PARAMETER ESTIMATION IN RELIABILITY
45007C                AND LIFE SPAN MODELS", MARCEL DEKKER, INC.
45008C              --RINNE (2009), "THE WEIBULL DISTRIBUTION: A HANDBOOK",
45009C                CRC PRESS.
45010C     WRITTEN BY--ALAN HECKERT
45011C                 STATISTICAL ENGINEERING DIVISION
45012C                 INFORMATION TECHNOLOGY LABORATORY
45013C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
45014C                 GAITHERSBURG, MD 20899-8980
45015C                 PHONE--301-975-2899
45016C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
45017C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
45018C     LANGUAGE--ANSI FORTRAN (1977)
45019C     VERSION NUMBER--2010/4
45020C     ORIGINAL VERSION--APRIL     2010.
45021C     UPDATED         --MARCH     2013. SUPPORT FOR GAUGE LENGTH
45022C                                       PARAMETER (AL)
45023C     UPDATED         --MARCH     2014. SUPPORT FOR "PROFILE LIKELIHOOD"
45024C                                       ESTIMATION
45025C     UPDATED         --MARCH     2014. SUPPORT FOR PERCENTILE
45026C                                       CONFIDENCE LIMITS
45027C     UPDATED         --SEPTEMBER 2014. SUPPORT FOR L-MOMENTS AND
45028C                                       ELEMENTAL PERCENTILE METHODS
45029C                                       (THESE CAN BE USEFUL FOR CASES
45030C                                       WHERE ML IS PROBLEMATIC, E.G.,
45031C                                       SHAPE < 2)
45032C
45033C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
45034C
45035      CHARACTER*4 ICAPSW
45036      CHARACTER*4 ICAPTY
45037      CHARACTER*4 IFORSW
45038      CHARACTER*4 IWEIFL
45039      CHARACTER*4 ISUBRO
45040      CHARACTER*4 IBUGA3
45041      CHARACTER*4 IERROR
45042C
45043      CHARACTER*4 ISUBN1
45044      CHARACTER*4 ISUBN2
45045      CHARACTER*4 ISTEPN
45046      CHARACTER*4 ILIKFL
45047      CHARACTER*4 ICASPL
45048      CHARACTER*4 IOPFLG
45049      CHARACTER*7 ICASE
45050      CHARACTER*40 IDIST
45051C
45052CCCCC DOUBLE PRECISION DA
45053CCCCC DOUBLE PRECISION DB
45054CCCCC DOUBLE PRECISION DC
45055CCCCC DOUBLE PRECISION DD
45056CCCCC DOUBLE PRECISION DF
45057      DOUBLE PRECISION DG
45058CCCCC DOUBLE PRECISION DH
45059      DOUBLE PRECISION DS
45060      DOUBLE PRECISION D4
45061      DOUBLE PRECISION DNUM
45062      DOUBLE PRECISION DENOM
45063      DOUBLE PRECISION DVAR
45064      DOUBLE PRECISION DTERM1
45065      DOUBLE PRECISION D(3)
45066      DOUBLE PRECISION Z95
45067C
45068C---------------------------------------------------------------------
45069C
45070      PARAMETER (NUMALP=8)
45071      DIMENSION ALPHA(NUMALP)
45072      DIMENSION ALOWLO(NUMALP)
45073      DIMENSION AUPPLO(NUMALP)
45074      DIMENSION ALOWSC(NUMALP)
45075      DIMENSION AUPPSC(NUMALP)
45076      DIMENSION ALOWGA(NUMALP)
45077      DIMENSION AUPPGA(NUMALP)
45078C
45079      DIMENSION Y(*)
45080      DIMENSION TAG(*)
45081      DIMENSION XTEMP(*)
45082      DIMENSION TEMP2(*)
45083      DIMENSION TEMP3(*)
45084      DIMENSION TEMP4(*)
45085      DIMENSION TEMP5(*)
45086      DIMENSION QP(*)
45087      DIMENSION XQPHAT(*)
45088      DIMENSION XQPSE(*)
45089      DIMENSION XQPLCL(*)
45090      DIMENSION XQPUCL(*)
45091      INTEGER   ITEMP(*)
45092      DOUBLE PRECISION DTEMP(*)
45093C
45094      INCLUDE 'DPCOST.INC'
45095C
45096      DIMENSION COV(3,3)
45097C
45098      PARAMETER (MAXROW=100)
45099      CHARACTER*60 ITITLE
45100      CHARACTER*60 ITITLZ
45101      CHARACTER*40 ITEXT(MAXROW)
45102      REAL         AVALUE(MAXROW)
45103      INTEGER      NCTEXT(MAXROW)
45104      INTEGER      IDIGIT(MAXROW)
45105      INTEGER      NTOT(MAXROW)
45106      LOGICAL IFRST
45107      LOGICAL ILAST
45108C
45109C---------------------------------------------------------------------
45110C
45111      INCLUDE 'DPCOP2.INC'
45112C
45113      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.025, 0.01, 0.005, 0.001/
45114C
45115C-----START POINT-----------------------------------------------------
45116C
45117      ISUBN1='DPML'
45118      ISUBN2='W3  '
45119C
45120      ALOCML=CPUMIN
45121      SCALML=CPUMIN
45122      SHAPML=CPUMIN
45123      ALOCS4=CPUMIN
45124      SCALS4=CPUMIN
45125      SHAPS4=CPUMIN
45126      ALIKML=CPUMIN
45127      AICML=CPUMIN
45128      AICCML=CPUMIN
45129      BICML=CPUMIN
45130C
45131      ALOCMO=CPUMIN
45132      SCALMO=CPUMIN
45133      SHAPMO=CPUMIN
45134      ALOCS3=CPUMIN
45135      SCALS3=CPUMIN
45136      SHAPS3=CPUMIN
45137      ALIKMO=CPUMIN
45138      AICMO=CPUMIN
45139      AICCMO=CPUMIN
45140      BICMO=CPUMIN
45141C
45142      ALOCM2=CPUMIN
45143      SCALM2=CPUMIN
45144      SHAPM2=CPUMIN
45145      ALOCS5=CPUMIN
45146      SCALS5=CPUMIN
45147      SHAPS5=CPUMIN
45148      ALIKM2=CPUMIN
45149      AICM2=CPUMIN
45150      AICCM2=CPUMIN
45151      BICM2=CPUMIN
45152C
45153      ALOCPE=CPUMIN
45154      SCALPE=CPUMIN
45155      SHAPPE=CPUMIN
45156      ALOCS1=CPUMIN
45157      SCALS1=CPUMIN
45158      SHAPS1=CPUMIN
45159      ALIKPE=CPUMIN
45160      AICPE=CPUMIN
45161      AICCPE=CPUMIN
45162      BICPE=CPUMIN
45163C
45164      ALOCWB=CPUMIN
45165      SCALWB=CPUMIN
45166      SHAPWB=CPUMIN
45167      ALOCS2=CPUMIN
45168      SCALS2=CPUMIN
45169      SHAPS2=CPUMIN
45170      ALIKWB=CPUMIN
45171      AICWB=CPUMIN
45172      AICCWB=CPUMIN
45173      BICWB=CPUMIN
45174C
45175      ALOCLM=CPUMIN
45176      SCALLM=CPUMIN
45177      SHAPLM=CPUMIN
45178      ALOCS6=CPUMIN
45179      SCALS6=CPUMIN
45180      SHAPS6=CPUMIN
45181      ALIKLM=CPUMIN
45182      AICWLM=CPUMIN
45183      AICCLM=CPUMIN
45184      BICLM=CPUMIN
45185C
45186      ALOCEP=CPUMIN
45187      SCALEP=CPUMIN
45188      SHAPEP=CPUMIN
45189      ALOCS7=CPUMIN
45190      SCALS7=CPUMIN
45191      SHAPS7=CPUMIN
45192      ALIKEP=CPUMIN
45193      AICWEP=CPUMIN
45194      AICCEP=CPUMIN
45195      BICEP=CPUMIN
45196C
45197      IF(IWEIFL.EQ.'IWEI')THEN
45198        IDIST='INVERTED WEIBULL'
45199        ICASE='MINIMUM'
45200      ELSE
45201        IDIST='WEIBULL'
45202        ICASE='MINIMUM'
45203        IF(MINMAX.EQ.2)ICASE='MAXIMUM'
45204      ENDIF
45205C
45206      IERROR='NO'
45207C
45208      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW3')THEN
45209        WRITE(ICOUT,999)
45210  999   FORMAT(1X)
45211        CALL DPWRST('XXX','WRIT')
45212        WRITE(ICOUT,51)
45213   51   FORMAT('**** AT THE BEGINNING OF DPMLW3--')
45214        CALL DPWRST('XXX','WRIT')
45215        WRITE(ICOUT,52)IBUGA3,ISUBRO,IOUNI2
45216   52   FORMAT('IBUGA3,ISUBRO,IOUNI2 = ',2(A4,2X),I8)
45217        CALL DPWRST('XXX','WRIT')
45218        WRITE(ICOUT,55)N,NUMV,NPERC,MINMAX,AL
45219   55   FORMAT('N,NUMV,NPERC,MINMAX,AL = ',4I8,G15.7)
45220        CALL DPWRST('XXX','WRIT')
45221        DO56I=1,MIN(N,100)
45222          WRITE(ICOUT,57)I,Y(I)
45223   57     FORMAT('I,Y(I) = ',I8,2G15.7)
45224          CALL DPWRST('XXX','WRIT')
45225   56   CONTINUE
45226        WRITE(ICOUT,59)IWEIFL,ICASE,IDIST(1:16)
45227   59   FORMAT('IWEIFL,ICASE,IDIST = ',A4,2X,A7,2X,A16)
45228        CALL DPWRST('XXX','WRIT')
45229      ENDIF
45230C
45231C               ********************************************
45232C               **  STEP 11--                             **
45233C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
45234C               ********************************************
45235C
45236      ISTEPN='11'
45237      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW3')
45238     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
45239C
45240C     STEP 1: OBTAIN POINT ESTIMATES AND STANDARD ERRORS
45241C
45242      CALL WEIML3(Y,N,IWEIFL,IWEIML,IWEIMM,IWEIMO,IWEIEP,IWEILM,
45243     1            MINMAX,MAXNXT,ISEED,
45244     1            XTEMP,TEMP2,TEMP3,TEMP4,TEMP5,DTEMP,
45245     1            XMEAN,XSD,XVAR,XMIN,XMAX,XSKEW,
45246     1            ZMEAN,ZSD,
45247     1            ALOCPE,SCALPE,SHAPPE,
45248     1            ALOCWB,SCALWB,SHAPWB,
45249     1            ALOCMO,SCALMO,SHAPMO,
45250     1            ALOCM2,SCALM2,SHAPM2,
45251     1            ALOCML,SCALML,SHAPML,
45252     1            ALOCLM,SCALLM,SHAPLM,
45253     1            ALOCEP,SCALEP,SHAPEP,
45254     1            ISUBRO,IBUGA3,IERROR)
45255C
45256C     2014/03: FOR MAXIMUM LIKELIHOOD, CHECK IF BIAS CORRECTION
45257C              REQUESTED (SHAPE(BC) = 1 + SHAPE/N**1.13)
45258C
45259      SHAPSV=SHAPML
45260      IF(IWEIBC.EQ.'ON')THEN
45261        SHAPSV=SHAPML
45262        BN=1.0 + SHAPML/N**1.13
45263        SHAPML=SHAPML/BN
45264      ENDIF
45265C
45266C     2014/03: USER MAY REQUEST THE LAWLESS "PROFILE LIKELIHOOD" METHOD
45267C              TO OBTAIN THE MAXIMUM LIKELIHOOD ESTIMATES
45268C
45269C              THE PROFILE LIKELIHOOD METHOD HAS THE ADVANTAGE THAT IT
45270C              SHOULD ALWAYS CONVERGE (IT UTILIZES 2-PARAMETER WEIBULL
45271C              ML) AND THAT YOU CAN CONSTRAIN THE LOCATION PARAMETER TO
45272C              BE BETWEEN ZERO AND THE DATA MINIMUM.
45273C
45274C              IF MAXIMUM LIKELIHOOD FAILS TO CONVERGE, AUTOMATICALLY
45275C              USE PROFILE LIKELIHOOD METHOD.
45276C
45277C              FOR NOW, SKIP PROFILE METHOD FOR "MAXIMIM" CASE (NEED TO
45278C              THINK THROUGH THIS CASE A BIT MORE).
45279C
45280      IFLAGF=0
45281      IF(I3WEME.EQ.'PROF' .OR. SHAPML.LE.0.0 .AND. MINMAX.EQ.1)THEN
45282        IOPFLG='ON'
45283        CALL WEIML8(Y,N,ICASPL,IWEIBC,IWEIFL,MINMAX,MAXNXT,P3WEMI,
45284     1              IOPFLG,
45285     1              XTEMP,DTEMP,TAG,
45286     1              ALOCML,SCALML,SHAPML,
45287     1              ISUBRO,IBUGA3,IERROR)
45288        SHAPSV=SHAPML
45289        IF(IWEIBC.EQ.'ON')THEN
45290          SHAPSV=SHAPML
45291          BN=1.0 + SHAPML/N**1.13
45292          SHAPML=SHAPML/BN
45293        ENDIF
45294        IFLAGF=1
45295      ENDIF
45296C
45297C     NOTE 3/2013: ADJUST THE SCALE PARAMETERS IF GAUGE LENGTH
45298C                  PARAMETER USED.
45299C
45300      SCALPT=SCALPE
45301      SCALWT=SCALWB
45302      SCLMOT=SCALMO
45303      SCLMLT=SCALML
45304      SCLM2T=SCALM2
45305      SCLLMT=SCALLM
45306      SCLEPT=SCALEP
45307      IFLAGL=0
45308      IF(IWEIGL.EQ.'ON' .AND. AL.GT.0.0 .AND.
45309     1   IWEIFL.EQ.'WEIB')THEN
45310        SCALPT=AL**(1.0/SHAPPE)*SCALPE
45311        SCALWT=AL**(1.0/SHAPWB)*SCALWB
45312        IF(IWEIML.EQ.'YES')SCLMLT=AL**(1.0/SHAPML)*SCALML
45313        IF(IWEIMM.EQ.'YES')SCLMOT=AL**(1.0/SHAPMO)*SCALMO
45314        IF(IWEIMO.EQ.'YES')SCLM2T=AL**(1.0/SHAPM2)*SCALM2
45315        IF(IWEIEP.EQ.'YES')SCLEPT=AL**(1.0/SHAPEP)*SCALEP
45316        SCLLMT=AL**(1.0/SHAPLM)*SCALLM
45317        IFLAGL=1
45318      ENDIF
45319C
45320C     THIS IS NOW DONE IN WEIML3
45321C
45322CCCCC IF(IWEIFL.EQ.'IWEI')THEN
45323CCCCC   IF(SCALPE.GT.0.0)SCALPE=1.0/SCALPE
45324CCCCC   IF(SCALWB.GT.0.0)SCALWB=1.0/SCALWB
45325CCCCC   IF(SCALMO.GT.0.0)SCALMO=1.0/SCALMO
45326CCCCC   IF(SCALM2.GT.0.0)SCALM2=1.0/SCALM2
45327CCCCC   IF(SCALML.GT.0.0)SCALML=1.0/SCALML
45328CCCCC ENDIF
45329C
45330      ICASPL='3WEI'
45331      CALL WEILI1(Y,N,ICASPL,MINMAX,ALOCPE,SCALPE,SHAPPE,
45332     1            ALIKPE,AICPE,AICCPE,BICPE,
45333     1            ISUBRO,IBUGA3,IERROR)
45334      CALL WEILI1(Y,N,ICASPL,MINMAX,ALOCWB,SCALWB,SHAPWB,
45335     1            ALIKWB,AICWB,AICCWB,BICWB,
45336     1            ISUBRO,IBUGA3,IERROR)
45337      CALL WEILI1(Y,N,ICASPL,MINMAX,ALOCLM,SCALLM,SHAPLM,
45338     1            ALIKLM,AICLM,AICCLM,BICLM,
45339     1            ISUBRO,IBUGA3,IERROR)
45340      IF(SHAPMO.GT.0.0)THEN
45341        CALL WEILI1(Y,N,ICASPL,MINMAX,ALOCMO,SCALMO,SHAPMO,
45342     1              ALIKMO,AICMO,AICCMO,BICMO,
45343     1              ISUBRO,IBUGA3,IERROR)
45344      ENDIF
45345      IF(SHAPM2.GT.0.0)THEN
45346        CALL WEILI1(Y,N,ICASPL,MINMAX,ALOCM2,SCALM2,SHAPM2,
45347     1              ALIKM2,AICM2,AICCM2,BICM2,
45348     1              ISUBRO,IBUGA3,IERROR)
45349      ENDIF
45350      IF(SHAPML.GT.0.0)THEN
45351        CALL WEILI1(Y,N,ICASPL,MINMAX,ALOCML,SCALML,SHAPML,
45352     1              ALIKML,AICML,AICCML,BICML,
45353     1              ISUBRO,IBUGA3,IERROR)
45354      ENDIF
45355      IF(SHAPEP.GT.0.0)THEN
45356        CALL WEILI1(Y,N,ICASPL,MINMAX,ALOCEP,SCALEP,SHAPEP,
45357     1              ALIKEP,AICEP,AICCEP,BICEP,
45358     1              ISUBRO,IBUGA3,IERROR)
45359      ENDIF
45360C
45361      IFLAG1=0
45362      IFLAG2=0
45363      IFLAG3=0
45364      IFLAG4=0
45365      IFLAG5=0
45366      IFLAG6=0
45367      IFLAG7=0
45368C
45369      IF(SHAPPE.GE.1.1)THEN
45370        CALL WEIML5(ALOCPE,SCALPE,SHAPPE,Y,N,COV,
45371     1              XTEMP,ITEMP,MAXNXT,
45372     1              ISUBRO,IBUGA3,IERROR)
45373        IF(COV(1,1).GE.0.0 .AND. COV(2,2).GE.0.0 .AND.
45374     1     COV(3,3).GE.0.0)THEN
45375          IFLAG1=1
45376          ALOCS1=SQRT(COV(1,1))
45377          SCALS1=SQRT(COV(2,2))
45378          SHAPS1=SQRT(COV(3,3))
45379        ENDIF
45380      ENDIF
45381C
45382      IF(SHAPWB.GE.1.1)THEN
45383        CALL WEIML5(ALOCWB,SCALWB,SHAPWB,Y,N,COV,
45384     1              XTEMP,ITEMP,MAXNXT,
45385     1              ISUBRO,IBUGA3,IERROR)
45386        IF(COV(1,1).GE.0.0 .AND. COV(2,2).GE.0.0 .AND.
45387     1     COV(3,3).GE.0.0)THEN
45388          IFLAG2=1
45389          ALOCS2=SQRT(COV(1,1))
45390          SCALS2=SQRT(COV(2,2))
45391          SHAPS2=SQRT(COV(3,3))
45392        ENDIF
45393      ENDIF
45394C
45395      IF(SHAPMO.GE.1.1)THEN
45396        CALL WEIML5(ALOCMO,SCALMO,SHAPMO,Y,N,COV,
45397     1              XTEMP,ITEMP,MAXNXT,
45398     1              ISUBRO,IBUGA3,IERROR)
45399        IF(COV(1,1).GE.0.0 .AND. COV(2,2).GE.0.0 .AND.
45400     1     COV(3,3).GE.0.0)THEN
45401          IFLAG3=1
45402          ALOCS3=SQRT(COV(1,1))
45403          SCALS3=SQRT(COV(2,2))
45404          SHAPS3=SQRT(COV(3,3))
45405        ENDIF
45406      ENDIF
45407C
45408      IF(SHAPM2.GE.1.1)THEN
45409        CALL WEIML5(ALOCM2,SCALM2,SHAPM2,Y,N,COV,
45410     1              XTEMP,ITEMP,MAXNXT,
45411     1              ISUBRO,IBUGA3,IERROR)
45412        IF(COV(1,1).GE.0.0 .AND. COV(2,2).GE.0.0 .AND.
45413     1     COV(3,3).GE.0.0)THEN
45414          IFLAG5=1
45415          ALOCS5=SQRT(COV(1,1))
45416          SCALS5=SQRT(COV(2,2))
45417          SHAPS5=SQRT(COV(3,3))
45418        ENDIF
45419      ENDIF
45420C
45421      IF(SHAPLM.GE.1.1)THEN
45422        CALL WEIML5(ALOCLM,SCALLM,SHAPLM,Y,N,COV,
45423     1              XTEMP,ITEMP,MAXNXT,
45424     1              ISUBRO,IBUGA3,IERROR)
45425        IF(COV(1,1).GE.0.0 .AND. COV(2,2).GE.0.0 .AND.
45426     1     COV(3,3).GE.0.0)THEN
45427          IFLAG6=1
45428          ALOCS6=SQRT(COV(1,1))
45429          SCALS6=SQRT(COV(2,2))
45430          SHAPS6=SQRT(COV(3,3))
45431        ENDIF
45432      ENDIF
45433C
45434      IF(SHAPEP.GE.1.1)THEN
45435        CALL WEIML5(ALOCEP,SCALEP,SHAPEP,Y,N,COV,
45436     1              XTEMP,ITEMP,MAXNXT,
45437     1              ISUBRO,IBUGA3,IERROR)
45438        IF(COV(1,1).GE.0.0 .AND. COV(2,2).GE.0.0 .AND.
45439     1     COV(3,3).GE.0.0)THEN
45440          IFLAG7=1
45441          ALOCS7=SQRT(COV(1,1))
45442          SCALS7=SQRT(COV(2,2))
45443          SHAPS7=SQRT(COV(3,3))
45444        ENDIF
45445      ENDIF
45446C
45447C     FOR ML, COMPUTE COVARIANCE MATRIX WITH UNBIASED ESTIMATE,
45448C     THEN APPLY BIAS CORRECTION TO COVARIANCE MATRIX
45449C
45450      IF(SHAPML.GE.1.01)THEN
45451CCCCC   CALL WEIML5(ALOCML,SCALML,SHAPML,Y,N,COV,
45452        CALL WEIML5(ALOCML,SCALML,SHAPSV,Y,N,COV,
45453     1              XTEMP,ITEMP,MAXNXT,
45454     1              ISUBRO,IBUGA3,IERROR)
45455        IF(COV(1,1).GE.0.0 .AND. COV(2,2).GE.0.0 .AND.
45456     1     COV(3,3).GE.0.0)THEN
45457          IFLAG4=1
45458          BN=1.0 + SHAPSV/N**1.13
45459CCCCC     COV(3,3)=COV(3,3)/BN**2
45460CCCCC     COV(3,1)=COV(3,1)/BN
45461CCCCC     COV(3,2)=COV(3,2)/BN
45462CCCCC     COV(1,3)=COV(1,3)/BN
45463CCCCC     COV(2,3)=COV(2,3)/BN
45464          ALOCS4=SQRT(COV(1,1))
45465          SCALS4=SQRT(COV(2,2))
45466          SHAPS4=SQRT(COV(3,3)/BN)
45467        ENDIF
45468      ENDIF
45469C
45470C     STEP 2: CONFIDENCE INTERVALS FOR PARAMETERS BASED ON
45471C             NORMAL APPROXIMATION.  THIS WILL ONLY BE DONE
45472C             IF SHAPE > 1.1.
45473C
45474      IF(SHAPML.GE.1.1)THEN
45475        IF(IWEIGL.EQ.'ON' .AND. AL.GT.0.0 .AND.
45476     1     IWEIFL.EQ.'WEIB')THEN
45477          DO2210I=1,NUMALP
45478            ALP=ALPHA(I)
45479            P=1.0-(ALP/2.0)
45480            CALL NORPPF(P,PPF)
45481            ALOWLO(I)=ALOCML - PPF*ALOCS4
45482            AUPPLO(I)=ALOCML + PPF*ALOCS4
45483            ALOWSC(I)=SCLMLT - PPF*SCALS4
45484            AUPPSC(I)=SCLMLT + PPF*SCALS4
45485            ALOWGA(I)=SHAPML - PPF*SHAPS4
45486            AUPPGA(I)=SHAPML + PPF*SHAPS4
45487            IF(ALOWSC(I).LT.0.0)ALOWSC(I)=0.0
45488            IF(ALOWGA(I).LT.0.0)ALOWGA(I)=0.0
45489 2210     CONTINUE
45490        ELSE
45491          DO2220I=1,NUMALP
45492            ALP=ALPHA(I)
45493            P=1.0-(ALP/2.0)
45494            CALL NORPPF(P,PPF)
45495            ALOWLO(I)=ALOCML - PPF*ALOCS4
45496            AUPPLO(I)=ALOCML + PPF*ALOCS4
45497            ALOWSC(I)=SCALML - PPF*SCALS4
45498            AUPPSC(I)=SCALML + PPF*SCALS4
45499            ALOWGA(I)=SHAPML - PPF*SHAPS4
45500            AUPPGA(I)=SHAPML + PPF*SHAPS4
45501            IF(ALOWSC(I).LT.0.0)ALOWSC(I)=0.0
45502            IF(ALOWGA(I).LT.0.0)ALOWGA(I)=0.0
45503 2220     CONTINUE
45504        ENDIF
45505      ENDIF
45506C
45507C     APPROXIMATE CONFIDENCE INTERVALS FOR SELECTED PERCENTILES BASED
45508C     ON MAXIMUM LIKELIHOOD ESTIMATES
45509C
45510C     2014/03: METHOD ON PAGE 351-353 OF BURY.
45511C
45512C     Xp(Lower) = XpHat - NORPPF(1 - ALPHA/2)*Xp(SE)
45513C     Xp(Upper) = XpHat + NORPPF(1 - ALPHA/2)*Xp(SE)
45514C
45515C     WHERE
45516C
45517C     Xp(SE) IS THE PERCENTILE STANDARD ERROR.  THIS IS COMPUTED AS:
45518C
45519C     Xp(SE) = SQRT{SUM[j=1 to 3][SUM[k=1 to 3][d(j)*d(k)*COV(j,k)]]}
45520C
45521C     WHERE
45522C
45523C     COV  = PARAMETER VARIANCE-COVARIANCE MATRIX
45524C     D1   = PARTIAL DERIVATIVE OF THE PERCENT POINT FUNCTION WITH
45525C            RESPECT TO THE LOCATION PARAMETER
45526C          = 1
45527C     D2   = PARTIAL DERIVATIVE OF THE PERCENT POINT FUNCTION WITH
45528C            RESPECT TO THE SCALE PARAMETER
45529C          = LOG((1/(1-P))**(1/SHAPE)
45530C     D3   = PARTIAL DERIVATIVE OF THE PERCENT POINT FUNCTION WITH
45531C            RESPECT TO THE SHAPE PARAMETER
45532C          = -NUM/DENOM
45533C     NUM  = SCALE*LOG(1/(1-P))**(1/SHAPE)*LOG(LOG(1/(1-P)))
45534C     P    = THE DESIRED PERCENTILE
45535C
45536C     NOTE THAT ONE-SIDED PERCENTILE INTERVALS ARE EQUIVALENT TO
45537C     ONE-SIDED TOLERANCE INTERVALS.
45538C
45539      IF(NPERC.GE.1)THEN
45540C
45541        IF(IDTYPR.EQ.'LOWE')THEN
45542          ALPHL=ALPHAP
45543          ALPHU=1.0 - ALPHAP
45544        ELSEIF(IDTYPR.EQ.'UPPE')THEN
45545          ALPHL=ALPHAP
45546          ALPHU=1.0 - ALPHAP
45547        ELSE
45548          ALPHL=ALPHAP/2.0
45549          ALPHU=1.0 - ALPHAP/2.0
45550        ENDIF
45551CCCCC   CALL NORPPF(ALPHU,Z95)
45552        CALL NODPPF(DBLE(ALPHU),Z95)
45553        MINMAX=1
45554C
45555        WRITE(IOUNI1,2431)
45556        WRITE(IOUNI1,2432)
45557C
45558        DG=DBLE(SHAPML)
45559        DS=DBLE(SCALML)
45560C
45561        DO2429I=1,NPERC
45562          QPTEMP=QP(I)/100.0
45563          CALL WEIPPF(QPTEMP,SHAPML,MINMAX,APPF)
45564          XQPHAT(I)=ALOCML + SCALML*APPF
45565C
45566          D(1)=1.0D0
45567          D4=DLOG(1.0D0/(1.0D0 - DBLE(QPTEMP)))
45568          D(2)=D4**(1.0D0/DG)
45569          DNUM=DS*D4**(1.0D0/DG)*DLOG(D4)
45570          DENOM=DG**2
45571          D(3)=-DNUM/DENOM
45572          DVAR=0.0D0
45573          DO2460J=1,3
45574            DO2470K=1,3
45575              DTERM1=D(J)*D(K)*DBLE(COV(J,K))
45576              DVAR=DVAR + DTERM1
45577 2470       CONTINUE
45578 2460     CONTINUE
45579          SEXQP=REAL(DSQRT(DVAR))
45580C
45581          XQPSE(I)=SEXQP
45582          IF(IDTYPR.EQ.'LOWE')THEN
45583            XQPLCL(I)=XQPHAT(I) - REAL(Z95)*SEXQP
45584            XQPUCL(I)=CPUMIN
45585          ELSEIF(IDTYPR.EQ.'UPPE')THEN
45586            XQPLCL(I)=CPUMIN
45587            XQPUCL(I)=XQPHAT(I) + REAL(Z95)*SEXQP
45588          ELSE
45589            XQPLCL(I)=XQPHAT(I) - REAL(Z95)*SEXQP
45590            XQPUCL(I)=XQPHAT(I) + REAL(Z95)*SEXQP
45591          ENDIF
45592          WRITE(IOUNI1,'(5E15.7)')
45593     1         QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
45594 2429   CONTINUE
45595 2431   FORMAT(15X,'       POINT     ','     LOWER     ',
45596     1         '     UPPER')
45597 2432   FORMAT('    PERCENTILE ','     ESTIMATE   ',
45598     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
45599      ENDIF
45600C
45601C               *************************************
45602C               **   STEP 42--                     **
45603C               **   WRITE OUT EVERYTHING          **
45604C               **   FOR WEIBULL MLE ESTIMATE      **
45605C               *************************************
45606C
45607      ISTEPN='42'
45608      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW3')
45609     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
45610C
45611C     PRINT SUMMARY STATISTICS TABLE
45612C
45613      IF(IPRINT.EQ.'OFF')GOTO9000
45614C
45615      NUMDIG=7
45616      IF(IFORSW.EQ.'1')NUMDIG=1
45617      IF(IFORSW.EQ.'2')NUMDIG=2
45618      IF(IFORSW.EQ.'3')NUMDIG=3
45619      IF(IFORSW.EQ.'4')NUMDIG=4
45620      IF(IFORSW.EQ.'5')NUMDIG=5
45621      IF(IFORSW.EQ.'6')NUMDIG=6
45622      IF(IFORSW.EQ.'7')NUMDIG=7
45623      IF(IFORSW.EQ.'8')NUMDIG=8
45624      IF(IFORSW.EQ.'9')NUMDIG=9
45625      IF(IFORSW.EQ.'0')NUMDIG=0
45626      IF(IFORSW.EQ.'E')NUMDIG=-2
45627      IF(IFORSW.EQ.'-2')NUMDIG=-2
45628      IF(IFORSW.EQ.'-3')NUMDIG=-3
45629      IF(IFORSW.EQ.'-4')NUMDIG=-4
45630      IF(IFORSW.EQ.'-5')NUMDIG=-5
45631      IF(IFORSW.EQ.'-6')NUMDIG=-6
45632      IF(IFORSW.EQ.'-7')NUMDIG=-7
45633      IF(IFORSW.EQ.'-8')NUMDIG=-8
45634      IF(IFORSW.EQ.'-9')NUMDIG=-9
45635C
45636      IF(IWEIFL.EQ.'IWEI')THEN
45637        ITITLE='Three-Parameter Inverted Weibull Parameter Estimation:'
45638        NCTITL=54
45639        ITITLZ='Full Sample Case'
45640        NCTITZ=16
45641      ELSEIF(ICASE.EQ.'MINIMUM')THEN
45642        ITITLE='Three-Parameter Weibull (Minimum) Parameter Estimation:'
45643        NCTITL=55
45644        ITITLZ='Full Sample Case'
45645        NCTITZ=16
45646      ELSEIF(ICASE.EQ.'MAXIMUM')THEN
45647        ITITLE='Three-Parameter Weibull (Maximum) Parameter Estimation:'
45648        NCTITL=55
45649        ITITLZ='Full Sample Case'
45650        NCTITZ=16
45651      ELSE
45652        ITITLE='Three-Parameter Weibull (Minimum) Parameter Estimation:'
45653        NCTITL=55
45654        ITITLZ='Full Sample Case'
45655        NCTITZ=16
45656      ENDIF
45657      ITEXT(1)='Summary Statistics:'
45658      NCTEXT(1)=19
45659      AVALUE(1)=0.0
45660      IDIGIT(1)=-1
45661      ITEXT(2)='Number of Observations:'
45662      NCTEXT(2)=23
45663      AVALUE(2)=REAL(N)
45664      IDIGIT(2)=0
45665      ITEXT(3)='Sample Mean:'
45666      NCTEXT(3)=12
45667      AVALUE(3)=XMEAN
45668      IDIGIT(3)=NUMDIG
45669      ITEXT(4)='Sample Standard Deviation:'
45670      NCTEXT(4)=26
45671      AVALUE(4)=XSD
45672      IDIGIT(4)=NUMDIG
45673      ITEXT(5)='Sample Skewness:'
45674      NCTEXT(5)=16
45675      AVALUE(5)=XSKEW
45676      IDIGIT(5)=NUMDIG
45677      ITEXT(6)='Sample Minimum:'
45678      NCTEXT(6)=15
45679      AVALUE(6)=XMIN
45680      IDIGIT(6)=NUMDIG
45681      ITEXT(7)='Sample Maximum:'
45682      NCTEXT(7)=15
45683      AVALUE(7)=XMAX
45684      IDIGIT(7)=NUMDIG
45685      NUMROW=7
45686C
45687      IF(IFLAGL.EQ.1)THEN
45688        NUMROW=NUMROW+1
45689        ITEXT(NUMROW)='Gauge Length:'
45690        NCTEXT(NUMROW)=13
45691        AVALUE(NUMROW)=AL
45692        IDIGIT(NUMROW)=NUMDIG
45693      ENDIF
45694C
45695      DO2310I=1,NUMROW
45696        NTOT(I)=15
45697 2310 CONTINUE
45698C
45699      IFRST=.TRUE.
45700      ILAST=.FALSE.
45701      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
45702     1            NCTEXT,AVALUE,IDIGIT,
45703     1            NTOT,NUMROW,
45704     1            ICAPSW,ICAPTY,ILAST,IFRST,
45705     1            ISUBRO,IBUGA3,IERROR)
45706      IFRST=.FALSE.
45707      ITITLE=' '
45708      NCTITL=0
45709C
45710      ICNT=1
45711      ITEXT(ICNT)='Zanakis Percentile Method:'
45712      NCTEXT(ICNT)=26
45713      AVALUE(ICNT)=0.0
45714      IDIGIT(ICNT)=-1
45715      ICNT=ICNT+1
45716      ITEXT(ICNT)='Estimate of Location:'
45717      NCTEXT(ICNT)=21
45718      AVALUE(ICNT)=ALOCPE
45719      IDIGIT(ICNT)=NUMDIG
45720      ICNT=ICNT+1
45721      ITEXT(ICNT)='Estimate of Scale:'
45722      NCTEXT(ICNT)=18
45723      AVALUE(ICNT)=SCALPT
45724      IDIGIT(ICNT)=NUMDIG
45725      ICNT=ICNT+1
45726      ITEXT(ICNT)='Estimate of Shape:'
45727      NCTEXT(ICNT)=18
45728      AVALUE(ICNT)=SHAPPE
45729      IDIGIT(ICNT)=NUMDIG
45730      IF(IFLAG1.EQ.1)THEN
45731        ICNT=ICNT+1
45732        ITEXT(ICNT)='Standard Error of Location:'
45733        NCTEXT(ICNT)=27
45734        AVALUE(ICNT)=ALOCS1
45735        IDIGIT(ICNT)=NUMDIG
45736        ICNT=ICNT+1
45737        ITEXT(ICNT)='Standard Error of Scale:'
45738        NCTEXT(ICNT)=24
45739        AVALUE(ICNT)=SCALS1
45740        IDIGIT(ICNT)=NUMDIG
45741        ICNT=ICNT+1
45742        ITEXT(ICNT)='Standard Error of Shape:'
45743        NCTEXT(ICNT)=24
45744        AVALUE(ICNT)=SHAPS1
45745        IDIGIT(ICNT)=NUMDIG
45746      ENDIF
45747      ICNT=ICNT+1
45748      ITEXT(ICNT)='Value of Log-Likelihood Function:'
45749      NCTEXT(ICNT)=33
45750      AVALUE(ICNT)=ALIKPE
45751      IDIGIT(ICNT)=NUMDIG
45752      ICNT=ICNT+1
45753      ITEXT(ICNT)='AIC:'
45754      NCTEXT(ICNT)=4
45755      AVALUE(ICNT)=AICPE
45756      IDIGIT(ICNT)=NUMDIG
45757      ICNT=ICNT+1
45758      ITEXT(ICNT)='AICC:'
45759      NCTEXT(ICNT)=5
45760      AVALUE(ICNT)=AICCPE
45761      IDIGIT(ICNT)=NUMDIG
45762      ICNT=ICNT+1
45763      ITEXT(ICNT)='BIC:'
45764      NCTEXT(ICNT)=4
45765      AVALUE(ICNT)=BICPE
45766      IDIGIT(ICNT)=NUMDIG
45767      ICNT=ICNT+1
45768      ITEXT(ICNT)=' '
45769      NCTEXT(ICNT)=0
45770      AVALUE(ICNT)=0.0
45771      IDIGIT(ICNT)=-1
45772C
45773      ICNT=ICNT+1
45774      ITEXT(ICNT)='Wycoff-Bain-Englehardt Percentile Method'
45775      NCTEXT(ICNT)=40
45776      AVALUE(ICNT)=0.0
45777      IDIGIT(ICNT)=-1
45778      ICNT=ICNT+1
45779      ITEXT(ICNT)='Estimate of Location:'
45780      NCTEXT(ICNT)=21
45781      AVALUE(ICNT)=ALOCWB
45782      IDIGIT(ICNT)=NUMDIG
45783      ICNT=ICNT+1
45784      ITEXT(ICNT)='Estimate of Scale:'
45785      NCTEXT(ICNT)=18
45786      AVALUE(ICNT)=SCALWT
45787      IDIGIT(ICNT)=NUMDIG
45788      ICNT=ICNT+1
45789      ITEXT(ICNT)='Estimate of Shape:'
45790      NCTEXT(ICNT)=18
45791      AVALUE(ICNT)=SHAPWB
45792      IDIGIT(ICNT)=NUMDIG
45793      IF(IFLAG2.EQ.1)THEN
45794        ICNT=ICNT+1
45795        ITEXT(ICNT)='Standard Error of Location:'
45796        NCTEXT(ICNT)=27
45797        AVALUE(ICNT)=ALOCS2
45798        IDIGIT(ICNT)=NUMDIG
45799        ICNT=ICNT+1
45800        ITEXT(ICNT)='Standard Error of Scale:'
45801        NCTEXT(ICNT)=24
45802        AVALUE(ICNT)=SCALS2
45803        IDIGIT(ICNT)=NUMDIG
45804        ICNT=ICNT+1
45805        ITEXT(ICNT)='Standard Error of Shape:'
45806        NCTEXT(ICNT)=24
45807        AVALUE(ICNT)=SHAPS2
45808        IDIGIT(ICNT)=NUMDIG
45809      ENDIF
45810      ICNT=ICNT+1
45811      ITEXT(ICNT)='Value of Log-Likelihood Function:'
45812      NCTEXT(ICNT)=33
45813      AVALUE(ICNT)=ALIKWB
45814      IDIGIT(ICNT)=NUMDIG
45815      ICNT=ICNT+1
45816      ITEXT(ICNT)='AIC:'
45817      NCTEXT(ICNT)=4
45818      AVALUE(ICNT)=AICWB
45819      IDIGIT(ICNT)=NUMDIG
45820      ICNT=ICNT+1
45821      ITEXT(ICNT)='AICC:'
45822      NCTEXT(ICNT)=5
45823      AVALUE(ICNT)=AICCWB
45824      IDIGIT(ICNT)=NUMDIG
45825      ICNT=ICNT+1
45826      ITEXT(ICNT)='BIC:'
45827      NCTEXT(ICNT)=4
45828      AVALUE(ICNT)=BICWB
45829      IDIGIT(ICNT)=NUMDIG
45830      ICNT=ICNT+1
45831      ITEXT(ICNT)=' '
45832      NCTEXT(ICNT)=0
45833      AVALUE(ICNT)=0.0
45834      IDIGIT(ICNT)=-1
45835C
45836      IF(SHAPMO.GT.0.0)THEN
45837        ICNT=ICNT+1
45838        ITEXT(ICNT)='Modified Moments:'
45839        NCTEXT(ICNT)=17
45840        AVALUE(ICNT)=0.0
45841        IDIGIT(ICNT)=-1
45842        ICNT=ICNT+1
45843        ITEXT(ICNT)='Estimate of Location:'
45844        NCTEXT(ICNT)=21
45845        AVALUE(ICNT)=ALOCMO
45846        IDIGIT(ICNT)=NUMDIG
45847        ICNT=ICNT+1
45848        ITEXT(ICNT)='Estimate of Scale:'
45849        NCTEXT(ICNT)=18
45850        AVALUE(ICNT)=SCLMOT
45851        IDIGIT(ICNT)=NUMDIG
45852        ICNT=ICNT+1
45853        ITEXT(ICNT)='Estimate of Shape (Gamma):'
45854        NCTEXT(ICNT)=26
45855        AVALUE(ICNT)=SHAPMO
45856        IDIGIT(ICNT)=NUMDIG
45857        IF(IFLAG3.EQ.1)THEN
45858          ICNT=ICNT+1
45859          ITEXT(ICNT)='Standard Error of Location:'
45860          NCTEXT(ICNT)=27
45861          AVALUE(ICNT)=ALOCS3
45862          IDIGIT(ICNT)=NUMDIG
45863          ICNT=ICNT+1
45864          ITEXT(ICNT)='Standard Error of Scale:'
45865          NCTEXT(ICNT)=24
45866          AVALUE(ICNT)=SCALS3
45867          IDIGIT(ICNT)=NUMDIG
45868          ICNT=ICNT+1
45869          ITEXT(ICNT)='Standard Error of Shape:'
45870          NCTEXT(ICNT)=24
45871          AVALUE(ICNT)=SHAPS3
45872          IDIGIT(ICNT)=NUMDIG
45873        ENDIF
45874        ICNT=ICNT+1
45875        ITEXT(ICNT)='Value of Log-Likelihood Function:'
45876        NCTEXT(ICNT)=33
45877        AVALUE(ICNT)=ALIKMO
45878        IDIGIT(ICNT)=NUMDIG
45879        ICNT=ICNT+1
45880        ITEXT(ICNT)='AIC:'
45881        NCTEXT(ICNT)=4
45882        AVALUE(ICNT)=AICMO
45883        IDIGIT(ICNT)=NUMDIG
45884        ICNT=ICNT+1
45885        ITEXT(ICNT)='AICC:'
45886        NCTEXT(ICNT)=5
45887        AVALUE(ICNT)=AICCMO
45888        IDIGIT(ICNT)=NUMDIG
45889        ICNT=ICNT+1
45890        ITEXT(ICNT)='BIC:'
45891        NCTEXT(ICNT)=4
45892        AVALUE(ICNT)=BICMO
45893        IDIGIT(ICNT)=NUMDIG
45894        ICNT=ICNT+1
45895        ITEXT(ICNT)=' '
45896        NCTEXT(ICNT)=0
45897        AVALUE(ICNT)=0.0
45898        IDIGIT(ICNT)=-1
45899      ENDIF
45900C
45901      IF(SHAPM2.GT.0.0)THEN
45902        ICNT=ICNT+1
45903        ITEXT(ICNT)='Moments:'
45904        NCTEXT(ICNT)=8
45905        AVALUE(ICNT)=0.0
45906        IDIGIT(ICNT)=-1
45907        ICNT=ICNT+1
45908        ITEXT(ICNT)='Estimate of Location:'
45909        NCTEXT(ICNT)=21
45910        AVALUE(ICNT)=ALOCM2
45911        IDIGIT(ICNT)=NUMDIG
45912        ICNT=ICNT+1
45913        ITEXT(ICNT)='Estimate of Scale:'
45914        NCTEXT(ICNT)=18
45915        AVALUE(ICNT)=SCLM2T
45916        IDIGIT(ICNT)=NUMDIG
45917        ICNT=ICNT+1
45918        ITEXT(ICNT)='Estimate of Shape (Gamma):'
45919        NCTEXT(ICNT)=26
45920        AVALUE(ICNT)=SHAPM2
45921        IDIGIT(ICNT)=NUMDIG
45922        IF(IFLAG5.EQ.1)THEN
45923          ICNT=ICNT+1
45924          ITEXT(ICNT)='Standard Error of Location:'
45925          NCTEXT(ICNT)=27
45926          AVALUE(ICNT)=ALOCS5
45927          IDIGIT(ICNT)=NUMDIG
45928          ICNT=ICNT+1
45929          ITEXT(ICNT)='Standard Error of Scale:'
45930          NCTEXT(ICNT)=24
45931          AVALUE(ICNT)=SCALS5
45932          IDIGIT(ICNT)=NUMDIG
45933          ICNT=ICNT+1
45934          ITEXT(ICNT)='Standard Error of Shape:'
45935          NCTEXT(ICNT)=24
45936          AVALUE(ICNT)=SHAPS5
45937          IDIGIT(ICNT)=NUMDIG
45938        ENDIF
45939        ICNT=ICNT+1
45940        ITEXT(ICNT)='Value of Log-Likelihood Function:'
45941        NCTEXT(ICNT)=33
45942        AVALUE(ICNT)=ALIKM2
45943        IDIGIT(ICNT)=NUMDIG
45944        ICNT=ICNT+1
45945        ITEXT(ICNT)='AIC:'
45946        NCTEXT(ICNT)=4
45947        AVALUE(ICNT)=AICM2
45948        IDIGIT(ICNT)=NUMDIG
45949        ICNT=ICNT+1
45950        ITEXT(ICNT)='AICC:'
45951        NCTEXT(ICNT)=5
45952        AVALUE(ICNT)=AICCM2
45953        IDIGIT(ICNT)=NUMDIG
45954        ICNT=ICNT+1
45955        ITEXT(ICNT)='BIC:'
45956        NCTEXT(ICNT)=4
45957        AVALUE(ICNT)=BICM2
45958        IDIGIT(ICNT)=NUMDIG
45959        ICNT=ICNT+1
45960        ITEXT(ICNT)=' '
45961        NCTEXT(ICNT)=0
45962        AVALUE(ICNT)=0.0
45963        IDIGIT(ICNT)=-1
45964      ENDIF
45965C
45966      IF(SHAPLM.GT.0.0)THEN
45967        ICNT=ICNT+1
45968        ITEXT(ICNT)='L-Moments:'
45969        NCTEXT(ICNT)=10
45970        AVALUE(ICNT)=0.0
45971        IDIGIT(ICNT)=-1
45972        ICNT=ICNT+1
45973        ITEXT(ICNT)='Estimate of Location:'
45974        NCTEXT(ICNT)=21
45975        AVALUE(ICNT)=ALOCLM
45976        IDIGIT(ICNT)=NUMDIG
45977        ICNT=ICNT+1
45978        ITEXT(ICNT)='Estimate of Scale:'
45979        NCTEXT(ICNT)=18
45980        AVALUE(ICNT)=SCLLMT
45981        IDIGIT(ICNT)=NUMDIG
45982        ICNT=ICNT+1
45983        ITEXT(ICNT)='Estimate of Shape (Gamma):'
45984        NCTEXT(ICNT)=26
45985        AVALUE(ICNT)=SHAPLM
45986        IDIGIT(ICNT)=NUMDIG
45987        IF(IFLAG6.EQ.1)THEN
45988          ICNT=ICNT+1
45989          ITEXT(ICNT)='Standard Error of Location:'
45990          NCTEXT(ICNT)=27
45991          AVALUE(ICNT)=ALOCS6
45992          IDIGIT(ICNT)=NUMDIG
45993          ICNT=ICNT+1
45994          ITEXT(ICNT)='Standard Error of Scale:'
45995          NCTEXT(ICNT)=24
45996          AVALUE(ICNT)=SCALS6
45997          IDIGIT(ICNT)=NUMDIG
45998          ICNT=ICNT+1
45999          ITEXT(ICNT)='Standard Error of Shape:'
46000          NCTEXT(ICNT)=24
46001          AVALUE(ICNT)=SHAPS6
46002          IDIGIT(ICNT)=NUMDIG
46003        ENDIF
46004        ICNT=ICNT+1
46005        ITEXT(ICNT)='Value of Log-Likelihood Function:'
46006        NCTEXT(ICNT)=33
46007        AVALUE(ICNT)=ALIKLM
46008        IDIGIT(ICNT)=NUMDIG
46009        ICNT=ICNT+1
46010        ITEXT(ICNT)='AIC:'
46011        NCTEXT(ICNT)=4
46012        AVALUE(ICNT)=AICLM
46013        IDIGIT(ICNT)=NUMDIG
46014        ICNT=ICNT+1
46015        ITEXT(ICNT)='AICC:'
46016        NCTEXT(ICNT)=5
46017        AVALUE(ICNT)=AICCLM
46018        IDIGIT(ICNT)=NUMDIG
46019        ICNT=ICNT+1
46020        ITEXT(ICNT)='BIC:'
46021        NCTEXT(ICNT)=4
46022        AVALUE(ICNT)=BICLM
46023        IDIGIT(ICNT)=NUMDIG
46024        ICNT=ICNT+1
46025        ITEXT(ICNT)=' '
46026        NCTEXT(ICNT)=0
46027        AVALUE(ICNT)=0.0
46028        IDIGIT(ICNT)=-1
46029      ENDIF
46030C
46031      IF(SHAPEP.GT.0.0)THEN
46032        ICNT=ICNT+1
46033        ITEXT(ICNT)='Elemental Percentiles:'
46034        NCTEXT(ICNT)=22
46035        AVALUE(ICNT)=0.0
46036        IDIGIT(ICNT)=-1
46037        ICNT=ICNT+1
46038        ITEXT(ICNT)='Estimate of Location:'
46039        NCTEXT(ICNT)=21
46040        AVALUE(ICNT)=ALOCEP
46041        IDIGIT(ICNT)=NUMDIG
46042        ICNT=ICNT+1
46043        ITEXT(ICNT)='Estimate of Scale:'
46044        NCTEXT(ICNT)=18
46045        AVALUE(ICNT)=SCLEPT
46046        IDIGIT(ICNT)=NUMDIG
46047        ICNT=ICNT+1
46048        ITEXT(ICNT)='Estimate of Shape (Gamma):'
46049        NCTEXT(ICNT)=26
46050        AVALUE(ICNT)=SHAPEP
46051        IDIGIT(ICNT)=NUMDIG
46052        IF(IFLAG7.EQ.1)THEN
46053          ICNT=ICNT+1
46054          ITEXT(ICNT)='Standard Error of Location:'
46055          NCTEXT(ICNT)=27
46056          AVALUE(ICNT)=ALOCS7
46057          IDIGIT(ICNT)=NUMDIG
46058          ICNT=ICNT+1
46059          ITEXT(ICNT)='Standard Error of Scale:'
46060          NCTEXT(ICNT)=24
46061          AVALUE(ICNT)=SCALS7
46062          IDIGIT(ICNT)=NUMDIG
46063          ICNT=ICNT+1
46064          ITEXT(ICNT)='Standard Error of Shape:'
46065          NCTEXT(ICNT)=24
46066          AVALUE(ICNT)=SHAPS7
46067          IDIGIT(ICNT)=NUMDIG
46068        ENDIF
46069        ICNT=ICNT+1
46070        ITEXT(ICNT)='Value of Log-Likelihood Function:'
46071        NCTEXT(ICNT)=33
46072        AVALUE(ICNT)=ALIKEP
46073        IDIGIT(ICNT)=NUMDIG
46074        ICNT=ICNT+1
46075        ITEXT(ICNT)='AIC:'
46076        NCTEXT(ICNT)=4
46077        AVALUE(ICNT)=AICEP
46078        IDIGIT(ICNT)=NUMDIG
46079        ICNT=ICNT+1
46080        ITEXT(ICNT)='AICC:'
46081        NCTEXT(ICNT)=5
46082        AVALUE(ICNT)=AICCEP
46083        IDIGIT(ICNT)=NUMDIG
46084        ICNT=ICNT+1
46085        ITEXT(ICNT)='BIC:'
46086        NCTEXT(ICNT)=4
46087        AVALUE(ICNT)=BICEP
46088        IDIGIT(ICNT)=NUMDIG
46089        ICNT=ICNT+1
46090        ITEXT(ICNT)=' '
46091        NCTEXT(ICNT)=0
46092        AVALUE(ICNT)=0.0
46093        IDIGIT(ICNT)=-1
46094      ENDIF
46095C
46096      IF(SHAPML.GT.0.0)THEN
46097        ICNT=ICNT+1
46098        IF(IWEIBC.EQ.'ON')THEN
46099          IF(IFLAGF.EQ.0)THEN
46100            ITEXT(ICNT)='Maximum Likelihood (bias correction):'
46101            NCTEXT(ICNT)=37
46102          ELSE
46103            ITEXT(ICNT)='Profile Maximum Likelihood (bias corr.):'
46104            NCTEXT(ICNT)=40
46105          ENDIF
46106        ELSE
46107          IF(IFLAGF.EQ.0)THEN
46108            ITEXT(ICNT)='Maximum Likelihood:'
46109            NCTEXT(ICNT)=19
46110          ELSE
46111            ITEXT(ICNT)='Profile Maximum Likelihood:'
46112            NCTEXT(ICNT)=27
46113          ENDIF
46114        ENDIF
46115        AVALUE(ICNT)=0.0
46116        IDIGIT(ICNT)=-1
46117        ICNT=ICNT+1
46118        ITEXT(ICNT)='Estimate of Location:'
46119        NCTEXT(ICNT)=21
46120        AVALUE(ICNT)=ALOCML
46121        IDIGIT(ICNT)=NUMDIG
46122        ICNT=ICNT+1
46123        ITEXT(ICNT)='Estimate of Scale:'
46124        NCTEXT(ICNT)=18
46125        AVALUE(ICNT)=SCLMLT
46126        IDIGIT(ICNT)=NUMDIG
46127        ICNT=ICNT+1
46128        ITEXT(ICNT)='Estimate of Shape (Gamma):'
46129        NCTEXT(ICNT)=26
46130        AVALUE(ICNT)=SHAPML
46131        IDIGIT(ICNT)=NUMDIG
46132        IF(IFLAG4.EQ.1)THEN
46133          ICNT=ICNT+1
46134          ITEXT(ICNT)='Standard Error of Location:'
46135          NCTEXT(ICNT)=27
46136          AVALUE(ICNT)=ALOCS4
46137          IDIGIT(ICNT)=NUMDIG
46138          ICNT=ICNT+1
46139          ITEXT(ICNT)='Standard Error of Scale:'
46140          NCTEXT(ICNT)=24
46141          AVALUE(ICNT)=SCALS4
46142          IDIGIT(ICNT)=NUMDIG
46143          ICNT=ICNT+1
46144          ITEXT(ICNT)='Standard Error of Shape:'
46145          NCTEXT(ICNT)=24
46146          AVALUE(ICNT)=SHAPS4
46147          IDIGIT(ICNT)=NUMDIG
46148        ENDIF
46149        ICNT=ICNT+1
46150        ITEXT(ICNT)='Value of Log-Likelihood Function:'
46151        NCTEXT(ICNT)=33
46152        AVALUE(ICNT)=ALIKML
46153        IDIGIT(ICNT)=NUMDIG
46154        ICNT=ICNT+1
46155        ITEXT(ICNT)='AIC:'
46156        NCTEXT(ICNT)=4
46157        AVALUE(ICNT)=AICML
46158        IDIGIT(ICNT)=NUMDIG
46159        ICNT=ICNT+1
46160        ITEXT(ICNT)='AICC:'
46161        NCTEXT(ICNT)=5
46162        AVALUE(ICNT)=AICCML
46163        IDIGIT(ICNT)=NUMDIG
46164        ICNT=ICNT+1
46165        ITEXT(ICNT)='BIC:'
46166        NCTEXT(ICNT)=4
46167        AVALUE(ICNT)=BICML
46168        IDIGIT(ICNT)=NUMDIG
46169        ICNT=ICNT+1
46170        ITEXT(ICNT)=' '
46171        NCTEXT(ICNT)=0
46172        AVALUE(ICNT)=0.0
46173        IDIGIT(ICNT)=-1
46174      ENDIF
46175C
46176      NUMROW=ICNT
46177      DO2320I=1,NUMROW
46178        NTOT(I)=15
46179 2320 CONTINUE
46180C
46181      IFRST=.FALSE.
46182      ILAST=.FALSE.
46183      ITITLZ=' '
46184      NCTITZ=0
46185      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
46186     1            AVALUE,IDIGIT,
46187     1            NTOT,NUMROW,
46188     1            ICAPSW,ICAPTY,ILAST,IFRST,
46189     1            ISUBRO,IBUGA3,IERROR)
46190C
46191CCCCC ILIKFL='OFF'
46192      IF(IFLAG4.EQ.1)THEN
46193        CALL DPDTA6(COV,ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALOWGA,AUPPGA,
46194     1              ALPHA,NUMALP,
46195     1              ICAPSW,ICAPTY,NUMDIG,
46196     1              ISUBRO,IBUGA3,IERROR)
46197      ENDIF
46198C
46199      IF(NPERC.GT.1)THEN
46200        ILIKFL='OFF'
46201        CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
46202     1              ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
46203     1              ISUBRO,IBUGA3,IERROR)
46204C
46205      ENDIF
46206C
46207C               *****************
46208C               **  STEP 90--  **
46209C               **  EXIT       **
46210C               *****************
46211C
46212 9000 CONTINUE
46213C
46214      IF(IFLAGL.EQ.1)THEN
46215        SCALPE=SCALPT
46216        SCALWB=SCALWT
46217        SCALMO=SCLMOT
46218        SCALM2=SCLM2T
46219        SCALML=SCLMLT
46220      ENDIF
46221C
46222      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW3')THEN
46223        WRITE(ICOUT,999)
46224        CALL DPWRST('XXX','WRIT')
46225        WRITE(ICOUT,9011)
46226 9011   FORMAT('***** AT THE END       OF DPMLW3--')
46227        CALL DPWRST('XXX','WRIT')
46228        WRITE(ICOUT,9012)N,IBUGA3,IERROR
46229 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
46230        CALL DPWRST('XXX','WRIT')
46231      ENDIF
46232C
46233      RETURN
46234      END
46235      SUBROUTINE DPMLWA(Y,X,N,NVAR,
46236     1                  DTEMP1,TEMP1,TEMP2,TEMP3,MAXNXT,
46237     1                  AMOM,AFREQ,AML,CMOM,CFREQ,CML,
46238     1                  ICAPSW,ICAPTY,IFORSW,
46239     1                  ISUBRO,IBUGA3,IERROR)
46240C
46241C     PURPOSE--THIS ROUTINE COMPUTES THE METHOD OF MOMENTS
46242C              ESTIMATE FOR WARING DISTRIBUTION.  USE THE FORMULA
46243C                 U1 = 1/(P-1)
46244C              WHICH GIVES
46245C                 P = (1+U1)/U1
46246C              REPLACE POPULATION MEAN, U1, WITH SAMPLE ESTIMATE,
46247C              XBAR.  NOTE THAT MEAN IS UNDEFINED FOR P < 1.
46248C              LARGE VALUES OF THE MEAN INDICATE A VALUE OF P
46249C              LESS THAN 1, IN WHICH CASE ESTIMATE OF P IS NOT
46250C              VALID.
46251C     EXAMPLE--WARING MOMENTS Y
46252C     REFERENCE--"UNIVARIATE DISCRETE DISTRIBUTIONS", SECOND EDITION,
46253C                JOHNSON, KOTZ, AND KEMP, WILEY, PP. 276.
46254C     WRITTEN BY--ALAN HECKERT
46255C                 STATISTICAL ENGINEERING DIVISION
46256C                 INFORMATION TECHNOLOGY LABORATORY
46257C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
46258C                 GAITHERSBURG, MD 20899-8980
46259C                 PHONE--301-975-2899
46260C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
46261C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
46262C     LANGUAGE--ANSI FORTRAN (1977)
46263C     VERSION NUMBER--2004/4
46264C     ORIGINAL VERSION--APRIL     2004.
46265C     UPDATED         --APRIL     2011. USE DPDTA1 TO PRINT OUTPUT
46266C
46267C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
46268C
46269      CHARACTER*4 ICAPSW
46270      CHARACTER*4 ICAPTY
46271      CHARACTER*4 IFORSW
46272      CHARACTER*4 ISUBRO
46273      CHARACTER*4 IBUGA3
46274      CHARACTER*4 IERROR
46275C
46276      CHARACTER*4 IWRITE
46277      CHARACTER*4 IRELAT
46278      CHARACTER*4 IRHSTG
46279      CHARACTER*4 ISUBN1
46280      CHARACTER*4 ISUBN2
46281      CHARACTER*4 ISTEPN
46282C
46283      PARAMETER (MAXROW=30)
46284      CHARACTER*60 ITITLE
46285      CHARACTER*1  ITITLZ
46286      CHARACTER*40 IDIST
46287      CHARACTER*40 ITEXT(MAXROW)
46288      REAL         AVALUE(MAXROW)
46289      INTEGER      NCTEXT(MAXROW)
46290      INTEGER      IDIGIT(MAXROW)
46291      INTEGER      NTOT(MAXROW)
46292      LOGICAL      IFRST
46293      LOGICAL      ILAST
46294C
46295C---------------------------------------------------------------------
46296C
46297      REAL Y(*)
46298      REAL X(*)
46299      REAL TEMP1(*)
46300      REAL TEMP2(*)
46301      REAL TEMP3(*)
46302      DOUBLE PRECISION DTEMP1(*)
46303C
46304      DOUBLE PRECISION FVEC(2)
46305      DOUBLE PRECISION XPAR(2)
46306      DOUBLE PRECISION TOL
46307C
46308      EXTERNAL WARFU2
46309      COMMON/WARCOM/NTOT2
46310C
46311C---------------------------------------------------------------------
46312C
46313      INCLUDE 'DPCOP2.INC'
46314C
46315C-----START POINT-----------------------------------------------------
46316C
46317      ISUBN1='DPML'
46318      ISUBN2='WA  '
46319      IERROR='NO'
46320      IWRITE='NO'
46321C
46322      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLWA')THEN
46323        WRITE(ICOUT,999)
46324  999   FORMAT(1X)
46325        CALL DPWRST('XXX','WRIT')
46326        WRITE(ICOUT,51)
46327   51   FORMAT('**** AT THE BEGINNING OF DPMLWA--')
46328        CALL DPWRST('XXX','WRIT')
46329        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR
46330   52   FORMAT('IBUGA3,ISUBRO,N,NVAR = ',2(A4,2X),2I8)
46331        CALL DPWRST('XXX','WRIT')
46332        IF(NVAR.EQ.1)THEN
46333          DO56I=1,MIN(N,100)
46334            WRITE(ICOUT,57)I,Y(I)
46335   57       FORMAT('I,Y(I) = ',I8,G15.7)
46336            CALL DPWRST('XXX','WRIT')
46337   56     CONTINUE
46338        ELSE
46339          DO61I=1,N
46340            WRITE(ICOUT,62)I,X(I),Y(I)
46341   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
46342            CALL DPWRST('XXX','WRIT')
46343   61     CONTINUE
46344        ENDIF
46345       ENDIF
46346C
46347C               ********************************************
46348C               **  STEP 11--                             **
46349C               **  1) ROUND DATA TO INTEGER VALUES       **
46350C               **  2) COMPUTE SUMMARY STATISTICS         **
46351C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
46352C               **     INSUFFICIENT SAMPLE SIZE           **
46353C               ********************************************
46354C
46355      ISTEPN='11'
46356      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLWA')
46357     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
46358C
46359      IDIST='WARING'
46360C
46361      NPERC=0
46362      MAXGRP=MAXNXT/2
46363      NMIN=2
46364      IF(NVAR.EQ.1)THEN
46365        DO1105I=1,N
46366          ITEMP=INT(Y(I)+0.5)
46367          Y(I)=REAL(ITEMP)
46368 1105   CONTINUE
46369        CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
46370        IF(IERROR.EQ.'YES')GOTO9000
46371C
46372        IFLAG=1
46373        CALL SUMRAW(Y,N,IDIST,IFLAG,
46374     1              XMEAN,XVAR,XSD,XMIN,XMAX,
46375     1              ISUBRO,IBUGA3,IERROR)
46376        IF(IERROR.EQ.'YES')GOTO9000
46377        NTOTZZ=N
46378C
46379C       NOW BIN THE DATA FOR USE BY THE ESTIMATION METHOD BELOW
46380C
46381        IRELAT='OFF'
46382        IRHSTG='OFF'
46383        XSTART=XMIN-0.5
46384        XSTOP=XMAX+0.5
46385        CLWID=1.0
46386        CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
46387     1              TEMP1,X,N2,IBUGA3,IERROR)
46388        ICNT=0
46389        DO1121I=1,N2
46390          IF(TEMP1(I).GT.0.0)THEN
46391            ICNT=ICNT+1
46392            Y(ICNT)=TEMP1(I)
46393            X(ICNT)=X(I)
46394          ENDIF
463951121    CONTINUE
46396        N2=ICNT
46397      ELSE
46398        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
46399     1              ISUBRO,IBUGA3,IERROR)
46400        IF(IERROR.EQ.'YES')GOTO9000
46401        IFLAG1=1
46402        IFLAG2=1
46403        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
46404     1              TEMP1,TEMP2,TEMP3,MAXNXT,
46405     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
46406     1              ISUBRO,IBUGA3,IERROR)
46407        ICNT=0
46408        DO1221I=1,N
46409          IF(Y(I).GT.0.0)THEN
46410            ICNT=ICNT+1
46411            Y(ICNT)=Y(I)
46412            X(ICNT)=X(I)
46413          ENDIF
464141221    CONTINUE
46415        N2=ICNT
46416      ENDIF
46417      IF(IERROR.EQ.'YES')GOTO9000
46418C
46419      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLWA')THEN
46420        WRITE(ICOUT,999)
46421        CALL DPWRST('XXX','WRIT')
46422        WRITE(ICOUT,1311)
46423 1311   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
46424        CALL DPWRST('XXX','WRIT')
46425        WRITE(ICOUT,1312)XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ
46426 1312   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ = ',5G15.7,I10)
46427        CALL DPWRST('XXX','WRIT')
46428      ENDIF
46429C
46430C               ******************************
46431C               **  STEP 41--               **
46432C               **  CARRY OUT CALCULATIONS  **
46433C               **  FOR WARING MLE ESTIMATE **
46434C               ******************************
46435C
46436      ISTEPN='41'
46437      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLWA')
46438     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
46439C
46440C     COMPUTE MOMENT ESTIMATORS.
46441C     FROM IRWIN, "MATHEMATICS IN MEDICAL AND BIOLOGICAL
46442C     STATISTICS", JOURNAL OF THE ROYAL STATISTICAL SOCIETY, A,
46443C     1963, 126, PP. 1-44.  THE FORMULAS ARE:
46444C
46445C        CHAT = XBAR[XVAR + XBAR*(XBAR+1)]/[XVAR - XBAR*(XBAR+1)]
46446C        AHAT = [XVAR*(XBAR+2) + (XBAR+1)*XBAR**2]/[XVAR-XBAR*(XBAR+1)]
46447C
46448      TERM1=XMEAN*(XMEAN+1.0)
46449      CMOM=XMEAN*(XVAR+TERM1)/(XVAR-TERM1)
46450      TERM2=XVAR*(XMEAN+2.0) + (XMEAN+1.0)*XMEAN**2
46451      AMOM=TERM2/(XVAR-TERM1)
46452C
46453C     COMPUTE ESTIMATE BASED ON SAMPLE MEAN AND FIRST OBSERVED
46454C     FREQUENCY.  FROM IRWIN, "MATHEMATICS IN MEDICAL AND BIOLOGICAL
46455C     STATISTICS", JOURNAL OF THE ROYAL STATISTICAL SOCIETY, A,
46456C     1963, 126, PP. 1-44.  THE FORMULA IS:
46457C
46458C        CHAT = 1/((1/Q1) - (1/XBAR) - 1)
46459C        AHAT = (1Q1)/((1/Q1) - (1/XBAR) - 1)
46460C
46461C     WITH f1 = FIRST OBSERVED FREQUENCY AND Q1=1-F1.
46462C
46463      F1=Y(1)/REAL(NTOTZZ)
46464      Q1=1.0 - F1
46465      TERM1=1.0/XMEAN
46466      TERM2=1.0/Q1
46467      CFREQ=1.0/(TERM2 - TERM1 - 1.0)
46468      AFREQ=TERM2/(TERM2 - TERM1 - 1.0)
46469C
46470C     NOW COMPUTE MAXIMUM LIKELIHOOD ESTIMATE
46471C
46472      N22=2*N2
46473      IF(N22.GT.MAXNXT)THEN
46474        WRITE(ICOUT,999)
46475        CALL DPWRST('XXX','BUG ')
46476        WRITE(ICOUT,106)
46477  106   FORMAT('***** WARNING FROM WARING MAXIMUM LIKELIHOOD--')
46478        CALL DPWRST('XXX','BUG ')
46479        WRITE(ICOUT,108)MAXNXT/2
46480  108   FORMAT('      NUMBER OF FREQUENCY CLASSES EXCEEDED ',I8)
46481        CALL DPWRST('XXX','BUG ')
46482        WRITE(ICOUT,109)
46483  109   FORMAT('      MAXIMUM LIKELIHOOD ESTIMATION NOT PERFORMED.')
46484        CALL DPWRST('XXX','BUG ')
46485        CML=0.0
46486        AML=0.0
46487      ELSE
46488        XPAR(1)=DBLE(CFREQ)
46489        XPAR(2)=DBLE(AFREQ)
46490        NTOT2=NTOTZZ
46491        IOPT=2
46492        TOL=1.0D-6
46493        NVAR=2
46494        NPRINT=-1
46495        INFO=0
46496        LWA=MAXNXT
46497        CALL DNSQE(WARFU2,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
46498     1             DTEMP1,LWA,TEMP3,N2)
46499C
46500        CML=REAL(XPAR(1))
46501        AML=REAL(XPAR(2))
46502C
46503      ENDIF
46504C
46505C
46506C               *********************************
46507C               **   STEP 42--                 **
46508C               **   WRITE OUT EVERYTHING      **
46509C               **   FOR WARING MLE ESTIMATE   **
46510C               *********************************
46511C
46512      ISTEPN='42'
46513      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLWA')
46514     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
46515C
46516C     PRINT SUMMARY STATISTICS TABLE
46517C
46518      NUMDIG=7
46519      IF(IFORSW.EQ.'1')NUMDIG=1
46520      IF(IFORSW.EQ.'2')NUMDIG=2
46521      IF(IFORSW.EQ.'3')NUMDIG=3
46522      IF(IFORSW.EQ.'4')NUMDIG=4
46523      IF(IFORSW.EQ.'5')NUMDIG=5
46524      IF(IFORSW.EQ.'6')NUMDIG=6
46525      IF(IFORSW.EQ.'7')NUMDIG=7
46526      IF(IFORSW.EQ.'8')NUMDIG=8
46527      IF(IFORSW.EQ.'9')NUMDIG=9
46528      IF(IFORSW.EQ.'0')NUMDIG=0
46529      IF(IFORSW.EQ.'E')NUMDIG=-2
46530      IF(IFORSW.EQ.'-2')NUMDIG=-2
46531      IF(IFORSW.EQ.'-3')NUMDIG=-3
46532      IF(IFORSW.EQ.'-4')NUMDIG=-4
46533      IF(IFORSW.EQ.'-5')NUMDIG=-5
46534      IF(IFORSW.EQ.'-6')NUMDIG=-6
46535      IF(IFORSW.EQ.'-7')NUMDIG=-7
46536      IF(IFORSW.EQ.'-8')NUMDIG=-8
46537      IF(IFORSW.EQ.'-9')NUMDIG=-9
46538C
46539      ITITLE='Waring Parameter Estimation'
46540      NCTITL=27
46541      ITITLZ=' '
46542      NCTITZ=0
46543C
46544      ICNT=1
46545      ITEXT(ICNT)='Summary Statistics:'
46546      NCTEXT(ICNT)=19
46547      AVALUE(ICNT)=0.0
46548      IDIGIT(ICNT)=-1
46549      ICNT=ICNT+1
46550      ITEXT(ICNT)='Number of Observations:'
46551      NCTEXT(ICNT)=23
46552      AVALUE(ICNT)=REAL(NTOTZZ)
46553      IDIGIT(ICNT)=0
46554      ICNT=ICNT+1
46555      ITEXT(ICNT)='Sample Mean:'
46556      NCTEXT(ICNT)=12
46557      AVALUE(ICNT)=XMEAN
46558      IDIGIT(ICNT)=NUMDIG
46559      ICNT=ICNT+1
46560      ITEXT(ICNT)='Sample Standard Deviation:'
46561      NCTEXT(ICNT)=26
46562      AVALUE(ICNT)=XSD
46563      IDIGIT(ICNT)=NUMDIG
46564      ICNT=ICNT+1
46565      ITEXT(ICNT)='Sample Minimum:'
46566      NCTEXT(ICNT)=15
46567      AVALUE(ICNT)=XMIN
46568      IDIGIT(ICNT)=NUMDIG
46569      ICNT=ICNT+1
46570      ITEXT(ICNT)='Sample Maximum:'
46571      NCTEXT(ICNT)=15
46572      AVALUE(ICNT)=XMAX
46573      IDIGIT(ICNT)=NUMDIG
46574      ICNT=ICNT+1
46575      ITEXT(ICNT)='Sample First Frequency:'
46576      NCTEXT(ICNT)=23
46577      AVALUE(ICNT)=F1
46578      IDIGIT(ICNT)=NUMDIG
46579      ICNT=ICNT+1
46580      ITEXT(ICNT)=' '
46581      NCTEXT(ICNT)=0
46582      AVALUE(ICNT)=0.0
46583      IDIGIT(ICNT)=-1
46584C
46585      ICNT=ICNT+1
46586      ITEXT(ICNT)='Method of Moments:'
46587      NCTEXT(ICNT)=18
46588      AVALUE(ICNT)=0.0
46589      IDIGIT(ICNT)=-1
46590      ICNT=ICNT+1
46591      ITEXT(ICNT)='Estimate of C:'
46592      NCTEXT(ICNT)=14
46593      AVALUE(ICNT)=CMOM
46594      IDIGIT(ICNT)=NUMDIG
46595      ICNT=ICNT+1
46596      ITEXT(ICNT)='Estimate of A:'
46597      NCTEXT(ICNT)=14
46598      AVALUE(ICNT)=AMOM
46599      IDIGIT(ICNT)=NUMDIG
46600      ICNT=ICNT+1
46601      ITEXT(ICNT)=' '
46602      NCTEXT(ICNT)=0
46603      AVALUE(ICNT)=0.0
46604      IDIGIT(ICNT)=-1
46605C
46606      ICNT=ICNT+1
46607      ITEXT(ICNT)='Method of First Frequency and Mean:'
46608      NCTEXT(ICNT)=35
46609      AVALUE(ICNT)=0.0
46610      IDIGIT(ICNT)=-1
46611      ICNT=ICNT+1
46612      ITEXT(ICNT)='Estimate of C:'
46613      NCTEXT(ICNT)=14
46614      AVALUE(ICNT)=CFREQ
46615      IDIGIT(ICNT)=NUMDIG
46616      ICNT=ICNT+1
46617      ITEXT(ICNT)='Estimate of A:'
46618      NCTEXT(ICNT)=14
46619      AVALUE(ICNT)=AFREQ
46620      IDIGIT(ICNT)=NUMDIG
46621      ICNT=ICNT+1
46622      ITEXT(ICNT)=' '
46623      NCTEXT(ICNT)=0
46624      AVALUE(ICNT)=0.0
46625      IDIGIT(ICNT)=-1
46626C
46627      ICNT=ICNT+1
46628      ITEXT(ICNT)='Method of Maximum Likelihood:'
46629      NCTEXT(ICNT)=29
46630      AVALUE(ICNT)=0.0
46631      IDIGIT(ICNT)=-1
46632      ICNT=ICNT+1
46633      ITEXT(ICNT)='Estimate of C:'
46634      NCTEXT(ICNT)=14
46635      AVALUE(ICNT)=CML
46636      IDIGIT(ICNT)=NUMDIG
46637      ICNT=ICNT+1
46638      ITEXT(ICNT)='Estimate of A:'
46639      NCTEXT(ICNT)=14
46640      AVALUE(ICNT)=AML
46641      IDIGIT(ICNT)=NUMDIG
46642      ICNT=ICNT+1
46643      ITEXT(ICNT)=' '
46644      NCTEXT(ICNT)=0
46645      AVALUE(ICNT)=0.0
46646      IDIGIT(ICNT)=-1
46647C
46648      NUMROW=ICNT
46649      DO2310I=1,NUMROW
46650        NTOT(I)=15
46651 2310 CONTINUE
46652C
46653      IFRST=.TRUE.
46654      ILAST=.TRUE.
46655      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
46656     1            AVALUE,IDIGIT,
46657     1            NTOT,NUMROW,
46658     1            ICAPSW,ICAPTY,ILAST,IFRST,
46659     1            ISUBRO,IBUGA3,IERROR)
46660C
46661C               *****************
46662C               **  STEP 90--  **
46663C               **  EXIT       **
46664C               *****************
46665C
46666 9000 CONTINUE
46667      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLWA')THEN
46668        WRITE(ICOUT,999)
46669        CALL DPWRST('XXX','WRIT')
46670        WRITE(ICOUT,9011)
46671 9011   FORMAT('***** AT THE END       OF DPMLWA--')
46672        CALL DPWRST('XXX','WRIT')
46673        WRITE(ICOUT,9012)IERROR
46674 9012   FORMAT('IERROR = ',A4)
46675        CALL DPWRST('XXX','WRIT')
46676        WRITE(ICOUT,9015)N
46677 9015   FORMAT('N = ',I8)
46678        CALL DPWRST('XXX','WRIT')
46679      ENDIF
46680C
46681      RETURN
46682      END
46683      SUBROUTINE DPMLWC(Y,TAG,N,
46684     1                  XTEMP,MAXNXT,
46685     1                  GAMMA,ALPHA,NUMV,ICENTY,TEND,
46686     1                  ISUBRO,IBUGA3,IERROR)
46687C
46688C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
46689C              ESTIMATES FOR CENSORED WEIBULL DISTRIBUTION
46690C              IT ONLY SUPPORTS TYPE 2 CENSORING
46691C     EXAMPLE--WEIBULL MAXIMUM LIKELIHOOD Y TAG
46692C     REFERENCE--XX
46693C     WRITTEN BY--JAMES J. FILLIBEN
46694C                 STATISTICAL ENGINEERING DIVISION
46695C                 INFORMATION TECHNOLOGY LABORATORY
46696C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
46697C                 GAITHERSBURG, MD 20899-8980
46698C                 PHONE--301-975-2855
46699C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
46700C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
46701C     LANGUAGE--ANSI FORTRAN (1977)
46702C     VERSION NUMBER--98/6
46703C     ORIGINAL VERSION--JUNE      1998.
46704C
46705C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
46706C
46707      CHARACTER*4 ICENTY
46708      CHARACTER*4 ISUBRO
46709      CHARACTER*4 IBUGA3
46710      CHARACTER*4 IERROR
46711C
46712      CHARACTER*4 IWRITE
46713      CHARACTER*4 ISUBN1
46714      CHARACTER*4 ISUBN2
46715      CHARACTER*4 ISTEPN
46716C
46717C---------------------------------------------------------------------
46718C
46719      DIMENSION Y(*)
46720      DIMENSION TAG(*)
46721      DIMENSION XTEMP(*)
46722C
46723C---------------------------------------------------------------------
46724C
46725      INCLUDE 'DPCOP2.INC'
46726C
46727C-----START POINT-----------------------------------------------------
46728C
46729      ISUBN1='DPML'
46730      ISUBN2='WC  '
46731      IERROR='NO'
46732C
46733      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLWC')THEN
46734        WRITE(ICOUT,999)
46735  999   FORMAT(1X)
46736        CALL DPWRST('XXX','WRIT')
46737        WRITE(ICOUT,51)
46738   51   FORMAT('**** AT THE BEGINNING OF DPMLWC--')
46739        CALL DPWRST('XXX','WRIT')
46740        WRITE(ICOUT,52)IBUGA3,ICENTY,TEND
46741   52   FORMAT('IBUGA3,ICENTY,TEND = ',2(A4,2X),G15.7)
46742        CALL DPWRST('XXX','WRIT')
46743        WRITE(ICOUT,55)N,NUMV,MAXNXT
46744   55   FORMAT('N,NUMV,MAXNXT = ',3I8)
46745        CALL DPWRST('XXX','WRIT')
46746        DO56I=1,MIN(N,100)
46747          WRITE(ICOUT,57)I,Y(I),TAG(I)
46748   57     FORMAT('I,Y(I),TAG(I) = ',I8,2E15.7)
46749          CALL DPWRST('XXX','WRIT')
46750   56   CONTINUE
46751      ENDIF
46752C
46753C               ********************************************
46754C               **  STEP 11--                             **
46755C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
46756C               ********************************************
46757C
46758      ISTEPN='11'
46759      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
46760C
46761      IF(N.GE.1)GOTO1119
46762      WRITE(ICOUT,999)
46763      CALL DPWRST('XXX','WRIT')
46764      WRITE(ICOUT,1111)
46765 1111 FORMAT('***** ERROR IN DPMLWC--THE NUMBER OF OBSERVATIONS ',
46766     1'FOR VARIABLE 1 IS NON-POSITIVE')
46767      CALL DPWRST('XXX','WRIT')
46768      WRITE(ICOUT,1112)N
46769 1112 FORMAT('SAMPLE SIZE = ',I8)
46770      CALL DPWRST('XXX','WRIT')
46771      IERROR='YES'
46772      GOTO9000
46773 1119 CONTINUE
46774C
46775      IF(N.EQ.1)GOTO1120
46776      GOTO1129
46777 1120 CONTINUE
46778      WRITE(ICOUT,999)
46779      CALL DPWRST('XXX','WRIT')
46780      WRITE(ICOUT,1121)
46781 1121 FORMAT('***** NOTE FROM DPMLWC--VARIABLE 1 ',
46782     1'HAS ONLY 1 ELEMENT')
46783      CALL DPWRST('XXX','WRIT')
46784      GOTO9000
46785 1129 CONTINUE
46786C
46787      HOLD=Y(1)
46788      DO1135I=2,N
46789      IF(Y(I).NE.HOLD)GOTO1139
46790 1135 CONTINUE
46791      WRITE(ICOUT,999)
46792      CALL DPWRST('XXX','WRIT')
46793      WRITE(ICOUT,1131)HOLD
46794 1131 FORMAT('***** NOTE FROM DPMLWC--VARIABLE 1 ',
46795     1'HAS ALL ELEMENTS = ',E15.7)
46796      CALL DPWRST('XXX','WRIT')
46797      GOTO9000
46798 1139 CONTINUE
46799C
46800C               **********************************
46801C               **  STEP 51--                   **
46802C               **  CARRY OUT CALCULATIONS      **
46803C               **  FOR WEIBULL MLE             **
46804C               **  ESTIMATE (CENSORED CASE)    **
46805C               **  TYPE II CENSORING           **
46806C               **********************************
46807C
46808      ISTEPN='43'
46809      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
46810C
46811      IF(NUMV.EQ.2.AND.(ICENTY.EQ.'2   '.OR.ICENTY.EQ.'1   '))THEN
46812        IERROR='NO'
46813        IWRITE='OFF'
46814C
46815        CALL SORTC(Y,TAG,N,Y,TAG)
46816        IR=0
46817        DO5105I=1,N
46818          IF(ABS(TAG(I)).GE.0.5)THEN
46819            IR=IR+1
46820            XTEMP(IR)=Y(I)
46821          ENDIF
46822 5105   CONTINUE
46823        IF(IR.LT.2)THEN
46824          WRITE(ICOUT,999)
46825          CALL DPWRST('XXX','WRIT')
46826          WRITE(ICOUT,5109)
46827 5109   FORMAT(
46828     1         '****ERROR FROM DPMLWC: AFTER CENSORING, ONLY ',I3,
46829     1         ' OBSERVATIONS REMAIN.')
46830          IERROR='YES'
46831          GOTO9000
46832        ENDIF
46833        AR=REAL(IR)
46834C
46835        CALL WBLES2(XTEMP,N,IR,ALPHA,GAMMA,IERROR)
46836C
46837C               *********************************
46838C               **   STEP 52--                 **
46839C               **   WRITE OUT EVERYTHING      **
46840C               **   FOR WEIBULL MLE ESTIMATE  **
46841C               **********************************
46842C
46843        ISTEPN='52'
46844        IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
46845C
46846        IF(IPRINT.EQ.'OFF')GOTO5290
46847        WRITE(ICOUT,999)
46848        CALL DPWRST('XXX','WRIT')
46849        WRITE(ICOUT,5211)
46850 5211   FORMAT(
46851     1'WEIBULL 2-PARAMETER MAXIMUM LIKELIHOOD ESTIMATE (CENSORED ',
46852     1'CASE):')
46853        CALL DPWRST('XXX','WRIT')
46854C
46855        WRITE(ICOUT,999)
46856        CALL DPWRST('XXX','WRIT')
46857        WRITE(ICOUT,5242)N
46858 5242   FORMAT(6X,'NUMBER OF OBSERVATIONS            = ',I8)
46859        CALL DPWRST('XXX','WRIT')
46860        WRITE(ICOUT,5243)IR
46861 5243   FORMAT(6X,'NUMBER OF UNCENSORED OBSERVATIONS = ',I8)
46862        CALL DPWRST('XXX','WRIT')
46863        WRITE(ICOUT,5244)GAMMA
46864 5244   FORMAT(6X,'SHAPE PARAMETER GAMMA             = ',G15.7)
46865        CALL DPWRST('XXX','WRIT')
46866        WRITE(ICOUT,5246)ALPHA
46867 5246   FORMAT(6X,'SCALE PARAMETER ALPHA             = ',G15.7)
46868        CALL DPWRST('XXX','WRIT')
46869C
46870        WRITE(ICOUT,999)
46871        CALL DPWRST('XXX','WRIT')
46872        WRITE(ICOUT,5278)
46873 5278   FORMAT(6X,'GAMMA AND ALPHA WILL BE SAVED AS INTERNAL ',
46874     1         'PARAMETERS.')
46875        CALL DPWRST('XXX','WRIT')
46876        WRITE(ICOUT,999)
46877        CALL DPWRST('XXX','WRIT')
46878C
46879 5290   CONTINUE
46880        GOTO9000
46881      ENDIF
46882C
46883C               *****************
46884C               **  STEP 90--  **
46885C               **  EXIT       **
46886C               *****************
46887C
46888 9000 CONTINUE
46889      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLWC')GOTO9090
46890      WRITE(ICOUT,999)
46891      CALL DPWRST('XXX','WRIT')
46892      WRITE(ICOUT,9011)
46893 9011 FORMAT('***** AT THE END       OF DPMLWC--')
46894      CALL DPWRST('XXX','WRIT')
46895      WRITE(ICOUT,9012)N,IBUGA3,IERROR
46896 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
46897      CALL DPWRST('XXX','WRIT')
46898      WRITE(ICOUT,9015)N
46899 9015 FORMAT('N = ',I8)
46900      CALL DPWRST('XXX','WRIT')
46901 9090 CONTINUE
46902C
46903      RETURN
46904      END
46905      SUBROUTINE DPMLWK(Y,N,
46906     1                  DTEMP1,XMOM,MAXNXT,
46907     1                  SHA1LM,SHA2LM,SHA3LM,SCALLM,ALOCLM,
46908     1                  ICAPSW,ICAPTY,IFORSW,
46909     1                  ISUBRO,IBUGA3,IERROR)
46910C
46911C     PURPOSE--THIS ROUTINE COMPUTES THE L-MOMENT ESTIMATES
46912C              FOR THE WAKEBY DISTRIBUTION
46913C     EXAMPLE--WAKEBY MAXIMUM LIKELIHOOD Y
46914C     REFERENCE--FORTRAN CODE WRITTEN FOR INCLUSION IN IBM
46915C                RESEARCH REPORT RC20525, 'FORTRAN ROUTINES FOR
46916C                USE WITH THE METHOD OF L-MOMENTS, VERSION 3',
46917C                J. R. M. HOSKING, IBM RESEARCH DIVISION,
46918C                T. J. WATSON RESEARCH CENTER, YORKTOWN HEIGHTS
46919C                NEW YORK 10598, U.S.A., VERSION 3     AUGUST 1996
46920C     WRITTEN BY--ALAN HECKERT
46921C                 STATISTICAL ENGINEERING DIVISION
46922C                 INFORMATION TECHNOLOGY LABORATORY
46923C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
46924C                 GAITHERSBUG, MD 20899-8980
46925C                 PHONE--301-975-2899
46926C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
46927C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
46928C     LANGUAGE--ANSI FORTRAN (1977)
46929C     VERSION NUMBER--2007/10
46930C     ORIGINAL VERSION--OCTOBER   2007.
46931C     UPDATED         --JULY      2010. EXTRACT POINT ESTIMATES TO KAPML1
46932C     UPDATED         --JULY      2010. USE DPDTA1 TO PRINT OUTPUT
46933C
46934C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
46935C
46936      CHARACTER*4 ICAPSW
46937      CHARACTER*4 ICAPTY
46938      CHARACTER*4 IFORSW
46939      CHARACTER*4 ISUBRO
46940      CHARACTER*4 IBUGA3
46941      CHARACTER*4 IERROR
46942C
46943      CHARACTER*4 IWRITE
46944      CHARACTER*4 ISUBN1
46945      CHARACTER*4 ISUBN2
46946      CHARACTER*4 ISTEPN
46947C
46948C---------------------------------------------------------------------
46949C
46950      DIMENSION Y(*)
46951      DIMENSION QP(1)
46952      DOUBLE PRECISION DTEMP1(*)
46953      DOUBLE PRECISION XMOM(*)
46954C
46955CCCCC PARAMETER (NUMALP=6)
46956CCCCC DIMENSION ALPHA(NUMALP)
46957CCCCC DIMENSION ALOWSC(NUMALP)
46958CCCCC DIMENSION AUPPSC(NUMALP)
46959CCCCC DIMENSION ALOWGA(NUMALP)
46960CCCCC DIMENSION AUPPGA(NUMALP)
46961C
46962      PARAMETER (MAXROW=20)
46963      CHARACTER*60 ITITLE
46964      CHARACTER*60 ITITLZ
46965      CHARACTER*40 ITEXT(MAXROW)
46966      REAL         AVALUE(MAXROW)
46967      INTEGER      NCTEXT(MAXROW)
46968      INTEGER      IDIGIT(MAXROW)
46969      INTEGER      NTOT(MAXROW)
46970      LOGICAL IFRST
46971      LOGICAL ILAST
46972C
46973C---------------------------------------------------------------------
46974C
46975      INCLUDE 'DPCOP2.INC'
46976C
46977CCCCC DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
46978C
46979C-----START POINT-----------------------------------------------------
46980C
46981      ISUBN1='DPML'
46982      ISUBN2='WK  '
46983      IERROR='NO'
46984C
46985      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLWK')THEN
46986        WRITE(ICOUT,999)
46987  999   FORMAT(1X)
46988        CALL DPWRST('XXX','WRIT')
46989        WRITE(ICOUT,51)
46990   51   FORMAT('**** AT THE BEGINNING OF DPMLWK--')
46991        CALL DPWRST('XXX','WRIT')
46992        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,MAXNXT
46993   52   FORMAT('IBUGA3,ISUBRO,N,MAXNXT = ',2(A4,2X),2I8)
46994        CALL DPWRST('XXX','WRIT')
46995        DO56I=1,MIN(N,100)
46996          WRITE(ICOUT,57)I,Y(I)
46997   57     FORMAT('I,Y(I) = ',I8,G15.7)
46998          CALL DPWRST('XXX','WRIT')
46999   56   CONTINUE
47000      ENDIF
47001C
47002C               ********************************************
47003C               **  STEP 11--                             **
47004C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
47005C               ********************************************
47006C
47007      ISTEPN='11'
47008      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLWK')
47009     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
47010C
47011C               ***************************************************
47012C               **  STEP 21--                                    **
47013C               **  CARRY OUT CALCULATIONS                       **
47014C               **  FOR WAKEBY L-MOMENT ESTIMATION               **
47015C               ***************************************************
47016C
47017      ISTEPN='21'
47018      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLWK')
47019     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
47020C
47021      NPERC=5
47022      NMIN=5
47023      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
47024      IF(IERROR.EQ.'YES')GOTO9000
47025C
47026      IERROR='NO'
47027      IWRITE='OFF'
47028C
47029      CALL WAKML1(Y,N,
47030     1            DTEMP1,XMOM,NMOM,
47031     1            XMEAN,XSD,XVAR,XMIN,XMAX,
47032     1            ALOCLM,SCALLM,SHA1LM,SHA2LM,SHA3LM,
47033     1            ISUBRO,IBUGA3,IERROR)
47034      IF(IERROR.EQ.'YES')GOTO9000
47035C
47036C               ***********************************************
47037C               **   STEP 42--                               **
47038C               **   WRITE OUT EVERYTHING                    **
47039C               **   FOR WAKEBY MLE ESTIMATION               **
47040C               ***********************************************
47041C
47042      ISTEPN='42'
47043      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLWK')
47044     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
47045C
47046      IF(IPRINT.EQ.'OFF')GOTO9000
47047C
47048      NUMDIG=7
47049      IF(IFORSW.EQ.'1')NUMDIG=1
47050      IF(IFORSW.EQ.'2')NUMDIG=2
47051      IF(IFORSW.EQ.'3')NUMDIG=3
47052      IF(IFORSW.EQ.'4')NUMDIG=4
47053      IF(IFORSW.EQ.'5')NUMDIG=5
47054      IF(IFORSW.EQ.'6')NUMDIG=6
47055      IF(IFORSW.EQ.'7')NUMDIG=7
47056      IF(IFORSW.EQ.'8')NUMDIG=8
47057      IF(IFORSW.EQ.'9')NUMDIG=9
47058      IF(IFORSW.EQ.'0')NUMDIG=0
47059      IF(IFORSW.EQ.'E')NUMDIG=-2
47060      IF(IFORSW.EQ.'-2')NUMDIG=-2
47061      IF(IFORSW.EQ.'-3')NUMDIG=-3
47062      IF(IFORSW.EQ.'-4')NUMDIG=-4
47063      IF(IFORSW.EQ.'-5')NUMDIG=-5
47064      IF(IFORSW.EQ.'-6')NUMDIG=-6
47065      IF(IFORSW.EQ.'-7')NUMDIG=-7
47066      IF(IFORSW.EQ.'-8')NUMDIG=-8
47067      IF(IFORSW.EQ.'-9')NUMDIG=-9
47068C
47069      ITITLE='Wakeby Parameter Estimation:'
47070      NCTITL=28
47071      ITITLZ='Full Sample Case'
47072      NCTITZ=16
47073      ICNT=1
47074      ITEXT(ICNT)='Summary Statistics:'
47075      NCTEXT(ICNT)=19
47076      AVALUE(ICNT)=0.0
47077      IDIGIT(ICNT)=-1
47078      ICNT=ICNT+1
47079      ITEXT(ICNT)='Number of Observations:'
47080      NCTEXT(ICNT)=23
47081      AVALUE(ICNT)=REAL(N)
47082      IDIGIT(ICNT)=0
47083      ICNT=ICNT+1
47084      ITEXT(ICNT)='Sample Mean:'
47085      NCTEXT(ICNT)=12
47086      AVALUE(ICNT)=XMEAN
47087      IDIGIT(ICNT)=NUMDIG
47088      ICNT=ICNT+1
47089      ITEXT(ICNT)='Sample Standard Deviation:'
47090      NCTEXT(ICNT)=26
47091      AVALUE(ICNT)=XSD
47092      IDIGIT(ICNT)=NUMDIG
47093      ICNT=ICNT+1
47094      ITEXT(ICNT)='Sample Minimum:'
47095      NCTEXT(ICNT)=15
47096      AVALUE(ICNT)=XMIN
47097      IDIGIT(ICNT)=NUMDIG
47098      ICNT=ICNT+1
47099      ITEXT(ICNT)='Sample Maximum:'
47100      NCTEXT(ICNT)=15
47101      AVALUE(ICNT)=XMAX
47102      IDIGIT(ICNT)=NUMDIG
47103      ICNT=ICNT+1
47104      ITEXT(ICNT)=' '
47105      NCTEXT(ICNT)=0
47106      AVALUE(ICNT)=0.0
47107      IDIGIT(ICNT)=-1
47108C
47109      ICNT=ICNT+1
47110      ITEXT(ICNT)='First Sample L-Moment:'
47111      NCTEXT(ICNT)=22
47112      AVALUE(ICNT)=REAL(XMOM(1))
47113      IDIGIT(ICNT)=NUMDIG
47114      ICNT=ICNT+1
47115      ITEXT(ICNT)='Second Sample L-Moment:'
47116      NCTEXT(ICNT)=23
47117      AVALUE(ICNT)=REAL(XMOM(2))
47118      IDIGIT(ICNT)=NUMDIG
47119      ICNT=ICNT+1
47120      ITEXT(ICNT)='Third Sample L-Moment:'
47121      NCTEXT(ICNT)=22
47122      AVALUE(ICNT)=REAL(XMOM(3))
47123      IDIGIT(ICNT)=NUMDIG
47124      ICNT=ICNT+1
47125      ITEXT(ICNT)='Fourth Sample L-Moment:'
47126      NCTEXT(ICNT)=23
47127      AVALUE(ICNT)=REAL(XMOM(4))
47128      IDIGIT(ICNT)=NUMDIG
47129      ICNT=ICNT+1
47130      ITEXT(ICNT)='Fifth Sample L-Moment:'
47131      NCTEXT(ICNT)=22
47132      AVALUE(ICNT)=REAL(XMOM(5))
47133      IDIGIT(ICNT)=NUMDIG
47134      ICNT=ICNT+1
47135      ITEXT(ICNT)=' '
47136      NCTEXT(ICNT)=0
47137      AVALUE(ICNT)=0.0
47138      IDIGIT(ICNT)=-1
47139C
47140      ICNT=ICNT+1
47141      ITEXT(ICNT)='Method of L-Moments:'
47142      NCTEXT(ICNT)=20
47143      AVALUE(ICNT)=0.0
47144      IDIGIT(ICNT)=-1
47145      ICNT=ICNT+1
47146      ITEXT(ICNT)='Estimate of Location:'
47147      NCTEXT(ICNT)=22
47148      AVALUE(ICNT)=ALOCLM
47149      IDIGIT(ICNT)=NUMDIG
47150      ICNT=ICNT+1
47151      ITEXT(ICNT)='Estimate of Scale:'
47152      NCTEXT(ICNT)=18
47153      AVALUE(ICNT)=SCALLM
47154      IDIGIT(ICNT)=NUMDIG
47155      ICNT=ICNT+1
47156      ITEXT(ICNT)='Estimate of Shape Parameter Beta:'
47157      NCTEXT(ICNT)=33
47158      AVALUE(ICNT)=SHA1LM
47159      IDIGIT(ICNT)=NUMDIG
47160      ICNT=ICNT+1
47161      ITEXT(ICNT)='Estimate of Shape Parameter Gamma:'
47162      NCTEXT(ICNT)=34
47163      AVALUE(ICNT)=SHA2LM
47164      IDIGIT(ICNT)=NUMDIG
47165      ICNT=ICNT+1
47166      ITEXT(ICNT)='Estimate of Shape Parameter Delta:'
47167      NCTEXT(ICNT)=34
47168      AVALUE(ICNT)=SHA3LM
47169      IDIGIT(ICNT)=NUMDIG
47170      ICNT=ICNT+1
47171      ITEXT(ICNT)=' '
47172      NCTEXT(ICNT)=0
47173      AVALUE(ICNT)=0.0
47174      IDIGIT(ICNT)=-1
47175C
47176CCCCC ICNT=ICNT+1
47177CCCCC ITEXT(ICNT)='Log-likelihood:'
47178CCCCC NCTEXT(ICNT)=15
47179CCCCC AVALUE(ICNT)=ALIK
47180CCCCC IDIGIT(ICNT)=-7
47181CCCCC ICNT=ICNT+1
47182CCCCC ITEXT(ICNT)='AIC:'
47183CCCCC NCTEXT(ICNT)=4
47184CCCCC AVALUE(ICNT)=AIC
47185CCCCC IDIGIT(ICNT)=-7
47186CCCCC ICNT=ICNT+1
47187CCCCC ITEXT(ICNT)='AICc:'
47188CCCCC NCTEXT(ICNT)=5
47189CCCCC AVALUE(ICNT)=AICC
47190CCCCC IDIGIT(ICNT)=-7
47191CCCCC ICNT=ICNT+1
47192CCCCC ITEXT(ICNT)='BIC:'
47193CCCCC NCTEXT(ICNT)=4
47194CCCCC AVALUE(ICNT)=BIC
47195CCCCC IDIGIT(ICNT)=-7
47196C
47197      NUMROW=ICNT
47198      DO2320I=1,NUMROW
47199        NTOT(I)=15
47200 2320 CONTINUE
47201C
47202      IFRST=.TRUE.
47203      ILAST=.TRUE.
47204      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
47205     1            AVALUE,IDIGIT,
47206     1            NTOT,NUMROW,
47207     1            ICAPSW,ICAPTY,ILAST,IFRST,
47208     1            ISUBRO,IBUGA3,IERROR)
47209C
47210C               *****************
47211C               **  STEP 90--  **
47212C               **  EXIT       **
47213C               *****************
47214C
47215 9000 CONTINUE
47216      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLWK')THEN
47217        WRITE(ICOUT,999)
47218        CALL DPWRST('XXX','WRIT')
47219        WRITE(ICOUT,9011)
47220 9011   FORMAT('***** AT THE END       OF DPMLWK--')
47221        CALL DPWRST('XXX','WRIT')
47222        WRITE(ICOUT,9012)N,IBUGA3,IERROR
47223 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
47224        CALL DPWRST('XXX','WRIT')
47225        WRITE(ICOUT,9015)N
47226 9015   FORMAT('N = ',I8)
47227        CALL DPWRST('XXX','WRIT')
47228      ENDIF
47229C
47230      RETURN
47231      END
47232      SUBROUTINE DPMLYU(Y,X,N,NVAR,
47233     1                  XTEMP2,YTEMP2,VTEMP,MAXNXT,
47234     1                  PMOM,PFREQ,PML,
47235CCCCC1                  AICMO,AICCMO,BICMO,
47236CCCCC1                  AICFR,AICCFR,BICFR,
47237CCCCC1                  AICML,AICCML,BICML,
47238     1                  ICAPSW,ICAPTY,IFORSW,
47239     1                  ISUBRO,IBUGA3,IERROR)
47240C
47241C     PURPOSE--THIS ROUTINE COMPUTES THE METHOD OF MOMENTS,
47242C              FREQUENCY, AND MAXIMUM LIKELIHOOD ESTIMATES
47243C              FOR YULE DISTRIBUTION.
47244C     EXAMPLE--YULE MLE Y
47245C     REFERENCES--JOHNSON, KOTZ, AND KEMP (1992), "UNIVARIATE DISCRETE
47246C                 DISTRIBUTIONS", SECOND EDITION, WILEY, PP. 276.
47247C               --IRWIN (1963), "MATHEMATICS IN MEDICAL AND BIOLOGICAL
47248C                 STATISTICS", JOURNAL OF THE ROYAL STATISTICAL SOCIETY,
47249C                 A, 126, PP. 1-44.
47250C     WRITTEN BY--ALAN HECKERT
47251C                 STATISTICAL ENGINEERING DIVISION
47252C                 INFORMATION TECHNOLOGY LABORATORY
47253C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
47254C                 GAITHERSBURG, MD 20899-8980
47255C                 PHONE--301-975-2899
47256C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
47257C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
47258C     LANGUAGE--ANSI FORTRAN (1977)
47259C     VERSION NUMBER--2004/4
47260C     ORIGINAL VERSION--APRIL     2004.
47261C     UPDATED         --APRIL     2011. MODULARIZE THE CODE
47262C     UPDATED         --APRIL     2011. USE DPDTA1 TO PRINT THE OUTPUT
47263C     UPDATED         --APRIL     2011. COMMENT OUT FIRST FREQUENCY
47264C                                       METHOD MY FORMULA SEEMS TO
47265C                                       BE INCORRECT
47266C
47267C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
47268C
47269      CHARACTER*4 ICAPSW
47270      CHARACTER*4 ICAPTY
47271      CHARACTER*4 IFORSW
47272      CHARACTER*4 ISUBRO
47273      CHARACTER*4 IBUGA3
47274      CHARACTER*4 IERROR
47275C
47276      CHARACTER*4 IWRITE
47277      CHARACTER*4 IRELAT
47278      CHARACTER*4 IRHSTG
47279C
47280      CHARACTER*4 ISUBN1
47281      CHARACTER*4 ISUBN2
47282      CHARACTER*4 ISTEPN
47283C
47284C---------------------------------------------------------------------
47285C
47286      DIMENSION Y(*)
47287      DIMENSION X(*)
47288      DIMENSION XTEMP2(*)
47289      DIMENSION YTEMP2(*)
47290      DIMENSION VTEMP(*)
47291C
47292      REAL YULFU2
47293      EXTERNAL YULFU2
47294      COMMON/YULCOM/NTOTZZ,NCLASS
47295C
47296      PARAMETER (MAXROW=30)
47297      CHARACTER*60 ITITLE
47298      CHARACTER*1  ITITLZ
47299      CHARACTER*40 IDIST
47300      CHARACTER*40 ITEXT(MAXROW)
47301      REAL         AVALUE(MAXROW)
47302      INTEGER      NCTEXT(MAXROW)
47303      INTEGER      IDIGIT(MAXROW)
47304      INTEGER      NTOT(MAXROW)
47305      LOGICAL      IFRST
47306      LOGICAL      ILAST
47307C
47308CCCCC PARAMETER(NUMCLI=3)
47309CCCCC PARAMETER(MAXLIN=2)
47310CCCCC CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
47311CCCCC INTEGER      NCTIT2(MAXLIN,NUMCLI)
47312CCCCC INTEGER      IWHTML(NUMALP)
47313CCCCC INTEGER      IWRTF(NUMALP)
47314CCCCC REAL         AMAT(MAXROW,NUMCLI)
47315C
47316C---------------------------------------------------------------------
47317C
47318      INCLUDE 'DPCOP2.INC'
47319C
47320C-----START POINT-----------------------------------------------------
47321C
47322      ISUBN1='DPML'
47323      ISUBN2='YU  '
47324      IERROR='NO'
47325      IWRITE='OFF'
47326C
47327      PMOM=CPUMIN
47328      PML=CPUMIN
47329      PFREQ=CPUMIN
47330      ALIKE=CPUMIN
47331      AICMO=CPUMIN
47332      AICCMO=CPUMIN
47333      BICMO=CPUMIN
47334      AICML=CPUMIN
47335      AICCML=CPUMIN
47336      BICML=CPUMIN
47337      AICFR=CPUMIN
47338      AICCFR=CPUMIN
47339      BICFR=CPUMIN
47340C
47341      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLYU')THEN
47342        WRITE(ICOUT,999)
47343  999   FORMAT(1X)
47344        CALL DPWRST('XXX','WRIT')
47345        WRITE(ICOUT,51)
47346   51   FORMAT('**** AT THE BEGINNING OF DPMLYU--')
47347        CALL DPWRST('XXX','WRIT')
47348        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR
47349   52   FORMAT('IBUGA3,ISUBRO,N,NVAR = ',2(A4,2X),2I8)
47350        CALL DPWRST('XXX','WRIT')
47351        IF(NVAR.EQ.1)THEN
47352          DO56I=1,MIN(N,100)
47353            WRITE(ICOUT,57)I,Y(I)
47354   57       FORMAT('I,Y(I) = ',I8,G15.7)
47355            CALL DPWRST('XXX','WRIT')
47356   56     CONTINUE
47357        ELSE
47358          DO61I=1,N
47359            WRITE(ICOUT,62)I,X(I),Y(I)
47360   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
47361            CALL DPWRST('XXX','WRIT')
47362   61     CONTINUE
47363        ENDIF
47364       ENDIF
47365C
47366C               ********************************************
47367C               **  STEP 11--                             **
47368C               **  1) ROUND DATA TO INTEGER VALUES       **
47369C               **  2) COMPUTE SUMMARY STATISTICS         **
47370C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
47371C               **     INSUFFICIENT SAMPLE SIZE           **
47372C               ********************************************
47373C
47374      ISTEPN='11'
47375      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLYU')
47376     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
47377C
47378      IDIST='YULE'
47379C
47380      NPERC=0
47381      MAXGRP=MAXNXT/2
47382      NMIN=2
47383      IF(NVAR.EQ.1)THEN
47384        DO1105I=1,N
47385          ITEMP=INT(Y(I)+0.5)
47386          Y(I)=REAL(ITEMP)
47387 1105   CONTINUE
47388        CALL CKDIST(Y,N,NMIN,XTEMP2,NPERC,ISUBRO,IBUGA3,IERROR)
47389        IF(IERROR.EQ.'YES')GOTO9000
47390C
47391        IFLAG=1
47392        CALL SUMRAW(Y,N,IDIST,IFLAG,
47393     1              XMEAN,XVAR,XSD,XMIN,XMAX,
47394     1              ISUBRO,IBUGA3,IERROR)
47395        IF(IERROR.EQ.'YES')GOTO9000
47396        NTOTZZ=N
47397C
47398C       NOW BIN THE DATA FOR USE BY THE ESTIMATION METHOD BELOW
47399C
47400        IRELAT='OFF'
47401        IRHSTG='OFF'
47402        XSTART=XMIN-0.5
47403        XSTOP=XMAX+0.5
47404        CLWID=1.0
47405        CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
47406     1              YTEMP2,X,N2,IBUGA3,IERROR)
47407        ICNT=0
47408        NTOTZZ=0
47409        DO1121I=1,N2
47410          Y(I)=YTEMP2(I)
47411          IF(YTEMP2(I).GT.0)THEN
47412            ICNT=ICNT+1
47413            Y(ICNT)=Y(I)
47414            X(ICNT)=X(I)
47415            NTOTZZ=NTOTZZ + INT(Y(I)+0.01)
47416          ENDIF
474171121    CONTINUE
47418        N2=ICNT
47419      ELSE
47420        CALL CKDIS2(Y,X,XTEMP2,N,MAXGRP,NMIN,VTEMP,NPERC,NTOTZZ,
47421     1              ISUBRO,IBUGA3,IERROR)
47422        IF(IERROR.EQ.'YES')GOTO9000
47423        IFLAG1=1
47424        IFLAG2=1
47425        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
47426     1              XTEMP2,YTEMP2,VTEMP,MAXNXT,
47427     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
47428     1              ISUBRO,IBUGA3,IERROR)
47429C
47430C       NOW REMOVE THE EMPTY BINS
47431C
47432        ICNT=0
47433        NTOTZZ=0
47434        DO1221I=1,N
47435          IF(Y(I).GT.0.0)THEN
47436            ICNT=ICNT+1
47437            Y(ICNT)=Y(I)
47438            X(ICNT)=X(I)
47439            NTOTZZ=NTOTZZ + INT(Y(I)+0.01)
47440          ENDIF
474411221    CONTINUE
47442        N2=ICNT
47443      ENDIF
47444      IF(IERROR.EQ.'YES')GOTO9000
47445C
47446      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLYU')THEN
47447        WRITE(ICOUT,999)
47448        CALL DPWRST('XXX','WRIT')
47449        WRITE(ICOUT,1151)
47450 1151   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
47451        CALL DPWRST('XXX','WRIT')
47452        WRITE(ICOUT,1152)XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ
47453 1152   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ = ',5G15.7,I10)
47454        CALL DPWRST('XXX','WRIT')
47455      ENDIF
47456C
47457C               ******************************
47458C               **  STEP 41--               **
47459C               **  CARRY OUT CALCULATIONS  **
47460C               **  FOR YULE MLE ESTIMATE   **
47461C               ******************************
47462C
47463      ISTEPN='41'
47464      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLYU')
47465     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
47466C
47467C     METHOD OF MOMENTS ESTIMATE (FROM JOHHSON, KOTZ, AND KEMP).
47468C     USE THE FORMULA
47469C         U1 = 1/(P-1)
47470C     WHICH GIVES
47471C         P = (1+U1)/U1
47472C     REPLACE POPULATION MEAN, U1, WITH SAMPLE ESTIMATE, XBAR.
47473C     NOTE THAT THE MEAN IS UNDEFINED FOR P < 1.  LARGE VALUES OF
47474C     THE MEAN INDICATE A VALUE OF P LESS THAN 1, IN WHICH CASE
47475C     ESTIMATE OF P IS NOT VALID.
47476C
47477      PMOM=(XMEAN+1.0)/XMEAN
47478C
47479C     COMPUTE ESTIMATE BASED ON SAMPLE MEAN AND FIRST OBSERVED
47480C     FREQUENCY.  FROM IRWIN, THE FORMULA IS:
47481C
47482C        PHAT = (1/(1 - f1/N)/((1/(1-f1/N) - (1/XBAR) - 1)
47483C
47484C     WITH f1 = DENOTING THE FIRST OBSERVED FREQUENCY.
47485C
47486      F1=Y(1)/REAL(NTOTZZ)
47487      Q1=1.0 - F1
47488CCCCC PFREQ=(1.0/Q1)/((1.0/Q1) - (1.0/XMEAN) - 1.0) - 1.0
47489C
47490C     MAXIMUM LIKELIHOOD ESTIMATE
47491C
47492      VTEMP(N2)=Y(N2)
47493      IF(N2.GT.1)THEN
47494        DO110I=N2-1,1,-1
47495          VTEMP(I)=Y(I)+VTEMP(I+1)
47496  110   CONTINUE
47497      ENDIF
47498      IF(NVAR.EQ.1)NTOTZZ=N
47499      NCLASS=N2
47500      AE=1.E-6
47501      RE=1.E-6
47502      IFLAG=0
47503      XLOW=1.1
47504      XSTRT=PMOM+1.0
47505      XUP=XSTRT+20.0
47506      CALL FZEROY(YULFU2,XLOW,XUP,XSTRT,RE,AE,IFLAG,X,VTEMP)
47507C
47508      PML=XLOW - 1.0
47509C
47510      IF(IFLAG.EQ.2)THEN
47511C
47512C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
47513CCCCC   WRITE(ICOUT,999)
47514CCCCC   CALL DPWRST('XXX','BUG ')
47515CCCCC   WRITE(ICOUT,111)
47516CC111   FORMAT('***** WARNING FROM YULE MAXIMUM LIKELIHOOD--')
47517CCCCC   CALL DPWRST('XXX','BUG ')
47518CCCCC   WRITE(ICOUT,113)
47519CC113   FORMAT('      ESTIMATE OF P MAY NOT BE COMPUTED TO DESIRED ',
47520CCCCC1         'TOLERANCE.')
47521CCCCC   CALL DPWRST('XXX','BUG ')
47522      ELSEIF(IFLAG.EQ.3)THEN
47523        WRITE(ICOUT,999)
47524        CALL DPWRST('XXX','BUG ')
47525        WRITE(ICOUT,121)
47526  121   FORMAT('***** WARNING FROM YULE MAXIMUM LIKELIHOOD--')
47527        CALL DPWRST('XXX','BUG ')
47528        WRITE(ICOUT,123)
47529  123   FORMAT('      ESTIMATE OF P MAY BE NEAR A SINGULAR POINT.')
47530        CALL DPWRST('XXX','BUG ')
47531      ELSEIF(IFLAG.EQ.4)THEN
47532        WRITE(ICOUT,999)
47533        CALL DPWRST('XXX','BUG ')
47534        WRITE(ICOUT,131)
47535  131   FORMAT('***** ERROR FROM YULE MAXIMUM LIKELIHOOD--')
47536        CALL DPWRST('XXX','BUG ')
47537        WRITE(ICOUT,133)
47538  133   FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
47539        CALL DPWRST('XXX','BUG ')
47540      ELSEIF(IFLAG.EQ.5)THEN
47541        WRITE(ICOUT,999)
47542        CALL DPWRST('XXX','BUG ')
47543        WRITE(ICOUT,121)
47544        CALL DPWRST('XXX','BUG ')
47545        WRITE(ICOUT,143)
47546  143   FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
47547        CALL DPWRST('XXX','BUG ')
47548      ENDIF
47549C
47550      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLYU')THEN
47551        WRITE(ICOUT,999)
47552        CALL DPWRST('XXX','WRIT')
47553        WRITE(ICOUT,2151)
47554 2151   FORMAT('AFTER COMPUTE ESTIMATES--')
47555        CALL DPWRST('XXX','WRIT')
47556        WRITE(ICOUT,2152)PMOM,PFREQ,PML,F1
47557 2152   FORMAT('PMOM,PFREQ,PML,F1 = ',4G15.7)
47558        CALL DPWRST('XXX','WRIT')
47559      ENDIF
47560C
47561C               *********************************
47562C               **   STEP 42--                 **
47563C               **   WRITE OUT EVERYTHING      **
47564C               **   FOR YULE MLE ESTIMATE     **
47565C               **********************************
47566C
47567      ISTEPN='42'
47568      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLYU')
47569     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
47570C
47571C     PRINT SUMMARY STATISTICS TABLE
47572C
47573      NUMDIG=7
47574      IF(IFORSW.EQ.'1')NUMDIG=1
47575      IF(IFORSW.EQ.'2')NUMDIG=2
47576      IF(IFORSW.EQ.'3')NUMDIG=3
47577      IF(IFORSW.EQ.'4')NUMDIG=4
47578      IF(IFORSW.EQ.'5')NUMDIG=5
47579      IF(IFORSW.EQ.'6')NUMDIG=6
47580      IF(IFORSW.EQ.'7')NUMDIG=7
47581      IF(IFORSW.EQ.'8')NUMDIG=8
47582      IF(IFORSW.EQ.'9')NUMDIG=9
47583      IF(IFORSW.EQ.'0')NUMDIG=0
47584      IF(IFORSW.EQ.'E')NUMDIG=-2
47585      IF(IFORSW.EQ.'-2')NUMDIG=-2
47586      IF(IFORSW.EQ.'-3')NUMDIG=-3
47587      IF(IFORSW.EQ.'-4')NUMDIG=-4
47588      IF(IFORSW.EQ.'-5')NUMDIG=-5
47589      IF(IFORSW.EQ.'-6')NUMDIG=-6
47590      IF(IFORSW.EQ.'-7')NUMDIG=-7
47591      IF(IFORSW.EQ.'-8')NUMDIG=-8
47592      IF(IFORSW.EQ.'-9')NUMDIG=-9
47593C
47594      ITITLE='Yule Parameter Estimation'
47595      NCTITL=25
47596      ITITLZ=' '
47597      NCTITZ=0
47598C
47599      ICNT=1
47600      ITEXT(ICNT)='Summary Statistics:'
47601      NCTEXT(ICNT)=19
47602      AVALUE(ICNT)=0.0
47603      IDIGIT(ICNT)=-1
47604      ICNT=ICNT+1
47605      ITEXT(ICNT)='Number of Observations:'
47606      NCTEXT(ICNT)=23
47607      AVALUE(ICNT)=REAL(NTOTZZ)
47608      IDIGIT(ICNT)=0
47609      ICNT=ICNT+1
47610      ITEXT(ICNT)='Sample Mean:'
47611      NCTEXT(ICNT)=12
47612      AVALUE(ICNT)=XMEAN
47613      IDIGIT(ICNT)=NUMDIG
47614      ICNT=ICNT+1
47615      ITEXT(ICNT)='Sample Standard Deviation:'
47616      NCTEXT(ICNT)=26
47617      AVALUE(ICNT)=XSD
47618      IDIGIT(ICNT)=NUMDIG
47619      ICNT=ICNT+1
47620      ITEXT(ICNT)='Sample Minimum:'
47621      NCTEXT(ICNT)=15
47622      AVALUE(ICNT)=XMIN
47623      IDIGIT(ICNT)=NUMDIG
47624      ICNT=ICNT+1
47625      ITEXT(ICNT)='Sample Maximum:'
47626      NCTEXT(ICNT)=15
47627      AVALUE(ICNT)=XMAX
47628      IDIGIT(ICNT)=NUMDIG
47629      ICNT=ICNT+1
47630      ITEXT(ICNT)='Sample First Frequency:'
47631      NCTEXT(ICNT)=23
47632      AVALUE(ICNT)=F1
47633      IDIGIT(ICNT)=NUMDIG
47634      ICNT=ICNT+1
47635      ITEXT(ICNT)=' '
47636      NCTEXT(ICNT)=0
47637      AVALUE(ICNT)=0.0
47638      IDIGIT(ICNT)=-1
47639C
47640      ICNT=ICNT+1
47641      ITEXT(ICNT)='Estimates of p:'
47642      NCTEXT(ICNT)=23
47643      AVALUE(ICNT)=0.0
47644      IDIGIT(ICNT)=-1
47645      ICNT=ICNT+1
47646      ITEXT(ICNT)='Method of Moments:'
47647      NCTEXT(ICNT)=18
47648      AVALUE(ICNT)=PMOM
47649      IDIGIT(ICNT)=NUMDIG
47650CCCCC ICNT=ICNT+1
47651CCCCC ITEXT(ICNT)='Method of First Frequency:'
47652CCCCC NCTEXT(ICNT)=26
47653CCCCC AVALUE(ICNT)=PFREQ
47654CCCCC IDIGIT(ICNT)=NUMDIG
47655      ICNT=ICNT+1
47656      ITEXT(ICNT)='Method of Maximum Likelihood:'
47657      NCTEXT(ICNT)=29
47658      AVALUE(ICNT)=PML
47659      IDIGIT(ICNT)=NUMDIG
47660C
47661      NUMROW=ICNT
47662      DO2310I=1,NUMROW
47663        NTOT(I)=15
47664 2310 CONTINUE
47665C
47666      IFRST=.TRUE.
47667      ILAST=.TRUE.
47668      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
47669     1            AVALUE,IDIGIT,
47670     1            NTOT,NUMROW,
47671     1            ICAPSW,ICAPTY,ILAST,IFRST,
47672     1            ISUBRO,IBUGA3,IERROR)
47673C
47674C               *****************
47675C               **  STEP 90--  **
47676C               **  EXIT       **
47677C               *****************
47678C
47679 9000 CONTINUE
47680      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLYU')THEN
47681        WRITE(ICOUT,999)
47682        CALL DPWRST('XXX','WRIT')
47683        WRITE(ICOUT,9011)
47684 9011   FORMAT('***** AT THE END       OF DPMLYU--')
47685        CALL DPWRST('XXX','WRIT')
47686        WRITE(ICOUT,9012)N,IBUGA3,IERROR
47687 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
47688        CALL DPWRST('XXX','WRIT')
47689        WRITE(ICOUT,9014)PMOM,PFREQ,PML
47690 9014   FORMAT('PMOM,PFREQ,PML = ',3G15.7)
47691        CALL DPWRST('XXX','WRIT')
47692      ENDIF
47693C
47694      RETURN
47695      END
47696      SUBROUTINE DPMLZE(Y,X,N,NVAR,
47697     1                  TEMP1,TEMP2,TEMP3,
47698     1                  ALPHML,ALPHFR,ALPHMO,AFRVAR,AMLVAR,
47699     1                  ICAPSW,ICAPTY,IFORSW,MAXNXT,
47700     1                  ISUBRO,IBUGA3,IERROR)
47701C
47702C     PURPOSE--THIS ROUTINE COMPUTES ESTIMATES FOR THE ZETA
47703C              DISTRIBUTION USING THE FOLLOWING METHODS:
47704C
47705C              1) RATIO OF F1/F2 (THESE ARE THE FREQUENCIES
47706C                 OF THE FIRST AND SECOND GROUPS.
47707C
47708C                 ALPHAHAT = (LN(F1/F2)/LN(2))
47709C
47710C              2) A MOMENT BASED ESTIMATE - SOLVE THE EQUATION:
47711C
47712C                 XBAR - ZETA(ALPHAHAT-1)/ZETA(ALPHAHAT) = 0
47713C
47714C              3) MAXIMUM LIKELIHOOD - SOLVE THE EQUATION:
47715C
47716C                 SUM[i=1 to N][LN(X(i)] +
47717C                 ZETA'(ALPHAHAT)/ZETA(ALPHAHAT) = 0
47718C
47719C     EXAMPLE--ZETA MLE Y
47720C     REFERENCE--"UNIVARIATE DISCRETE DISTRIBUTIONS", SECOND EDITION,
47721C                JOHNSON, KOTZ, AND KEMP, WILEY, PP. 465-469.
47722C     WRITTEN BY--ALAN HECKERT
47723C                 STATISTICAL ENGINEERING DIVISION
47724C                 INFORMATION TECHNOLOGY LABORATORY
47725C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
47726C                 GAITHERSBURG, MD 20899-8980
47727C                 PHONE--301-975-2899
47728C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
47729C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
47730C     LANGUAGE--ANSI FORTRAN (1977)
47731C     VERSION NUMBER--2006/5
47732C     ORIGINAL VERSION--MAY       2006.
47733C     UPDATED         --APRIL     2011. USE DPDTA1 TO PRINT OUTPUT
47734C
47735C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
47736C
47737      CHARACTER*4 ICAPSW
47738      CHARACTER*4 ICAPTY
47739      CHARACTER*4 IFORSW
47740      CHARACTER*4 ISUBRO
47741      CHARACTER*4 IBUGA3
47742      CHARACTER*4 IERROR
47743      CHARACTER*4 IWRITE
47744      CHARACTER*4 IRELAT
47745      CHARACTER*4 IRHSTG
47746      CHARACTER*4 ISUBN1
47747      CHARACTER*4 ISUBN2
47748      CHARACTER*4 ISTEPN
47749C
47750      PARAMETER (MAXROW=30)
47751      CHARACTER*60 ITITLE
47752      CHARACTER*1  ITITLZ
47753      CHARACTER*40 IDIST
47754      CHARACTER*40 ITEXT(MAXROW)
47755      REAL         AVALUE(MAXROW)
47756      INTEGER      NCTEXT(MAXROW)
47757      INTEGER      IDIGIT(MAXROW)
47758      INTEGER      NTOT(MAXROW)
47759      LOGICAL      IFRST
47760      LOGICAL      ILAST
47761C
47762C---------------------------------------------------------------------
47763C
47764      DIMENSION Y(*)
47765      DIMENSION X(*)
47766      DIMENSION TEMP1(*)
47767      DIMENSION TEMP2(*)
47768      DIMENSION TEMP3(*)
47769C
47770      DOUBLE PRECISION DSUM1
47771      DOUBLE PRECISION DTERM1
47772C
47773      REAL ZETFUN
47774      EXTERNAL ZETFUN
47775      REAL ZETFU2
47776      EXTERNAL ZETFU2
47777      COMMON/ZETCOM/XBAR,SUM1
47778C
47779C---------------------------------------------------------------------
47780C
47781      INCLUDE 'DPCOP2.INC'
47782C
47783C-----START POINT-----------------------------------------------------
47784C
47785      ISUBN1='DPML'
47786      ISUBN2='ZE  '
47787      IERROR='NO'
47788      IWRITE='OFF'
47789C
47790      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLZE')THEN
47791        WRITE(ICOUT,999)
47792  999   FORMAT(1X)
47793        CALL DPWRST('XXX','WRIT')
47794        WRITE(ICOUT,51)
47795   51   FORMAT('**** AT THE BEGINNING OF DPMLZE--')
47796        CALL DPWRST('XXX','WRIT')
47797        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR
47798   52   FORMAT('IBUGA3,ISUBRO,N,NVAR = ',2(A4,2X),2I8)
47799        CALL DPWRST('XXX','WRIT')
47800        IF(NVAR.EQ.1)THEN
47801          DO56I=1,MIN(N,100)
47802            WRITE(ICOUT,57)I,Y(I)
47803   57       FORMAT('I,Y(I) = ',I8,G15.7)
47804            CALL DPWRST('XXX','WRIT')
47805   56     CONTINUE
47806        ELSE
47807          DO61I=1,N
47808            WRITE(ICOUT,62)I,X(I),Y(I)
47809   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
47810            CALL DPWRST('XXX','WRIT')
47811   61     CONTINUE
47812        ENDIF
47813       ENDIF
47814C
47815C               ********************************************
47816C               **  STEP 11--                             **
47817C               **  1) ROUND DATA TO INTEGER VALUES       **
47818C               **  2) COMPUTE SUMMARY STATISTICS         **
47819C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
47820C               **     INSUFFICIENT SAMPLE SIZE           **
47821C               ********************************************
47822C
47823      ISTEPN='11'
47824      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLZE')
47825     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
47826C
47827      IDIST='ZETA'
47828C
47829      NPERC=0
47830      MAXGRP=MAXNXT/2
47831      NMIN=2
47832      IF(NVAR.EQ.1)THEN
47833        DSUM1=0.0D0
47834        DO1105I=1,N
47835          ITEMP=INT(Y(I)+0.5)
47836          Y(I)=REAL(ITEMP)
47837          DSUM1=DSUM1 + DLOG(DBLE(Y(I)))
47838 1105   CONTINUE
47839        SUM1=REAL(DSUM1/DBLE(N))
47840        CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
47841        IF(IERROR.EQ.'YES')GOTO9000
47842C
47843        IFLAG=1
47844        CALL SUMRAW(Y,N,IDIST,IFLAG,
47845     1              XMEAN,XVAR,XSD,XMIN,XMAX,
47846     1              ISUBRO,IBUGA3,IERROR)
47847        IF(IERROR.EQ.'YES')GOTO9000
47848        NTOTZZ=N
47849C
47850C       NOW BIN THE DATA FOR USE BY THE ESTIMATION METHOD BELOW
47851C
47852        IRELAT='OFF'
47853        IRHSTG='OFF'
47854        XSTART=XMIN-0.5
47855        XSTOP=XMAX+0.5
47856        CLWID=1.0
47857        CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
47858     1              TEMP1,X,N2,IBUGA3,IERROR)
47859        ICNT=0
47860        DO1121I=1,N2
47861          Y(I)=TEMP1(I)
47862          ICNT=ICNT+1
47863          Y(ICNT)=Y(I)
47864          X(ICNT)=X(I)
478651121    CONTINUE
47866        N2=ICNT
47867      ELSE
47868        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
47869     1              ISUBRO,IBUGA3,IERROR)
47870        IF(IERROR.EQ.'YES')GOTO9000
47871        IFLAG1=1
47872        IFLAG2=1
47873        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
47874     1              TEMP1,TEMP2,TEMP3,MAXNXT,
47875     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
47876     1              ISUBRO,IBUGA3,IERROR)
47877        N2=N
47878      ENDIF
47879      IF(IERROR.EQ.'YES')GOTO9000
47880C
47881      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLZE')THEN
47882        WRITE(ICOUT,999)
47883        CALL DPWRST('XXX','WRIT')
47884        WRITE(ICOUT,1311)
47885 1311   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
47886        CALL DPWRST('XXX','WRIT')
47887        WRITE(ICOUT,1312)XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ
47888 1312   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ = ',5G15.7,I10)
47889        CALL DPWRST('XXX','WRIT')
47890      ENDIF
47891C
47892C               ******************************
47893C               **  STEP 21--               **
47894C               **  CARRY OUT CALCULATIONS  **
47895C               **  FOR ZETA MLE ESTIMATE   **
47896C               ******************************
47897C
47898      ISTEPN='21'
47899      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLZE')
47900     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
47901C
47902      F1=TEMP1(1)/REAL(N)
47903      F2=TEMP1(2)/REAL(N)
47904      IF(F1.GT.0.0 .AND. F2.GT.0.0)THEN
47905        ALPHFR=(LOG(F1/F2)/LOG(2.0))
47906        CALL ZETA(DBLE(ALPHFR),DTERM1)
47907        AFRVAR=REAL((1.0D0+2.0D0**ALPHFR)/
47908     1         (DLOG(2.0D0)**2*(DTERM1+1.0D0)*DBLE(N)))
47909      ELSE
47910        ALPHFR=-1.0
47911      ENDIF
47912C
47913C     COMPUTE MOMENT TYPE ESTIMATE
47914C
47915C     ZETA HAS INFINITE MEAN FOR ALPHA < 2.  THE MOMENT METHOD
47916C     REQUIRES THE ZETA FUNCTION FOR ALPHA - 1, SO THIS IMPOSES
47917C     A LOWER BOUND OF 2 ON THE MOMENT ESTIMATE.
47918C
47919      XBAR=XMEAN
47920      AE=1.E-6
47921      RE=1.E-6
47922      IFLAG=0
47923      XLOW=2.01
47924      IF(ALPHFR.GT.2.01)THEN
47925        XMID=ALPHFR
47926        XUP=ALPHFR + 5.0
47927      ELSE
47928        XMID=3.0
47929        XUP=10.0
47930      ENDIF
47931      CALL FZERO(ZETFU2,XLOW,XUP,XUP,RE,AE,IFLAG)
47932C
47933      ALPHMO=XLOW
47934C
47935      IF(IFLAG.EQ.2)THEN
47936C
47937C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
47938CCCCC   WRITE(ICOUT,999)
47939CCCCC   CALL DPWRST('XXX','BUG ')
47940CCCCC   WRITE(ICOUT,111)
47941CC111   FORMAT('***** WARNING FROM ZETA MAXIMUM LIKELIHOOD--')
47942CCCCC   CALL DPWRST('XXX','BUG ')
47943CCCCC   WRITE(ICOUT,113)
47944CC113   FORMAT('      ESTIMATE OF ALPHA MAY NOT BE COMPUTED TO ',
47945CCCCC1         'DESIRED TOLERANCE.')
47946CCCCC   CALL DPWRST('XXX','BUG ')
47947      ELSEIF(IFLAG.EQ.3)THEN
47948        WRITE(ICOUT,999)
47949        CALL DPWRST('XXX','BUG ')
47950        WRITE(ICOUT,121)
47951  121   FORMAT('***** WARNING FROM ZETA MAXIMUM LIKELIHOOD--')
47952        CALL DPWRST('XXX','BUG ')
47953        WRITE(ICOUT,123)
47954  123   FORMAT('      MOMENT ESTIMATE OF ALPHA MAY BE NEAR A ',
47955     1         'SINGULAR POINT.')
47956        CALL DPWRST('XXX','BUG ')
47957      ELSEIF(IFLAG.EQ.4)THEN
47958        WRITE(ICOUT,999)
47959        CALL DPWRST('XXX','BUG ')
47960        WRITE(ICOUT,131)
47961  131   FORMAT('***** ERROR FROM ZETA MAXIMUM LIKELIHOOD--')
47962        CALL DPWRST('XXX','BUG ')
47963        WRITE(ICOUT,133)
47964  133   FORMAT('      APPROPRIATE BRACKETING INTERVAL FOR MOMENT ',
47965     1         'ESTIMATE NOT FOUND.')
47966        CALL DPWRST('XXX','BUG ')
47967      ELSEIF(IFLAG.EQ.5)THEN
47968        WRITE(ICOUT,999)
47969        CALL DPWRST('XXX','BUG ')
47970        WRITE(ICOUT,121)
47971        CALL DPWRST('XXX','BUG ')
47972        WRITE(ICOUT,143)
47973  143   FORMAT('      MAXIMUM ITERATIONS FOR MOMENT ESTIMATE ',
47974     1         'EXCEEDED.')
47975        CALL DPWRST('XXX','BUG ')
47976      ENDIF
47977C
47978C  COMPUTE MAXIMUM LIKELIHOOD ESTIMATE
47979C
47980      XBAR=XMEAN
47981      AE=1.E-6
47982      RE=1.E-6
47983      IFLAG=0
47984      XLOW=1.01
47985      IF(ALPHFR.GT.1.01)THEN
47986        XMID=ALPHFR
47987        XUP=ALPHFR + 5.0
47988      ELSE
47989        XMID=2.0
47990        XUP=20.0
47991      ENDIF
47992      CALL FZERO(ZETFUN,XLOW,XUP,XUP,RE,AE,IFLAG)
47993C
47994      ALPHML=XLOW
47995      IF(ALPHML.LE.1.5)THEN
47996        TERM1=3.860
47997      ELSEIF(ALPHML.GT.1.5 .AND. ALPHML.LE.1.6)THEN
47998        TERM1=2.638
47999      ELSEIF(ALPHML.GT.1.6 .AND. ALPHML.LE.1.7)THEN
48000        TERM1=1.909
48001      ELSEIF(ALPHML.GT.1.7 .AND. ALPHML.LE.1.8)THEN
48002        TERM1=1.436
48003      ELSEIF(ALPHML.GT.1.8 .AND. ALPHML.LE.1.9)THEN
48004        TERM1=1.114
48005      ELSEIF(ALPHML.GT.1.9 .AND. ALPHML.LE.2.0)THEN
48006        TERM1=0.904
48007      ELSEIF(ALPHML.GT.2.0 .AND. ALPHML.LE.2.1)THEN
48008        TERM1=0.716
48009      ELSEIF(ALPHML.GT.2.1 .AND. ALPHML.LE.2.2)THEN
48010        TERM1=0.588
48011      ELSEIF(ALPHML.GT.2.2 .AND. ALPHML.LE.2.3)THEN
48012        TERM1=0.490
48013      ELSEIF(ALPHML.GT.2.3 .AND. ALPHML.LE.2.4)THEN
48014        TERM1=0.412
48015      ELSEIF(ALPHML.GT.2.4 .AND. ALPHML.LE.2.5)THEN
48016        TERM1=0.354
48017      ELSEIF(ALPHML.GT.2.5 .AND. ALPHML.LE.2.6)THEN
48018        TERM1=0.300
48019      ELSEIF(ALPHML.GT.2.6 .AND. ALPHML.LE.2.7)THEN
48020        TERM1=0.258
48021      ELSEIF(ALPHML.GT.2.7 .AND. ALPHML.LE.2.8)THEN
48022        TERM1=0.225
48023      ELSEIF(ALPHML.GT.2.8 .AND. ALPHML.LE.2.9)THEN
48024        TERM1=0.196
48025      ELSEIF(ALPHML.GT.2.9 .AND. ALPHML.LE.3.0)THEN
48026        TERM1=0.172
48027      ELSEIF(ALPHML.GT.3.0 .AND. ALPHML.LE.3.1)THEN
48028        TERM1=0.152
48029      ELSEIF(ALPHML.GT.3.1 .AND. ALPHML.LE.3.2)THEN
48030        TERM1=0.134
48031      ELSEIF(ALPHML.GT.3.2 .AND. ALPHML.LE.3.3)THEN
48032        TERM1=0.119
48033      ELSEIF(ALPHML.GT.3.3 .AND. ALPHML.LE.3.4)THEN
48034        TERM1=0.106
48035      ELSEIF(ALPHML.GT.3.4 .AND. ALPHML.LE.3.5)THEN
48036        TERM1=0.095
48037      ELSEIF(ALPHML.GT.3.5 .AND. ALPHML.LE.3.6)THEN
48038        TERM1=0.085
48039      ELSEIF(ALPHML.GT.3.6 .AND. ALPHML.LE.3.7)THEN
48040        TERM1=0.076
48041      ELSEIF(ALPHML.GT.3.7 .AND. ALPHML.LE.3.8)THEN
48042        TERM1=0.069
48043      ELSEIF(ALPHML.GT.3.8 .AND. ALPHML.LE.3.9)THEN
48044        TERM1=0.062
48045      ELSE
48046        TERM1=0.056
48047      ENDIF
48048      AMLVAR=1.0/(REAL(NTOTZZ)*TERM1)
48049C
48050      IF(IFLAG.EQ.2)THEN
48051C
48052C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
48053CCCCC   WRITE(ICOUT,999)
48054CCCCC   CALL DPWRST('XXX','BUG ')
48055CCCCC   WRITE(ICOUT,211)
48056CC211   FORMAT('***** WARNING FROM ZETA MAXIMUM LIKELIHOOD--')
48057CCCCC   CALL DPWRST('XXX','BUG ')
48058CCCCC   WRITE(ICOUT,213)
48059CC213   FORMAT('      ESTIMATE OF P MAY NOT BE COMPUTED TO DESIRED ',
48060CCCCC1         'TOLERANCE.')
48061CCCCC   CALL DPWRST('XXX','BUG ')
48062      ELSEIF(IFLAG.EQ.3)THEN
48063        WRITE(ICOUT,999)
48064        CALL DPWRST('XXX','BUG ')
48065        WRITE(ICOUT,121)
48066        CALL DPWRST('XXX','BUG ')
48067        WRITE(ICOUT,223)
48068  223   FORMAT('      ESTIMATE OF P MAY BE NEAR A SINGULAR POINT.')
48069        CALL DPWRST('XXX','BUG ')
48070      ELSEIF(IFLAG.EQ.4)THEN
48071        WRITE(ICOUT,999)
48072        CALL DPWRST('XXX','BUG ')
48073        WRITE(ICOUT,131)
48074        CALL DPWRST('XXX','BUG ')
48075        WRITE(ICOUT,233)
48076  233   FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
48077        CALL DPWRST('XXX','BUG ')
48078      ELSEIF(IFLAG.EQ.5)THEN
48079        WRITE(ICOUT,999)
48080        CALL DPWRST('XXX','BUG ')
48081        WRITE(ICOUT,121)
48082        CALL DPWRST('XXX','BUG ')
48083        WRITE(ICOUT,243)
48084  243   FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
48085        CALL DPWRST('XXX','BUG ')
48086      ENDIF
48087C
48088C
48089C               *********************************
48090C               **   STEP 42--                 **
48091C               **   WRITE OUT EVERYTHING      **
48092C               **   FOR ZETA MLE ESTIMATE     **
48093C               **********************************
48094C
48095      ISTEPN='42'
48096      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLZE')
48097     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
48098C
48099C     PRINT SUMMARY STATISTICS TABLE
48100C
48101      NUMDIG=7
48102      IF(IFORSW.EQ.'1')NUMDIG=1
48103      IF(IFORSW.EQ.'2')NUMDIG=2
48104      IF(IFORSW.EQ.'3')NUMDIG=3
48105      IF(IFORSW.EQ.'4')NUMDIG=4
48106      IF(IFORSW.EQ.'5')NUMDIG=5
48107      IF(IFORSW.EQ.'6')NUMDIG=6
48108      IF(IFORSW.EQ.'7')NUMDIG=7
48109      IF(IFORSW.EQ.'8')NUMDIG=8
48110      IF(IFORSW.EQ.'9')NUMDIG=9
48111      IF(IFORSW.EQ.'0')NUMDIG=0
48112      IF(IFORSW.EQ.'E')NUMDIG=-2
48113      IF(IFORSW.EQ.'-2')NUMDIG=-2
48114      IF(IFORSW.EQ.'-3')NUMDIG=-3
48115      IF(IFORSW.EQ.'-4')NUMDIG=-4
48116      IF(IFORSW.EQ.'-5')NUMDIG=-5
48117      IF(IFORSW.EQ.'-6')NUMDIG=-6
48118      IF(IFORSW.EQ.'-7')NUMDIG=-7
48119      IF(IFORSW.EQ.'-8')NUMDIG=-8
48120      IF(IFORSW.EQ.'-9')NUMDIG=-9
48121C
48122      ITITLE='Zeta Parameter Estimation'
48123      NCTITL=25
48124      ITITLZ=' '
48125      NCTITZ=0
48126C
48127      ICNT=1
48128      ITEXT(ICNT)='Summary Statistics:'
48129      NCTEXT(ICNT)=19
48130      AVALUE(ICNT)=0.0
48131      IDIGIT(ICNT)=-1
48132      ICNT=ICNT+1
48133      ITEXT(ICNT)='Number of Observations:'
48134      NCTEXT(ICNT)=23
48135      AVALUE(ICNT)=REAL(NTOTZZ)
48136      IDIGIT(ICNT)=0
48137      ICNT=ICNT+1
48138      ITEXT(ICNT)='Sample Mean:'
48139      NCTEXT(ICNT)=12
48140      AVALUE(ICNT)=XMEAN
48141      IDIGIT(ICNT)=NUMDIG
48142      ICNT=ICNT+1
48143      ITEXT(ICNT)='Sample Standard Deviation:'
48144      NCTEXT(ICNT)=26
48145      AVALUE(ICNT)=XSD
48146      IDIGIT(ICNT)=NUMDIG
48147      ICNT=ICNT+1
48148      ITEXT(ICNT)='Sample Minimum:'
48149      NCTEXT(ICNT)=15
48150      AVALUE(ICNT)=XMIN
48151      IDIGIT(ICNT)=NUMDIG
48152      ICNT=ICNT+1
48153      ITEXT(ICNT)='Sample Maximum:'
48154      NCTEXT(ICNT)=15
48155      AVALUE(ICNT)=XMAX
48156      IDIGIT(ICNT)=NUMDIG
48157      ICNT=ICNT+1
48158      ITEXT(ICNT)='Sample First Frequency:'
48159      NCTEXT(ICNT)=23
48160      AVALUE(ICNT)=F1
48161      IDIGIT(ICNT)=NUMDIG
48162      ICNT=ICNT+1
48163      ITEXT(ICNT)='Sample Second Frequency:'
48164      NCTEXT(ICNT)=24
48165      AVALUE(ICNT)=F2
48166      IDIGIT(ICNT)=NUMDIG
48167      ICNT=ICNT+1
48168      ITEXT(ICNT)=' '
48169      NCTEXT(ICNT)=0
48170      AVALUE(ICNT)=0.0
48171      IDIGIT(ICNT)=-1
48172C
48173      ICNT=ICNT+1
48174      ITEXT(ICNT)='Method of First Two Frequencies:'
48175      NCTEXT(ICNT)=32
48176      AVALUE(ICNT)=0.0
48177      IDIGIT(ICNT)=-1
48178      ICNT=ICNT+1
48179      ITEXT(ICNT)='Estimate of Alpha:'
48180      NCTEXT(ICNT)=18
48181      AVALUE(ICNT)=ALPHFR
48182      IDIGIT(ICNT)=NUMDIG
48183      ICNT=ICNT+1
48184      ITEXT(ICNT)='Approximate Standard Error of Alpha:'
48185      NCTEXT(ICNT)=36
48186      AVALUE(ICNT)=SQRT(AFRVAR)
48187      IDIGIT(ICNT)=NUMDIG
48188      ICNT=ICNT+1
48189      ITEXT(ICNT)=' '
48190      NCTEXT(ICNT)=0
48191      AVALUE(ICNT)=0.0
48192      IDIGIT(ICNT)=-1
48193C
48194      ICNT=ICNT+1
48195      ITEXT(ICNT)='Method of Moments:'
48196      NCTEXT(ICNT)=18
48197      AVALUE(ICNT)=0.0
48198      IDIGIT(ICNT)=-1
48199      ICNT=ICNT+1
48200      ITEXT(ICNT)='Estimate of Alpha:'
48201      NCTEXT(ICNT)=18
48202      AVALUE(ICNT)=ALPHMO
48203      IDIGIT(ICNT)=NUMDIG
48204      ICNT=ICNT+1
48205      ITEXT(ICNT)=' '
48206      NCTEXT(ICNT)=0
48207      AVALUE(ICNT)=0.0
48208      IDIGIT(ICNT)=-1
48209C
48210      ICNT=ICNT+1
48211      ITEXT(ICNT)='Method of Maximum Likelihood:'
48212      NCTEXT(ICNT)=29
48213      AVALUE(ICNT)=0.0
48214      IDIGIT(ICNT)=-1
48215      ICNT=ICNT+1
48216      ITEXT(ICNT)='Estimate of Alpha:'
48217      NCTEXT(ICNT)=18
48218      AVALUE(ICNT)=ALPHML
48219      IDIGIT(ICNT)=NUMDIG
48220      ICNT=ICNT+1
48221      ITEXT(ICNT)='Approximate Standard Error of Alpha:'
48222      NCTEXT(ICNT)=36
48223      AVALUE(ICNT)=SQRT(AMLVAR)
48224      IDIGIT(ICNT)=NUMDIG
48225      ICNT=ICNT+1
48226      ITEXT(ICNT)=' '
48227      NCTEXT(ICNT)=0
48228      AVALUE(ICNT)=0.0
48229      IDIGIT(ICNT)=-1
48230C
48231      NUMROW=ICNT
48232      DO2310I=1,NUMROW
48233        NTOT(I)=15
48234 2310 CONTINUE
48235C
48236      IFRST=.TRUE.
48237      ILAST=.TRUE.
48238      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
48239     1            AVALUE,IDIGIT,
48240     1            NTOT,NUMROW,
48241     1            ICAPSW,ICAPTY,ILAST,IFRST,
48242     1            ISUBRO,IBUGA3,IERROR)
48243C
48244C               *****************
48245C               **  STEP 90--  **
48246C               **  EXIT       **
48247C               *****************
48248C
48249 9000 CONTINUE
48250      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLZE')THEN
48251        WRITE(ICOUT,999)
48252        CALL DPWRST('XXX','WRIT')
48253        WRITE(ICOUT,9011)
48254 9011   FORMAT('***** AT THE END       OF DPMLZE--')
48255        CALL DPWRST('XXX','WRIT')
48256        WRITE(ICOUT,9012)IERROR
48257 9012   FORMAT('IERROR = ',A4)
48258        CALL DPWRST('XXX','WRIT')
48259      ENDIF
48260C
48261      RETURN
48262      END
48263