      subroutine hiersmud2 (iprio,ntot,nn
     *,s,v,ss,vv,i11)
      implicit real*8 (a-h,o-x,z),logical*1(y)
      real(kind=8), dimension(nn,nn) :: s, v, ss, vv
      common/pr/nprint
      yw=.false.
!
      nac=ntot-iprio
      if(yw) then
         print*,'entree hiersmud2'
         print*,'nn,ntot,iprio',nn,ntot,iprio
         print*,'mat de rec'
         call script(s,ntot,ntot,nn,nn)
         write (6,*)
      endif
!
!     S^(-1/2) prioritaires
!
      if(i11.eq.1.and.iprio.ne.0) then
         i11=0
         ss(1:iprio,1:iprio)=s(1:iprio,1:iprio)
c         ss(1:iprio,1:iprio)=matmul(transpose(v(1:iprio,1:iprio))
c     *   ,matmul(s(1:iprio,1:iprio),v(1:iprio,1:iprio)))
      if(yw) then
         write (6,*) ' ss in'
         call script(ss,iprio,iprio,nn,nn)
      endif
         call hdiag (ss,vv,iprio,nn)
         do i=1,iprio
            ss(i,i)=1.d0/dsqrt(ss(i,i))
         enddo
         vv(1:iprio,1:iprio)=matmul(vv(1:iprio,1:iprio)
     *   ,matmul(ss(1:iprio,1:iprio),transpose(vv(1:iprio,1:iprio))))
         v(1:iprio,1:iprio)=vv(1:iprio,1:iprio)
      if(yw) then
         print*,'S^(-1/2) prioritaires'
         call script(v,iprio,iprio,nn,nn)
      endif
      endif
!
!     Schmidt
!
      if(iprio.ne.0.and.ntot.ne.iprio) then
         do i=1,iprio
            do j=iprio+1,ntot
               vij=dot_product(v(:,i),matmul(s(:,:),v(:,j)))
               v(:,j)=v(:,j)-v(:,i)*vij
            enddo
         enddo
      if(yw) then
         write (6,*) ' schmidt '
         call script(v,ntot,ntot,nn,nn)
      endif
      endif
!
!     S^(-1/2) non prioritaires
!
      if(ntot.ne.iprio) then
         ss(1:nac,1:nac)=matmul(transpose(v(:,iprio+1:iprio+nac))
     *   ,matmul(s(:,:),v(:,iprio+1:iprio+nac)))
      if(yw) then
         write (6,*) ' rec non prioritaires'
         call script(ss,nac,nac,nn,nn)
      endif
         call hdiag (ss,vv,nac,nn)
         if(yw)print*,'ss',(ss(i,i),i=1,nac)
         do i=1,nac
            ss(i,i)=1.d0/dsqrt(ss(i,i))
         enddo
         if(yw)print*,'ss',(ss(i,i),i=1,nac)
         ss(1:nac,1:nac)=matmul(vv(1:nac,1:nac)
     *   ,matmul(ss(1:nac,1:nac),transpose(vv(1:nac,1:nac))))
      if(yw) then
         write (6,*) ' s-1/2 non prioritaires'
         call script(ss,nac,nac,nn,nn)
      endif
c      print*,'iprio,nac',iprio,nac
         if(yw)write (6,*) ' vavant '
         if(yw)call script(v,ntot,ntot,nn,nn)
        if(yw)call script(ss(1:nac,1:nac),nac,nac,nac,nac)
         v(1:iprio,iprio+1:iprio+nac)=
     *   matmul(v(1:iprio,iprio+1:iprio+nac),ss(1:nac,1:nac))
         if(yw)call script(v,ntot,ntot,nn,nn)
         v(iprio+1:iprio+nac,iprio+1:iprio+nac)=
     *   matmul(v(iprio+1:iprio+nac,iprio+1:iprio+nac),ss(1:nac,1:nac))
c         v(1:iprio+nac,iprio+1:iprio+nac)=
c     *   matmul(v(1:iprio+nac,iprio+1:iprio+nac),ss(1:nac,1:nac))
      if(yw) then
         write (6,*) ' v3 '
         call script(v,ntot,ntot,nn,nn)
      endif
      endif
!
!     TEST
!
      ss(1:ntot,1:ntot)=matmul(transpose(v(1:ntot,1:ntot)),
     *matmul(s(1:ntot,1:ntot),v(1:ntot,1:ntot)))
      if(yw) then
      write (6,*) ' test hiersmud2 '
      call script(ss,ntot,ntot,nn,nn)
100   format (10f6.2)
      endif
      return
      end
