c					GUY_MODULAR_CH.FOR (ULTIMA MODIFICA: 11/3/2006)
c	Questa e' una versione piu' articolata del rivoluzionario programma che
c	dovrebbe permettere di risolvere la congettura
c	per "Mousetrap", almeno fino a cio'
c	che mi interessa direttamente, cioe' le carte francesi.
c	Il programma si basa sulla ricostruzione a ritroso delle stringhe
c	che possono portare ai mazzi che diano il massimo punteggio.
c	E' la terza versione, in cui la costruzione a ritroso delle
c	stringhe viene affidata tutta al computer, anziche' 
c	fatta a mano.
C	Stiamo considerando il MOUSETRAP MODULAR.
c	In esso si inserisce una nuova difficolta', collegata al fatto
c	che si conta ad libitum, anche permettendo di non avere coincidenze
c	nei primi NQ numeri. Questo comporta che, da una stessa stringa, si 
c	possono generare differenti mazzi.
c	In Mousetrap ho il vantaggio di sapere quanti mazzi vincenti
c	mi devo aspettare, in quanto lo calcolo con CAYLEY.FOR.
c	In MANMA la chance di avere il punteggio piu' alto e'
c	a volte talmente bassa che non ho idea di quale sia l'ordine
c	di grandezza dei mazzi vincenti.
c	Rispetto alla seconda versione, che e' nel file STRINGHE_MOUSETRAP,
c	questo programma mi serve per rispondere anche ai quesiti di Guy sulle
c	stringhe REFORMED, sia nel caso di Mousetrap classico, sia nel
c	caso di Mousetrap modulare, cioe' giocato "alla Carola", senza
c	bruciare alcuna carta, ma andando avanti ad libitum.
C	Rispetto alla vecchia versione, GUY_MODULAR, inseriamo l'importantissima
c	innovazione di memorizzare i vettori in forma di CARATTERE, in modo
c	da risparmiare, auspicabilmente, molto spazio memoria.
c

      integer*4 na,nq,nu,nsem,nr,nf,nd1(100),mul(100),nd2(100),nd3(100),
     #kc(100000),mg(400),mgu(100000),lgu(100000),kc1(0:100000),
     #kc2(100000), mg1(400), kgu(100000), nf4(100)
      integer*4 nsum(100),nn(400),nc(100000,400), ne(2), nw(2), 
     #nl1(100),nn1(100),nn0(400),nn2(400),ngu(100000),ns(0:100000)
  	CHARACTER str1*38, nch*1, ncn*1

	write(*,*) 'RICORDATI DI DIMENSIONARE I CHARACTER!!!'
      write (*,*) ' Fino a quale valore di carta vuoi arrivare (max 100)
     #?'
	read (*,*) nq  
	write(*,*) 'Quanti semi (da 1 a 4)?'
	read (*,*) nsem
	write(*,*) 'si conta ex-novo?'
	read(*,*) mo
	write(*,*) 'cerchiamo UN mazzo (1) o TUTTI i mazzi (2)?'
	read(*,*) mi
	write(*,*) 'vuoi memorizzare TUTTI i mazzi vincenti?'
	read(*,*) nqq
	write(*,*) 'vuoi studiare anche i cicli di Guy?'
	read(*,*) ng
	if(ng.eq.1)then

c	questa istruzione è stata messa perché si prospettano mazzi
c	reformed fino a 40000 volte e sono ormai interessato a 
c	memorizzare solo le stringhe reformed il maggior numero
c	di volte

	write(*,*) 'vuoi memorizzare tutti i reformed e i cicli?'
	read(*,*) kre
	if(kre.eq.0)then
	write(*,*) 'da quale valore a quale valore di REFORMED?'
	write(*,*) '(minore di 100000)'
	read(*,*) lin, lg
	write(*,*) 'da quale valore a quale valore di CICLO TOTALE?'
	write(*,*) '(minore di 100000)'
	read(*,*) lic, lgc
	write(*,*) 'da quale valore a quale valore di LOOP?'
	write(*,*) '(minore di 100000)'
	read(*,*) lil, lgl
	write(*,*) 'quanti mazzi vuoi memorizzare?'
	read(*,*) krn
	end if
	endif

c     nz mi da' il numero di carte del mazzo
c     ny mi da' la somma dei valori delle carte.
c	In GU(1) inserisco gli eventuali cicli di mazzi reformed.
c	Da esso creo, automaticamente, i valori degli altri nomi
c	di file per la memorizzazione dei mazzi. In GU(k) vanno i mazzi
c	k-reformed. Poiché gli 1-reformed sono semplicemente i mazzi
c	vincenti, non li memorizzo, perché già lo ho fatto con 
c	STRINGHE_MOUSETRAP.

      nz = nq*nsem
      ny = (nsem*nq*(nq+1))/2
	KC1(0)=0
	do 112 mm=1,1000
	kc1(mm)=0
	kc2(mm)=0
112	kc(mm)=0
	
c	kc(i) indica il numero di loop di lunghezza i di stringhe reformed
c	kc1(i) indica il numero di pre-loop di lunghezza i
c	kc2(i) indica il numero di cicli totali (loop + pre-loop)
c	di lunghezza i
c	ns(0) mi indica il numero di stringhe memorizzate.
c	ns(k) memorizza il numero di stringhe k-reformed

	do 12 mm=0,1000
	ns(mm)=0
	if(mm.eq.0) goto 12
	NGU(MM)=0
	mgu(mm)=0
	lgu(mm)=0
	kgu(mm)=0
12	continue

c	verifico i sottomultipli di NQ

	ndj=0
	do 61 ii = 2,nq
	nd=(nq/ii)*ii
	if(nd.eq.nq)then
	ndj=ndj+1
	write(*,*) 'divisore: ', ii
	nd1(ndj)=ii
	nd2(ndj)=nq/ii
	end if
61	continue

	if(mo.eq.0)then
	write(*,*) 'file da cui leggere i numeri di file'
	write(*,*) 'quanti file devo leggere?'
	write(*,*) 'lunghezza stringhe da leggere'
	write(*,*) 'ulteriore prefisso (minore di 21)?'
	read(*,*) nf5, ns2, nl, iu

