!MS6-RC-Solve.f95
!2025.01.25.1445cst JMS- Rubik's Cubes - Wisdom on Call
!                      - For:2x2x2 & 3x3x3 Rubik's Cubes 
!              Computer- "T4"/HP-800-G4-Mini/i7-8700T/IntelUHD630/Win10Pro-22H2
!                         ^name  ^Mfgr.Id    ^chipset ^graphics   ^OS
!                            /AbsoftProFortran 21.0.2/OpenGL+Glut3.6
!                             ^compiler               ^Fortran graphics

!Table of Contents - ToC:
!Subroutine GenScramble(iP)                -opens Data.Emulator.txt
!Subroutine SolveScramble(iP)              -opens Data.Emulator.txt
!Subroutine AtoD(VtotL,VAin,iDiscord,iP)   -opens Discord.bim files
!---------------------------------------------------------------------------7 9

Subroutine GenScramble(iP)
!2025.01.21.1830cst JMS- !Generates the scramble defined by Ein in a .nml file. 
!                            using: AECAV(). 
!                         Processes an arbitrary voter subset. 
!--Globals
 use MS1Def   ,only: Ur,Us,Ut
 use MS2RCDef ,only: SRrec,resetSR,AECAV,Rtot8,C,MC      &
                    ,Ein,RubSize,Sfound8,Vtot,V,Asymbol  &   
                    ,AlV                                 &
                    ,SrTestIn,Mtot,MC,Ctot,C,Vtot,V   
!--End Globals
 implicit none
 !--Arguments
  integer(4)::iP     !Write enable>5: write(iP,...)
 !--Internals
  integer(4)::Init
  integer(4)::nV,nV2 !Voter- index
  integer(1)::nVE    !      = V(nV) is used within the model- cell# 
  integer(4)::nA,nA2 !Choice- index

 type(SRrec)::SRin   !The cube being scrambled
  integer(4)::nM     !Move counter
  integer(1)::nCE    !      = C(nC) is used within the model- rotation# 
  integer(1)::VAn(27)!now copy of SRn%VA()

  !--EndDefs-----------------------------------------------
   if(iP>5) write(iP,"(/'GenScramble:    MS6-RC-Solve @L41'/)")
   if(Init==0) then
     write(Us,"('GenScramble:Import Data-Emulator.txt:AECAV(0:19,24,27):')")

     if(iP>5) write(iP,"(/,'GenScramble initializing @L45')")
    !-- Import AECAV:
     if(iP>5)write(iP,"('Import AECAV(0:19,24,27): 2025.01.05.1946:')")
     open(11, file='Data-Emulator.txt', action='read' &
            , access='sequential'     , status='old'    )
       read(11,"(////)")  !Skips the first 5 lines
      !write(13,"(/'             | D  |  E  |  F  |  G  |  H  |  I  |' )")
