40 MODULE PROCEDURE stat_averager, stat_averaged
55 MODULE PROCEDURE stat_variancer, stat_varianced
70 MODULE PROCEDURE stat_stddevr, stat_stddevd
90 MODULE PROCEDURE stat_linear_corrr, stat_linear_corrd
108 MODULE PROCEDURE stat_linear_regressionr, stat_linear_regressiond
122 MODULE PROCEDURE stat_percentiler, stat_percentiled
142 MODULE PROCEDURE stat_binr, stat_bind
161 MODULE PROCEDURE stat_mode_histogramr, stat_mode_histogramd
167 normalizeddensityindex
172 FUNCTION stat_averager(sample, mask, nomiss)
RESULT(average)
173 REAL,
INTENT(in) :: sample(:)
174 LOGICAL,
OPTIONAL,
INTENT(in) :: mask(:)
175 LOGICAL,
OPTIONAL,
INTENT(in) :: nomiss
179 INTEGER :: sample_count
180 LOGICAL :: sample_mask(SIZE(sample))
182 IF (optio_log(nomiss))
THEN 183 average = sum(sample)/
SIZE(sample)
185 sample_mask = (sample /= rmiss)
186 IF (
PRESENT(mask)) sample_mask = sample_mask .AND. mask
187 sample_count = count(sample_mask)
189 IF (sample_count > 0)
THEN 191 average = sum(sample, mask=sample_mask)/sample_count
197 END FUNCTION stat_averager
200 FUNCTION stat_averaged(sample, mask, nomiss)
RESULT(average)
201 DOUBLE PRECISION,
INTENT(in) :: sample(:)
202 LOGICAL,
OPTIONAL,
INTENT(in) :: mask(:)
203 LOGICAL,
OPTIONAL,
INTENT(in) :: nomiss
205 DOUBLE PRECISION :: average
207 INTEGER :: sample_count
208 LOGICAL :: sample_mask(SIZE(sample))
210 IF (optio_log(nomiss))
THEN 211 average = sum(sample)/
SIZE(sample)
213 sample_mask = (sample /= dmiss)
214 IF (
PRESENT(mask)) sample_mask = sample_mask .AND. mask
215 sample_count = count(sample_mask)
217 IF (sample_count > 0)
THEN 219 average = sum(sample, mask=sample_mask)/sample_count
225 END FUNCTION stat_averaged
228 FUNCTION stat_variancer(sample, average, mask, nomiss, nm1)
RESULT(variance)
229 REAL,
INTENT(in) :: sample(:)
230 REAL,
OPTIONAL,
INTENT(out) :: average
231 LOGICAL,
OPTIONAL,
INTENT(in) :: mask(:)
232 LOGICAL,
OPTIONAL,
INTENT(in) :: nomiss
233 LOGICAL,
OPTIONAL,
INTENT(in) :: nm1
238 INTEGER :: sample_count, i
239 LOGICAL :: sample_mask(SIZE(sample))
241 IF (optio_log(nomiss))
THEN 243 laverage = sum(sample)/
SIZE(sample)
244 IF (
PRESENT(average)) average = laverage
245 IF (optio_log(nm1))
THEN 246 variance = sum((sample-laverage)**2)/max(
SIZE(sample)-1,1)
248 variance = sum((sample-laverage)**2)/
SIZE(sample)
252 sample_mask = (sample /= rmiss)
253 IF (
PRESENT(mask)) sample_mask = sample_mask .AND. mask
254 sample_count = count(sample_mask)
256 IF (sample_count > 0)
THEN 258 laverage = sum(sample, mask=sample_mask)/sample_count
259 IF (
PRESENT(average)) average = laverage
262 DO i = 1,
SIZE(sample)
263 IF (sample_mask(i)) variance = variance + (sample(i)-laverage)**2
265 IF (optio_log(nm1))
THEN 266 variance = variance/max(sample_count-1,1)
268 variance = variance/sample_count
271 IF (
PRESENT(average)) average = rmiss
277 END FUNCTION stat_variancer
280 FUNCTION stat_varianced(sample, average, mask, nomiss, nm1)
RESULT(variance)
281 DOUBLE PRECISION,
INTENT(in) :: sample(:)
282 DOUBLE PRECISION,
OPTIONAL,
INTENT(out) :: average
283 LOGICAL,
OPTIONAL,
INTENT(in) :: mask(:)
284 LOGICAL,
OPTIONAL,
INTENT(in) :: nomiss
285 LOGICAL,
OPTIONAL,
INTENT(in) :: nm1
287 DOUBLE PRECISION :: variance
289 DOUBLE PRECISION :: laverage
290 INTEGER :: sample_count, i
291 LOGICAL :: sample_mask(SIZE(sample))
293 IF (optio_log(nomiss))
THEN 295 laverage = sum(sample)/
SIZE(sample)
296 IF (
PRESENT(average)) average = laverage
297 IF (optio_log(nm1))
THEN 298 variance = sum((sample-laverage)**2)/max(
SIZE(sample)-1,1)
300 variance = sum((sample-laverage)**2)/
SIZE(sample)
304 sample_mask = (sample /= dmiss)
305 IF (
PRESENT(mask)) sample_mask = sample_mask .AND. mask
306 sample_count = count(sample_mask)
308 IF (sample_count > 0)
THEN 310 laverage = sum(sample, mask=sample_mask)/sample_count
311 IF (
PRESENT(average)) average = laverage
314 DO i = 1,
SIZE(sample)
315 IF (sample_mask(i)) variance = variance + (sample(i)-laverage)**2
317 IF (optio_log(nm1))
THEN 318 variance = variance/max(sample_count-1,1)
320 variance = variance/sample_count
323 IF (
PRESENT(average)) average = dmiss
329 END FUNCTION stat_varianced
332 FUNCTION stat_stddevr(sample, average, mask, nomiss, nm1)
RESULT(stddev)
333 REAL,
INTENT(in) :: sample(:)
334 REAL,
OPTIONAL,
INTENT(out) :: average
335 LOGICAL,
OPTIONAL,
INTENT(in) :: mask(:)
336 LOGICAL,
OPTIONAL,
INTENT(in) :: nomiss
337 LOGICAL,
OPTIONAL,
INTENT(in) :: nm1
342 IF (
c_e(stddev)) stddev = sqrt(stddev)
344 END FUNCTION stat_stddevr
347 FUNCTION stat_stddevd(sample, average, mask, nomiss, nm1)
RESULT(stddev)
348 DOUBLE PRECISION,
INTENT(in) :: sample(:)
349 DOUBLE PRECISION,
OPTIONAL,
INTENT(out) :: average
350 LOGICAL,
OPTIONAL,
INTENT(in) :: mask(:)
351 LOGICAL,
OPTIONAL,
INTENT(in) :: nomiss
352 LOGICAL,
OPTIONAL,
INTENT(in) :: nm1
354 DOUBLE PRECISION :: stddev
357 IF (
c_e(stddev)) stddev = sqrt(stddev)
359 END FUNCTION stat_stddevd
362 FUNCTION stat_linear_corrr(sample1, sample2, average1, average2, &
363 variance1, variance2, mask, nomiss)
RESULT(linear_corr)
364 REAL,
INTENT(in) :: sample1(:)
365 REAL,
INTENT(in) :: sample2(:)
366 REAL,
OPTIONAL,
INTENT(out) :: average1
367 REAL,
OPTIONAL,
INTENT(out) :: average2
368 REAL,
OPTIONAL,
INTENT(out) :: variance1
369 REAL,
OPTIONAL,
INTENT(out) :: variance2
370 LOGICAL,
OPTIONAL,
INTENT(in) :: mask(:)
371 LOGICAL,
OPTIONAL,
INTENT(in) :: nomiss
375 REAL :: laverage1, laverage2, lvariance1, lvariance2
376 INTEGER :: sample_count, i
377 LOGICAL :: sample_mask(SIZE(sample1))
379 IF (
SIZE(sample1) /=
SIZE(sample2))
THEN 380 IF (
PRESENT(average1)) average1 = rmiss
381 IF (
PRESENT(average2)) average2 = rmiss
382 IF (
PRESENT(variance1)) variance1 = rmiss
383 IF (
PRESENT(variance2)) variance2 = rmiss
388 sample_mask = (sample1 /= rmiss .AND. sample2 /= rmiss)
389 IF (
PRESENT(mask)) sample_mask = sample_mask .AND. mask
390 sample_count = count(sample_mask)
391 IF (sample_count > 0)
THEN 393 laverage1 = sum(sample1, mask=sample_mask)/sample_count
394 laverage2 = sum(sample2, mask=sample_mask)/sample_count
395 IF (
PRESENT(average1)) average1 = laverage1
396 IF (
PRESENT(average2)) average2 = laverage2
400 DO i = 1,
SIZE(sample1)
401 IF (sample_mask(i))
THEN 402 lvariance1 = lvariance1 + (sample1(i)-laverage1)**2
403 lvariance2 = lvariance2 + (sample2(i)-laverage2)**2
406 lvariance1 = lvariance1/sample_count
407 lvariance2 = lvariance2/sample_count
408 IF (
PRESENT(variance1)) variance1 = lvariance1
409 IF (
PRESENT(variance2)) variance2 = lvariance2
412 DO i = 1,
SIZE(sample1)
413 IF (sample_mask(i)) linear_corr = linear_corr + &
414 (sample1(i)-laverage1)*(sample2(i)-laverage2)
416 linear_corr = linear_corr/sample_count / sqrt(lvariance1*lvariance2)
418 IF (
PRESENT(average1)) average1 = rmiss
419 IF (
PRESENT(average2)) average2 = rmiss
420 IF (
PRESENT(variance1)) variance1 = rmiss
421 IF (
PRESENT(variance2)) variance2 = rmiss
425 END FUNCTION stat_linear_corrr
428 FUNCTION stat_linear_corrd(sample1, sample2, average1, average2, &
429 variance1, variance2, mask, nomiss)
RESULT(linear_corr)
430 DOUBLE PRECISION,
INTENT(in) :: sample1(:)
431 DOUBLE PRECISION,
INTENT(in) :: sample2(:)
432 DOUBLE PRECISION,
OPTIONAL,
INTENT(out) :: average1
433 DOUBLE PRECISION,
OPTIONAL,
INTENT(out) :: average2
434 DOUBLE PRECISION,
OPTIONAL,
INTENT(out) :: variance1
435 DOUBLE PRECISION,
OPTIONAL,
INTENT(out) :: variance2
436 LOGICAL,
OPTIONAL,
INTENT(in) :: mask(:)
437 LOGICAL,
OPTIONAL,
INTENT(in) :: nomiss
439 DOUBLE PRECISION :: linear_corr
441 DOUBLE PRECISION :: laverage1, laverage2, lvariance1, lvariance2
442 INTEGER :: sample_count, i
443 LOGICAL :: sample_mask(SIZE(sample1))
445 IF (
SIZE(sample1) /=
SIZE(sample2))
THEN 446 IF (
PRESENT(average1)) average1 = dmiss
447 IF (
PRESENT(average2)) average2 = dmiss
448 IF (
PRESENT(variance1)) variance1 = dmiss
449 IF (
PRESENT(variance2)) variance2 = dmiss
454 sample_mask = (sample1 /= dmiss .AND. sample2 /= dmiss)
455 IF (
PRESENT(mask)) sample_mask = sample_mask .AND. mask
456 sample_count = count(sample_mask)
457 IF (sample_count > 0)
THEN 459 laverage1 = sum(sample1, mask=sample_mask)/sample_count
460 laverage2 = sum(sample2, mask=sample_mask)/sample_count
461 IF (
PRESENT(average1)) average1 = laverage1
462 IF (
PRESENT(average2)) average2 = laverage2
466 DO i = 1,
SIZE(sample1)
467 IF (sample_mask(i))
THEN 468 lvariance1 = lvariance1 + (sample1(i)-laverage1)**2
469 lvariance2 = lvariance2 + (sample2(i)-laverage2)**2
472 lvariance1 = lvariance1/sample_count
473 lvariance2 = lvariance2/sample_count
474 IF (
PRESENT(variance1)) variance1 = lvariance1
475 IF (
PRESENT(variance2)) variance2 = lvariance2
478 DO i = 1,
SIZE(sample1)
479 IF (sample_mask(i)) linear_corr = linear_corr + &
480 (sample1(i)-laverage1)*(sample2(i)-laverage2)
482 linear_corr = linear_corr/sample_count / sqrt(lvariance1*lvariance2)
484 IF (
PRESENT(average1)) average1 = dmiss
485 IF (
PRESENT(average2)) average2 = dmiss
486 IF (
PRESENT(variance1)) variance1 = dmiss
487 IF (
PRESENT(variance2)) variance2 = dmiss
491 END FUNCTION stat_linear_corrd
494 SUBROUTINE stat_linear_regressionr(sample1, sample2, alpha0, alpha1, mask)
495 REAL,
INTENT(in) :: sample1(:)
496 REAL,
INTENT(in) :: sample2(:)
497 REAL,
INTENT(out) :: alpha0
498 REAL,
INTENT(out) :: alpha1
499 LOGICAL,
OPTIONAL,
INTENT(in) :: mask(:)
501 REAL :: laverage1, laverage2
502 INTEGER :: sample_count
503 LOGICAL :: sample_mask(SIZE(sample1))
505 IF (
SIZE(sample1) /=
SIZE(sample2))
THEN 511 sample_mask = (sample1 /= rmiss .AND. sample2 /= rmiss)
512 IF (
PRESENT(mask)) sample_mask = sample_mask .AND. mask
513 sample_count = count(sample_mask)
515 IF (sample_count > 0)
THEN 516 laverage1 = sum(sample1, mask=sample_mask)/sample_count
517 laverage2 = sum(sample2, mask=sample_mask)/sample_count
518 alpha1 = sum((sample1-laverage1)*(sample2-laverage2), mask=sample_mask)/ &
519 sum((sample1-laverage1)**2, mask=sample_mask)
520 alpha0 = laverage1 - alpha1*laverage2
527 END SUBROUTINE stat_linear_regressionr
530 SUBROUTINE stat_linear_regressiond(sample1, sample2, alpha0, alpha1, mask)
531 DOUBLE PRECISION,
INTENT(in) :: sample1(:)
532 DOUBLE PRECISION,
INTENT(in) :: sample2(:)
533 DOUBLE PRECISION,
INTENT(out) :: alpha0
534 DOUBLE PRECISION,
INTENT(out) :: alpha1
535 LOGICAL,
OPTIONAL,
INTENT(in) :: mask(:)
537 DOUBLE PRECISION :: laverage1, laverage2
538 INTEGER :: sample_count
539 LOGICAL :: sample_mask(SIZE(sample1))
541 IF (
SIZE(sample1) /=
SIZE(sample2))
THEN 547 sample_mask = (sample1 /= dmiss .AND. sample2 /= dmiss)
548 IF (
PRESENT(mask)) sample_mask = sample_mask .AND. mask
549 sample_count = count(sample_mask)
551 IF (sample_count > 0)
THEN 552 laverage1 = sum(sample1, mask=sample_mask)/sample_count
553 laverage2 = sum(sample2, mask=sample_mask)/sample_count
554 alpha1 = sum((sample1-laverage1)*(sample2-laverage2), mask=sample_mask)/ &
555 sum((sample1-laverage1)**2, mask=sample_mask)
556 alpha0 = laverage1 - alpha1*laverage2
563 END SUBROUTINE stat_linear_regressiond
566 FUNCTION stat_percentiler(sample, perc_vals, mask, nomiss)
RESULT(percentile)
567 REAL,
INTENT(in) :: sample(:)
568 REAL,
INTENT(in) :: perc_vals(:)
569 LOGICAL,
OPTIONAL,
INTENT(in) :: mask(:)
570 LOGICAL,
OPTIONAL,
INTENT(in) :: nomiss
571 REAL :: percentile(SIZE(perc_vals))
573 REAL :: lsample(SIZE(sample)), rindex
574 INTEGER :: sample_count, j, iindex
575 LOGICAL :: sample_mask(SIZE(sample))
577 percentile(:) = rmiss
578 IF (.NOT.optio_log(nomiss))
THEN 579 sample_mask =
c_e(sample)
580 IF (
PRESENT(mask)) sample_mask = sample_mask .AND. mask
581 sample_count = count(sample_mask)
582 IF (sample_count == 0)
RETURN 584 sample_count =
SIZE(sample)
587 IF (sample_count ==
SIZE(sample))
THEN 590 lsample(1:sample_count) = pack(sample, mask=sample_mask)
593 IF (sample_count == 1)
THEN 594 percentile(:) = lsample(1)
600 CALL sort(lsample(1:sample_count))
612 DO j = 1,
SIZE(perc_vals)
613 IF (perc_vals(j) >= 0. .AND. perc_vals(j) <= 100.)
THEN 615 rindex =
REAL(sample_count-1, kind=kind(rindex))*perc_vals(j)/100.+1.
617 iindex = min(max(int(rindex), 1), sample_count-1)
620 percentile(j) = lsample(iindex)*(
REAL(iindex+1, kind=kind(rindex))-rindex) &
621 + lsample(iindex+1)*(rindex-
REAL(iindex, kind=kind(rindex)))
626 END FUNCTION stat_percentiler
629 FUNCTION stat_percentiled(sample, perc_vals, mask, nomiss)
RESULT(percentile)
630 DOUBLE PRECISION,
INTENT(in) :: sample(:)
631 DOUBLE PRECISION,
INTENT(in) :: perc_vals(:)
632 LOGICAL,
OPTIONAL,
INTENT(in) :: mask(:)
633 LOGICAL,
OPTIONAL,
INTENT(in) :: nomiss
634 DOUBLE PRECISION :: percentile(SIZE(perc_vals))
636 DOUBLE PRECISION :: lsample(SIZE(sample)), rindex
637 INTEGER :: sample_count, j, iindex
638 LOGICAL :: sample_mask(SIZE(sample))
641 percentile(:) = dmiss
642 IF (.NOT.optio_log(nomiss))
THEN 643 sample_mask = (sample /= dmiss)
644 IF (
PRESENT(mask)) sample_mask = sample_mask .AND. mask
645 sample_count = count(sample_mask)
646 IF (sample_count == 0)
RETURN 648 sample_count =
SIZE(sample)
651 IF (sample_count ==
SIZE(sample))
THEN 654 lsample(1:sample_count) = pack(sample, mask=sample_mask)
657 IF (sample_count == 1)
THEN 658 percentile(:) = lsample(1)
663 CALL sort(lsample(1:sample_count))
675 DO j = 1,
SIZE(perc_vals)
676 IF (perc_vals(j) >= 0.d0 .AND. perc_vals(j) <= 100.d0)
THEN 678 rindex =
REAL(sample_count-1, kind=kind(rindex))*perc_vals(j)/100.d0+1.d0
680 iindex = min(max(int(rindex), 1), sample_count-1)
682 percentile(j) = lsample(iindex)*(
REAL(iindex+1, kind=kind(rindex))-rindex) &
683 + lsample(iindex+1)*(rindex-
REAL(iindex, kind=kind(rindex)))
687 END FUNCTION stat_percentiled
690 SUBROUTINE stat_binr(sample, bin, nbin, start, finish, mask, binbounds)
691 REAL,
INTENT(in) :: sample(:)
692 INTEGER,
INTENT(out),
ALLOCATABLE :: bin(:)
693 INTEGER,
INTENT(in) :: nbin
694 REAL,
INTENT(in),
OPTIONAL :: start
695 REAL,
INTENT(in),
OPTIONAL :: finish
696 LOGICAL,
INTENT(in),
OPTIONAL :: mask(:)
697 REAL,
INTENT(out),
ALLOCATABLE,
OPTIONAL :: binbounds(:)
700 REAL :: lstart, lfinish, incr
701 REAL,
ALLOCATABLE :: lbinbounds(:)
702 LOGICAL :: lmask(SIZE(sample))
706 IF (
PRESENT(mask))
THEN 711 lmask = lmask .AND.
c_e(sample)
712 IF (count(lmask) < 1)
RETURN 714 lstart = optio_r(start)
715 IF (.NOT.
c_e(lstart)) lstart = minval(sample, mask=lmask)
716 lfinish = optio_r(finish)
717 IF (.NOT.
c_e(lfinish)) lfinish = maxval(sample, mask=lmask)
718 IF (lfinish <= lstart)
RETURN 720 incr = (lfinish-lstart)/nbin
723 ALLOCATE(lbinbounds(nbin+1))
726 lbinbounds(i) = lstart + (i-1)*incr
728 lbinbounds(nbin+1) = lfinish
731 bin(i) = count(sample >= lbinbounds(i) .AND. sample < lbinbounds(i+1) .AND. lmask)
734 bin(nbin) = count(sample >= lbinbounds(nbin) .AND. sample <= lbinbounds(nbin+1) .AND. lmask)
737 IF (
PRESENT(binbounds)) binbounds = lbinbounds
739 END SUBROUTINE stat_binr
743 SUBROUTINE stat_binr2(sample, bin, nbin, start, finish, mask, binbounds)
744 REAL,
INTENT(in) :: sample(:)
745 INTEGER,
INTENT(out),
ALLOCATABLE :: bin(:)
746 INTEGER,
INTENT(in) :: nbin
747 REAL,
INTENT(in),
OPTIONAL :: start
748 REAL,
INTENT(in),
OPTIONAL :: finish
749 LOGICAL,
INTENT(in),
OPTIONAL :: mask(:)
750 REAL,
INTENT(out),
ALLOCATABLE,
OPTIONAL :: binbounds(:)
753 REAL :: lstart, lfinish, incr
754 LOGICAL :: lmask(SIZE(sample))
758 IF (
PRESENT(mask))
THEN 763 lmask = lmask .AND.
c_e(sample)
764 IF (count(lmask) < 1)
RETURN 766 lstart = optio_r(start)
767 IF (.NOT.
c_e(lstart)) lstart = minval(sample, mask=
c_e(sample))
768 lfinish = optio_r(finish)
769 IF (.NOT.
c_e(lfinish)) lfinish = maxval(sample, mask=
c_e(sample))
770 IF (lfinish <= lstart)
RETURN 772 incr = (lfinish-lstart)/nbin
777 DO i = 1,
SIZE(sample)
779 ind = int((sample(i)-lstart)/incr) + 1
780 IF (ind > 0 .AND. ind <= nbin)
THEN 781 bin(ind) = bin(ind) + 1
783 IF (sample(i) == finish) bin(nbin) = bin(nbin) + 1
788 IF (
PRESENT(binbounds))
THEN 789 ALLOCATE(binbounds(nbin+1))
791 binbounds(i) = lstart + (i-1)*incr
793 binbounds(nbin+1) = lfinish
796 END SUBROUTINE stat_binr2
799 SUBROUTINE stat_bind(sample, bin, nbin, start, finish, mask, binbounds)
800 DOUBLE PRECISION,
INTENT(in) :: sample(:)
801 INTEGER,
INTENT(out),
ALLOCATABLE :: bin(:)
802 INTEGER,
INTENT(in) :: nbin
803 DOUBLE PRECISION,
INTENT(in),
OPTIONAL :: start
804 DOUBLE PRECISION,
INTENT(in),
OPTIONAL :: finish
805 LOGICAL,
INTENT(in),
OPTIONAL :: mask(:)
806 DOUBLE PRECISION,
INTENT(out),
ALLOCATABLE,
OPTIONAL :: binbounds(:)
809 DOUBLE PRECISION :: lstart, lfinish, incr
810 DOUBLE PRECISION,
ALLOCATABLE :: lbinbounds(:)
811 LOGICAL :: lmask(SIZE(sample))
815 IF (
PRESENT(mask))
THEN 820 lmask = lmask .AND.
c_e(sample)
821 IF (count(lmask) < 1)
RETURN 823 lstart = optio_d(start)
824 IF (.NOT.
c_e(lstart)) lstart = minval(sample, mask=lmask)
825 lfinish = optio_d(finish)
826 IF (.NOT.
c_e(lfinish)) lfinish = maxval(sample, mask=lmask)
827 IF (lfinish <= lstart)
RETURN 829 incr = (lfinish-lstart)/nbin
832 ALLOCATE(lbinbounds(nbin+1))
835 lbinbounds(i) = lstart + (i-1)*incr
837 lbinbounds(nbin+1) = lfinish
840 bin(i) = count(sample >= lbinbounds(i) .AND. sample < lbinbounds(i+1) .AND. lmask)
843 bin(nbin) = count(sample >= lbinbounds(nbin) .AND. sample <= lbinbounds(nbin+1) .AND. lmask)
846 IF (
PRESENT(binbounds)) binbounds = lbinbounds
848 END SUBROUTINE stat_bind
851 FUNCTION stat_mode_histogramr(sample, nbin, start, finish, mask)
RESULT(mode)
852 REAL,
INTENT(in) :: sample(:)
853 INTEGER,
INTENT(in) :: nbin
854 REAL,
INTENT(in),
OPTIONAL :: start
855 REAL,
INTENT(in),
OPTIONAL :: finish
856 LOGICAL,
INTENT(in),
OPTIONAL :: mask(:)
861 INTEGER,
ALLOCATABLE :: bin(:)
862 REAL,
ALLOCATABLE :: binbounds(:)
864 CALL stat_bin(sample, bin, nbin, start, finish, mask, binbounds)
866 IF (
ALLOCATED(bin))
THEN 868 mode = (binbounds(loc(1)) + binbounds(loc(1)+1))*0.5
871 END FUNCTION stat_mode_histogramr
874 FUNCTION stat_mode_histogramd(sample, nbin, start, finish, mask)
RESULT(mode)
875 DOUBLE PRECISION,
INTENT(in) :: sample(:)
876 INTEGER,
INTENT(in) :: nbin
877 DOUBLE PRECISION,
INTENT(in),
OPTIONAL :: start
878 DOUBLE PRECISION,
INTENT(in),
OPTIONAL :: finish
879 LOGICAL,
INTENT(in),
OPTIONAL :: mask(:)
881 DOUBLE PRECISION :: mode
884 INTEGER,
ALLOCATABLE :: bin(:)
885 DOUBLE PRECISION,
ALLOCATABLE :: binbounds(:)
887 CALL stat_bin(sample, bin, nbin, start, finish, mask, binbounds)
889 IF (
ALLOCATED(bin))
THEN 891 mode = (binbounds(loc(1)) + binbounds(loc(1)+1))*0.5d0
894 END FUNCTION stat_mode_histogramd
1290 subroutine densityindex(di,nlimbins,occu,rnum,limbins)
1291 real,
intent(out) :: di(:)
1292 real,
intent(out) :: nlimbins(:)
1293 integer,
intent(out) :: occu(:)
1294 REAL,
DIMENSION(:),
INTENT(IN) :: rnum
1295 real,
intent(in) :: limbins(:)
1297 real :: nnum(size(rnum))
1298 integer :: i,k,sample_count
1299 logical :: sample_mask(size(rnum))
1305 nlimbins(1)=limbins(1)
1307 do i=2,
size(limbins)
1308 if (limbins(i) /= limbins(k))
then 1310 nlimbins(k)= limbins(i)
1317 sample_mask = (rnum /= rmiss)
1318 sample_count = count(sample_mask)
1319 IF (sample_count == 0)
RETURN 1320 nnum(1:sample_count) = pack(rnum, mask=sample_mask)
1323 occu(i)=count(nnum>=nlimbins(i) .and. nnum<nlimbins(i+1))
1324 di(i) = float(occu(i)) / (nlimbins(i+1) - nlimbins(i))
1328 occu(i)=count(nnum>=nlimbins(i) .and. nnum<=nlimbins(i+1))
1329 di(i) = float(occu(i)) / (nlimbins(i+1) - nlimbins(i))
1331 end subroutine densityindex
1335 SUBROUTINE normalizeddensityindex(rnum, perc_vals, ndi, nlimbins)
1337 REAL,
DIMENSION(:),
INTENT(IN) :: rnum
1338 REAL,
DIMENSION(:),
INTENT(IN) :: perc_vals
1339 REAL,
DIMENSION(:),
INTENT(OUT) :: ndi
1340 REAL,
DIMENSION(:),
INTENT(OUT) :: nlimbins
1342 REAL,
DIMENSION(size(ndi)) :: di
1343 INTEGER,
DIMENSION(size(ndi)) :: occu
1344 REAL,
DIMENSION(size(nlimbins)) :: limbins
1346 integer :: i,k,middle
1351 call densityindex(di,nlimbins,occu,rnum,limbins)
1355 middle=count(
c_e(rnum))/2
1357 do i=1,count(
c_e(occu))
1359 if (k > middle)
then 1360 if (k > 1 .and. (k - occu(i)) == middle)
then 1361 med = (di(i-1) + di(i)) / 2.
1370 ndi(:count(
c_e(di))) = min(pack(di,mask=
c_e(di))/med,1.0)
1372 END SUBROUTINE normalizeddensityindex
Function to check whether a value is missing or not.
Compute the average of the random variable provided, taking into account missing data.
Bin a sample into equally spaced intervals to form a histogram.
Compute the mode of the random variable provided taking into account missing data.
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.
Compute a set of percentiles for a random variable.
Compute the standard deviation of the random variable provided, taking into account missing data...
Compute the linear regression coefficients between the two random variables provided, taking into account missing data.
Compute the variance of the random variable provided, taking into account missing data...
This module defines usefull general purpose function and subroutine.
Definitions of constants and functions for working with missing values.
Module for basic statistical computations taking into account missing data.
Compute the linear correlation coefficient between the two random variables provided, taking into account missing data.