c	NF5 e' la NF1 del precedente passo.
c	IU e' un prefisso che va messo davanti al numero di file, per
c	riconoscerlo dagli altri file di uguale lunghezza di stringhe

	else

c	qui si conta ex-novo

	iu=0

c	ns2 mi dice il numero di file di stringhe di una data lunghezza che devo leggere.
c	Se sto cominciando ex-novo, ho ovviamente un solo file da leggere.
c	nl mi dice la lunghezza delle stringhe che devo leggere. 
c	Se sto iniziando ex-novo, parto ovviamente da stringhe di lunghezza 1.

	ns2=1
	nl=1
	nfile = nq*10000+nsem*1000+20
	ihb=1

c	con Mousetrap devo ricostruire tutte le stringhe, non solo
c	quelle terminanti con il 2.
c	mz e' un contatore del numero di file che sto creando per
c	memorizzare le stringhe.
c	Nel file, oltre al numero, memorizzo il numero di volte che
c	gira a vuoto. Nel caso della prima stringa, con un solo
c	elemento, il numero di volte, MGG, e' ovviamente pari a 0.

	mz=1
	mgg=0
	ncn='0'
c	do 205 mm=2,nq
	do 205 mm=1,nq
	if(mm.eq.1)nch='1'
	if(mm.eq.2)nch='2'
	if(mm.eq.3)nch='3'
	if(mm.eq.4)nch='4'
	if(mm.eq.5)nch='5'
	if(mm.eq.6)nch='6'
	if(mm.eq.7)nch='7'
	if(mm.eq.8)nch='8'
	if(mm.eq.9)nch='9'
	if(mm.eq.10)nch='A'
	if(mm.eq.11)nch='B'
	if(mm.eq.12)nch='C'
	if(mm.eq.13)nch='D'
	if(mm.eq.14)nch='E'
	if(mm.eq.15)nch='F'
	if(mm.eq.16)nch='G'
	if(mm.eq.17)nch='H'
	if(mm.eq.18)nch='I'
	if(mm.eq.19)nch='J'
	if(mm.eq.20)nch='K'
	str1(1:1)=nch
	str1(2:2)=ncn
	write(NFILE,*) str1
c	write(4,*) 'ho letto la stringa n. ', mm, ' = ', str1
	ns(0)=nq
c	ns(0)=nq-1
205	continue
	close(nfile)
	end if

	write(*,*) 'file su cui memorizzare i dati sulle stringhe 
     #vincenti?'
	read(*,*) nf1
	write(*,*) 'su quale file il numero di stringhe vincenti?'
	read(*,*) nf2

	open(nf1)
	if(mo.eq.0) open(nf5)
	open(nf2, access='append', status='unknown')
	write(nf2, *) 'GUY_MODULAR_CH : ', nq, ' carte * ', nsem, ' semi'

c	Voglio memorizzare il conteggio totale dei reformed
c	e dei cicli. Questo lo faccio in NF2.
c	Voglio memorizzare i vari mazzi reformed, su NGU(k).
c	Voglio memorizzare i LOOP, su MGU(k).
c	Voglio memorizzare i PRE-LOOP su LGU(k).
c	Voglio memorizzare i cicli interi su KGU(k).

	do 200 nu=nl+1, nz
	if(nu.eq.nz.and.ng.eq.1) then
	write(*,*)'file su cui memorizzare le stringhe REFORMED?'
	write(*,*) 'file su cui memorizzare solo i loop?'
	write(*,*) 'file su cui memorizzare i pre-loop?'
	write(*,*) 'file su cui memorizzare i cicli interi?'
	read(*,*) ngu(1), mgu(1), lgu(1), kgu(1)
	WRITE(*,*) 'valore minimo di k per segnalare stringhe k-reformed'
	read(*,*) krec
	krec1=0
	krec2=0
	krec3=0
	ngu(lin)=ngu(1)+lin-1
	mgu(lil)=mgu(1)+lil-1
	kgu(lic)=kgu(1)+lic-1
	lgu(lic)=lgu(1)+lic-1
	open(ngu(1), access='append', status='unknown')
	write(ngu(lin),*) 'MOUSETRAP MODULARE: MAZZI ' , lin, 
     #' VOLTE REFORMED'
	write(ngu(1),*) nq, ' carte * ', nsem, ' semi'
	open(mgu(1), access='append', status='unknown')
	write(mgu(1),*) 'MOUSETRAP MODULARE: LOOP LUNGHI 1'
	write(mgu(1),*) nq, ' carte * ', nsem, ' semi'
	open(lgu(1), access='append', status='unknown')
	write(lgu(1),*) 'MOUSETRAP MODULARE: PRE-LOOP LUNGHI 0'
	write(lgu(1),*) nq, ' carte * ', nsem, ' semi'
	open(kgu(1), access='append', status='unknown')
	write(kgu(1),*) 'MOUSETRAP MODULARE: CICLI INTERI LUNGHI 1'
	write(kgu(1),*) nq, ' carte * ', nsem, ' semi'
	open(mgu(lil), access='append', status='unknown')
	write(mgu(lil),*) 'MOUSETRAP MODULARE: LOOP LUNGHI ', lil
	write(mgu(lil),*) nq, ' carte * ', nsem, ' semi'
	open(lgu(lic), access='append', status='unknown')
	write(lgu(lic),*) 'MOUSETRAP MODULARE: PRE-LOOP LUNGHI ', lic-1
	write(lgu(lic),*) nq, ' carte * ', nsem, ' semi'
	open(kgu(lic), access='append', status='unknown')
	write(kgu(lic),*) 'MOUSETRAP MODULARE: CICLI INTERI LUNGHI ', lic
	write(kgu(lic),*) nq, ' carte * ', nsem, ' semi'

	do 11 mm=lin+1,lg-1
	ngu(mm)=ngu(mm-1)+1
	open(ngu(mm), access='append', status='unknown')
	write(ngu(mm),*) 'MOUSETRAP MODULARE: MAZZI ', mm, ' VOLTE 
     #REFORMED'
	write(ngu(mm),*) nq, ' carte * ', nsem, ' semi'
