This subroutine updates matrices WS and WY, and forms the middle matrix in B.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer | :: | n | ||||
integer | :: | m | ||||
real(kind=wp) | :: | Ws(n,m) | ||||
real(kind=wp) | :: | Wy(n,m) | ||||
real(kind=wp) | :: | Sy(m,m) | ||||
real(kind=wp) | :: | Ss(m,m) | ||||
real(kind=wp) | :: | d(n) | ||||
real(kind=wp) | :: | r(n) | ||||
integer | :: | Itail | ||||
integer | :: | Iupdat | ||||
integer | :: | Col | ||||
integer | :: | Head | ||||
real(kind=wp) | :: | Theta | ||||
real(kind=wp) | :: | Rr | ||||
real(kind=wp) | :: | Dr | ||||
real(kind=wp) | :: | Stp | ||||
real(kind=wp) | :: | Dtd |
subroutine matupd(n,m,Ws,Wy,Sy,Ss,d,r,Itail,Iupdat,Col,Head,Theta,& Rr,Dr,Stp,Dtd) implicit none integer :: n , m , Itail , Iupdat , Col , Head real(wp) :: Theta , Rr , Dr , Stp , Dtd , d(n) , r(n) , & Ws(n,m) , Wy(n,m) , Sy(m,m) , Ss(m,m) integer :: j , pointr ! Set pointers for matrices WS and WY. if ( Iupdat<=m ) then Col = Iupdat Itail = mod(Head+Iupdat-2,m) + 1 else Itail = mod(Itail,m) + 1 Head = mod(Head,m) + 1 endif ! Update matrices WS and WY. call dcopy(n,d,1,Ws(1,Itail),1) call dcopy(n,r,1,Wy(1,Itail),1) ! Set theta=yy/ys. Theta = Rr/Dr ! Form the middle matrix in B. ! update the upper triangle of SS, ! and the lower triangle of SY: if ( Iupdat>m ) then ! move old information do j = 1 , Col - 1 call dcopy(j,Ss(2,j+1),1,Ss(1,j),1) call dcopy(Col-j,Sy(j+1,j+1),1,Sy(j,j),1) enddo endif ! add new information: the last row of SY ! and the last column of SS: pointr = Head do j = 1 , Col - 1 Sy(Col,j) = ddot(n,d,1,Wy(1,pointr),1) Ss(j,Col) = ddot(n,Ws(1,pointr),1,d,1) pointr = mod(pointr,m) + 1 enddo if ( Stp==one ) then Ss(Col,Col) = Dtd else Ss(Col,Col) = Stp*Stp*Dtd endif Sy(Col,Col) = Dr end subroutine matupd