!!     write(13,"( '           0  1  2  3  4  5  6  7  8  9  A  B  C',\)")
!!     write(13,"('| D  E  F  G  H  I  _'/)")
       do nV = 1,27
         do nA = 1,24
           read(11,*) nV2,nA2,AECAV(0:19,nA2,nV2)
          !write(13,"(2i4,':',20i3)") nV2,nA2,AECAV(0:19,nA2,nV2)
         enddo!nA 
       enddo!nV
     close(11)
     Init = 1
   endif!(Init==0)
  !--------------------------------------------------------
  !SRin = SrTestIn
  !call PrintSRrec(SrTestIn,iP,'The input to GenScramble')
   if(iP>5) write(iP,"('Mtot = ',i2,' Vtot = ',i2)") Mtot,Vtot
   if(iP>5) write(iP,"('Voters: ',:,20(i2,','))") Ein%V(1:Vtot)

   Ein%VA     = 1 
  !Cycle through the Moves
   do nM = 1,Ein%Mtotvis
     VAn(1:20)  = Ein%VA(1:20)
     nCe = Ein%MCvis(nM)
     !cycle through all the active cells: 
     do nV = 1,Vtot;   nVE = Ein%V(nV)     
      !Here's the beef: the face rotation changes one cell's attitude:
       Ein%VA(nV) = AECAV(nCE,VAn(nV),nVE)
      !     ... & the cell`s attitude character symbol is updated:
       Ein%cVAtest(nV:nV) = char(Asymbol(Ein%VA(nV)))
     enddo!nV
     
     if(iP>5) then
       write(iP,"( 'Move Choice = ',i2,'   ',:,20a1)") &
                 nCe,char(Asymbol(AECAV(nCE,1,Ein%V(1:Vtot))))
       write(iP,"(8x,:,20(i2,','))") AECAV(nCE,1,Ein%V(1:Vtot))
      
       write(iP,"('result#',i3,9x,:,20a1)") &
                             nM,char(Asymbol(Ein%VA(1:Vtot)))
       write(iP,"(8x,:,20(i2,','))") Ein%VA(1:Vtot)
     endif!(iP>5)
   enddo!nM
  !Modelling completed. ----------------------- in four lines of Fortran
   call PrintErec(Ein,iP,'GenScramble output @L93')
                                                                         return
End Subroutine GenScramble  
!---------------------------------------------------------------------------7 9

Subroutine SolveScramble(iP)
!2025.01.25.1445cst JMS- !Exercises the scramble defined by Ein in a .nml file. 
!--Globals
 use MS1Def   ,only: Ur,Us,Ut,LExists,iAlloc
 use MS2RCDef ,only: SRrec,resetSR,AECAV,Rtot8,C,MC               &
                    ,Erec,Ein,EinW,RubSize,Sfound8,Vtot,V,Asymbol &   
                    ,AlV,Csymbol,nCinv4                           &
                    ,SrTestIn,Mtot,MC,Ctot,C,Vtot,V,Ztot,Z  
!--End Globals
 implicit none
 !--Arguments
  integer(4)::iP     !Write enable>5: write(iP,...)
 !--Internals
  integer(4)::Init
  integer(4)::nV,nV2 !Voter - index
  integer(4)::nA,nA2 !Choice- index

  integer(1)::nC ,Nc1 !the Symbolic move
  integer(4)::nC4,Nc4m

  integer(1)   ::VtotL
  integer(4)   ::VAin(20)  !    The votes  [1:VtotL] 
  character(20)::cVAin     !Sortable character version of VAin(1:Vtot)
  integer(4)   ::VAout(20) !    The votes  [1:VtotL] 
  character(20)::cVAOut    !Sortable character version of VAiout(1:Vtot)

  integer(4)::iDiscord(0:9)!Function results(i.e.:output:returned values)
                           !(0) is the sum, =-1:all invalid
                           !(1): R3-08161920-12-RrToDis.bim
                           !(2): R2C-1234567-6-RrToDis.bim
                           !(3): R3E-091011121314151718-6-RrToDis.bim
  integer(4)::iDscd01(-18:18)
  integer(4)::iDscd18(-18:18)
  integer(4)::i,nOrder(0:9)
  integer(4)::VAhell(20) =  & !a scramble from hell:
        (/ 7,10,23,13,23,15,22,14, 4,18,10,14,18, 2,11,22,19,22, 8,22/)
!       (/ 3,7,1,9,16,1,6,13,1,5,1,10,5,2,10,1,5,13,10,2,5,10,13/) move choices

  integer(4)::iPrint,iP2

  integer(4)::VA159(20) =  & !Result of moves ->1->5->9 -> "tdtfbdkadtffbdkadbaa"
            (/20, 4,20, 6, 2, 4,11, 1, 4,20, 6, 6, 2, 4,11, 1, 4, 2, 1, 1/)

  integer(4)::VAprev(20) = & !Choice #2
    (/ 3, 1, 3, 1, 3, 1, 3, 1, 1, 3, 1, 1, 3, 1, 3, 1, 1, 3, 1, 1/)
  integer(4)::VAnew( 20)
  integer(4)::VAnow( 20) = &  !Choice #6
    (/ 5, 5, 1, 1, 5, 5, 1, 1, 5, 1, 1, 1, 5, 5, 1, 1, 5, 1, 1, 1/)
 type(Erec)::Euse,Euse2  !Accumulates moves. 
  character*2::cMC
  !--EndDefs-----------------------------------------------

   if(iP>5) write(iP,"(/'SolveScramble:    MS5-RC-Solve@L148'/)")
   if(Init==0) then
     write(Us,"('SolveScramble:Import Data-Emulator.txt: AECAV(0:19,24,27):')")

     if(iP>5) write(iP,"(/,'SolveScramble initializing @L152')")
    !-- Import AECAV:
     if(iP>5)write(iP,"('Import AECAV(0:19,24,27): 2025.01.05.1946:')")
     open(11, file='Data-Emulator.txt', action='read' &
            , access='sequential'     , status='old'    )
       read(11,"(////)")  !Skips the first 5 lines
       do nV = 1,27
         do nA = 1,24
           read(11,*) nV2,nA2,AECAV(0:19,nA2,nV2)
          !if(iP>5) &
          !write(iP,"(2i4,':',20i3)") nV2,nA2,AECAV(0:19,nA2,nV2)
         enddo!nA 
       enddo!nV
     close(11)
     Euse = Ein
     Init = 1
   endif!(Init==0)
  !--------------------------------------------------------
 !Ein% input:
   VtotL            = Ein%Vtot 
   VaIn             = 0
   VAin(1:VtotL)    = Ein%VA(1:VtotL)
   do i=1,20
     cVAin(i:i)      = char(Asymbol(VAin(i)))
   enddo!i
  !                 VtotL = 20
   call Concatenate(VtotL,VAnew,VAnow,VAprev, 0) !or iP

!  if(iP>5) write(iP, &
!    "(/,'SolveScramble testing AllMoves  @L181 - works!')")
                 VtotL=20; VAprev=1; nC4=1  !aaaaaaaaaaaaaaaaaaaa
   call AllMoves(VtotL,VAnew,VAprev, 0)     !aaaaaaaaaaaaaaaaaaaa

   if(0>1) then !This bypasses a deep scramble printout of non-quad edge cells
!%Mused  = 18  %MC(1:18) = 1 1 5 5 9 9 1 6 A 2 5 5 2 5 9 9 1 6
              VAprev = VAnew
   call AllMoves(VtotL,VAnew,VAprev, 1 ,iP) ! 1   0 0    0  0  0  0  
              VAprev = VAnew
   call AllMoves(VtotL,VAnew,VAprev, 1 ,iP) ! 2
              VAprev = VAnew
   call AllMoves(VtotL,VAnew,VAprev, 5 ,iP) !
              VAprev = VAnew
   call AllMoves(VtotL,VAnew,VAprev, 5 ,iP) !
              VAprev = VAnew
   call AllMoves(VtotL,VAnew,VAprev, 9 ,iP) !
              VAprev = VAnew
   call AllMoves(VtotL,VAnew,VAprev, 9 ,iP) !
              VAprev = VAnew
   call AllMoves(VtotL,VAnew,VAprev, 1 ,iP) !
              VAprev = VAnew
   call AllMoves(VtotL,VAnew,VAprev, 6 ,iP) !
              VAprev = VAnew
   call AllMoves(VtotL,VAnew,VAprev,10 ,iP) !
              VAprev = VAnew
   call AllMoves(VtotL,VAnew,VAprev, 2 ,iP) !10
                 VAprev = VAnew
   call AllMoves(VtotL,VAnew,VAprev, 5 ,iP) !
              VAprev = VAnew
   call AllMoves(VtotL,VAnew,VAprev, 5 ,iP) !
              VAprev = VAnew
   call AllMoves(VtotL,VAnew,VAprev, 2 ,iP) !
              VAprev = VAnew
   call AllMoves(VtotL,VAnew,VAprev, 5 ,iP) !
              VAprev = VAnew
   call AllMoves(VtotL,VAnew,VAprev, 9 ,iP) !
              VAprev = VAnew
   call AllMoves(VtotL,VAnew,VAprev, 9 ,iP) !
              VAprev = VAnew
   call AllMoves(VtotL,VAnew,VAprev, 1 ,iP) !
              VAprev = VAnew
   call AllMoves(VtotL,VAnew,VAprev, 6 ,iP) !18
              VAprev = VAnew
   endif!(0>1) bypass.

   call AtoD(VtotL,VAout,iDiscord,iP)  !initializes AtoD Zones & returns

!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
   do iPrint = 1,2      !Prints to Screen & then iP >=10:
     select case(iPrint)
      case(1); iP2 = 6 
      case(2); iP2 = iP; if(iP2<10) exit
     end select!(iPrint)
   call PrintErec(Ein,iP2,'SolveScramble input @L236')
   write(iP2, &
    "(/,50('|') ,//, 'Move = 0 closes this program.')")
   write(iP2, &
    "(/,'Negatives of Move Sequence values will deconstruct the scramble')")
   write(iP2, &
    "(  'to solved by post-multiplication.',/ )")
   write(iP2, &
    "(  'Otherwise, pick any move that reduces the Discord of a Zone, &' )")
   write(iP2, &
    "(  'thus the 2x2x2 RC will solve in a mimimum number of moves.',/   )")
   write(iP2, &
    "(  'Move#0 shows the individual zone Discord(s) and order(s).'      )")
   write(iP2, &
    "(  '          Order: the number of self-concatenations to solved.',/)")
   write(iP2, &
    "(  'For 2x2x2`s: now = ____ is only Zone:[1,2,3,4,5,6,7]'           )")
   write(iP2, &
    "(  'For 3x3x3`s: now = ____  is Zone#1  followed by'                )")
   write(iP2, &
    "(  '             now = ____  the sum of Zone#2 & #3',/              )")
   write(iP2, &
    "(50('|'),/,'Previous move [-18:18] =  0'                            )")
   enddo!i
