


Source file: c:\msdev\projects\prineseven\sourseven.f90

  Line Covered  Source
----------------------
    1:    *     USE PORTLIB
    2:          use MSIMSL
    3:          use MSFLIB
    4:          implicit none
    5:          !PROGRAM Primseven
    6:          real*8 a0111(15000),a1(15000),a2(15000),a3(15000),a0222(15000),a4(15000),a5(15000),a6(15000)
    7:          real*8 sosti(15000),park,park1,n1,park2,k ,k11
    8:          integer*4 key1,key2,key3,second,resto,resto1
    9:          integer*4 wl,rr,flag1,flag2,flag3,flag4,u(851068),flag5
   10:          integer*4 n,p,j,i,pr ,scelta,z,combi1,combi2,combi3,combi4,combi5
   11:          integer*4 y(149000),sump,sumn,numc,resto2,toto1,toto2,toto3
   12:          INTEGER(4) time_array(3)
   13:          character*20 filename
   14:          character*1  ch
   15:          ! ***************************
   16:           3 format(1X,a3,I10,a3,I10,a3,I10,a3,I10,a3,I10,a3,I10,a3,I10)
   17:           4 format(1X,a7)
   18:           5 format(1X,a75)
   19:           6 format(1X,a60)
   20:           7 format(1x,a45)
   21:           8 format(a1)
   22:           9 Format(8I7)
   23:          10 format(a45,4I10)
   24:          11 format(1F6.0,a2,1F6.0,a2,1F6.0,a2,1F6.0,a2,1F6.0)
   25:          12 format(2F6.0,a2,1F6.0,a2,1F6.0,a2,1F6.0,a2,1F6.0)
   26:          19 format(1I9,1F10.0,1I9)
   27:          21 format(4F10.0)
   28:          23 format(2I9,2F9.0,1I9)
   29:          24 format(1I9,1F12.3,1I8,1F10.0,1F10.0,1F10.0 )
   30:          25 format(a6,1F10.0,a20,1I10,a3,2I10    )
   31:          26 format(1X,a40,2F11.0)
   32:          27 format(1I8,5F13.0)
   33:          28 format(a20,1I9,a20,1I9)
   34:          29 format(1x,20I5)
   35:          
   36:          !*******************************
   37:    *     FILENAME="session7.dat"
   38:    *         open(7,file=filename,access='sequential',form='formatted',        &     
   39:              &action='write')
   40:              scelta=0
   41:          !===============================================================
   42:          !start program generating primes up to 2000600 and store them in array y     
   43:          !====================================================
   44:    *     1020   p=1;j=2
   45:    *     y(1)=2;y(2)=3
   46:    *     do i=1,1000300
   47:    *      n=3
   48:           p=p+2
   49:    *     resto = mod( P, N )
   50:    *     DO WHILE (resto /= 0 .AND. N < SQRT( REAL(P) ))
   51:    *       n = n + 2
   52:    *        resto = MOD( p, n )
   53:    *     end do
   54:    *     IF (resto /= 0) THEN
   55:          j=j+1
   56:    *       y(j)=p
   57:          END IF
   58:           continue
   59:           end do
   60:    *      flag5=0
   61:            !===============
   62:    *     1025    j=1;k=1;z=0
   63:    *     print*,'',flag1
   64:    *      if (flag5.eq.1)then
   65:    .      if (n.eq.1)then
   66:    .      j=0
   67:    .      else if(n.gt.1)then
   68:    .      j=1
   69:           end if
   70:           end if
   71:    *      if(flag4.eq.1)then
   72:    .      j=0
   73:           end if
   74:    *       do i=2,1000000
   75:    *       k=k+2
   76:    *       j=j+1
   77:    *          if (k.eq.y(j))then
   78:               goto 88776
   79:               end if
   80:    *       if(k.ne.y(j))then ! must keep in case of one primes
   81:    *         z=z+1
   82:    *         u(z)=k
   83:              j=j-1
   84:             end if
   85:            88776 continue
   86:             end do
   87:    *       flag4=0
   88:    *       if(flag1.eq.0)goto 2222
   89:    .       if(flag1.eq.1)goto 11124
   90:           !=====================================
   91:           !end generating primes and composites for main arrays  y and u
   92:           !================================================
   93:           !start option 6 .-variation in inain array Y and u
   94:           !============================================ 
   95:    .     1022   WRITE(*,*)'ENTER THE POSITION OF PRIME TO ELIMINATE'
   96:    .      CALL CONTROL (SCELTA)
   97:    .       K=SCELTA ;n=scelta
   98:    .       y(k)=2000300
   99:    .           call sortqq(loc(y),148500,srt$Integer4)
  100:    .         flag5=1;flag1=0
  101:          !   print*,' flag1',flag1
  102:          !  do j=1,10
  103:          !  print*,y(j)
  104:          !  continue
  105:          !  end do
  106:          !  pause
  107:              j=1
  108:    .     goto 1025
  109:    .     1023 flag5=1
  110:    .     do i=1,4
  111:    .       y(1)=2000300
  112:    .           call sortqq(loc(y),148500,srt$Integer4)
  113:            continue
  114:            end do
  115:           !  do j=1,10
  116:           !  print*,y(j)
  117:           !  continue
  118:           !  end do
  119:           !  pause
  120:    .        j=1  ;flag4=1;goto 1025
  121:          !===========================
  122:             !start main menu
  123:             !=====================================
  124:    *     2222   write(*,*)'        MENU'
  125:    *      write(*,*)'1  Go to submenu primes'
  126:    *      write(*,*)'2  Go to submenu divisors'
  127:    *      write(*,*)'3  Go to submenu inclusion-exclusion and reverse methods'
  128:    *      write(*,*)'4  Elaborate triplets with reverse method(Theorem of Fermat,Problem of 2N)'
  129:    *      write(*,*)'5  Go to submenu Goldbach '
  130:    *      write(*,*)'6  TAKE AWAY A PRIME FROM MAIN ARRAY y'
  131:    *      write(*,*)'7  SUBSTITUTE A PRIME WITH A SMALLER COMPOSITE'
  132:          
  133:    *      write(*,*)'8  MAIN ARRAY TO NORMAL'
  134:    *      write(*,*)'9  About this program'
  135:    *      write(*,*)'10 Exit program'
  136:    *       call control(scelta)
  137:    .       if(scelta.eq.1)then
  138:            goto 11121
  139:            end if
  140:    .       if(scelta.eq.2)then
  141:            goto 11122
  142:            end if
  143:    .       if(scelta.eq.3)then
  144:            goto 11124
  145:            end if
  146:    .       if(scelta.eq.4)then
  147:    .       flag1=1
  148:    .       goto 3333
  149:            end if
  150:    .       if (scelta.eq.5)then
  151:            goto 11135
  152:            end if 
  153:    .       if(scelta.eq.6)then
  154:    .       flag1=0
  155:            goto 1022
  156:            end if
  157:    .       if(scelta.eq.7)then
  158:    .       CALL CHANGE(Y)
  159:            goto 2222
  160:            end if
  161:    .       if(scelta.eq.8)then
  162:    .       flag1=0
  163:    .       goto 1020
  164:            end if
  165:    .       if(scelta.eq.9)then
  166:    .         write(*,*)'Program of Ito Buda-Via S.Vito 5-TS-Italy'
  167:    .         write (*,*)'-No responsability accepted'
  168:    .         write(*,*)'For help and description read "readme"'
  169:    .         write(*,*)'email ito.buda@tin.it '
  170:    .         goto 2222
  171:              end if
  172:    .         if(scelta.eq.10)then
  173:    .         close (7)
  174:    .       call exit
  175:            end if
  176:    .         if(scelta.gt.10)goto 2222
  177:    .       pause
  178:    .       goto 2222
  179:              !==============================
  180:              !end main menu
  181:    .      11121 write(*,*)'      SUBMENU PRIMES'
  182:    .       write(*,*)'1  Phi(N)  ,10<N<=2147483647(sub trova1)'
  183:    .       write(*,*)'2  Lists of primes  of gaps and twins N<=2147483647(sub lista) '
  184:    .       write(*,*)'3  Prime factors of a number N<=2147483647(sub decom) '
  185:    .       write(*,*)'4  Go back to main menu '
  186:    .       call control(scelta)
  187:    .      if(scelta.eq.1)then
  188:    .     10011  call control(scelta)
  189:    .      n1=scelta
  190:    .      if(n1.lt.11)goto 10011
  191:    .        write(*,*)'Please wait few seconds'
  192:    .     1021    CALL ITIME (time_array)
  193:          1122   format (1X,I2,':',I2,':',I2)
  194:    .            write(*,1122) time_array
  195:    .            park1=n1
  196:    .            call trova1 (n1,y)
  197:    .         write(*,21)n1
  198:    .         write(*,26)'  prime numbers up to ',park1
  199:    .         write(7,26)'  prime numbers up to ',park1
  200:    .         write(7,21)n1
  201:    .         write(7,7) '_______________________________________'
  202:    .         CALL ITIME (time_array)
  203:    .         write(*,1122) time_array
  204:    .         pause
  205:    .         goto 11121
  206:              end if
  207:    .        if(scelta.eq.2)then
  208:    .         call lista(y)
  209:    .         goto 11121
  210:              end if
  211:    .         if(scelta.eq.3)then  
  212:    .         call decom
  213:    .         goto 11121
  214:              end if
  215:    .         if(scelta.eq.4)then
  216:              goto 2222
  217:              end if
  218:    .         if(scelta.gt.4)goto 11121
  219:          !==========================
  220:    .        11122 write(*,*)'      SUBMENU DIVISORS'
  221:    .       write(*,*)'1  Lists, total divisors and other functions N<=2147483647(sub vetto1)'
  222:    .       write(*,*)'2  Lists of divisors for a single number N<=2147483647(sub div) '
  223:    .       write(*,*)'3  Euler function for a single number N<=2147483647(sub Euler1) '
  224:    .       write(*,*)'4  go back to main menu '
  225:    .       call control(scelta)
  226:    .       if(scelta.eq.1)then
  227:    .       call vetto1(y)
  228:    .       goto 11122
  229:            end if
  230:    .       if(scelta.eq.2)then
  231:    .       call div(y)
  232:    .       goto 11122
  233:            end if
  234:    .      if(scelta.eq.3)then
  235:    .       call euler1
  236:    .       goto 11122
  237:            end if 
  238:    .       if(scelta.eq.4)then
  239:              goto 2222
  240:              end if
  241:    .         if(scelta.gt.4)goto 11122
  242:          !======================================
  243:    .      11124 write(*,*)'      SUBMENU inclusion-exclusion and reverse methods'
  244:    .       write(*,*)'1  Phi(N) with inclusion-exclusion method (sub inclusion)'
  245:    .       write(*,*)'2  Phi(N) with reverse method(sub reverse)'
  246:    .       write(*,*)'3  Take away  the primes 2,3,5,7 from main array y(label 1023)'
  247:    .       write(*,*)'4  MAIN ARRAY TO NORMAL(label 1020)'
  248:    .       write(*,*)'5  Go back to main menu '
  249:    .       call control(scelta)
  250:    .       if(scelta.eq.1)then
  251:    .       call inclusion (y,flag5)
  252:    .       goto 11124
  253:            end if
  254:    .       if(scelta.eq.2)then
  255:    .       flag1=0
  256:    .       call reverse (y,flag1,flag2,flag3,flag4,flag5,a1,a2,a3,a4,a5,a6,key1,key3,second,numc,resto,resto1,resto2)
  257:    .       goto 11124
  258:            end if
  259:    .       if(scelta.eq.3)then
  260:    .       flag1=1
  261:    .       pause
  262:            goto 1023
  263:            end if
  264:    .      if(scelta.eq.4)then
  265:    .        flag1=1
  266:    .        goto 1020
  267:            end if
  268:    .      if(scelta.eq.5)then
  269:              goto 2222
  270:           end if
  271:    .      if(scelta.gt.5)goto 11124
  272:          !start sub menu triplets
  273:          !==============================
  274:    .     3333  write(*,*)'     SUB MENU triplets or 3 numbers'
  275:    .      write(*,*)'1  Enter 1st number of the triplet N1<=N2<N3 (sub reverse)'
  276:    .      write(*,*)'   some data will be memorized in vector a1'   
  277:    .      write(*,*)'2  Enter 2nd number of the triplet N2<N3(sub reverse)'
  278:    .      write(*,*)'   some data will be memorized in vector a2'   
  279:    .      write(*,*)'3  Enter 3rd number of the triplet N3>N2>=N1(sub reverse)'
  280:    .      write(*,*)'   some data will be memorized in vector a3'   
  281:    .      write(*,*)'4  Elaborate data for the 3 numbers(label 5111)'
  282:    .      write(*,*)'5  List of primitive Pythaforean triplets(sub triplets)'
  283:    .      write(*,*)'6  Go to main menu'
  284:    .      scelta=0 ;flag2=0;flag3=0 ;flag4=0      !print*,'enter number'
  285:    .       call control(scelta)
  286:           !***************
  287:    .      if(scelta.eq.1)then
  288:    .        flag2=1;flag3=0;flag4=0
  289:    .        call reverse(y,flag1,flag2,flag3,flag4,flag5,a1,a2,a3,a4,a5,a6,key1,key3,second,numc,resto,resto1,resto2)
  290:    .        goto 3333
  291:            end if
  292:    .      if(scelta.eq.2)then
  293:    .         flag3=1 ;flag2=0;flag4=0
  294:    .         call reverse(y,flag1,flag2,flag3,flag4,flag5,a1,a2,a3,a4,a5,a6,key1,key3,second,numc,resto,resto1,resto2)
  295:    .         goto 3333
  296:              end if
  297:    .      if(scelta.eq.3)then
  298:    .         flag4=1;flag2=0;flag3=0
  299:    .         call reverse(y,flag1,flag2,flag3,flag4,flag5,a1,a2,a3,a4,a5,a6,key1,key3,second,numc,resto,resto1,resto2)
  300:    .          goto 3333
  301:               end if 
  302:    .      if(scelta.eq.4)then
  303:           goto  5111      
  304:           end if
  305:    .      if (scelta.eq.5)then
  306:    .      call triplets
  307:    .      goto 3333
  308:           end if
  309:    .      if(scelta.eq.6)then
  310:           goto  2222      
  311:           end if
  312:    .      if(scelta.gt.6)goto 3333
  313:          !=============================
  314:          !end sub menu
  315:          !==================================
  316:          !start printing complete table not ordered
  317:           5111  i=0;park=0
  318:    .      i=1
  319:    .      do while (a2(i).ne.0) 
  320:          i=i+1
  321:          continue
  322:    .     end do
  323:    .     second=a2(i-1)
  324:    .     a2(i-1)=0
  325:    .     park=0;wl=numc+1
  326:          !===========================
  327:          !preparing vectors for ordered table
  328:          !=======================
  329:          sosti=0
  330:    .     a6=idnint(a6)
  331:    .     a5=idnint (a5)
  332:    .     a4=idnint(a4)
  333:    .     do j=1,key3
  334:    .     do i=1,key1
  335:    .     if((a6(j)).eq.(a4(i)))then
  336:    .     sosti(j)=a1(i)
  337:          end if
  338:           continue
  339:          end do 
  340:          continue
  341:          end do
  342:    .     sosti(key3+1)=a1(key1+1)
  343:    .     a1=sosti
  344:          sosti=0
  345:    .      do j=1,key3 !second
  346:    .      do i=1,second
  347:    .     if(a6(j) .eq. a5(i))then
  348:    .     sosti(j)=a2(i)
  349:          end if
  350:          continue
  351:          end do
  352:          continue
  353:          end do
  354:    .     sosti(key3+1)=a2(second+1)
  355:          a2=sosti
  356:          !end preparing vectors for ordered table
  357:          !===========================
  358:          !start printing ordered table
  359:          !=====================
  360:    .     write(*,9) resto,resto2,resto1
  361:    .     write(7,7)'the 3 numbers entered are                '
  362:    .     write(7,9) resto,resto2,resto1
  363:    .     park=0
  364:    .     key2=0
  365:            if(key2.eq.0)then
  366:    .     write(7,5)'column 1 = combinations of N3,this set contains combinations of M2 and N1    '                                   
  367:    .     write(7,5)'column 2 = values for N1 and relevant to combination in the same line        '
  368:    .     write(7,5)'column 3 = values for N2 and relevant to combination in the same line        '                                                                             
  369:    .     write(7,5)'column 4 = sum of the values of colimns 2 and 3 in rhe same line             '
  370:    .     write(7,5)'column 5 = values for N3 and relevant to combination in the same line        '
  371:    .     write(7,5)'column 6 =           difference betwen columns 4 and 5                       '                                                                     
  372:    .     write(7,5)'NOTE:if N3=N1+N2 the sum for column 6 must be 0 if we add 1 to all 3 members  '                                                                                                
  373:          end if
  374:    .     write(7,7)' printing table A          '
  375:          
  376:    .     write(7,7)'_________________________________________'
  377:    .     write(7,7)'1     2       3       4       5      6   '
  378:    .     write(7,7)'_________________________________________'
  379:    .     do i=1,wl
  380:    .     numc=i
  381:    .     write(*,12 )a6(i),a1(i),' +',a2(i),' =',a1(i)+a2(i),' -',a3(i),' =',(a1(i)+a2(i))-a3(i)
  382:    .     write(7,12 )a6(i),a1(i),' +',a2(i),' =',a1(i)+a2(i),' -',a3(i),' =',(a1(i)+a2(i))-a3(i)
  383:    .        rr=0;call riga(numc,rr)
  384:    .         if(rr.eq.1)goto 2222
  385:    .     park=park+(a1(i)+a2(i))-a3(i) 
  386:           continue
  387:           end do
  388:    .     print*,'sum of last column+1 = ',park+1
  389:    .     write(7,26)'sum of last column+1 =                   ',park+1
  390:    .     Print*,'number of combinations of N1,N2,N3  ',key1,second,key3
  391:    .     write(7,10) 'number of combinations of N1,N2,N3      ',key1,second,key3
  392:    .     pause
  393:    .     pause
  394:    .     write(7,7)'end printing table A          '
  395:    .      call endline
  396:          !end printing ordered table
  397:          !========================
  398:          !print vectors of combinations
  399:    .     sump=0;sumn=0;pr=0
  400:    .     print*,'combinations for 3 numbers'
  401:    .     write(7,26)'combinations for 3 numbers          '
  402:    .     write(7,9) resto,resto2,resto1
  403:    .       if(key2.eq.0)then
  404:    .     write(7,5)'column 1 = sequential number of combination                                    '                 
  405:    .     write(7,5)'column 2 = combinations of 1st number                                                        '
  406:    .     write(7,5)'column 3 = combinations of 2nd number                                                        '                                           
  407:    .     write(7,5)'column 4 = combinations of 3rd number                                                             '              
  408:    .     write(7,5)'NOTE:the combinations are obtained by N/K1,K2,K3..                             '
  409:    .     write(7,5)'they are the combinations of primes+operation of multiplication and/or power                                   '                
  410:          end if                                                
  411:    .     write(7,6)'       1        2         3         4                              '
  412:    .     write(7,6)'________________________________________________________            '
  413:    .      do i=1,wl
  414:    .     numc=i;k11=i
  415:    .     write(*,21)k11,a4(i),a5(i),a6(i)
  416:    .     write(7,21)k11,a4(i),a5(i),a6(i)
  417:    .     rr=0;call riga(numc,rr)
  418:    .     if(rr.eq.1)goto 2222
  419:    .     sump=sump+a4(i);sumn=sumn+a5(i);pr=pr+a6(i)
  420:          continue
  421:          end do
  422:    .     print*,'sums of combinations'
  423:    .     write(7,26)'sums of combinations                 '
  424:    .     print*,sump,sumn,pr
  425:    .     write(7,9)sump,sumn,pr
  426:    .     i=1
  427:    .      do while (a4(i).ne.0) 
  428:           i=i+1
  429:           continue
  430:    .      end do
  431:    .      combi1=i-1
  432:    .      i=1
  433:    .      do while (a5(i).ne.0) 
  434:           i=i+1
  435:           continue
  436:    .      end do
  437:    .      combi2=i-1
  438:    .      print*,combi1,combi2,wl
  439:    .     write(7,5)'number of combinations for the 3 numbers                                  '
  440:    .     write(7,9)combi1,combi2,wl-1
  441:    .     a4=idint(a4)
  442:    .     a5=idint(a5)
  443:    .     a6=idint(a6)
  444:    .     i=1
  445:    .      do while (a4(i).ne.0) 
  446:    .      i=i+1
  447:    .      if (mod(a4(i),2.0).ne.0 )then
  448:           exit
  449:           end if
  450:           continue
  451:           end do
  452:    .      combi3=i-1
  453:    .      i=1
  454:    .      do while (a5(i).ne.0) 
  455:    .      i=i+1
  456:    .      if (mod(a5(i),2.0).ne.0 )then
  457:           exit
  458:           end if
  459:           continue
  460:           end do
  461:    .      combi4=i-1
  462:    .      i=1
  463:    .      do while (a6(i).ne.0) 
  464:    .      i=i+1
  465:          
  466:    .      if (mod(a6(i),2.0).ne.0 )then
  467:           exit
  468:           end if
  469:           continue
  470:           end do
  471:    .      combi5=i-1
  472:    .      print*,combi3,combi4,combi5
  473:    .     write(7,5)'number of combinations for the 3 numbers for the prime 2                            '
  474:    .     write(7,9)combi3,combi4,combi5
  475:    .     i=combi3;toto1=combi3
  476:    .      do while (a4(i).ne.0) 
  477:    .      i=i+1
  478:    .      if (mod(a4(i),3.0).ne.0 )then
  479:           exit
  480:           end if
  481:           continue
  482:           end do
  483:    .      combi3=i-1-toto1
  484:    .      i=combi4;toto2=combi4
  485:    .      do while (a5(i).ne.0) 
  486:    .      i=i+1
  487:    .      if (mod(a5(i),3.0).ne.0 )then
  488:           exit
  489:           end if
  490:           continue
  491:           end do
  492:    .      combi4=i-1-toto2
  493:    .      i=combi5;toto3=combi5
  494:    .      do while (a6(i).ne.0) 
  495:    .      i=i+1
  496:    .      if (mod(a6(i),3.0).ne.0 )then
  497:           exit
  498:           end if
  499:           continue
  500:           end do
  501:    .      combi5=i-1-toto3
  502:    .      write(7,5)'number of combinations for the 3 numbers for the prime 3                            '
  503:    .      write(7,9)combi3,combi4,combi5
  504:    .      i=combi3+toto1 ;toto1=i
  505:    .      do while (a4(i).ne.0) 
  506:    .      i=i+1
  507:    .      if (mod(a4(i),5.0).ne.0 )then
  508:           exit
  509:           end if
  510:           continue
  511:           end do
  512:    .      combi3=i-1-toto1
  513:    .      i=combi4+toto2;toto2=i
  514:    .      do while (a5(i).ne.0) 
  515:    .      i=i+1
  516:    .      if (mod(a5(i),5.0).ne.0 )then
  517:           exit
  518:           end if
  519:           continue
  520:           end do
  521:    .      combi4=i-1-toto2
  522:    .       i=combi5+toto3;toto3=i
  523:    .      do while (a6(i).ne.0) 
  524:    .      i=i+1
  525:    .      if (mod(a6(i),5.0).ne.0 )then
  526:           exit
  527:           end if
  528:           continue
  529:           end do
  530:    .      combi5=i-1-toto3
  531:    .      write(7,5)'number of combinations for the 3 numbers for the prime 5                            '
  532:    .      write(7,9)combi3,combi4,combi5
  533:    .      pause
  534:    .      call endline
  535:          !end printing vectors of combinations
  536:          !=========================
  537:          !ordering the vectors of combinations
  538:          !===================================
  539:                sosti=0;j=0
  540:    .           call sortqq(loc(a4),15000,srt$real8)
  541:    .           do i=1,15000
  542:    .           if (a4(i).ne.0)then
  543:                j=j+1
  544:    .           sosti(j)=a4(i)
  545:                end if
  546:                continue
  547:    .           end do
  548:    .           a4=sosti
  549:            !!!!!!!!!!!!!!!
  550:               sosti=0;j=0
  551:    .           call sortqq(loc(a5),15000,srt$real8)
  552:    .           do i=1,15000
  553:    .           if (a5(i).ne.0)then
  554:                j=j+1
  555:    .           sosti(j)=a5(i)
  556:                end if
  557:                continue
  558:    .           end do
  559:    .           a5=sosti
  560:            !!!!!!!!!!!!!!!
  561:              sosti=0;j=0
  562:    .           call sortqq(loc(a6),15000,srt$real8)
  563:    .           do i=1,15000
  564:    .           if (a6(i).ne.0)then
  565:                j=j+1
  566:    .           sosti(j)=a6(i)
  567:                end if
  568:                continue
  569:    .           end do
  570:                a6=sosti
  571:            ! end ordering the vectors of combinations
  572:            !start print ordered vectors
  573:            !======================
  574:    .       sump=0;sumn=0;pr=0
  575:    .     print*,'ordered combinations for 3 numbers'
  576:    .     write(7,26)'ordered combinations of numbers             '
  577:    .     write(7,9) resto,resto2,resto1
  578:    .     write(7,6)'       1        2         3         4                              '
  579:    .     write(7,6)'________________________________________________________            '
  580:    .      do i=1,key3
  581:    .     numc=i;k11=i
  582:    .     write(*,21)k11,a4(i),a5(i),a6(i)
  583:    .     write(7,21)k11,a4(i),a5(i),a6(i)
  584:    .     rr=0;call riga(numc,rr)
  585:    .     if(rr.eq.1)goto 2222
  586:    .     sump=sump+a4(i);sumn=sumn+a5(i);pr=pr+a6(i)
  587:          continue
  588:          end do
  589:    .     print*,'sums of combinations'
  590:    .     write(7,26)'sums of combinations              '
  591:    .     print*,sump,sumn,pr
  592:    .     write(7,9)sump,sumn,pr
  593:    .     write(7,7)'end printing combinations for the 3 numbers          '
  594:    .     write(7,7)'======================================================'
  595:    .     pause
  596:    .     a0111=0;a1=0;a2=0;a3=0;a4=0;a5=0;a6=0;a0222=0
  597:          goto 3333
  598:          !=================================
  599:          !end print ordered vectors
  600:          !==================================
  601:    .      11135 write(*,*)'      SUBMENU  Goldbach'
  602:    .       write(*,*)'1  Pairs of primes,mixed and composites(sub Goldbach1)'
  603:    .       write(*,*)'2  Numbers with the same numbers of pairs of prmes N <= 100(sub Goldbach2)'
  604:    .       write(*,*)'3  Numbers with the same numbers of pairs of composites N<=100(sub Goldbach3)'
  605:    .       write(*,*)'4  Numbers with the same numbers of pairs of mixed N <= 100(sub Goldbach4)'
  606:    .       write(*,*)'5  Goldbach pairs with reverse method div 6,8( sub gold)'
  607:    .       write(*,*)'6  Goldbach pairs with reverse method div 3,4(sub gold1)'
  608:    .       write(*,*)'7  Mixed  pairs with total scanning  method(sub mixed1) '
  609:    .       write(*,*)'8  Mixed total pairs with combinatorics method of 1/2 (N) and scanning for the second half of N(sub mixed)'
  610:    .       write(*,*)'9  Composite total pairs with combinatorics method for 1/2 (N)and scanning for   the second half of N(sub composite)'
  611:    .       write(*,*)'10  Go back to main menu '
  612:    .       call control(scelta)
  613:    .       if(scelta.eq.1)then
  614:    .       call Goldbach1(y)
  615:    .       ch=''
  616:    .       goto 11135
  617:            end if
  618:    .        if(scelta.eq.2)then
  619:    .        call goldbach2(y)
  620:    .        goto 11135
  621:             end if
  622:    .        if(scelta.eq.3)then
  623:    .        call goldbach3(u)
  624:    .        goto 11135
  625:             end if
  626:    .        if(scelta.eq.4)then
  627:    .        call goldbach4(u,y)
  628:    .        goto 11135
  629:             end if
  630:    .       if(scelta.eq.5)then
  631:    .       call gold (y)
  632:    .       goto 11135
  633:            end if
  634:    .       if(scelta.eq.6)then
  635:    .       call gold1 (y)
  636:    .       goto 11135
  637:            end if
  638:    .     if(scelta.eq.7)then
  639:    .      call control(scelta)
  640:    .      park1=scelta
  641:    .      park2=park1-2
  642:    .      call mixed1(park1,park2,y,u)
  643:    .      goto 11135
  644:          end if  
  645:    .     if(scelta.eq.8)then
  646:    .      call control(scelta)
  647:    .      park1=scelta
  648:    .      park2=park1-2
  649:    .      call mixed(park1,park2,y,u)
  650:    .      goto 11135
  651:           end if      
  652:    .       if(scelta.eq.9)then
  653:    .      call control(scelta)
  654:    .      park1=scelta
  655:    .      park2=park1-2
  656:    .      call composite(park1,park2,u)
  657:    .      goto 11135
  658:           end if
  659:    .     if(scelta.eq.10)then
  660:          goto 2222
  661:          end if
  662:    .     if(scelta.gt.10)goto 11135
  663:    .     end
  664:            !end main program    
  665:            !=======================
  666:            ! start subroutines
  667:            !=======================
  668:    .          subroutine cerca(pr,y)
  669:               integer*4 y(149000)
  670:               integer*4 sinistro,medio,destro,pr
  671:    .          i=0
  672:                sinistro=1
  673:    .           destro=149000
  674:    .           do while (sinistro .le.destro )
  675:    .           medio=((sinistro + destro)/2) 
  676:    .           if (pr.gt.y(medio))then
  677:    .           sinistro =medio+1 
  678:    .           else if (pr .lt.y(medio) )then
  679:    .           destro=medio -1
  680:    .           else       
  681:                exit
  682:                endif
  683:                end do 
  684:    .           if (y(medio).gt.pr)then
  685:    .             medio=medio-1
  686:    .             end if        
  687:    .             pr=medio
  688:    .             end subroutine cerca
  689:             !===================================
  690:    .         subroutine cerca1(pr,u)
  691:                implicit none
  692:                integer*4 u(851068),i
  693:                integer*4 sinistro,medio,destro,pr
  694:                 i=0
  695:                sinistro=1
  696:    .           destro=851068
  697:    .           do while (sinistro .le.destro )
  698:    .           medio=((sinistro + destro)/2) 
  699:    .           if (pr.gt.u(medio))then
  700:    .           sinistro =medio+1 
  701:    .           else if (pr .lt.u(medio) )then
  702:    .           destro=medio -1
  703:    .           else       
  704:                exit
  705:                endif
  706:                end do 
  707:    .           if (u(medio).gt.pr)then
  708:    .             medio=medio-1
  709:    .             end if        
  710:    .             pr=medio
  711:    .             end subroutine cerca1
  712:          !========================
  713:          !subroutine to control entry data
  714:             !===================================
  715:    *        subroutine control(scelta)
  716:             character*1 ch
  717:             integer*4 scelta
  718:             real*8  n1
  719:             character(20) c20
  720:             character(10) c10
  721:          10 format(a1)
  722:          20 format(F11.0)
  723:          1234 format(I10)
  724:          30   format(a1)
  725:    *     c10='0123456789'
  726:    *     ch=''
  727:    *     99 print*,'enter number' 
  728:    *        read(*,*)c20
  729:    .        write(*,*)'   ',c20,'  OK? Yes=any key N/n=no'
  730:    .        read (*,10) ch
  731:    .      if((ch.eq.'N').or.(ch.eq.'n'))then
  732:                 goto 99
  733:                 end if
  734:    .          position=verify(c20,c10)
  735:    .          if(position.eq.1)then
  736:               goto 99
  737:               end if
  738:    .          read(c20,20)n1
  739:    .          if(n1.gt.2147483647)goto 99     !scelta
  740:    .          scelta=n1
  741:    .          end subroutine control
  742:               !==============================
  743:               !subroutine riga
  744:               !==============================
  745:    .          subroutine riga(numc,rr)
  746:               use MSFLIB
  747:               integer*4 numc,rr
  748:               character*1 key
  749:    .          if (mod(numc,20).eq.0)then
  750:    .          write(*,*)'press any key to continue,q to exit'
  751:    .          key = getcharqq()
  752:    .         if (key .eq.'q')then
  753:    .         rr=1
  754:              goto 2121
  755:              end if
  756:    .         pause
  757:              end if
  758:    .     2121    end subroutine riga      
  759:          !==============================
  760:            !       Subroutine reduce 
  761:            ! to eliminate multiples of 2 3  5 and 7   
  762:    .           Subroutine reduce(c,c2)
  763:                integer*4 r,s3,c2,c
  764:                real*8 p9 
  765:    .           c2=0
  766:                s3=0 
  767:    .           if(c.lt.13)then
  768:    .            c2=2
  769:    .            goto 2100
  770:                 end if
  771:    .           r=0
  772:                goto 1130
  773:    .      1120   r=1
  774:    .      1130   if  ( mod(c, 2) .eq.0)then
  775:    .           c=c-1
  776:                end if
  777:    .           do while(( mod(c, 3) .eq.0).or. ( mod(c, 5) .eq.0) )
  778:    .           c=c-2 
  779:                end do 
  780:    .           if (r .eq.1)then
  781:    .           p9=c
  782:    .           s3=aint(((p9*8)/30)+1)
  783:    .           goto 2100
  784:                end if
  785:    .           p9=c
  786:    .           c2=aint(((p9*8)/30)+1)
  787:    .           c=c/7 
  788:    .           if (c.lt.7)then
  789:    .           s3=1
  790:                goto 2100
  791:                end if
  792:    .           goto 1120
  793:    .      2100   c2=c2-s3
  794:    .           end subroutine reduce
  795:          !=================================
  796:    .     Subroutine trova1(n1,y)
  797:                integer*2 t,zl,yl,hl,gl,ml,ll,kl,zx,wl,rr 
  798:                real*8 z2,z3,z4,q8,z5,z6,z7,n1,z11,z12,k 
  799:                integer*4 k1,k2,k3,k4,k5,k6,k7,k8,k9,k10,k11,comb,scomb,se,pr,s1
  800:                integer*4 sr1,z1,v11,x,c2,sost,w,s,x1,c 
  801:                integer*4 y(149000)
  802:           9 Format(7I9)
  803:           10 format(2F10.0)
  804:           11 format (1X,a20)
  805:    .           k=n1
  806:    .           q8=k
  807:    .           c=n1
  808:                c2=0
  809:    .           s=n1
  810:    .           w=s
  811:    .           call reduce(c,c2)
  812:    .           se = c2 
  813:           ! se is now the number of elements  of the set without the nultiples of 2 ,3,5     
  814:    .           x=(sqrt(q8))
  815:    .           x1=q8**(0.3333333333333333333333)
  816:                pr=x            
  817:    .           call cerca(pr,y)
  818:    .           z1=pr-1
  819:    .           z2=pr
  820:                pr=x1
  821:    .           call cerca(pr,y)
  822:    .           z3=pr             
  823:    .            z4=((z2*z2)+z2)/2
  824:    .           z5=((z3*z3)+z3)/2
  825:    .           z6=z4-z5          
  826:    .           z7=z2-z3
  827:    .           z11=n1/2000000
  828:    .           pr=z11
  829:    .           call cerca (pr,y)
  830:    .           z12=pr
  831:                sr1=0
  832:                comb=0
  833:                scomb=0
  834:    .           if(z12.le.4)then  
  835:                 goto 3659 !go to reverse
  836:                 end if 
  837:           ! start rest of calculation up to reverse            
  838:    .               t=4
  839:    .       660      t=t+1
  840:    .           if(z12.lt.t)goto 3659
  841:    .           k1=k/y(t)
  842:                scomb=scomb+1
  843:    .           if (k1.lt.11)then
  844:    .           sr1=sr1+1
  845:    .           else 
  846:    .           c=k1
  847:    .              call reduce(c,c2)
  848:    .              sost=c2
  849:                   sr1=sr1 + sost
  850:                   end if
  851:                   zl=4
  852:    .       740    zl=zl+1
  853:    .           k2=k1/y(zl)
  854:    .           if((k2.lt.1).or.(zl.eq.t))goto 660
  855:                scomb=scomb+1
  856:    .           if (k2.lt.11)then
  857:    .           sr1=sr1-1
  858:    .           else
  859:    .           c=k2
  860:    .           call reduce (c,c2)
  861:    .           sost=c2
  862:                sr1=sr1-sost
  863:                end if
  864:                yl=4
  865:    .       820      yl=yl+1
  866:    .           k3=k2/y(yl)
  867:    .           if((k3.lt.1).or.(yl.eq.zl))goto 740
  868:    .           scom=scomb+1
  869:    .           if(k3.lt.11)then
  870:    .           sr1=sr1+1
  871:    .           else
  872:    .           c=k3
  873:    .           call reduce (c,c2)
  874:    .           sost=c2
  875:                sr1=sr1+sost
  876:                end if
  877:                hl=4
  878:    .       910      hl=hl+1
  879:    .           k4=k3/y(hl)
  880:    .           if((k4.lt.1).or.(hl.eq.yl))goto 820
  881:                scomb=scomb+1
  882:    .           if(k4.lt.11)then
  883:    .           sr1=sr1-1
  884:    .           else
  885:    .           c=k4
  886:    .           call reduce(c,c2)
  887:    .           sost=c2
  888:                sr1=sr1-sost
  889:                end if
  890:                gl=4
  891:    .       960      gl=gl+1
  892:    .           k5=k4/y(gl)
  893:    .           if((k5.lt.1).or.(gl.eq.hl))goto 910
  894:                scomb=scomb+1
  895:    .           if(k5.lt.11)then
  896:    .           sr1=sr1+1
  897:    .           else
  898:    .           c=k5
  899:    .           call reduce (c,c2)
  900:    .           sost=c2
  901:                sr1=sr1+sost
  902:                end if
  903:                ml=4
  904:    .       964      ml=ml+1
  905:    .           k6=k5/y(ml)
  906:    .           if((k6.lt.1).or.(ml.eq.gl))goto 960
  907:                scomb=scomb+1
  908:    .           if(k6.lt.11)then
  909:    .           sr1=sr1-1
  910:    .           else
  911:    .           c=k6
  912:    .           call reduce(c,c2)
  913:    .           sost=c2
  914:                sr1=sr1-sost
  915:                end if
  916:                ll=4
  917:    .       968       ll=ll+1
  918:    .           k7=k6/y(ll)
  919:    .           if((k7.lt.1).or.(ll.eq.ml))goto 964
  920:                scomb=scomb+1
  921:    .           if(k7.lt.11)then
  922:    .           sr1=sr1+1
  923:    .           else
  924:    .           c=k7
  925:    .           call reduce(c,c2)
  926:    .           sost=c2
  927:                sr1=sr1+sost
  928:                end if
  929:                kl=4
  930:    .       972      kl=kl+1
  931:    .           k8=k7/y(kl)
  932:    .           if((k8.lt.1).or.(kl.eq.ll))goto 968
  933:    .           scom=scomb+1
  934:    .           if(k8.lt.11)then
  935:    .           sr1=sr1-1
  936:    .           else
  937:    .           c=k8
  938:    .           call reduce (c,c2)
  939:    .           sost=c2
  940:                sr1=sr1-sost
  941:                end if
  942:                zx=4
  943:    .       976      zx=zx+1
  944:    .           k9=k8/y(zx)      
  945:    .           if((k9.lt.1).or.(zx.eq.kl))goto 972
  946:                scomb=scomb+1
  947:    .           if(k9.lt.11)then
  948:    .           sr1=sr1+1
  949:    .           else
  950:    .           c=k9
  951:    .           call reduce(c,c2)
  952:    .           sost=c2
  953:                sr1=sr1+sost
  954:                end if
  955:    .           wl=4
  956:    .       978      wl=wl+1
  957:    .           k10=k9/y(wl)
  958:    .           if((k10.lt.1).or.(wl.eq.zx))goto 976
  959:                scomb=scomb+1
  960:    .           if (k10.lt.11)then
  961:    .           sr1=sr1-1
  962:    .           else
  963:    .           c=k10
  964:    .           call reduce(c,c2)
  965:    .           sost=c2
  966:    .           sr1=sr1-sost
  967:    .           end if
  968:    .           rr=4
  969:    .       980      rr=rr+1
  970:                k11=k10/y(rr)
  971:    .           if((k11.lt.1).or.(rr.eq.wl))goto 978
  972:    .           c=k11
  973:    .           scomb=scomb+1
  974:    .           call reduce(c,c2)
  975:    .           sost=c2
  976:                sr1=sr1+sost 
  977:    .           goto 980
  978:                 
  979:          !  C     start reverse
  980:    .      3659 if(z12.gt.4)then 
  981:    .         t=z12
  982:              end if
  983:    .         if (z12.lt.5)then
  984:    .         t=4
  985:              end if
  986:    .         s1=0
  987:    .      3660     t=t+1
  988:    .           if (z2.lt.t)goto 5000
  989:    .           k1=k/y(t)
  990:    .           pr=k1
  991:    .           call cerca(pr,y)
  992:    .           s1=s1+pr-t+1
  993:                goto 3730
  994:    .     3700      k1=k1/y(t)
  995:    .           if(k1.lt.y(t)) goto 3660
  996:                pr=k1
  997:                call cerca(pr,y)       
  998:                s1=s1+pr-t+1
  999:    .     3730  zl=t
 1000:    .     3740  zl=zl+1
 1001:    .           k2=k1/y(zl)
 1002:    .           if (k2.lt.y(zl)) goto 3700
 1003:    .           pr=k2
 1004:    .           call cerca(pr,y)
 1005:    .           s1=s1+pr-zl+1
 1006:                goto 3810
 1007:    .     3780  k2=k2/y(zl)
 1008:    .           if( k2.lt.y(zl)) goto 3740
 1009:                pr=k2
 1010:                call cerca(pr,y)
 1011:                s1=s1+pr-zl+1
 1012:    .      3810  yl=zl
 1013:    .      3820 yl=yl+1
 1014:    .           k3=k2/y(yl)
 1015:    .           if(k3.lt.y(yl))goto 3780
 1016:    .           pr=k3
 1017:    .           call cerca(pr,y)
 1018:    .           s1=s1+pr-yl+1
 1019:                goto 3900
 1020:    .     3850  k3=k3/y(yl)
 1021:    .            if(k3.lt.y(yl)) goto 3820
 1022:    .            pr=k3
 1023:    .            call cerca(pr,y)
 1024:    .            s1=s1+pr-yl+1
 1025:           3900 hl=yl
 1026:    .      3910 hl=hl+1
 1027:    .           k4=k3/y(hl)
 1028:    .           if(k4.lt.y(hl) )goto 3850
 1029:    .           pr=k4
 1030:    .           call cerca(pr,y)
 1031:    .           s1=s1+pr-hl+1
 1032:                goto 3950
 1033:    .     3940  k4=k4/y(hl)
 1034:    .           if(k4.lt.y(hl))goto 3910
 1035:                pr=k4
 1036:                call cerca(pr,y)
 1037:                s1=s1+pr-hl+1
 1038:           3950 gl=hl
 1039:    .      3960 gl=gl+1
 1040:    .           k5=k4/y(gl)
 1041:    .           if(k5.lt.y(gl))goto 3940
 1042:    .           pr=k5
 1043:    .           call cerca(pr,y)
 1044:    .           s1=s1+pr-gl+1
 1045:    .           goto 3960
 1046:          
 1047:    .     5000       if (z12.lt.5)then
 1048:    .                v11=se-s1-sr1+4-1
 1049:    .                end if
 1050:    .           if (z12.gt.4)then
 1051:    .            v11=se-s1-sr1+z12-1
 1052:    .            end if
 1053:    .            n=v11
 1054:    .            n1=v11
 1055:    .           end subroutine trova1
 1056:          !========================
 1057:    .     subroutine vetto1(y)
 1058:           USE MSIMSL
 1059:          USE MSFLIB
 1060:            implicit none 
 1061:            integer*4 divisori,sl,numc,divisori1,flag,div1,div2,pr,cont
 1062:            real*8 e0,ex,e2,e3,e4,e5,e6,q8,z2,e7,e8,e9,s1,saln,ss99
 1063:            real*8 k1,k2,k3,k4,k5,k6,k7,k,k8,k9,ss88,k88a,k88,in,somma 
 1064:            real*8 x,n1,k11,k11a,k22,k22a,k33,k33a,k44,k44a,k55,k55a,k66,k66a,k77,k77a,k99,k99a
 1065:            integer*4 y(149000),total,rr
 1066:            integer*4 g(2000)!in this array divisors are memorized
 1067:            integer*4 a,b,d1,d2,d3,d4,i
 1068:            integer*4 p(2000)
 1069:            real*8 s(2000)
 1070:            integer*4 e(2000),c(4) ,scelta,t,yl,hl,zl,gl,il,fl   
 1071:            integer*4 v11,al,salto,z(3),j
 1072:            real*8 combi1,combi2,combi3,combi4,combi5,combi6,combi7,combi8,combi9
 1073:            real*8 sum7,sum7a,sum8,sum8a,sum9,sum9a,sum5,sum5a,sum6,sum6a
 1074:            real*8 sum4,sum4a,sum3,sum3a,sum2,sum2a,sum1,sum1a
 1075:            character*1 ch,fz
 1076:    .         p=0
 1077:              g=0
 1078:    .         fz=achar(179)
 1079:          1123  format(a3,F11.0)
 1080:          30    format(a1) 
 1081:          10    format(a1)
 1082:          40    format(a70)
 1083:          41    format(a20,I5,a15)
 1084:          1234 format(I10)
 1085:    .         z(1)=18;z(2)=19;z(3)=20 
 1086:    .         call control(scelta)
 1087:    .           n1=scelta
 1088:    .           saln=n1
 1089:    .           WRITE(7,42)'Subdivision of divisors for N='
 1090:    .           divisori = 0
 1091:    .           salto = 0 
 1092:    .        105  k=n1
 1093:                q8=k
 1094:    .           z2=sqrt(1.*q8)
 1095:                cont=0
 1096:                e0=1
 1097:                in=0
 1098:                somma=0
 1099:             !    w=n
 1100:          !C    start reverse for divisors
 1101:    .         if (divisori.gt.0)then
 1102:    .         write(*,*)'There are',g(divisori),' numbers with '
 1103:    .         write(*,*)divisori,'  divisors up to   '
 1104:    .         write(*,1123)'   ',saln
 1105:    .             end if
 1106:    .         if (g(divisori).eq.0)then
 1107:              g(divisori)=g(divisori)
 1108:    .         if (divisori.gt.0)then
 1109:              goto 2222
 1110:              end if
 1111:              end if
 1112:    .         if (g(divisori).gt.2000)then
 1113:    .         write(*,*)'only 2000 numbers could be indicated and'
 1114:    .         write(*,*)'they they would not the first 2000 numbers with'
 1115:    .         write(*,*)divisori,' divisors,but the first 2000 numbers'
 1116:    .         write(*,*)'with ',divisori, ' divisors as generated by '
 1117:    .         write(*,*)'the algorithm For a  list  with all the'
 1118:    .         write(*,*)'first numbers with ',divisori,' divisors run again '
 1119:    .         write(*,*)'this option   and enter N smaller.Menu ?  Y/N'
 1120:    .         read (*,10) ch
 1121:    .         pause
 1122:    .         g=0
 1123:              p=0
 1124:    .            if((ch.eq.'Y').or.(ch.eq.'y'))then
 1125:                 return
 1126:                 end if
 1127:                 end if
 1128:    .            pause
 1129:    .            write(*,*)'Please wait few seconds'
 1130:    .             if(divisori.gt.0) then
 1131:    .             write(*,*)'            NUMBER      SUM OF DIV.    EULER FUNCT.'
 1132:    .             write(7,41)'Numbers with  ',divisori,' divisors'
 1133:    .             write(7,40)'            NUMBER      SUM OF DIV.    EULER FUNCT.               '
 1134:    .             WRITE(*,*)'AND FACTORS '
 1135:    .             WRITE(7,40)'AND FACTORS                                                  '
 1136:                  end if            
 1137:    .            numc=0
 1138:    .             flag=0
 1139:           3659     t=0
 1140:    .            s1=0 
 1141:          !C     block 1 ------------------------     
 1142:    .      3660     t=t+1
 1143:    .           if(z2.lt.y(t))goto 5000
 1144:    .           k1=k/y(t)
 1145:                ex=1
 1146:    .          if (k1.lt.y(t))goto 5000
 1147:    .           pr=k1 
 1148:    .            if(pr.gt.2000000)then
 1149:    .            n1=pr
 1150:    .            call trova1(n1,y)
 1151:    .            pr=n1
 1152:    .            else if(pr.lt.2000001)then
 1153:    .            call cerca(pr,y)
 1154:    .            end if 
 1155:    .            x=pr-t+1
 1156:    .           s1=s1+x
 1157:    .           combi1=y(t)
 1158:    .           sum1=((y(t)**(ex+1))-1)/(y(t)-1)
 1159:    .           sum1a=((y(t)**(ex+2))-1)/(y(t)-1)
 1160:    .           k11=y(t)-1
 1161:    .           div1=(e0+1)*(ex+1)
 1162:    .           div2=(ex+2)
 1163:    .           g(div1)=g(div1)+x-1
 1164:    .           g(div2)=g(div2)+1
 1165:    .           if ((divisori.eq.div1).and.(pr-t+1.gt.1))then
 1166:    .         do i=t+1,pr
 1167:    .         flag=flag+1
 1168:    .         if(flag.gt.2000)then
 1169:    .         divisori=0;exit
 1170:              end if
 1171:    .            p(flag)=y(i)*combi1
 1172:    .            s(flag)=(y(i)+1)*sum1
 1173:    .            e(flag)=k11*(y(i)-1)
 1174:    .            write(*,11)flag,p(flag),s(flag),e(flag)
 1175:    .            write(7,11)flag,p(flag),s(flag),e(flag)
 1176:          11   format(' ',I7,'  ',I10,'   ',F12.0,'   ',I10) 
 1177:    .            write(*,12) y(t),'^',ex,' *',y(i),'^1'
 1178:    .            write(7,12) y(t),'^',ex,' *',y(i),'^1'
 1179:          12   format(I7, a1, F3.0, a2, I7, a2, :)
 1180:    .            numc=numc+2
 1181:    .         rr=0;call riga(numc,rr)
 1182:    .         if(rr.eq.1)goto 2222
 1183:                 continue
 1184:                 end do
 1185:                 end if
 1186:    .            if(divisori.eq.div2)then
 1187:    .            flag=flag+1
 1188:    .         if(flag.gt.2000)then
 1189:    .         divisori=0
 1190:    .         end if
 1191:    .            p(flag)=y(t)*combi1
 1192:    .            s(flag)=sum1a
 1193:    .            e(flag)=k11*y(t)
 1194:    .             write(*,11)flag,p(flag),s(flag),e(flag)
 1195:    .             write(7,11)flag,p(flag),s(flag),e(flag)
 1196:    .             write(*,13)y(t),'^',ex+1
 1197:    .             write(7,13)y(t),'^',ex+1
 1198:            13    format(I7, a1, F3.0 :)
 1199:    .             numc=numc+2
 1200:    .             rr=0;call riga(numc,rr)
 1201:    .           if(rr.eq.1)goto 2222
 1202:                end if 
 1203:                goto 3730 !!Go to block 2 ---->
 1204:    .     3700      k1=k1/y(t) !power block 1^^^^^^^
 1205:    .           if(k1.lt.y(t)) goto 3660 !go to block 1->
 1206:    .           pr=k1
 1207:                ex=ex+1
 1208:    .           if(pr.gt.2000000)then
 1209:    .            n1=pr
 1210:    .            call trova1(n1,y)
 1211:    .            pr=n1
 1212:    .            else if(pr.lt.2000001)then
 1213:    .            call cerca(pr,y)
 1214:    .            end if
 1215:    .            x=pr-t +1      
 1216:    .            s1=s1+x
 1217:    .            combi1=(y(t))**ex
 1218:    .           div1=(e0+1)*(ex+1)
 1219:    .           div2=(ex+2) 
 1220:    .           g(div1)=g(div1)+x-1
 1221:    .           g(div2)=g(div2)+1
 1222:    .           sum1=((y(t)**(ex+1))-1)/(y(t)-1)
 1223:    .           sum1a=((y(t)**(ex+2))-1)/(y(t)-1)
 1224:    .         if ((divisori.eq.div1).and.(pr-t+1.gt.1))then
 1225:    .         do i=t+1,pr
 1226:    .         flag=flag+1
 1227:    .         if(flag.gt.2000)then
 1228:    .         divisori=0;exit
 1229:              end if
 1230:    .            p(flag)=y(i)*combi1
 1231:    .            s(flag)=(y(i)+1)*sum1 
 1232:    .            k11a=(p(flag))/(y(t)*y(i))
 1233:    .            e(flag)=k11*(y(i)-1)*k11a
 1234:    .              write(*,11)flag,p(flag),s(flag),e(flag) 
 1235:    .              write(7,11)flag,p(flag),s(flag),e(flag) 
 1236:    .              write(*,12)y(t),'^',ex,'*',y(i),'^1'
 1237:    .              write(7,12)y(t),'^',ex,'*',y(i),'^1'
 1238:    .              numc=numc+2
 1239:    .         rr=0;call riga(numc,rr)
 1240:    .         if(rr.eq.1)goto 2222
 1241:                continue
 1242:                 end do
 1243:                 end if
 1244:    .           if(divisori.eq.div2)then
 1245:    .            flag=flag+1
 1246:    .           if(flag.gt.2000)then
 1247:    .              divisori=0
 1248:    .           end if
 1249:    .            p(flag)=y(t)*combi1
 1250:    .            s(flag)=sum1a
 1251:    .            k11a=(p(flag))/y(t)
 1252:    .            e(flag)=k11*k11a
 1253:    .              write(*,11)flag,p(flag),s(flag),e(flag)
 1254:    .              write(7,11)flag,p(flag),s(flag),e(flag)
 1255:    .              write(*,13)y(t),'^',ex+1
 1256:    .              write(7,13)y(t),'^',ex+1
 1257:    .         numc=numc+2
 1258:    .         rr=0;call riga(numc,rr)
 1259:    .         if(rr.eq.1)goto 2222
 1260:              end if  
 1261:          !C     block 2----------------------------------- 
 1262:    .     3730  zl=t
 1263:    .     3740  zl=zl+1
 1264:    .           k2=k1/y(zl)
 1265:    .           if (k2.lt.y(zl)) goto 3700 !Go to power block 1-------> 
 1266:    .           e2=1
 1267:    .           pr=k2
 1268:    .           if(pr.gt.2000000)then
 1269:    .            n1=pr
 1270:    .            call trova1(n1,y)
 1271:    .            pr=n1
 1272:    .           else if(pr.lt.2000001)then
 1273:    .            call cerca(pr,y)
 1274:    .           end if
 1275:    .           x=pr-zl+1
 1276:    .           s1=s1+x
 1277:    .            combi2=combi1*y(zl) 
 1278:    .           div1=(e0+1)*(ex+1)*(e2+1)
 1279:    .           div2=(div1/(2*(e2+1)))*(e2+2)
 1280:    .           sum2=sum1*(  ( ((y(zl))**(e2+1))-1) /(y(zl)-1)  ) 
 1281:    .           sum2a=sum1*(  ( ((y(zl))**(e2+2))-1) /(y(zl)-1)  )
 1282:    .           k22=k11*(y(zl)-1)
 1283:    .           g(div1)=g(div1)+x-1
 1284:    .           g(div2)=g(div2)+1
 1285:    .         if ((divisori.eq.div1).and.(pr-zl+1.gt.1))then
 1286:    .         do i=zl+1,pr
 1287:    .            flag=flag+1
 1288:    .         if(flag.gt.2000)then
 1289:    .             divisori=0;exit
 1290:              end if
 1291:    .            p(flag)=y(i)*combi2 
 1292:    .            s(flag)=(y(i)+1)*sum2 
 1293:    .            k22a=(p(flag))/(y(t)*y(zl)*y(i))
 1294:    .            e(flag)=k22*(y(i)-1)*k22a
 1295:    .             write(*,11)flag,p(flag),s(flag),e(flag)
 1296:    .             write(7,11)flag,p(flag),s(flag),e(flag)
 1297:    .             write(*,14)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(i),'^1'
 1298:    .             write(7,14)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(i),'^1'
 1299:          14   format(I7, a1,F3.0,a1,I7,a1,F3.0,a1,I7,a2)
 1300:    .             numc=numc+2
 1301:    .         rr=0;call riga(numc,rr)
 1302:    .         if(rr.eq.1)goto 2222
 1303:                 continue
 1304:                 end do
 1305:                 end if
 1306:    .            if(divisori.eq.div2)then
 1307:    .            flag=flag+1
 1308:    .         if(flag.gt.2000)then
 1309:    .             divisori=0
 1310:    .         end if
 1311:    .            p(flag)=y(zl)*combi2
 1312:    .            s(flag)=sum2a
 1313:    .            k22a=(p(flag))/(y(t)*y(zl))
 1314:    .            e(flag)=k22 *k22a
 1315:    .             write(*,11)flag,p(flag),s(flag),e(flag)
 1316:    .             write(7,11)flag,p(flag),s(flag),e(flag)
 1317:    .             write(*,15)y(t),'^',ex,'*',y(zl),'^',e2+1
 1318:    .             write(7,15)y(t),'^',ex,'*',y(zl),'^',e2+1
 1319:          15    Format(I7,a1,F3.0,a1,I7,a1,F3.0:)
 1320:    .              numc=numc+2
 1321:    .         rr=0;call riga(numc,rr)
 1322:    .         if(rr.eq.1)goto 2222
 1323:                end if
 1324:                goto 3810 !goto block 3->
 1325:    .     3780  k2=k2/y(zl) !power block 2 ^^^^^^^
 1326:    .           if( k2.lt.y(zl)) goto 3740  ! goto block 2->
 1327:    .           pr=k2 
 1328:                e2=e2+1
 1329:    .           if(pr.gt.2000000)then
 1330:    .            n1=pr
 1331:    .            call trova1(n1,y)
 1332:    .            pr=n1
 1333:    .           else if(pr.lt.2000001)then
 1334:    .            call cerca(pr,y)
 1335:    .           end if
 1336:    .           x=pr-zl+1
 1337:    .           s1=s1+x
 1338:    .           combi2=combi1*(y(zl)**e2)   
 1339:    .           sum2=sum1*(  ( ((y(zl))**(e2+1))-1) /(y(zl)-1)  )
 1340:    .           sum2a=sum1*(  ( ((y(zl))**(e2+2))-1) /(y(zl)-1)  )
 1341:    .           div1=(e0+1)*(ex+1)*(e2+1)
 1342:    .           div2=(div1/(2*(e2+1)))*(e2+2)
 1343:    .           g(div1)=g(div1)+x-1
 1344:    .           g(div2)=g(div2)+1
 1345:    .           if ((divisori.eq.div1).and.(pr-zl+1.gt.1))then
 1346:    .           do i=zl+1,pr
 1347:    .            flag=flag+1
 1348:    .         if(flag.gt.2000)then
 1349:    .             divisori=0;exit
 1350:              end if
 1351:    .            p(flag)=y(i)*combi2
 1352:    .            s(flag)=(y(i)+1)*sum2 
 1353:    .            k22a=(p(flag))/(y(t)*y(zl)*y(i))
 1354:    .            e(flag)=k22*(y(i)-1)*k22a
 1355:    .             write(*,11)flag,p(flag),s(flag),e(flag)
 1356:    .             write(7,11)flag,p(flag),s(flag),e(flag)
 1357:    .             write(*,14)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(i),'^1'
 1358:    .             write(7,14)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(i),'^1'
 1359:    .             numc=numc+2
 1360:    .         rr=0;call riga(numc,rr)
 1361:    .         if(rr.eq.1)goto 2222
 1362:                 continue
 1363:                 end do
 1364:                 end if
 1365:    .            if(divisori.eq.div2)then
 1366:    .            flag=flag+1
 1367:    .         if(flag.gt.2000)then
 1368:    .             divisori=0
 1369:    .         end if
 1370:    .            p(flag)=y(zl)*combi2
 1371:    .            s(flag)=sum2a 
 1372:    .            k22a=(p(flag))/(y(t)*y(zl))
 1373:    .            e(flag)=k22*k22a
 1374:    .             write(*,11)flag,p(flag),s(flag),e(flag)
 1375:    .             write(7,11)flag,p(flag),s(flag),e(flag)
 1376:    .             write(*,15)y(t),'^',ex,'*',y(zl),'^',e2+1
 1377:    .             write(7,15)y(t),'^',ex,'*',y(zl),'^',e2+1
 1378:    .              numc=numc+2
 1379:    .         rr=0;call riga(numc,rr)
 1380:    .         if(rr.eq.1)goto 2222
 1381:                end if 
 1382:           !C     block 3-------------------------------------- 
 1383:    .      3810  yl=zl
 1384:    .      3820 yl=yl+1
 1385:    .           k3=k2/y(yl)
 1386:    .           if(k3.lt.y(yl))goto 3780! Go to powera block 2 ->
 1387:    .           e3=1
 1388:    .           pr=k3
 1389:    .           if(pr.gt.2000000)then
 1390:    .            n1=pr
 1391:    .            call trova1(n1,y)
 1392:    .            pr=n1
 1393:    .           else if(pr.lt.2000001)then
 1394:    .            call cerca(pr,y)
 1395:    .           end if
 1396:    .           x=pr-yl+1
 1397:    .           s1=s1+x
 1398:    .           combi3=combi2*y(yl)
 1399:    .           sum3=sum2*(  ( ((y(yl))**(e3+1))-1) /(y(yl)-1)  )
 1400:    .           sum3a=sum2*(  ( ((y(yl))**(e3+2))-1) /(y(yl)-1)  ) 
 1401:    .           k33=k22*(y(yl)-1)
 1402:    .           div1=(e0+1)*(ex+1)*(e2+1)*(e3+1)
 1403:    .           div2=(div1/(2*(e3+1)))*(e3+2)
 1404:    .           g(div1)=g(div1)+x-1
 1405:    .           g(div2)=g(div2)+1
 1406:    .            if ((divisori.eq.div1).and.(pr-yl+1.gt.1))then
 1407:    .            do i=yl+1,pr
 1408:    .           flag=flag+1
 1409:    .         if(flag.gt.2000)then
 1410:    .             divisori=0;exit
 1411:              end if
 1412:    .            p(flag)=y(i)*combi3
 1413:    .            s(flag)=(y(i)+1)*sum3 
 1414:    .            k33a=(p(flag))/(y(t)*y(zl)*y(yl)*y(i))
 1415:    .            e(flag)=k33*(y(i)-1)*k33a
 1416:    .             write(*,11)flag,p(flag),s(flag),e(flag)
 1417:    .             write(7,11)flag,p(flag),s(flag),e(flag)
 1418:    .             write(*,16)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(i),&
 1419:               &'^1'
 1420:    .             write(7,16)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(i),&
 1421:               &'^1'
 1422:          16    format(I7, a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a2)
 1423:    .            numc=numc+2
 1424:    .         rr=0;call riga(numc,rr)
 1425:    .         if(rr.eq.1)goto 2222
 1426:                continue
 1427:                 end do
 1428:                 end if
 1429:          
 1430:    .            if(divisori.eq.div2)then
 1431:    .            flag=flag+1
 1432:    .         if(flag.gt.2000)then
 1433:    .             divisori=0
 1434:    .         end if
 1435:    .            p(flag)=y(yl)*combi3
 1436:    .            s(flag)=sum3a
 1437:    .            k33a=(p(flag))/(y(t)*y(zl)*y(yl))
 1438:    .            e(flag)=k33*k33a
 1439:    .              write(*,11)flag,p(flag),s(flag),e(flag)
 1440:    .              write(7,11)flag,p(flag),s(flag),e(flag)
 1441:    .         write(*,17)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3+1 
 1442:    .         write(7,17)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3+1 
 1443:          17    format(I7, a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0)
 1444:    .              numc=numc+2
 1445:    .         rr=0;call riga(numc,rr)
 1446:    .         if(rr.eq.1)goto 2222
 1447:              end if
 1448:                 goto 3900 !goto block 4 ---->
 1449:    .     3850  k3=k3/y(yl) !power block 3^^^^^^^^^^
 1450:    .            if(k3.lt.y(yl)) goto 3820 !Goto block 3-------->
 1451:    .            pr=k3
 1452:                 e3=e3+1
 1453:    .            if(pr.gt.2000000)then
 1454:    .            n1=pr
 1455:    .            call trova1(n1,y)
 1456:    .            pr=n1
 1457:    .           else if(pr.lt.2000001)then
 1458:    .            call cerca(pr,y)
 1459:    .           end if
 1460:    .            x=pr-yl+1
 1461:    .            s1=s1+x
 1462:    .            combi3=combi2*(y(yl)**e3)
 1463:    .           sum3=sum2*(  ( ((y(yl))**(e3+1))-1) /(y(yl)-1)  )
 1464:    .           sum3a=sum2*(  ( ((y(yl))**(e3+2))-1) /(y(yl)-1)  )
 1465:    .            div1=(e0+1)*(ex+1)*(e2+1)*(e3+1)
 1466:    .           div2=(div1/(2*(e3+1)))*(e3+2)
 1467:    .           g(div1)=g(div1)+x-1
 1468:    .           g(div2)=g(div2)+1
 1469:    .            if ((divisori.eq.div1).and.(pr-yl+1.gt.1))then
 1470:    .            do i=yl+1,pr
 1471:    .            flag=flag+1
 1472:    .         if(flag.gt.2000)then
 1473:    .             divisori=0;exit
 1474:              end if
 1475:    .            p(flag)=y(i)*combi3
 1476:    .            s(flag)=(y(i)+1)*sum3
 1477:    .            k33a=(p(flag))/(y(t)*y(zl)*y(yl)*y(i))
 1478:    .            e(flag)=k33*(y(i)-1)*k33a
 1479:    .              write(*,11)flag,p(flag),s(flag),e(flag)
 1480:    .              write(7,11)flag,p(flag),s(flag),e(flag)
 1481:    .          write(*,16)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(i),&
 1482:               &'^1'
 1483:    .          write(7,16)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(i),&
 1484:               &'^1'
 1485:    .         numc=numc+2
 1486:    .         rr=0;call riga(numc,rr)
 1487:    .         if(rr.eq.1)goto 2222
 1488:                continue
 1489:                 end do
 1490:                 end if
 1491:    .            if(divisori.eq.div2)then
 1492:    .            flag=flag+1
 1493:    .             if(flag.gt.2000)then
 1494:    .             divisori=0
 1495:    .             end if
 1496:    .                p(flag)=y(yl)*combi3
 1497:    .            s(flag)=sum3a
 1498:    .            k33a=(p(flag))/(y(t)*y(zl)*y(yl))
 1499:    .            e(flag)=k33*k33a
 1500:    .               write(*,11)flag,p(flag),s(flag),e(flag)
 1501:    .               write(7,11)flag,p(flag),s(flag),e(flag)
 1502:    .             write(*,17)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3+1 
 1503:    .             write(7,17)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3+1 
 1504:    .              numc=numc+2
 1505:    .         rr=0;call riga(numc,rr)
 1506:    .         if(rr.eq.1)goto 2222
 1507:                     end if
 1508:          !C     block 4-------------------------------------------  
 1509:    .      3900 hl=yl
 1510:    .      3910 hl=hl+1
 1511:    .           k4=k3/y(hl)
 1512:    .           if(k4.lt.y(hl))goto 3850  !goto powera block 3------->
 1513:    .           e4=1
 1514:    .           pr=k4
 1515:    .           if(pr.gt.2000000)then
 1516:    .            n1=pr
 1517:    .            call trova1(n1,y)
 1518:    .            pr=n1
 1519:    .           else if(pr.lt.2000001)then
 1520:    .            call cerca(pr,y)
 1521:    .           end if
 1522:    .           x=pr-hl +1
 1523:    .           s1=s1+x 
 1524:    .           combi4=combi3*y(hl)
 1525:    .           sum4=sum3*(  ( ((y(hl))**(e4+1))-1) /(y(hl)-1)  )
 1526:    .           sum4a=sum3*(  ( ((y(hl))**(e4+2))-1) /(y(hl)-1)  )
 1527:    .           k44=k33*(y(hl)-1)
 1528:    .           div1=(e0+1)*(ex+1)*(e2+1)*(e3+1)*(e4+1)
 1529:    .           div2=(div1/(2*(e4+1)))*(e4+2)
 1530:    .           g(div1)=g(div1)+x-1
 1531:    .           g(div2)=g(div2)+1
 1532:    .            if ((divisori.eq.div1).and.(pr-hl+1.gt.1))then
 1533:    .            do i=hl+1,pr
 1534:    .            flag=flag+1
 1535:    .         if(flag.gt.2000)then
 1536:    .             divisori=0;exit
 1537:              end if
 1538:    .            p(flag)=y(i)*combi4
 1539:    .            s(flag)=(y(i)+1)*sum4
 1540:    .           k44a=(p(flag))/(y(t)*y(zl)*y(yl)*y(hl)*y(i))
 1541:    .            e(flag)=k44*(y(i)-1)*k44a 
 1542:    .           write(*,11)flag,p(flag),s(flag),e(flag)
 1543:    .           write(7,11)flag,p(flag),s(flag),e(flag)
 1544:    .          write(*,18)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',    &
 1545:               &y(hl),'^',e4,'*',y(i),'^1'
 1546:    .          write(7,18)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',    &
 1547:               &y(hl),'^',e4,'*',y(i),'^1'
 1548:          18    format(I7, a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7&
 1549:               &,a2)
 1550:    .              numc=numc+2
 1551:    .         rr=0;call riga(numc,rr)
 1552:    .         if(rr.eq.1)goto 2222
 1553:                continue
 1554:                 end do
 1555:                 end if
 1556:    .           if(divisori.eq.div2)then
 1557:    .            flag=flag+1
 1558:    .         if(flag.gt.2000)then
 1559:    .             divisori=0
 1560:    .         end if
 1561:    .            p(flag)=y(hl)*combi4
 1562:    .            s(flag)=sum4a 
 1563:    .            k44a=(p(flag))/(y(t)*y(zl)*y(yl)*y(hl))
 1564:    .            e(flag)=k44*k44a 
 1565:    .              write(*,11)flag,p(flag),s(flag),e(flag)
 1566:    .              write(7,11)flag,p(flag),s(flag),e(flag)
 1567:    .           write(*,19)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl)&
 1568:               &,'^',e4+1  
 1569:    .           write(7,19)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl)&
 1570:               &,'^',e4+1  
 1571:          19    format(I7, a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0)
 1572:    .           numc=numc+2
 1573:    .         rr=0;call riga(numc,rr)
 1574:    .         if(rr.eq.1)goto 2222
 1575:                 end if
 1576:                 
 1577:                goto 3950  !goto block 5------->
 1578:    .     3940  k4=k4/y(hl) !power block 4^^^^^^^^^^^^^^^^^^
 1579:    .           if(k4.lt.y(hl))goto 3910!Goto block 4-->
 1580:    .           pr=k4
 1581:                e4=e4+1
 1582:    .           if(pr.gt.2000000)then
 1583:    .            n1=pr
 1584:    .            call trova1(n1,y)
 1585:    .            pr=n1
 1586:    .           else if(pr.lt.2000001)then
 1587:    .            call cerca(pr,y)
 1588:    .           end if
 1589:    .           x=pr-hl+1
 1590:    .           s1=s1+x
 1591:    .           combi4=combi3*(y(hl)**e4)
 1592:    .           sum4=sum3*(  ( ((y(hl))**(e4+1))-1) /(y(hl)-1)  )
 1593:    .           sum4a=sum3*(  ( ((y(hl))**(e4+2))-1) /(y(hl)-1)  )
 1594:    .           div1=(e0+1)*(ex+1)*(e2+1)*(e3+1)*(e4+1)
 1595:    .           div2=(div1/(2*(e4+1)))*(e4+2)
 1596:    .           g(div1)=g(div1)+x-1
 1597:    .           g(div2)=g(div2)+1
 1598:    .            if ((divisori.eq.div1).and.(pr-hl+1.gt.1))then
 1599:    .            do i=hl+1,pr
 1600:    .            flag=flag+1
 1601:    .         if(flag.gt.2000)then
 1602:    .             divisori=0;exit
 1603:              end if
 1604:    .            p(flag)=y(i)*combi4
 1605:    .             s(flag)=(y(i)+1)*sum4
 1606:    .              k44a=(p(flag))/(y(t)*y(zl)*y(yl)*y(hl)*y(i))
 1607:    .            e(flag)=k44*(y(i)-1)*k44a
 1608:    .              write(*,11)flag,p(flag),s(flag),e(flag)
 1609:    .              write(7,11)flag,p(flag),s(flag),e(flag)
 1610:    .       write(*,18)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl&
 1611:               &),'^',e4,'*',y(i),'^1'
 1612:    .       write(7,18)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl&
 1613:               &),'^',e4,'*',y(i),'^1'
 1614:    .           numc=numc+2
 1615:    .         rr=0;call riga(numc,rr)
 1616:    .         if(rr.eq.1)goto 2222
 1617:                 continue
 1618:                 end do
 1619:                 end if
 1620:    .           if(divisori.eq.div2)then
 1621:    .            flag=flag+1
 1622:    .         if(flag.gt.2000)then
 1623:    .             divisori=0
 1624:    .         end if
 1625:    .            p(flag)=y(hl)*combi4
 1626:    .            s(flag)=sum4a
 1627:    .            k44a=(p(flag))/(y(t)*y(zl)*y(yl)*y(hl))
 1628:    .            e(flag)=k44*k44a
 1629:    .             write(*,11)flag,p(flag),s(flag),e(flag)
 1630:    .             write(7,11)flag,p(flag),s(flag),e(flag)
 1631:    .           write(*,19)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',   &
 1632:               &y(hl),'^',e4+1
 1633:    .           write(7,19)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',   &
 1634:               &y(hl),'^',e4+1
 1635:    .           numc=numc+2
 1636:    .         rr=0;call riga(numc,rr)
 1637:    .         if(rr.eq.1)goto 2222
 1638:                 end if
 1639:          !C     block 5--------------------------------------------- 
 1640:    .      3950 gl=hl
 1641:    .      3960 gl=gl+1
 1642:    .           k5=k4/y(gl)
 1643:    .           if(k5.lt.y(gl))goto 3940  !goto powera block 4---->
 1644:    .           e5=1
 1645:    .           pr=k5
 1646:    .           if(pr.gt.2000000)then
 1647:    .            n1=pr
 1648:    .            call trova1(n1,y)
 1649:    .            pr=n1
 1650:    .           else if(pr.lt.2000001)then
 1651:    .            call cerca(pr,y)
 1652:    .           end if
 1653:    .           x=pr-gl+1
 1654:    .           s1=s1+x
 1655:    .           combi5=combi4*y(gl)
 1656:    .           sum5=sum4*(  ( ((y(gl))**(e5+1))-1) /(y(gl)-1)  )
 1657:    .           sum5a=sum4*(  ( ((y(gl))**(e5+2))-1) /(y(gl)-1)  )
 1658:    .           k55=k44*(y(gl)-1)
 1659:    .           div1=(e0+1)*(ex+1)*(e2+1)*(e3+1)*(e4+1)*(e5+1)
 1660:    .           div2=(div1/(2*(e5+1)))*(e5+2)
 1661:    .           g(div1)=g(div1)+x-1
 1662:    .           g(div2)=g(div2)+1
 1663:    .            if ((divisori.eq.div1).and.(pr-gl+1.gt.1))then
 1664:    .            do i=gl+1,pr
 1665:    .            flag=flag+1
 1666:    .         if(flag.gt.2000)then
 1667:    .             divisori=0;exit
 1668:              end if
 1669:    .            p(flag)=y(i)*combi5
 1670:    .            s(flag)=(y(i)+1)*sum5
 1671:    .            k55a=(p(flag))/(y(t)*y(zl)*y(yl)*y(hl)*y(gl)*y(i))
 1672:    .            e(flag)=k55*(y(i)-1)*k55a  
 1673:    .             write(*,11)flag,p(flag),s(flag),e(flag)
 1674:    .              write(7,11)flag,p(flag),s(flag),e(flag)
 1675:    .     write(*,202)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',     &
 1676:                &y(hl),'^',e4,'*',y(gl),'^',e5,'*',y(i),'^1'
 1677:    .      write(7,202)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',     &
 1678:               &y(hl),'^',e4,'*',y(gl),'^',e5,'*',y(i),'^1'
 1679:          202   format(I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7, &
 1680:               &a1,F3.0,a1,I7,a2)
 1681:    .         numc=numc+2
 1682:    .         rr=0;call riga(numc,rr)
 1683:    .         if(rr.eq.1)goto 2222
 1684:                continue
 1685:                 end do
 1686:                 end if
 1687:    .          if(divisori.eq.div2)then
 1688:    .            flag=flag+1
 1689:    .         if(flag.gt.2000)then
 1690:    .             divisori=0
 1691:    .         end if
 1692:    .            p(flag)=y(gl)*combi5
 1693:    .            s(flag)=sum5a
 1694:    .            k55a=(p(flag))/(y(t)*y(zl)*y(yl)*y(hl)*y(gl))
 1695:    .            e(flag)=k55*k55a 
 1696:    .           write(*,11)flag,p(flag),s(flag),e(flag)
 1697:    .           write(7,11)flag,p(flag),s(flag),e(flag)
 1698:    .         write(*,21)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl)&
 1699:               &,'^',e4,'*',y(gl),'^',e5+1     
 1700:    .         write(7,21)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl)&
 1701:               &,'^',e4,'*',y(gl),'^',e5+1
 1702:          21    format(I7, a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7&
 1703:               & ,a1,F3.0)
 1704:    .          numc=numc+2
 1705:    .         rr=0;call riga(numc,rr)
 1706:    .         if(rr.eq.1)goto 2222
 1707:              end if
 1708:             goto 4000 !goto block 6------->
 1709:    .      3970 k5=k5/y(gl) !power block 5^^^^^^^^^^^^^^^
 1710:    .           if(k5.lt.y(gl))then
 1711:                 goto 3960 
 1712:                 end if  !Goto block 5
 1713:    .           pr=k5
 1714:                e5=e5+1
 1715:    .           if(pr.gt.2000000)then
 1716:    .            n1=pr
 1717:    .            call trova1(n1,y)
 1718:    .            pr=n1
 1719:    .           else if(pr.lt.2000001)then
 1720:    .            call cerca(pr,y)
 1721:    .           end if
 1722:    .           x=pr-gl+1
 1723:    .           s1=s1+x 
 1724:    .           combi5=combi4*(y(gl)**e5)
 1725:    .             sum5=sum4*(  ( ((y(gl))**(e5+1))-1) /(y(gl)-1)  )
 1726:    .           sum5a=sum4*(  ( ((y(gl))**(e5+2))-1) /(y(gl)-1)  )
 1727:    .            div1=(e0+1)*(ex+1)*(e2+1)*(e3+1)*(e4+1)*(e5+1)
 1728:    .           div2=(div1/(2*(e5+1)))*(e5+2)
 1729:    .            g(div1)=g(div1)+x-1
 1730:    .           g(div2)=g(div2)+1
 1731:    .          if ((divisori.eq.div1).and.(pr-gl+1.gt.1))then
 1732:    .            do i=gl+1,pr
 1733:    .            flag=flag+1
 1734:    .         if(flag.gt.2000)then
 1735:    .             divisori=0;exit
 1736:              end if
 1737:    .            p(flag)=y(i)*combi5
 1738:    .            s(flag)=(y(i)+1)*sum5
 1739:    .              k55a=(p(flag))/(y(t)*y(zl)*y(yl)*y(hl)*y(gl)*y(i))
 1740:    .            e(flag)=k55*(y(i)-1)*k55a 
 1741:    .             write(*,11)flag,p(flag),s(flag),e(flag)
 1742:    .              write(7,11)flag,p(flag),s(flag),e(flag)
 1743:    .          write(*,202)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',    &
 1744:               &y(hl),'^',e4,'*',y(gl),'^',e5,'*',y(i),'^1'
 1745:    .         write(7,202)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',    &
 1746:               &y(hl),'^',e4,'*',y(gl),'^',e5,'*',y(i),'^1'
 1747:    .            numc=numc+2
 1748:    .         rr=0;call riga(numc,rr)
 1749:    .         if(rr.eq.1)goto 2222
 1750:                 continue
 1751:                 end do
 1752:                 end if
 1753:    .            if(divisori.eq.div2)then
 1754:    .         flag=flag+1
 1755:    .            p(flag)=y(gl)*combi5
 1756:    .            if(flag.gt.2000)then
 1757:    .             divisori=0
 1758:              end if
 1759:    .            s(flag)=sum5a
 1760:    .            k55a=(p(flag))/(y(t)*y(zl)*y(yl)*y(hl)*y(gl))
 1761:    .            e(flag)=k55*k55a
 1762:    .           write(*,11)flag,p(flag),s(flag),e(flag)
 1763:    .           write(7,11)flag,p(flag),s(flag),e(flag)
 1764:    .         write(*,21)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl)&
 1765:               &,'^',e4,'*',y(gl),'^',e5+1
 1766:    .         write(7,21)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl)&
 1767:               &,'^',e4,'*',y(gl),'^',e5+1
 1768:    .           numc=numc+3
 1769:    .         rr=0;call riga(numc,rr)
 1770:    .         if(rr.eq.1)goto 2222
 1771:                end if
 1772:          !C     block 6 ------------------------------------      
 1773:    .      4000 il=gl
 1774:    .      4010 il=il+1
 1775:    .           k6=k5/y(il)
 1776:    .           if(k6.lt.y(il))goto 3970  !goto power block 5-> 
 1777:    .           e6=1
 1778:    .           pr=k6
 1779:    .           if(pr.gt.2000000)then
 1780:    .            n1=pr
 1781:    .            call trova1(n1,y)
 1782:    .            pr=n1
 1783:    .           else if(pr.lt.2000001)then
 1784:    .            call cerca(pr,y)
 1785:    .           end if
 1786:    .           x=pr-il+1
 1787:    .           s1=s1+x
 1788:    .           div1=(e0+1)*(ex+1)*(e2+1)*(e3+1)*(e4+1)*(e5+1)*(e6+1)
 1789:    .           div2=(div1/(2*(e6+1)))*(e6+2)
 1790:    .           combi6=combi5*y(il)
 1791:    .           sum6=sum5*(  ( ((y(il))**(e6+1))-1) /(y(il)-1)  ) 
 1792:    .           sum6a=sum5*(  ( ((y(il))**(e6+2))-1) /(y(il)-1)  )
 1793:    .           k66=k55*(y(il)-1)
 1794:    .           g(div1)=g(div1)+x-1
 1795:    .           g(div2)=g(div2)+1
 1796:    .            if ((divisori.eq.div1).and.(pr-il+1.gt.1))then
 1797:    .            do i=il+1,pr
 1798:    .            flag=flag+1
 1799:    .         if(flag.gt.2000)then
 1800:    .             divisori=0;exit
 1801:              end if
 1802:    .            p(flag)=y(i)*combi6
 1803:    .            s(flag)=(y(i)+1)*sum6
 1804:    .            k66a=(p(flag))/(y(t)*y(zl)*y(yl)*y(hl)*y(gl)*y(il)*y(i))
 1805:    .            e(flag)=k66*(y(i)-1)*k66a  
 1806:                 
 1807:    .             write(*,11)flag,p(flag),s(flag),e(flag)
 1808:    .             write(7,11)flag,p(flag),s(flag),e(flag)
 1809:    .      write(*,22)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',      &
 1810:               &y(hl),'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(i),'^1'
 1811:    .      write(7,22)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',      &
 1812:               &y(hl),'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(i),'^1'
 1813:          22    format(I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7, &
 1814:               &a1,F3.0,a1,I7,a1,F3.0,a1,I7,a2)
 1815:    .           numc=numc+3
 1816:    .         rr=0;call riga(numc,rr)
 1817:    .         if(rr.eq.1)goto 2222
 1818:                continue
 1819:                 end do
 1820:                 end if
 1821:    .         if(divisori.eq.div2)then 
 1822:    .            flag=flag+1
 1823:    .         if(flag.gt.2000)then
 1824:    .             divisori=0
 1825:    .         end if
 1826:    .            p(flag)=y(il)*combi6
 1827:    .            s(flag)=sum6a
 1828:    .            k66a=(p(flag))/(y(t)*y(zl)*y(yl)*y(hl)*y(gl)*y(il))
 1829:    .            e(flag)=k66*k66a 
 1830:    .            write(*,11)flag,p(flag),s(flag),e(flag)
 1831:    .             write(7,11)flag,p(flag),s(flag),e(flag)
 1832:    .      write(*,23)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl)&
 1833:               &,'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6+1    
 1834:    .      write(7,23)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl)&
 1835:               &,'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6+1    
 1836:          23    format(I7, a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7&
 1837:               &,a1,F3.0,a1,I7,a1,F3.0)
 1838:    .          numc=numc+3
 1839:    .         rr=0;call riga(numc,rr)
 1840:    .         if(rr.eq.1)goto 2222
 1841:             end if 
 1842:             goto 4500  !goto block 7---->
 1843:    .      4450     k6=k6/y(il) !power block 6^^^^^^^^^^^^^^^^^^^
 1844:    .           if(k6.lt.y(il))goto 4010 !goto block 6----->
 1845:    .           pr=k6
 1846:    .           e6=e6+1
 1847:    .            call cerca(pr,y)
 1848:    .           x=pr-il+1
 1849:    .           s1=s1+x
 1850:    .           combi6=combi5*(y(il)**e6)
 1851:    .           sum6=sum5*(  ( ((y(il))**(e6+1))-1) /(y(il)-1)  )
 1852:    .           sum6a=sum5*(  ( ((y(il))**(e6+2))-1) /(y(il)-1)  )
 1853:    .            div1=(e0+1)*(ex+1)*(e2+1)*(e3+1)*(e4+1)*(e5+1)*(e6+1)
 1854:    .           div2=(div1/(2*(e6+1)))*(e6+2)
 1855:    .           g(div1)=g(div1)+x-1
 1856:    .           g(div2)=g(div2)+1
 1857:    .            if ((divisori.eq.div1).and.(pr-il+1.gt.1))then
 1858:    .            do i=il+1,pr
 1859:    .            flag=flag+1
 1860:    .         if(flag.gt.2000)then
 1861:    .             divisori=0;exit
 1862:              end if
 1863:    .            p(flag)=y(i)*combi6
 1864:    .            s(flag)=(y(i)+1)*sum6
 1865:    .              k66a=(p(flag))/(y(t)*y(zl)*y(yl)*y(hl)*y(gl)*y(il)*y(i))
 1866:    .            e(flag)=k66*(y(i)-1)*k66a 
 1867:    .             write(*,11)flag,p(flag),s(flag),e(flag)
 1868:    .             write(7,11)flag,p(flag),s(flag),e(flag)
 1869:    .      write(*,22)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',      &
 1870:               &y(hl),'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(i),'^1'
 1871:    .      write(7,22)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',      &
 1872:               &y(hl),'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(i),'^1'
 1873:    .           numc=numc+3
 1874:    .         rr=0;call riga(numc,rr)
 1875:    .         if(rr.eq.1)goto 2222
 1876:                continue
 1877:                 end do
 1878:                 end if
 1879:    .         if(divisori.eq.div2)then
 1880:    .            flag=flag+1
 1881:    .         if(flag.gt.2000)then
 1882:    .             divisori=0
 1883:    .         end if
 1884:    .            p(flag)=y(il)*combi6
 1885:    .            s(flag)=sum6a
 1886:    .             k66a=(p(flag))/(y(t)*y(zl)*y(yl)*y(hl)*y(gl)*y(il))
 1887:    .            e(flag)=k66*k66a
 1888:    .             write(*,11)flag,p(flag),s(flag),e(flag)
 1889:    .             write(7,11)flag,p(flag),s(flag),e(flag)
 1890:    .      write(*,23)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl)&
 1891:               &,'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6+1   
 1892:    .      write(7,23)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl)&
 1893:               &,'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6+1   
 1894:    .           numc=numc+3
 1895:    .         rr=0;call riga(numc,rr)
 1896:    .         if(rr.eq.1)goto 2222
 1897:                 end if
 1898:          !C        block 7 ------------------------------------      
 1899:    .      4500 sl=il
 1900:    .      4510 sl=sl+1
 1901:    .           k7=k6/y(sl)
 1902:    .           if(k7.lt.y(sl))goto 4450 !goto power block 6-> 
 1903:    .           e7=1
 1904:    .           pr=k7
 1905:    .           call cerca (pr,y)
 1906:    .           x=pr-sl+1
 1907:    .           s1=s1+x
 1908:    .           div1=(e0+1)*(ex+1)*(e2+1)*(e3+1)*(e4+1)*(e5+1)*(e6+1)*(e7+1)
 1909:    .           div2=(div1/(2*(e7+1)))*(e7+2)
 1910:    .           combi7=combi6*y(sl)
 1911:    .           sum7=sum6*(  ( ((y(sl))**(e7+1))-1) /(y(sl)-1)  ) 
 1912:    .           sum7a=sum6*(  ( ((y(sl))**(e7+2))-1) /(y(sl)-1)  )
 1913:    .           k77=k66*(y(sl)-1)
 1914:    .           g(div1)=g(div1)+x-1
 1915:    .           g(div2)=g(div2)+1
 1916:    .            if ((divisori.eq.div1).and.(pr-sl+1.gt.1))then
 1917:    .            do i=sl+1,pr
 1918:    .            flag=flag+1
 1919:    .         if(flag.gt.2000)then
 1920:    .             divisori=0;exit
 1921:              end if
 1922:    .            p(flag)=y(i)*combi7
 1923:    .            s(flag)=(y(i)+1)*sum7
 1924:    .            k77a=(p(flag))/(y(t)*y(zl)*y(yl)*y(hl)*y(gl)*y(il)*y(sl)*y(i))
 1925:    .            e(flag)=k77*(y(i)-1)*k77a  
 1926:    .             write(*,11)flag,p(flag),s(flag),e(flag)
 1927:    .             write(7,11)flag,p(flag),s(flag),e(flag)
 1928:    .      write(*,24)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',      &
 1929:               &y(hl),'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(sl),'^',e7,   &
 1930:               &'*',y(i),'^1'
 1931:    .      write(7,24)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',      &
 1932:               &y(hl),'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(sl),'^',e7,   &
 1933:               &'*',y(i),'^1'
 1934:          24    format(I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7, &
 1935:               &a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a2)
 1936:    .               numc=numc+3
 1937:    .         rr=0;call riga(numc,rr)
 1938:    .         if(rr.eq.1)goto 2222
 1939:                 continue
 1940:                 end do
 1941:                 end if
 1942:    .         if(divisori.eq.div2)then 
 1943:    .            flag=flag+1
 1944:    .         if(flag.gt.2000)then
 1945:    .             divisori=0
 1946:    .         end if
 1947:    .            p(flag)=y(sl)*combi7
 1948:    .            s(flag)=sum7a
 1949:    .            k77a=(p(flag))/(y(t)*y(zl)*y(yl)*y(hl)*y(gl)*y(il)*y(sl))
 1950:    .            e(flag)=k77*k77a 
 1951:    .            write(*,11)flag,p(flag),s(flag),e(flag)
 1952:    .            write(7,11)flag,p(flag),s(flag),e(flag)
 1953:    .      write(*,25)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl)&
 1954:               &,'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(sl),'^',e7+1   
 1955:    .      write(7,25)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl)&
 1956:               &,'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(sl),'^',e7+1   
 1957:          25    format(I7, a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7&
 1958:               &,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0)
 1959:    .                   numc=numc+3
 1960:    .         rr=0;call riga(numc,rr)
 1961:    .         if(rr.eq.1)goto 2222
 1962:                    end if 
 1963:                    goto 4600!goto block 8---->
 1964:    .      4550     k7=k7/y(sl) !power block 7^^^^^^^^^^^^^^^^^^^
 1965:    .           if(k7.lt.y(sl))goto 4510!goto block 7----->
 1966:    .           pr=k7
 1967:    .           e7=e7+1
 1968:    .           call cerca (pr,y)
 1969:    .           x=pr-sl+1
 1970:    .           s1=s1+x
 1971:    .           combi7=combi6*(y(sl)**e7)
 1972:    .           sum7=sum6*(  ( ((y(sl))**(e7+1))-1) /(y(sl)-1)  )
 1973:    .           sum7a=sum6*(  ( ((y(sl))**(e7+2))-1) /(y(sl)-1)  )
 1974:    .           div1=(e0+1)*(ex+1)*(e2+1)*(e3+1)*(e4+1)*(e5+1)*(e6+1)*(e7+1)
 1975:    .                 div2=(div1/(2*(e7+1)))*(e7+2)
 1976:    .               g(div1)=g(div1)+x-1
 1977:    .           g(div2)=g(div2)+1
 1978:    .            if ((divisori.eq.div1).and.(pr-sl+1.gt.1))then
 1979:    .            do i=sl+1,pr
 1980:    .            flag=flag+1
 1981:    .         if(flag.gt.2000)then
 1982:    .             divisori=0;exit
 1983:              end if
 1984:    .            p(flag)=y(i)*combi7
 1985:    .            s(flag)=(y(i)+1)*sum7
 1986:    .              k77a=(p(flag))/(y(t)*y(zl)*y(yl)*y(hl)*y(gl)*y(il)*y(sl)*y(i))
 1987:    .            e(flag)=k77*(y(i)-1)*k77a 
 1988:    .             write(*,11)flag,p(flag),s(flag),e(flag)
 1989:    .             write(7,11)flag,p(flag),s(flag),e(flag)
 1990:    .         write(*,24)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',      &
 1991:               &y(hl),'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(sl),'^',e7,   &
 1992:               &'*',y(i),'^1'
 1993:    .         write(7,24)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',      &
 1994:               &y(hl),'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(sl),'^',e7,   &
 1995:               &'*',y(i),'^1'
 1996:    .               numc=numc+3
 1997:    .         rr=0;call riga(numc,rr)
 1998:    .         if(rr.eq.1)goto 2222
 1999:                continue
 2000:                 end do
 2001:                 end if
 2002:          
 2003:    .         if(divisori.eq.div2)then
 2004:    .            flag=flag+1
 2005:    .         if(flag.gt.2000)then
 2006:    .             divisori=0
 2007:    .         end if
 2008:    .            p(flag)=y(sl)*combi7
 2009:    .            s(flag)=sum7a
 2010:    .             k77a=(p(flag))/(y(t)*y(zl)*y(yl)*y(hl)*y(gl)*y(il)*y(sl))
 2011:    .            e(flag)=k77*k77a
 2012:    .             write(*,11)flag,p(flag),s(flag),e(flag)
 2013:    .             write(7,11)flag,p(flag),s(flag),e(flag)
 2014:    .         write(*,25)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl)&
 2015:               &,'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(sl),'^',e7+1
 2016:    .         write(7,25)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl)&
 2017:               &,'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(sl),'^',e7+1
 2018:    .            numc=numc+3
 2019:    .         rr=0;call riga(numc,rr)
 2020:    .         if(rr.eq.1)goto 2222
 2021:                 end if 
 2022:          !C               block 8 ------------------------------------      
 2023:    .      4600 al=sl
 2024:    .      4610 al=al+1
 2025:    .           k8=k7/y(al)
 2026:    .           if(k8.lt.y(al))goto 4550 !goto power block 7-> 
 2027:    .           e8=1
 2028:    .           pr=k8
 2029:    .           call cerca (pr,y)
 2030:    .           x=pr-al+1
 2031:    .           s1=s1+x
 2032:                div1=(e0+1)*(ex+1)*(e2+1)*(e3+1)*(e4+1)*(e5+1)*(e6+1)*(e7+1)
 2033:    .           div1=div1*(e8+1)
 2034:    .           div2=(div1/(2*(e8+1)))*(e8+2)
 2035:    .                combi8=combi7*y(al)
 2036:    .                sum8=sum7*(  ( ((y(al))**(e8+1))-1) /(y(al)-1)  ) 
 2037:    .                sum8a=sum7*(  ( ((y(al))**(e8+2))-1) /(y(al)-1)  )
 2038:    .                k88=k77*(y(al)-1)
 2039:    .                g(div1)=g(div1)+x-1
 2040:    .                g(div2)=g(div2)+1
 2041:    .            if ((divisori.eq.div1).and.(pr-al+1.gt.1))then
 2042:    .            do i=al+1,pr
 2043:    .            flag=flag+1
 2044:    .         if(flag.gt.2000)then
 2045:    .             divisori=0;exit
 2046:              end if
 2047:    .            p(flag)=y(i)*combi8
 2048:    .            s(flag)=(y(i)+1)*sum8 
 2049:    .            ss88=y(t)*y(zl)*y(yl)*y(hl)*y(gl)*y(il)*y(sl)*y(al)*y(i)
 2050:    .            k88a=(p(flag))/ss88
 2051:    .            e(flag)=k88*(y(i)-1)*k88a  
 2052:                 
 2053:    .           write(*,11)flag,p(flag),s(flag),e(flag)
 2054:    .           write(7,11)flag,p(flag),s(flag),e(flag)
 2055:    .      write(*,26)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',      &
 2056:               &y(hl),'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(sl),'^',e7,   &
 2057:               &'*',y(al),'^',e8,'*',y(i),'^1'
 2058:    .      write(7,26)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',      &
 2059:               &y(hl),'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(sl),'^',e7,   &
 2060:               &'*',y(al),'^',e8,'*',y(i),'^1'
 2061:          26    format(I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7, &
 2062:               &a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a2)
 2063:    .             numc=numc+3
 2064:    .         rr=0;call riga(numc,rr)
 2065:    .         if(rr.eq.1)goto 2222
 2066:                 continue
 2067:                 end do
 2068:                 end if
 2069:    .         if(divisori.eq.div2)then
 2070:    .            flag=flag+1
 2071:    .         if(flag.gt.2000)then
 2072:    .             divisori=0
 2073:    .         end if
 2074:    .            p(flag)=y(al)*combi8
 2075:    .            s(flag)=sum8a
 2076:    .            ss88=y(t)*y(zl)*y(yl)*y(hl)*y(gl)*y(il)*y(sl)*y(al)
 2077:    .            k88a=(p(flag))/ss88
 2078:    .            e(flag)=k88*k88a 
 2079:    .            write(*,11)flag,p(flag),s(flag),e(flag)
 2080:    .             write(7,11)flag,p(flag),s(flag),e(flag)
 2081:    .       write(*,27)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl)&
 2082:               &,'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(sl),'^',e7,'*',     &
 2083:               &y(al),'^',e8+1
 2084:    .       write(7,27)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl)&
 2085:               &,'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(sl),'^',e7,'*',     &
 2086:               &y(al),'^',e8+1
 2087:          27    format(I7, a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7&
 2088:               &,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0,a1,I7,a1,F3.0)
 2089:    .             numc=numc+3
 2090:    .         rr=0;call riga(numc,rr)
 2091:    .         if(rr.eq.1)goto 2222
 2092:                 end if 
 2093:                 
 2094:                goto 4700   !goto block 9---->
 2095:    .      4650     k8=k8/y(al) !power block 8^^^^^^^^^^^^^^^^^^^
 2096:    .           if(k8.lt.y(al))goto 4610 !goto block 8----->
 2097:    .           pr=k8
 2098:    .           e8=e8+1
 2099:    .           call cerca (pr,y)
 2100:    .           x=pr-al+1
 2101:    .           s1=s1+x
 2102:    .           combi8=combi7*(y(al)**e8)
 2103:    .           sum8=sum7*(  ( ((y(al))**(e8+1))-1) /(y(al)-1)  )
 2104:    .           sum8a=sum7*(  ( ((y(al))**(e8+2))-1) /(y(al)-1)  )
 2105:                   div1=(e0+1)*(ex+1)*(e2+1)*(e3+1)*(e4+1)*(e5+1)*(e6+1)
 2106:    .              div1=div1*(e8+1)*(e7+1)
 2107:    .              div2=(div1/(2*(e8+1)))*(e8+2)
 2108:    .              g(div1)=g(div1)+x-1
 2109:    .              g(div2)=g(div2)+1
 2110:    .            if ((divisori.eq.div1).and.(pr-al+1.gt.1))then
 2111:    .            do i=al+1,pr
 2112:    .            flag=flag+1
 2113:    .         if(flag.gt.2000)then
 2114:    .             divisori=0;exit
 2115:              end if
 2116:    .            p(flag)=y(i)*combi8
 2117:    .            s(flag)=(y(i)+1)*sum8
 2118:    .            ss88=y(t)*y(zl)*y(yl)*y(hl)*y(gl)*y(il)*y(sl)*y(al)*y(i)
 2119:    .            k88a=(p(flag))/ss88
 2120:    .            e(flag)=k88*(y(i)-1)*k88a 
 2121:    .             write(*,11)flag,p(flag),s(flag),e(flag)
 2122:    .             write(7,11)flag,p(flag),s(flag),e(flag)
 2123:    .        write(*,26)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',      &
 2124:               &y(hl),'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(sl),'^',e7,   &
 2125:               &'*',y(al),'^',e8,'*',y(i),'^1'
 2126:    .        write(7,26)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',      &
 2127:               &y(hl),'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(sl),'^',e7,   &
 2128:               &'*',y(al),'^',e8,'*',y(i),'^1'
 2129:    .            numc=numc+3
 2130:    .         rr=0;call riga(numc,rr)
 2131:    .         if(rr.eq.1)goto 2222
 2132:                 continue
 2133:                 end do
 2134:                 end if
 2135:    .         if(divisori.eq.div2)then
 2136:    .            flag=flag+1
 2137:    .         if(flag.gt.2000)then
 2138:    .             divisori=0
 2139:    .         end if
 2140:    .            p(flag)=y(al)*combi8
 2141:    .            s(flag)=sum8a
 2142:    .            ss88=y(t)*y(zl)*y(yl)*y(hl)*y(gl)*y(il)*y(sl)*y(al)
 2143:    .            k88a=(p(flag))/ss88
 2144:    .            e(flag)=k88*k88a
 2145:    .             write(*,11)flag,p(flag),s(flag),e(flag)
 2146:    .              write(7,11)flag,p(flag),s(flag),e(flag)
 2147:    .         write(*,27)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl)&
 2148:               &,'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(sl),'^',e7,'*',     &
 2149:               &y(al),'^',e8+1
 2150:    .         write(7,27)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(yl),'^',e3,'*',y(hl)&
 2151:               &,'^',e4,'*',y(gl),'^',e5,'*',y(il),'^',e6,'*',y(sl),'^',e7,'*',     &
 2152:               &y(al),'^',e8+1
 2153:    .           numc=numc+3
 2154:    .         rr=0;call riga(numc,rr)
 2155:    .         if(rr.eq.1)goto 2222
 2156:                end if 
 2157:          !C                      block 9 ------------------------------------      
 2158:    .      4700 fl=al
 2159:    .      4710 fl=fl+1
 2160:    .           k9=k8/y(fl)
 2161:    .           if(k9.lt.y(fl))goto 4650!goto power block 8-> 
 2162:    .           e9=1
 2163:    .           pr=k9
 2164:    .           call cerca (pr,y)
 2165:    .           x=pr-fl+1
 2166:    .           s1=s1+x
 2167:                div1=(e0+1)*(ex+1)*(e2+1)*(e3+1)*(e4+1)*(e5+1)*(e6+1)*(e7+1)
 2168:    .           div1=div1*(e8+1)*(e9+1)
 2169:    .           div2=(div1/(2*(e9+1)))*(e9+2)
 2170:    .           combi9=combi8*y(fl)
 2171:    .           sum9=sum8*(  ( ((y(fl))**(e9+1))-1) /(y(fl)-1)  ) 
 2172:    .           sum9a=sum8*(  ( ((y(fl))**(e9+2))-1) /(y(fl)-1)  )
 2173:    .           k99=k88*(y(fl)-1)
 2174:    .           g(div1)=g(div1)+x-1
 2175:    .           g(div2)=g(div2)+1
 2176:    .           if ((divisori.eq.div1).and.(pr-fl+1.gt.1))then
 2177:    .            do i=fl+1,pr
 2178:    .            flag=flag+1
 2179:    .            p(flag)=y(i)*combi9
 2180:    .            s(flag)=(y(i)+1)*sum9 
 2181:    .            ss99=y(t)*y(zl)*y(yl)*y(hl)*y(gl)*y(il)*y(sl)*y(al)*y(fl)*y(i)
 2182:    .            k99a=(p(flag))/ss99
 2183:    .            e(flag)=k99*(y(i)-1)*k99a  
 2184:    .            write(*,*)flag,p(flag),s(flag),s(flag)-2*(p(flag)),e(flag)
 2185:    .           write(*,*)y(t),'^',ex,y(zl),'^',e2,y(yl),'^',e3
 2186:    .           write(*,*)y(hl),'^',e4,y(gl),'^',e5,y(il),'^',e6,y(sl),'^',e7
 2187:    .           write(*,*)y(al),'^',e8,y(fl),'^',e9,y(i)
 2188:    .            numc=numc+3
 2189:    .         rr=0;call riga(numc,rr)
 2190:    .         if(rr.eq.1)goto 2222
 2191:                continue
 2192:                 end do
 2193:                 end if
 2194:    .            if(divisori.eq.div2)then 
 2195:    .            flag=flag+1
 2196:    .            p(flag)=y(fl)*combi9
 2197:    .            s(flag)=sum9a
 2198:    .            ss99=y(t)*y(zl)*y(yl)*y(hl)*y(gl)*y(il)*y(sl)*y(al)*y(fl)
 2199:    .            k99a=(p(flag))/ss99
 2200:    .            e(flag)=k99*k99a 
 2201:    .            write(*,*)flag,p(flag),s(flag),s(flag)-2*(p(flag)),e(flag)
 2202:    .            write(*,*)y(t),'^',ex,y(zl),'^',e2,y(yl),'^',e3
 2203:    .           write(*,*)y(hl),'^',e4,y(gl),'^',e5,y(il),'^',e6,y(sl),'^',e7
 2204:    .           write(*,*)y(al),'^',e8,y(fl),'^',e9+1
 2205:    .            numc=numc+3
 2206:    .            if(mod(numc,18).eq.0)then
 2207:    .            pause
 2208:                 end if
 2209:                 end if 
 2210:    .            goto 4710      
 2211:          !!C     Ok indicazione dati finali
 2212:    .       5000 if(salto .eq.1)then
 2213:                goto 107
 2214:                  end if
 2215:    .           write(*,*)'         V E C T O R    R E A D Y'
 2216:    .           pause 
 2217:    .            fz=achar(124)
 2218:    .             write(7,1123)'   ',saln
 2219:    .              v11=saln-s1-1
 2220:    .           write(*,*)'there are ',v11,' prime numbers' 
 2221:    .           g(1)=1
 2222:                g(2)=v11
 2223:    .           do i=1,2000
 2224:    .           if(g(i).ne.0)cont=i
 2225:                continue
 2226:                end do
 2227:    .         a=-3;b=0;c=0
 2228:    .           do i=1,cont,4
 2229:    .           do j =1,4
 2230:    .         a=a+1;b=b+1;c(j)=g(b)
 2231:              continue
 2232:              end do
 2233:    .         d1=c(1);d2=c(2);d3=c(3);d4=c(4)
 2234:    .           write(*,333)' ',a,' ',d1,fz,a+1,' ',d2,fz,a+2,' ',d3,fz,a+3,      &
 2235:               &' ',d4
 2236:    .       write(7,333)' ',a,' ',d1,fz,a+1,' ',d2,fz,a+2,' ',d3,fz,a+3,      &
 2237:               &' ',d4
 2238:          333   format(a1, I5, a1, I10, a2, I5, a1, I10, a2, I5, a1, I10, a2, &
 2239:                 & I5, a1, I10 , :)
 2240:          339   format(I5,I10)   
 2241:    .           if(mod(b,72).eq.0)then
 2242:    .           pause
 2243:                end if
 2244:                continue
 2245:                end do
 2246:    .           total=0
 2247:    .           do i=1,cont
 2248:    .           total=total+g(i)
 2249:                continue
 2250:                end do
 2251:           340 format(a60,I10)
 2252:    .         Print*,'The sum of the list(total numbers of composites and primes+1)= ',total
 2253:    .         write(7,340)'The sum of the list(total numbers of composites and primes+1)= ',total
 2254:    .         n1=saln      
 2255:    .         pause
 2256:    .         102 write(*,*)'O P T I O N for a lists of numbers with the same number'  
 2257:    .             write(*,*)'of divisors up to '
 2258:    .             write(*,1123)'   ',saln
 2259:    .             write(*,*)'In this list sum of divisors,Euler Function and' 
 2260:    .             write(*,*)'factors are indicated.If N is large the list could'
 2261:    .             write(*,*)'be big.The program shows only up to 2000 numbers '
 2262:    .             write(*,*)'as generated by the algorithm.' 
 2263:    .             write(*,*)'.Enter 0 to go to main menu otherwise the number' 
 2264:    .             write(*,*)'of divisors of the numbers to be indicated.For '
 2265:    .             write(*,*)'instance 6 for a list of numbers with 6 divisors up to'
 2266:    .             write(*,1123)'   ',saln
 2267:    .         CALL CONTROL (SCELTA)
 2268:    .         divisori =scelta
 2269:    .           if (divisori.eq.2)then
 2270:    .         write(*,*)'this is only a list of primes'
 2271:              goto 2222
 2272:              end if
 2273:    .            if(divisori.eq.0)then
 2274:                 goto 2222; else
 2275:    .         salto = 1
 2276:    .         divisori1=divisori
 2277:    .             goto 105
 2278:                 end if               
 2279:                 pause
 2280:    .     107    If(flag.gt.2000)then
 2281:    .            flag=2000
 2282:                 end if 
 2283:    .            pause
 2284:                   5142 format(2I10)
 2285:    .            if (divisori.gt.0)then
 2286:    .            call sortqq(loc(p),flag,srt$Integer4)
 2287:           42 format(a35)
 2288:    .      WRITE(7,42)'ORDERED LIST OF DIVISORS'  
 2289:    .        do i=1,flag
 2290:    .            print*,i,p(i)
 2291:    .            numc=numc+1
 2292:    .         rr=0;call riga(numc,rr)
 2293:    .         if(rr.eq.1)goto 2222
 2294:    .            write(7,5142)i,p(i)
 2295:                 continue
 2296:                 end do
 2297:    .            pause
 2298:    .            end if
 2299:          109      do i=1,2000
 2300:                g(i)=0
 2301:              p(i)=0
 2302:                continue
 2303:                end do
 2304:    .            pause
 2305:    .       2222     k=0 
 2306:                 cont=0 
 2307:                flag=0
 2308:    .           call endline
 2309:                return
 2310:    .           end subroutine vetto1
 2311:           
 2312:          !================================================
 2313:          ! to find divisors of a single number      
 2314:    .           Subroutine div (y)
 2315:              USE MSIMSL
 2316:              USE MSFLIB
 2317:                integer*4 y(149000),w(1600),w1,w2,scelta,numc,rr      
 2318:                Integer*4 n,k,l,test,test1,pr,a,riga1,pr1,h,k2,k1,z
 2319:                real*8 park1
 2320:             1234 format(I10)
 2321:    .     90   call control(scelta)
 2322:    .       n=scelta
 2323:            pr1=n
 2324:    .           if(pr1.lt.0) then
 2325:                goto 90
 2326:                endif 
 2327:    .           a=n
 2328:                c=1      
 2329:    .           h=0;park1=0      
 2330:    .           c=sqrt(1.*a)
 2331:    .           pr=c       
 2332:    .           call cerca (pr,y)
 2333:    .            k2=pr       
 2334:    .           do h=1,k2
 2335:    .            k=h
 2336:                k1=y(k)       
 2337:    .           z=(mod(a,k1))      
 2338:    .           if( z) 150,200,150      
 2339:          150      continue
 2340:                end do
 2341:    .           write(*,*)'primo  1',a
 2342:                goto 1000
 2343:    .     200      k=1
 2344:    .           test=0
 2345:    .           test1=0
 2346:    .           riga1=0;w1=-1
 2347:    .     100   if(k.gt.n)then
 2348:                 goto 1000 
 2349:                 end if
 2350:    .           test=k*(int(n/k))
 2351:    .           if(n.eq.test)then
 2352:    .           l=n/k
 2353:    .           riga1=riga1+1
 2354:                w1=w1+2
 2355:                w(w1)=k;w(w1+1)=l
 2356:    .           test1=l
 2357:    .           end if
 2358:    .           k=k+1
 2359:    .           if((k.eq.test1).or.(k-1.eq.test1))then
 2360:    .           goto 1000
 2361:                end if
 2362:                goto 100 
 2363:    .      1000  pause
 2364:    .     w2=riga1*2
 2365:    .     if(w(w2).eq.w(w2-1))then
 2366:    .     w2=w2-1
 2367:          end if
 2368:    .     numc=0
 2369:    .     call sortqq(loc(w),w2,srt$Integer4)
 2370:    .     write(7,1235)'divisors of ',n
 2371:    .     do i=1,w2
 2372:    .     numc=numc+1
 2373:    .     print*,i,w(i)
 2374:    .      write(7,339)i,w(i)
 2375:    .      park1=park1+w(i)
 2376:    .     rr=0;call riga(numc,rr)
 2377:    .         if(rr.eq.1)exit
 2378:          continue
 2379:          end do
 2380:    .     write(7,340)'sum of divisors',park1
 2381:    .     write(*,340)'sum of divisors',park1
 2382:    .      pause
 2383:           339   format(I5,I10)
 2384:           340  format(1x,a20,F14.0)
 2385:          1235  format(1x,a15,1I10)
 2386:    .     call endline
 2387:    .      pause
 2388:    .     pause
 2389:    .           end subroutine div
 2390:           !=========================
 2391:             
 2392:          !   C     Subroutine lista for a list of prime numbers from N1 to N2
 2393:    .           subroutine lista(y)
 2394:                USE MSIMSL
 2395:              implicit none
 2396:              character*1 fz
 2397:              integer*4 y(149000),targ,phi1,d1,d2,d3,rr,numc
 2398:              integer*4  c(4),c2,flag,park1,park2,park,park3,salp,park4
 2399:              integer*4 IEXP(13), IPF(13), IPW(13), NPF,n,k,z,j,c1,i
 2400:              integer*4 h,pr,k1,k2,a,pr1,pr2,phi,scelta,park5
 2401:              real*8 n1
 2402:           7 format(1x,a45)
 2403:          1234 format(I10)
 2404:    .             fz=achar(124)
 2405:    .             park5=0
 2406:    .      89     write(*,*)'Enter 0 to find a list of prines'
 2407:    .             write(*,*)'enter 1 for a list of a fixed  gap(example 2)'
 2408:    .             write(*,*)'enter 2 for a list in an  interval of gaps(example from  2 to 10)'
 2409:            
 2410:    .              call control(scelta)
 2411:    .             flag=scelta
 2412:    .             if(flag.lt.0)goto 89
 2413:    .             if(flag.gt.2)goto 89
 2414:    .            if (flag.eq.1)then
 2415:    .             write(*,*)'enter even numbe >= 2 for the gap'
 2416:    .             call control(scelta)
 2417:    .             park=scelta
 2418:    .             end if
 2419:                  !----------------
 2420:    .             if (flag.eq.2)then
 2421:    .             write(*,*)'enter even numbe >= 2 for the first number of the inteval of gaps'
 2422:    .             call control(scelta)
 2423:    .             park=scelta
 2424:    .             write(*,*)'enter even numbe >= 4 for the last number of the inteval of gaps'
 2425:    .             call control(scelta)
 2426:    .             park5=scelta
 2427:                  end if  
 2428:                 !-------------------
 2429:    .     90       write(*,*)'N1 ? odd number>11'
 2430:    .              write(*,*)'list starts with next prime'
 2431:    .              call control(scelta)
 2432:    .             pr1=scelta
 2433:    .             if(pr1.lt.13)goto 90
 2434:    .             if(mod(pr1,2).eq.0)goto 90
 2435:    .              print*,pr1
 2436:    .              n=pr1
 2437:    .          do while((npf.ne.1).or.(iexp(1).ne.1))
 2438:    .           CALL PRIME (N, NPF, IPF, IEXP, IPW)
 2439:    .           n=n-2
 2440:                continue
 2441:    .           end do
 2442:    .           pr1=n+2
 2443:    .           print*,pr1
 2444:    .         n1=dfloat(pr1)
 2445:    .            call trova1 (n1,y)
 2446:    .           phi=n1
 2447:    .               print*,phi
 2448:                    goto 99
 2449:    .     99      write(*,*)'N2 ? N2>N1 and N2<2147483647'
 2450:    .             call control(scelta)
 2451:    .             pr2=scelta
 2452:    .         if(pr2.lt.pr1)goto 99
 2453:    .         n1=dfloat(pr2)
 2454:    .            call trova1 (n1,y)
 2455:    .           phi1=n1
 2456:    .           print*,n1,phi1
 2457:    .           targ=phi1-phi+1
 2458:    .           write(*,*)'there are  ',targ,' primes from N1 to N2'
 2459:    .         if(flag.eq.0)then
 2460:    .           write(*,*)'It follows the list of primes with their index'
 2461:    .           write(7,7)' List of primes with their index'
 2462:                end if
 2463:    .            if((flag.eq.1).or.(flag.eq.2))then
 2464:    .           write(*,*)'It follows the list of gap of primes with their index'
 2465:    .           write(7,7)' List of gap of primes with their index'
 2466:    .          write(7,7)' gap =   '
 2467:    .          write(7,1234)park,park5
 2468:                end if
 2469:    .           pause
 2470:    .     109 a=pr1 -2
 2471:    .         c2=1
 2472:              phi=phi-1
 2473:    .         numc=0;c1=0
 2474:    .           do i=1,targ,3
 2475:    .           do j =1,3
 2476:    .     if(j.eq.2)then
 2477:    .         park3=c(1)-salp
 2478:              end if
 2479:              h=0
 2480:    .     100   a=a+2
 2481:    .           c2=sqrt(1.*a)
 2482:    .           pr=c2
 2483:    .           call cerca (pr,y)
 2484:    .           k2=pr
 2485:    .           do h=1,k2
 2486:    .           k=h
 2487:    .           k1=y(k)
 2488:    .           z=(mod(a,k1))
 2489:    .           if( z) 150,100,150
 2490:          150   continue
 2491:                end do
 2492:    .           phi=phi+1
 2493:    .           c(j)=a
 2494:              continue
 2495:              end do
 2496:    .          d1=c(1);d2=c(2);d3=c(3)
 2497:    .         if((flag.eq.1).or.(flag.eq.2))then
 2498:    .         park1=d2-d1
 2499:    .         park2=d3-d2
 2500:    .         park4=d1-salp
 2501:              end if
 2502:    .         if(flag.eq.0)then
 2503:    .           write(*,333)'  ',phi-2,d1,fz,phi-1,d2 ,fz,phi,d3
 2504:    .           write(7,333)'  ',phi-2,d1,fz,phi-1,d2 ,fz,phi,d3
 2505:    .            numc=numc+1
 2506:    .          rr=0;call riga(numc,rr)
 2507:    .         if(rr.eq.1)exit
 2508:                  end if
 2509:    .             if(flag.eq.1)then
 2510:    .             park5=park
 2511:                  end if
 2512:    .         if((flag.eq.1).or.(flag.eq.2))then
 2513:    .         if ((park3.ge.park).and.(park3.le.park5))then
 2514:    .          write(*,333)'  ',phi-3,salp,fz,phi-2,d1,fz,park4
 2515:    .          write(7,333)'  ',phi-3,salp,fz,phi-2,d1,fz,park4
 2516:    .         numc=numc+1
 2517:    .         rr=0;call riga(numc,rr)
 2518:    .         if(rr.eq.1)exit
 2519:              end if
 2520:    .         if ((park1.ge.park).and.(park1.le.park5))then
 2521:    .         write(*,333)'  ',phi-2,d1,fz,phi-1,d2 ,fz,park1
 2522:    .         write(7,333)'  ',phi-2,d1,fz,phi-1,d2 ,fz,park1
 2523:    .         numc=numc+1 
 2524:    .     rr=0;call riga(numc,rr)
 2525:    .         if(rr.eq.1)exit
 2526:              end if
 2527:    .        if ((park2.ge.park).and.(park2.le.park5))then
 2528:    .          write(*,333)'  ',phi-1,d2,fz,phi,d3,fz,park2
 2529:    .          write(7,333)'  ',phi-1,d2,fz,phi,d3,fz,park2
 2530:    .          numc=numc+1
 2531:    .     rr=0;call riga(numc,rr)
 2532:    .         if(rr.eq.1)exit
 2533:              end if
 2534:              end if
 2535:    .         if((flag.eq.1).or.(flag.eq.2))then
 2536:    .         salp=c(3)
 2537:              end if
 2538:              continue
 2539:    .         end do
 2540:    .           iexp=0;npf=0
 2541:    .         if((flag.eq.1).or.(flag.eq.2))then
 2542:    .           write(*,7)'pairs found                    '
 2543:    .           write(7,7)'pairs found                    '
 2544:    .           write(*,1234)numc          
 2545:    .           write(7,1234)numc
 2546:                end if
 2547:    .         call endline
 2548:              333   format(a2,I11,I11,a2,I11,I11,a2,I11,I11:)
 2549:              334   format(I11,I11)
 2550:    .           pause
 2551:    .           end subroutine lista
 2552:          !============================
 2553:    .       subroutine decom
 2554:               integer*4 IEXP(13), IPF(13), IPW(13), NPF,scelta,pr1
 2555:             4 format(1X,a17)
 2556:             7 format(1x,a45)
 2557:             9 Format(3I11)
 2558:    .     90       write(*,*)'N ?  number >=2,<=2147483647'
 2559:    .              call control(scelta)
 2560:    .              pr1=scelta
 2561:    .         if(pr1.lt.2)goto 90
 2562:    .         n=pr1
 2563:    .         write(7,4)'prime factors of'
 2564:    .         write(*,9)n
 2565:    .         write(7,9)n
 2566:    .      CALL PRIME (N, NPF, IPF, IEXP, IPW)
 2567:    .           do j=1,npf
 2568:    .            write(*,9)ipf(j),iexp(j)
 2569:    .            write(7,9)ipf(j),iexp(j)
 2570:                continue
 2571:                end do
 2572:    .           call endline
 2573:    .         end subroutine decom
 2574:              !====================
 2575:    .      subroutine euler1 
 2576:           integer*4 eul(15),park1,scelta,n,j,i,pr1
 2577:           real*8 eul1(15),eul2
 2578:           integer*4 IEXP(13), IPF(13), IPW(13), NPF
 2579:             4 format(1X,a25)
 2580:             9 Format(3I11)
 2581:    .     90       write(*,*)'N ?  number >=2,<=2147483647'
 2582:    .              call control(scelta)
 2583:    .              pr1=scelta
 2584:    .         if(pr1.lt.2)goto 90
 2585:    .          n=pr1
 2586:    .         write(7,4)'Euler function of         '
 2587:    .         write(*,9)n
 2588:    .         write(7,9)n
 2589:    .         CALL PRIME (N, NPF, IPF, IEXP, IPW)
 2590:    .      do j=1,npf
 2591:                eul(j)=ipf(j)
 2592:                continue
 2593:                end do
 2594:    .           eul2=1
 2595:    .           i=1
 2596:    .           do while (eul(i).ne.0)
 2597:    .           eul1(i)=eul(i)
 2598:    .           eul2=eul2*(1.0-(1.0/eul1(i)))
 2599:                i=i+1
 2600:                continue
 2601:    .           end do
 2602:    .           eul2=eul2*(real(n))
 2603:    .           park1=dnint(eul2)
 2604:    .           eul1=0
 2605:                eul=0
 2606:    .          print*,park1
 2607:    .          write(7,9)park1
 2608:    .          call endline
 2609:    .         end subroutine euler1 
 2610:          !=======================
 2611:    .      subroutine endline
 2612:                7 format(1x,a45)
 2613:              write(*,7)'__________________________________________________               '
 2614:    .         write(7,7)'__________________________________________________               '
 2615:              end subroutine endline
 2616:              !===============================================
 2617:          
 2618:    .         subroutine inclusion (y,flag5)
 2619:           !start inclusion exclusion (see readme file)
 2620:          real*8 aa,bb,cc,dd,ee,ff,gg,hh,ii,ll,mm
 2621:          real*8 park1
 2622:          real*8 k ,k1,k2,k3,k4,k5,k6,k7,k8,k9,k10,k11,sr1
 2623:          integer*4 y(149000),sump,sumn,numc,sets(300),scelta,pr,z12,comb,scomb
 2624:          integer*4 z11,c2,sost,flag5,c,numc1,numc2,key2,rr
 2625:           5 format(1X,a75)
 2626:           6 format(1X,a60)
 2627:           7 format(1x,a45)
 2628:           8 format(a1)
 2629:           9 Format(8I7)
 2630:          10 format(a45,4I10)
 2631:          21 format(4F10.0)
 2632:          23 format(2I9,2F9.0,1I9)
 2633:          24 format(1I9,1F12.3,1I8,1F10.0,1F10.0,1F10.0 )
 2634:          25 format(a6,1F10.0,a20,1I10,a3,2I10    )
 2635:          26 format(1X,a40,2F11.0)
 2636:          
 2637:    .     11221  write(7,5)'suggested N < 2000000                                          '
 2638:    .      write(7,5)'calculate Phi(N) with inclusion exclusion method for N =       '
 2639:    .      write(*,5)'suggested N < 2000000                                          '
 2640:    .      write(*,5)'calculate Phi(N) with inclusion exclusion method for N =       '
 2641:    .     call control(scelta)
 2642:    .     k=scelta
 2643:    .     write(7,21)k
 2644:    .     Print*,'Print all data enter 0 part of data enter 1'
 2645:    .     write(7,5)'Print all data enter 0 part of data enter 1'
 2646:    .     call control(scelta)
 2647:    .     key2=scelta
 2648:    .     write(7,9)key2
 2649:    .     z12= SQRT( REAL(k)) 
 2650:    .     pr=z12
 2651:    .     call cerca(pr,y)
 2652:    .     z11=pr
 2653:          sets=0
 2654:    .     sr1=0 ;numc=0;sump=0;sumn=0;c2=0
 2655:    .           comb=0
 2656:                scomb=0
 2657:    .           if(z12.le.2)then
 2658:                 goto 11221
 2659:                 end if 
 2660:           !start calculate        
 2661:    .        park1=0 ;sr2=0
 2662:          !Block 1  
 2663:             !====================================
 2664:    .       write(7,26)'___________                       '                              
 2665:    .       if(key2.eq.0)then
 2666:    .     write(7,5)'column 1 = sequential number of operatiom                                       '  
 2667:    .     write(7,5)'column 2 = combination of primes.-Operation multiplication                                '
 2668:    .     write(7,5)'column 3 = sequential total                                                                       '
 2669:    .     write(7,5)'column 4 = result on one block for one loop. K1,k2,k3...                                         '
 2670:    .     write(7,5)'NOTE:each prime up to sqrt of N is elaborated,when complete its set             '
 2671:    .     write(7,5)'     and subtotals are printed                                                  '
 2672:    .     write(7,6)'      1        2         3         4                              '
 2673:    .     write(7,6)'________________________________________________________            '
 2674:    .     write(*,5)'column 1 = sequential number of operatiom                                       '  
 2675:    .     write(*,5)'column 2 = combination of primes.-Operation multiplication                                '
 2676:    .     write(*,5)'column 3 = sequential total                                                                       '
 2677:    .     write(*,5)'column 4 = result on one block for one loop. K1,k2,k3...                                         '
 2678:    .     write(*,5)'NOTE:each prime up to sqrt of N is elaborated,when complete its set             '
 2679:    .     write(*,5)'     and subtotals are printed                                                  '
 2680:    .     write(*,6)'      1        2         3         4                              '
 2681:    .     write(*,6)'________________________________________________________            '
 2682:           end if
 2683:    .      aa=0
 2684:    .     100      aa=aa+1
 2685:    .       sets(aa)=sump-sumn
 2686:    .       if((aa-1).ne.0)then
 2687:    .         write(*,25)'set N',aa-1,' relevant to prime ',y(aa-1),' = ',sets(aa)-sets(aa-1)
 2688:    .         write(7,25)'set N',aa-1,' relevant to prime ',y(aa-1),' = ',sets(aa)-sets(aa-1)
 2689:             end if
 2690:    .         pause
 2691:    .           if(y(aa).gt.z12)goto 11220 
 2692:    .         if(aa.gt.z11)goto 11220 
 2693:    .           k1=dint(k/y(aa))
 2694:    .           scomb=scomb+1
 2695:    .         if (k1.lt.1)then
 2696:                sr1=sr1 !+1
 2697:                sr2=sr2
 2698:                else 
 2699:    .           numc=numc+1;sump=sump+k1
 2700:    .           sr1=sr1 +k1
 2701:    .           sr2=sr1
 2702:    .          if(flag5.eq.1)then
 2703:    .          if (k1.lt.11)then
 2704:    .           sr1=sr1+1 -k1
 2705:                sost=1
 2706:    .           else 
 2707:    .           c=k1
 2708:    .       call reduce(c,c2)
 2709:    .              sost=c2
 2710:    .              sr1=sr1 + sost-k1
 2711:                   end if
 2712:                   end if
 2713:    .         if (key2.eq.0)then    
 2714:    .         write(*,23)numc,y(aa),sr1 ,k1,sost
 2715:    .         write(7,23)numc,y(aa),sr1 ,k1,sost
 2716:    .         sost=0
 2717:    .         rr=0;call riga(numc,rr)
 2718:    .         if(rr.eq.1)return
 2719:                 end if
 2720:                 end if
 2721:          !Block 2   
 2722:             !====================================
 2723:          
 2724:                     bb=0
 2725:    .       200      bb=bb+1
 2726:    .           k2=dint(k1/y(bb))
 2727:    .           if((k2.lt.1).or.(bb.eq.aa))goto 100
 2728:    .           scomb=scomb+1
 2729:    .           if (k2.lt.1 )then
 2730:                sr1=sr1 !-1
 2731:                sr2=sr2
 2732:                else
 2733:    .               numc=numc+1;sumn=sumn+k2
 2734:    .               sr1=sr1-k2 
 2735:    .               sr2=sr1
 2736:    .          if(flag5.eq.1)then
 2737:    .          if (k2.lt.11)then
 2738:    .           sr1=sr1-1 +k2
 2739:                sost=1
 2740:    .           else 
 2741:    .           c=k2
 2742:    .        call reduce(c,c2)
 2743:    .              sost=c2
 2744:    .              sr1=sr1 - sost+k2
 2745:                   end if
 2746:                   end if
 2747:    .           if (key2.eq.0)then      
 2748:    .               write(*,23)numc,y(aa)*y(bb),sr1,-k2,-sost
 2749:    .               write(7,23)numc,y(aa)*y(bb),sr1,-k2,-sost
 2750:    .               rr=0;call riga(numc,rr)
 2751:    .               sost=0
 2752:    .         if(rr.eq.1)return
 2753:                      end  if
 2754:               end if
 2755:           !Block 3   
 2756:             !====================================
 2757:                     cc=0
 2758:    .       300      cc=cc+1
 2759:    .           k3=dint(k2/y(cc))
 2760:    .           if((k3.lt.1).or.(cc.eq.bb))goto 200
 2761:    .           scomb=scomb+1
 2762:    .         if(k3.lt.1)then
 2763:                sr1=sr1 !+1
 2764:                sr2=sr2
 2765:                else
 2766:    .               numc=numc+1;sump=sump+k3
 2767:    .               sr1=sr1+k3 
 2768:    .               sr2=sr1
 2769:          
 2770:               !------------
 2771:    .       if(flag5.eq.1)then
 2772:    .       if (k3.lt.11)then
 2773:    .           sr1=sr1+1 -k3
 2774:                sost=1
 2775:    .           else 
 2776:    .           c=k3
 2777:    .        call reduce(c,c2)
 2778:    .              sost=c2
 2779:    .              sr1=sr1 + sost-k3
 2780:                   end if
 2781:                   end if
 2782:    .           if (key2.eq.0)then     
 2783:    .               write(*,23)numc,y(aa)*y(bb)*y(cc) ,sr1,k3,sost 
 2784:    .               write(7,23)numc,y(aa)*y(bb)*y(cc) ,sr1,k3,sost 
 2785:    .               sost=0
 2786:    .               rr=0;call riga(numc,rr)
 2787:    .         if(rr.eq.1)return
 2788:              end if
 2789:                    end if
 2790:          !Block 4   
 2791:             !====================================
 2792:                     dd=0
 2793:    .       400      dd=dd+1
 2794:    .           k4=dint(k3/y(dd))
 2795:    .           if((k4.lt.1).or.(dd.eq.cc))goto 300
 2796:    .           scomb=scomb+1
 2797:    .           if(k4.lt.1)then
 2798:                sr1=sr1 !-1
 2799:                  sr2=sr2
 2800:                  else
 2801:    .               numc=numc+1;sumn=sumn+k4
 2802:    .               sr1=sr1-k4 
 2803:    .              sr2=sr1
 2804:    .          if(flag5.eq.1)then
 2805:               
 2806:    .          if (k4.lt.11)then
 2807:    .           sr1=sr1-1 +k4
 2808:                sost=1
 2809:    .           else 
 2810:    .           c=k4
 2811:    .        call reduce(c,c2)
 2812:    .              sost=c2
 2813:    .              sr1=sr1 - sost+k4
 2814:                   end if
 2815:                   end if
 2816:    .         if (key2.eq.0)then    
 2817:    .              write(*,23)numc,y(aa)*y(bb)*y(cc)*y(dd),sr1 ,-k4,-sost
 2818:    .              write(7,23)numc,y(aa)*y(bb)*y(cc)*y(dd),sr1 ,-k4,-sost
 2819:    .              sost=0
 2820:    .           rr=0;call riga(numc,rr)
 2821:    .         if(rr.eq.1)return
 2822:              end if
 2823:              end if
 2824:          !Block 5     
 2825:             !====================================
 2826:                     ee=0
 2827:    .       500      ee=ee+1
 2828:    .           k5=dint(k4/y(ee))
 2829:    .           if((k5.lt.1).or.(ee.eq.dd))goto 400
 2830:    .           scomb=scomb+1
 2831:    .           if(k5.lt.1)then
 2832:                 sr1=sr1 !+1
 2833:                 sr2=sr2
 2834:                 else
 2835:    .               numc=numc+1;sump=sump+k5
 2836:    .               sr1=sr1+k5
 2837:    .               sr2=sr1
 2838:          
 2839:    .       if(flag5.eq.1)then
 2840:    .       if (k5.lt.11)then
 2841:    .           sr1=sr1+1-k5
 2842:                sost=1
 2843:    .           else 
 2844:    .           c=k5
 2845:    .        call reduce(c,c2)
 2846:    .              sost=c2
 2847:    .              sr1=sr1 + sost-k5
 2848:                   end if
 2849:                   end if
 2850:    .         if (key2.eq.0)then    
 2851:    .           write(*,23)numc,y(aa)*y(bb)*y(cc)*y(dd)*y(ee) ,sr1,k5,sost 
 2852:    .           write(7,23)numc,y(aa)*y(bb)*y(cc)*y(dd)*y(ee) ,sr1,k5,sost 
 2853:    .           rr=0;call riga(numc,rr)
 2854:    .         sost=0
 2855:    .         if(rr.eq.1)return
 2856:              end if
 2857:                end if
 2858:          !Block 6   
 2859:             !====================================
 2860:                     ff=0
 2861:    .       600      ff=ff+1
 2862:    .           k6=dint(k5/y(ff))
 2863:    .           if((k6.lt.1).or.(ff.eq.ee))goto 500
 2864:    .           scomb=scomb+1
 2865:    .           if(k6.lt.1)then
 2866:                sr1=sr1 !-1
 2867:                sr2=sr2
 2868:                else
 2869:    .               numc=numc+1;sumn=sumn+k6
 2870:    .               sr1=sr1-k6
 2871:    .               sr2=sr1
 2872:    .          if(flag5.eq.1)then
 2873:    .          if (k6.lt.11)then
 2874:    .           sr1=sr1-1+k6
 2875:                sost=1
 2876:    .           else 
 2877:    .           c=k6
 2878:    .        call reduce(c,c2)
 2879:    .              sost=c2
 2880:    .              sr1=sr1 - sost+k6
 2881:                   end if
 2882:                   end if
 2883:    .         if (key2.eq.0)then    
 2884:    .              write(*,23)numc,y(aa)*y(bb)*y(cc)*y(dd)*y(ee)*y(ff),sr1,-k6,-sost 
 2885:    .              write(7,23)numc,y(aa)*y(bb)*y(cc)*y(dd)*y(ee)*y(ff),sr1,-k6,-sost 
 2886:    .              sost=0
 2887:    .              rr=0;call riga(numc,rr)
 2888:    .         if(rr.eq.1)return
 2889:                  end if
 2890:          end if
 2891:          !Block 7  
 2892:             !====================================
 2893:                      gg=0
 2894:    .       700       gg=gg+1
 2895:    .           k7=dint(k6/y(gg))
 2896:    .           if((k7.lt.1).or.(gg.eq.ff))goto 600
 2897:    .           scomb=scomb+1
 2898:    .           if(k7.lt.1)then
 2899:                sr1=sr1 !+1
 2900:                sr2=sr2
 2901:                else
 2902:    .               numc=numc+1;sump=sump+k7
 2903:    .               sr1=sr1+k7
 2904:    .               sr2=sr1
 2905:    .          if(flag5.eq.1)then
 2906:               
 2907:    .          if (k7.lt.11)then
 2908:    .           sr1=sr1+1-k7
 2909:                sost=1
 2910:    .           else 
 2911:    .           c=k7
 2912:    .        call reduce(c,c2)
 2913:    .              sost=c2
 2914:    .              sr1=sr1 + sost-k7
 2915:                   end if
 2916:                   end if
 2917:    .            if (key2.eq.0)then     
 2918:    .               write(*,23)numc,y(aa)*y(bb)*y(cc)*y(dd)*y(ee)*y(ff)*y(gg),sr1 ,k7,sost
 2919:    .               write(7,23)numc,y(aa)*y(bb)*y(cc)*y(dd)*y(ee)*y(ff)*y(gg),sr1,k7,sost
 2920:    .               sost=0
 2921:    .           rr=0;call riga(numc,rr)
 2922:    .         if(rr.eq.1)return
 2923:                     end if
 2924:                     end if
 2925:          !Block 8   
 2926:             !====================================
 2927:                   hh=0
 2928:    .     800      hh=hh+1
 2929:    .           k8=dint(k7/y(hh))
 2930:    .           if((k8.lt.1).or.(hh.eq.hh))goto 700
 2931:    .           scomb=scomb+1
 2932:    .           if(k8.lt.1)then
 2933:                sr1=sr1 !-1
 2934:                else
 2935:    .               numc=numc+1;sumn=sumn+k8
 2936:    .               sr1=sr1-k8 
 2937:    .         if (key2.eq.0)then    
 2938:    .             write(*,23)numc,y(aa)*y(bb)*y(cc)*y(dd)*y(ee)*y(ff)*y(gg)*y(hh) ,sr1,-k8 
 2939:    .             write(7,23)numc,y(aa)*y(bb)*y(cc)*y(dd)*y(ee)*y(ff)*y(gg)*y(hh) ,sr1,-k8 
 2940:    .             rr=0;call riga(numc,rr)
 2941:    .         if(rr.eq.1)return
 2942:                  end if
 2943:                  end if
 2944:          !Block 9   
 2945:             !====================================
 2946:                     ii=0
 2947:    .       900      ii=ii+1
 2948:    .           k9=dint(k8/y(ii))      
 2949:    .           if((k9.lt.1).or.(ii.eq.hh))goto 800
 2950:    .           scomb=scomb+1
 2951:    .           if(k9.lt.1)then
 2952:                sr1=sr1 !+1
 2953:                else
 2954:    .               numc=numc+1;sump=sump+k9
 2955:    .               sr1=sr1+k9 
 2956:    .         if (key2.eq.0)then    
 2957:    .             write(*,23)numc,y(aa)*y(bb)*y(cc)*y(dd)*y(ee)*y(ff)*y(gg)*y(hh)*y(ii),sr1,k9 
 2958:    .             write(7,23)numc,y(aa)*y(bb)*y(cc)*y(dd)*y(ee)*y(ff)*y(gg)*y(hh)*y(ii),sr1,k9 
 2959:    .             rr=0;call riga(numc,rr)
 2960:    .         if(rr.eq.1)return
 2961:              end if
 2962:              end if
 2963:           !Block 10   
 2964:             !====================================
 2965:                    ll=0
 2966:    .      910      ll=ll+1
 2967:                k10=k9/y(ll)
 2968:    .           if((k10.lt.1).or.(ll.eq.ii))goto 900
 2969:    .           scomb=scomb+1
 2970:    .           if (k10.lt.1)then
 2971:                sr1=sr1 !-1
 2972:                else
 2973:    .               numc=numc+1;sumn=sumn+k10
 2974:    .               sr1=sr1-k10 
 2975:    .         if (key2.eq.0)then    
 2976:    .             write(*,23)numc,k/k10   ,sr1,-k10 
 2977:    .             write(7,23)numc,k/k10   ,sr1,-k10 
 2978:    .         rr=0;call riga(numc,rr)
 2979:    .         if(rr.eq.1)return
 2980:              end if
 2981:              end if
 2982:            !Block 11      
 2983:            !====================================
 2984:    .                mm=0
 2985:    .       911      mm=mm+1
 2986:    .           k11=k10/y(mm)
 2987:    .           if((k11.lt.1).or.(mm.eq.ll))goto 910
 2988:    .               scomb=scomb+1
 2989:    .               numc=numc+1;sump=sump+k11
 2990:                    sr1=sr1+k11
 2991:    .           if (key2.eq.0)then      
 2992:    .                 write(*,23)numc,k/k11   ,sr1,k11 
 2993:    .                 write(7,23)numc,k/k11   ,sr1,k11 
 2994:    .                 rr=0;call riga(numc,rr)
 2995:    .         if(rr.eq.1)return
 2996:                 end if
 2997:              goto 911
 2998:    .     11220 park1=sr1
 2999:    .        if (flag5.eq.0)then
 3000:          
 3001:    .        write(*,26)'sr1 =totalizer of multiples          ',park1
 3002:    .        write(7,26)'sr1  = totalizer of multiples         ',park1 
 3003:    .         write(*,10)' negative and positive results                                    ' ,sumn,sump
 3004:    .         write(7,10)'negative and positive results                                      ' ,sumn,sump
 3005:    .         write(*,10)'Number of combinations                                         ', scomb
 3006:    .         write(7,10)'Number of combinations                                         ', scomb
 3007:    .          park1=k
 3008:    .          write(*,26)'N and number of primes calculated    ',park1,park1-sr1+z11-1
 3009:    .          write(7,26)'N and number of primes calculated    ',park1,park1-sr1+z11-1
 3010:          
 3011:    .          if(k.le.2000000) then
 3012:    .          pr =k
 3013:    .          call cerca(pr,y)
 3014:    .          park1=pr
 3015:    .          write(*,26)'with binary search                   ',park1
 3016:    .          write(7,26)'with binary search                   ',park1
 3017:    .          write(*,10)' sum of positive and negative results                          ',sumn+sump
 3018:    .          write(7,10)' sumn of positive and negative results                         ',sumn+sump
 3019:                   end if
 3020:    .          call endline
 3021:               end if
 3022:    .          pause
 3023:    .          pause
 3024:    .          if(flag5.eq.1)then
 3025:    .           c=k
 3026:    .              call reduce(c,c2)
 3027:    .              sost=c2
 3028:    .              numc1=sr1
 3029:    .              numc2=k
 3030:    .          write(*,10)'reduce of N -sr1+z11+4-1 =                            ',sost-numc1+z11+4-1
 3031:    .          write(7,10)'reduce of N -sr1+z11+4-1 =                           ',sost-numc1+z11+4-1
 3032:    .         write(7,10)'N,reduced,sr1,z11  =  ',numc2,sost,numc1,z11     
 3033:    .         write(*,10)'N,reduced,sr1,z11  =  ',numc2,sost,numc1,z11     
 3034:                end if
 3035:    .          write(7,7)'end inclusion exclusion method                   '
 3036:    .          call endline
 3037:    .          end subroutine inclusion
 3038:             !==============================================  
 3039:          !start reverse method
 3040:          !==================================
 3041:    .      Subroutine reverse(y,flag1,flag2,flag3,flag4,flag5,a1,a2,a3,a4,a5,a6,key1,key3,second,numc,resto,resto1,resto2)
 3042:          implicit none   
 3043:          real*8 aa,bb,cc,dd,ee,ff,gg,hh,ii
 3044:          real*8 a0111(15000),a1(15000),a2(15000),a3(15000),a0222(15000),a4(15000),a5(15000),a6(15000)
 3045:          real*8 z2,park,park2,park1,s1
 3046:          real*8 k ,k1,k2,k3,k4,k5,k6,k7,k8,k9
 3047:          integer*4 y(149000),sump,sumn,numc,sets(300),scelta,pr
 3048:           integer*4 c2,sost,flag5,c,numc1,numc2,key2,flag1
 3049:           integer*4 flag2,flag3,flag4,rr,phi1,resto2
 3050:           integer*4 e3,e4,e5,e6,e2,numc3,resto1,resto,second,key1,key3
 3051:            3 format(1X,a3,I10,a3,I10,a3,I10,a3,I10,a3,I10,a3,I10,a3,I10)
 3052:            4 format(1X,a7)
 3053:            5 format(1X,a75)
 3054:            6 format(1X,a60)
 3055:            7 format(1x,a45)
 3056:            8 format(a1)
 3057:            9 Format(8I7)
 3058:            10 format(a45,4I10)
 3059:            21 format(4F10.0)
 3060:            23 format(2I9,2F9.0,1I9)
 3061:            24 format(1I9,1F12.3,1I8,1F10.0,1F10.0,1I10 )
 3062:            25 format(a6,1F10.0,a20,1I10,a3,2I10  )
 3063:            26 format(1X,a40,2F11.0)
 3064:            28 format(a20,1I9,a20,1I9)
 3065:            29 format(1x,20I5)
 3066:    .     4999   scelta=0;a0111=0        
 3067:    .      print*,'calculate Phi(N) with reverse method'
 3068:    .      write(7,7)'calculate Phi(N) with reverse method for N ='
 3069:    .      call control(scelta)
 3070:    .      k=scelta
 3071:    .       write(7,21)k
 3072:          
 3073:    .      Print*,'Print all data enter 0 part of data enter 1'
 3074:    .      write(7,5)'Print all data enter 0 part of data enter 1'
 3075:    .     call control(scelta)
 3076:    .      key2=scelta
 3077:    .        write(7,9)key2
 3078:    .        z2= SQRT( k) 
 3079:    .        pr=z2
 3080:    .       call cerca(pr,y)
 3081:    .         z2=pr 
 3082:              numc=0;sump=0;sumn=0;phi1=0
 3083:    .         rr=z2
 3084:    .         pause
 3085:    .            s1=0 ;sets=0;park1=0
 3086:    .            a0111(0)=k
 3087:           !block 1
 3088:           !===============================
 3089:          
 3090:    .      140     aa=0; ! write(7,21)k
 3091:    .       write(7,26)'___________                       '                              
 3092:    .       if(key2.eq.0)then
 3093:    .     write(7,5)'column 1 = sequential number of calculations for each block                                      '
 3094:    .     write(7,5)'column 2 = result of succesive division;k1,k2,k3 etc                           '
 3095:    .     write(7,5)'column 3 = prime relevamt to the block under calculation;y(aa),y(bb)...       '
 3096:    .     write(7,5)'column 4 = Phi(N) of N/combination - Phi(N) of one primes before last           ' 
 3097:    .     write(7,5)'column 5 = sequential total of column 4                                         '
 3098:    .     write(7,5)'column 6 = Combinations obtained by succesive divisions                                         '
 3099:    .     write(7,5)'NOTE:N/K1,K2..  may be called combimations,the elements are primes               '
 3100:    .     write(7,5)'NOTE:each prime up to sqrt of N is elaborated,when complete its set             '
 3101:    .     write(7,5)'     and subtotals are printed                                                  '
 3102:    .     write(7,6)'      1        2         3         4         5          6                  '
 3103:    .     write(7,6)'________________________________________________________            '
 3104:           end if
 3105:    .     150     aa=aa+1 !element 1
 3106:    .           sets(aa)=s1-park1
 3107:    .         if((aa-1).ne.0)then
 3108:    .         write(*,25)'set N',aa-1,' relevant to prine ',y(aa-1),' = ',sets(aa),numc
 3109:    .         write(7,25)'set N',aa-1,' relevant to prime ',y(aa-1),' = ',sets(aa),numc
 3110:    .         call endline 
 3111:    .          pause
 3112:            end if
 3113:    .       park1=s1
 3114:    .         if (z2.lt.aa)goto 5000 ! goto finish
 3115:    .         k1=k/y(aa)
 3116:    .           pr=k1
 3117:    .           call cerca(pr,y)
 3118:    .           s1=s1+pr-aa+1
 3119:                numc=numc+1
 3120:    .         a0111(numc)=pr-aa+1
 3121:    .         a0222(numc)=(k/k1)
 3122:    .     if (key2.eq.0)then
 3123:    .         write(*,24)numc,k1,y(aa),pr-aa+1,s1,idnint(a0222(numc))
 3124:    .         write(7,24)numc,k1,y(aa),pr-aa+1,s1,idnint(a0222(numc))
 3125:    .         write(*,7)'--------------------------             '
 3126:    .         write(7,7)'--------------------------             '
 3127:              
 3128:    .         rr=0;call riga(numc,rr)
 3129:    .         if(rr.eq.1)return
 3130:               end if
 3131:             goto 240 !!Go to element 2 ---->
 3132:           !------------------------------------------
 3133:    .     160 park2=k1;  k1=k1/y(aa) !power element 1^
 3134:    .          park=sqrt(park2)
 3135:    .          if(park.lt.y(aa))then
 3136:    .          phi1=phi1+1
 3137:    .          goto 150
 3138:               end if
 3139:              !  if(k1.lt.y(aa)) goto 150 !go to element 1->
 3140:    .           pr=k1
 3141:    .           call cerca(pr,y)       
 3142:    .           s1=s1+pr-aa+1
 3143:                 numc=numc+1
 3144:    .            a0111(numc)=pr-aa+1
 3145:    .            a0222(numc)=(k/k1)
 3146:    .        if (key2.eq.0)then
 3147:    .         write(*,24)numc,k1,y(aa),pr-aa+1,s1,idnint(a0222(numc))
 3148:    .         write(7,24)numc,k1,y(aa),pr-aa+1,s1,idnint(a0222(numc)) ! ,park
 3149:    .         write(*,7)'--------------------------             '
 3150:    .         write(7,7)'--------------------------             '
 3151:    .            rr=0;call riga(numc,rr)
 3152:    .         if(rr.eq.1)return
 3153:    .           end if
 3154:          !Block 2
 3155:          !================================
 3156:    .     240  bb=aa !element 2
 3157:    .     250  bb=bb+1
 3158:    .           k2=k1/y(bb)
 3159:    .           park=sqrt(k1)
 3160:    .           if(park.lt.y(bb))then
 3161:    .           phi1=phi1+1
 3162:                goto 160
 3163:                end if
 3164:               ! if (k2.lt.y(bb)) goto 160 ! goto power element 1 ^
 3165:    .           pr=k2
 3166:    .           call cerca(pr,y)
 3167:    .           s1=s1+pr-bb+1
 3168:                 numc=numc+1
 3169:                 e2=1
 3170:    .            a0111(numc)=pr-bb+1
 3171:    .            a0222(numc)=(k/k2)
 3172:    .     if (key2.eq.0)then
 3173:    .         write(*,24)numc,k2,y(bb),pr-bb+1,s1,idnint(a0222(numc))
 3174:    .         write(7,24)numc,k2,y(bb),pr-bb+1,s1,idnint(a0222(numc)) ! ,park
 3175:    .         write(*,7)'--------------------------             '
 3176:    .         write(7,7)'--------------------------             '
 3177:    .          rr=0;call riga(numc,rr)
 3178:    .         if(rr.eq.1)return
 3179:                end if
 3180:                goto 340   !goto element 3
 3181:           !--------------------------
 3182:    .     260 park2=k2;   k2=k2/y(bb)! power element 2^^
 3183:    .     park=sqrt(park2)
 3184:    .          if(park.lt.y(bb))then
 3185:    .          phi1=phi1+1
 3186:    .          goto 250
 3187:               end if
 3188:           !   if( k2.lt.y(bb)) goto 250  !goto element 2
 3189:    .           pr=k2
 3190:    .           call cerca(pr,y)
 3191:    .            s1=s1+pr-bb+1
 3192:                 numc=numc+1
 3193:                 e2=e2+1
 3194:    .            a0111(numc)=pr-bb+1
 3195:    .            a0222(numc)=k/k2
 3196:    .         if (key2.eq.0)then
 3197:    .      write(*,24)numc,k2,y(bb),pr-bb+1,s1,idnint(a0222(numc))
 3198:    .      write(7,24)numc,k2,y(bb),pr-bb+1,s1,idnint(a0222(numc)) !,park
 3199:    .      write(*,7)'--------------------------             '
 3200:    .      write(7,7)'--------------------------             '
 3201:    .           rr=0;call riga(numc,rr)
 3202:    .         if(rr.eq.1)return
 3203:    .       end if
 3204:           !Block 3
 3205:           !=================================
 3206:    .      340  cc=bb ! element 3
 3207:    .      350 cc=cc+1
 3208:    .           k3=k2/y(cc)
 3209:    .           park=sqrt(k2)
 3210:    .           if(park.lt.y(cc))then
 3211:    .           phi1=phi1+1
 3212:                goto 260
 3213:                end if
 3214:           !    if(k3.lt.y(cc))goto 260 ! goto power element 2
 3215:    .           pr=k3
 3216:    .           call cerca(pr,y)
 3217:    .           s1=s1+pr-cc+1
 3218:                numc=numc+1
 3219:                e3=1
 3220:    .                 a0111(numc)=pr-cc+1
 3221:    .                 a0222(numc)=(k/k3)
 3222:    .      if (key2.eq.0)then
 3223:    .         write(*,24)numc,k3,y(cc),pr-cc+1,s1,idnint(a0222(numc))
 3224:    .         write(7,24)numc,k3,y(cc),pr-cc+1,s1,idnint(a0222(numc))
 3225:    .         write(*,7)'--------------------------             '
 3226:    .         write(7,7)'--------------------------             '
 3227:    .            rr=0;call riga(numc,rr)
 3228:    .         if(rr.eq.1)return
 3229:                end if
 3230:                goto 440   !goto elemennt 4
 3231:           !----------------------------
 3232:    .     360 park2=k3; k3=k3/y(cc)! power element 3^^^
 3233:    .            park=sqrt(park2)
 3234:    .          if(park.lt.y(cc))then
 3235:    .          phi1=phi1+1
 3236:    .          goto 350
 3237:               end if
 3238:           !   if(k3.lt.y(cc)) goto 350  !goto element 3
 3239:    .            pr=k3
 3240:    .            call cerca(pr,y)
 3241:    .            s1=s1+pr-cc+1
 3242:               numc=numc+1
 3243:               e3=e3+1
 3244:    .                 a0111(numc)=pr-cc+1
 3245:    .                 a0222(numc)=(k/k3)
 3246:    .          if (key2.eq.0)then
 3247:    .         write(*,24)numc,k3,y(cc),pr-cc+1,s1,idnint(a0222(numc))
 3248:    .         write(7,24)numc,k3,y(cc),pr-cc+1,s1,idnint(a0222(numc))
 3249:    .         write(*,7)'--------------------------             '
 3250:    .         write(7,7)'--------------------------             '
 3251:    .           rr=0;call riga(numc,rr)
 3252:    .         if(rr.eq.1)return
 3253:    .           end if
 3254:            !Block 4
 3255:           !===================================
 3256:    .      440 dd=cc  ! element 4
 3257:    .      450 dd=dd+1
 3258:    .           k4=k3/y(dd)
 3259:    .           park=sqrt(k3)
 3260:    .         if(park.lt.y(dd))then
 3261:    .           phi1=phi1+1
 3262:                goto 360
 3263:                end if
 3264:            !   if(k4.lt.y(dd) )goto 360  !goto power element 3^^^
 3265:    .           pr=k4
 3266:    .           call cerca(pr,y)
 3267:    .           s1=s1+pr-dd+1
 3268:                numc=numc+1
 3269:                e4=1
 3270:    .                 a0111(numc)=pr-dd+1
 3271:    .                 a0222(numc)=(k/k4)
 3272:    .             if (key2.eq.0)then
 3273:    .         write(*,24)numc,k4,y(dd),pr-dd+1,s1,idnint(a0222(numc))
 3274:    .         write(7,24)numc,k4,y(dd),pr-dd+1,s1,idnint(a0222(numc))
 3275:    .         write(*,7)'--------------------------             '
 3276:    .         write(7,7)'--------------------------             '
 3277:    .           rr=0;call riga(numc,rr)
 3278:    .         if(rr.eq.1)return
 3279:               end if
 3280:          goto 540     ! goto element 5
 3281:           !----------------------------
 3282:    .     460 park2=k4; k4=k4/y(dd) !power element 4^^^^
 3283:    .     park=sqrt(park2)
 3284:    .          if(park.lt.y(dd))then
 3285:    .          phi1=phi1+1
 3286:    .          goto 450
 3287:               end if
 3288:           !   if(k4.lt.y(dd))goto 450 !goto element 4
 3289:    .           pr=k4
 3290:    .           call cerca(pr,y)
 3291:    .           s1=s1+pr-dd+1
 3292:                 numc=numc+1
 3293:                 e4=e4+1
 3294:    .             a0111(numc)=pr-dd+1
 3295:    .             a0222(numc)=(k/k4)
 3296:    .           if (key2.eq.0)then
 3297:    .         write(*,24)numc,k4,y(dd),pr-dd+1,s1,idnint(a0222(numc))
 3298:    .         write(7,24)numc,k4,y(dd),pr-dd+1,s1,idnint(a0222(numc))
 3299:    .         write(*,7)'--------------------------             '
 3300:    .         write(7,7)'--------------------------             '
 3301:    .           rr=0;call riga(numc,rr)
 3302:    .         if(rr.eq.1)return
 3303:    .        end if
 3304:          ! Block 5          
 3305:          !==================================
 3306:    .      540 ee=dd   ! element 5
 3307:    .      550 ee=ee+1
 3308:    .            k5=k4/y(ee)
 3309:    .            park=sqrt(k4)
 3310:    .           if(park.lt.y(ee))then
 3311:    .           phi1=phi1+1
 3312:                goto 460
 3313:                end if
 3314:             !  if(k5.lt.y(ee))goto 460 !goto power elenebr 4^^^^
 3315:    .           pr=k5
 3316:    .           call cerca(pr,y)
 3317:    .           s1=s1+pr-ee+1
 3318:                numc=numc+1
 3319:                e5=1
 3320:    .            a0111(numc)=pr-ee+1
 3321:    .           a0222(numc)=(k/k5)
 3322:    .             if (key2.eq.0)then
 3323:    .             write(*,24)numc,k5,y(ee),pr-ee+1,s1,idnint(a0222(numc))
 3324:    .             write(7,24)numc,k5,y(ee),pr-ee+1,s1,idnint(a0222(numc))
 3325:    .             write(*,7)'--------------------------             '
 3326:    .             write(7,7)'--------------------------             '
 3327:    .            rr=0;call riga(numc,rr)
 3328:    .         if(rr.eq.1)return
 3329:                 end if
 3330:                 goto 640   ! goto element 6
 3331:          !--------------------------------      
 3332:    .     560 park2=k5; k5=k5/y(ee) ! power of element5^^^^^
 3333:    .     park=sqrt(park2)
 3334:    .          if(park.lt.y(ee))then
 3335:    .          phi1=phi1+1
 3336:    .          goto 550
 3337:               end if
 3338:              !if(k5.lt.y(ee))    goto 550 ! goto element 5
 3339:    .            pr=k5
 3340:    .           call cerca(pr,y)
 3341:    .           s1=s1+pr-ee+1 
 3342:                 numc=numc+1
 3343:                 e5=e5+1
 3344:    .             a0111(numc)=pr-ee+1
 3345:    .             a0222(numc)=(k/k5)
 3346:    .           if (key2.eq.0)then
 3347:    .             write(*,24)numc,k5,y(ee),pr-ee+1,s1,idnint(a0222(numc))
 3348:    .             write(7,24)numc,k5,y(ee),pr-ee+1,s1 ,idnint(a0222(numc))
 3349:    .             write(*,7)'--------------------------             '
 3350:    .             write(7,7)'--------------------------             '
 3351:    .            rr=0;call riga(numc,rr)
 3352:    .         if(rr.eq.1)return
 3353:    .          end if
 3354:          !Block 6     
 3355:          !==================================
 3356:    .     640   ff=ee   !element 6
 3357:    .     650 ff=ff+1
 3358:    .           k6=k5/y(ff)
 3359:    .            park=sqrt(k5)
 3360:    .           if(park.lt.y(ff))then
 3361:    .           phi1=phi1+1
 3362:                goto 560
 3363:                end if
 3364:            !   if(k6.lt.y(ff))goto 560 !goto power element 5^^^^
 3365:    .           pr=k6
 3366:    .           call cerca(pr,y)
 3367:    .           s1=s1+pr-ff+1
 3368:                numc=numc+1
 3369:                e6=1
 3370:    .            a0111(numc)=pr-ff+1
 3371:    .            a0222(numc)=(k/k6)
 3372:    .         if (key2.eq.0)then
 3373:    .           write(*,24)numc,k6,y(ff),pr-ff+1,s1,idnint(a0222(numc))
 3374:    .           write(7,24)numc,k6,y(ff),pr-ff+1,s1,idnint(a0222(numc))
 3375:    .           write(*,7)'--------------------------             '
 3376:    .           write(7,7)'--------------------------             '
 3377:    .            rr=0;call riga(numc,rr)
 3378:    .         if(rr.eq.1)return
 3379:              end if
 3380:              goto 740      ! goto element 7
 3381:          !--------------------------------      
 3382:    .      660 park2=k6;  k6=k6/y(ff) ! power of element 6^^^^^
 3383:    .      park=sqrt(park2)
 3384:    .          if(park.lt.y(ff))then
 3385:    .          phi1=phi1+1
 3386:    .          goto 650
 3387:               end if
 3388:              !if(k6.lt.y(ff))    goto 650 ! goto element 6
 3389:    .            pr=k6
 3390:    .           call cerca(pr,y)
 3391:    .           s1=s1+pr-ff+1
 3392:                numc=NUMC+1
 3393:                e6=e6+1
 3394:    .           a0111(numc)=pr-ff+1
 3395:    .           a0222(numc)=(k/k6)
 3396:    .     if (key2.eq.0)then
 3397:    .           write(*,24)numc,k6,y(ff),pr-ff+1,s1,idnint(a0222(numc))
 3398:    .           write(7,24)numc,k6,y(ff),pr-ff+1,s1,idnint(a0222(numc))
 3399:    .           write(*,7)'--------------------------             '
 3400:    .           write(7,7)'--------------------------             '
 3401:    .            rr=0;call riga(numc,rr)
 3402:    .         if(rr.eq.1)return
 3403:    .         end if
 3404:           !Block 7
 3405:          !============================
 3406:    .      740  gg=ff  ! element 7
 3407:    .      750  gg=gg+1
 3408:    .       k7=k6/y(gg)
 3409:    .        park=sqrt(k6)
 3410:    .     if(park.lt.y(gg))then
 3411:    .           phi1=phi1+1
 3412:                goto 660
 3413:                end if
 3414:             !  if(k7.lt.y(gg))goto 660 !goto power elenebr 6^^^^
 3415:    .           pr=k7
 3416:    .           call cerca(pr,y)
 3417:    .           s1=s1+pr-gg+1
 3418:                NUMC=numc+1
 3419:    .           a0111(numc)=pr-gg+1
 3420:    .           a0222(numc)=(k/k7)
 3421:    .         if (key2.eq.0)then
 3422:    .          write(*,24)numc,k7,y(gg),pr-gg+1,s1,idnint(a0222(numc))
 3423:    .          write(7,24)numc,k7,y(gg),pr-gg+1,s1,idnint(a0222(numc))
 3424:    .          write(*,7)'--------------------------              '
 3425:    .          write(7,7)'--------------------------              '
 3426:    .            rr=0;call riga(numc,rr)
 3427:    .         if(rr.eq.1)return
 3428:                end if
 3429:                goto 840   !goto element 8
 3430:          !     ---------------------------      
 3431:    .      760 park2=k7;  k7=k7/y(gg) ! power of element 7^^^^^
 3432:    .      park=sqrt(park2)
 3433:    .          if(park.lt.y(gg))then
 3434:    .          phi1=phi1+1
 3435:    .          goto 750
 3436:               end if
 3437:              !if(k7.lt.y(gg))    goto 750 ! goto element 7
 3438:    .            pr=k7
 3439:    .           call cerca(pr,y)
 3440:    .           s1=s1+pr-gg+1
 3441:                numc=numc+1
 3442:    .           a0111(numc)=pr-gg+1
 3443:    .           a0222(numc)=(k/k7)
 3444:    .         if (key2.eq.0)then    
 3445:    .     write(*,24)numc,k7,y(gg),pr-gg+1,s1,idnint(a0222(numc))
 3446:    .     write(7,24)numc,k7,y(gg),pr-gg+1,s1,idnint(a0222(numc))
 3447:    .            rr=0;call riga(numc,rr)
 3448:    .         if(rr.eq.1)return
 3449:    .         end if
 3450:          ! Block 8        
 3451:          !===================================
 3452:    .        840 hh=gg !  element 8
 3453:    .        850   hh=hh+1
 3454:    .           k8=k7/y(hh)
 3455:    .            park=sqrt(k7)
 3456:    .           if(park.lt.y(hh))goto 760
 3457:              !  if(k8.lt.y(hh))goto 760 !goto power elenent 7^^^^
 3458:    .           pr=k8
 3459:    .           call cerca(pr,y)
 3460:    .           s1=s1+pr-hh+1
 3461:                numc=numc+1
 3462:    .           a0111(numc)=pr-hh+1
 3463:    .           a0222(numc)=(k/k8)
 3464:    .          if (key2.eq.0)then   
 3465:    .            write(*,24)numc,k8,y(hh),k/k8,pr-hh+1,s1,idnint(a0222(numc))
 3466:    .            write(7,24)numc,k8,y(hh),k/k8,pr-hh+1,s1 ,idnint(a0222(numc))
 3467:    .            rr=0;call riga(numc,rr)
 3468:    .         if(rr.eq.1)return
 3469:                 end if
 3470:                 goto 940    !go to element 9
 3471:            !----------------
 3472:    .        860 park2=k8;  k8=k8/y(hh) ! power of element 8^^^^^
 3473:    .      park=sqrt(park2)
 3474:    .          if(park.lt.y(hh))goto 850
 3475:               !if(k8.lt.y(hh))   goto 850 ! goto element 8
 3476:    .            pr=k8
 3477:    .           call cerca(pr,y)
 3478:    .           s1=s1+pr-hh+1
 3479:                numc=numc+1
 3480:    .           a0111(numc)=pr-hh+1
 3481:    .           a0222(numc)=(k/k8)
 3482:    .         if (key2.eq.0)then    
 3483:    .          write(*,24)numc,k8,y(hh),k/k8,pr-hh+1,s1,idnint(a0222(numc))
 3484:    .          write(7,24)numc,k8,y(hh),k/k8,pr-hh+1,s1,idnint(a0222(numc))
 3485:    .           end if
 3486:           !Block 9            
 3487:          !===== ==========================
 3488:    .       940 ii=hh          !element 9
 3489:    .       950 ii=ii+1
 3490:    .           k9=k8/y(ii)
 3491:    .            park=sqrt(k8)
 3492:    .           if(park.lt.y(ii))goto 860
 3493:                !if(k9.lt.y(ii))goto 860 !goto power elenent 8^^^^
 3494:    .           pr=k9
 3495:    .           call cerca(pr,y)
 3496:    .           s1=s1+pr-ii+1
 3497:                numc=numc+1
 3498:    .           a0111(numc)=pr-ii+1
 3499:    .           a0222(numc)=(k/k9)
 3500:    .         if (key2.eq.0)then    
 3501:    .                write(*,24)numc,k9,y(ii),k/k9,pr-ii+1,s1,idnint(a0222(numc))
 3502:    .                write(7,24)numc,k9,y(ii),k/k9,pr-ii+1,s1,idnint(a0222(numc))
 3503:                     end if
 3504:    .           goto 950
 3505:            !----------------
 3506:          !ok show final data
 3507:          !-------------------------------------------
 3508:    .     5000 if (flag5.eq.0)then
 3509:    .     write(*,26)'total =  ',s1
 3510:    .      write(7,26)'final data for this number                         '
 3511:    .      write(7,26)'total of column 5 or total of sets =        ',s1 
 3512:    .      write(*,26)'primes to  ',k,k-s1-1
 3513:    .      write(7,26)'primes to                                   ',k,k-s1-1
 3514:           end if
 3515:    .      a0111(numc+1)=k-s1-1
 3516:    .      pr =k
 3517:    .          call cerca(pr,y)
 3518:    .          print*,'with binary search ',pr
 3519:    .          park1=pr
 3520:    .          write(7,26)'with binary search                      ',park1
 3521:    .          print*,'negative jumps',phi1
 3522:    .          park1=phi1
 3523:    .          write(7,26)'NOT events(negative jumps)                                  ',park1
 3524:    .          write(7,10)'YES events(positive jumps)conbi                             ',numc
 3525:             !======================== 
 3526:    .         if(flag5.eq.1)then
 3527:    .           call endline
 3528:    .              c=k
 3529:    .              call reduce(c,c2)
 3530:    .              sost=c2
 3531:    .              numc1=s1
 3532:    .              numc2=k
 3533:    .              numc3=z2
 3534:    .         write(*,10)'reduce of N -s1-1+4 (primes to N)=                            ',sost-numc1-1+4
 3535:    .         write(7,10)'reduce of N -s1-1+4(primes to N) =                           ',sost-numc1-1+4
 3536:    .         write(7,10)' z2(primes in vector to sqrt(N) =                                         ',numc3
 3537:    .         write(7,10)'N,reduced,s1,z2  =                    ',numc2,sost,numc1,numc3   
 3538:    .         call endline     
 3539:                   end if
 3540:    .       if(flag1.eq.0)then
 3541:    .         call endline
 3542:    .          return
 3543:               end if
 3544:    .          write(7,7)'end reverse method                            ' 
 3545:    .          call endline
 3546:               !========================
 3547:               !end reverse method 
 3548:               !================================================
 3549:          
 3550:               !''''''''''''
 3551:          !preparing vectors a1,a4 for table
 3552:    .          if (flag2.eq.1)then
 3553:    .            a1=a0111;a4=a0222
 3554:    .            key1=numc
 3555:    .            resto=k
 3556:    .            a1(0)=k;a0111(0)=k
 3557:    .            return
 3558:                 end if
 3559:           !''''''''''''''''
 3560:           !preparing vectors a2,a5 for table
 3561:    .          if(flag3.eq.1)then
 3562:    .           a2=a0111 ;a5=a0222;second=numc
 3563:    .           resto2=k  
 3564:    .           a2(0)=k;a0111(0)=k
 3565:    .           a2(numc+2)=second
 3566:    .           return
 3567:                end if
 3568:           !'''''''''''''''''''''
 3569:            !preparing vectors a3,a6 for table
 3570:    .          if(flag4.eq.1)then
 3571:    .           a3=a0111  ;a6=a0222;key3=numc
 3572:    .           a3(0)=k;a0111(0)=k
 3573:    .           resto1=k
 3574:                return
 3575:                end if 
 3576:    .     end Subroutine reverse
 3577:          !=================================
 3578:          !end reverse method when preparing data for triplets table
 3579:          !=============================
 3580:    .      subroutine  goldbach1(y)
 3581:           Use Msflib
 3582:           implicit none
 3583:          real*8 n1,part1,part2,part3,part4,part5,part6,part7,prodotto
 3584:          real*8 park2,park1
 3585:          real*8 k 
 3586:          Integer*4 compo(375000),mixed2,conta1,phi3,phi2
 3587:          integer*4 numc1,toto1,toto2,toto3,toto5
 3588:          integer*4 salvac,salvam,mixed1,delta
 3589:          integer*4 rr,conta,s ,numc2,numc5,incre,w
 3590:          integer*4 n,j,i,pr ,scelta,z,compo1
 3591:          integer*4 y(149000),numc
 3592:          character*1 ch
 3593:           3 format(1X,a3,I10,a3,I10,a3,I10,a3,I10,a3,I10,a3,I10,a3,I10)
 3594:           4 format(1X,a7)
 3595:           5 format(1X,a75)
 3596:           6 format(1X,a60)
 3597:           7 format(1x,a45)
 3598:           8 format(1x,a1)
 3599:           9 Format(8I7)
 3600:          10 format(a45,5I10)
 3601:          26 format(1X,a40,2F11.0)
 3602:          28 format (1x,6I5)
 3603:          27 format(1I8,5F13.0)
 3604:    .     6430  write(*,*)' Even Number ? >10,<=2000000'
 3605:    .       call control(scelta)
 3606:    .       n=scelta
 3607:    .     write(7,26)'Calculate pairs for N=             '
 3608:    .     write(7,9)scelta
 3609:    .     write(7,26)'___________                       '                              
 3610:          
 3611:            
 3612:    .       n1=n-2
 3613:    .       park1=n
 3614:            park2=n1
 3615:              !============================================
 3616:              ! start summary of data for the number entered
 3617:              !===========================================
 3618:    .         do j=1,2
 3619:    .         pr=n
 3620:    .         call cerca(pr,y)
 3621:    .         phi3=pr
 3622:    .         part1=pr-1
 3623:    .         pr=n/2
 3624:    .         call cerca(pr,y)
 3625:    .         part2=pr-1
 3626:    .         part7=(part1-part2)*part2
 3627:    .         part3=((part2*part2)+part2)/2
 3628:              conta=n;toto1=0
 3629:    .         numc1=part1;numc2=part2
 3630:    .          if((n.lt.49).and. (j.eq.1))then
 3631:    .         print*,'scanning for  ',n
 3632:    .         write(7,10)'scanning for  ',n
 3633:              end if
 3634:    .         do i=numc2+2,numc1+1
 3635:    .         part5=conta-y(i)
 3636:    .         numc5=part5
 3637:    .         if(numc5 < 3)then
 3638:              goto 6531
 3639:              end if
 3640:    .         pr=part5
 3641:    .         call cerca(pr,y)
 3642:    .         toto1=toto1+(pr-1)
 3643:    .         if((n.lt.49).and. (j.eq.1))then
 3644:    .         print*,conta,y(i),conta -y(i),pr-1,toto1
 3645:    .         write(7,28) conta,y(i),conta -y(i),pr-1,toto1
 3646:              end if
 3647:              continue
 3648:          6531    end do
 3649:                !"   pause
 3650:    .        if(j.eq.1)then
 3651:    .     write(7,5)'column 1 = N and N-2                                                     '                                   
 3652:    .     write(7,5)'column 2 = ((x^2+x)/2) applied to Phi(N/2)-1 and Phi((N-2)/2)-1          '
 3653:    .     write(7,5)'column 3 = values for ((Phi(N/2)-1)*((Phi(N)-1)-Phi(N/2))                '                                                                             
 3654:    .     write(7,5)'column 4 = value of pairs found after N/2                                '
 3655:    .     write(7,5)'column 5 = values for column 2 + column 4                                '
 3656:    .     write(*,5)'column 1 = N and N-2                                                     '                                   
 3657:    .     write(*,5)'column 2 = ((x^2+x)/2) applied to Phi(N/2)-1 and Phi((N-2)/2)-1          '
 3658:    .     write(*,5)'column 3 = values for ((Phi(N/2)-1)*((Phi(N)-1)-Phi(N/2))                '                                                                             
 3659:    .     write(*,5)'column 4 = value of pairs found after N/2                                '
 3660:    .     write(*,5)'column 5 = values for column 2 + column 4                                '
 3661:                                                                                                          
 3662:    .     write(*,*)'_________________________________________'
 3663:    .     write(*,*)'   1              2           3           4            5         '
 3664:    .     write(7,5)'    1             2           3           4            5                       '
 3665:    .     write(7,5)'_____________________________________________________________                 '
 3666:    .            end if
 3667:    .         part6=part3+toto1
 3668:    .         part4=toto1
 3669:    .         write(*,27)n,part3,part7,part4,part6
 3670:    .         write(7,27)n,part3,part7,part4,part6
 3671:    .         if(j.eq.1)then
 3672:    .          toto2=part6
 3673:               end    if
 3674:    .          if(j.eq.2)then
 3675:    .          toto3=part6
 3676:               end    if
 3677:    .          n=n1
 3678:               continue 
 3679:               end do
 3680:    .          toto5=toto2-toto3
 3681:    .          n=n+2
 3682:               pr=n
 3683:    .         if(mod(pr,4).eq.0)then
 3684:    .         prodotto=((n/4)-1)
 3685:              end if
 3686:    .         if(mod(pr,4).ne.0)then
 3687:    .         prodotto=int(n/4)
 3688:    .         end if
 3689:    .         pr=n-3
 3690:    .          call cerca(pr,y)
 3691:    .          phi2=pr-1
 3692:               pr=n;j=0
 3693:    .          if(mod((pr),2).eq.0)then
 3694:    .          pr=pr/2
 3695:               phi3=pr
 3696:    .          call cerca(pr,y)
 3697:    .          if(y(pr).eq.phi3)then
 3698:    .          j=1 
 3699:               end if
 3700:               end if
 3701:    .          write(7,5)'_____________________________________________________________               '
 3702:    .          print*,'pairs of primes=difference of column 5',toto5
 3703:    .          write(7,10)'pairs of primes=delta of column 5             ',toto5
 3704:    .          print*,'pairs of mixed(see source)=              ',(phi2-((2*toto5)-j))
 3705:    .          write(7,10) 'pairs of mixed(see source)=                 ',(phi2-((2*toto5)-j))
 3706:    .          write(*,26)'pairs of conposites=                       ', prodotto-toto5-(phi2-((2*toto5)-j))
 3707:    .          write(7,26)'pairs of conposites=                       ', prodotto-toto5-(phi2-((2*toto5)-j))
 3708:    .          salvac= prodotto-toto5-(phi2-((2*toto5)-j))
 3709:    .          salvam=(phi2-((2*toto5)-j))
 3710:    .          write(*,26)'total pairs of odds(see source)                          ',prodotto
 3711:    .          write(7,26)'total pairs of odds(see source)                          ',prodotto
 3712:    .          write(7,7)'======================================================'
 3713:              !============================================
 3714:              ! end summary of data for the number entered
 3715:              !============================================
 3716:              !start list of pairs of primes
 3717:              !============================================
 3718:    .         pause
 3719:    .          write(*,*)   'do you want io see the pairs of primes ?  yes=(any key) or Not= n/N'
 3720:    .          ch = getcharqq()              !read (*,8) ch
 3721:    .          if((ch.eq.'N').or.(ch.eq.'n'))then
 3722:               return           
 3723:               end if
 3724:    .            pr=n;conta1=0
 3725:    .            pr=pr/2 ;j=1
 3726:    .            call cerca(pr,y)
 3727:    .            k=pr
 3728:    .            write(7,10)'pairs of primes for N=          '
 3729:    .            write(7,9)scelta
 3730:    .            do i=2,k
 3731:    .            s=n-y(i)
 3732:                 pr=s
 3733:    .            call cerca(pr,y)
 3734:    .            if (y(pr).eq.s)then
 3735:    .            conta1=conta1+1
 3736:    .            numc=conta1
 3737:    .            print*,conta1,y(pr),y(i)
 3738:    .            write(7,9)conta1,y(pr),y(i)
 3739:    .            rr=0;call riga(numc,rr)
 3740:    .            if(rr.eq.1)goto 6430
 3741:                 end if
 3742:                 continue
 3743:                 end do
 3744:    .            call endline
 3745:          !start list of pairs of mixed
 3746:          !===========================================
 3747:    .     pause 
 3748:    .     11233  write(*,*)   'do you want to see the pairs of mixed?  yes=(any key) or Not= n/N'
 3749:    .            ch = getcharqq()              !read (*,8) ch
 3750:    .            if((ch.eq.'N').or.(ch.eq.'n'))then
 3751:                 return
 3752:                 end if
 3753:    .            pr=n;conta1=0 ;z=0;compo=0
 3754:                 pr=pr ;j=1
 3755:    .            call cerca(pr,y)
 3756:    .            k=pr
 3757:    .            if(y(pr).eq.n-1)then
 3758:    .            k=pr-1
 3759:                 end if
 3760:    .            mixed2=0
 3761:    .            write(7,10) 'pairs of mixed for N=           '
 3762:    .            write(7,9)scelta
 3763:    .            do i=2,k
 3764:    .            s=n-y(i)
 3765:                 pr=s
 3766:    .            call cerca(pr,y)
 3767:    .            if (y(pr).ne.s)then
 3768:    .            conta1=conta1+1
 3769:    .            mixed1=s
 3770:    .            numc=conta1
 3771:    .            print*,conta1,mixed1,y(i)
 3772:    .            write(7,9)conta1,mixed1,y(i)
 3773:    .            rr=0;call riga(numc,rr)
 3774:    .            if(rr.eq.1)goto 6430
 3775:    .             delta=mixed2-mixed1
 3776:                  w=0
 3777:    .            if((delta.gt.2).and.(mixed2.gt.(n/2)))then
 3778:    .            incre=0
 3779:    .            do w=1,(delta/2)-1
 3780:    .            incre=incre+2
 3781:    .            compo1=mixed2-incre
 3782:                 pr=compo1
 3783:    .            call cerca(pr,y)
 3784:    .            if(y(pr).ne.compo1)then
 3785:    .            z=z+1
 3786:                 compo(z)=compo1
 3787:                 end if
 3788:                 continue
 3789:                 end do
 3790:                 end if
 3791:                 end if
 3792:    .            mixed2=mixed1
 3793:                 continue
 3794:                 end do
 3795:    .            if((salvam.eq.1).or.(mixed2.ge.(n/2)))then
 3796:    .            delta=mixed2-(n/2)
 3797:                 incre=0
 3798:    .            do w=1,(delta/2)
 3799:    .            incre=incre+2
 3800:    .            compo1=mixed2-incre
 3801:                 pr=compo1
 3802:    .            call cerca(pr,y)
 3803:    .            if(y(pr).ne.compo1)then
 3804:    .            z=z+1
 3805:                 compo(z)=compo1
 3806:                 end if
 3807:                 continue
 3808:                 end do
 3809:                 end if
 3810:    .            call endline
 3811:                !===============================================
 3812:                !end list of pairs of mixed
 3813:                !start list of pairs of composites
 3814:                !===============================================
 3815:    .            pause
 3816:    .             write(*,*)   'do you want io see the pairs of composites?  yes = any key) no= N/n'
 3817:    .             ch = getcharqq()             
 3818:    .            if((ch.eq.'N').or.(ch.eq.'n'))then
 3819:                 return
 3820:                 end if
 3821:    .            j=0 ;z=0;pr=n
 3822:    .            write(7,26)'pairs of conposites for N=          '
 3823:    .            write(7,9)scelta
 3824:    .            do i=1,salvac
 3825:    .            z=z+1 ;numc=z
 3826:    .            print*,z,compo(z),pr-compo(z)
 3827:    .            write(7,9)z,compo(z),pr-compo(z)
 3828:    .            rr=0;call riga(numc,rr)
 3829:    .            if(rr.eq.1)goto 6430
 3830:                 continue
 3831:                 end do
 3832:    .            call endline
 3833:    .     end subroutine   goldbach1
 3834:          
 3835:          !==============================================
 3836:           !end list of pairs of composites
 3837:           !end Goldbach 1 
 3838:           !===========================
 3839:          ! start Goldbach 2 
 3840:           ! start list of numbers with same number of pairs of primes
 3841:           !================================================
 3842:    .       subroutine goldbach2(y)
 3843:            implicit none
 3844:          real*8 part1,part2,part3,part4,part5,part6,phi4,phi5
 3845:          Integer*4 stay
 3846:          integer*4 numc1,numc2,numc3,numc4,numc5,toto1,toto2,toto3,toto4,phi,phi3,numc6
 3847:          integer*4 rr,conta
 3848:          integer*4 n,j,i,pr ,scelta
 3849:          integer*4 y(149000),numc
 3850:           5 format(1X,a75)
 3851:           7 format(1x,a45)
 3852:           9 Format(8I7)
 3853:           28 format(a20,1I9,a20,1I9)
 3854:    .     64301      write(*,*)'Number of pairs of primes? >1,<=100'
 3855:    .       call control(scelta)
 3856:    .       n=scelta ;stay=1;phi=0;toto4=0;phi4=0;phi5=0
 3857:            pr=scelta
 3858:    .         if(pr.gt.100) then
 3859:              goto 64301
 3860:              end if
 3861:    .         write(7,5)'List of numbers which have the same number of pairs of primes          '
 3862:    .         write(7,5)'Number of pairs of primes =                                            '
 3863:    .         write(7,9)scelta
 3864:    .         scelta=n;numc6=0
 3865:    .         n=4
 3866:    .         if(scelta.eq.1)then
 3867:    .         n=2
 3868:              end if
 3869:    .         do j=1,6000
 3870:    .         n=n+2
 3871:    .         pr=n
 3872:    .         call cerca(pr,y)
 3873:    .         phi3=pr
 3874:    .         part1=pr-1
 3875:    .         pr=n/2
 3876:    .         call cerca(pr,y)
 3877:    .         part2=pr-1
 3878:    .         part3=((part2*part2)+part2)/2
 3879:              conta=n;toto1=0
 3880:    .         numc1=part1;numc2=part2
 3881:    .         do i=numc2+2,numc1+1
 3882:    .         part5=conta-y(i)
 3883:    .         numc5=part5
 3884:    .         if(numc5 < 3)then
 3885:              goto 65311
 3886:              end if
 3887:    .         pr=part5
 3888:    .         call cerca(pr,y)
 3889:    .         toto1=toto1+(pr-1)
 3890:              continue
 3891:    .     65311   end do
 3892:    .         part6=part3+toto1
 3893:    .         part4=toto1
 3894:    .          if(mod(j,2).ne.0)then
 3895:    .          toto2=part6
 3896:               end    if
 3897:    .          if(mod(j,2).eq.0)then
 3898:    .          toto3=part6
 3899:               end    if
 3900:    .          numc4=n
 3901:    .          numc3=iabs(toto3-toto2)
 3902:    .          if(numc3.eq.scelta)then
 3903:    .           numc6=numc6+1 ;numc=numc6
 3904:    .          print*,numc6,numc4
 3905:    .          write(7,9)numc6,numc4
 3906:    .          rr=0;call riga(numc,rr)
 3907:    .         if(rr.eq.1)goto 64301
 3908:              end if
 3909:              continue
 3910:              end do
 3911:    .         print*,'numbers with',scelta,' pairs = ',numc6
 3912:    .         write(7,28)'numbers with',scelta,' pairs = ',numc6
 3913:    .         call endline
 3914:    .         pause
 3915:    .         end   subroutine goldbach2
 3916:           !===========================
 3917:           ! start Goldbach 3 
 3918:           ! start list of numbers with same number of pairs of compsites
 3919:           !================================================
 3920:    .       subroutine goldbach3(u)
 3921:            implicit none
 3922:          real*8 part1,part2,part3,part4,part5,part6,phi4,phi5
 3923:          Integer*4 stay
 3924:          integer*4 numc1,numc2,numc3,numc4,numc5,toto1,toto2,toto3,toto4,phi,phi3,numc6
 3925:          integer*4 rr,conta
 3926:          integer*4 n,j,i,pr ,scelta
 3927:          integer*4 u(851068),numc
 3928:           5 format(1X,a75)
 3929:           7 format(1x,a45)
 3930:           9 Format(8I7)
 3931:           28 format(a20,1I9,a20,1I9)
 3932:    .     64301      write(*,*)'Number of pairs of composites? >=0,<=100'
 3933:    .       call control(scelta)
 3934:    .       n=scelta ;stay=1;phi=0;toto4=0;phi4=0;phi5=0
 3935:            pr=scelta
 3936:    .      if(pr.gt.100) then
 3937:              goto 64301
 3938:              end if
 3939:    .         write(7,5)'List of numbers which have the same number of pairs of composites          '
 3940:    .         write(7,5)'Number of pairs of composites =                                            '
 3941:    .         write(7,9)scelta
 3942:    .         scelta=n;numc6=0
 3943:              n=4
 3944:    .         do j=1,6000
 3945:    .         n=n+2
 3946:    .         pr=n
 3947:    .         call cerca1(pr,u)
 3948:    .         phi3=pr
 3949:    .         part1=pr 
 3950:    .         pr=n/2
 3951:    .         call cerca1(pr,u)
 3952:    .         part2=pr !-1
 3953:    .         part3=((part2*part2)+part2)/2
 3954:              conta=n;toto1=0
 3955:    .         numc1=part1;numc2=part2
 3956:    .         do i=numc2+1 ,numc1
 3957:    .         part5=conta-u(i)
 3958:    .         numc5=part5
 3959:    .         if(numc5 < 9)then
 3960:              goto 65311
 3961:              end if
 3962:    .         pr=part5
 3963:    .         call cerca1(pr,u)
 3964:    .         toto1=toto1+(pr) !-1)
 3965:              continue
 3966:    .     65311   end do
 3967:    .         part6=part3+toto1
 3968:    .         part4=toto1
 3969:    .         if(mod(j,2).ne.0)then
 3970:    .         toto2=part6
 3971:              end     if
 3972:    .          if(mod(j,2).eq.0)then
 3973:    .          toto3=part6
 3974:               end    if
 3975:    .          numc4=n
 3976:    .          numc3=iabs(toto3-toto2)
 3977:    .          if(numc3.eq.scelta)then
 3978:    .          numc6=numc6+1  ;numc=numc6
 3979:    .          print*,numc6,numc4
 3980:    .          write(7,9)numc6,numc4
 3981:    .          rr=0;call riga(numc,rr)
 3982:    .         if(rr.eq.1)goto 64301
 3983:              end if
 3984:              continue
 3985:              end do
 3986:    .         print*,'numbers with',scelta,' pairs = ',numc6
 3987:    .         write(7,28)'numbers with',scelta,' pairs = ',numc6
 3988:    .         call endline
 3989:    .         pause
 3990:    .         end   subroutine goldbach3
 3991:           !===============
 3992:    .       subroutine goldbach4(u,y)
 3993:            implicit none
 3994:          real*8 part1,part4,part5,part6,phi4,phi5
 3995:          Integer*4 stay
 3996:          integer*4 numc1,numc2,numc3,numc4,numc5,toto1,toto2,toto3,toto4,phi,phi3,numc6
 3997:          integer*4 rr,conta
 3998:          integer*4 n,j,i,pr ,scelta
 3999:          integer*4 u(851068),y(149000),numc
 4000:           5 format(1X,a75)
 4001:           7 format(1x,a45)
 4002:           9 Format(8I7)
 4003:           28 format(a20,1I9,a20,1I9)
 4004:    .     64301      write(*,*)'Number of pairs of mixed ? >=0,<=100'
 4005:    .       call control(scelta)
 4006:    .       n=scelta ;stay=1;phi=0;toto4=0;phi4=0;phi5=0
 4007:            pr=scelta
 4008:    .      if(pr.gt.100) then
 4009:              goto 64301
 4010:              end if
 4011:    .         write(7,5)'List of numbers which have the same number of pairs of mixeed         '
 4012:    .         write(7,5)'Number of pairs of mixed =                                            '
 4013:    .         write(7,9)scelta
 4014:    .         scelta=n;numc6=0
 4015:              n=4
 4016:    .         do j=1,6000
 4017:    .         n=n+2
 4018:    .         pr=n
 4019:    .         call cerca1(pr,u)
 4020:    .         phi3=pr
 4021:    .         part1=pr 
 4022:              conta=n;toto1=0
 4023:    .         numc1=part1;numc2=1
 4024:    .         do i=numc2 ,numc1
 4025:    .         part5=conta-u(i)
 4026:    .         numc5=part5
 4027:    .         if(numc5 < 3)then
 4028:              goto 65311
 4029:              end if
 4030:    .         pr=part5
 4031:    .         call cerca(pr,y)
 4032:    .         toto1=toto1+(pr-1)
 4033:              continue
 4034:    .     65311   end do
 4035:    .         part6=toto1
 4036:    .         part4=toto1
 4037:    .         if(mod(j,2).ne.0)then
 4038:    .          toto2=part6
 4039:               end    if
 4040:    .          if(mod(j,2).eq.0)then
 4041:    .          toto3=part6
 4042:               end    if
 4043:    .          numc4=n
 4044:    .          numc3=iabs(toto3-toto2)
 4045:    .          if(numc3.eq.scelta)then
 4046:    .          numc6=numc6+1  ;numc=numc6
 4047:    .          print*,numc6,numc4
 4048:    .          write(7,9)numc6,numc4
 4049:    .          rr=0;call riga(numc,rr)
 4050:    .         if(rr.eq.1)goto 64301
 4051:              end if
 4052:              continue
 4053:              end do
 4054:    .         print*,'numbers with',scelta,' pairs = ',numc6
 4055:    .         write(7,28)'numbers with',scelta,' pairs = ',numc6
 4056:    .         call endline
 4057:    .         pause
 4058:    .       end   subroutine goldbach4
 4059:           !===============
 4060:             !for mixed
 4061:    .       subroutine mixed1(park1,park2,y,u)
 4062:            implicit none
 4063:             integer*4 y(149000),u(851068),toto1,pr,j,riga1,conta
 4064:             integer*4 riga5,i
 4065:             real*8 part1,part5,part6,n,n1,n3,park1,park2
 4066:           6 format(1x,a35,4F12.0)     
 4067:           7 format(1x,4F12.0)
 4068:           11 format(1x,a20,1F10.0,a3,1F10.0)
 4069:            toto1=0
 4070:    .       n=park1;n1=park2
 4071:    .       write(*,6)'calculate with total scanning for ', n,n1
 4072:    .       write(7,6)'calculate with total scanning for ', n,n1
 4073:    .         do j=1,2
 4074:    .         pr=n
 4075:    .         call cerca1(pr,u) 
 4076:    .         part1=pr
 4077:    .         conta=n;toto1=0
 4078:    .         riga1=part1
 4079:    .         do i=1,riga1 !do for all composites
 4080:    .         part5=conta-u(i) !delta between n and conpositess
 4081:    .         riga5=part5
 4082:    .         if(riga5 < 3)then
 4083:              goto 6533
 4084:              end if
 4085:    .         pr=part5
 4086:    .         call cerca(pr,y)
 4087:    .         toto1=toto1+(pr-1) !sum of primes up to delta ie pairs of nixed
 4088:              continue
 4089:          6533    end do
 4090:    .     part6=toto1  !total pairs of nixed
 4091:    .        write(7,7)n,part6
 4092:    .        write(*,7)n,part6
 4093:    .        if(j.eq.1)then
 4094:    .        n3=part6
 4095:             end  if
 4096:    .        if(j.eq.2)then
 4097:    .        part5=part6
 4098:             end  if
 4099:    .        pause
 4100:    .          n=n1
 4101:               continue 
 4102:               end do
 4103:    .          write(*,11)'total pairs mixed of ' ,n+2,' = ' ,n3-part5
 4104:    .          write(7,11)'total pairs mixed of ' ,n+2,' = ' ,n3-part5
 4105:    .          call endline
 4106:    .          pause;pause
 4107:    .          end subroutine mixed1
 4108:            !================================
 4109:    .       subroutine mixed(park1,park2,y,u)
 4110:             implicit none
 4111:             integer*4 y(149000),u(851068),toto1,total,pr,j,riga1,riga2,conta
 4112:             integer*4 toto4,toto5,riga5,i,numc,rr
 4113:             real*8 part1,part2,part3,part4,part5,part6,n,n1,n3,park1,park2
 4114:           4 format(1X,a45)
 4115:           5 format(1X,a75)
 4116:           6 format(1x,a50,4F12.0)     
 4117:           7 format(1x,4F12.0)
 4118:           8 format(1x,a76,4I10)       
 4119:           9 format(1x,5I10)       
 4120:          10 format(1x,1F12.0,2I10,1F12.0)         
 4121:           11 format(1x,1F12.0,1I10,1F12.0)
 4122:              toto1=0;total=0;toto4=0;toto5=0                      
 4123:    .         n=park1;n1=park2
 4124:    .         write(*,4)'now find pair of mixed for'
 4125:    .         write(7,4) 'now find pair of mixed for'
 4126:    .         write(7,7)n
 4127:    .         write(*,7)n
 4128:    .         do j=1,2
 4129:    .         if(j.eq.1)then
 4130:    .         write(*,6)'calculating for             ',n
 4131:    .         write(7,6)'calculating for             ',n
 4132:    .         call endline
 4133:             end if
 4134:    .         if(j.eq.2)then
 4135:    .         write(*,6)'calculating for             ',n1
 4136:    .         write(7,6)'calculating for             ',n1
 4137:    .         call endline
 4138:              end if
 4139:    .         pr=n
 4140:    .         call cerca1(pr,u) 
 4141:    .         part1=pr !number of composites up to n(if j =1),n-2(if j=2) 
 4142:    .         pr=n/2 
 4143:    .         call cerca1(pr,u)
 4144:    .         part2=pr ! number of conposites up to n/2 (if j =1),n-2(if j=2)
 4145:    .         pr= n/2
 4146:    .         call cerca (pr,y)
 4147:    .         part3=pr
 4148:    .         total=(pr-1)*part2 ! this is total fot the first half
 4149:    .          if (j.eq.1)then
 4150:    .         print*,'total combinations between prime and composites for the first half of N = ',total
 4151:    .         write(7,8)'total combinations between prime and composites for the first half of N = ',total
 4152:    .         call endline
 4153:              end if
 4154:    .         if (j.eq.2)then
 4155:    .         write(*,8)'total combinations between prime and composites for the first half of N1 = ',total
 4156:    .         write(7,8)'total combinations between prime and composites for the first half of N1 = ',total
 4157:    .         call endline
 4158:              end if
 4159:    .         pause
 4160:    .         pr= n
 4161:    .         call cerca (pr,y)
 4162:    .         part4=pr
 4163:    .         conta=n;toto1=0
 4164:    .         riga1=part1
 4165:    .         riga2=part2+1
 4166:    .         write(*,4)'start scanning composites for the second half' 
 4167:    .         write(7,4)'start scanning composites for the second half' 
 4168:    .     write(7,5)'column 1 = sequential number(index of composite)                                     '                                                   
 4169:    .     write(7,5)'column 2 = conposite                                                      '
 4170:    .     write(7,5)'column 3 =delta between n and conposite                                  '                                                                             
 4171:    .     write(7,5)'column 4 = primes up to delta                                            '       
 4172:    .     write(7,5)'column 5 = total number of pairs                                         '
 4173:    .     write(*,5)'column 1 = sequential number(index of composite)                                                                '                                   
 4174:    .     write(*,5)'column 2 = conposite                                                       '
 4175:    .     write(*,5)'column 3 = delta between n and conposite                                  '                                                                            
 4176:    .     write(*,5)'column 4 = primes up to delta                                           '
 4177:    .     write(*,5)'column 5 = total number of pairs                                         '
 4178:                                                                                                          
 4179:    .     write(*,*)'_________________________________________'
 4180:    .     write(*,*)'       1             2         3        4        5         '
 4181:    .     write(7,5)'    1          2         3        4        5                          '
 4182:    .     write(7,5)'_____________________________________________________________                 '
 4183:    .         do i=riga2,riga1 !do for all composites from n/2 to n
 4184:    .         part5=conta-u(i) !delta ss after n/2
 4185:    .         riga5=part5
 4186:    .         if(riga5 < 3)then
 4187:              goto 6534
 4188:              end if
 4189:    .         pr=part5
 4190:    .         call cerca(pr,y)
 4191:    .         toto1=toto1+(pr-1) !sum of primes up to delta ie pairs of nixed
 4192:    .        write(*,9)i,u(i),riga5,pr-1,toto1
 4193:    .        write(7,9)i,u(i),riga5,pr-1,toto1
 4194:    .        numc=i
 4195:    .          rr=0;call riga(numc,rr)
 4196:    .         if(rr.eq.1)return
 4197:              continue
 4198:          6534    end do
 4199:    .         part6=toto1 +total !total pairs of nixed
 4200:    .         write(*,10)n,total,toto1,part6
 4201:    .         write(7,10)n,total,toto1,part6
 4202:    .         write(*,4)'end scanning composites  '
 4203:    .         write(7,4)'end scanning composites  '
 4204:    .         call endline
 4205:    .         pause
 4206:             !scanning now primes===================  
 4207:    .         conta=n;toto1=0
 4208:    .         riga1=part4
 4209:    .         riga2=part3+1
 4210:    .         Print*,'start scanning primes of the second half'
 4211:    .         write(7,4)'start scanning primes of the second half'
 4212:    .         write(7,4)'column 1 = sequential number(index of prime)                                     '                                                   
 4213:    .     write(7,5)'column 2 = prime                                                          '
 4214:    .     write(7,5)'column 3 =delta between n and prime                                       '                                                                            
 4215:    .     write(7,5)'column 4 = composites up to delta                                            '       
 4216:    .     write(7,5)'column 5 = total number of pairs                                         '
 4217:    .     write(*,5)'column 1 = sequential number(index of prime)                                                                '                                   
 4218:    .     write(*,5)'column 2 = prime                                                            '
 4219:    .     write(*,5)'column 3 = delta between n and prime                                       '                                                                           
 4220:    .     write(*,5)'column 4 = composites up to delta                                           '
 4221:    .     write(*,5)'column 5 = total number of pairs                                         '
 4222:                                                                                                          
 4223:    .     write(*,*)'_________________________________________'
 4224:    .     write(*,*)'       1             2         3        4        5         '
 4225:    .     write(7,5)'    1          2         3        4        5                          '
 4226:    .     write(7,5)'_____________________________________________________________                 '
 4227:            
 4228:    .         do i=riga2,riga1 !do for all primes from n/2 to n
 4229:    .         part5=conta-y(i) !delta between n and primes after n/2
 4230:    .         riga5=part5
 4231:    .         if(riga5 < 9)then
 4232:              exit 
 4233:              end if
 4234:    .         pr=part5
 4235:    .         call cerca(pr,u)
 4236:    .         toto1=toto1+(pr) !sum of composites up to delta ie pairs of nixed
 4237:    .         write(*,9)i,y(i),riga5,pr,toto1
 4238:    .         write(7,9)i,y(i),riga5,pr,toto1
 4239:              continue
 4240:          6535    end do
 4241:    .         write(*,8)'found for scanning primes ',toto1
 4242:    .         write(7,8)'found for scanning primes ',toto1
 4243:    .         part6=part6 +toto1 !total pairs of nixed
 4244:    .         write(*,11)n,toto1,part6
 4245:    .         write(7,11)n,toto1,part6
 4246:    .         pause   
 4247:    .         if(j.eq.1)then
 4248:    .         n3=part6
 4249:              end if
 4250:    .          if(j.eq.2)then
 4251:    .          part5=part6
 4252:               end if
 4253:    .          pause
 4254:    .          n=n1
 4255:               continue 
 4256:               end do
 4257:    .          print*,'total pairs mixed of ' ,n+2,' = ' ,n3-part5
 4258:    .          toto4=n3-part5
 4259:    .          pause
 4260:    .          print*,' for N = ',n +2
 4261:    .          Print*,'pairs of mixed from 6 to N ',n3
 4262:    .          write(7,6)'pairs of mixed from 6 to N ',n3
 4263:    .          Print*,'pairs of mixed from 6 to N-2',part6
 4264:    .          write(7,6) 'pairs of mixed from 6 to N-2',part6
 4265:    .          Print*,'pairs of mixed of N ',toto4
 4266:    .          write(7,8)'pairs of mixed of N ',toto4
 4267:    .          call endline
 4268:    .          pause;pause
 4269:    .          end subroutine mixed
 4270:           !========================================== 
 4271:           !   for composites
 4272:           !==================
 4273:    .        subroutine   composite(park1,park2,u)
 4274:             implicit none
 4275:             integer*4 u(851068),toto1,pr,j,riga1,riga2,conta
 4276:             integer*4 riga5,i,toto2,toto3
 4277:             real*8 part1,part2,part3,part5,part6,n,n1,park1,park2
 4278:           5 format(1X,a50)
 4279:           6 format(1x,4F10.0)
 4280:    .      write(7,5)'number of composite pairs for N   =                 '
 4281:    .      write(7,6)park1
 4282:    .      write(*,5)'number of composite pairs for N   =                 '
 4283:    .      write(*,6)park1
 4284:    .      toto1=0
 4285:            n=park1;n1=park2
 4286:    .      write(*,5)'total pairs are calculated for                 '
 4287:    .      write(7,5)'total pairs are calculated for                 '
 4288:    .      write(*,6)n,n1
 4289:    .      write(7,6)n,n1
 4290:    .         do j=1,2
 4291:    .         pr=n
 4292:    .         call cerca1(pr,u)
 4293:    .         part1=pr
 4294:    .         pr=n/2
 4295:    .         call cerca1(pr,u)
 4296:    .         part2=pr
 4297:    .         part3=((part2*part2)+part2)/2
 4298:    .      write(7,5)'combinations for 1/2(N)   =              '
 4299:    .      write(7,6)part3
 4300:    .      write(*,5)'combinations for 1/2(N)   =              ' 
 4301:    .      write(*,6)part3
 4302:    .         conta=n;toto1=0
 4303:    .         riga1=part1;riga2=part2
 4304:    .         do i=riga2+1,riga1
 4305:    .         part5=conta-u(i)
 4306:    .         riga5=part5
 4307:    .         if(riga5 < 9)then
 4308:              goto 6532
 4309:              end if
 4310:    .         pr=part5
 4311:    .         call cerca1(pr,u)
 4312:    .         toto1=toto1+(pr)
 4313:              continue
 4314:          6532    end do
 4315:    .         part6=part3+toto1
 4316:    .      write(7,5)'total pairs for                                   '
 4317:    .      write(*,5)'total pairs for                                   '
 4318:    .      write(*,6)n,part6
 4319:    .      write(7,6)n,part6
 4320:              
 4321:    .         if(j.eq.1)then
 4322:    .          toto2=part6
 4323:               end    if
 4324:    .          if(j.eq.2)then
 4325:    .          toto3=part6
 4326:               end    if
 4327:    .          n=n1
 4328:               continue 
 4329:               end do
 4330:          7  format(1x,a30,1F10.0,a4,1I9)  
 4331:    .         write(7,7)'total pairs composites of ' ,n+2,' = ' ,toto2-toto3
 4332:    .         write(*,7)'total pairs composites of ' ,n+2,' = ' ,toto2-toto3
 4333:    .         call endline
 4334:    .         pause
 4335:    .         end subroutine  composite
 4336:            !================ 
 4337:    .       subroutine    gold (y)
 4338:          USE MSIMSL
 4339:          USE MSFLIB
 4340:          implicit none   
 4341:           integer*4 numc,div1,div2,pr,cont,zl,pair
 4342:           real*8 e0,ex,q8,z2,s1,saln,odd1
 4343:           real*8 k1,k,flag,k2
 4344:           real*8 x,n1,sum4
 4345:           real*8 sum2,sum3
 4346:            integer*4 y(149000),rr
 4347:            integer*4 g(8)!in questo array si memorizzano il num dei divisori
 4348:            integer*4 a,b,d1,d2,d3,d4,i
 4349:            integer*4 p(40000),s(40000),flag1
 4350:            integer*4 c(4) ,scelta,t,e2
 4351:            integer*4 z(3),j
 4352:            real*8 combi1,combi2
 4353:            character*1 fz
 4354:    .         p=0
 4355:              g=0
 4356:    .      fz=achar(179)
 4357:          13    format(I7, a1, F3.0 :)
 4358:          12    format(I7, a1, F3.0, a2, I7, a2, :)
 4359:          11    format(' ',I7,'  ',I10,'   ',I10,'   ',I10) 
 4360:          333   format(a1, I5, a1, I10, a2, I5, a1, I10, a2, I5, a1, I10, a2, &
 4361:                & I5, a1, I10 , :)
 4362:          14    format(1F13.0,2I10)
 4363:          1123  format(a3,F13.0)
 4364:          30    format(a30) 
 4365:          10    format(a1)
 4366:          40    format(a80)
 4367:          41    format(a45,1F15.0)
 4368:          339   format(I5,2I10)   
 4369:          933   format(3F13.0)
 4370:          1234  format(I10)
 4371:    .         z(1)=18;z(2)=19;z(3)=20 
 4372:    .     write(7,40)'find total number of prime pairs from 6 to N with reverse method'
 4373:    .     write(*,40)'find total number of prime pairs from 6 to N with reverse method'
 4374:    .     write(*,40)'enter the even number <=160000                                 '
 4375:    .     write(7,40)'enter the even number <=160000                                 '
 4376:    .     call control(scelta)
 4377:    .       n1=scelta
 4378:    .       saln=n1
 4379:    .      write(7,933)saln
 4380:    .      write(*,933)saln
 4381:    .      flag1=0
 4382:    .      if(saln.lt.2001)then
 4383:    .      print*,'enter 1 to print all data  otherwise  enter 0'
 4384:    .      call control(scelta)
 4385:    .      flag1=scelta
 4386:            end if
 4387:    .       numc=1
 4388:    .       sum2=n1/2
 4389:    .       pr=sum2 
 4390:    .       if(pr.gt.2000000)then
 4391:    .            sum2=pr
 4392:    .            call trova1(sum2,y)
 4393:    .            pr=sum2
 4394:    .            else if(pr.lt.2000001)then
 4395:    .            call cerca(pr,y)
 4396:                 end if 
 4397:    .           if(n1.ne.2*y(pr))then
 4398:    .           sum3=y(pr+1)
 4399:    .           else if(n1.eq.2*y(pr))then
 4400:    .           sum3=y(pr)
 4401:                end if
 4402:    .           pr=saln/2  
 4403:    .           call cerca(pr,y)
 4404:    .           sum2=pr
 4405:    .           sum2=y(pr)    !(pr-1)
 4406:    .           odd1=2*(sum2*sum3)
 4407:    .           pr=saln
 4408:    .           call cerca(pr,y)
 4409:    .           sum4=pr
 4410:    .           write(*,40)'The central primes of N are                                 '
 4411:    .           write(7,40)'The central primes of N are                                 '
 4412:    .     105   write(*,933)sum2,sum3 !,odd1
 4413:    .           write(7,933)sum2,sum3 !,odd1
 4414:    .           write(7,41)'the set of numbers with 6 and 8 divisors of ',odd1
 4415:    .           write(*,41)'the set of numbers with 6 and 8 divisors of ',odd1
 4416:    .           write(7,41)'contains the set of pairs of prime of       ',saln
 4417:    .           write(*,41)'contains the set of pairs of prime of       ',saln
 4418:    .           pause
 4419:    .           k=odd1
 4420:                q8=k
 4421:    .           z2=dsqrt(q8)
 4422:                cont=0
 4423:    .           e0=1
 4424:    .           g=0
 4425:                p=0
 4426:    .           numc=0
 4427:    .           flag=0;pair=0
 4428:           3659     t=0
 4429:    .               s1=0 
 4430:          !C     block 1 ------------------------     
 4431:           3660     t=t+1
 4432:    .          if(y(t).gt.2)goto 5000
 4433:    .            k1=k/y(t)
 4434:                 ex=1
 4435:    .          if (k1.lt.y(t))goto 5000
 4436:    .           combi1=y(t)
 4437:               goto 3730
 4438:                 pr=k1 
 4439:           !C     block 2----------------------------------- 
 4440:          3730  zl=t
 4441:    .     3740  zl=zl+1
 4442:    .           k2=k1/y(zl)
 4443:    .         if (k2.lt.y(zl)) goto 3660 !Go to  block 1-------> 
 4444:    .           e2=1
 4445:    .           pr=k2
 4446:    .         if(pr.gt.2000000)then
 4447:    .            n1=pr
 4448:    .            call trova1(n1,y)
 4449:    .            pr=n1
 4450:    .         else if(pr.lt.2000001)then
 4451:    .            call cerca(pr,y)
 4452:              end if
 4453:           !==================
 4454:    .           if(pr.gt.148934)then
 4455:    .           pr=148934
 4456:    .           else if(pr.le.148934) then
 4457:    .           pr=sum4
 4458:                end if
 4459:    .           do while((y(pr)+y(zl)).gt.saln)
 4460:    .           pr=pr-1
 4461:                continue
 4462:    .           end do
 4463:    .           x=pr-zl+1
 4464:    .           write(*,40)'number of primes satisfing condition x+y for pairs                                 '
 4465:    .           write(7,40)'number of primes satisfing condition x+y for pairs                                 '
 4466:    .           write(*,933) x
 4467:    .           write(7,933) x
 4468:    .           if(x.eq.0)goto 5000
 4469:    .           s1=s1+x
 4470:    .           print*,s1
 4471:    .           combi2=combi1*y(zl) 
 4472:    .           div1=(e0+1)*(ex+1)*(e2+1)
 4473:    .           div2=(div1/(2*(e2+1)))*(e2+2)
 4474:    .           g(div1)=g(div1)+x-1
 4475:    .           g(div2)=g(div2)+1
 4476:    .            if ((div1.eq.8).and.(pr-zl+1.gt.1))then
 4477:    .           write(*,40)'scanning each prime forming combinations                       '
 4478:    .           write(7,40)'scanning each prime forming combinations                       '
 4479:    .           do i=zl+1,pr
 4480:    .             if((y(i)+y(zl)).gt.saln)exit
 4481:    .             if(flag1.eq.1)then
 4482:    .            flag=flag+1
 4483:    .            pair=pair+1
 4484:    .         if(flag.gt.2000)then
 4485:                  exit
 4486:              end if
 4487:    .            p(flag)=y(i)*combi2 
 4488:    .            s(pair)=(y(i)+y(zl)) 
 4489:    .            write(*,14)flag,p(flag),s(pair)
 4490:    .            write(7,14)flag,p(flag),s(pair)
 4491:    .            write(*,29)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(i),'^1'
 4492:    .            write(7,29)y(t),'^',ex,'*',y(zl),'^',e2,'*',y(i),'^1'
 4493:              29    format(I7, a1,F3.0,a1,I7,a1,I7,a1,I7,a2)
 4494:    .             numc=numc+2
 4495:    .         rr=0;call riga(numc,rr)
 4496:    .         if(rr.eq.1)goto 2222
 4497:                 end if
 4498:                 continue
 4499:                 end do
 4500:                 end if
 4501:    .           if(div2.eq.6)then
 4502:    .           if((y(zl)+y(zl)).gt.saln)goto 3740
 4503:    .            flag=flag+1
 4504:                 pair=pair+1
 4505:    .           if(flag1.eq.1)then
 4506:    .            p(flag)=y(zl)*combi2
 4507:    .            s(pair)=2*(y(zl))
 4508:    .             write(*,14)flag,p(flag),s(flag)
 4509:    .             write(7,14)flag,p(flag),s(flag)
 4510:    .             write(*,15)y(t),'^',ex,'*',y(zl),'^',e2+1
 4511:    .             write(7,15)y(t),'^',ex,'*',y(zl),'^',e2+1
 4512:          
 4513:          15    Format(I7,a1,F3.0,a1,I7,a1,I7:)
 4514:    .              numc=numc+2
 4515:    .         rr=0;call riga(numc,rr)
 4516:    .         if(rr.eq.1)goto 2222
 4517:                end if
 4518:                end if
 4519:                goto 3740 !!Go to block 2 ----        
 4520:    .       5000  write(*,*)'         V E C T O R    R E A D Y'
 4521:    .             pause 
 4522:    .            fz=achar(124)
 4523:    .             write(7,1123)'   ',saln
 4524:    .             write(*,*)'there are ',sum4,' prime numbers' 
 4525:    .           g(1)=1
 4526:    .           g(2)=sum4
 4527:    .           do i=1,8
 4528:    .           if(g(i).ne.0)cont=i
 4529:                continue
 4530:                end do
 4531:    .           pause
 4532:    .           a=-3;b=0;c=0
 4533:    .           do i=1,cont,4
 4534:    .           do j =1,4
 4535:    .         a=a+1;b=b+1;c(j)=g(b)
 4536:              continue
 4537:              end do
 4538:    .         d1=c(1);d2=c(2);d3=c(3);d4=c(4)
 4539:    .           write(*,333)' ',a,' ',d1,fz,a+1,' ',d2,fz,a+2,' ',d3,fz,a+3,      &
 4540:               &' ',d4
 4541:    .           write(7,333)' ',a,' ',d1,fz,a+1,' ',d2,fz,a+2,' ',d3,fz,a+3,      &
 4542:               &' ',d4
 4543:    .           if(mod(b,72).eq.0)then
 4544:    .           pause
 4545:                end if
 4546:                continue
 4547:                end do
 4548:                42 format(a15)
 4549:    .          write(7,40)'the sum of selected numbers with 6 and 8 divisors = the total pairs of primes '
 4550:    .          write(*,40)'the sum of selected numbers with 6 and 8 divisors = the total pairs of primes '
 4551:    .          write(7,42) 'from 6 to N'
 4552:    .          write(*,42) 'from 6 to N'
 4553:    .          write(7,933)s1
 4554:    .          write(*,933)s1
 4555:    .           pause
 4556:    .           n1=saln     
 4557:    .            if(flag1.eq.1)then
 4558:    .           write(7,40)'Not ordered list                                               '
 4559:    .           write(*,40)'Not ordered list                                               '
 4560:    .           do i=1,flag
 4561:    .            print*,i,p(i),s(i)
 4562:    .            numc=numc+1
 4563:    .         rr=0;call riga(numc,rr)
 4564:    .         if(rr.eq.1)goto 2222
 4565:    .            write(7,5142)i,p(i),s(i)
 4566:                 continue
 4567:                 end do
 4568:    .            call endline    
 4569:    .                t=flag
 4570:    .           call sortqq(loc(p),t,srt$Integer4)
 4571:    .           call sortqq(loc(s),t,srt$Integer4)
 4572:    .            K=0;k1=0
 4573:    .           write(7,40)' ordered list                                               '
 4574:    .           write(*,40)' ordered list                                               '
 4575:    .            do i=1,flag
 4576:    .            print*,i,p(i),s(i)
 4577:    .            k=k+p(i);k1=k1+s(i)
 4578:                 numc=numc+1
 4579:    .         rr=0;call riga(numc,rr)
 4580:    .         if(rr.eq.1)goto 2222
 4581:             5142 format(3I10)
 4582:    .            write(7,5142)i,p(i),s(i)
 4583:                 continue
 4584:                 end do
 4585:    .            write(*,933)k,k1
 4586:    .            write(7,933)k,k1
 4587:    .           pause
 4588:    .           end if
 4589:    .     109       g=0
 4590:    .         p=0 ;s=0
 4591:    .            pause
 4592:    .       2222     k=0 
 4593:                 cont=0
 4594:    .            call endline 
 4595:    .           flag=0
 4596:                return
 4597:    .           end subroutine gold     
 4598:          !=========================
 4599:    .      subroutine gold1 (y)
 4600:          USE MSIMSL
 4601:          USE MSFLIB
 4602:          implicit none   
 4603:           integer*4 numc,div1,div2,pr,cont
 4604:           real*8 e0,ex,q8,z2,s1,saln,odd1
 4605:           real*8 k1,k,flag
 4606:           real*8 x,n1
 4607:           integer*4 y(149000),rr
 4608:           real*8 g(4),d1,d2,d3,d4 !in questo array si memorizzano il num dei divisori
 4609:           integer*4 a,b,i
 4610:           integer*4 p(40000),s(40000),flag1
 4611:           integer*4 c(4) ,scelta,t 
 4612:           integer*4 v11,z(3),j
 4613:           real*8 combi1
 4614:           real*8 sum2,sum3,sum4
 4615:           character*1 fz
 4616:    .         p=0
 4617:              g=0
 4618:    .      fz=achar(179)
 4619:          13    format(I7, a1, F3.0 :)
 4620:          12    format(I7, a1, F3.0, a2, I7, a2, :)
 4621:          11    format(' ',I7,'  ',I10,'   ',I10,'   ',I10) 
 4622:          333   format(a1, I5, a1, F14.0, a2, I5, a1, F14.0, a2, I5, a1, F14.0, a2, &
 4623:                & I5, a1, F14.0 , :)
 4624:          14    format(1F13.0,2I10)
 4625:          1123  format(a3,F13.0)
 4626:          30    format(a1) 
 4627:          10    format(a1)
 4628:          40    format(a80)
 4629:          41    format(a45,1F15.0)
 4630:          339   format(I5,2I10)   
 4631:          933   format(3F15.0)
 4632:          1234 format(I10)
 4633:    .         z(1)=18;z(2)=19;z(3)=20
 4634:    .     write(7,40)'find total number of prime pairs from 6 to N with reverse method'
 4635:    .     write(*,40)'find total number of prime pairs from 6 to N with reverse method'
 4636:    .     write(*,40)'enter the even number <=160000                                 '
 4637:    .     write(7,40)'enter the even number <=160000                                 '
 4638:    .     call control(scelta)
 4639:    .       n1=scelta
 4640:    .       saln=n1
 4641:    .      write(7,933)saln
 4642:    .      write(*,933)saln
 4643:    .      flag1=0
 4644:    .       if(saln.lt.2001)then
 4645:            !possibility to print all data only if N is < 2001
 4646:    .       print*,'enter 1 to print all data  otherwise  enter 0'
 4647:    .       call control(scelta)
 4648:    .       flag1=scelta
 4649:            end if
 4650:    .       numc=1
 4651:    .       sum2=n1/2
 4652:    .       pr=sum2 
 4653:    .       if(pr.gt.2000000)then
 4654:    .            sum2=pr
 4655:    .            call trova1(sum2,y)
 4656:    .            pr=sum2
 4657:    .            else if(pr.lt.2000001)then
 4658:    .            call cerca(pr,y)
 4659:                end if 
 4660:    .           if(n1.ne.2*y(pr))then
 4661:    .           sum3=y(pr+1)
 4662:    .           else if(n1.eq.2*y(pr))then
 4663:    .           sum3=y(pr)
 4664:                end if
 4665:    .           pr=saln/2  !-3
 4666:    .           call cerca(pr,y)
 4667:    .           sum2=pr
 4668:    .           sum2=y(pr)    !(pr-1)
 4669:    .           odd1= sum2*sum3
 4670:    .           pr=saln
 4671:    .           call cerca(pr,y)
 4672:    .           sum4=pr
 4673:    .           write(*,40)'The central primes of N are                                 '
 4674:    .           write(7,40)'The central primes of N are                                 '
 4675:    .     105   write(*,933)sum2,sum3 !,odd1
 4676:    .           write(7,933)sum2,sum3 !,odd1
 4677:    .           write(7,41)'the set of numbers with 3 and 4 divisors of ',odd1
 4678:    .           write(*,41)'the set of numbers with 3 and 4 divisors of ',odd1
 4679:    .           write(7,41)'contains the set of pairs of prime of       ',saln
 4680:    .           write(*,41)'contains the set of pairs of prime of       ',saln
 4681:    .           pause
 4682:    .           k=odd1
 4683:                q8=k
 4684:    .           z2=dsqrt(q8)
 4685:                cont=0
 4686:    .           e0=1
 4687:    .           g=0
 4688:                p=0
 4689:    .           numc=0
 4690:    .           flag=0
 4691:           3659     t=1
 4692:    .               s1=0 
 4693:          !C     block 1 ------------------------     
 4694:           3660     t=t+1
 4695:    .           if(z2.lt.y(t))goto 5000
 4696:    .           k1=k/y(t)
 4697:    .           if(k1.gt.2147483647)then
 4698:    .           k1=2147483647
 4699:                end if
 4700:    .            ex=1
 4701:    .            if (k1.lt.y(t))goto 5000
 4702:    .            pr=k1 
 4703:    .            if(pr.gt.2000000)then
 4704:    .            n1=pr
 4705:    .            call trova1(n1,y)
 4706:    .            pr=n1
 4707:    .            else if(pr.lt.2000001)then
 4708:    .            call cerca(pr,y)
 4709:                end if
 4710:    .           if(pr.gt.148934)then
 4711:    .           pr=148934
 4712:    .           else if(pr.le.148934) then
 4713:    .           pr=sum4
 4714:                end if
 4715:    .           do while((y(pr)+y(t)).gt.saln)
 4716:    .           pr=pr-1
 4717:                continue
 4718:    .           end do
 4719:    .           x=pr-t+1
 4720:    .           write(*,40)'number of primes satisfing condition x+y for pairs                                 '
 4721:    .           write(7,40)'number of primes satisfing condition x+y for pairs                                 '
 4722:    .           write(*,933) x
 4723:    .           write(7,933) x
 4724:    .           if(x.eq.0)goto 5000
 4725:    .           s1=s1+x
 4726:    .           combi1=y(t)
 4727:    .           div1=(e0+1)*(ex+1)
 4728:    .           div2=(ex+2)
 4729:    .           if(x.gt.0)then
 4730:    .           g(div1)=g(div1)+x-1
 4731:    .           g(div2)=g(div2)+1
 4732:    .           end if
 4733:    .            if ((div1.eq.4).and.(pr-t+1.gt.1))then
 4734:    .           write(*,40)'scanning each prime forming combinations                       '
 4735:    .           write(7,40)'scanning each prime forming combinations                       '
 4736:              
 4737:    .         do i=t+1,pr
 4738:    .             flag=flag+1
 4739:    .             if(flag1.eq.1)then
 4740:    .             p(flag)=y(i)*combi1
 4741:    .             s(flag)=y(i)+combi1
 4742:    .           write(*,14)flag,p(flag) ,s(flag)
 4743:    .           write(7,14)flag,p(flag),s(flag)
 4744:    .           write(*,12) y(t),'^',ex,' *',y(i),'^1'
 4745:    .           write(7,12) y(t),'^',ex,' *',y(i),'^1'
 4746:    .         numc=numc+2
 4747:    .         rr=0;call riga(numc,rr)
 4748:    .         if(rr.eq.1)goto 2222
 4749:              end if
 4750:              continue
 4751:                 end do
 4752:                 end if
 4753:    .            if(div2.eq.3)then
 4754:    .            if((2*y(t)).gt.saln)goto 3660
 4755:    .            flag=flag+1
 4756:    .           if(flag1.eq.1)then
 4757:    .            p(flag)=y(t)*combi1
 4758:    .            s(flag)=y(t)+y(t)
 4759:    .             write(*,14)flag,p(flag),s(flag)
 4760:    .             write(7,14)flag,p(flag),s(flag)
 4761:    .             write(*,13)y(t),'^',ex+1
 4762:    .             write(7,13)y(t),'^',ex+1
 4763:                      end if
 4764:                      end if
 4765:    .       goto 3660 !!Go to block 1 ----        
 4766:    .       5000  write(*,*)'         V E C T O R    R E A D Y'
 4767:    .             pause 
 4768:    .            fz=achar(124)
 4769:    .             write(7,1123)'   ',saln
 4770:    .             pr=saln
 4771:    .             call cerca (pr,y) 
 4772:    .           v11=pr
 4773:    .           write(*,*)'there are ',v11,' prime numbers' 
 4774:    .           g(1)=1
 4775:    .           g(2)=v11
 4776:    .           do i=1,4
 4777:    .           if(g(i).ne.0)cont=i
 4778:                continue
 4779:                end do
 4780:    .         a=-3;b=0;c=0
 4781:    .           do i=1,cont,4
 4782:    .           do j =1,4
 4783:    .         a=a+1;b=b+1;c(j)=g(b)
 4784:              continue
 4785:              end do
 4786:    .         d1=c(1);d2=c(2);d3=c(3);d4=c(4)
 4787:    .           write(*,333)' ',a,' ',d1,fz,a+1,' ',d2,fz,a+2,' ',d3,fz,a+3,      &
 4788:               &' ',d4
 4789:    .           write(7,333)' ',a,' ',d1,fz,a+1,' ',d2,fz,a+2,' ',d3,fz,a+3,      &
 4790:               &' ',d4
 4791:    .           if(mod(b,72).eq.0)then
 4792:    .           pause
 4793:                end if
 4794:                continue
 4795:                end do
 4796:             42 format(a15)
 4797:    .          write(7,40)'the sum of selected numbers with 3 and 4 divisors = the total pairs of primes '
 4798:    .          write(*,40)'the sum of selected numbers with 3 and 4 divisors = the total pairs of primes '
 4799:    .          write(7,42) 'from 6 to N'
 4800:    .          write(*,42) 'from 6 to N'
 4801:    .          write(7,933)d3+d4
 4802:    .          write(*,933)d3+d4
 4803:    .           pause
 4804:    .            if(flag1.eq.0)goto 109
 4805:    .           n1=saln     
 4806:    .           pause
 4807:    .           write(7,40)'Not ordered list                                               '
 4808:    .           write(*,40)'Not ordered list                                               '
 4809:    .           do i=1,flag
 4810:    .            print*,i,p(i),s(i)
 4811:    .            numc=numc+1
 4812:    .         rr=0;call riga(numc,rr)
 4813:    .         if(rr.eq.1)goto 2222
 4814:    .            write(7,5142)i,p(i),s(i)
 4815:                 continue
 4816:                 end do
 4817:    .            call endline
 4818:    .             t=flag
 4819:    .           call sortqq(loc(p),t,srt$Integer4)
 4820:    .           call sortqq(loc(s),t,srt$Integer4)
 4821:    .            write(7,40)' ordered list                                                    '
 4822:    .            write(*,40)' ordered list                                                   '
 4823:    .            do i=1,flag
 4824:    .            print*,i,p(i),s(i)
 4825:    .            numc=numc+1
 4826:    .         rr=0;call riga(numc,rr)
 4827:    .         if(rr.eq.1)goto 2222
 4828:             5142 format(3I10)
 4829:    .            write(7,5142)i,p(i),s(i)
 4830:                 continue
 4831:                 end do
 4832:    .            pause
 4833:    .     109       g=0
 4834:    .         p=0 ;s=0
 4835:    .     2222     k=0 
 4836:                 cont=0 
 4837:    .           flag=0
 4838:    .           call endline
 4839:                return
 4840:    .     end subroutine gold1    
 4841:          !=======================
 4842:    .               subroutine triplets
 4843:                    implicit none
 4844:                    real*8 p,q,r1,r2,r3,r4
 4845:                    integer*4 i,j,park1,park2,park3
 4846:              1     format(1x,a48)
 4847:              2     format(1x,3F4.0)
 4848:    .               write(7,1)'Partial list of primitive Pythagorean triplets'
 4849:    .               write(*,1)'Partial list of primitive Pythagorean triplets'
 4850:    .               do i=2,8
 4851:    .               do j=1,7
 4852:    .               if(j.ge.i)then
 4853:                    goto 666
 4854:                    end if
 4855:    .               p=i;q=j
 4856:    .               if ((p*p)-(q*q).lt.3)then
 4857:                     goto 666
 4858:                     end if
 4859:    .                if(i.eq.6)then
 4860:    .                if(j.eq.3)then
 4861:                     goto 666
 4862:                     end if
 4863:                     end if
 4864:    .                park3=(p*p)-(q*q)
 4865:    .                if(mod(park3,2).eq.0)then
 4866:                     goto 666
 4867:                     end if
 4868:    .               r1=(2*p*q)**2
 4869:    .               r2=((p*p)-(q*q))**2
 4870:    .               r3=((p*p)+(q*q))**2
 4871:    .               r4=r1+r2
 4872:    .               park1=r3
 4873:    .               park2=r4
 4874:    .               if(r2.ne.0)then
 4875:    .               if(park1.eq.park2)then
 4876:    .               write(*,2)2*p*q,(p*p)-(q*q),(p*p)+(q*q)
 4877:    .               write(7,2)2*p*q,(p*p)-(q*q),(p*p)+(q*q)
 4878:                    end if
 4879:                    end if
 4880:              666   continue
 4881:                    end do
 4882:                    continue
 4883:                    end do
 4884:    .               call endline
 4885:    .               pause
 4886:    .               pause
 4887:    .               end subroutine triplets
 4888:            !===================================
 4889:    .               subroutine change(Y)
 4890:               USE MSFLIB
 4891:          implicit none   
 4892:           integer*4 y(149000),scelta,park1,park2
 4893:          10 format (1x,a50)
 4894:    .     write(*,10)'write the index of the prime you want to change'
 4895:    .      call control(scelta)
 4896:    .      park1=scelta
 4897:    .      print*,scelta,y(PARK1)
 4898:    .      write(*,10)'write the odd composite < of the above prime'
 4899:    .       call control(scelta)
 4900:    .       park2=scelta
 4901:    .       y(park1)=park2
 4902:    .       print*,park1,y(park1)
 4903:    .       end subroutine change
 4904:          
 4905:          