11	continue

	do 111 mm=lil+1,lgl-1
	mgu(mm)=mgu(mm-1)+1
	open(mgu(mm), access='append', status='unknown')
	write(mgu(mm),*) 'MOUSETRAP MODULARE: LOOP LUNGHI ', mm
	write(mgu(mm),*) nq, ' carte * ', nsem, ' semi'
111	continue

	do 211 mm=lic+1,lgc-1
	lgu(mm)=lgu(mm-1)+1
	kgu(mm)=kgu(mm-1)+1
	open(lgu(mm), access='append', status='unknown')
	write(lgu(mm),*) 'MOUSETRAP MODULARE: PRE-LOOP LUNGHI ', mm-1
	write(lgu(mm),*) nq, ' carte * ', nsem, ' semi'
	open(kgu(mm), access='append', status='unknown')
	write(kgu(mm),*) 'MOUSETRAP MODULARE: CICLI INTERI LUNGHI ', mm
	write(kgu(mm),*) nq, ' carte * ', nsem, ' semi'
211	continue

	ngu(lg)=ngu(lg-1)+1
	mgu(lgl)=mgu(lgl-1)+1
	lgu(lgc)=lgu(lgc-1)+1
	kgu(lgc)=kgu(lgc-1)+1
	open(ngu(lg), access='append', status='unknown')
	write(ngu(lg),*) 'MOUSETRAP MODULARE: MAZZI ALMENO', lg, ' VOLTE 
     #REFORMED'
	write(ngu(lg),*) nq, ' carte * ', nsem, ' semi'
	open(mgu(lgl), access='append', status='unknown')
	write(mgu(lgl),*) 'MOUSETRAP MODULARE: LOOP LUNGHI ALMENO', lgl
	write(mgu(lgl),*) nq, ' carte * ', nsem, ' semi'
	open(lgu(lgc), access='append', status='unknown')
	write(lgu(lgc),*) 'MOUSETRAP MODULARE: PRE-LOOP LUNGHI ALMENO',
     #lgc-1
	write(lgu(lgc),*) nq, ' carte * ', nsem, ' semi'
	open(kgu(lgc), access='append', status='unknown')
	write(kgu(lgc),*)'MOUSETRAP MODULARE: CICLI INTERI LUNGHI ALMENO',
     #lgc
	write(kgu(lgc),*) nq, ' carte * ', nsem, ' semi'

	end if
	nsumm=0
	mz=0
	nm0=0
	do 55 mm=1, ndj
	nd3(mm)= nu/nd1(mm)
	mul(mm)=nd3(mm)*nd1(mm)
55	if(mul(mm).eq.nu) nm0=nd3(mm)

c	qui ho bisogno del MCD fra NQ e NU per far fare obbligatoriamente
c	alle carte il numero minimale di giri a vuoto. Altrimenti c'e'
c	il rischio che, pesand tutti i comuni divisori, ci sia una
c	replica di qualche stringa. Se esco con NM0=0, vuole dire che
c	NT e NU sono primi fra loro. In tal caso devo far contare
c	NU volte fino a NQ prima di avere la certezza di essere entrato
c	in un loop.

	if(nm0.eq.0)nm0=nu
	do 601 ib=1, ns2
	if(mo.eq.0) read(nf5,*) ihb, nfile, ns(0)

c	ihb conta il numero di file memorizzato nel passo precedente.
c	NFILE e' il file da cui leggo le varie stringhe.
c	NF5 e' il file da cui leggo il numero di stringhe che dovro' leggere su
c	NFILE. A ogni passo del loop leggo una riga di NF5, che mi dice
c	qual e' il file NFILE da cui leggere le stringhe e il numero di stringhe.
c	ns(1) indica il numero di stringhe da leggere in nfile.
c	nu e' la lunghezza delle stringhe da costruire e verificare
c	il primo file su cui memorizzare e' dato da un numero
c	le cui cifre danno il numero di carte, il numero di semi
c	e il numero di elementi della stringa.

	nf= nq*10000+nsem*1000+nu*10+ib*1000000+iu*100000000
	write(*,*)'numero di file = ' , nf
	nr=ns(0)
	ns(0)=0

c	su FOR.NF memorizzo le stringhe da leggere al passo successivo.
c	Una volta riazzerato,
c	ns mi dira' il numero di stringhe nuove che ho memorizzato 
c	nel file for.nf.

	open(nfile)
	write(*,*) 'sto leggendo il file n. ', ihb, ' : ' , nfile

c	leggo, una per volta, le NR stringhe immagazzinate, insieme
c	al vettore indicante le volte che la carta deve svolgere giri
c	a vuoto prima di essere piazzata.

	do 70 i=1,nr
	if(nu.eq.nz)then
	if((i/10000*10000).eq.i)write(*,*) i
	endif
c	il programma legge i numeri sulla stringa posta nella 
c	i-esima posizione del file for.nfile, chiamandola
c	nn.
c	MG e' il vettore che memorizza le volte che la carta deve svolgere giri
c	a vuoto prima di essere piazzata.

	read(nfile,*) str1
