      subroutine smudo(n,ndim,a1ext,aext)
!      parameter (idismu=100)
      implicit real*8(a-h,o-x,z),logical*1(y)
      dimension aext(ndim,ndim),a1ext(ndim,ndim)
      double precision,allocatable,dimension(:,:) :: v,s,vs,a0,s1
!      dimension v(idismu,idismu),s(idismu,idismu)
!     *,vs(idismu,idismu),a0(idismu,idismu),s1(idismu,idismu)
!      dimension a1(n,n),a(n,n)
c
c---------------------------------------------------------------
c     subroutine d'orthogonalisation par s-1/2
c     a (en donnee) sont les vecteurs non orth
c     donnes dans une base ORTHOGONALE
c     a1 (en sortie) sont les vec orthogonaux, dans la meme base
c---------------------------------------------------------------
c
      if(n.eq.0) return
      allocate (v(n,n))
      allocate (s(n,n))
      allocate (vs(n,n))
      allocate (a0(n,n))
      allocate (s1(n,n))
      call smudo1(n,ndim,a1ext,aext,v,s,vs,a0,s1)
      deallocate (v,s,vs,a0,s1)
      return
      end
      
       subroutine smudo1(n,ndim,a1ext,aext,v,s,vs,a0,s1)
      implicit real*8(a-h,o-x,z),logical*1(y)
      common /data/thr,maxit,nprint,yverif
      dimension aext(ndim,ndim),a1ext(ndim,ndim)
      dimension v(n,n),s(n,n)
     *,vs(n,n),a0(n,n),s1(n,n)
      dimension a1(n,n),a(n,n)
      if(nprint.ge.4) print*,'n',n
      a=aext(1:n,1:n)
      if(nprint.ge.4) print*,'a'
      if(nprint.ge.4) call script(a,n,n,n,n)
      do k=1,n
         anor=0.D0
         do l=1,n
            anor=anor+a(l,k)*a(l,k)
         enddo
         anor=dsqrt(anor)
         do l=1,n
            a(l,k)=a(l,k)/anor
         enddo
      enddo
      if(nprint.ge.4) print*,'a norm'
      a0=a
      if(nprint.ge.4) call script(a,n,n,n,n)
c      call hdiag(a,v,n,n)
      if(nprint.ge.4) print*,'n',n
      call jacobi(n,a,v,n)
      if(nprint.ge.4) print*,'n',n
      if(nprint.ge.4) print*,'a diag'
      if(nprint.ge.4) call script(a,n,n,n,n)
      if(nprint.ge.4) print*,'vp'
      if(nprint.ge.4) call script(v,n,n,n,n)
      s=matmul(transpose(a0),a0)
      if(nprint.ge.4) print*,'s'
      if(nprint.ge.4) call script(s,n,n,n,n)
c      call hdiag(s,vs,n,n)
      call jacobi(n,s,vs,n)
      if(nprint.ge.4) print*,'s diag'
      if(nprint.ge.4) call script(s,n,n,n,n)
      if(nprint.ge.4) print*,'vp'
      if(nprint.ge.4) call script(vs,n,n,n,n)
      do k=1,n
         s(k,k)=1.d0/dsqrt(s(k,k))
      enddo
      vs=matmul(vs,matmul(s,transpose(vs)))
      if(nprint.ge.4) print*,'s-1/2 vect orth'
      if(nprint.ge.4) call script(vs,n,n,n,n)
c      vs=matmul(transpose(a),matmul(vs,(a)))
      s1=matmul(a0,vs)
      if(nprint.ge.4) print*,'S-1/2 vect orth dans base orth'
      if(nprint.ge.4) call script(s1,n,n,n,n)
      if(yverif) then
         vs=matmul(transpose(s1),s1)
         if(nprint.ge.4) print*,'verif prod scal'
         if(nprint.ge.4) call script(vs,n,n,n,n)
         do k=1,n
         print*,'smudo recou',k,vs(k,k)
         enddo
      endif
      a1ext(1:n,1:n)=s1
      
      return
      end
      
      
      
      
