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
81
82
83
84#include "implicit_f.inc"
85
86
87
88 INTEGER IDX, IDY, IDZ, NCTRL, PX, PY, PZ,
89 . ITEL, N, BOOLG,IDX2, IDY2, IDZ2
91 . gaussx, gaussy, gaussz,
92 . r(*),xxi(*),yyi(*),zzi(*),
93 . wwi(*),kx(*), ky(*), kz(*), knotlocx(px+2,nctrl),
94 . knotlocy(py+2,nctrl),knotlocz(pz+2,nctrl),knotlocelx(2),
95 . knotlocely(2),knotlocelz(2)
96
97
98
99 INTEGER NUMLOC, I, J, K, NA, NB, NC
101 . sumtot, fn(nctrl), fm(nctrl),
102 . fl(nctrl),xi(3)
103
104
105
106
107 IF (boolg == 1) THEN
108
109 xi(1) = ((knotlocelx(2)-knotlocelx(1))*gaussx + (knotlocelx(2)+(knotlocelx(1))))/two
110 xi(2) = ((knotlocely(2)-knotlocely(1))*gaussy + (knotlocely(2)+(knotlocely(1))))/two
111 xi(3) = ((knotlocelz(2)-knotlocelz(1))*gaussz + (knotlocelz(2)+(knotlocelz(1))))/two
112
113
114
115 ELSE
116 xi(1) = gaussx
117 xi(2) = gaussy
118 xi(3) = gaussz
119 ENDIF
120
121
122
123
124
125
126
127
128
129 numloc = 0
130 DO k=1,pz+1
131 DO j=1,py+1
132 DO i=1,px+1
133 numloc = numloc+1
134 CALL onebasisfun(i, 1, px, xi(1), knotlocx(:,numloc), fn(numloc))
135 CALL onebasisfun(j, 1, py, xi(2), knotlocy(:,numloc), fm(numloc))
136 CALL onebasisfun(k, 1, pz, xi(3), knotlocz(:,numloc), fl(numloc))
137 ENDDO
138 ENDDO
139 ENDDO
140
141
142
143 sumtot=zero
144
145 DO numloc=1,nctrl
146 r(numloc)=fn(numloc)*fm(numloc)*fl(numloc)*wwi(numloc)
147 sumtot=sumtot+r(numloc)
148 ENDDO
149
150
151
152 DO numloc=1,nctrl
153 r(numloc)=r(numloc)/sumtot
154 ENDDO
155
156 RETURN
subroutine onebasisfun(idxii, idxi, pxi, xi, kxi, ders1)