c	write(4,*) 'sto leggendo la stringa ', str1

	do 260 ii=1,nu-1
	III=NU-1+II
	nch=str1(ii:ii)
	ncn=str1(iii:iii)
	if(nch.eq.'1')nn(ii+1)=1
	if(nch.eq.'2')nn(ii+1)=2
	if(nch.eq.'3')nn(ii+1)=3
	if(nch.eq.'4')nn(ii+1)=4
	if(nch.eq.'5')nn(ii+1)=5
	if(nch.eq.'6')nn(ii+1)=6
	if(nch.eq.'7')nn(ii+1)=7
	if(nch.eq.'8')nn(ii+1)=8
	if(nch.eq.'9')nn(ii+1)=9
	if(nch.eq.'A')nn(ii+1)=10
	if(nch.eq.'B')nn(ii+1)=11
	if(nch.eq.'C')nn(ii+1)=12
	if(nch.eq.'D')nn(ii+1)=13
	if(nch.eq.'E')nn(ii+1)=14
	if(nch.eq.'F')nn(ii+1)=15
	if(nch.eq.'G')nn(ii+1)=16
	if(nch.eq.'H')nn(ii+1)=17
	if(nch.eq.'I')nn(ii+1)=18
	if(nch.eq.'J')nn(ii+1)=19
	if(nch.eq.'K')nn(ii+1)=20
	if(ncn.eq.'0')mg(ii+1)=0
	if(ncn.eq.'1')mg(ii+1)=1
	if(ncn.eq.'2')mg(ii+1)=2
	if(ncn.eq.'3')mg(ii+1)=3
	if(ncn.eq.'4')mg(ii+1)=4
	if(ncn.eq.'5')mg(ii+1)=5
	if(ncn.eq.'6')mg(ii+1)=6
	if(ncn.eq.'7')mg(ii+1)=7
	if(ncn.eq.'8')mg(ii+1)=8
	if(ncn.eq.'9')mg(ii+1)=9
	if(ncn.eq.'A')mg(ii+1)=10
	if(ncn.eq.'B')mg(ii+1)=11
	if(ncn.eq.'C')mg(ii+1)=12
	if(ncn.eq.'D')mg(ii+1)=13
	if(ncn.eq.'E')mg(ii+1)=14
	if(ncn.eq.'F')mg(ii+1)=15
	if(ncn.eq.'G')mg(ii+1)=16
	if(ncn.eq.'H')mg(ii+1)=17
	if(ncn.eq.'I')mg(ii+1)=18
	if(ncn.eq.'J')mg(ii+1)=19
	if(ncn.eq.'K')mg(ii+1)=20
260	continue

c	WRITE(4,*) (nn(ii), ii=2,nu)
c	write(4,*) (mg(ii),ii=2,nu)

c	una volta letta la stringa nn, aggiungo l'nu-esimo
c	numero. nsum mi segnala se le carte di valore j sono
c	gia' state messe tutte, nel qual caso incremento j
c	e metto una carta di valore piu' alto. Per sistemare
c	il mazzo, creo una stringa di nu valori e inserisco
c	le carte nell'ordine dato dalla stringa lunga nu-1.
c	Quando arrivo a nu, riazzero il conteggio. Quando
c	trovo una casella occupata, mi sposto di uno a destra.

	do 10 js=1,nq
10	nsum(js)=0

c	il prossimo loop verifica quante volte e' ripetuta una
c	carta nella stringa che sto leggendo

	do 20 js=2, nu
	na=nn(js)
20	nsum(na) = nsum(na) + 1

c	costruisco la stringa di un elemento piu' lunga, rispetto a quella
c	 che ho letto, provando, a uno a uno, gli NQ valori ammissibili

	do 30 j=1, nq
c	if(nu.lt.nz.and.j.eq.1)goto 30
	if(nsum(j).eq.nsem) goto 30

	nn(1)=j

c	il prossimo loop serve per costruire mazzi differenti a seconda 
c	del numero di giri a vuoto che permetto alla nuova carta. Il
c	numero massimo di giri a vuoto e' determinato tramite
c	il mcm fra NQ e NU.

	do 35 jaa=0,nm0-1
	mg(1)=jaa

c	kw indica la lunghezza del loop.
c	lw indica a quale turno e' avvenuto il loop

	lw=0
	kw=0
	do 50 js=1, nu
50	nc(1,js)=0


c	nn(1) e' l'elemento nuovo da inserire nella precedente stringa.
c	mg(1) è il numero di volte che deve girare a vuoto prima di
c	piazzarlo nella stringa.

	k=0
	ns1=0

c	ns4 e' il contatore per far spostare la carta al posto giusto
c	NS1 e' la somma dei valori delle carte della stringa in esame.

	ns4=0

	do 40 l=1, nu
	nh=nn(l)+mg(l)*nq
	if(ns4.gt.0)then
	k=k+1
		if(k.gt.nu)k=k-nu
146		if(nc(1,K).gt.0)then
		k=k+1
		if(k.gt.nu)k=k-nu
		goto 146
		end if
	else
		do 155 i0=1,nh
		k=k+1
		if(k.gt.nu)k=k-nu
145		if(nc(1,k).gt.0)then
		k=k+1
		if(k.gt.nu)k=k-nu
		goto 145
		end if
155		end do
	end if
	nc(1,k)=nn(l)
	ns1=ns1+nc(1,k)
40	continue

	do 240 mh=1,nu
240	nn0(mh)=nc(1,mh)

c	write(*,*) 'somma dei punti= ', ns1
c	write(*,*)(nn(hi), hi=1, nu)
c	write(*,*)(nc(1,hi), hi=1, nu)
c	write(4,*)(nn(hi), hi=1, nu)
c	write(4,*)(MG(HI), HI=1,NU)
c	write(4,*)(nc(1,hi), hi=1, nu)
c	write(4,*) ' '

c	una volta ricostruito il mazzo, faccio partire il giuoco. 
c	QUESTO E' MOUSETRAP MODULARE (CIOE' "ALLA CAROLA")
c	Per adeguare il programma a Mousetrap, ho rispolverato il metodo
c	meno efficiente.
c	Partendo dalla stringa NN, ricostruisco NC.
c     Il vettore NC memorizza il mazzo iniziale. Costruisco 
c     anche il mazzo NN0, che sara' quello manipolabile durante
c     il gioco. Ho bisogno di tenere in memoria NC, perche' alla
c     fine, se ho fatto record, devo stampare anche il mazzo con
c     cui ho fatto record.
c	Il vettore MG1 serve per confrontare quante volte devo contare
c	prima di pescare ogni carta. Questo vettore va confrontato
c	col corrispettivo vettore che mi e' servito per costruire
c	il mazzo partendo dalla stringa. A priori, i due vettori
c	potrebbero essere tra loro differenti. In tal caso il mazzo
c	va buttato via, perche' genera una stringa diversa da quella
c	di partenza.

c	serve il 120, qui?

120	nt = nu
	n1=0
	n2=0
	n3=0
	k=0
	do 13 js=1,nu
13	mg1(js)=0