!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

10 continue
   if(iP>5) write(iP,"(/,'cVAin = ',12x,a20))") cVAin

!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
   do iPrint = 1,2      !Prints to Screen & then iP >=10:
     select case(iPrint)
      case(1); iP2 = 6 
      case(2); iP2 = iP; if(iP2<10) exit
     end select!(iPrint)
     write(iP2, &
      "('The current scramble, pre-mult`s on left, post-mults on right:')")
     write(iP2,"('Moves:(',i2,':1)  =   ',\)") Euse%Mtotvis
     do i = Euse%Mtotvis,1,-1
       if(Euse%MCvis(i)>0) write(cMC,"('+',a1)") Csymbol(     Euse%MCvis(i)  )
       if(Euse%MCvis(i)<0) write(cMC,"('-',a1)") Csymbol( abs(Euse%MCvis(i)) )
       if(mod(i,20)/=0) then
         write(iP2,"(a2,      ',',\)") cMC
        else
         write(iP2,"(a2,/,17x,',',\)") cMC
       endif!(mod(i,20)/=0)                                       
     enddo!i
     write(iP2,*)
     select case(RubSize)
      case(2);   write(iP2,"('Ztot = ',i1,13x,'Discord:     Order:'     )")Ztot
                 write(iP2,"('Move#  Attitudes:    Zone#: ',\        )")
      case(3);   write(iP2,"('Ztot = ',i1,21x,'Discord:          Order:')")Ztot
                 write(iP2,"('Move#  Attitudes:     Zone#:',\        )")
     end select!(RubSize)

     do i=1,Ztot;write(iP2,"(i4,\  )") Z(i) ;enddo!i
                 write(iP2,"('    :',\)")         
     do i=1,Ztot;write(iP2,"(i5,\)  ") Z(i) ;enddo!i 
                 write(iP2,*)        
   enddo!i
