File: pass0.f

package info (click to toggle)
x13as 1.1-b59-1
  • links: PTS, VCS
  • area: non-free
  • in suites: bookworm
  • size: 9,088 kB
  • sloc: fortran: 114,121; makefile: 14
file content (171 lines) | stat: -rw-r--r-- 7,566 bytes parent folder | download | duplicates (3)
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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
      SUBROUTINE pass0(Trnsrs,Frstry,Isig,Istep,Lprt)
      IMPLICIT NONE
c-----------------------------------------------------------------------
c     Check trading day, easter, constant regressors of final model
c     to see if they are significant.
c-----------------------------------------------------------------------
      LOGICAL T,F
      PARAMETER(T=.true.,F=.false.)
c-----------------------------------------------------------------------
      INCLUDE 'srslen.prm'
      INCLUDE 'model.prm'
      INCLUDE 'model.cmn'
      INCLUDE 'picktd.cmn'
      INCLUDE 'arima.cmn'
      INCLUDE 'prior.prm'
      INCLUDE 'prior.cmn'
      INCLUDE 'extend.cmn'
      INCLUDE 'units.cmn'
      INCLUDE 'error.cmn'
c     ------------------------------------------------------------------
      DOUBLE PRECISION Trnsrs,tval,cval,tderiv
      INTEGER ktd,keastr,kmu,begcol,endcol,igrp,Isig,nsig,icol,Frstry,
     &        Istep
      DIMENSION Trnsrs(PLEN),tval(PB)
c     ------------------------------------------------------------------
      INTEGER strinx
      DOUBLE PRECISION tstdrv
      LOGICAL dpeq,Lprt
      EXTERNAL strinx,tstdrv,dpeq
c-----------------------------------------------------------------------
      ktd=strinx(F,Grpttl,Grpptr,1,Ngrptl,'Trading Day')
      IF(ktd.eq.0.and.(Itdtst.eq.1.or.Itdtst.eq.4.or.Itdtst.eq.5))
     &   ktd=strinx(F,Grpttl,Grpptr,1,Ngrptl,
     &              '1-Coefficient Trading Day')
      IF(ktd.eq.0.and.Itdtst.eq.3)
     &   ktd=strinx(T,Grpttl,Grpptr,1,Ngrptl,'Stock Trading Day')
      IF(ktd.eq.0.and.Itdtst.eq.6)
     &   ktd=strinx(T,Grpttl,Grpptr,1,Ngrptl,
     &              '1-Coefficient Stock Trading Day')
c-----------------------------------------------------------------------
      keastr=strinx(T,Grpttl,Grpptr,1,Ngrptl,'Easter')
      IF(keastr.eq.0)
     &   keastr=strinx(T,Grpttl,Grpptr,1,Ngrptl,'StatCanEaster')
      IF(keastr.eq.0)
     &   keastr=strinx(T,Grpttl,Grpptr,1,Ngrptl,'StockEaster')
c-----------------------------------------------------------------------
      kmu=strinx(F,Grpttl,Grpptr,1,Ngrptl,'Constant')
      IF(ktd.eq.0.and.keastr.eq.0.and.kmu.eq.0)RETURN
c-----------------------------------------------------------------------
c     compute t-statistics for regressors
c-----------------------------------------------------------------------
      CALL genrtt(tval)
      cval=1.96D0