c	nt conta il numero di carte non accantonate;
c	mul verifica quando il numero delle carte e' un multiplo 
c	di nq e interviene quando non ho accantonato alcuna carta 
c	nell'ultima girata;
c	n1 conta la somma dei punteggi. Per vincere, devo arrivare a NS1;
c	n2 conta il numero di carte accantonate;
c	n3 conta il numero di carte accantonate fino alla precedente
c	girata;
c	k e' il contatore, che viene azzerato quando supera nt;
c	N4 è il contatore del numero di giri a vuoto.

60	n4 = 0

C	qui verifico se i divisori di NQ sono anche divisori di NT, 
c	per individuare i loop di
c	carte. Se individuo un loop, il mazzo è perdente e quindi
c	esco

160	do 161 ii=1, ndj
161	mul(ii)=(nt/(nd1(ii)))*nd1(ii)
	do 140 ja=1,nq
	k=k+1
		if(k.gt.nt) then
			n4=n4+1
			k=k-nt
			if(n3.ne.n2)n4=0
	do 162 ii=1, ndj
162	if(mul(ii).eq.nt.and.n4.eq.nd2(ii))goto 35
			n3=n2
		endif
			if(ja.eq.nn0(k))then
				n1=n1+ja
				n2=n2+1
				nt=nt-1
				nn2(n2)=ja
				mg1(n2)=n5
				n5=0
				if(nn2(n2).ne.nn(n2))goto 35
				if(mg1(n2).ne.mg(n2))goto 35
					if(nt.eq.0) goto 170
						if(k.le.nt)then
							do 130 ii=k,nt
130							nn0(ii)=nn0(ii+1)
						endif
				k=k-1
				goto 60
			endif
140	continue
	n5=n5+1
	goto 160
   
c     al passo 170 si arriva se sono state accantonate TUTTE le carte (nt=0).

c     terza fase: eventuale memorizzazione del risultato 
c	(se il punteggio ha raggiunto la somma dei valori delle carte
c	nella stringa in esame, memorizzo) e, nel caso in cui NU=NZ, prosieguo
c	del gioco secondo le regole del mazzo REFORMED. Prendo la stringa NN2,
c	costruita dal mazzo vincente NC e la utilizzo come nuovo mazzo,
c	verificando se esso, a sua volta, vince, generando una nuova stringa.
c	E cosi' via.

170	if(n1.eq.ns1)then
c	write(4,*) 'mazzo memorizzato'
c	write(4,*)(nn(hi), hi=1, nu)
c	write(4,*)(MG(HI), HI=1,NU)
c	write(4,*)(nc(1,hi), hi=1, nu)
c	write(4,*)(nn2(hi), hi=1,nu)
c	write(4,*) ' '

	ns(0)=ns(0)+1

	do 270 ii=1,nu
	iii=ii+nu
	if(nn(ii).eq.1)nch='1'
	if(nn(ii).eq.2)nch='2'
	if(nn(ii).eq.3)nch='3'
	if(nn(ii).eq.4)nch='4'
	if(nn(ii).eq.5)nch='5'
	if(nn(ii).eq.6)nch='6'
	if(nn(ii).eq.7)nch='7'
	if(nn(ii).eq.8)nch='8'
	if(nn(ii).eq.9)nch='9'
	if(nn(ii).eq.10)nch='A'
	if(nn(ii).eq.11)nch='B'
	if(nn(ii).eq.12)nch='C'
	if(nn(ii).eq.13)nch='D'
	if(nn(ii).eq.14)nch='E'
	if(nn(ii).eq.15)nch='F'
	if(nn(ii).eq.16)nch='G'
	if(nn(ii).eq.17)nch='H'
	if(nn(ii).eq.18)nch='I'
	if(nn(ii).eq.19)nch='J'
	if(nn(ii).eq.20)nch='K'
	if(mg(ii).eq.0)ncn='0'
	if(mg(ii).eq.1)ncn='1'
	if(mg(ii).eq.2)ncn='2'
	if(mg(ii).eq.3)ncn='3'
	if(mg(ii).eq.4)ncn='4'
	if(mg(ii).eq.5)ncn='5'
	if(mg(ii).eq.6)ncn='6'
	if(mg(ii).eq.7)ncn='7'
	if(mg(ii).eq.8)ncn='8'
	if(mg(ii).eq.9)ncn='9'
	if(mg(ii).eq.10)ncn='A'
	if(mg(ii).eq.11)ncn='B'
	if(mg(ii).eq.12)ncn='C'
	if(mg(ii).eq.13)ncn='D'
	if(mg(ii).eq.14)ncn='E'
	if(mg(ii).eq.15)ncn='F'
	if(mg(ii).eq.16)ncn='G'
	if(mg(ii).eq.17)ncn='H'
	if(mg(ii).eq.18)ncn='I'
	if(mg(ii).eq.19)ncn='J'
	if(mg(ii).eq.20)ncn='K'
	str1(ii:ii)=nch
	str1(iii:iii)=ncn
270	continue

	write(NF,*) str1
c	write(4,*) 'ho scritto la stringa ' , str1

		if(ns1.eq.ny)then
		if(nqq.eq.1)then
c		write(*,*) ' somma dei punti = ' , ny
		write (nf2,*) (nc(1,ii), ii = 1, nu)
		write (nf2,*) 'punteggio =', n1
		write (nf2,*) 'ottenuto con  ', n2, '   carte'
c		write (nf1,*) (nc(1,ii), ii = 1, nu)
c		write (nf1,*) 'punteggio =', n1
c		write (nf1,*) 'ottenuto con  ', n2, '   carte'
		else
			if(ns(0).eq.1)then

c	memorizzo un solo mazzo per file, giusto come controllo.
c	potrei memorizzarne quanti ne voglio, tramite l'istruzione
c	if(ns(1).ge.1.and.ns(1).le.XXX)then...

			write(*,*) ' somma dei punti = ' , ny
			write (nf2,*) (nc(1,ii), ii = 1, nu)
			write (nf2,*) 'punteggio =', n1
			write (nf2,*) 'ottenuto con  ', n2, '   carte'
c			write (nf1,*) (nc(1,ii), ii = 1, nu)
c			write (nf1,*) 'punteggio =', n1
c			write (nf1,*) 'ottenuto con  ', n2, '   carte'
			end if
		end if