!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

  !Cycle through all the Move Choices: 
   do nC = -18,18; Nc4 = Nc;  Nc4m =  nC4
!  do nC =   0, 0; Nc4 = Nc;  Nc4m =  nC4
     if(RubSize==2) then
       select case(abs(nC))
        case(3,4,7,8,11,12,14,16,18); cycle
       end select!(abs(nC))
     endif!RubSize==2)
      VtotL = Vtot
      VAout = VAin
     cVaout = cVAin
     if(nC==0) goto 20  !...report the input case
                call AllMoves(VtotL,VAout, VAout,nC4m, 0) !iP
     do nV = 1,VtotL     
       cVAout(nV:nV) = char(Asymbol(VAout(nV)))
     enddo!nV
20   continue
     nOrder = 1
    !if(iP>5) write(iP,"('nC = ',i2,' cVAout = ',a20,'  @L297'))") nC,cVAout
    !Evaluate the resulting Discords:
     call AtoD(VtotL,VAout,iDiscord, 0) !iP    <- Discords computed here
     call ComputeOrder(VtotL,VAout,nOrder, 0)    
     nC4 = nC; iDscd18(nC4) = iDiscord(0)
               iDscd01(nC4) = iDiscord(1)
    !if(RubSize==2) iDscd18(nC4) = iDiscord(2)

!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
     do iPrint = 1,2      !Prints to Screen & then iP >=10:
       select case(iPrint)
        case(1); iP2 = 6 
        case(2); iP2 = iP; if(iP2<10) exit
       end select!(iPrint)
       if(nC==0)    write(iP2,*)
       if(nC <0)    write(iP2,"(i3,1x,'-',a1,1x,a20,\)")  &
                                nC,char(Csymbol(abs(nC4))),cVAout
       if(nC==0)    write(iP2,"(i3,1x,' ',a1,1x,a20,\)")  &
                                nC,char(Csymbol(abs(nC4))),cVAout
       if(nC >0)    write(iP2,"(i3,1x,'+',a1,1x,a20,\)")  &
                                nC,char(Csymbol(abs(nC4))),cVAout
                    write(iP2,"(' ',\) ")
       do i=1,Ztot; write(iP2,"(i4,\)  ") iDiscord(i) ;enddo!i         
                    write(iP2,"('     ',\)")
       do i=1,Ztot; write(iP2,"(i5,\)  ") nOrder(i)   ;enddo!i         
                    write(iP2,*)
       if(nC==0)    write(iP2,*)
       if((nC<18).and.(RubSize==3))cycle        
       if((nC<17).and.(RubSize==2))cycle        
       write(iP2,"(24x,'max:',:,10i4)") &
                                        EinW(Z(1:Ztot))%mTot         
       write(iP2,"(8x,'Pre-multiplies:',15x,'Post-multiplies:')")
       write(iP2,"('Move#`s:','  1   2  13D     3   4  14E',\ )")
       write(iP2,"(        4x,' -1  -2 -13     -3  -4 -14'    )")
       write(iP2,"(        8x,'  5   6  15F     7   8  16G',\ )")
       write(iP2,"(        4x,' -5  -6 -14     -7  -8 -16'    )")
       write(iP2,"(        8x,'  9  10A 17H    11B 12C 18I',\ )")
       write(iP2,"(        4x,' -9 -10 -17    -11 -12 -18'    )")
       write(iP2,"('   -:   -90 +90 180 +: -90 +90 180',\     )")
       write(iP2,"(  ' -:  -90 +90 180 +: -90 +90 180'        )")
