        module m_mres2d

contains
! version double precision

        subroutine mres2d(x,y,sc,specif,wavelet)

!  MRES2D    Performs two dimensional multiresolution analysis.
! 
!                  Y = MRES2D (X,H,RH,G,RG,SC,SPECIF) obtains the detail
!             or the low frequency approximation at scale SC of matrix 
!            X from a 2D multiresolution scheme. The analysis lowpass 
!            filter H, synthesis lowpass filter RH, analysis highpass 
!            filter G and synthesis highpass filter RG are used to
!            implement the scheme.
!
! In this version H,RH,G,RG are set to wavelets in the module 'wavelets'
!
!            The SPECIF parameter selects one of the following outputs: 
!
!        	0: Lowpass vertical and horizontal filtering. (APPROXIMATION)
!        	1: Lowpass vertical and highpass horizontal filtering.
!        	2: Highpass vertical and horizontal filtering. 
!        	3: Highpass vertical and lowpass horizontal filtering. 
!        	4: Sum of 1,2 and 3 outputs (COMPLETE DETAIL).
!
!
!             See also: APROX, DETAIL, MULTIRES, WT, SHOW


!--------------------------------------------------------
! Copyright (C) 1994, 1995, 1996, by Universidad de Vigo 
!                                                      
!                                                      
! Uvi_Wave is free software; you can redistribute it and/or modify it      
! under the terms of the GNU General Public License as published by the    
! Free Software Foundation; either version 2, or (at your option) any      
! later version.                                                           
!                                                                          
! Uvi_Wave is distributed in the hope that it will be useful, but WITHOUT  
! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or    
! FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License    
! for more details.                                                        
!                                                                          
! You should have received a copy of the GNU General Public License        
! along with Uvi_Wave; see the file COPYING.  If not, write to the Free    
! Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.             
!                                                                          
!       Author: Sergio J. Garcia Galan
!       e-mail: Uvi_Wave@tsc.uvigo.es
! Translated into fortran90 by Michel Rieutord
!       e-mail: rieutord@obs-mip.fr
!--------------------------------------------------------

         use convolution_sub
        use wavelets_BL
        use wavelets_daub
        use wavelets_daub4
        use wavelets_spline

        implicit none

        real(kind(0d0)), dimension(:,:), intent(in) :: x
        real(kind(0d0)), dimension(:,:), intent(out) :: y
        real(kind(0d0)), dimension (:,:), allocatable :: t2,t2t, tr,tt
        real(kind(0d0)), dimension (:), allocatable :: t2tl,tm,fh,fv,rfh, &
                               rfv,f1,f2,h,rh,g,rg
        integer,intent(in) :: specif
        integer,intent(in) :: sc
        character*128, intent(in) :: wavelet
        integer d,dd,i,init,j,k,lx,ly,lox,loy,lf,spec,specific,s_h,s_g, &
                s_rh,s_rg,stm,jj,i1,j1

! choose the wavelet
        if (wavelet == 'daub4') then
         allocate(h(8),rh(8),g(8),rg(8))
         h=h4; rh=rh4; g=g4; rg=rg4
        else if (wavelet == 'daub8') then
         allocate(h(16),rh(16),g(16),rg(16))
         h=h8; rh=rh8; g=g8; rg=rg8
        else if (wavelet == 'splines') then
         allocate(h(8),rh(4),g(4),rg(8))
         h=hs; rh=rhs; g=gs; rg=rgs
        else if (wavelet == 'lemarie') then
         allocate(h(16),rh(16),g(16),rg(16))
         h=h_l; rh=rh_l; g=g_l; rg=rg_l
        else
         stop'in mres2d: no wavelet supplied'
        endif


!t=x
![loy,lox]=size(t);

lox=size(x,2)
loy=size(x,1)

allocate(tt(loy,lox),tr(loy,lox))

s_h=size(h); s_g=size(g); s_rh=size(rh); s_rg=size(rg)

!print*,'just a check on h and g: sum(h)=sqrt(2), sum(g)=0',sum(h),sum(g)
lf=s_h+s_rh

dd=lf/2-1
d=dd
if (sc>1) then
        do i=2,sc
          d=d+dd*2**(i-1)
        enddo
endif

!initialisation
!y(:,:)=0. !; f1(:)=0. ; f2(:)=0.; fh(:)=0.; fv(:)=0.; rfh(:)=0.; rfv(:)=0.
y=0d0

init=specif
specific=specif

if (specific==4) then
        specific=3;
        init=1;
endif

!print*,'avant la boucle'
!print*,'init,specific,d',init,specific,d,sc,lox,loy
!print*,'minmax of input',minval(x),maxval(x)
!print*,x(:,18)