c-----------------------------------------------------------------------
c     If trading day, check the t-statistics to see if there are
c     any significant trading day regressors
c-----------------------------------------------------------------------
      IF(ktd.gt.0.and.Itdtst.gt.0)THEN
       nsig=0
       DO igrp=Ngrp,1,-1
        begcol=Grp(igrp-1)
        endcol=Grp(igrp)-1
        IF(Rgvrtp(begcol).eq.PRGTST.or.Rgvrtp(begcol).eq.PRGTTD.or.
     &     Rgvrtp(begcol).eq.PRRTST.or.Rgvrtp(begcol).eq.PRRTTD.or.
     &     Rgvrtp(begcol).eq.PRATST.or.Rgvrtp(begcol).eq.PRATTD.or.
     &     Rgvrtp(begcol).eq.PRGTLM.or.Rgvrtp(begcol).eq.PRGTLQ.or.
     &     Rgvrtp(begcol).eq.PRGTLY.or.Rgvrtp(begcol).eq.PRGTSL.or.
     &     Rgvrtp(begcol).eq.PRRTLM.or.Rgvrtp(begcol).eq.PRRTLQ.or.
     &     Rgvrtp(begcol).eq.PRRTLY.or.Rgvrtp(begcol).eq.PRRTSL.or.
     &     Rgvrtp(begcol).eq.PRATLM.or.Rgvrtp(begcol).eq.PRATLQ.or.
     &     Rgvrtp(begcol).eq.PRATLY.or.Rgvrtp(begcol).eq.PRATSL.or.
     &     Rgvrtp(begcol).eq.PRG1TD.or.Rgvrtp(begcol).eq.PRR1TD.or.
     &     Rgvrtp(begcol).eq.PRA1TD.or.Rgvrtp(begcol).eq.PRG1ST.or.
     &     Rgvrtp(begcol).eq.PRR1ST.or.Rgvrtp(begcol).eq.PRA1ST.or.
     &     Rgvrtp(begcol).eq.PRGUTD.or.Rgvrtp(begcol).eq.PRGULM.or.
     &     Rgvrtp(begcol).eq.PRGULQ.or.Rgvrtp(begcol).eq.PRGULY)THEN
         DO icol=begcol,endcol
          IF(DABS(tval(icol)).ge.cval)nsig=nsig+1
         END DO
        END IF
       END DO
       IF(nsig.lt.1)THEN
        tderiv=tstdrv(ktd)
        if (DABS(tderiv).lt.cval) ktd=-ktd
       END IF
      END IF
      IF(keastr.gt.0.and.Leastr)THEN
       nsig=0
       begcol=Grp(keastr-1)
       endcol=Grp(keastr)-1
       DO icol=begcol,endcol
        IF(DABS(tval(icol)).ge.cval)nsig=nsig+1
       END DO
       IF(nsig.lt.1)keastr=-keastr
      END IF
      IF(Istep.eq.1)cval=Tsig
      IF(kmu.gt.0.and.Lchkmu)THEN
       begcol=Grp(kmu-1)
       IF(DABS(tval(begcol)).lt.cval)kmu=-kmu
      END IF
      IF(ktd.lt.0)THEN
       DO igrp=Ngrp,1,-1
        begcol=Grp(igrp-1)
        endcol=Grp(igrp)-1
        IF(Rgvrtp(begcol).eq.PRGTST.or.Rgvrtp(begcol).eq.PRGTTD.or.
     &     Rgvrtp(begcol).eq.PRRTST.or.Rgvrtp(begcol).eq.PRRTTD.or.
     &     Rgvrtp(begcol).eq.PRATST.or.Rgvrtp(begcol).eq.PRATTD.or.
     &     Rgvrtp(begcol).eq.PRGTLM.or.Rgvrtp(begcol).eq.PRGTLQ.or.
     &     Rgvrtp(begcol).eq.PRGTLY.or.Rgvrtp(begcol).eq.PRGTSL.or.
     &     Rgvrtp(begcol).eq.PRRTLM.or.Rgvrtp(begcol).eq.PRRTLQ.or.
     &     Rgvrtp(begcol).eq.PRRTLY.or.Rgvrtp(begcol).eq.PRRTSL.or.
     &     Rgvrtp(begcol).eq.PRATLM.or.Rgvrtp(begcol).eq.PRATLQ.or.
     &     Rgvrtp(begcol).eq.PRATLY.or.Rgvrtp(begcol).eq.PRATSL.or.
     &     Rgvrtp(begcol).eq.PRG1TD.or.Rgvrtp(begcol).eq.PRR1TD.or.
     &     Rgvrtp(begcol).eq.PRA1TD.or.Rgvrtp(begcol).eq.PRG1ST.or.
     &     Rgvrtp(begcol).eq.PRR1ST.or.Rgvrtp(begcol).eq.PRA1ST.or.
     &     Rgvrtp(begcol).eq.PRGUTD.or.Rgvrtp(begcol).eq.PRGULM.or.
     &     Rgvrtp(begcol).eq.PRGULQ.or.Rgvrtp(begcol).eq.PRGULY)THEN
         CALL dlrgef(begcol,Nrxy,endcol-begcol+1)
         IF(Lfatal)RETURN
        END IF
       END DO
       Isig=Isig+1
       IF(Lprt)WRITE(Mt1,1010)'trading day'
       Aicint=0
c-----------------------------------------------------------------------
c   If leap year or other prior adjustment done with trading day,
c   remove effect of prior adjustment from series
c-----------------------------------------------------------------------
       IF(Picktd)THEN
        Picktd=.false.
        IF(.not.(Fcntyp.eq.4.OR.dpeq(Lam,1D0)))THEN
         CALL rmlpyr(Trnsrs,Nobspf)
         IF(Lfatal)RETURN
        END IF
       END IF
c-----------------------------------------------------------------------
      END IF
      IF(keastr.lt.0)THEN
       igrp=strinx(T,Grpttl,Grpptr,1,Ngrptl,'Easter')
       IF(igrp.eq.0)
     &    igrp=strinx(T,Grpttl,Grpptr,1,Ngrptl,'StatCanEaster')
       IF(igrp.eq.0)
     &    igrp=strinx(T,Grpttl,Grpptr,1,Ngrptl,'StockEaster')
       begcol=Grp(igrp-1)
       endcol=Grp(igrp)-1
       CALL dlrgef(begcol,Nrxy,endcol-begcol+1)
       IF(Lfatal)RETURN
       Isig=Isig+1
       IF(Lprt)WRITE(Mt1,1010)'Easter'
       Aicind=0
      END IF
      IF(kmu.lt.0)THEN
       igrp=strinx(F,Grpttl,Grpptr,1,Ngrptl,'Constant')
       begcol=Grp(igrp-1)
       CALL dlrgef(begcol,Nrxy,1)
       IF(Lfatal)RETURN
       Isig=Isig+1
       IF(Lprt)WRITE(Mt1,1010)'constant'
      END IF
c     ------------------------------------------------------------------
c	If regressors have been deleted, regenerate regression matrix
c     ------------------------------------------------------------------
      IF(Isig.gt.0)
     &   CALL regvar(Trnsrs,Nobspf,Fctdrp,Nfcst,0,Userx,Bgusrx,Nrusrx,
     &               Priadj,Reglom,Nrxy,Begxy,Frstry,T,Elong)
c-----------------------------------------------------------------------
 1010 FORMAT(5x,'Deleted ',a,' regressor(s) due to insignificant ',
     &          't-value.')
      RETURN
      END