c	Il primo IF rimane aperto, perché, se NS1 è uguale a NY,
c	voglio continuare a giocare.	
c	qui inserisco la ricerca delle permutazioni REFORMED.
c	Prendo la stringa NN2, costruita con il mazzo NC e ci rigioco.

	if(ng.eq.1)then
	kj=1
		do 642 ii=1,nz
642		if(nc(1,ii).ne.nn2(ii))goto 341

c	se arrivo qui vuol dire che c'è stato un loop al primo turno.
c	kw mi dice che il loop e' lungo 1. lw rimane uguale a 0, perche'
c	il loop avviene subito.

	kw=1
	goto 344

c	RICOMINCIO IL GIUOCO.
C	Nel primo passo, sto trattando una stringa ottenuta per la prima
c	volta, cioè la stringa ottenuta dal primo mazzo, a sua volta
c	ottenuta dalla stringa da me costruita.
c	Quindi la prima stringa coincide con la stringa da me costruita.
c	Al primo passo, dunque, siamo ancora in una 1-reformed stringa.

341	do 340 mh=1,nz
	NC(KJ+1, MH)=NN2(MH)
	nn0(mh)=nn2(mh)
340	nn2(mh)=0
	
500	nt = nu
	n1=0
	n2=0
	k=0

c	nt conta il numero di carte non accantonate;
c	mul verifica quando il numero delle carte e' un multiplo 
c	di nq e interviene quando non ho accantonato alcuna carta 
c	nell'ultima girata;
c	n2 conta il numero di carte accantonate;
c	n1 conta il numero di carte accantonate fino alla precedente
c	girata;
c	k e' il contatore, che viene azzerato quando supera nt;
c	N4 è il contatore del numero di giri a vuoto.

563	n4 = 0

560	do 561 ii=1, ndj
561	mul(ii)=(nt/(nd1(ii)))*nd1(ii)
	do 540 jc=1,nq
	k=k+1
		if(k.gt.nt) then
			n4=n4+1
			k=k-nt
			if(n1.ne.n2)n4=0
	do 562 ii=1, ndj
562	if(mul(ii).eq.nt.and.n4.eq.nd2(ii))goto 572
			n1=n2
		endif
			if(jc.eq.nn0(k))then
				n2=n2+1
				nt=nt-1
				nn2(n2)=jc
					if(nt.eq.0) goto 570
						if(k.le.nt)then
							do 530 jb=k,nt
530							nn0(jb)=nn0(jb+1)
						endif
			k=k-1
			goto 563
			endif
540	continue
	goto 560
       
c     se esco dal loop, vuol dire che sono
c	entrato in un loop di carte che non accantonano
c	più alcuna carta, quindi devo terminare il giuoco,
c	abbandonando il mazzo, perché il mazzo non mi darà il
c	massimo risultato.
c	Aggiorno il numero di kj-reformed
c	stringhe e memorizzo nel file corrispettivo tutta la sequenza
c	di mazzi riformati fino al kj-esimo.

572	ns(kj)=ns(kj)+1

	if(kre.eq.1) then			
		if(kj.lt.lg) then
			write(ngu(kj),*) ns(kj)
			do 542 mh=1,kj+1
			write(ngu(kj),*) (nc(mh, ii), ii=1, nz)
542			write(ngu(kj),*) ' '
		else
			write(ngu(lg),*) ns(kj)
			do 592 mh=1,kj+1
			write(ngu(lg),*) (nc(mh, ii), ii=1, nz)
592			write(ngu(lg),*) ' '
		end if
	else
		if(ns(kj).le.krn)then
		if(kj.ge.lin)then
			if(kj.lt.lg) then
				write(ngu(kj),*) ns(kj)
				do 1542 mh=1,kj+1
				write(ngu(kj),*) (nc(mh, ii), ii=1, nz)
1542				write(ngu(kj),*) ' '
			else
				write(ngu(lg),*) ns(kj)
				do 1592 mh=1,kj+1
				write(ngu(lg),*) (nc(mh, ii), ii=1, nz)
1592				write(ngu(lg),*) ' '
			end if
		end if
		endif
	end if
			if(kj.ge.krec)then
				write(*,*)'HO UNA STRINGA ', kj,' -REFORMED' 
				krec=kj
				end if
		goto 35

c     al passo 570 si arriva se sono state accantonate TUTTE le carte (nt=0).
c	Innanzitutto, controllo se la stringa appena ottenuta mi ha creato
c	un loop, anche nel caso kj=1. Se non ho a che fare con un ciclo,
c	allora posso ricominciare il gioco. Aumento kj.

570	do 343 iii=1,kj+1
		do 342 ii=1,nz
342		if(nc(iii,ii).ne.nn2(ii))goto 343

c	se arrivo qui, vuol dire che ho trovato un loop
c	lw mi segnala che il loop NON e' avvenuto al primo turno

	kw=iii
	lw=1
	goto 344
343	continue

c	se esco, vuol dire che NON HO il ciclo chiuso e quindi proseguo
c	il giuoco. Prendo la stringa NN2,
c	costruita dal mazzo vincente NC e la utilizzo come nuovo mazzo,
c	verificando se esso, a sua volta, vince, generando una nuova stringa.
c	E cosi' via.

	KJ=KJ+1
541	do 550 mh=1,nz
	nc(kj+1,mh)=nn2(mh)
	nn0(mh)=nn2(mh)
550	nn2(mh)=0
	goto 500

c	se arrivo qui, vuol dire che HO il ciclo chiuso e quindi fermo
c	il giuoco. Memorizzo tutto il ciclo in NGU(1)

344	if(lw.eq.1)then
		
c	questo e' il caso in cui NON ho loop al primo turno

			if((kj-kw+2).gt.krec1) then
			krec1=kj-kw+2
			write(*,*)'HO UN ', krec1, ' - LOOP'
			end if
			kc(kj-kw+2)=kc(kj-kw+2)+1
		if(kre.eq.1)then
			if((kj-kw+2).lt.lgl)then
				write(mgu(kj-kw+2),*)kc(kj-kw+2)
				write(mgu(kj-kw+2),*) 'HO UN ', kj-kw+2, ' - LOOP'
				do 345 ii=1,kj+1
				write(mgu(kj-kw+2),*) (nc(ii,mh), mh=1,nz)
				write(mgu(kj-kw+2),*) ' '
