subroutine mcm
      implicit none
      include "DIMENSIONS"
      include "DIMENSIONS.ZSCOPT"
#ifdef MPI
      include "mpif.h"
#endif
      include "COMMON.NAMES"
      include "COMMON.WEIGHTS"
      include "COMMON.VMCPAR"
      include "COMMON.OPTIM"
      include "COMMON.CLASSES"
      include "COMMON.ENERGIES"
      include "COMMON.IOUNITS"
      integer i,j,k,igap,iprot,nf,imcm,ii,inn,n,nn,indn(max_ene)
      double precision target_gap0(maxobj),target_gap1(maxobj),delta
      logical solved,all_satisfied,not_done
      double precision ran_number,f,f0,x(max_paropt),x0(max_paropt),
     &  zz(maxobj),viol,obf,obg(max_paropt)
      integer iran_num,nvarr
      double precision tcpu,t0,t1,t0w,t1w
        do imcm=1,nmcm
          write (iout,*) "MCM procedure: step",imcm
          write (iout,*) "Initial params",(x(i),i=1,nvarr)
          write (iout,*) "f0",f0
          nn=iran_num(1,nvarr/3) 
          do i=1,nvarr
            indn(i)=0
          enddo
          inn=0
          do while (inn.lt.nn)
            ii=iran_num(1,nvarr)
            if (indn(ii).eq.0) then
              inn=inn+1
              indn(ii)=1
            endif
          enddo
          write (iout,*) "nn",nn," indn",(indn(i),i=1,n_ene)
          ii=0
          not_done=.true.
          do while (not_done)
          do i=1,n_ene
            if (indn(i).eq.1) then
              ii=ii+1
              x(i)=ran_number(x_low(i),x_up(i))
            endif
          enddo
          call x2w(nvarr,x)
          if (i_local_check.gt.0) 
     &        call viol_secondary(.false.,.false.,.false.,viol)
          not_done=(i_local_check.gt.0 .and. viol.gt.1.0d8)
          write (iout,*) "imcm",imcm," not_done",not_done
          if (not_done) then
            do i=1,n_ene
              x(i)=x0(i)
            enddo
          endif
          enddo
          write (iout,*) "Perturbed parameters"
          write (iout,*) (x(i),i=1,nvarr)
          call minimize(nvarr,x,f,zz)
          write (iout,*) "Parameters after minimization:"
          write (iout,*) (x(i),i=1,nvarr)
          write (iout,*) "f",f
          if (f.lt.f0) then
            f0=f
            do i=1,nvarr
              x0(i)=x(i)
              xm(i)=x(i)
            enddo
          else
            do i=1,nvarr
              x(i)=x0(i)
            enddo
          endif
        enddo      
      return
      end