module chain0_mod {
  logical, parameter, private :: T = .true., F = .false.
  interface chain0{
     module procedure chain20
     module procedure chain30
  } 
contains
  subroutine array0(op1,op2, adj,add, m,d1,d2) { #        ARRAY
    interface {
       integer function op1(adj,add,m,d){real::m(:),d(:);logical,intent(in)::adj,add}
       integer function op2(adj,add,m,d){real::m(:),d(:);logical,intent(in)::adj,add}
    }
    logical, intent(in) :: adj, add
    real, dimension(:)  :: m,d1,d2
    integer             :: st

    if(adj) {  st = op1(T, add, m, d1)		# m = m0 + A' d1
               st = op2(T,   T, m, d2)		# m = m  + B' d2
    }
    else    {  st = op1(F, add, m, d1)		# d1 = d1 + A  m
               st = op2(F, add, m, d2)		# d2 = d2 + B  m
    }
  }

  subroutine chain20(op1,op2, adj,add, m,d,t1) { #        CHAIN 2
    interface {
       integer function op1(adj,add,m,d){real::m(:),d(:);logical,intent(in)::adj,add}
       integer function op2(adj,add,m,d){real::m(:),d(:);logical,intent(in)::adj,add}
    }
    logical, intent(in) :: adj, add
    real, dimension(:)  :: m,d, t1
    integer             :: st
    if(adj) {  st = op1( T,   F, t1,d )		#        t =    A' d
               st = op2( T, add, m, t1)		# m = B' t = B' A' d
    } 
    else    {  st = op2( F,   F, m, t1)		#        t =    B  m
               st = op1( F, add, t1,d )		# d = A  t = A  B  m
    }
  }

  subroutine chain30(op1,op2,op3, adj,add, m,d,t1,t2) { # CHAIN 3
    interface {
       integer function op1(adj,add,m,d){real::m(:),d(:);logical,intent(in)::adj,add}
       integer function op2(adj,add,m,d){real::m(:),d(:);logical,intent(in)::adj,add}
       integer function op3(adj,add,m,d){real::m(:),d(:);logical,intent(in)::adj,add}
    }
    logical, intent(in) :: adj, add
    real, dimension(:)  :: m,d, t1,t2
    integer             :: st
    if(adj) {  st = op1( T,   F, t2, d )	#                 t1 =       A' d
               st = op2( T,   F, t1, t2)	#         t2 = B' t1 =    B' A' d
               st = op3( T, add, m , t1)	# m  = C' t2 =         C' B' A' d
    } 
    else    {  st = op3( F,   F, m , t1)	#                 t1 =       C  m
               st = op2( F,   F, t1, t2)	#         t2 = B  t1 =    B  C  m
               st = op1( F, add, t2, d )	# d  = A  t2 =         A  B  C  m
    }
  }

}
