# 1 "" # 1 "" # 1 "" # 1 "" module mtcai1 use adj_mod use tcai1 use mask1 implicit none logical, parameter, private :: T = .true. logical, parameter, private :: F = .false. real ,private, dimension(:), pointer :: tt contains subroutine mtcai1_init ( aa,msk ) real, dimension(:), pointer :: aa logical, dimension(:), pointer :: msk call tcai1_init (aa) call mask1_init(msk) allocate(tt(size(msk))) end subroutine function mtcai1_lop ( adj, add, mm, dd) result(stat) integer :: stat logical,intent(in) :: adj,add real,dimension(:) :: mm,dd call adjnull (adj,add,mm,dd ) call mtcai1_lop2(adj,add,mm,dd ) stat=0 end function subroutine mtcai1_lop2(adj,add,mm,dd) logical,intent(in) :: adj,add real, dimension (:) :: mm real, dimension (:) :: dd integer stat1, stat2 if ( adj) then stat1 = tcai1_lop( T, F, tt, dd) ! t = F' d stat2 = mask1_lop( T, T, mm, tt) ! m = J' t = J' F' d else stat1 = mask1_lop( F, F, mm, tt) ! t = J m stat2 = tcai1_lop( F, T, tt, dd) ! d = F t = F J m end if end subroutine subroutine mtcai1_close() end subroutine end module