345				continue
				write(mgu(kj-kw+2),*) (nn2(mh), mh=1,nz)
				write(mgu(kj-kw+2),*) ' '
			else
				write(mgu(lgl),*)kc(kj-kw+2)
				write(mgu(lgl),*) 'HO UN ', kj-kw+2, ' - LOOP!!!'
				do 347 ii=1,kj+1
				write(mgu(lgl),*) (nc(ii,mh), mh=1,nz)
				write(mgu(lgl),*) ' '
347				continue
				write(mgu(lgl),*) (nn2(mh), mh=1,nz)
				write(mgu(lgl),*) ' '
			end if
		else
			if((kc(kj-kw+2)).le.krn)then
			if((kj-kw+2).ge.lil)then
				if((kj-kw+2).lt.lgl)then
					write(mgu(kj-kw+2),*)kc(kj-kw+2)
					write(mgu(kj-kw+2),*) 'HO UN ', kj-kw+2, ' - LOOP'
					do 1345 ii=1,kj+1
					write(mgu(kj-kw+2),*) (nc(ii,mh), mh=1,nz)
					write(mgu(kj-kw+2),*) ' '
1345					continue
					write(mgu(kj-kw+2),*) (nn2(mh), mh=1,nz)
					write(mgu(kj-kw+2),*) ' '
				else
					write(mgu(lgl),*)kc(kj-kw+2)
					write(mgu(lgl),*) 'HO UN ', kj-kw+2, ' - LOOP'
					do 1347 ii=1,kj+1
					write(mgu(lgl),*) (nc(ii,mh), mh=1,nz)
					write(mgu(lgl),*) ' '
1347					continue
					write(mgu(lgl),*) (nn2(mh), mh=1,nz)
					write(mgu(lgl),*) ' '
				end if
			end if
			endif
		end if

			if((kw-1).gt.krec2) then
			krec2=kw-1
			write(*,*)'HO UN ', krec2, ' - PRE-LOOP'
			end if
			kc1(kw-1)=kc1(kw-1)+1
		if(kre.eq.1)then
			if (kw.lt.lgc)then
				write(lgu(kw),*)kc1(kw-1)
				write(lgu(kw),*) 'HO UN ', kw-1, ' - PRE-LOOP'
				do 745 ii=1,kj+1
				write(lgu(kw),*) (nc(ii,mh), mh=1,nz)
				write(lgu(kw),*) ' '
745				continue
				write(lgu(kw),*) (nn2(mh), mh=1,nz)
				write(lgu(kw),*) ' '
			else
				write(lgu(lgc),*)kc1(kw-1)
				write(lgu(lgc),*) 'HO UN ', kw-1, ' - PRE-LOOP'
				do 747 ii=1,kj+1
				write(lgu(lgc),*) (nc(ii,mh), mh=1,nz)
				write(lgu(lgc),*) ' '
747				continue
				write(lgu(lgc),*) (nn2(mh), mh=1,nz)
				write(lgu(lgc),*) ' '
			end if
		else
			if((kc1(kw-1)).le.krn)then
			if(kw.ge.lic)then
				if (kw.lt.lgc)then
					write(lgu(kw),*)kc1(kw-1)
					write(lgu(kw),*) 'HO UN ', kw-1, ' - PRE-LOOP'
					do 1745 ii=1,kj+1
					write(lgu(kw),*) (nc(ii,mh), mh=1,nz)
					write(lgu(kw),*) ' '
1745					continue
					write(lgu(kw),*) (nn2(mh), mh=1,nz)
					write(lgu(kw),*) ' '
				else
					write(lgu(lgc),*)kc1(kw-1)
					write(lgu(lgc),*) 'HO UN ', kw-1, ' - PRE-LOOP'
					do 1747 ii=1,kj+1
					write(lgu(lgc),*) (nc(ii,mh), mh=1,nz)
					write(lgu(lgc),*) ' '
1747					continue
					write(lgu(lgc),*) (nn2(mh), mh=1,nz)
					write(lgu(lgc),*) ' '
				end if
			end if
			endif
		end if

			if((kj+1).gt.krec3)then
			krec3=kj+1
			write(*,*) 'HO UN ', krec3, ' CICLO TOTALE'
			end if
			kc2(kj+1)=kc2(kj+1)+1
		if(kre.eq.1)then
			if ((kj+1).lt.lgc)then
				write(kgu(kj+1),*) kc2(kj+1)
				write(kgu(kj+1),*) 'HO UN ', kj+1, ' - CICLO TOTALE'
				do 845 ii=1,kj+1
				write(kgu(kj+1),*) (nc(ii,mh), mh=1,nz)
				write(kgu(kj+1),*) ' '
845				continue
				write(kgu(kj+1),*) (nn2(mh), mh=1,nz)
				write(kgu(kj+1),*) ' '
			else
				write(kgu(lgc),*) kc2(kj+1)
				write(kgu(lgc),*) 'HO UN ', kj+1, ' - CICLO TOTALE'
				do 847 ii=1,kj+1
				write(kgu(lgc),*) (nc(ii,mh), mh=1,nz)
				write(kgu(lgc),*) ' '
847				continue
				write(kgu(lgc),*) (nn2(mh), mh=1,nz)
				write(kgu(lgc),*) ' '
			end if
		else
			if((kc2(kj+1)).le.krn)then
			if((kj+1).ge.lic)then
				if ((kj+1).lt.lgc)then
					write(kgu(kj+1),*) kc2(kj+1)
				write(kgu(kj+1),*) 'HO UN ', kj+1, ' - CICLO TOTALE'
					do 1845 ii=1,kj+1
					write(kgu(kj+1),*) (nc(ii,mh), mh=1,nz)
					write(kgu(kj+1),*) ' '