!The build environment hung on this line of code:
!      write(iP2,"( 'Z#2+Z#3 =',i3,',35x,' <-for all move#`s:')")  iDscd18(0)
       write(iP2,"( '   X:  ',3i4,3x,3i4,4x,3i4,3x,3i4,' :Z#1')")             &
  iDscd01( 1),iDscd01(  2),iDscd01( 13),iDscd01(  3),iDscd01(  4),iDscd01( 14)&
 ,iDscd01(-1),iDscd01( -2),iDscd01(-13),iDscd01( -3),iDscd01( -4),iDscd01(-14) 
       write(iP2,"( '   Y:  ',3i4,3x,3i4,4x,3i4,3x,3i4,'  now =',i5)")        &
  iDscd01( 5),iDscd01(  6),iDscd01( 15),iDscd01(  7),iDscd01(  8),iDscd01( 16)&
 ,iDscd01(-5),iDscd01( -6),iDscd01(-15),iDscd01( -7),iDscd01( -8),iDscd01(-16)&
                                                                 ,iDscd01(  0)
       write(iP2,"( '   Z:  ',3i4,3x,3i4,4x,3i4,3x,3i4)")                     &
  iDscd01( 9),iDscd01( 10),iDscd01( 17),iDscd01( 11),iDscd01( 12),iDscd01( 18)&
 ,iDscd01(-9),iDscd01(-10),iDscd01(-17),iDscd01(-11),iDscd01(-12),iDscd01(-18)
       if(RubSize==2) cycle
       write(iP2,"( 3x,2(5x,11('-'),4x,11('-')) )")  !dividing line
       write(iP2,"( '   X:  ',3i4,3x,3i4,4x,3i4,3x,3i4,' :Z#2+Z#3')")         &
  iDscd18( 1),iDscd18(  2),iDscd18( 13),iDscd18(  3),iDscd18(  4),iDscd18( 14)&
 ,iDscd18(-1),iDscd18( -2),iDscd18(-13),iDscd18( -3),iDscd18( -4),iDscd18(-14) 
       write(iP2,"( '   Y:  ',3i4,3x,3i4,4x,3i4,3x,3i4,'  now =',i5)")        &
  iDscd18( 5),iDscd18(  6),iDscd18( 15),iDscd18(  7),iDscd18(  8),iDscd18( 16)&
 ,iDscd18(-5),iDscd18( -6),iDscd18(-15),iDscd18( -7),iDscd18( -8),iDscd18(-16)& 
                                                                 ,iDscd18(  0)
       write(iP2,"( '   Z:  ',3i4,3x,3i4,4x,3i4,3x,3i4)")                     &
  iDscd18( 9),iDscd18( 10),iDscd18( 17),iDscd18( 11),iDscd18( 12),iDscd18( 18)&
 ,iDscd18(-9),iDscd18(-10),iDscd18(-17),iDscd18(-11),iDscd18(-12),iDscd18(-18)
     enddo!iPrint
!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

   enddo!nC
   if(iP<6)                                                              return
