Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=8), | dimension(:) | :: | wt | |||
integer, | optional | :: | nrk |
subroutine get_quadrature_weights(wt,nrk) real(8),dimension(:) :: wt integer,optional :: nrk integer :: nrk_ integer :: N nrk_=4;if(present(nrk))nrk_=nrk N=size(wt) if(nrk_==4)then select case(n) !n>=3 case (1) wt = 1.d0 case (2) wt = 0.5d0 case (3) !simpson's rule wt(1)=1.d0/3.d0 wt(2)=4.d0/3.d0 wt(3)=1.d0/3.d0 case(4) !simpson's 3/8 rule wt(1)=3.d0/8.d0 wt(2)=9.d0/8.d0 wt(3)=9.d0/8.d0 wt(4)=3.d0/8.d0 case(5) !Simpson's rule (E,O n) wt(1)=1.d0/3.d0 wt(2)=4.d0/3.d0 wt(3)=2.d0/3.d0 wt(4)=4.d0/3.d0 wt(5)=1.d0/3.d0 case default !Simpson's rule n>=6 if(mod(n-1,2)==0)then wt(1)=1.d0/3.d0 wt(n)=1.d0/3.d0 wt(2:n-1:2)=4.d0/3.d0 wt(3:n-2:2)=2.d0/3.d0 else wt(1)=1.d0/3.d0 wt(2:n-4:2)=4.d0/3.d0 wt(3:n-5:2)=2.d0/3.d0 wt(n-3)=17.d0/24.d0 wt(n-2)=9.d0/8.d0 wt(n-1)=9.d0/8.d0 wt(n)=3.d0/8.d0 endif ! case default !Simpson's rule n>=6 ! wt(1)=3.d0/8.d0 ! wt(2)=7.d0/6.d0 ! wt(3)=23.d0/24.d0 ! wt(4:n-3)=1.d0 ! wt(n-2)=23.d0/24.d0 ! wt(n-1)=7.d0/6.d0 ! wt(n)=3.d0/8.d0 end select elseif(nrk_==2)then wt(1) = 0.5d0 wt(2:n-1)=1.d0 wt(n) = 0.5d0 else stop "error in +get_quadrature_weights: nrk != 2,4" end if end subroutine get_quadrature_weights