1845					continue
					write(kgu(kj+1),*) (nn2(mh), mh=1,nz)
					write(kgu(kj+1),*) ' '
				else
					write(kgu(lgc),*) kc2(kj+1)
					write(kgu(lgc),*) 'HO UN ', kj+1, ' - CICLO TOTALE'
					do 1847 ii=1,kj+1
					write(kgu(lgc),*) (nc(ii,mh), mh=1,nz)
					write(kgu(lgc),*) ' '
1847					continue
					write(kgu(lgc),*) (nn2(mh), mh=1,nz)
					write(kgu(lgc),*) ' '
				end if
			end if
			endif
		end if

	else

c	questo e' il caso in cui HO loop al primo turno (lw=0)
c	QUI TENGO TUTTI I MAZZI

	kc(1)=kc(1)+1

c	write(*,*) 'HO UN ', kj-iii+2, ' - LOOP!!!'
c	if((kj-iii+1).eq.1)write(*,*) 'VALE A DIRE UNA IDENTITA!!!' 

	write(mgu(1),*)kc(1)
	write(mgu(1),*) 'HO UN 1 - LOOP!!!'
		write(mgu(1),*) (nc(1,mh), mh=1,nz)
		write(mgu(1),*) ' '
		write(mgu(1),*) (nn2(mh), mh=1,nz)
		write(mgu(1),*) ' '

	kc1(0)=kc1(0)+1
	write(lgu(1),*)kc1(0)
	write(lgu(1),*) 'HO UNO 0 - PRE-LOOP!!!'
		write(lgu(1),*) (nc(1,mh), mh=1,nz)
		write(lgu(1),*) ' '
		write(lgu(1),*) (nn2(mh), mh=1,nz)
		write(lgu(1),*) ' '

	kc2(1)=kc2(1)+1
c	write(*,*) 'HO UN ', kj-iii+2, ' CICLO TOTALE!!!'
c	if((kj-iii+1).eq.1)write(*,*) 'VALE A DIRE UNA IDENTITA!!!' 
	write(kgu(1),*) kc2(1)
	write(kgu(1),*) 'HO UN 1 - CICLO TOTALE!!!'
		write(kgu(1),*) (nc(1,mh), mh=1,nz)
		write(kgu(1),*) ' '
		write(kgu(1),*) (nn2(mh), mh=1,nz)
		write(kgu(1),*) ' '	
	endif
	goto 35

c	chiudo l'IF che chiede se continuare il giuoco alla GUY

	end if

c	chiudo l'IF che si apre se sono arrivato a NZ

c		else
c		write(*,*) (nn0(ii), ii=1,nu)
c		write(*,*) (nc(1,ii), ii=1,nu)
c		write(*,*) (nn2(ii), ii=1,nu)

	end if
	
c	chiudo l'IF che si apre se ho messo da parte tutte le carte

	end if

	if(mi.eq.1.and.ns(0).eq.1000000)goto 300
	if(ns(0).eq.1000000)then
	ns2=ns2+119
	mz=mz+1
	nsumm=nsumm+ns(0)
	write(*,310) mz, nf, ns(0), nu
	write(nf2,310) mz, nf, ns(0), nu
310	format('file n. ', i4, ' : ' , i10, ' : memorizzate ', i10, 
     #' stringhe di ', i4, ' elementi')
	write(nf1,*) mz, nf, ns(0)
	close(nf)
	nf=nf+1
	write(*,*) 'numero di file = ' , nf
	ns(0)=ns(0)-1000000
	end if

c	chiudo il loop sui giri a vuoto da consentire alla nuova carta

35	continue

C	CHIUDO IL DO LOOP SULLA STRINGA COSTRUITA DALLA STRINGA LETTA

30	continue

C	CHIUDO IL DO LOOP SULLA STRINGA LETTA

70	continue
	mz=mz+1
300	write(*,210) mz, nf, ns(0), nu
	write(nf2,210) mz, nf, ns(0), nu
210	format('file n. ', i4, ' : ' , i10, ' : memorizzate ', i10, 
     #' stringhe di ', i4, ' elementi')
	nsumm=nsumm+ns(0)
	close(nf)
	write(nf1,*) mz, nf, ns(0)
601	continue
	write(nf1,*) 'totale stringhe di ', nu, ' elementi = ' , nsumm
	close(nf1)
	write(*,*) 'totale stringhe di ', nu, ' elementi = ' , nsumm

c	write(*,*) 'nu=', nu
	if(nu.eq.nz)nuu=nu
c	write(*,*) 'nuu=', nuu
		
c	questa istruzione e' messa come controllo, per evitare che i file
c	in cui immagazzinare i dati esplodano

	if(ns2.gt.1)goto 220
	nf5=nf1
	nfile=nf
	if(mo.eq.0.and.mi.eq.1)nf1=nf1+1
200	continue
	ksum=0
	ksum1=0
220	if(nuu.eq.nz)then
c	write(*,*) 'ultimo nu=', nu, ' , nz=', nz, ' , nuu=', nuu
	write(nf2,*) 'totale stringhe di ', nz, ' elementi = ' , nsumm
	do 355 ii=1,krec
	ksum1=ksum1+ns(ii)
	IF(ns(ii).gt.0) write(nf2,*)'HO ', ns(ii), ' STRINGHE ', ii, 
     #' -REFORMED' 
355	continue
	write(nf2,*)' '
	write(nf2,*) 'TOTALE STRINGHE REFORMED = ', ksum1
	write(nf2,*)' '
	do 230 ii=1, krec1
	if(kc(ii).gt.0) write(nf2,*) ' NUMERO DI ', ii,' - CICLI CHIUSI 
     #= ' , kc(ii)
230	continue
	DO 231 II=0, KREC2
	if(kc1(ii).gt.0)write(nf2,*) ' NUMERO DI ', ii,' - PRE-CICLI  = ', 
     #kc1(ii)
231	continue
	DO 232 II=1, KREC3
	ksum=ksum+kc2(ii)
	if(kc2(ii).gt.0) write(nf2,*) ' NUMERO DI ', ii,' - CICLI 
     #TOTALI = ' , kc2(ii)
232	continue
	write(nf2,*) ' '
	write(nf2, *) 'NUMERO TOTALE DI CICLI = ', KSUM
	end if
	stop
      end                      