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
|
C Last change: BCM 29 Oct 97 7:18 am
**==qmap.f processed by SPAG 4.03F at 09:02 on 13 Sep 1994
SUBROUTINE qmap(Series,Stci,Stci2,Lfda,Llda,Ny,Ns,Ne,Nyrt)
IMPLICIT NONE
C*** Start of declarations inserted by SPAG
DOUBLE PRECISION Series,Stci,Stci2
INTEGER i,i1,i2,ii,ij,j,j1,j2,jy,k1,k2,k3,l,l1,l2,Lfda,Llda,n1,n2,
& n3
INTEGER n4,Ne,Ns,ntest,Ny,Nyrt,ny2
C*** End of declarations inserted by SPAG
DOUBLE PRECISION w,wq,wm1,wm2,tmp1,tmp2,r(186)
DIMENSION w(200),wm1(75),wm2(75),wq(50),Series(*),Stci(*),Stci2(*)
EQUIVALENCE(w(1),wq(1)),(w(51),wm1(1)),(w(126),wm2(1))
DATA wq/
& 0.3101014D0,-0.0745478D0,0.0179083D0,-0.0042489D0,0.0007868D0,
& 0.2860609D0,-0.0447286D0,0.0107450D0,-0.0025492D0,0.0004721D0,
& 0.2379797D0,0.0149095D0,-0.0035817D0,0.0008498D0,-0.0001575D0,
& 0.1658580D0,0.1043667D0,-0.0250716D0,0.0059485D0,-0.0011016D0,
& 0.0696957D0,0.2236430D0,-0.0537249D0,0.0127467D0,-0.0023605D0,
& 0.0033526D0,0.2818963D0,-0.0436963D0,0.0103673D0,-0.0019199D0,
& -0.0331716D0,0.2791267D0,0.0050143D0,-0.0011897D0,0.0002203D0,
& -0.0398767D0,0.2153340D0,0.0924069D0,-0.0219243D0,0.0040601D0,
& -0.0167627D0,0.0905184D0,0.2184814D0,-0.0518365D0,0.0095994D0,
& -0.0008120D0,0.0043849D0,0.2815186D0,-0.0430668D0,0.0079753D0/
DATA wm1/
& 0.1053950D0,-0.0279005D0,0.0073776D0,-0.0019194D0,0.0003807D0,
& 0.1044693D0,-0.0267298D0,0.0070680D0,-0.0018389D0,0.0003647D0,
& 0.1026180D0,-0.0243885D0,0.0064489D0,-0.0016778D0,0.0003327D0,
& 0.0998410D0,-0.0208766D0,0.0055203D0,-0.0014362D0,0.0002849D0,
& 0.0961383D0,-0.0161940D0,0.0042821D0,-0.0011141D0,0.0002210D0,
& 0.0915100D0,-0.0103407D0,0.0027344D0,-0.0007114D0,0.0001410D0,
& 0.0859560D0,-0.0033168D0,0.0008771D0,-0.0002282D0,0.0000453D0,
& 0.0794764D0,0.0048777D0,-0.0012898D0,0.0003356D0,-0.0000666D0,
& 0.0720711D0,0.0142429D0,-0.0037662D0,0.0009799D0,-0.0001943D0,
& 0.0637402D0,0.0247787D0,-0.0065521D0,0.0017046D0,-0.0003381D0,
& 0.0544835D0,0.0364852D0,-0.0096476D0,0.0025100D0,-0.0004978D0,
& 0.0443012D0,0.0493624D0,-0.0130527D0,0.0033959D0,-0.0006735D0,
& 0.0331933D0,0.0634102D0,-0.0167673D0,0.0043624D0,-0.0008652D0,
& 0.0232560D0,0.0750521D0,-0.0189211D0,0.0049227D0,-0.0009764D0,
& 0.0144893D0,0.0842882D0,-0.0195142D0,0.0050770D0,-0.0010070D0/
DATA wm2/
& 0.0068933D0,0.0911184D0,-0.0185466D0,0.0048253D0,-0.0009570D0,
& 0.0004679D0,0.0955427D0,-0.0160183D0,0.0041675D0,-0.0008267D0,
& -0.0047868D0,0.0975612D0,-0.0119292D0,0.0031037D0,-0.0006156D0,
& -0.0088708D0,0.0971739D0,-0.0062794D0,0.0016337D0,-0.0003240D0,
& -0.0117842D0,0.0943806D0,0.0009312D0,-0.0002423D0,0.0000480D0,
& -0.0135270D0,0.0891815D0,0.0097025D0,-0.0025243D0,0.0005007D0,
& -0.0140991D0,0.0815765D0,0.0200345D0,-0.0052124D0,0.0010338D0,
& -0.0135006D0,0.0715657D0,0.0319272D0,-0.0083065D0,0.0016475D0,
& -0.0117315D0,0.0591490D0,0.0453807D0,-0.0118068D0,0.0023417D0,
& -0.0087915D0,0.0443265D0,0.0603949D0,-0.0157130D0,0.0031165D0,
& -0.0061612D0,0.0310647D0,0.0729068D0,-0.0180586D0,0.0035816D0,
& -0.0038405D0,0.0193636D0,0.0829163D0,-0.0188434D0,0.0037373D0,
& -0.0018293D0,0.0092233D0,0.0904234D0,-0.0180674D0,0.0035834D0,
& -0.0001277D0,0.0006437D0,0.0954281D0,-0.0157308D0,0.0031200D0,
& 0.0012644D0,-0.0063752D0,0.0979305D0,-0.0118334D0,0.0023470D0/
Ns=Lfda
ntest=(Lfda-1)/Ny*Ny+Nyrt
IF(ntest.gt.Lfda)Ns=ntest
IF(ntest.lt.Lfda)Ns=ntest+Ny
ny2=Nyrt-1
IF(ny2.eq.0)ny2=Ny
Ne=(Llda/Ny*Ny)-(Ny-ny2)
IF((Llda-Ne).ge.Ny)Ne=Ne+Ny
n1=(Ns-1)/Ny+1
n2=Ne/Ny
DO i=n1,n2
n3=(i-1)*Ny+Nyrt
n4=i*Ny+(Nyrt-1)
r(i)=0.0D0
DO j=n3,n4
r(i)=r(i)+Series(j)-Stci(j)
END DO
END DO
jy=0
IF(Ny.eq.12)jy=50
k1=2*Ny
DO i=1,k1
i1=Ns+i-1
i2=Ne-i+1
tmp1=Stci(i1)
tmp2=Stci(i2)
ii=(i-1)*5+jy
DO j=1,5
j1=n1+j-1
j2=n2-j+1
ij=ii+j
tmp1=tmp1+r(j1)*w(ij)
tmp2=tmp2+r(j2)*w(ij)
END DO
Stci2(i1)=tmp1
Stci2(i2)=tmp2
END DO
l1=n1+2
l2=n2-2
DO l=l1,l2
k2=(l-1)*Ny+Nyrt
k3=k2+Ny/2-1
j1=l-2
j2=l+2
DO i=k2,k3
i2=2*k2+Ny-i-1
tmp1=Stci(i)
tmp2=Stci(i2)
ii=5*(i+k1-k2)+1+jy
DO j=j1,j2
ij=ii+j-j1
tmp1=tmp1+r(j)*w(ij)
tmp2=tmp2+r(j2+j1-j)*w(ij)
END DO
Stci2(i)=tmp1
Stci2(i2)=tmp2
END DO
END DO
RETURN
END
|