30 write( 6,"(50('|'),/'input next move [-18:18] = ',\)")
   read(5,*,err=30) nC
   if(iP>6) &
   write(iP,"(50('|'),/,'Previous move [-18:18] =',i3)") nC
   call SaveOutFile
   nC4 = nC

   if(RubSize==2) then
     select case(abs(nC))
      case(3,4,7,8,11,12,14,16,18); goto 30
     end select!(abs(nC))
   endif!RubSize==2)


   select case(nC)
    case(19)
     write( 6,"('cVAin = ',a20,'   Solved:')") cVAin
     write( 6,"('        _______a_______a__aa  = quad')")
     write( 6,"('        aaaaaaaa_______a__aa  =   & corners')")
     write( 6,"('        _______aaaaaaaaaaaaa  =   & edges')")
     write( 6,"('        aaaaaaaaaaaaaaaaaaaa  = all')")
     if(iP>6) then
       write(iP,"('cVAin = ',a20,'   Solved:')") cVAin
       write(iP,"('        _______a_______a__aa  = quad')")
       write(iP,"('        aaaaaaaa_______a__aa  =   & corners')")
       write(iP,"('        _______aaaaaaaaaaaaa  =   & edges')")
       write(iP,"('        aaaaaaaaaaaaaaaaaaaa  = all')")
       write(iP,"(' = (/', 8(i2,','),'/)')") VAin(1: 8)
       write(iP,"(' = (/',12(i2,','),'/)')") VAin(9:20)
     endif!(iP>6)
                                                                        goto 30
    case( :-19,0,20:);                                                       return
    case(-18:-1,1:18)       
    !The concatenation-based emulator:
                                     nC4m =  nC4
     call AllMoves(VtotL,VAout, VAin,nC4m, 0) !or iP

    !The moves-based emulator:
    !do nV = 1,VtotL     
    ! !Here's the beef: how a face rotation choice changes each cell's attitude:
    !  VAout(nV) = AECAV(nC4,VAin(nV),nV)
    ! !                 ... & the cell`s attitude character symbol is updated:
    !  cVAout(nV:nV) = char(Asymbol(VAout(nV)))
    !enddo!nV

      Vain =   VAout
      do nV = 1,VtotL
        cVAout(nV:nV) = char(Asymbol(VAin(nV)))
      enddo!nV  
     cVAin =  cVAout;                                          goto 40 !goto 10
   end select!(nC)

  !Parse pre- & post- multiplication:
40 Euse2         = Euse
   Euse2%Mtotvis = Euse%Mtotvis+1    
   select case(nC)
    case(-18:-1 ) !Pre-multiplication - inserted before the first:
     Euse2%MCvis(2:Euse2%Mtotvis) = Euse%MCvis(1:Euse%Mtotvis)   
     Euse2%MCvis(1              ) = nC4
    case(  1: 18) !Post-multiplication - appended to the last:
     Euse2%MCvis(  Euse2%Mtotvis) = nC4 
   end select!(nC)
   Euse = Euse2                                                        ;goto 10
!                                                                        return
End Subroutine SolveScramble  
!---------------------------------------------------------------------------7 9

Subroutine AtoD(VtotL,VAin,iDiscord2,iP)
!2025.01.22.1920cst JMS- Zones evaluated are defined by Ein in a .nml file.
!                      - Rubik's Cube 2x2x2 & 3x3x3 Discord evaluation.
!                          The Output is iDiscord2(0:9)

!Wisdom Zone#1 generation: forward-right-lower quad- cells 
!01/21/2025  01:49 PM  select     6,359 MS-RC-R3Q-08161920-12.nml
!                                                [8,16,19,20]
!01/21/2025  01:56 PM  ZoneGen   25,935       R3Q-08161920-12-Summary.txt
!01/21/2025  01:56 PM  init       2,696       R3Q-08161920-12-Ein.bim
!01/21/2025  01:56 PM  Discord  253,440       R3Q-08161920-12-RrToDis.bim

!Wisdom Zone#2 generation: 7 non=quad corners -  also the 2x2x2 solution
!                                                [1,2,3,4,5,6,7]
!01/16/2025  04:08 PM  select     6,331 MS-RC-R2C-1234567-6.nml
!01/16/2025  05:31 PM  ZoneGen   33,180       R2C-1234567-6-Summary.txt
!01/16/2025  05:24 PM  init       2,696       R2C-1234567-6-Ein.bim
!01/16/2025  05:31 PM  Disc. 11,022,480       R2C-1234567-6-RrToDis.bim

!Wisdom Zone#3 generation: 9 non=quad edges of a 3x3x3:
!                                                 [9,10,11,12,13,14,15,17,18]
!01/17/2025  07:45 PM  select     7,968 MS-RC-R3E-091011121314151718-6.nml
!01/18/2025  02:46 AM  ZoneGen   43,300       R3E-091011121314151718-6-Summary.txt
!01/18/2025  12:33 AM  init       2,696       R3E-091011121314151718-6-Ein.bim
!01/18/2025  02:46 AM  Disc.185,794,560       R3E-091011121314151718-6-RrToDis.bim

!This only operates on Vtot=8 or Vtot=20 all-vote strings.
!--Globals
 use MS1Def   ,only: Ur,Us,Ut,LExists,iAlloc
 use MS2RCDef ,only: Vgzero,resetVg,Vg,Csymbol                            &
                    ,resetSR,SRrec,Erec,Ein,Einreset,RubSize,Ctot,Asymbol

 use MS2RCDef ,only: Ztot,Z,EinW ,cZrFilename,nOrder                      &
                    ,Zone1,Zone2,Zone3,Zone4                              &
                    ,Zone5,Zone6,Zone7,Zone8,Zone9,ZonePnt 
!--End Globals
 implicit none
 !--Arguments
  integer(1)::VtotL
  integer(4)::VAin(20)    !The votes  [1:VtotL] 
 !4-groups
 integer(4)::iDiscord2(0:9)!Function results (i.e.:output:returned values)
                          !(0) is the sum, =-1:all invalid

  integer(4)::iP          !Write enable>5: write(iP,...)
 !--Internals
  integer(4)::Init 
  integer(8)::n8,H8a,Indexer
 type(Erec) ::EinSave
 type(SRrec)::Srin
 type(SRrec)::Sr1       !Indexer`s Sr argument
  character(60)::FileIn
  integer(4)::i,n,nin,nU,nZi,nZ,Vtw
  integer(4)::iDiscord(0:9)
  !--EndDefs-----------------------------------------------
   EinSave = Ein
   Ein     = EinReset
   SRin    = resetSR
   if(Init==0) then
     resetVg = Vgzero
     write(Us,"(/'AtoD():  initialization & data import:')")
     if(iP>5) &
     write(iP,"(/'AtoD():  initialization & data import:  @L484')")
     call PrintSRrec(Srin,iP,'Input to AtoD')

     EinW                   = EinReset
     Ztot                   = EinSave%Ztot
     Z(1:Ztot)              = EinSave%Z(1:Ztot)
     cZrFilename(Z(1:Ztot)) = EinSave%cZrFilename(Z(1:Ztot))
     iDiscord               = 0
     nOrder                 = 0

     if(iP>5) write(iP,"('Ztot=',i2,2x,9i2)") Ztot,Z
 
     do nZi = 1,Ztot; nZ = Z(nZi)
       if(iP>5) write(iP,"('nZ=',i2,2x,a60)") nZ,EinSave%cZrFilename(nZ)
       inquire(file = EinSave%cZrFilename(nZ), exist = LExists)
       if(LExists)then
         open(Ur, file  = EinSave%cZrFilename(nZ) , action='read' &
                , access='direct', recl= 2696     , status='old',err = 4)
           read(Ur, rec = 1, err = 4) EinW(nZ)
         close(Ur);
         call PrintErec(EinW(nZ),iP,'AtoD: EinW import @L504')          ;goto 5