do spec=init,specific
        tt=x;
  select case(spec)
    case(0); allocate(fh(s_h),fv(s_h),rfh(s_rh),rfv(s_rh))
                      fh=h; fv=h; rfh=rh; rfv=rh;
    case(1); allocate(fh(s_g),fv(s_h),rfh(s_rg),rfv(s_rh))
                      fh=g; fv=h; rfh=rg; rfv=rh;
    case(2); allocate(fh(s_g),fv(s_g),rfh(s_rg),rfv(s_rg))
                      fh=g; fv=g; rfh=rg; rfv=rg;
    case(3); allocate(fh(s_h),fv(s_g),rfh(s_rh),rfv(s_rg))
                      fh=h; fv=g; rfh=rh; rfv=rg;
  end select

  do i=1,sc
        if (i==sc) then
        		allocate(f1(size(fh)),f2(size(fv)))
        		f1=fh; f2=fv
        	else
        		allocate(f1(s_h),f2(s_h))
        		f1=h; f2=h
        endif
        ! fortran 90				      ! Matlab
        deallocate(tr)				      ! tr=[];
        ly=size(tt,1); lx=size(tt,2)                  ! [ly,lx]=size(tt);
        stm=lx+size(f1)-1
        allocate(tr(ly,(stm+1)/2),tm(stm)); tr=0d0; tm=0d0   ! (lx+16-1+1)/2

        do j=1,ly
         call convol(f1,tt(j,:),tm)
         tr(j,:)=tm(1:lx+15:2)
        enddo
        deallocate(tt)                                !	tt=[];

        ly=size(tr,1); lx=size(tr,2)                  !	[ly,lx]=size(tr);
        stm=ly+size(f2)-1
        allocate(tt((stm+1)/2,lx)); tt=0d0
        deallocate(tm); allocate(tm(stm)); tm=0d0
        do j=1,lx
         call convol(f2,tr(:,j),tm)
         tt(:,j)=tm(1:ly+15:2)
        enddo
        deallocate(tm,f1,f2)
  enddo

!print*,'minmax tt',minval(tt),maxval(tt)
        
  do i=1,sc
        if (i==1) then
        	allocate(f1(size(rfh)),f2(size(rfv)))
        	f1=rfh; f2=rfv;
        else
        	allocate(f1(s_rh),f2(s_rh))
        	f1=rh; f2=rh;
        endif
        deallocate(tr)		                      !	tr=[];
        ly=size(tt,1); lx=size(tt,2)                  !	[ly,lx]=size(tt);
        stm=2*ly+size(f2)-1
        allocate(t2(ly,2),t2t(2,ly),t2tl(2*ly),tr(stm,lx),tm(stm))
        t2=0d0; t2t=0d0; t2tl=0d0; tr=0d0; tm=0d0

        do j=1,lx
                                                    ! tm=[tt(:,j),zeros(ly,1)]
         t2=reshape(source=(/ (tt(k,j),k=1,ly),(0.d0,k=1,ly) /),shape=(/ly,2/) )
!        print*,'t2',j,minval(t2),maxval(t2)
         t2t=transpose(t2)
!t2tl=reshape(source=t2t, shape=(/1/)) ! marche sous ifort et pas sous gfortran
         do jj=1,2*ly
          j1=(jj+1)/2; i1=2-modulo(jj,2)
          t2tl(jj)=t2t(i1,j1)
         enddo
!        print*,'t2tl',j,minval(t2tl),maxval(t2tl)
         call convol(f2,t2tl,tm)
!        print*,'tm',j,minval(tm),maxval(tm)
          tr(:,j) = tm(:)
        enddo
!       print*,'minmax next step 1',minval(tr),maxval(tr)


        deallocate(t2,t2t,t2tl,tm,tt)                 !	tt=[];
        ly=size(tr,1); lx=size(tr,2)                  !        [ly,lx]=size(tr);
        stm=2*lx+size(f1)-1
        allocate(t2(lx,2),t2t(2,lx),t2tl(2*lx),tt(ly,stm),tm(stm))
        t2=0d0; t2t=0d0; t2tl=0d0; tt=0d0; tm=0d0

        do j=1,ly
                                                   ! tm=[tr(j,:);zeros(1,lx)];
         t2=reshape(source=(/ (tr(j,k),k=1,lx),(0d0,k=1,lx) /), shape=(/lx,2/) )
         t2t=transpose(t2)
         !t2tl=reshape(source=t2t, shape=(/1/))
         do jj=1,2*lx
          j1=(jj+1)/2; i1=2-modulo(jj,2)
          t2tl(jj)=t2t(i1,j1)
         enddo
         call convol(f1,t2tl,tm)
         tt(j,:) = tm(:)
        enddo
!       print*,'minmax next step 2',minval(tt),maxval(tt)
        deallocate(t2,t2t,t2tl,tm,f1,f2)
  enddo
        
!       print*,'spec=',spec,'dims',ly,2*lx+15
!       print*,'requested=',1+d,loy+d,1+d,lox+d
        y=y+tt(1+d:loy+d,1+d:lox+d);
        deallocate(tt,fh,fv,rfh,rfv)
        allocate(tt(loy,lox))
enddo ! sur spec

!       print*,'minmax la sortie',minval(y),maxval(y)

        deallocate(tt,tr,h,rh,g,rg)
        end subroutine

end module
