C\begin{verbatim}
c       program nsgaII.f
      program NSGA-II-sJG for Heat Exchanger Network optimization (10 streams)
c     **************************************************
c     *                                                *
c     *             NON-DOMINATED SORTING              *
c     *               GENETIC ALGORITHMS-II-sJG             *
c     *                    (NSGA-II-sJG)                    *
c     **************************************************
c Developed by Kalyanmoy Deb, Indian Institute of Technology, Kanpur
c The single objective code, simple GA (SGA), is adapted in Fortran from David E. Goldberg's Pascal
c code.The NSGA-II is adapted in Fortran from Kalyanmoy Deb's C code by
c Rahul Kasat. The sJG adaptation to NSGA-II has been developed by Aaditya Agarwal.
c All rights reserved. This listing is for personal use.
c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
c This routine finds the optimum point of a constrained
c optimization problem using genetic algorithms.
c Code your function in subroutine funct
c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C     ____________________________________________________________________
      Integer oldchr1(200,1000), newchrom(200,1000),oldrank(200)
      Integer chr(1000),lsubstr(50),dummychr(1000),oldrankno(200)
c      integer newrankar(200,200),newmaxrank,newrankno(200),newrank(200)
      integer oldrankar(200,200),keepchrom(200,1000),globchrom(400,1000)
      integer oldmaxrank,grank(400),grankno(400),maxgen,igen
      integer lchrom,ipopsize,nmute,ncross,nparam,tempbit,strbit,strno
	-,hstrno,cstrno 
C     ____________________________________________________________________
      double precision  oldx(200,50),factor(50),oldcub_len(200)
      double precision dummyx(50),alow(50),ahigh(50),newx(200,50)
      double precision oldfit1(200),oldfit2(200),newfit1(200)
      double precision  newfit2(200),keepx(200,50),globfit2(400)
      double precision keepfit1(200),keepfit2(200),gcub_len(400)
	double precision globx(400,50),a11(200),globfit1(400),a22(200)
	real pjump, pcross, pmute,pmjg,thotin(100),thotout(100),
	-tcoldin(100),tcoldout(100),area,pcrossparta,pcrosspartalim
	integer units
	real dpen,dpen1
      integer counter,mincounter,mincounter1,mincounter2,mincounter3
	real cphot(100),cpcold(100)
c............. common blocks .........................
c.....for GA parameters
      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
      common/data11/thotin,thotout,tcoldin,tcoldout

      common/data7/hstrno,cstrno,strno
      common/data8/cphot,cpcold
	common/data9/counter,mincounter,mincounter1,mincounter2
	-,mincounter3
 	
c.....for random variables routines
      common/randvar/oldrand,jrand

c.....for other constant
      common/consts/fix
c........ fixed array for random number generator .....
      
c.........for the model 
!	common/model/hstrno,cstrno,strno
     	common/data6/pmjg,pcrossparta,pcrosspartalim
   	COMMON/REST/restart
   	integer restart
	real temparrange,arrange(200)

     
      real oldrand(55), fix
      integer jrand
c........ read all GA input parameters first ..........
      call systemqq('del res2.txt')
      call systemqq('del res3.txt')
 	call systemqq('del devars.txt')
 
      call initdata

c     -------------------------------------------------------
c............. main program begins here ................

      igen = 0
      do i = 1,ipopsize
       do j =1,lchrom
        oldchr1(i,j)=0
       end do
       do j=1,nparam
        oldx(i,j)=0.0
       end do
        oldfit1(i)=0.0
        oldfit2(i)=0.0
      end do



c.....create initial population and evaluate*********
      call initialize(oldchr1,oldx,oldfit1,oldfit2,factor,lsubstr,
     1  alow,ahigh,dummyx,dummychr,oldrank,oldcub_len,oldmaxrank,
     1  oldrankar,oldrankno)

      do i=1,ipopsize
         oldcub_len(i)=0.0
      end do