4        pause "Error reading the file. Press enter to continue."
         close(Ur)
        else
         write(Us,"('Did not find: ',a60))") EinSave%cZrFilename(nZ)
         cycle
       endif!LExists
5      continue
       if(iP>5) write(iP,"('Allocating ',i12,' bytes for Discord data:')") &
                                          EinW(nZ)%Zonebimsize
       resetVg%cVgFileName(nZ) = EinW(nZ)%cRrtoDisBinary
       select case(nZ)
        case(1);allocate(Zone1(EinW(nZ)%Zonebimsize),stat=iAlloc)
                if(iAlloc==0)then; Zone1=-2; ZonePnt=>Zone1; endif
        case(2);allocate(Zone2(EinW(nZ)%Zonebimsize),stat=iAlloc)
                if(iAlloc==0)then; Zone2=-2; ZonePnt=>Zone2; endif
        case(3);allocate(Zone3(EinW(nZ)%Zonebimsize),stat=iAlloc)
                if(iAlloc==0)then; Zone3=-2; ZonePnt=>Zone3; endif
        case(4);allocate(Zone4(EinW(nZ)%Zonebimsize),stat=iAlloc)
                if(iAlloc==0)then; Zone4=-2; ZonePnt=>Zone4; endif
        case(5);allocate(Zone5(EinW(nZ)%Zonebimsize),stat=iAlloc)
                if(iAlloc==0)then; Zone5=-2; ZonePnt=>Zone5; endif
        case(6);allocate(Zone6(EinW(nZ)%Zonebimsize),stat=iAlloc)
                if(iAlloc==0)then; Zone6=-2; ZonePnt=>Zone6; endif
        case(7);allocate(Zone7(EinW(nZ)%Zonebimsize),stat=iAlloc)
                if(iAlloc==0)then; Zone7=-2; ZonePnt=>Zone7; endif
        case(8);allocate(Zone8(EinW(nZ)%Zonebimsize),stat=iAlloc)
                if(iAlloc==0)then; Zone8=-2; ZonePnt=>Zone8; endif
        case(9);allocate(Zone9(EinW(nZ)%Zonebimsize),stat=iAlloc)
                if(iAlloc==0)then; Zone9=-2; ZonePnt=>Zone9; endif
       end select!(nZ)
       if(iAlloc.ne.0) then
         write(Us, &
          "('  ...Allocation failed. iAlloc =',i6)") iAlloc
         stop'Halt: MS6-RS-Solve @L538' 
       endif

       open(Ur, file  = resetVg%cVgFileName(nZ) , action='read' &
              , access='direct', recl= EinW(nZ)%Zonebimsize, status='old')
         read(Ur, rec = 1, err = 9) ZonePnt
       close(Ur)                                                       ;goto 10
 9     pause "Error reading the binary Discord file. Press enter to continue."
       close(Ur)
       cycle
10    resetVg%Maskneed(1:20,nZ) = EinW(nZ)%ZMaskNeed
      resetVg%Maskfor1(1:20,nZ) = EinW(nZ)%ZMaskfora 
     enddo!nZ
     write(6,"(a1)") char(7) !Beep

     call SaveOutFile;                             write(6,"(a1)") char(7)!Beep
!////////////////////////////////////////////////////////////////////
      write(Us,"('Subroutine AtoD(): initialized.',/)")
     !call PrintSRrec(Srin,iP,'AtoD post initialization')    
      iDiscord2= 0
      if(iP>5) &
       write(iP,"(/'AtoD():  initialization completed  @L559',/)")
      Ein = EinSave
      Init     = 1                                                      ;return
    endif!(Init==0)) --------------------------------------

  !Normal processing: |||||||||||||||||||||||||||||||||||||  VtotL, 
   Vg      = resetVg

  !Unpack all the Attitude values in Srin:
   do n = 1,VtotL 
     Vg%V( n)  = n
     Vg%VA(n)  = VAin(n)
   enddo!n
   iDiscord2(0:Ztot) = -1 !initialize all invalid           !*****
   Vg%iDiscord   =  iDiscord2

   if(iP>5) then
     write(iP, &
      "(/,80('|'),/,80('|'),/,'Subroutine AtoD():  MS6-RC-Solve @L577',/)")
     select case(VtotL)   
      case(8,20)
       write(iP, &
       "(        20a1       ,' :incoming Attitudes (i.e.Votes)')")Asymbol(VAin)   
       write(iP, &
       "('_______a_______a__aa :criteria of forward-right-down quad solved'/)")
      case default
       stop 'VtotL not 8 or 20    @L585'
     end select!(totL)
     write(iP,"( ' Vg%VA =', 8i3,'|',i2,11i3)") Vg%VA
   endif!(iP>5)

  !Process the wisdom groups:
   do nZi = 1,Ztot; nZ = Z(nZi)
