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*34, 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.2000000)goto 300 if(ns(0).eq.2000000)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)-2000000 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