c.....main generation loop begins   =====
10    igen = igen + 1
c.....perform one generation of GA operators ====
c       contains reproduction, crossover` and mutation
	oldmaxrank=0
      do i=1,ipopsize
       oldrankno(i)=0
       oldrank(i)=0
       do j=1,ipopsize
        oldrankar(i,j)=0
       end do
      end do

	call initranking(oldfit1,oldfit2,oldrank,oldrankno,oldmaxrank,
     -      oldrankar)

      write(*,*)'oldmaxrank=',oldmaxrank

      do i=1,ipopsize
         oldcub_len(i)=0.0
      end do

	do i=1,oldmaxrank
        call share1(i,oldfit1,oldfit2,oldrankno,oldrankar,oldrank,
     1              oldcub_len)
      end do

	
      do i = 1,ipopsize
       do j =1,lchrom
        newchrom(i,j)=0
       end do
       do j=1,nparam
        newx(i,j)=0.0
       end do
        newfit1(i)=0.0
        newfit2(i)=0.0
      end do

      call generation(oldchr1,newchrom,newx,oldx,oldfit1,oldfit2,newfit1
     1 ,newfit2,factor,lsubstr,alow,ahigh,chr,oldrank,oldcub_len,
     1   oldrankar,igen)


c****here we make global population by mixing parents and children******

      do i = 1,2*ipopsize
       do j =1,lchrom
        globchrom(i,j)=0
       end do
       do j=1,nparam
        globx(i,j)=0.0
       end do
        globfit1(i)=0.0
        globfit2(i)=0.0
      end do



      call global(oldchr1,newchrom,oldx,newx,oldfit1,newfit1,oldfit2,
     1  newfit2,globchrom,globx,globfit1,globfit2)

c****here we carry out ranking , sharing and making of pseudo parents ***
c*****which can be used in next generation *************
      call keepalive(globx,globchrom,globfit1,globfit2,keepx,keepchrom,
     1  keepfit1,keepfit2,grank,grankno,gcub_len,oldrank,oldcub_len)

       do i = 1, ipopsize
         a11(i) = 0
         a22(i) = 0
       end do

c*****here we make pseudo parents for the next generation********
       do i=1,ipopsize
          oldfit1(i)=keepfit1(i)
          oldfit2(i)=keepfit2(i)
          a11(i)= (1/oldfit1(i)) - 1.0
          a22(i)= (1/oldfit2(i)) - 1.0
!	a11(i)=oldfit1(i)
!	a22(1)=oldfit2(i)
          do j=1,nparam
           oldx(i,j)= keepx(i,j)
          end do
          do j=1,lchrom
            oldchr1(i,j)= keepchrom(i,j)
c	      write(*,*)'vvvv',oldchr1(i,j)
          end do
c	pause
       end do
!	open(unit=113,file='result.txt')
      open(unit=112,file='res3.txt')	
!	open(unit= 111, file='res2.txt')
	open (unit=111,file='res2.txt',position='append')
 	open (unit=115,file='devars.txt',position='append')
     	open (unit=712,file='chrom.txt')!,position='append')
	open (unit=713,file='fit.txt')!,position='append')
	open (unit=714,file='oldx.txt')!',position='append')
	open (unit=715,file='lowest.txt',position='append')


	do i=1,200
	arrange(i)=a11(i)
	end do



	if(igen.eq.10.or.mod(igen,200).eq.0)then
    	do i=1,199
      do j = i+1,200
      if(arrange(i).ge.arrange(j)) then
      temparrange=arrange(i)
	arrange(i)=arrange(j)
	arrange(j)=temparrange         	   
      end if
      end do			 
      end do

	write(715,*)igen,arrange(1)
	endif


	if(mod(igen,25000).eq.0)then
	write(712,*)igen
      write(713,*)igen
	write(714,*)igen
 
	do i=1,200
	write(712,612)(keepchrom(i,j),j=1,lchrom)
!	write(*,*)(keepchrom(i,j),j=1,lchrom)
612	format(330(1x,i1))
	write(713,*)oldfit1(i),oldfit2(i)
	write(714,614)(keepx(i,j),j=1,40)
614	format(40(5x,f10.5))
!	pause
      enddo 
	endif

!	pause 

!	restart=0
	if(restart.eq.1)then
      read(712,*)igen 
 	read(713,*) igen  
	read(714,*) igen  
    
     	do i=1,ipopsize
      read(712,*)(keepchrom(i,j),j=1,lchrom)
	read(713,*)keepfit1(i),keepfit2(i)
	read(714,*)(keepx(i,j),j=1,18)
      enddo 

      do i=1,ipopsize
      oldfit1(i)=keepfit1(i)
       oldfit2(i)=keepfit2(i)
          a11(i)= (1/oldfit1(i)) - 1.0
          a22(i)= (1/oldfit2(i)) - 1.0
!	a11(i)=oldfit1(i)
!	a22(1)=oldfit2(i)
          do j=1,nparam
           oldx(i,j)= keepx(i,j)
          end do
          do j=1,lchrom
            oldchr1(i,j)= keepchrom(i,j)
c	      write(*,*)'vvvv',oldchr1(i,j)
          end do
c	pause
       end do

	restart=0
	endif

	
!	write(*,*)'igen......',igen


      if(mod(igen,25000).eq.0.or.igen.eq.1.or.igen.eq.2.
	-or.igen.eq.1000)then
!	write(111,*)igen
!       do q=1,ipopsize
!	  write(*,*)q,oldx(q,1),oldx(q,2),a11(q,1),a11(q,2)  
 !       write(111,240)q,oldx(q,1),oldx(q,2),a11(q,1),a11(q,2), 
      
	write(*,*)'gen=',igen
	write(111,*)igen
 	write(115,*)igen
 
      do i=1,ipopsize
      write(*,*) i,a11(i),a22(i)
      write(111,143)a11(i),a22(i)
143	format(1X,f20.5,1X,f20.5)

     	write(*,240)oldx(i,1),oldx(i,2),oldx(i,3),oldx(i,4),oldx(i,5)
	-,oldx(i,6),oldx(i,7),oldx(i,8),oldx(i,9),oldx(i,10),oldx(i,11)
     -,oldx(i,12),oldx(i,13),oldx(i,14),oldx(i,15),oldx(i,16)
     -,oldx(i,17),oldx(i,18),oldx(i,19),oldx(i,20),oldx(i,21),oldx(i,22)
     -,oldx(i,23),oldx(i,24),oldx(i,25),oldx(i,26),oldx(i,27),oldx(i,28)
     -,oldx(i,29),oldx(i,30),a11(i),a22(i)   
      write(115,240)oldx(i,1),oldx(i,2),oldx(i,3),oldx(i,4),oldx(i,5)
	-,oldx(i,6),oldx(i,7),oldx(i,8),oldx(i,9),oldx(i,10),oldx(i,11)
     -,oldx(i,12),oldx(i,13),oldx(i,14),oldx(i,15),oldx(i,16)
     -,oldx(i,17),oldx(i,18),oldx(i,19),oldx(i,20),oldx(i,21),oldx(i,22)
     -,oldx(i,23),oldx(i,24),oldx(i,25),oldx(i,26),oldx(i,27),oldx(i,28)
     -,oldx(i,29),oldx(i,30),a11(i),a22(i)   
      
 !	end do
	
c	if(igen.eq.100)then
c	do i=1,ipopsize
240	format(1X,f10.5,1X,f10.5,1X,f10.5,1X,f10.5,1X,f10.5,1X,f10.5,
     -1X,f10.5,1X,f10.5,1X,f10.5,1X,f10.5,1X,f10.5,1X,f10.5,
	-1X,f10.5,1X,f10.5,1X,f10.5,1X,f10.5,1X,f10.5,1X,f10.5,
	-1X,f10.5,1X,f10.5,1X,f10.5,1X,f10.5,1X,f10.5,1X,f10.5,
     -1X,f10.5,1X,f10.5,1X,f10.5,1X,f10.5,1X,f10.5,1X,f10.5,
     -1X,f20.5,1X,f20.5)     

	 end do	
!	pause
	close(111)
	close(115) 
	close(712)
	close(713)
	close(714)
	close(112)
	end if
	write(*,*)'igen',igen 
c     pause    
c*******condition to go to next loop********
       if(igen .lt. maxgen) goto 10
	close(111)
	close(115)

c	pause
	
	

      stop
      end


c******************all the subroutines start here *******************************
c     *****   initializes GA parameters  *****
c**********input all ur data here***********
      subroutine initdata
      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
      common/data11/thotin,thotout,tcoldin,tcoldout

      common/data7/hstrno,cstrno,strno
      common/data8/cphot,cpcold
	common/data9/counter,mincounter,mincounter1,mincounter2
	-,mincounter3
	common/data25/intervalno
      
	real thotin(100),thotout(100),tcoldin(100),tcoldout(100)
	-,cphot(100),cpcold(100)
     	common/data6/pmjg,pcrossparta,pcrosspartalim
	COMMON/REST/restart
	integer restart


	
!     	  aadi input
      write(*,*)'  '
      write(*,*)'            Non-dominated Sorting GA-II'
      write(*,*)'         Genetic Algorithms in FORTRAN'
      write(*,*)'                 Kalyanmoy Deb'
      write(*,*)'                      &   '
      write(*,*)'                 Rahul Kasat'
      write(*,*)'              All rights reserved'
      write(*,*)'  '
c.....read all GA parameters
      write(*,*)'** GA data entry and initialization **'
c     nparam=18
c     write(*,*) 'nparam -------> ',nparam
c     read(*,*) nparam
       
      write(*,*) 'lchrom --------> ',lchrom
      ipopsize = 200 
      write(*,*) 'ipopsize ------------> ',ipopsize
c      read(*,*) ipopsize
      maxgen= 500000 
	write(*,*) 'maxgen ------------>',maxgen
c      read(*,*) maxgen
      pcross=0.8
      write(*,*) 'pcross-------->',pcross
c      read(*,*) pcross
c	lchrom = 900
c	lchrom = 300.0										  
      pcrossparta=0.3
	pcrosspartalim=0.3
      write(*,*)'pcrossparta------>',pcrossparta
	
     	restart=0
     
      pmute= 0.01d0
	pmjg=0.5d0
!/lchrom
      write(*,*) 'pmute -------> ',pmute
c      read(*,*) pmute
	pjump = 0.0
	write(*,*)'pjump--------> ', pjump
	nmute  = 0
      ncross = 0
c	******* the number of streams ------> strno*******
      hstrno=5
	cstrno=5
      strno=hstrno+cstrno  
c    ******* number of bits for each stream --------> exchbit 
	strbit=3
c    ******* number of bits for each temperature interval -->tempbit
	tempbit=15
!	lchrom=strno*strbit+(2**strbit-1 )*tempbit*strno 
	
    
      intervalno=2

	
      lchrom=strbit*strno+tempbit*intervalno*strno
	

	nparam=strno+intervalno*strno 


!	nparam=strno + (2**strbit-1 )*strno



	thotin(1)  = 433.0d0
	thotout(1) = 366.0d0
	thotin(2)  = 522.0d0
	thotout(2) = 411.0d0
	thotin(3)  = 544.0d0
	thotout(3) = 422.0d0
     	thotin(4)  = 500.0d0
	thotout(4) = 339.0d0
	thotin(5)  = 472.0d0
	thotout(5) = 339.0d0

     	tcoldout(1)= 450.0d0
	tcoldin(1) = 355.0d0 
	tcoldout(2)= 478.0d0
	tcoldin(2) = 366.0d0
	tcoldout(3)= 494.0d0
	tcoldin(3) = 311.0d0
	tcoldout(4)= 433.0d0
	tcoldin(4) = 333.0d0
	tcoldout(5)= 495.0d0
	tcoldin(5) = 389.0d0

	cphot(1)  =	8.79d0
	cphot(2)  =	10.55d0
	cphot(3)  =	12.56d0
	cphot(4)  =	14.77d0
	cphot(5)  =	17.73d0

	cpcold(1) = 17.28d0
	cpcold(2) =	13.90d0
	cpcold(3) = 8.44d0
	cpcold(4) = 7.62d0
	cpcold(5) =	6.08d0


	counter=0
	mincounter =100050000
	mincounter1=123434800
	mincounter2=123543621
  	mincounter3=123671825

	mincounter4=181500000 
	call systemqq('del resmap.txt')
	call systemqq('del resarea1.txt') 
	call systemqq('del resarea2.txt')
	call systemqq('del resarea3.txt')
      call systemqq('del resarea.txt')
	call systemqq('del inputdata.txt')
	call systemqq('del counter.txt')
     	call systemqq('del areafinal.txt')

	open(unit=2006,file='areafinal.txt',position='append')
      open(unit=1111,file='resmap.txt',position='append')
	open(unit=122, file='resarea1.txt',position='append')
	open(unit=123, file='resarea2.txt',position='append')
	open(unit=124, file='resarea3.txt',position='append')
	open(unit= 121,file='resarea.txt',position='append')
!	open(unit=0311,file='counter.txt',position='append')
	open(unit=11,file='count.txt')
	open(unit=01,file='inputdata.txt',position='append')
 	write(01,*)'** GA data entry and initialization **'
	write(01,*) 'ipopsize ------',ipopsize
	write(01,*) 'maxgen---------',maxgen
      write(01,*) 'lchrom --------',lchrom
	write(01,*) 'nparam --------',nparam
	write(01,*) 'maxgen --------',maxgen
	write(01,*) 'pcross---------',pcross
	write(01,*)	'pcrossparta----',pcrossparta
      write(01,*)	'pcrosspartalim-',pcrosspartalim
	write(01,*) 'pmute ---------',pmute
	write(01,*) 'pjump----------',pjump
	write(01,*) 'pjg------------',pjg
	write(01,*) 'strbit---------',strbit
	write(01,*) 'tempbit--------',tempbit
	write(01,*) 'intervalno ----',intervalno 
	write(01,*)' hahahaha '
	write(01,*)' notes : .....	 '
      close(01)


c  ********
c	pause
      return
      end


c     ***** initializes the data, population and
C           statistics variables                  ****
      subroutine initialize(oldchr1,oldx,oldfit1,oldfit2,factor,
     - lsubstr,alow,ahigh,dummyx,dummychr,oldrank,oldcub_len,
     - oldmaxrank,oldrankar,oldrankno)
      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
       

      common/data7/hstrno,cstrno,strno
 	common/data25/intervalno 

      common/consts/fix
      integer oldchr1(200,1000),oldrank(200),oldmaxrank
      integer dummychr(1000),oldrankar(200,200)
      double precision oldx(200,50),oldcub_len(200)
      double precision oldfit1(200),oldfit2(200)
      double precision factor(nparam), dummyx(nparam)
      double precision alow(nparam), ahigh(nparam)
 														  
      integer lsubstr(nparam),oldrankno(200)
	integer aa

c   *****enter the string coding information**********
c   *****change 'i' to number and enter for nparam parameters separately*****
c   *****enter the length of substring for each variable*******
c      strno=2

	do i = 1,hstrno 
	lsubstr(i)= strbit
	alow(i)= 0.0
      ahigh(i)= intervalno
	factor(i) = 2.0**float(lsubstr(i))-1.0
	end do 


	do i = hstrno+1,strno  
 	lsubstr(i)= strbit
	alow(i)= 0.0
      ahigh(i)= intervalno
	factor(i) = 2.0**float(lsubstr(i))-1.0
	end do 




c	lsubstr(1)= 3

c   ******enter alow and ahigh here*********
c     alow(1)= 0.0
c     ahigh(1)= 1.0
c	lsubstr(2)=3
c	alow(2)= 0.0
c     ahigh(2)= 1.0
	
c     *******calculate factor here*********
c     factor(1) = 2.0**float(lsubstr(1))-1.0
c	factor(2) = 2.0**float(lsubstr(1))-1.0
	 
      do i = strno+1,nparam 
	lsubstr(i)= tempbit
	alow(i)= 1.0
      ahigh(i)= 1.5
	factor(i) = 2.0**float(lsubstr(i))-1.0
	end do


	goto 1007

	alow(1)= 1.0
	ahigh(1)= 1.1

	alow(2)= 2.0
	ahigh(2)= 2.1

	alow(3)=  3.0
	ahigh(3)= 3.1

	alow(4)=  0.0
	ahigh(4)= 0.1





	
	alow(5)   =89.999999
	ahigh(5)  =90.0
!	factor(5) = 2.0**float(lsubstr(5))-1.0
	\
	alow(6)   =89.999999
	ahigh(6)  =90.0
!	factor(6) = 2.0**float(lsubstr(6))-1.0

	alow(7)   =59.999999
	ahigh(7)  =60.0
!	factor(7) = 2.0**float(lsubstr(7))-1.0

	alow(8)   =109.99999
	ahigh(8)  =110.0
!	factor(8) = 2.0**float(lsubstr(8))-1.0

	alow(9)   =79.999999
	ahigh(9)  =80.0
!	factor(9) = 2.0**float(lsubstr(9))-1.0

	alow(10)  =34.999999
	ahigh(10) =35.0
!	factor(10) = 2.0**float(lsubstr(10))-1.0







c    ******enter total length of the chromosome******
c      lchrom=32

c    *****INITIALIZE THE RANDOM NUMBER GENERATOR************
1007      call randomize

c    *****CREATE THE INITIAL POPULATION**********
      call initpop(oldchr1,oldx,oldfit1,oldfit2,dummyx,dummychr,
     -         lsubstr,alow,ahigh,factor)

      oldmaxrank=0
      do i=1,ipopsize
       oldrankno(i)=0
       oldrank(i)=0
c       oldcub_len(i)=0.0
       do j=1,ipopsize
        oldrankar(i,j)=0
       end do
      end do

c    *******doing the ranking in the initial population**********
      call initranking(oldfit1,oldfit2,oldrank,oldrankno,oldmaxrank,
     -      oldrankar)

       write(*,*)'oldmaxrank=',oldmaxrank

      do i=1,ipopsize
         oldcub_len(i)=0.0
      end do

c    ********doing the sharing for the diversity******************
      do i=1,oldmaxrank
        call share1(i,oldfit1,oldfit2,oldrankno,oldrankar,oldrank,
     1              oldcub_len)
      end do


c  *****report the initial population ************************
      call initreport
c      write(*,*)'************************************************'
      write(*,*)'printing the information of initial parent population'
      write(*,*)'VALUES OF THE DIFFERENT PARAMETERS'
      write(*,*)'POPULATION NO. , X1 , X2..'
       do i = 1, ipopsize
         write(*,*) i,oldx(i,1)
       end do
c	pause
      write(*,*)'***************************************************'
      return
      end


c ************subroutines needed for the random number generator*********************
c.............. utility subroutines ...................
c     *****   function to find i mod j *****
      function modop(i,j)
      modop = i - j*ifix(float(i)/float(j))
      return
      end

c     *** random number initialization routines ***
      subroutine advance_random
      common /randvar/ oldrand,jrand
      real oldrand(55)
      do 11 j1 = 1,24
         rand_new = oldrand(j1) - oldrand(j1+31)
         if(rand_new.lt.0.0) rand_new = rand_new + 1.0
         oldrand(j1) = rand_new
 11   continue
      do 12 j1 = 25,55
         rand_new = oldrand(j1)-oldrand(j1-24)
         if(rand_new.lt.0.0)  rand_new = rand_new+1.0
         oldrand(j1) = rand_new
 12   continue
      return
      end

      subroutine warmup_random(random_seed)
      real oldrand(55)
      common/randvar/oldrand,jrand
      oldrand(55) = random_seed
      rand_new = 1.0e-9
      prev_rand = random_seed
      do 21 j1 = 1,54
         ii = modop(21*j1,55)
         oldrand(ii) = rand_new
         rand_new = prev_rand - rand_new
         if(rand_new.lt.0.0) rand_new = rand_new + 1.0
         prev_rand = oldrand(ii)
 21   continue
      call advance_random
      call advance_random
      call advance_random
      jrand = 0
      return
      end

c     ***** create a random number between 0 and 1 *****
      function random()
      real oldrand(55)
      common/randvar/oldrand,jrand
      jrand = jrand + 1
      if(jrand.gt.55) then
         jrand = 1
         call advance_random
      endif
      random = oldrand(jrand)
      return
      end

c     ***** flip a coin with a probability prob *****
      function iflip(prob)
      iflip = 0
      if ((prob.eq.1.0).or.(random().le.prob)) iflip = 1
      return
      end

c     * create a random integer between ilow and ihigh *
      function irnd(ilow,ihigh)
      if(ilow.ge.ihigh) then
         i = ilow
      else
         i = ifix(random()*(ihigh-ilow+1)+ilow)
         if(i.gt.ihigh) i = ihigh
      endif
      irnd = i
      return
      end

c     ***** initiate the random number generator *****
      subroutine randomize
      common/consts/fix
      randomseed=0.88876
 61   write(*,*)'enter seed random number (0.0 to 1.0)>',randomseed
c      read(*,*) randomseed
      if ((randomseed.lt.0) .or. (randomseed.gt.1.0))
     -   go to 61
      call warmup_random(randomseed)
      fix = randomseed
      return
      end
c\end{verbatim}


c   ***************subroutines used in the initpop***********
c.....*****  generates initial random population  *****
      subroutine initpop(oldchr1,oldx,fitness1,fitness2,x,chr,
     -         lsubstr,alow,ahigh,factor)
      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
       

      common/data7/hstrno,cstrno,strno
      


      integer oldchr1(200,1000), chr(lchrom)
      double precision oldx(200,50), fitness1(200),fitness2(200)

      double precision alow(nparam), ahigh(nparam), factor(nparam)
      integer lsubstr(nparam)
      double precision x(nparam)
	 
	integer a,b,acc,power2,c,c1,aa,aa1,units
!	real cost    
c	integer b 
c	integer acc 
c	integer power2 
	
c    ** try to make modifications so as to have different mapping rules *****  
	open(unit=112,file='res3.txt') 

	do 121 j = 1,ipopsize
		do 122 j1 = 1,lchrom
      	chr(j1) = iflip(0.5)
          oldchr1(j,j1) = chr(j1)
122		continue 


! 	power2=1
!	a=1
!	b=0
!	acc=0
!	c=strbit*strno
!	c1 =strbit*hstrno
!	c2 =strbit*cstrno
!	aa =(2**strbit-1)*tempbit*strno+strno*strbit
!	aa1=(2**strbit-1)*tempbit*strno+strno*strbit
! 65        do 122 j1 = a,a+strbit-1
c  *******create random strings of 1 and 0********
!            if(a.eq.c1+1) goto 1223  
!		  chr(j1) = iflip(0.5)
!            oldchr1(j,j1) = chr(j1)
!	   	  if(chr(j1) .eq. 1) acc = acc + power2 
!		  power2 = power2 * 2
c 	      power2 = 1.0
c          if(a.eq.c+1) goto 32  
!       write(*,*)'j j1 chrom',j,j1,oldchr1(j,j1)
! 122     continue
!		a=a+strbit
!	power2=1
!	goto 65
!1223	a1=a 
!	power2=1
!66		do 1222 j1=a1,a1+strbit-1
!			if(a1.eq.c+1) goto 32  
!			chr(j1) = iflip(0.5)
!			oldchr1(j,j1) = chr(j1)
!	   		if(chr(j1) .eq. 1) acc = acc + power2 
! 			power2 = power2 * 2
!1222		continue	
!	a1=a1+strbit
!	power2=1
!	goto 66

c    *******  the temperature lstrings start here  here 5 is the length for a single lstring  *****
!32	   	  b=acc*tempbit
c           c=strbit*strno
!		  do 124 j1=c+1,b+c
!            chr(j1) = iflip(0.5)
!            oldchr1(j,j1) = chr(j1)
!124		continue
!	 	  do 125 j1=b+c+1,aa
!	      chr(j1) = 0
!            oldchr1(j,j1) = chr(j1)
!125		continue 








c ** ** ** ** 76 has to be replaced with lchomosome ** ** **	
!	write(*,11)(oldchr1(j,j1),j1=1,aa)
!  11	format(1X,76I1)
! 	write(112,12)(oldchr1(j,j1),j1=1,aa)
!  12	format(5X,76I1,5X)

 !     pause
c121	continue 

c	do 126 i=1,ipopsize 
c		do 127 j1=1,86
c		write(*,*)' bit', oldchr1(j,j1)
c127		continue
c126   continue      
		     
     
c     do 121 j = 1,ipopsize
c         do 122 j1 = 1,lchrom
c  *******create random strings of 1 and 0********
c            chr(j1) = iflip(0.5)
c            oldchr1(j,j1) = chr(j1)
c            write(*,*)'j j1 chrom',j,j1,oldchr1(j,j1)
c 122     continue
c  *******calculate x values from the string*******
         call decodevars(chr,x,lsubstr,alow,ahigh,
     -           factor)
         do 123 j1 = 1,nparam
            oldx(j,j1) = x(j1)
c          write(*,*)' X = ',oldx(j,j1)
 123     continue

	
	call prepsort(x,area,units,nparam,cost,dpen,dpen1)

c  ****** calculate the fitness of the string***********
         fitness1(j) = funct1(cost,dpen,dpen1)
         fitness2(j) = funct2(units)
c        write(*,*) 'fit1=  ,fit2=',fitness1(j),fitness2(j)
	

 121  continue
c 		  do 127 i=1,ipopsize
	      
c127	    continue 

	return
      end

c   ********decodvars**************************************
c     *****  decodes a substring of length lstr *****
      function decode(chrom,id,lstr)
      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
       
      common/data7/hstrno,cstrno,strno
       

 
      integer chrom(lchrom)
      acc = 0.0
c.....multiplier is one for the first bit position
      powof2 = 1.0
      do 71 j = 1,lstr
c....... accumulate the bit value times the multiplier
         if(chrom(id+j) .eq. 1) acc = acc + powof2
c....... update multiplier for next bit position
         powof2 = powof2 * 2
 71   continue
      decode = acc
c      write(*,*)'decode=',decode
c      pause
      return
      end

c     * map the decoded value in the specified region *
      function xmap(y,alo,ahi,denom)
	double precision alo, ahi,denom
c.....linear mapping
      xmap = alo + (ahi-alo)*y/denom
c      write(*,*)alo,ahi,y,denom,xmap
c      write(*,*)'xmap=',xmap
c      pause
      return
      end

c     ** calculate the parameter value from a string **
      subroutine decodevars(chrom,x,lsubstr,alow,ahigh,
     -         factor)
      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
      common/data11/thotin,thotout,tcoldin,tcoldout

      common/data7/hstrno,cstrno,strno
      common/data8/cphot,cpcold

	real thotin(100),thotout(100),tcoldout(100),tcoldin(100)
     -,cphot(100),cpcold(100)
	integer chrom(1000)
      integer lsubstr(50),cc,dd,a,b,c
      double precision alow(50),ahigh(50),factor(50)
      double precision x(50)
      jpos = 0
	cc=0
	dd=0
c     changed nparam to strno 
      do 10 j = 1,strno
c.......get the decoded value of the substring
c        y = decode(chrom,jpos,lsubstr(j))
c...... map in the specified range for real value
        if(j.le.hstrno)then
	  y = decode(chrom,jpos,lsubstr(j))
  	  x(j) = nint(xmap(y,alow(j),ahigh(j),factor(j))) 

!	  x(j)= y
!	  cc=cc+y
	cc=cc+x(j)
	  goto 9
	  endif
        
	  if (j.le.strno.and.j.gt.hstrno)then 
	  y = decode(chrom,jpos,lsubstr(j))
  	  x(j) = nint(xmap(y,alow(j),ahigh(j),factor(j))) 

!	  x(j)= y
!	  dd=dd+y

	dd=dd+x(j) 
	  goto 9
	  endif
9     jpos = jpos + lsubstr(j)
!      write(*,*)'x=',x(j),j
10   	continue 									 	  
c...... bit position for the next variable in the string							
   
   	
c     pause 
  	d=0
      b=1
      do 11 a=1,hstrno
		
		do 12 b=b,x(a)+d
		alow(strno+b)=thotout(a)
		ahigh(strno+b)=thotin(a)
12		continue  
	
	d=d+x(a)
11	continue
     	
!	b=b-1
!     	c=1
!	e=0
	do 13 a=hstrno+1,strno
		do 14 b=b,x(a)+d
		alow(strno+b) =tcoldin(a-hstrno)
		ahigh(strno+b)=tcoldout(a-hstrno)
14   		continue
     	
	d=d+x(a)
13	continue      
     
     
     
     
      do 15 j=strno+1,nparam  
23	  if(j.gt.strno.and.j.le.cc+dd+strno)then  
	  y = decode(chrom,jpos,lsubstr(j))
	  x(j) = xmap(y,alow(j),ahigh(j),factor(j)) 
	  goto 16
	  else
	  x(j)=0
	  endif  
16     jpos = jpos + lsubstr(j)
!      write(*,*)'x=',x(j),j
15  	continue
  
!	pause

      return
      end

c*************subroutines for the ranking of initial population**********************

      subroutine initranking(ifit1,ifit2,irank,irankno,
     1           imaxrank,irankar)

      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
       
  
 	double precision ifit1(200),ifit2(200)
      integer irank(200),irankno(200),maxrank1,nondom
      integer irankar(200,200),iflag(200)
      integer imaxrank,rnk,q,i,j,k,val

        imaxrank=0
      do i = 1, ipopsize
         irank(i)=0
         irankno(i)=0
         iflag(i)=2
      end do
      do i=1,ipopsize
        do  j=1,ipopsize
             irankar(i,j)=0
        end do
      end do

      rnk=0
      nondom=0
      maxrank1=0

      do k=1,ipopsize
         q=1
         do j=1,ipopsize
            if(iflag(j).ne.1) goto 1001
            if(j.eq.ipopsize) goto 1002
         end do


1001         rnk = rnk+1

          do j=1,ipopsize
            if(iflag(j).eq.0) iflag(j)=2
          end do

          do i=1,ipopsize
            if(iflag(i).ne.1 .and. iflag(i).ne.0) then
             do j=1,ipopsize
               if(i.ne.j) then
                 if(iflag(j).ne.1) then
                   val= value(ifit1(i),ifit1(j),ifit2(i),
     1                 ifit2(j))
                   if (val.eq.2) then
                      iflag(i)=0
                      goto 1003
                   end if

                   if (val.eq.1) iflag(j)=0
                   if (val.eq.3) then
                     nondom = nondom+1
                     if(iflag(j).ne.0) iflag(j)=3
                   end if
                 end if
               end if
              if(j .eq. ipopsize) then
                irank(i)=rnk
                iflag(i)=1
c                write(*,*)'i=',i
                irankar(rnk,q)=i
c                write(*,*)'irankar=',irankar(rnk,q)
                q = q+1
              end if
             end do
            end if
1003      end do


          irankno(rnk)=q-1
      end do

1002      maxrank1=rnk

      imaxrank = maxrank1
      return
      end

c*********function indcmp*used in initranking********************

      function value(oldfit11,oldfit12,oldfit21,oldfit22)
      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
 
  

 
      double precision  oldfit11,oldfit12,oldfit21,oldfit22


      if(((oldfit11 .ge. oldfit12) .and.((oldfit21 - oldfit22) .gt.
     1     1e-7)) .or.(((oldfit11 - oldfit12) .gt.1e-7) .and.
     1  (oldfit21.ge.oldfit22))) then
             value = 1
      else if(((oldfit11 .le. oldfit12).and.((oldfit22 - oldfit21).gt.
     1           1e-7)) .or.(((oldfit12 - oldfit11) .gt.1e-7) .and.
     1           (oldfit22 .ge. oldfit21))) then
             value=2
           else
             value=3
      end if

      return
      end

c******subroutine for sharing for initial population*************
      subroutine share1(rnk,sfit1,sfit2,srankno,srankar,srank,
     1           scub_len)

      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
 
      common/data7/hstrno,cstrno,strno
   
 

      double precision sfit1(200),sfit2(200),scub_len(200)
      double precision fpara(200,3),length(200,3),max
      integer rnk,srankno(200),srankar(200,200)
      integer srank(200),i,m1,a

      m1 = srankno(rnk)
c      write(*,*)'m1=',m1

      do i=1,m1
          fpara(i,1)=0.0
          fpara(i,2)=0.0
          length(i,1)=0.0
          length(i,2)=0.0
      end do

      do i=1,m1
         a= srankar(rnk,i)
         fpara(i,1)=real(a)
         fpara(i,2)=sfit1(a)
      end do

      call sort(m1,fpara)
      max = fpara(m1,2)

      do i=1,m1
        if(i.eq.1 .or. i.eq.m1)then
          length(i,1)=fpara(i,1)
          length(i,2)=100*max
        else
          length(i,1)=fpara(i,1)
          length(i,2)=abs(fpara(i+1,2)-fpara(i-1,2))
        end if
      end do

      do i=1,m1
       a=length(i,1)
       scub_len(a)=scub_len(a)+length(i,2)
      end do

      do i=1,m1
          fpara(i,1)=0
          fpara(i,2)=0
          length(i,1)=0
          length(i,2)=0
      end do

      do i=1,m1
         a= srankar(rnk,i)
         fpara(i,1)=real(a)
         fpara(i,2)=sfit2(a)
c         write(*,*)i,fpara(i,1),fpara(i,2)
      end do

      call sort(m1,fpara)
      max = fpara(m1,2)

      do i=1,m1
        if(i.eq.1 .or. i.eq.m1)then
          length(i,1)=fpara(i,1)
          length(i,2)=100*max
        else
          length(i,1)=fpara(i,1)
          length(i,2)=abs(fpara(i+1,2)-fpara(i-1,2))
        end if
      end do

      do i=1,m1
       a=length(i,1)
       scub_len(a)=scub_len(a)+length(i,2)
c       write(*,*) a,oldcub_len(a)
      end do

      return
      end

c*********function sotr is used in sharing*************
      subroutine sort(m1,fpara)

      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
 
      common/data7/hstrno,cstrno,strno
 

        integer m1,i1,k1
      double precision temp,temp1,fpara(200,3)

      do k1=1,m1-1
        do i1=k1+1,m1
          if(fpara(k1,2) .gt. fpara(i1,2))then
             temp=fpara(k1,2)
             temp1=fpara(k1,1)
             fpara(k1,2)=fpara(i1,2)
             fpara(k1,1)=fpara(i1,1)
             fpara(i1,2)=temp
             fpara(i1,1)=temp1
          end if
        end do
      end do
      return
      end


c*****************put ur 1st objective function here********
c     ***** objective function for optimization  *****
      function funct1(area,dpen,dpen1)
      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
      common/data11/thotin,thotout,tcoldin,tcoldout

      common/data7/hstrno,cstrno,strno
      common/data8/cphot,cpcold
	real dpen,dpen1
	real area
	real thotin(100),thotout(100),tcoldout(100),tcoldin(100)
     -,cphot(100),cpcold(100)

!      double precision x(nparam)
!	sum1=0
!	do i=1,strno
!      sum1=sum1+x(i)
!	end do 

      aobj=area+(dpen1)*1000.0d0+dpen*50.0d0
!	write(*,*)dpen,dpen1
c.....this transformation is for minimization problems
      funct1 =1.0/(1.0+aobj) 
      return
      end

c     ***** put ur 2nd objective function for optimization here  *****
      function funct2(units)
      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
      common/data11/thotin,thotout,tcoldin,tcoldout

      common/data7/hstrno,cstrno,strno
      common/data8/cphot,cpcold

     	real area
	real thotin(100),thotout(100),tcoldout(100),tcoldin(100)
     -,cphot(100),cpcold(100)


	integer units
!	  real thotin(100),thotout(100),tcoldout(100),tcoldin(100)

!     double precision x(nparam),sum,gx
!	 
!	sum = 0
!   	 sum = sum +  x(i) 
!	end do

   	aobj = units  

c.....this transformation is for minimization problems
      funct2 = 1/(1+aobj)
	return
      end


c*********initial report subroutine***********
c     *****   prints report of initial population  *****
      subroutine initreport
      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
  
      common/data7/hstrno,cstrno,strno
 

 

      common/statist/igen,avg,amax,amin,sumfitness
      common/consts/fix
      write(*,*)'  '
      write(*,*)'            Non-dominated SortingII'
      write(*,*)'         Genetic Algorithms in FORTRAN'
      write(*,*)'                    by '
      write(*,*)'                 RahulKasat'
      write(*,*)'              All rights reserved'
      write(*,*)'  '
      write(*,*)'                 GA parameters '
      write(*,*)'               ----------------- '
      write(*,*)'  '
c.....print the GA parameters

      write(*,9050) ipopsize
      write(*,9051) lchrom
      write(*,9052) maxgen
      write(*,9053) pcross
      write(*,9054) pmute
      write(*,9055) fix
      write(*,*) '  '

 9050 format(' population size       = ',i4)
 9051 format(' chromosome length     = ',i4)
 9052 format(' max. # of generations = ',i4)
 9053 format(' crossover probability = ',f8.5)
 9054 format(' mutation probabilty   = ',f8.5)
 9055 format(' seed random number    = ',f8.5)

      return
      end



c *******subroutine generation***********
      subroutine generation(oldchr1,newchrom,newx,oldx,oldfit1,oldfit2,
     1   newfit1,newfit2,factor,lsubstr,alow,ahigh,chr,oldrank,
     1   oldcub_len,oldrankar,igen)

      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
      common/data11/thotin,thotout,tcoldin,tcoldout

      common/data7/hstrno,cstrno,strno
      common/data8/cphot,cpcold
	common/data9/counter,mincounter,mincounter1,mincounter2
	-,mincounter3

	real thotin(100),thotout(100),tcoldout(100),tcoldin(100)
     -,cphot(100),cpcold(100)


      integer oldchr1(200,1000),newchrom(200,1000)
      integer chr(1000),lsubstr(50),oldrank(200)
      integer oldrankar(200,200),mate1,mate2
      integer rchr(200,1000),rrank(200)
      integer rrankar(200,200)
      double precision newx(200,50),x(50),oldfit1(200)
      double precision oldfit2(200),newfit1(200),newfit2(200)
      double precision factor(50),alow(50),ahigh(50)
      double precision oldcub_len(200),r,r1,r2
      double precision rx(200,50),rfit1(200),rfit2(200)
      double precision rcub_len(200),oldx(200,50)
	integer units
	real area,cost

c*******tournament selection operator********

      do i = 1,ipopsize
       do j =1,lchrom
        rchr(i,j)=0
       end do
       do j=1,nparam
        rx(i,j)=0.0
       end do
        rfit1(i)=0.0
        rfit2(i)=0.0
        rrank(i)=0
        rcub_len(i)=0.0
      end do


      call nselect(oldchr1,oldfit1,oldfit2,oldrank,oldcub_len,
     -      oldx,rchr,rfit1,rfit2,rrank,rcub_len,rx)

	
      j=1
      k=0
      n=ipopsize
c***** select the mates for the xover and mutation*********
181   r= random()
      r=r*ipopsize
      r1=nint(r)
      if(r1.eq.0) r1=ipopsize-n
      if(r1 .eq.ipopsize) r1=(ipopsize-4)/2
      if(r1.eq.0) r1=ipopsize-n+1
      mate1=r1
c      write(*,*)'mate1',mate1
      if(mate1.eq.0) mate1 = mate1 + 1
      r= random()
      r=r*ipopsize
      r2=nint(r)
       if(r2.eq.0) r2=ipopsize-k
       if(r2 .eq.ipopsize) r2=(ipopsize-2)/2
      if(r2.eq.0) r2=ipopsize-k+1
      mate2=r2
c      write(*,*)'mate2',mate2
      if(mate2.eq.0)mate2=mate2+1
      if (mate1 .eq. mate2) goto 181
c.....perform crossover using the selected mates
      call crossover(j,mate1,mate2,rchr,newchrom)
c.....compute real values of the first child string
      do 20 j1 = 1,lchrom
         chr(j1) = newchrom(j,j1)
c         write(*,*)'j,j1,new1',j,j1,newchrom(j,j1)
 20   continue
      call decodevars(chr,x,lsubstr,alow,ahigh,factor)
      do 10 j1 = 1,nparam
         newx(j,j1) = x(j1)
c         write(*,*)'j , j1,newx',j,j1,newx(j,j1)
 10   continue
c.....compute fitness of the first child string
      
	call prepsort(x,area,units,nparam,cost,dpen,dpen1) 
      newfit1(j) = funct1(cost,dpen,dpen1)
      newfit2(j) = funct2(units)
c      newfit(j)=newfit1(j)
c.....compute real values of the second child string
      do 22 j1 = 1,lchrom
         chr(j1) = newchrom(j+1,j1)
c         write(*,*)'j,j1,new2',j+1,j1,newchrom(j+1,j1)
 22   continue
      call decodevars(chr,x,lsubstr,alow,ahigh,factor)
      do 11 j1 = 1,nparam
         newx(j+1,j1) = x(j1)
c        write(*,*)'j , j1,newx',j+1,j1,newx(j+1,j1)
 11   continue
c.....compute fitness of the second child string
      
	call prepsort(x,area,units,nparam,cost,dpen,dpen1)
      newfit1(j+1) = funct1(cost,dpen,dpen1)
      newfit2(j+1) = funct2(units)
c      newfit(j+1) = newfit1(j+1)
c.....update the individial count in the population
      j = j + 2
      k=k+2
      n=n-2
c.....if the population is already filled up, quit
	if(j .le. ipopsize) go to 181
	
c	  pause
      return
      end




c******tournament selection subroutine********
      subroutine nselect(oldchr1,oldfit1,oldfit2,oldrank,
     1 oldcub_len,oldx,rchr,rfit1,rfit2,rrank,rcub_len,rx)

      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
 
      common/data7/hstrno,cstrno,strno
 
	


      integer oldchr1(200,1000),oldrank(200)
      integer s1rank,s1chr(1000)
      integer rchr(200,1000),rrank(200)
      double precision oldfit1(200), oldfit2(200),s1cub_len,s2cub_len
      double precision oldcub_len(200),rcub_len(200),s1x(50)
      double precision rx(200,50),rfit1(200),rfit2(200)
      integer rnd,k,n,s2rank,s2chr(1000),rnd1
      double precision rnd2,s1fit1,s1fit2,s2fit1,s2fit2,s2x(50)
      double precision oldx(200,50),rnd3


      k=0

        do n=1,ipopsize
c*****selecting first member******
        rnd2=random()
        rnd2=ipopsize*rnd2
        rnd=nint(rnd2)
c         write(*,*)'rnd',rnd
        if(rnd.eq.0) rnd = ipopsize-k
        if(rnd.eq.ipopsize) rnd=(ipopsize-2)/2
        if(rnd.eq.0) rnd = rnd + 1
c        write(*,*)'rnd',rnd
        s1rank=oldrank(rnd)
        s1cub_len=oldcub_len(rnd)

        do j=1,lchrom
         s1chr(j)=oldchr1(rnd,j)
c         write(*,*)'chr1',s1chr(j)
        end do

        do j=1,nparam
        s1x(j)=oldx(rnd,j)
        end do
        s1fit1=oldfit1(rnd)
        s1fit2=oldfit2(rnd)


C **** SELECTING SECOND MEMBER*******
        rnd3=random()
        rnd3=ipopsize*rnd3
        rnd1=nint(rnd3)
c        write(*,*)'rnd1',rnd1
        if(rnd1.eq.0) rnd1 = ipopsize-n
        if(rnd1.eq.ipopsize) rnd1=(ipopsize-4)/2
        if(rnd1.eq.0) rnd1 = rnd1 + 1
c        write(*,*)'rnd1',rnd1
        s2rank=oldrank(rnd1)
        s2cub_len=oldcub_len(rnd1)

        do j=1,lchrom
        s2chr(j)=oldchr1(rnd1,j)
c         write(*,*)'s2chr',s2chr(j)
        end do

        do j=1,nparam
        s2x(j)=oldx(rnd1,j)
        end do

        s2fit1=oldfit1(rnd1)
        s2fit2=oldfit2(rnd1)

c*****doing tornament selection**********

        if(s1rank .gt. s2rank) then
c*****select 2 nd member**********
c        write(*,*)'******select2******'
         rrank(n)=s2rank
         rcub_len(n)=s2cub_len

         do j=1,lchrom
         rchr(n,j)=s2chr(j)
         end do

         do j=1,nparam
         rx(n,j)=s2x(j)
         end do

         rfit1(n)=s2fit1
         rfit2(n)=s2fit2
         else if(s1rank .lt. s2rank) then
c*****select the 1st member*******\
c          write(*,*)'*******yes1*******'
         rrank(n)=s1rank
         rcub_len(n)=s1cub_len

         do j=1,lchrom
          rchr(n,j)=s1chr(j)
         end do

         do j=1,nparam
          rx(n,j)=s1x(j)
         end do

         rfit1(n)=s1fit1
         rfit2(n)=s1fit2
        else if(s1cub_len .lt. s2cub_len) then
C***select the 2 nd member************
c          write(*,*)'*******yes2******'
         rrank(n)=s2rank
         rcub_len(n)=s2cub_len

         do j=1,lchrom
          rchr(n,j)=s2chr(j)
         end do

         do j=1,nparam
          rx(n,j)=s2x(j)
         end do

         rfit1(n)=s2fit1
         rfit2(n)=s2fit2
        else if(s1cub_len .gt. s2cub_len) then
c *** select the first member************
c        write(*,*)'********yes1**********'
         rrank(n)=s1rank
         rcub_len(n)=s1cub_len

         do j=1,lchrom
          rchr(n,j)=s1chr(j)
         end do

         do j=1,nparam
          rx(n,j)=s1x(j)
         end do

         rfit1(n)=s1fit1
         rfit2(n)=s1fit2
        else
c        write(*,*)'any'
         rrank(n)=s1rank
         rcub_len(n)=s1cub_len

         do j=1,lchrom
          rchr(n,j)=s1chr(j)
         end do

         do j=1,nparam
          rx(n,j)=s1x(j)
         end do

         rfit1(n)=s1fit1
         rfit2(n)=s1fit2
        end if
        k= k+1

      end do

      return
      end


c     *******subroutine for the crossover**************'
c     *** performs single-point crossover
c         between mate1 and mate2        ***
      subroutine crossover1(ipop,mate1,mate2,rchr,
     -         newchrom)
      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
 
      common/data7/hstrno,cstrno,strno
 
	common/data6/pmjg,pcrossparta,pcrosspartalim

 

      integer rchr(200,1000)
      integer newchrom(200,1000),jcross
	double precision tempe
	real  tempparta1,tempparta2


	integer acc1,acc2,newacc1,newacc2,mutacc1,mutacc2,q,mjgsite,j1

!	evaluate part A of first chromosome  

	acc1=evalparta(rchr,mate1)

!	evalulate Part a of second chromosome 

	acc2=evalparta(rchr,mate2)




!	write(*,*)"enter"
!	pause
! 	evaluate part A for the first chrmomsome 
!	power2=1
!	a=1
!	b=0
!	acc1=0
!	c=strbit*strno

!c    ********* compute the number of intervals in the mate1 **********
!265   do 222 j = a,a+strbit-1
c  *******create random strings of 1 and 0********
!		if(a.eq.c+1) goto 232  
!		if(rchr(mate1,j) .eq. 1) acc1 = acc1 + power2 
!		power2 = power2 * 2
c 	    power2 = 1.0
c         if(a.eq.c+1) goto 32  
c         write(*,*)'j j1 chrom',j,j1,oldchr1(j,j1)
! 222	continue
!	a=a+strbit
!	power2=1
!	goto 265

c    ********* compute the number of intervals in the mate2 **********
!232	a=1
!	b=0
!	acc2=0
!	power2=1

!365        do 322 j = a,a+strbit-1
!
!            if(a.eq.c+1) goto 332  
!		  if(rchr(mate2,j) .eq. 1) acc2 = acc2 + power2 
! 		  power2 = power2 * 2
c 	      power2 = 1.0
c          if(a.eq.c+1) goto 32  
c       write(*,*)'j j1 chrom',j,j1,oldchr1(j,j1)
! 322     continue
!		a=a+strbit
!	power2=1
!	goto 365

!332   if(acc2.ne.acc1)then
!      jcross=lchrom
!	goto 1212 
!	endif 
	
       
!332     	jcross = 0





      If(iflip(pcross) .eq. 1) then
c.....if yes, create a random cross site
      jcross = irnd(1,lchrom-1)
c     write(*,*)'jcross',jcross
      ncross = ncross + 1
      else 
	jcross = lchrom
 !     pause
	endif
c.....copy till the cross site as it is

!	check if crossover is in part A or part B 

	
!	write(*,*)" crossover is in part A "
!	endif


	goto 6555



	c=strbit*strno 
	if(jcross.lt.c)then

      do j=1,jcross
	newchrom(ipop,  j)=rchr(mate1,j)
     	newchrom(ipop+1,j)=rchr(mate2,j)
     	end do

	do j=jcross+1,c
	newchrom(ipop+1,j)=rchr(mate1,j)
     	newchrom(ipop  ,j)=rchr(mate2,j)
     	end do 


      tempparta1=evalpartalim(rchr,mate1,jcross) 
      tempparta2=evalpartalim(rchr,mate2,jcross) 
     	r=strno*strbit+tempparta1*tempbit
     	s=strno*strbit+tempparta2*tempbit
	
      do j=c,r
	newchrom(ipop ,j)=rchr(mate1,j) 
      end do
      
	do j=c,s
	newchrom(ipop+1,j)=rchr(mate2,j)
     	end do 
 	
      count1=1
	do j=s,lchrom
      newchrom(ipop,r+count1)=rchr(mate2,j)
	count1=count1+1
	end do 
	
     	count2=1
     	do j=r,lchrom
	newchrom(ipop+1,s+count2)=rchr(mate1,j)
	count2=count2+1
	end do 

      
	
     
     
     
      else
	endif


!	aadi
	   
     
6555      do 1711 j = 1,jcross
      newchrom(ipop,  j) =  rchr(mate1,j) 
      newchrom(ipop+1,j) =  rchr(mate2,j) 
 1711 continue

      do 1712 j = jcross+1,lchrom
      newchrom(ipop,  j) = rchr(mate2,j)
      newchrom(ipop+1,j) = rchr(mate1,j)
 1712 continue
!	call repair(newchrom,ipop,acc1,acc2) 
!	call repair(newchrom,ipop+1,acc2,acc1) 

!     	endif 
     
!      newacc1=evalparta(newchrom,ipop)
!	newacc2=evalparta(newchrom,ipop+1)
!	e xtremely important ..... 
!      if(jcross.lt.strno*strbit)then
!	call repair(newchrom,ipop,acc1,newacc1) 
!	call repair(newchrom,ipop+1,acc2,newacc2) 
!	else
!	call repair(newchrom,ipop,acc1,acc2) 
!	call repair(newchrom,ipop+1,acc2,acc1) 
!	endif

	do 1810 j=1,lchrom
	newchrom(ipop,  j) = mutation(newchrom(ipop,j))
      newchrom(ipop+1,j) = mutation(newchrom(ipop+1,j))
1810  continue

!	mutacc1=evalparta(newchrom,ipop)
!	mutacc2=evalparta(newchrom,ipop+1)
!	call repair(newchrom,ipop,acc1,mutacc1) 
!	call repair(newchrom,ipop+1,acc2,mutacc2) 




!	write(*,*)jcross
!	write(*,*)acc1,newacc1,acc2,newacc2
!	pause

!	power2=1
! 	a=1
!	b=0
!	newacc1=0
!	c=strbit*strno

!c    ********* compute the number of intervals in the mate1 **********
!2265   do 2222 j = a,a+strbit-1
!c  *******create random strings of 1 and 0********
!		if(a.eq.c+1) goto 2232  
!		if(rchr(mate1,j) .eq. 1) newacc1 = newacc1 + power2 
! 		power2 = power2 * 2
!c 	    power2 = 1.0
!c         if(a.eq.c+1) goto 32  
!c         write(*,*)'j j1 chrom',j,j1,oldchr1(j,j1)
!2222	continue
!	a=a+strbit
!	power2=1
!	goto 2265
!
!c    ********* compute the number of intervals in the mate2 **********
!2232	a=1
!	b=0
!	newacc2=0
!	power2=1
!
!2365        do 2322 j = a,a+strbit-1
!
!            if(a.eq.c+1) goto 2332  
!		  if(rchr(mate2,j) .eq. 1) newacc2 = newacc2 + power2 
! 		  power2 = power2 * 2
c 	      power2 = 1.0
c          if(a.eq.c+1) goto 32  
c       write(*,*)'j j1 chrom',j,j1,oldchr1(j,j1)
! 2322     continue
!		a=a+strbit
!	power2=1
!	goto 2365
	 




	


c.....swap from the cross site till the end of string
c     this step has to be altered ....... &^%^&%%&^%&^%&^%&^%&^%%& 

!	do 172 j = jcross + 1,lchrom
!         newchrom(ipop,  j) = mutation(rchr(mate2,j))
!         newchrom(ipop+1,j) = mutation(rchr(mate1,j))
! 172  continue



!	***************************************check this kuch naya a soocho 
 	if(jcross.eq.lchrom) then
		do i =ipop,ipop+1
 			mjjump=0
			if(iflip(pjump).eq.1)then
			jjump1 = irnd(int(strno*strbit),lchrom-1)
			jjump2 = irnd(int(strno*strbit),lchrom-1)
			else
!c			write (*,*)'I am in dead zone going to 251'   
			jjump1 = jjump2
			goto  251
			endif
 
			if (jjump1 .gt. jjump2)	then 
			tempe = jjump1
			jjump1 = jjump2
			jjump2 = tempe	 
			endif
!			q=iflip(0.5)
			do j1 = jjump1+1, jjump2
c  *******create random strings of 1 and 0********
			newchrom(i,j1) = iflip(0.5)
!c			oldchr1(j,j1) = chr(j1)
!c            write(*,*)'j j1 chrom',j,j1,oldchr1(j,j1)
			end do


251		if(iflip(pmjg).eq.1)then
			mjgsite = irnd(1,nparam)
			b=iflip(0.5)
			if(mjgsite.lt.strno)then
				a=mjgsite*strbit
				do j1=a+1,a+strbit
!				newchrom(i,j1)=b
				newchrom(i,j1)=iflip(0.5)

!				write(*,*)newchrom(i,j1),rchr(i,j1),mjgsite
				
				end do 
 		
			else
				a=strno*strbit+(mjgsite-strno)*tempbit 
				do j1=a+1,a+tempbit
!				newchrom(i,j1)=b
!				write(*,*)newchrom(i,j1),rchr(i,j1),mjgsite
				newchrom(i,j1)=iflip(0.5)

				end do 
			endif
!	pause
	
     
     		endif
     
		end do 
	endif
	
 
 
	    
      return
      end

		
c     **** returns 1 if ivalue = 0 and vice versa ****
      function logicalnot(ivalue)
      integer ivalue
      logicalnot = 0
      if(ivalue .eq. 0) logicalnot = 1
      return
      end

c     *** mutates ivalue with probability 'pmute' ***
      function mutation(ivalue)
      integer ivalue
      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
  
      common/data7/hstrno,cstrno,strno
 

       mutation = ivalue
c.....check if a mutation is to be performed
      if(iflip(pmute) .eq. 1) then
c....... if yes, perform mutation
         mutation = logicalnot(ivalue)
         nmute = nmute + 1
      endif
      return
      end

c*******making the global population********
c     *****  copy new population to old population *****
      subroutine global(oldchr1,newchrom,oldx,newx,oldfit1,newfit1,
     1 oldfit2,newfit2,globchrom,globx,globfit1,globfit2)

      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
        common/data7/hstrno,cstrno,strno
 
      integer oldchr1(200,1000),newchrom(200,1000)
      integer globchrom(400,1000)
      double precision oldx(200,50), newx(200,50)
      double precision oldfit1(200), newfit1(200),newfit2(200)
      double precision oldfit2(200), globfit2(400)
      double precision globx(400,50),globfit1(400)


      do 191 i = 1,ipopsize
c**********copy the parents and children strings*******************
         do 192 j = 1,lchrom
            globchrom(i+ipopsize,j) = newchrom(i,j)
            globchrom(i,j) = oldchr1(i,j)
c            write(*,*)'gold gnew',globchr(i+ipopsize,j),globchr(i,j)
192     continue
c.**********copy the variables***********
         do 193 j = 1,nparam
            globx(i+ipopsize,j) = newx(i,j)
            globx(i,j) = oldx(i,j)
193     continue
c********** finally, copy the fitnesses**************
         globfit1(i+ipopsize) = newfit1(i)
         globfit2(i+ipopsize) = newfit2(i)
         globfit1(i) = oldfit1(i)
         globfit2(i) = oldfit2(i)
191   continue
      return
      end


c*******subroutine of keepalive********

      subroutine gsorting(rnk,sel,grankno,grankar,gcub_len,gflag)

      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
 
      common/data7/hstrno,cstrno,strno
 

 

      integer rnk,sel,grankno(400),gflag(400),i,j
      integer grankar(400,400),q,a
      double precision gcub_len(400),array1(400,3),temp,temp1

      q= grankno(rnk)
      do i =1,q
       array1(i,1)= grankar(rnk,i)
       a=grankar(rnk,i)
       array1(i,2)=gcub_len(a)

      end do

      do i=1,q-1
       do j = i+1,q
        if(array1(i,2) .le. array1(j,2)) then
         temp=array1(i,2)
         temp1=array1(i,1)
         array1(i,2)=array1(j,2)
         array1(i,1)=array1(j,1)
         array1(j,2)=temp
         array1(j,1)=temp1
        end if
       end do

      end do

      do i=1,sel
       a=array1(i,1)
       gflag(a)=1

      end do

      return
      end



c*******subroutine for the keepalive***********
      subroutine keepalive(globx,globchrom,globfit1,globfit2,keepx,
     1 keepchrom,keepfit1,keepfit2,grank,grankno,gcub_len,
     1 oldrank,oldcub_len)

      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
 
      common/data7/hstrno,cstrno,strno
 
      integer grankar(400,400),oldrank(200)
      integer keeprankno(200),globchrom(400,1000)
      integer grankno(400),z,gmaxrank 
      integer grank(400),gflag(400),poolf,sel
      integer keepchrom(200,1000),i,j,k,m,st,pool
      double precision gcub_len(400),keepfit1(200),oldcub_len(200)
      double precision keepfit2(200),keepx(200,50)
      double precision globx(400,50),globfit1(400)
      double precision globfit2(400),keepcub_len(200)

      do i =1,2*ipopsize
        gcub_len(i)=0.0
        grank(i)=0
        grankno(i)=0
      end do
	  gmaxrank = 0
      call granking(globfit1,globfit2,grank,grankno,gmaxrank,grankar)
	  
	write(*,*)'gmaxrank',gmaxrank
c	pause

      m=gmaxrank
		   
      do i =1,gmaxrank
       call gshare(i,globfit1,globfit2,grankno,grankar,grank,gcub_len)
      end do


      poolf = ipopsize
      pool=0
      do i=1,2*ipopsize
       gflag(i)=0
      end do

      st=0
      z=1
       do i =1,m
        st=pool
        pool=pool+grankno(i)

        if(pool .lt. ipopsize) then
         do k=1,2*ipopsize
          if(grank(k) .eq. i) gflag(k) =1
         end do

        else
         sel=ipopsize-st
c         write(*,*)'selllllll',sel
         call gsorting(i,sel,grankno,grankar,gcub_len,gflag)
         goto 1101
        end if
       end do
c         write(*,*)'hhahklhdsakfh'
c	open(unit = 113, file='res6.txt')

1101   do i=1,2*ipopsize
         if(gflag(i) .eq.1) then
c          write(*,*)'mem',i
          keepfit1(z)=globfit1(i)
          keepfit2(z)=globfit2(i)
	    keepcub_len(z) = gcub_len(i)
c          write(*,*)'hdhhcdh',grank(z)
          do j=1,nparam
           keepx(z,j)= globx(i,j)
c           write(*,*)'kkkk',z,i,keepx(z,j),gcub_len(i)
          end do
          do j=1,lchrom
c           write(*,*)'hhh',i,j, globchrom(i,j)
           keepchrom(z,j)= globchrom(i,j)
c	    write(*,*)'keppp',keepchrom(z,j)

          end do
c	    pause
          z=z+1
         end if
       end do

	 return
       end

c*************subroutines for the ranking of global population**********************

      subroutine granking(globfit1,globfit2,grank,grankno,gmaxrank,
     1           grankar)

      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
       

 
      common/data7/hstrno,cstrno,strno
 
 

      double precision globfit1(400),globfit2(400)
      integer grank(400),grankno(400),maxrank2,nondom
      integer rnk,grankar(400,400),gflg(400)
      integer q,i,j,k,val,popsize1,gmaxrank

      popsize1=ipopsize*2
      do i = 1, popsize1
         grank(i)=0
         grankno(i)=0
         gflg(i)=2
      end do

      do i=1,popsize1
        do  j=1,popsize1
             grankar(i,j)=0
        end do
      end do

      rnk=0
      nondom=0
      maxrank1=0
      gmaxrank=0
      do k=1,popsize1
         q=1
         do j=1,popsize1
            if(gflg(j).ne.1) goto 1001
            if(j.eq.popsize1) goto 1002

         end do



1001         rnk = rnk+1
          do j=1,popsize1
            if(gflg(j).eq.0) gflg(j)=2
          end do

          do i=1,popsize1
            if(gflg(i).ne.1 .and. gflg(i).ne.0) then
             do j=1,popsize1
               if(i .ne.j) then
                 if(gflg(j) .ne.1) then
                   val= gvalue(globfit1(i),globfit1(j),globfit2(i),
     1                    globfit2(j))
                   if (val.eq.2) then
                      gflg(i)=0
                      goto 1003
                   end if
                   if (val.eq.1) gflg(j)=0
                   if (val.eq.3) then
                     nondom = nondom+1
                     if(gflg(j).ne.0) gflg(j)=3
                   end if
                 end if
               end if
              if(j .eq. popsize1) then
                grank(i)=rnk
                gflg(i)=1
                grankar(rnk,q)=i
                q = q+1
              end if
             end do
            end if
1003      end do

          grankno(rnk)=q-1
      end do

1002      maxrank2=rnk

      gmaxrank = maxrank2
c	  pause
      return
      end

c*********function indcmp of granking*********************

      function gvalue(pfit11,pfit12,pfit21,pfit22)
      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
  
      common/data7/hstrno,cstrno,strno
 

 

      double precision  pfit11,pfit12,pfit21,pfit22

c	  write(*,*)'fit',pfit11,pfit12,pfit21,pfit22
      if(((pfit11 .ge. pfit12) .and.((pfit21 - pfit22) .gt.
     1    1e-7)) .or.(((pfit11 - pfit12) .gt.1e-7).and.(pfit21
     1    .ge.pfit22))) then
             gvalue = 1
      else if(((pfit11 .le. pfit12).and.((pfit22 - pfit21).gt.
     1           1e-7)) .or.(((pfit12 - pfit11) .gt.1e-7) .and.
     1           (pfit22 .ge. pfit21))) then
             gvalue=2
           else
             gvalue=3
      end if
c	  write(*,*)'valu=', gvalue
c	  pause
      return
      end

c******subroutine for sharing of global population*************
      subroutine gshare (rnk,globfit1,globfit2,grankno,grankar,grank,
     1           gcub_len)

      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
 
      common/data7/hstrno,cstrno,strno
 
      double precision globfit1(400),globfit2(400)
      double precision gcub_len(400)
      double precision fpara(400,3),length(400,3),max
      integer rnk,grankno(400),grankar(400,400)
      integer grank(400),i,m1,a

      m1 = grankno(rnk)
      do i=1,m1
          fpara(i,1)=0.0
          fpara(i,2)=0.0
          length(i,1)=0.0
          length(i,2)=0.0
      end do
      do i=1,m1
         a= grankar(rnk,i)
         fpara(i,1)=real(a)
         fpara(i,2)=globfit1(a)
      end do

      call globalsort(m1,fpara)
      max = fpara(m1,2)
      do i=1,m1
        if(i.eq.1 .or. i.eq.m1)then
          length(i,1)=fpara(i,1)
          length(i,2)=100*max
        else
          length(i,1)=fpara(i,1)
          length(i,2)=abs(fpara(i+1,2)-fpara(i-1,2))
        end if
      end do
      do i=1,m1
       a=length(i,1)
       gcub_len(a)=gcub_len(a)+length(i,2)
      end do

      do i=1,m1
          fpara(i,1)=0.0
          fpara(i,2)=0.0
          length(i,1)=0.0
          length(i,2)=0.0
      end do

      do i=1,m1
         a= grankar(rnk,i)
         fpara(i,1)=real(a)
         fpara(i,2)=globfit2(a)
      end do
      call globalsort(m1,fpara)
      max = fpara(m1,2)

      do i=1,m1
        if(i.eq.1 .or. i.eq.m1)then
          length(i,1)=fpara(i,1)
          length(i,2)=100*max
        else
          length(i,1)=fpara(i,1)
          length(i,2)=abs(fpara(i+1,2)-fpara(i-1,2))
        end if
      end do

      do i=1,m1
       a=length(i,1)
       gcub_len(a)=gcub_len(a)+length(i,2)
      end do
      return
      end

c*********function sotr is used in sharing*************
      subroutine globalsort(m1,fpara)

      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
        common/data7/hstrno,cstrno,strno
 

       integer m1,i1,k1
      double precision temp,temp1,fpara(400,3)

      do k1=1,m1-1
        do i1=k1+1,m1
          if(fpara(k1,2) .gt. fpara(i1,2)) then
             temp=fpara(k1,2)
             temp1=fpara(k1,1)
             fpara(k1,2)=fpara(i1,2)
             fpara(k1,1)=fpara(i1,1)
             fpara(i1,2)=temp
             fpara(i1,1)=temp1
          end if
        end do
      end do
      return
      end

	function evalparta(rchr,mate)
	common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
 
      common/data7/hstrno,cstrno,strno
  
       integer rchr(200,1000)
	integer power2,a,b,c,acc,mate,j
	power2=1
 	a=1
 	b=0
	acc=0
	c=strbit*strno

c    ********* compute the number of intervals in the mate1 **********
265   do 222 j = a,a+strbit-1
c  *******create random strings of 1 and 0********
		if(a.eq.c+1) goto 232  
		if(rchr(mate,j) .eq. 1) acc = acc + power2 
 		power2 = power2 * 2
c 	    power2 = 1.0
c         if(a.eq.c+1) goto 32  
c         write(*,*)'j j1 chrom',j,j1,oldchr1(j,j1)
 222	continue
	a=a+strbit
	power2=1
	goto 265

232   evalparta=acc
	return
	end


	function evalpartalim(rchr,mate,jcross) 
	common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
 
      common/data7/hstrno,cstrno,strno
  
      integer rchr(200,1000)
	integer power2,a,b,c,acc,mate,j,jcross
	power2=1
 	a=1
 	b=0
	d=1
      acc=0
	c=jcross*strbit  

c    ********* compute the number of intervals in the mate1 **********


	do j=1,c
	j1=j*strbit
     
	acc=acc+decode(rchr,j,int(strbit)) 
	end do 




	goto 11111



265   do 222 j = a,a+strbit-1
c  *******create random strings of 1 and 0********
		if(d.eq.c+1)then
		goto 232
		endif  
		if(rchr(mate,j) .eq. 1) acc = acc + power2 
 		power2 = power2 * 2
c 	    power2 = 1.0
c         if(a.eq.c+1) goto 32  
c         write(*,*)'j j1 chrom',j,j1,oldchr1(j,j1)
 		d=d+1
 222	continue
	a=a+strbit
	power2=1
	goto 265

232   evalpartalim=acc
11111	evalpartalim=acc
 
      return
	end



	subroutine repair(newchrom,number,oldval,newval)
	common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
 
      common/data7/hstrno,cstrno,strno
 
      integer newchrom(200,1000)
	integer  a,b,j,oldval ,newval,number 
	if(oldval.eq.newval)then 
	a=strno*strbit+oldval*tempbit
      do 10 j=a,lchrom
	newchrom(number,j)=0
10    continue	 
      endif
	
      if (newval.lt.oldval)then
	a=strno*strbit+newval*tempbit
	do 11 j=a,lchrom
	newchrom(number,j)=0
11	continue
	endif

 	if(newval.gt.oldval)then 
	a=strno*strbit+newval*tempbit
	b=strno*strbit+oldval*tempbit
	do 12 j=b,a
	newchrom(number,j)=iflip(0.5)
12	continue
	do 13 j=a,lchrom
	newchrom(number,j)=0
13	continue
	endif


	return
	end








	subroutine  prepsort(x,area,units,nparam,cost,dpen,dpen1)
      parameter (n=100)  
	integer a,c,b,d,coldstrno,m,p,o,n,hinterval 
	-,cinterval 
	real hotstr(n),hotstr1(n),thotin(n),thotout(n),z,hstream(n),
	-cstream(n) 
	real coldstr(n),tcoldin(n),tcoldout(n),coldstr1(n)
 	real dt
 	real combine 
 	real test(100)
    
!	real,dimension (1:100,3)::hottemper  
!      real,dimension (1:100,2)::thot 
	double precision x(nparam)
	integer nparam
      real thotsor(100)
	real thotsink(100)
      real tcoldsor(100)			  
	real tcoldsink(100)
!     	real cphot(3)
!	real cpcold(2)
	integer count,r,s 
!     have to change data values too 45645645
!      real x(13)	
	real temp1,temp2
	real areatotal,areautility,areahotutility,areacoldutility,
	-areaexchanger,area,areaex
	integer	numtotal,numutility,numhotutility,numcoldutility,
	-numexchanger,numunits,units
     	real oldrand(55), fix
      integer jrand
   	real pcu 
   	integer mark
     
     
      real hotutilcoff,coldutilcoff
     	real qhotutility,qcoldutility
	real cost 
     
      common/randvar/oldrand,jrand
      common/data1/hinterval,cinterval 
!	common/data2/cphot,cpcold
      common/data3/areatotal,numunits,areautility,numutility,
  	-areahotutility,numhotutility,areacoldutility,numcoldutility,
     -areaexchanger,numexchanger,areaex
	common/data4/hstrcoff,cstrcoff,hotutilcoff,coldutilcoff
	common/data5/qhotutility,qcoldutility
      common/data7/hstrno,cstrno,strno
      common/data8/cphot,cpcold
	common/data9/counter,mincounter,mincounter1,mincounter2
	-,mincounter3
	common/data30/thin,thout,tcin,tcout,qp,tcno,thno,no,ar 
	common/data1003/dpen2
	real cphot(100),cpcold(100)
      real hstrcoff(100),cstrcoff(100)
	real thin(100),thout(100),tcin(100),tcout(100),thno(100)
	-,tcno(100),qp(100),no,ar(100)
	real marker
      real dpen,dpen1,dpen2

!	hstrno=3
! 	cstrno=2 
! 	strno=hstrno+cstrno



!	do i=1,nparam
! 	x(i)= (anint(x(i)*100.0))/100.0
!      end do
 
	pcu=0.05d0

	dpen=0.0d0
	dpen1=0.0d0
	dpen2=0.0d0
	areatotal=0.0d0
      areautility=0.0d0
	areahotutility=0.0d0 
     	areacoldutility=0.0d0
	areaexchanger=0.0d0
	numtotal=0.0  
      numutility=0.0 
	numhotutility=0.0 
	numcoldutility=0.0 
	numexchanger=0.0 
	numunits=0.0 
	qcoldutility=0.0d0
	qhotutility=0.0d0
	units=0.0 
     	marker=0
	areaex=0.0d0
!	data x/0.0,1.0,5.0,1.0, 180.3372,187.101,236.8698,240.0,240.0,
!	- 240.0,150.0/

      thotsor(1)= 433.0d0
	thotsor(2)= 522.0d0
	thotsor(3)= 544.0d0
	thotsor(4)= 500.0d0
      thotsor(5)=	472.0d0

	thotsink(1)=366.0d0
	thotsink(2)=411.0d0
	thotsink(3)=422.0d0
	thotsink(4)=339.0d0
	thotsink(5)=339.0d0

	tcoldsor(1)= 355.0d0
	tcoldsor(2)= 366.0d0
	tcoldsor(3)= 311.0d0
	tcoldsor(4)= 333.0d0
	tcoldsor(5)= 389.0d0

	tcoldsink(1)= 450.0d0
	tcoldsink(2)= 478.0d0
	tcoldsink(3)= 494.0d0
	tcoldsink(4)= 433.0d0
	tcoldsink(5)= 495.0d0

!      data thotsink/343.0,288.0,500.0/
!      data tcoldsor/293.0,353.0/
!      data tcoldsink/493.0,383.0/ 
!      data cphot/4.0,6.0,2.0/
!     data cpcold/5.0,10.0/
!	data hstrcoff/2.0,0.2,5.0/
!	data cstrcoff/2.0,0.2/

!	hstrcoff(1)=2.0
!	hstrcoff(2)=0.2
!	hstrcoff(3)=5.0
     
!	cstrcoff(1)=2.0
!	cstrcoff(2)=0.2
!      hotutilcoff =2.0
!	coldutilcoff=2.0



!     common/data1/cphot,cpcold
!	common/data2/dt 
!	common/data3/coldstrno
!	common/data4/temp1,temp2
!	common/data5/combine

      dt=5.0
      a=0
	c=1
	b=0 
      d=0
	i=1
      r=0
	do   j=1,n
 	thotin(j)=0.0
	thotout(j)=0.0
	tcoldout(j)=0.0
	tcoldin(j)=0.0
	hstream(j)=0.0
	cstream(j)=0.0
 	thin(j)=0.0
     	thout(j)=0.0
	tcin(j)=0.0
	tcout(j)=0.0
	thno(j)=0.0
	tcno(j)=0.0
	qp(j)=0.0
!	no(j)=0.0
     	end do 
	no=0.0
	
       do 300 i=1,hstrno
		
		do j=1,n
	    hotstr(j)=0.0
		hotstr1(j)=0.0
		end do 
		
		do 301 j=1,x(i)
 		hotstr(j)=x(strno+j+a)
301		continue

	    hotstr(j)=thotsor(i)
	    hotstr(j+1)=thotsink(i)
	    a=a+x(i)
 	 
	    call sort11(hotstr)  
!	  	do 302 j=1,x(i)+2
!	    write(*,*)hotstr(j)
!302		continue
!	write(*,*)"	  "

	call delete(hotstr,count)
!		do 303 j=i,x(i)+2
!		write(*,*)hotstr(j)
!303		continue
!	write(*,*)count

	call copy(hotstr,hotstr1,r)
!	call sort(hotstr)
	
!      do 100 j=1,r 
!	write(*,*)hotstr1(j)
!100	continue 
       	
	
	b=b+r 

 	    do 303 k=c,b-1
		thotin(k)=hotstr1(k-d)
		thotout(k)=hotstr1(k+1-d)
!	    
	 	hstream(k)=i 
303		continue 

	c=c+r-1
	d=d+r-1

300   continue	
     

	hinterval=d
!    	do j=1,hinterval
!	write(*,*)thotin(j),thotout(j),hstream(j)
!     	end do 
!    	write(*,*)hinterval     
      
      b=0
	c=1
	d=0
       
		
  	do 400 i=hstrno+1,strno 
	
       do j=1,n
	 coldstr(j)=0.0
	 coldstr1(j)=0.0
	 end do  
     
     
     
      do 401 j=1,x(i)
 		coldstr(j)=x(strno+j+a)
401		continue

	    coldstr(j)=tcoldsink(i-hstrno)
	    coldstr(j+1)=tcoldsor(i-hstrno)
	    a=a+x(i)
 
	call sort11(coldstr)  
	  	
!	pause
!	 	  do 402 j=1,x(i)+2
!	    write(*,*)coldstr(j)
!402		continue
!	  pause
 		call delete(coldstr,count)
!
     		call copy(coldstr,coldstr1,r)
!     	      do 200 j=1,r 
!    	 write(*,*)coldstr1(j)
!200  	continue 
       	
	
     	b=b+r 
	  
 	    do 403 k=c,b-1
		tcoldout(k)=coldstr1(k-d)
		tcoldin(k)=coldstr1(k+1-d)
!	    
	cstream(k)=i-hstrno 
403		continue 

	c=c+r-1
	d=d+r-1

400   continue	
     	cinterval=d
!   	do j=1,cinterval
!	write(*,*)tcoldout(j),tcoldin(j),cstream(j)
!   	end do 
!   	write(*,*)cinterval    
!	pause
     	
!	the mapping code starts here ......
     
    	
!     aadi 
!	call randomize
	p=1

	do 1000  p=1,1000
 		if(hinterval.eq.0.and.cinterval.ne.0)then
		goto 1020
		endif
		
		if(cinterval.eq.0.and.hinterval.ne.0)then
!		map all the hot substreams to cold utility 
		goto 1030
!		call coldutilityall(thotin,thotout,hstream,p,hinterval) 
!	    goto 1000
	    endif


!		picking up random hot substream 
    		a=irnd(1,hinterval) 
!	write(*,*)'enter a'
!	read(*,*)a
!		picking a number which denotes the max number of time we pick a cold sub stream 
!		c=irnd(1,cinterval)
		c=cinterval
		do 1001 j=1,c
			if(iflip(pcu).eq.1)then
!			match it to cold utility
			call coldutility(thotin,thotout,hstream,a)   
			do g=a,hinterval 
			thotin(g)=thotin(g+1)
			thotout(g)=thotout(g+1)
			hstream(g)=hstream(g+1)
 			end do 
			hinterval=hinterval-1

			goto 1000 
  			end if

!			picking a cold sub stream to be matched 
			b=irnd(1,cinterval)
!			write(*,*)'enter b'
!			read(*,*)b


			mark=0
			if((thotin(a).ge.tcoldout(b)+10.0).and.(thotout(a).ge.
	-		tcoldin(b)+10.0))then 
      		r=hstream(a)
			s=cstream(b)
			qhot=cphot(r)*(thotin(a)-thotout(a))
			qcold=cpcold(s)*(tcoldout(b)-tcoldin(b))
				if(qhot.ge.qcold)then 
!				match the streams and the excess heat is cooled by a cold utility 
				marker=0.0
				call match(thotin(a),thotout(a),hstream(a),qhot,
	-			tcoldout(b),tcoldin(b),cstream(b),qcold,marker) 
	  			mark=1.0
!				write(*,*)'back in main'
!				write(*,*)' thotin(a) ',thotin(a)
!				write(*,*)' thotout(a) ',thotout(a)
				if(marker.eq.0.0)then
	            do g=a,hinterval 
				thotin(g)=thotin(g+1)
				thotout(g)=thotout(g+1)
				hstream(g)=hstream(g+1)
 				end do 
				hinterval=hinterval-1
				else
					if(a.ne.hinterval.and.hinterval.gt.1.and.
  	-				hstream(a).eq.hstream(a+1).and.thotout(a)
     -				.eq.thotin(a+1))then

					thotin(a+1)=marker
					dpen=dpen+marker-thotout(a)
					do g=a,hinterval 
					thotin(g)=thotin(g+1)
					thotout(g)=thotout(g+1)
					hstream(g)=hstream(g+1)
 					end do 
					hinterval=hinterval-1
					else
					thotin(a)=marker
					dpen=marker-thotout(a)
					endif
				endif

!					write(*,*)' thotin(a)after 	',thotin(a)
				
				do h=b,cinterval 
				tcoldin(h)=tcoldin(h+1)
				tcoldout(h)=tcoldout(h+1)
				cstream(h)=cstream(h+1)
				end do 
				cinterval=cinterval-1
				goto 1000
				
				
!				go to ..continue 
				
				
				else
				goto 1001 
				endif
			
			else
			goto 1001
	        endif
1001		continue

!		check the sub stream is mapped or not 
!		map the substring to cold utility 

 		if(mark.eq.0)then  
		call coldutility11(thotin(a),thotout(a),hstream(a))
		do g=a,hinterval
		thotin(g)=thotin(g+1)
		thotout(g)=thotout(g+1)
		hstream(g)=hstream(g+1)
 		end do 
!		write(*,*)hinterval
		hinterval=hinterval-1
		endif 

!	    callss a subroutine to delete the qentry 
1000		continue
	    
		
1020		if (cinterval.ne.0) then 
		mark=3 
		endif 
!		pause 

	    if((mark.eq.3).and.(hinterval.eq.0))then
!		map to the hot utility 
		do h=1,cinterval 
		call hotutility(tcoldout(h),tcoldin(h),cstream(h)) 
		end do 
	    cinterval=0 
	    endif

1030		if(cinterval.eq.0.and.hinterval.ne.0)then
		do a=1,hinterval
		call coldutility(thotin,thotout,hstream,a)   
		end do
		hinterval=0
		endif
      
     	dpen1=dpen2


      call costcal(cost)
	if(cost.le.43800)then
!	endif
	write(2006,*)'***************************************************' 
      do ex=1,no
!	write(*,9923)thin(ex),thout(ex),int(thno(ex)),tcout(ex),tcin(ex),
!	-int(tcno(ex)),qp(ex),ar(ex)
!	write(*,*)'*'
     
      write(2006,9923)thin(ex),thout(ex),int(thno(ex)),tcout(ex),
	-tcin(ex),int(tcno(ex)),qp(ex),ar(ex)
	end do 
9923	format(f12.5,f12.5,5x,i1,f12.5,f12.5,5x,i1,f12.5,f20.5)
	write(2006,*)cost,qcoldutility,qhotutility,numunits
	write(112,*)cost,qcoldutility,qhotutility,numunits
      do i=1,nparam
	write(2006,*)'x(i)--->',x(i)
     	enddo
      endif
!     	write(*,*)' qcoldutility',qcoldutility
!	write(*,*)' qhotutility',qhotutility 
!	write(*,*)' area',areatotal
!	write(*,*)' cost',cost
!	write(*,*)' numunits',numunits
 !     pause
!	write(2006,*)'***************************************************'
!      do i=1,nparam
!	write(*,*)x(i)
!	end do
!	pause
!	endif

!5x,f12.5,5X,I1,1X,f12.5,1x,f12.5,5X,I1,1X,
! 	-f12.5)

!      pause

!	pause


! 	write(*,*)"	 "
!      write(*,*)"	 "
!	write(*,*)"	 " 
!      write(*,*)areatotal,numunits,cost
!	pause
     
     	if(counter.gt.mincounter.and.counter.lt.mincounter1)then
      write(121,*)"	"
	write(121,*)"	"
!	write(1111,*)"	"
!	write(1111,*)"	"
      write(121,*)areatotal,numunits,cost
! 	write(1111,*)areatotal,numunits,cost
	write(121,*)"_____________________________________________________
	&__________________________"
!	write(1111,*)"____________________________________________________
!	&__________________________"
     	endif
	
	if(counter.gt.mincounter1.and.counter.lt.mincounter2)then
      write(122,*)"	"
	write(122,*)"	"
!	write(1111,*)"	"
!	write(1111,*)"	"
      write(122,*)areatotal,numunits,cost
! 	write(1111,*)areatotal,numunits,cost
	write(121,*)"_____________________________________________________
	&__________________________"
!	write(1111,*)"____________________________________________________
!	&__________________________"
     	endif
     
      if(counter.gt.mincounter2.and.counter.lt.mincounter3)then
      write(123,*)"	"
	write(123,*)"	"
!	write(1111,*)"	"
!	write(1111,*)"	"
      write(123,*)areatotal,numunits,cost
! 	write(1111,*)areatotal,numunits,cost
	write(123,*)"_____________________________________________________
	&__________________________"
!	write(1111,*)"____________________________________________________
!	&__________________________"
     	endif
		
	if(counter.gt.mincounter3)then
      write(124,*)"	"
	write(124,*)"	"
!	write(1111,*)"	"
!	write(1111,*)"	"
      write(124,*)areatotal,numunits,cost
! 	write(1111,*)areatotal,numunits,cost
	write(124,*)"_____________________________________________________
	&__________________________"
!	write(1111,*)"____________________________________________________
!	&__________________________"
   	endif	
		   
	units=numunits
   	area=areatotal

	counter=counter+1

!	if (units.lt.4)then
!	pause
!	endif 
     
!	write(*,*)'hotutility  ',qhotutility,' coldutility  ',qcoldutility 
!      pause

!	if(cost-96.0.le.0.01)then
!	cost=130
!	endif 
      

!	write(*,*)cost,units
!	pause 
	
!      write(*,*)counter
!	pause
	return
	end subroutine prepsort
     
     	     

      subroutine sort11(hotstr)
	
      parameter (n=100)
    	real hotstr(n)
	real temp	
 		
    	do i=1,n-1
       do j = i+1,n
        if(hotstr(i).le.hotstr(j)) then
         temp=hotstr(i)
	   hotstr(i)=hotstr(j)
	   hotstr(j)=temp         	   
        end if
       end do			 
      end do

 	return
	end  

	subroutine delete(hotstr,count)
	parameter (n=100)
      real hotstr(n)
	real temp	
	integer count
	 count=0
    	do i=1,n-1
       do j = i+1,n
        if(hotstr(i).eq.hotstr(j)) then
   !      temp=hotstr(i)
!   hotstr(i)=hotstr(j)
	   hotstr(j)=0 
	   count=count+1        	   
       end if
       end do			 
      end do

 	  return
	  end 

	subroutine copy(hotstr,hotstr1,r) 
	parameter (n=100)
	real hotstr(n),hotstr1(n)
	integer r 
	r=1
      do 11 j=1,n
		if(hotstr(j).neqv.0)then 
		hotstr1(r)=hotstr(j)
		r=r+1
		end if
11	continue  
	r=r-1
      return 
	end


	subroutine coldutilityall(thotin,thotout,hstream,p,hinterval)
	parameter (n=100)
	common/data8/cphot,cpcold
	common/data9/counter,mincounter,mincounter1,mincounter2
	-,mincounter3

	real cphot(100),cpcold(100)
 
      real thotin(n),thotout(n),hstream(n),qhot
	integer p , hinterval, r
	do j=p,hinterval
		r=hstream(p)
		qhot=cphot(r)*(thotin(p)-thotout(p))
!		write(*,*)'cold utility',thotin(p),thotout(p),r,qhot  
		
!		if(counter.ge.mincounter)then
!		write(1111,1)'cold utility',thotin(p),thotout(p),r,qhot
!1      	format(1X,15X,"cold uitlity",f10.5,f10.5,I5,f10.5)
!		endif	
		
	call areacoldutil(thotin(p),thotout(p),hstream(p),qhot)  
     
      end do 
	p=hinterval 
	return 
	end subroutine coldutilityall 
	 
      
	subroutine coldutility(thotin,thotout,hstream,p)
	parameter (n=100)
	common/data8/cphot,cpcold
	common/data9/counter,mincounter,mincounter1,mincounter2
	-,mincounter3

	real cphot(100),cpcold(100)
 
      real thotin(n),thotout(n),hstream(n),qhot
	integer p,r   
	r=hstream(p)
	qhot=cphot(r)*(thotin(p)-thotout(p))
	
!      if(counter.ge.mincounter)then
!	write(1111,2)thotin(p),thotout(p),r,qhot
!2	format(1X,15X,"cold uitlity",f10.5,f10.5,I5,f10.5)
!	endif 
     
!      write(*,*)'cold utility',thotin(p),thotout(p),r,qhot 
      call areacoldutil(thotin(p),thotout(p),hstream(p),qhot)
!	pause
!    	do i=p,hinterval-1 
!     thotin(p)=thotin(p+1)
!	thotout(p)=thotout(p+1)
!	hstream(p)=hstream(p+1)
!	end do 
!	hinterval= hinterval-1
	return 
	end	subroutine coldutility



	subroutine match(thotin ,thotout ,hstream ,qhot,tcoldout 
	-			,tcoldin ,cstream ,qcold,marker) 
	common/data8/cphot,cpcold
	common/data9/counter,mincounter,mincounter1,mincounter2
	-,mincounter3

	real cphot(100),cpcold(100)

	real thotin,thotout,tcoldin,tcoldout,hstream,cstream,qhot,
	-qcold,thottemp,qhottemp,marker,thottemp1
	integer r,s,z,x
	z=int(hstream)
	x=int(cstream)
		 
     	thottemp=thotin-qcold/cphot(hstream)
!	write(*,*)thotout,thottemp
!	pause
     
     
!      write(*,3)thotin,thottemp,z,tcoldout,tcoldin,
!	-x,qcold 
! 	write(*,*)'marker---',marker
!	if(counter.ge.mincounter)then 
!      write(1111,3)thotin,thottemp,z,tcoldout,tcoldin,
!	-x,qcold
!3	format(1X,"match",8X,f12.5,f12.5,5X,I1,1X,f12.5,f12.5,5X,I1,1X,
!	-f12.5)
!	endif
!	write(*,*)'entered match'


	thottemp1=(anint(thottemp*100.0d0)/100.0d0)
	if(thottemp.gt.thottemp1.and.thottemp1-thotout.le.0.01)then
	call areaexch(thotin,thottemp1,hstream,tcoldout,tcoldin,
 	-cstream,qcold) 
	marker=0.0
	goto 25
      else
	call areaexch(thotin,thottemp,hstream,tcoldout,tcoldin,
	-cstream,qcold) 
	endif


!	write(*,*)qhot,qcold
!	pause
      if(qhot.eq.qcold)then
      marker=0.0
	goto 25
 	endif

!1     format(1X,f10.5,1X,f10.5,1X,f10.5,1X,f10.5,1X,f10.5,1X,f10.5,
!	-1X,f10.5)


!	 thes two statements to unndo karro


	
!     	if(iflip(pcu).eq.1)then
!	z=int(hstream)
!	qhottemp=cphot(hstream)*(thottemp-thotout)
 !     call areacoldutil(thottemp,thotout,hstream,qhottemp)
!	else
      marker=thottemp
!	endif


!	write(*,*)' marker---',marker
!	write(*,2)thottemp,thotout,z,qhottemp   
     	
!	if(counter.ge.mincounter)then
!      write(1111,2)thottemp,thotout,z,qhottemp
!2	format(1X,"coldutility",2X,f12.5,f12.5,5X,I1,1X,31X,f12.5)
!	endif
	


!2     format(1X,f10.5,1X,f10.5,1X,f10.5,1X,f10.5)
!	pause
25    return
	end subroutine match 



	subroutine hotutility(tcoldout,tcoldin,cstream) 
	
      common/data8/cphot,cpcold
	common/data9/counter,mincounter,mincounter1,mincounter2
	-,mincounter3

	real cphot(100),cpcold(100)
! 	parameter (n=100)
      real tcoldout,tcoldin,qcold
 	real cstream 
	integer x
	x=int(cstream)
      qcold=cpcold(cstream)*(tcoldout-tcoldin)
!	write(*,4)tcoldout,tcoldin,x,qcold 
	
!	if(counter.ge.mincounter)then
!      write(1111,4)tcoldout,tcoldin,x,qcold 
!4	format(1X,"hotutility",34X,f12.5,f12.5,5X,I1,1X,f12.5)
!	endif
	call areahotutil(tcoldout,tcoldin,cstream,qcold)
 
     
!     pause
      return 
	end subroutine hotutility  


	subroutine coldutility11(thotin,thotout,hstream)
      common/data8/cphot,cpcold
		common/data9/counter,mincounter,mincounter1,mincounter2
	-,mincounter3

	real cphot(100),cpcold(100)

	real thotin,thotout,hstream,qhot
	
      integer r,z
	z=int(hstream)
	qhot=cphot(hstream)*(thotin-thotout)
!	write(*,1)thotin,thotout,z,qhot
	
!     if(counter.ge.mincounter)then
!     write(1111,1)thotin,thotout,z,qhot 
!1     format(1X,"coldutility",2X,f12.5,f12.5,5X,I1,1X,31X,f12.5)
!	endif

	call areacoldutil(thotin,thotout,hstream,qhot)
!	  pause
      return
	end subroutine coldutility11



	subroutine areaexch(thotin,thotout,hstream,tcoldout,tcoldin,
	
     -cstream,qduty) 

      common/data3/areatotal,numunits,areautility,numutility,
  	-areahotutility,numhotutility,areacoldutility,numcoldutility,
     -areaexchanger,numexchanger,areaex
	common/data4/hstrcoff,cstrcoff,hotutilcoff,coldutilcoff
 	common/data9/counter,mincounter,mincounter1,mincounter2
	-,mincounter3
	common/data30/thin,thout,tcin,tcout,qp,tcno,thno,no,ar 
	common/data1003/dpen2


     	real thin(100),thout(100),tcin(100),tcout(100),thno(100)
 	-,tcno(100),qp(100),no,ar(100) 

	real hstrcoff(100),cstrcoff(100),hotutilcoff,coldutilcoff
	real u1,u2,r,s 
	integer z,x
	
	real dpen2
      real delta1,delta2
      real thotin,thotout,hstream,tcoldout,tcoldin,cstream,lmtd,qduty,u
	r=hstream
	s=cstream
	u1=hstrcoff(r)
	u2=cstrcoff(s)
	z =int(hstream)
     	x =int(cstream)
       
!	u=1/(1/u1+1/u2)
!     lmtd=((thotin-tcoldout)-(thotout-tcoldin))/log((thotin-tcoldout)
!	-/(thotout-tcoldin))

	u=0.852d0

	delta1=thotin-tcoldout
      delta2=thotout-tcoldin

!	if(delta1.eq.delta2)then
     	lmtd=(delta1*delta2*(delta1+delta2)/2.0)**(0.3333d0) 
!     	else
!	lmtd=(delta1-delta2)/(log(delta1/delta2))
!     	endif
     
      temparea=qduty/(lmtd*u)
    	areaexchanger=areaexchanger+temparea
	numexchanger=numexchanger+1
	areaex=areaex+temparea**0.6
	areatotal=areatotal+temparea
	numunits=numunits+1
!     write(*,*)temparea,numexchanger 
!    	write(*,5)thotin,thotout,z,tcoldout,tcoldin,x,qduty
!	-,temparea
      
	if(counter.ge.mincounter.and.counter.lt.mincounter1)then
	write(121,5)thotin,thotout,z,tcoldout,tcoldin,x,qduty
	-,temparea
5	format(1X,"match",7X,f12.5,f12.5,5X,I1,1X,f12.5,f12.5,5X,I1,
	-f12.5,f12.5)
	goto 0001
      endif

	if(counter.ge.mincounter1.and.counter.lt.mincounter2)then
	write(122,5)thotin,thotout,z,tcoldout,tcoldin,x,qduty
	-,temparea
15	format(1X,"match",7X,f12.5,f12.5,5X,I1,1X,f12.5,f12.5,5X,I1,
	-f12.5,f12.5)
	goto 0001
      endif
	
      if(counter.ge.mincounter2.and.counter.lt.mincounter3)then
	write(123,5)thotin,thotout,z,tcoldout,tcoldin,x,qduty
	-,temparea
25	format(1X,"match",7X,f12.5,f12.5,5X,I1,1X,f12.5,f12.5,5X,I1,
	-f12.5,f12.5)
	goto 0001
      endif
	  
	if(counter.ge.mincounter3)then
	write(124,5)thotin,thotout,z,tcoldout,tcoldin,x,qduty
	-,temparea
35	format(1X,"match",7X,f12.5,f12.5,5X,I1,1X,f12.5,f12.5,5X,I1,
	-f12.5,f12.5)
	goto 0001
      endif     
	
0001  no=no+1
	thin(no) =	thotin
	thout(no)=	thotout
	thno(no) = 	z
      tcout(no)=	tcoldout
	tcin(no) =	tcoldin
	tcno(no) =	x
	qp(no)	 =	qduty
	ar(no)	 =	temparea

      if(temparea.le.0.5d0)then
 	dpen2=dpen2+temparea    
      endif



      return
	end subroutine areaexch




	subroutine areacoldutil(thotin,thotout,hstream,qduty)

      common/data3/areatotal,numunits,areautility,numutility,
  	-areahotutility,numhotutility,areacoldutility,numcoldutility,
     -areaexchanger,numexchanger,areaex
	common/data4/hstrcoff,cstrcoff,hotutilcoff,coldutilcoff
 	common/data5/qhotutility,qcoldutility
 	common/data9/counter,mincounter,mincounter1,mincounter2
	-,mincounter3
	common/data30/thin,thout,tcin,tcout,qp,tcno,thno,no,ar 
 	common/data1003/dpen2

	real thin(100),thout(100),tcin(100),tcout(100),thno(100)
 	-,tcno(100),qp(100),no,ar(100)

	real hstrcoff(100),cstrcoff(100),hotutilcoff,coldutilcoff
	real u1,u2,r,dpen2 
 	real thotin,thotout,hstream,qduty,lmtd,temparea,u 
	real tcutilityin,tcutilityout,delta1,delta2
	integer z
 	
      r=hstream 
	
     	u1=hstrcoff(r)
	u2=coldutilcoff
     	z=int(hstream)
     
      tcutilityin =311.0d0
	tcutilityout=355.0d0 
!	tcutilityout=40.0

!	u=1/(1/u1+1/u2)
 
!     	u=1.2

	u=0.852d0

!     lmtd=((thotin-tcutilityout)-(thotout-tcutilityin))/log((thotin-
!	-tcutilityout)/(thotout-tcutilityin))
     	
!	if(delta1.le.0.0)then
!	temparea=30000
!	goto 10 
!	endif

!	write(*,*)' thotin out',thotin,thotout

	delta1=thotin-tcutilityout
      delta2=thotout-tcutilityin
!	write(*,*)delta1,delta2

	if(delta1.le.10.0.or.delta2.le.10.0)then
	temparea=100000
	qduty=1000000
	areaex=areaex+temparea**0.6
!	write(*,*)' thotin out',thotin,thotout
!      write(*,*)delta1,delta2
!	write(*,6)thotin,thotout,z,tcutilityout,tcutilityin,qduty,
!	-temparea
!	pause

	goto 100
	endif   

     	
	
     
     
!	if(delta1.eq.delta2)then
     	lmtd=(delta1*delta2*(delta1+delta2)/2)**(0.3333) 
!     	else
!	lmtd=(delta1-delta2)/(log(delta1/delta2))
!     	endif
     
      temparea =qduty/(u*lmtd)
	areaex=areaex+temparea**0.6
!	write(*,6)thotin,thotout,z,tcutilityout,tcutilityin,qduty,temparea
!      if(temparea.eq.0)then
!	pause
!	endif

 100	if(counter.ge.mincounter.and.counter.lt.mincounter1)then
	write(121,6)thotin,thotout,z,tcutilityout,tcutilityin,qduty,
	-temparea
6	format(1X,"coldutility",1X,f12.5,f12.5,5X,I1,1X,f12.5,f12.5,6X, 
	-f12.5,f12.5)
 	goto 10
      endif

	if(counter.ge.mincounter1.and.counter.lt.mincounter2)then
	write(122,6)thotin,thotout,z,tcutilityout,tcutilityin,qduty,
	-temparea
16	format(1X,"coldutility",1X,f12.5,f12.5,5X,I1,1X,f12.5,f12.5,6X, 
	-f12.5,f12.5)
 	goto 10
      endif

	if(counter.ge.mincounter2.and.counter.lt.mincounter3)then
	write(123,6)thotin,thotout,z,tcutilityout,tcutilityin,qduty,
	-temparea
26	format(1X,"coldutility",1X,f12.5,f12.5,5X,I1,1X,f12.5,f12.5,6X, 
	-f12.5,f12.5)
 	goto 10
      endif

	if(counter.ge.mincounter3)then
	write(124,6)thotin,thotout,z,tcutilityout,tcutilityin,qduty,
	-temparea
36	format(1X,"coldutility",1X,f12.5,f12.5,5X,I1,1X,f12.5,f12.5,6X, 
	-f12.5,f12.5)
 	goto 10
      endif


10    areautility=areautility+temparea 
	numutility=numutility+1
	
      areatotal=areatotal+temparea
	numunits=numunits+1

	areacoldutility=areacoldutility+temparea
	numcoldutility=numcoldutility+1

	qcoldutility=qcoldutility+qduty

      no=no+1
 	thin(no) =	thotin
	thout(no)=	thotout
	thno(no) = 	z
      tcout(no)=	tcutilityout
	tcin(no) =	tcutilityin
	tcno(no) =	100
	qp(no)	 =	qduty
	ar(no)	 =	temparea

      if(temparea.le.0.5d0)then
 	dpen2=dpen2+temparea    
	endif


	return
	end subroutine areacoldutil

	
	subroutine areahotutil(tcoldout,tcoldin,cstream,qduty)
	
	real tcoldout,tcoldin,cstream,lmtd,temparea,u
  	real thutilityin,thutilityout,delta1,delta2
 
	
      common/data3/areatotal,numunits,areautility,numutility,
  	-areahotutility,numhotutility,areacoldutility,numcoldutility,
     -areaexchanger,numexchanger,areaex
	common/data4/hstrcoff,cstrcoff,hotutilcoff,coldutilcoff
	common/data5/qhotutility,qcoldutility
      common/data9/counter,mincounter,mincounter1,mincounter2
	-,mincounter3
	common/data30/thin,thout,tcin,tcout,qp,tcno,thno,no,ar 
	common/data1003/dpen2

      real thin(100),thout(100),tcin(100),tcout(100),thno(100)
 	-,tcno(100),qp(100),no,ar(100)
 
      real hstrcoff(100),cstrcoff(100),hotutilcoff,coldutilcoff
	real u1,u2,r,dpen2 
	integer x
	x=int(cstream)
	u1=cstrcoff(cstream)
	u2=hotutilcoff

!	u=1/(1/u1+1/u2)

      u=1.136d0
	thutilityin = 509.0d0 
	thutilityout= 509.0d0 

!	lmtd=((thutilityin-tcoldout)-(thutilityout-tcoldin))/log(
!	-(thutilityin-tcoldout)/(thutilityout-tcoldin))
	
	delta1=thutilityin-tcoldout
	delta2=thutilityout-tcoldin

	if(delta1.lt.10.0)then
	temparea=100000
	areaex=areaex+temparea**0.6
	goto 1011
	endif

!	if(delta1.eq.delta2)then
     	lmtd=(delta1*delta2*(delta1+delta2)/2)**(0.3333) 
!     	else
!	lmtd=(delta1-delta2)/(log(delta1/delta2))
!     	endif

	temparea =qduty/(u*lmtd)
	areaex=areaex+temparea**0.6
!	write(*,*)'jnjkn b'
!      write(*,7)thutilityin,thutilityout,tcoldout,tcoldin,x,
!	-qduty,temparea
	
1011 	if(counter.ge.mincounter.and.counter.lt.mincounter1)then
      write(121,7)thutilityin,thutilityout,tcoldout,tcoldin,x,
	-qduty,temparea
7	format(1X,"hotutility",2X,f12.5,f12.5,7X,f12.5,f12.5,5X,I1, 
	-f12.5,f12.5)
     	goto 0002
	endif

	if(counter.ge.mincounter1.and.counter.lt.mincounter2)then
      write(122,7)thutilityin,thutilityout,tcoldout,tcoldin,x,
	-qduty,temparea
17	format(1X,"hotutility",2X,f12.5,f12.5,7X,f12.5,f12.5,5X,I1, 
	-f12.5,f12.5)
      goto 0002
	endif

	if(counter.ge.mincounter2.and.counter.lt.mincounter3)then
      write(123,7)thutilityin,thutilityout,tcoldout,tcoldin,x,
	-qduty,temparea
27	format(1X,"hotutility",2X,f12.5,f12.5,7X,f12.5,f12.5,5X,I1, 
	-f12.5,f12.5)
     	goto 0002
	endif


	if(counter.ge.mincounter3)then
      write(124,7)thutilityin,thutilityout,tcoldout,tcoldin,x,
	-qduty,temparea
37	format(1X,"hotutility",2X,f12.5,f12.5,7X,f12.5,f12.5,5X,I1, 
	-f12.5,f12.5)
     	goto 0002
	endif

0002  areautility=areautility+temparea 
 	numutility=numutility+1
	
      areatotal=areatotal+temparea
	numunits=numunits+1

	areahotutility=areahotutility+temparea
	numhotutility=numhotutility+1
	
      qhotutility=qhotutility+qduty
		     	
      no=no+1
 	thin(no) =	thutilityin
	thout(no)=	thutilityout
	thno(no) = 	100
      tcout(no)=	tcoldout
	tcin(no) =	tcoldin
	tcno(no) =	x
	qp(no)	 =	qduty
	ar(no)	 =	temparea

	if(temparea.le.0.5d0)then
 	dpen2=dpen2+temparea    
	endif


 	return
	end	subroutine areahotutil


!	subroutine costexch(area,mark)
 

	subroutine costcal(cost)

	real a,b,c,i,t,cu,hu,arr
 	real costcapital,costenergy,cost
 
      common/data3/areatotal,numunits,areautility,numutility,
  	-areahotutility,numhotutility,areacoldutility,numcoldutility,
     -areaexchanger,numexchanger,areaex
!	common/data4/hstrcoff,cstrcoff,hotutilcoff,coldutilcoff
	common/data5/qhotutility,qcoldutility
	common/data9/counter,mincounter,mincounter1,mincounter2
	-,mincounter3

	a=1456.3
	b=0.6
 	cu=5.0e-5
	hu=1.0e-3
	arr=0.1
    !  write(*,*)areatotal,qcoldutility,hotutility
	costcapital= arr*a*areaex
!	costenergy = cu/(1.0/1000.0*(180.0-100.0))*qcoldutility
!	-+hu/(767.5/1000.0)*qhotutility
!	costenergy = costenergy*8500.0


	costenergy=37.64*qhotutility + 18.12*qcoldutility

!      costcapital= 6250+83.26*(areaexchanger+areacoldutility)+ 
!	-6250+99.91*areahotutility 
     
      cost=costcapital+costenergy

!	cost=hu/(1.785*1000.0e0)*qhotutility*3600.0*8400

!	write(*,*)'cost',cost


!	cost=qhotutility+qcoldutility
      return			  
	end subroutine costcal 
 


	subroutine crossover(ipop,mate1,mate2,rchr,
     -         newchrom)
      common/sgaparam/ipopsize,lchrom,maxgen,ncross,
     -         nmute,pcross,pmute,nparam,pjump, 
     -tempbit,strbit
 
      common/data7/hstrno,cstrno,strno
 
	common/data6/pmjg,pcrossparta,pcrosspartalim

 

      integer rchr(200,1000) ,temp1(1000),temp2(1000)
      integer newchrom(200,1000),jcross
	double precision tempe


!	integer acc1,acc2,newacc1,newacc2,mutacc1,mutacc2,q
	integer mjgsite,j1
 
	if(iflip(pcrosspartalim).eq.1)then
	jcross=irnd(1,int(strno))
      	 
      do j = 1,jcross*strbit
      newchrom(ipop,  j) =  rchr(mate1,j) 
      newchrom(ipop+1,j) =  rchr(mate2,j) 
 	end do 
 
	do j=jcross*strbit+1,strno*strbit
	newchrom(ipop,  j) =  rchr(mate2,j) 
      newchrom(ipop+1,j) =  rchr(mate1,j) 
	end do 
      
	r = evalpartalim(rchr,mate1,int(jcross*strbit)) 	 
     	s =	evalpartalim(rchr,mate2,int(jcross*strbit))   
     
      do j=strno*strbit+1,r 
     	newchrom(ipop  ,j) = rchr(mate1,j)
     	end do 
     	
	do j=strno*strbit+1,s
	newchrom(ipop+1,j) = rchr(mate2,j)
	end do 
     
     	count1=0
	count2=0
      do j=r+1,lchrom
     	temp1(j-r)=rchr(mate1,j)
	count1=count1+1
      end do 

	do j=s+1,lchrom
	temp2(j-s)=rchr(mate2,j)
	count2=count2+1
      end do 

	       
	do j=1,count1  
	newchrom(ipop+1,s+j)=rchr(mate1,j)
      end do 

	do j=1,count2
	newchrom(ipop,r+j)=rchr(mate2,j)
	end do 



	goto 1111
	
     
      endif 
     
     
     
      
	
     
     
1211  if(iflip(pcrossparta).eq.1)then
    	jcross=irnd(1,int(strno*strbit))
   	ncross=ncross+1
	goto 2007
	endif  
	





      If(iflip(pcross) .eq. 1) then
c.....if yes, create a random cross site
      jcross = irnd(int(1),lchrom-1)
c     write(*,*)'jcross',jcross
      ncross = ncross + 1
      else 
	jcross = lchrom
 !     pause
	endif
 	 
2007	do 1711 j = 1,jcross
      newchrom(ipop,  j) =  rchr(mate1,j) 
      newchrom(ipop+1,j) =  rchr(mate2,j) 
 1711 continue

      do 1712 j = jcross+1,lchrom
      newchrom(ipop,  j) = rchr(mate2,j)
      newchrom(ipop+1,j) = rchr(mate1,j)
 1712 continue

 
1111	do 1810 j=1,lchrom
	newchrom(ipop,  j) = mutation(newchrom(ipop,j))
      newchrom(ipop+1,j) = mutation(newchrom(ipop+1,j))
1810  continue

 

!	***************************************check this kuch naya a soocho 
 	if(jcross.eq.lchrom) then
		do i =ipop,ipop+1
c	write(*,*)'ipop',i
c	do j = 1, lchrom
c	write(*,*)'initial string',i,j,newchrom(i,j)
c	end do
c	pause
			mjjump=0
			if(iflip(pjump).eq.1)then
			jjump1 = irnd(int(strno*strbit),lchrom-1)
			jjump2 = irnd(int(strno*strbit),lchrom-1)
			else
!c			write (*,*)'I am in dead zone going to 251'   
			jjump1 = jjump2
			goto  251
			endif
 
			if (jjump1 .gt. jjump2)	then 
			tempe = jjump1
			jjump1 = jjump2
			jjump2 = tempe	 
			endif
!			q=iflip(0.5)
			do j1 = jjump1+1, jjump2
c  *******create random strings of 1 and 0********
			newchrom(i,j1) = iflip(0.5)
!c			oldchr1(j,j1) = chr(j1)
!c            write(*,*)'j j1 chrom',j,j1,oldchr1(j,j1)
			end do


251		if(iflip(pmjg).eq.1)then
			mjgsite = irnd(1,nparam)
!			b=iflip(0.5)
			if(mjgsite.lt.strno)then
				a=mjgsite*strbit
				do j1=a+1,a+strbit
				newchrom(i,j1)=iflip(0.5)

!				write(*,*)newchrom(i,j1),rchr(i,j1),mjgsite
				end do 
 		
			else
				a=strno*strbit+(mjgsite-strno)*tempbit 
				do j1=a+1,a+tempbit
				newchrom(i,j1)=iflip(0.5)

!				write(*,*)newchrom(i,j1),rchr(i,j1),mjgsite
				end do 
			endif
!	pause
	
     
     		endif
     
		end do 
	endif
	
 
 !	mjg where a single lstring is set to zero ....
!	  do i =ipop,ipop+1
!		if(iflip(pmjg).eq.1)then
!		mjgsite = irnd(int(strno),nparam)
!		b=iflip(0.5)
!		a=strno*strbit+(mjgsite-strno)*tempbit 
!		
!		do j1=a+1,a+tempbit
!		newchrom(i,j1)=b
!		write(*,*)newchrom(i,j1),rchr(i,j1),mjgsite
!		end do 
!		endif
!    	end do 
!	  pause









!       jjump = 0
!       If(iflip(pjump) .eq. 1) then
!c	    write(*,*)'lets do jumping genes'
!c.....if yes, create a random cross site
!         jjump1 = irnd(strno*strbit,lchrom-1)
!	   jjump2 = irnd(strno*strbit,lchrom-1)
!c	   write(*,*)'jjjjj',jjump1,jjump2
!c         write(*,*)'jcross',jcross
!c         ncross = ncross + 1
!       else
!c	   write (*,*)'I am in dead zone going to 251'   
!	   jjump1 = jjump2
!	   goto  251
!       endif
! 
!	if (jjump1 .gt. jjump2)	then 
!      tempe = jjump1
!	 jjump1 = jjump2
!	 jjump2 = tempe	 
!	endif
!	do j1 = jjump1+1, jjump2
!c  *******create random strings of 1 and 0********
!        newchrom(i,j1)     = iflip(0.5)
!c           oldchr1(j,j1) = chr(j1)
!c            write(*,*)'j j1 chrom',j,j1,oldchr1(j,j1)
!      end do
!c	do j = 1, lchrom
!c	 write(*,*)'initial string',i,j,newchrom(i,j)
!c	end do
	
     	
!251	end do  
	    
      return
      end