!!!!!if((VtotL==8).and.(nV/=7)) cycle       !This may introduce a bug.     
     if(iP>5) &
     write(iP,"(/,'>>>> Processing Discord mask#',i2,' >>>> @L594',/)") nZ
     Ein     = EinReset
       Vg%iDiscord(nZ) = -1

       if(iP>5) then
         write(iP,"(     '      These cells are being evaluated...')")
         write(iP,"('nZ#',i1,'  Vg%Maskneed =', 8i3,'|',i2,11i3)") &
                     nZ,        resetVg%Maskneed(1:20,nZ)
       endif!(iP>5)

       do nU = 1,VtotL
         if( resetVg%Maskneed(nU,nZ)==0)                   cycle
         if((resetVg%Maskneed(nU,nZ)>0).and.(Vg%VA(nU)>0)) cycle
         goto 100
       enddo!nV

       if(iP>5) then
         write(iP,"(     '      These cells must already be solved...')")
         write(iP,"(     '      Vg%Maskfor1 =', 8i3,'|',i2,11i3)") &
                                resetVg%Maskfor1(1:20,nZ)
       endif!(iP>5)

       do nU = 1,VtotL
         if( resetVg%Maskfor1(nU,nZ)==0)                    cycle
         if((resetVg%Maskfor1(nU,nZ)>0).and.(Vg%VA(nU)==1)) cycle
         goto 100
       enddo!nV

       Sr1      = resetSR
       Sr1%Vtot = VtotL 

       Ein%nZ           =          nZ
       Ein%Vtot         = EinW(nZ)%Vtot
           Vtw          = Ein%Vtot
       Ein%V(1:Vtw)     = EinW(nZ)%V(1:Vtw)
       Ein%Ctot         = EinW(nZ)%Ctot
       Sr1%Vtot         =          Vtw
      !Sr1%VA(1:Vtw)    = Ein%VA(1:Vtw)
       Sr1%VA(1:Vtw)    = VAin(Ein%V(1:Vtw))

       RubSize          = EinW(nZ)%RubSize
       Ctot             = Ein%Ctot

      !Compute the index holding nV`s vote:
       do i = 1,Sr1%Vtot
         Sr1%cVAsymb(i:i) =  char(Asymbol(Sr1%VA(i)))
       enddo!i  
       if(iP>5) write(iP,*)
       call PrintSRrec(Sr1,iP,'Indexer input  @L642')

                              nin = 0
       H8a          = Indexer(nin,Sr1, 0) !<- The Lookup table address,
                                          !     a recursive function.

       if(iP>5) write(iP,"('H8a = ',i12,5x,40('|'))") H8a
      !call PrintSRrec(Sr1,iP,'Indexer result @L649')

       if(H8a>0_8) then
        !Record the Discord as valid:
         select case(nZ)
          case(1); Vg%iDiscord(1) = Zone1(H8a)
          case(2); Vg%iDiscord(2) = Zone2(H8a)
          case(3); Vg%iDiscord(3) = Zone3(H8a)
          case(4); Vg%iDiscord(4) = Zone4(H8a)
          case(5); Vg%iDiscord(5) = Zone5(H8a)
          case(6); Vg%iDiscord(6) = Zone6(H8a)
          case(7); Vg%iDiscord(7) = Zone7(H8a)
          case(8); Vg%iDiscord(8) = Zone8(H8a)
          case(9); Vg%iDiscord(9) = Zone9(H8a)
         end select!(nV)
         iDiscord2(nZ) = Vg%iDiscord(nZ)
         if(iP>5) write(iP,"('Dis = ',i12,5x,40('|'))") iDiscord2(nZ)
        else
        !Record the Discord as invalid:
         Vg%iDiscord(nZ) = -1; iDiscord2(nZ) = Vg%iDiscord(nZ)
       endif!(H8a>0_8)

       call PrintSRrec(Sr1,iP,'Indexer result @L671')

      !Report results:
       if(iP>5) then   
         write(iP,"('nZ     =',i3,' Utot= ',i2,' U( 1:Utot) =',:,9i3)") &
                     nZ,        Sr1%Vtot,     Ein%V(1:Sr1%Vtot)
         write(iP,"('***iDiscord(nZ) =',i3,' UA(1:Utot) =',:,9i3)") &
                    Vg%iDiscord(nZ),Sr1%VA(1:Sr1%Vtot)
         write(iP,"('  H8a  =',i22)") H8a
       endif!(iP>5)
100    continue
   enddo!nZi

  !Compute iDiscord(0)
   if(VtotL==20) then
                         iDiscord2(0) =              - 1
     if(iDiscord2(2)>=0) iDiscord2(0) =                iDiscord2(2)
     if(iDiscord2(3)>=0) iDiscord2(0) = iDiscord2(0) + iDiscord2(3)
    else  
                        iDiscord2(0) =               iDiscord2(1)
  endif!(VtotL==20)
   iDiscord = iDiscord2
   if(iP>5) &
   write(iP,"(/'AtoD argument iDiscord(0:3) = ',10i3,'   @L694'))") iDiscord2
   if(iP>5) &
   write(iP,"('>>>> Discord mask computations done >>>>  @L696',/)")

   Ein = EinSave;                                                        return
End Subroutine AtoD
!---------------------------------------------------------------------------7 9

