1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
C Last change: SRD 25 Jan 100 2:59 pm
* SUBROUTINE prothd(Begtst,Endtst,Ltstao,Ltstls,Ltsttc,Ltstso,Ladd1,
* & Critvl)
SUBROUTINE prothd(Begtst,Endtst,Ltstao,Ltstls,Ltsttc,Ladd1,Critvl)
IMPLICIT NONE
c-----------------------------------------------------------------------
c Print outlier identification header
c-----------------------------------------------------------------------
INCLUDE 'srslen.prm'
INCLUDE 'model.prm'
INCLUDE 'model.cmn'
INCLUDE 'mdldat.cmn'
INCLUDE 'units.cmn'
INCLUDE 'error.cmn'
c ------------------------------------------------------------------
LOGICAL F
PARAMETER(F=.false.)
c ------------------------------------------------------------------
* LOGICAL Ladd1,Ltstao,Ltstls,Ltsttc,Ltstso
LOGICAL Ladd1,Ltstao,Ltstls,Ltsttc
INTEGER Begtst,Endtst,idate,itmp,itmp2
DOUBLE PRECISION Critvl
DIMENSION Begtst(2),Endtst(2),idate(2),Critvl(POTLR)
c ------------------------------------------------------------------
* CHARACTER OTTDIC*143,outstr*19
CHARACTER OTTDIC*57,outstr*19
INTEGER ottind,ottptr,POTT,nstr
* PARAMETER(POTT=15)
PARAMETER(POTT=7)
DIMENSION ottptr(0:POTT)
* PARAMETER(OTTDIC='AO onlyLS onlyAO and LSTC onlyAO and TCLS and TC
* &AO, LS and TCSO onlyAO and SOLS and SOAO, LS and TCTC and SOAO, TC
* & and SOLS, TC and SOAll types')
* DATA ottptr/1,8,15,24,31,40,49,62,69,78,87,100,109,122,135,144/
PARAMETER(OTTDIC=
& 'AO onlyLS onlyAO and LSTC onlyAO and TCLS and TCAll types')
DATA ottptr/1,8,15,24,31,40,49,58/
c ------------------------------------------------------------------
CALL dfdate(Begtst,Begspn,Sp,itmp)
itmp=max(itmp,0)
CALL addate(Begspn,Sp,itmp,idate)
CALL dfdate(Endtst,idate,Sp,itmp2)
IF(Ltstao)itmp2=itmp2+1
itmp=min(itmp2,Nspobs-itmp)
CALL prtshd('OUTLIER DETECTION',idate,Sp,itmp,F)
IF(Lfatal)RETURN
c ------------------------------------------------------------------
IF(itmp.le.1)Ltstls=F
IF(itmp.le.0)THEN
Ltstao=F
Ltsttc=F
* Ltstso=F
END IF
c ------------------------------------------------------------------
ottind=0
IF(Ltstao)ottind=ottind+1
IF(Ltstls)ottind=ottind+2
IF(Ltsttc)ottind=ottind+4
* IF(Ltstso)ottind=ottind+8
CALL getstr(OTTDIC,ottptr,POTT,ottind,outstr,nstr)
WRITE(Mt1,1010)outstr(1:nstr)
1010 FORMAT(' Types ',a)
c ------------------------------------------------------------------
IF(Ladd1)THEN
WRITE(Mt1,1020)'add one'
1020 FORMAT(' Method ',a)
ELSE
WRITE(Mt1,1020)'add all'
END IF
c ------------------------------------------------------------------
IF(Ltstao)WRITE(Mt1,1030)'AO',Critvl(AO)
IF(Ltstls)WRITE(Mt1,1030)'LS',Critvl(LS)
IF(Ltsttc)WRITE(Mt1,1030)'TC',Critvl(TC)
* IF(Ltstso)WRITE(Mt1,1030)'SO',Critvl(SO)
1030 FORMAT(' Critical |t| for ',a,' outliers ',f12.2)
c ------------------------------------------------------------------
RETURN
END
|
