!S6View8.f95         Group ID: #6     Stereo-3D Simulation Environment Vsn:1.00
!2025.05.24.1840cdt- Projection Matrix control

!            Author- Jeffrey M. Setterholm, Lakeville,MN 55044 USA
!         IP Status- Free source code (e.g.: post copyright)
!
!          Computer- "T3"/Dell Precision T3500/Intel i5 E5520/Win10Pro-21H2
!                     ^name ^Mfgr.Id           ^chipset       ^OS 
!                    /Absoft Pro Fortran 21.0.2/GeForce GTX 1050/f90gl~Glut3.7
!                     ^compiler ~Fortran 95     ^graphics card   ^graphics

!    f90gl bindings- public domain; see "https://math.nist.gov/f90gl/"

!Disclaimer:
! ***************************************************************
! **********   Individual cognition is always flawed,  **********
! **********         including yours and mine.         **********
! **********                 - So: -                   **********
! **********       Use this code at your own risk.     **********
! ***************************************************************

!Table of Contents: ...use to search...
! Subroutine View
! Subroutine ViewGeom(iP)
! Subroutine UnPackCv(Cv,D,E,N,F,L,R,T,B,Mx,Bx,My,By,Mz,Bz)
! Subroutine UnPackDv(Dv,N2,F2,L2,R2,T2,B2,Mi,Bi,Mh,Bh,Mv,Bv)
!---------------------------------------------------------------------------7-9

Subroutine View
!2020.06.29.2055cdt JMS- CallBack- User(i.e.your) View generator:
!                      - ThreePhase=3 bypassed & removed.
!--Globals                                                      in S1ModDef.f95
 use ViewDef,only: ThreePhase,Key,V,jVG &
     ,cVuModeName,cEyeName,cSplitName
 use OpenGLRec,only:  &        !Ref: OpenGL GL/GLU/GLUT docs
      glBegin     ,glClear      ,glClipPlane,glColorMask   ,glDisable         &
     ,glEnable    ,glEnd        ,glFlush    ,glLoadIdentity,glLogicOp         &
     ,glMatrixMode,glMultMatrixd,glOrtho    ,glPopMatrix   ,glPushMatrix      &
     ,glvertex2d                                                              &
     ,GL_CLIP_PLANE0     ,GL_CLIP_PLANE1 ,GL_CLIP_PLANE2   ,GL_CLIP_PLANE3    &
     ,GL_CLIP_PLANE4     ,GL_CLIP_PLANE5 ,GL_COLOR_LOGIC_OP,GL_COPY_INVERTED  &
     ,GL_DEPTH_BUFFER_BIT,GL_DEPTH_TEST  ,GL_LINES         ,GL_MODELVIEW      &
     ,GL_OR              ,GL_PROJECTION                                       &
     ,glLightModelf      ,GL_LIGHT_MODEL_LOCAL_VIEWER

 use S2Callback,only:CheckGL   !OpenGL CB's, GlutHandoff, & glGetError
 use ioDef     ,only:Up,UpVerb,Us,Ut,iTeapot,NowView
 use ScreenDef ,only: &        !screen & colors
      ForceRGBA,Side,nCharCenXS,vScrnHVD,nCharMaxY,iScrnColor
 use MouseDef   ,only: iMouse7DoF
 use ModelDef   ,only: M7,hPoIRotate,Nnutate,NutateAng,Nutate7,Nutateh
 use HelpDef    ,only: &       !Help text block
      HhHelpView,nHelpLines,BufferHhHelpView
!--End Globals
 implicit none
 !--Internals
  integer(4)::iP
  integer(4)::i,iEye
  integer(4)::nRow,nCol
  character(len=80)::PText
  logical(4)::L0=.false.
  logical(4)::L1=.true.
  integer(4)::Init=0
  integer(4)::iMouse7DofL
  !--EndDefs-----------------------------------------------
  !--Visualization //////////////////////////////////////////////////
   iP=Up !; if(UpVerb==0) iP=0
   if(iP>5) then
     write(iP,"(/'View: ',44('\'))")
     write(iP,"( 'Key%VuMode     =',i2,2x,a17)") &
                  Key%VuMode,     cVuModeName(Key%VuMode)
     write(iP,"( 'Key%SplitScreen=',i2,2x,a32)") &
                  Key%SplitScreen,cSplitName(Key%SplitScreen)
   endif!iP>5
  !--  Precompute projection matrices & clipping planes:
   iMouse7DofL=iMouse7DoF
   ForceRGBA=0
   call ViewGeom(iP)

  !--Enable the lateral clipping planes:
   call glMatrixMode(GL_PROJECTION)
  !--Pass the clipping planes to OpenGL (T-2 only has six):
   call glClipPlane(GL_CLIP_PLANE1,V%Clip(1:4,1))
   call glClipPlane(GL_CLIP_PLANE2,V%Clip(1:4,2))
   call glClipPlane(GL_CLIP_PLANE3,V%Clip(1:4,3))
   call glClipPlane(GL_CLIP_PLANE4,V%Clip(1:4,4))
   call glClipPlane(GL_CLIP_PLANE5,V%Clip(1:4,5))
   call glClipPlane(GL_CLIP_PLANE0,V%Clip(1:4,6))            ;call glFlush

   do iEye=-1,1; if(V%iFh(iEye)==0) cycle !//////
     Key%iEye = iEye
         Side = Key%SplitScreen*iEye
     if(iP>5) write(iP,"(/'Vision loop: iEye=',i3,' Split=',i3,' Side=',i3)") &
                                        iEye  ,Key%SplitScreen,  Side
     call glMatrixMode(GL_PROJECTION) ;call glLoadIdentity
     call glMatrixMode(GL_MODELVIEW)  ;call glLoadIdentity
     ForceRGBA=0

    !--Draw SplitScreen boundaries:
     if((iEye<1).and.(Key%SplitScreen/=0)) then
       call Colors3D( 3)  !Gray
       call glBegin(GL_LINES)
         call glvertex2d(-.999d0, -1.d0);call glvertex2d(-.999d0, +1.d0)!OnLeft
         call glvertex2d( .0d0, -1.d0);call glvertex2d( .0d0, +1.d0) !On C/L
         call glvertex2d(+1.d0, -1.d0);call glvertex2d(+1.d0, +1.d0) !On Right
       call glEnd
     endif!iEye<1 & Key%SplitScreen/=0

    !--Visualization control:
    !--Initialization & background number crunching: ------------------
     ThreePhase=1
     if(iP>5) &
       write(iP,"(/'~~~ ThreePhase=1  Background number crunching, if any:')")
     if(iEye<1) call CallYourApps

    !--Update variables & display 2D information: ---------------------
     ThreePhase=2
     if(iP>5) &
       write(iP,"(/'~~~ ThreePhase=2  Update variables & 2D screen info:')")
     call glMatrixMode(GL_PROJECTION) ;call glLoadIdentity
     call glOrtho( vScrnHVD(1,1),vScrnHVD(2,1) &   ! Left -to-right
                  ,vScrnHVD(1,2),vScrnHVD(2,2) &   !bottom-to- top
                  ,vScrnHVD(1,3),vScrnHVD(2,3)  )  !  far -to- near 2020.04.09
     call glMatrixMode(GL_MODELVIEW)  ;call glLoadIdentity
     ForceRGBA=0

     if(HhHelpView>0) then
    !-- Show the manual control options on the screen, then swapbuffers & exit:
       do i=1,nHelpLines
         write(PText,"(a73,a1)'")BufferHhHelpView(i),char(0)
                                                !White
         call PrntOrtho(i+10,nCharCenXS(Side)-37, 1, 0,PText)      !SwapBuffers
       enddo
       if(Key%SplitScreen==0) &
      !call TextToScreen(nRowIn,nColIn,iColor,iP)
       call TextToScreen(   1  ,   1  ,   1  , 0)
       cycle !...to end of iEye loop.
     endif !HhHelpView>0

    !--Point-of-Interest -or- Model Control- 7DoF ////////////
     if(Init==0) then
       call Motion7(0,iEye,iP)
       call Motion7(1,iEye,iP)
       Init=1
     endif!Init==0
     if(iP>5) write(iP,"('View - manual model control:')")
     call Motion7(iMouse7DoFL,iEye,iP)
     call Boilerplate(8)
                                              call glFlush;call CheckGL(+60145)
     call CallYourApps
                                              call glFlush;call CheckGL(-60147)
    !--Display 3D Graphics: -------------------------------------------
     ThreePhase=3;    ForceRGBA=0
     if(iP>5) &
       write(iP,"(/'~~~ ThreePhase=3  Draw/redraw app. 3D graphics:')")
     call glMatrixMode(GL_PROJECTION) ;call glLoadIdentity
     call glMatrixMode(GL_MODELVIEW)  ;call glLoadIdentity

    !--Enable clipping planes:
     call glMatrixMode(GL_PROJECTION)
     call glEnable(GL_CLIP_PLANE1)
     call glEnable(GL_CLIP_PLANE2)
     call glEnable(GL_CLIP_PLANE3)
     call glEnable(GL_CLIP_PLANE4)
     call glEnable(GL_CLIP_PLANE5)
     call glEnable(GL_CLIP_PLANE0)

    !--Upload the eye's UnitCube+Destination 14DoF transform:
     call glMatrixMode(GL_PROJECTION) ;call glLoadIdentity
     call glMultMatrixd(V%Fo(1:4,1:4,iEye))

    !--View(s) annotation(s):------------------------------
     if(NowView>0) then !------------------------
     PText=cEyeName(iEye)                           ;nRow=nCharMaxY
     if((Key%SplitScreen==0).and.(Key%VuMode==2)) &
     PText=cEyeName(  0 )                           ;nCol=nCharCenXS(Side)
     if((Key%SplitScreen/=0) .or.(Key%VuMode==2)) &                !White
                                      call PrntOrtho(nRow-3,nCol-10, 1,0,PText)
     if((iP>5).and.((Key%SplitScreen/=0) .or.(Key%VuMode==2))) &
            write(iP,*) PText
     PText=cVuModeName(Key%VuMode);   call PrntOrtho(nRow-2,nCol- 8, 1,0,PText)
     if(iP>5) write(iP,*) PText
     PText=cSplitName(Key%SplitScreen)
                                      call PrntOrtho(nRow-1,nCol-16, 1,0,PText)
                                              call glFlush;call CheckGL(+60181)
     endif!NowView>0

    !--Red|Cyan 3D display adjustments:
     if((Key%VuMode==2).and.(Key%SplitScreen==0)) then
       ForceRGBA=0
       if(iEye==-1) then; call Colors3D( 7)  !Left eye color & mask: Red
                          call glColorMask(L1,L0,L0,L1)
       endif!iEye==-1
       if(iEye==+1) then; call Colors3D(12)  !Left eye color & mask: Cyan
                          call glColorMask(L0,L1,L1,L1)
       endif!iEye==+1
       ForceRGBA=-1  !Locks in the color value.
                          call glEnable(GL_COLOR_LOGIC_OP) 
       if(iScrnColor==15) call glLogicOp(GL_OR)            !For Black screen
       if(iScrnColor== 1) call glLogicOp(GL_COPY_INVERTED) !For White screen
      !--Cleardepth at the beginning of pass#2:
       if(iEye==+1) call glClear(GL_DEPTH_BUFFER_BIT);             call glFlush
     endif! Key%VuMode==2 & Key%SplitScreen==0

    !--Draw the Point-of-Interest origin's rotation axis: ////////////////
     call glMatrixMode(GL_MODELVIEW); call glLoadIdentity
     if(Nnutate>0) call glMultMatrixd(Nutateh)
                   call glMultMatrixd(hPoIRotate)
                                              call glFlush;call CheckGL(+60205)
                  !call CubeGrid(1) !White
                                              call glFlush;call CheckGL(-60207)

    !--Upload the current 7DoF PoI transform: ///////
     call glMatrixMode(GL_MODELVIEW); call glLoadIdentity
    !  & Display the Modelview origin axis:
     if(Nnutate>0) call glMultMatrixd(Nutateh)
                   call glMultMatrixd(M7(0)%h)
     if(iTeapot.gt.3) call CubeGrid(3) !LLWhite
    !--Upload the current Object's 6DoF FS  transform: ///////
                   call glMultMatrixd(M7(1)%h);                    call glFlush
    !  & Display the teapot relative to the modelview origin:
     if(iTeapot.gt.0) call Teapot

    !if(iEye<1) call ShowProjectAndModel(-12,-48, 6,'UserView L326       ')
    !--Call your app:
                                              call glFlush;call CheckGL(+60222)
     call CallYourApps
                                              call glFlush;call CheckGL(-60224)
    !--Undo Red|Cyan 3D adjustments:
     if((Key%VuMode==2).and.(Key%SplitScreen==0)) then
       call glDisable(GL_COLOR_LOGIC_OP)
       call glColorMask(L1,L1,L1,L1)
       ForceRGBA=0
       call glEnable(GL_Depth_Test)
     endif! Key%VuMode==2 & Key%SplitScreen==0
   enddo!iEye

     call glMatrixMode(GL_PROJECTION)
     call glDisable(GL_CLIP_PLANE1)
     call glDisable(GL_CLIP_PLANE2)
     call glDisable(GL_CLIP_PLANE3)
     call glDisable(GL_CLIP_PLANE4)
     call glDisable(GL_CLIP_PLANE5)
     call glDisable(GL_CLIP_PLANE0)
     call glMatrixMode(GL_MODELVIEW)
   if(iP>5) write(iP,"('End View: ',40('/')/)")                 ;Side=0 ;return
End Subroutine View
!---------------------------------------------------------------------------7-9

Subroutine ViewGeom(iP)
!2020.06.19.0835cdt JMS- 14 defining coefficients -> Fh(4,4) vision transform
 use ViewDef,only: UnitCube0,Dv0,Key,V,Vreset,jVG,ClipLabel,ClipSymbolicLabel
 implicit none
 !--Arguments
  integer(4)::iP         ! >5: Printing enable, use: write(iP,...)
 !--Vector internal, values unpacked/repacked in V%_:
  real(8)   ::D ,E ,N ,F ,L ,R ,T ,B !See  S1ModDef.f95/
  real(8)   ::      Mx,Bx,My,By,Mz,Bz!  Module ViewDef for definitions.
  real(8)   ::      N2,F2,L2,R2,T2,B2!
  real(8)   ::      Mi,Bi,Mh,Bh,Mv,Bv!
 !--Internal
  real(8)   ::      N3,F3,L3,R3!,T3,B3!Temporary variables- bounds adjustments.
  real(8)   ::Clip(4,8)              !Exported to V%Clip
  real(8)   ::Fh(4,4)                !Exported to V%Fh
  integer(4)::iEye
  character::Label*26
  integer(4)::i,j,j0
! real(8)   ::v8(8)
  !--EndDefs-----------------------------------------------

   if(iP>5) write(iP,"('ViewGeom: 8DoF',36('\'))")
  !--Clear & rebuild V%_, the entire viewing geometry: \\\\
   V     = Vreset
   V%Key = Key     !Save the incoming key * flag values.
   jVG   = -2
  !--Define the 8DoF Viewed Volume: \\\\\\\\\\\\\\\\\\\\\\\
   select case(Key%Cube)
    case(0) !Default screen volume (centimeters)
     V%Mult0        = UnitCube0( 0 )
     V%Cv(1: 8,jVG) = UnitCube0(1:8)
    case(1) !User pre-defined UnitCube0(0:8)
     V%Mult0        = UnitCube0( 0 )
     V%Cv(1: 8,jVG) = UnitCube0(1:8)
    case(2) !Pixel-driven volume
    case(4) !Other user defined volume (TBD)
   end select !(Key%Cube)
  !--Multiply the Unit Cube vector my Mult0:
   if( V%Mult0<=0.d0)                               V%Mult0= 1.d0
   if( V%Mult0/=1.d0) V%Cv(1: 8,jVG)= V%Cv(1:8,jVG)*V%Mult0

  !--Screen N & F for reasonableness:
   call UnPackCv(  V%Cv(1:14,jVG),D,E,N,F,L,R,T,B,Mx,Bx,My,By,Mz,Bz)

  !--Diagnostic  2020.05.08: Balanced changes preserve geometric integrity!
  !N=N  +1.d0; F=F+1.d0
  !L=L  +2.d0; R=R+2.d0
  !T=T  +3.d0; B=B+3.d0
  !D=1000.d0
  !N=D*(2.D0-2.D0*D-F)/(D+2.D0*F)

   D=abs(D); E=abs(E)
   select case(Key%VuMode)
    case(-1) !--OpenGL ~raw screen coordinates
      V%Cv(1: 8,jVG)=(/0.d0,0.d0,-1.d0,1.d0,-1.d0,1.d0,-1.d0,1.d0/)
      call UnPackCv(V%Cv(1:14,jVG),D,E,N,F,L,R,T,B,Mx,Bx,My,By,Mz,Bz)
    case(0) !--Orthographic
     D=0.d0; E=0.d0
    case(1) !--Perspective
             E=0.d0
     if(N< -.999999d0*D) N=-.999999d0*D
    case(2) !--Stereo 3D
     if(N< -.999999d0*D) N=-.999999d0*D
     !--Bound at the near-field frustums overlap limit: ***confirm***
                         N3 =-D*(R-L)/((R-L)+2.d0*E)
     if( N3  >  N  ) N = N3
    !--Bound at the  far-field frustums overlap limit:  ***confirm***
     if((E+E)>(R-L))then;F3 = D*(R-L)/((E+E)-(R-L))
       if(F3 < F)    F = F3
     endif!(E+E)>(R-L)
   end select !(Key%VuMode)

  !--Halve or the lateral FoV for split screen viewing:
   select case(Key%SplitScreen)
    case(-1,+1); L=L/2.0d0; R=R/2.0d0 !Preserves apparent object size.
   end select!Key%Spli

   V%Cv(1:6,jVG)=(/D,E,N,F,L,R/) !Repack the modified variables.

  !--Construct the clipping planes: \\\\\\\\\\\\\\\\\\\\\\\
     clip       = 0.d0
   if(D==0.d0) then !D=0.: For an orthographic unit cube:  (A wag - debug.)
     Clip(1:4,1)= (/ -1.d0, 0.d0, 0.d0, -N   /) !Near
     Clip(1:4,2)= (/ +1.d0, 0.d0, 0.d0, +F   /) !Far

     Clip(1:4,3)= (/  0.d0,+1.d0, 0.d0, -L   /) !Left
     Clip(1:4,4)= (/  0.d0,-1.d0, 0.d0, +R   /) !Right
     Clip(1:4,5)= (/  0.d0, 0.d0,+1.d0, -T   /) !Upper
     Clip(1:4,6)= (/  0.d0, 0.d0,-1.d0, +B   /) !Lower

     Clip(1:4,7)= (/  0.d0, 0.d0, 0.d0, 0.d0 /) !undefined
     Clip(1:4,8)= (/  0.d0, 0.d0, 0.d0, 0.d0 /) !undefined
     j0=0

    else       !D>0.: For a projective unit cube:     (Previously worked.)
     Clip(1:4,1)= (/ -1.d0, 0.d0, 0.d0, -N   /) !Near
     Clip(1:4,2)= (/ +1.d0, 0.d0, 0.d0, +F   /) !Far

     Clip(1:4,3)= (/ -L-E ,   D , 0.d0, -D*L /) !Left -far -left
     Clip(1:4,4)= (/ -L+E ,   D , 0.d0, -D*L /) !Right-near-
     Clip(1:4,5)= (/  R-E ,  -D , 0.d0,  D*R /) !Right-far -right
     Clip(1:4,6)= (/  R+E ,  -D , 0.d0,  D*R /) !Left -near-

     Clip(1:4,7)= (/ -T   , 0.d0,   D , -D*T /) !Upper- unused
     Clip(1:4,8)= (/  B   , 0.d0,  -D ,  D*B /) !Lower-
     j0=8
   endif!D=0.
   V%Clip=Clip
   if(iP>5) then
     if (j0==0) write(iP,"(/'Orthographic clipping planes:')")
     if((j0==8).and.(E==0)) &
                write(iP,"(/'Projective perspective clipping planes E=0.:')")
     if((j0==8).and.(E/=0)) &
                write(iP,"(/'Projective stereo clipping planes:')")
     write(iP,"(' D=',f17.9,' N=' ,f17.9,' L=' ,f17.9,' T=' ,f17.9 )") &
                  D        ,  N        ,   L         ,  T
     write(iP,"(' E=',f17.9,' F=' ,f17.9,' R=' ,f17.9,' B=' ,f17.9)") &
                  E        ,  F        ,   R         ,  B
     do j=1,8; if((j>6).and.(j0==0)) exit
       write(iP,"(a7,1x,a64)") ClipLabel(j0+j),ClipSymbolicLabel(j0+j)
       write(iP,"(4f20.9)") Clip(1:4,j)
     enddo!j
   endif!iP>5

  !--Define the 6DoF Destination Display/Hardcopy \\\\\\\\\
   select case(Key%Dest)
    case(0) !Default screen output - OpenGL
     N2=-1.d0; L2=-1.d0; T2=-1.d0  !Redirect to OpenGL screen.
     F2=+1.d0; R2=+1.d0; B2=+1.d0
     V%Dv(1:6,jVG)=(/N2,F2,L2,R2,T2,B2/)
     Key%SFSOut= 0
    case(1) !User pre-defined Rv0(1:6)
     V%Dv(1:6,jVG) = Dv0
    case(2) !Default Pixel output
    case(4) !User defined output (TBD)
   end select !(Key%Dest)

   if(Key%VuMode==1) D=1.d6 !Compare with orthographic clipping plane values.

  !--Operate on each eye, or the monocular view: \\\\\\\\\\
   do iEye=-1,1 !; ForceRGBA= 0 !Defaulting to non-Red|Cyan viewing.
     jVG = iEye
!    Fu.ID=VuModeID(VuMode)
     select case(iEye) 
      case(  0  ); if (Key%SplitScreen/=0)                      cycle
                   if((Key%SplitScreen==0).and.(Key%VuMode==2)) cycle
      case(-1,+1); if((Key%SplitScreen==0).and.(Key%VuMode <2)) cycle
     end select!iSplt1

     if(iP>5) write(iP,"(/'iEye=',i2,' iSplit=',i2)") iEye,Key%SplitScreen
     call UnPackCv( V%Cv(1:14,-2),D,E,N,F,L,R,T,B,Mx,Bx,My,By,Mz,Bz)
    !--Starting with the Clipping Planes Unit Cube:
     V%Cv(1:14,jVG)=V%Cv(1:14,-2)
    !--Offset the eye spacing, if necessary:
     E = iEye*E

    !--Expand the vertical FoV x2, if necessary:
    !if(abs(iEye*Key%SplitScreen)==1) then
    !      T3 = 1.5d0*T -.5d0*B;     B3 = 1.5d0*B -.5d0*T
    !  T = T3                  ; B = B3
    !endif !iEye*iSplit/=0

     L3=L; R3=R
    !--Laterally expands the "other side" x2, if necessary:
     select case(iEye*Key%SplitScreen)
      case(-1); R3 = 2.d0 *R - L
      case(+1); L3 = 2.d0 *L - R
     end select!iSSide
     L =L3; R =R3

     V%Cv(1:8,jVG)=(/D,E,N,F,L,R,T,B/) !Repacking the eye's unit cube values.
    !--The eye's unit Cube vector is defined.

    !--Proceed with generating the homogeneous frustum \\\\\\\\\\\\\\
     call UnPackDv( V%Dv(1:12, -2),N2,F2,L2,R2,T2,B2,Mi,Bi,Mh,Bh,Mv,Bv)
    !--Destination intermediate values, for [ 0.,+1.]->[whatever]:
     Mi   = F2-N2 ; Bi = N2  !- in (depth)
     Mh   = R2-L2 ; Bh = L2  !- horizontal
     Mv   = B2-T2 ; Bv = T2  !- vertical
     V%Dv(1:12,jVG)=(/N2,F2,L2,R2,T2,B2,Mi,Bi,Mh,Bh,Mv,Bv/)

     call UnPackCv( V%Cv(1:14,jVG),D,E,N,F,L,R,T,B,Mx,Bx,My,By,Mz,Bz)
  !--The Unit Cube generator keys on whether there's depth D>0. or not D=0.
  !  With D=0. -> Proceed to- an orthographic- homogeneous transform
  !  With D>0. ->           -  a projective  -                         &
  !                  when Eye spacing E>0., slightly different projections
  !                                          result in 3D Stereo views.
     Fh=0.d0
     if(D==0.d0) then !----------------------------
       Label='D=0. Orthographic -> [0.,+1.]:'
      !--Orthographic Unit Cube intermediate values:
       Mx  = +1.d0/(F-N); Bx= -N/(F-N)
       My  = +1.d0/(R-L); By= -L/(R-L)
       Mz  = +1.d0/(B-T); Bz= -T/(B-T)
      !call h44Fill( Fh                            &  ![0.,+1.] -> Destination
      !             ,   Mx, 0.d0 , 0.d0 ,    Bx    &
      !             ,0.d0 ,    My, 0.d0 ,    By    &
      !             ,0.d0 , 0.d0 ,    Mz,    Bz    &
      !             ,0.d0 , 0.d0 , 0.d0 , 1.d0      )
       call h44Fill( Fh                            &!Concatenated ortho result:
                    ,Mi*Mx, 0.d0 , 0.d0 , Mi*Bx+Bi &
                    ,0.d0 , Mh*My, 0.d0 , Mh*By+Bh &
                    ,0.d0 , 0.d0 , Mv*Mz, Mv*Bz+Bv &
                    ,0.d0 , 0.d0 , 0.d0 , 1.d0      )

      else if(D>0.d0) then !D>0. ------------------
       Label='D>0. Projective [ 0.,+1.]:'
      !--Projective Unit Cube intermediate values:
       Mx = (F+D)/(F-N) ; Bx= -(D+N)*(F+D)/(F-N)
       My =   1. /(R-L) ; By= -   L       /(R-L)
       Mz =   1. /(B-T) ; Bz= -   T       /(B-T)
      !call h44Fill( Fh   &                      !User coordinates -> [ 0.,1.]
      !  ,    +Mx          ,  0.d0   ,  0.d0   , +D   *Mx    +   Bx &
      !  ,    +My*E+By     , +D  *My ,  0.d0   , +D   *By           &
      !  ,         +Bz     ,  0.d0   , +D  *Mz , +D   *Bz           &
      !  ,+1.d0            ,  0.d0   ,  0.d0   , +D                  )
       call h44Fill( Fh   &                    !Concatenated projective result:
         , Mi *Mx      +Bi , 0.d0    , 0.d0    ,+D*(Mi*Mx+Bi)+Mi*Bx &
         , Mh*(My*E+By)+Bh ,+D*Mh*My , 0.d0    ,+D*(Mh*By+Bh)       &
         , Mv*      Bz +Bv , 0.d0    ,+D*Mv*Mz ,+D*(Mv*Bz+Bv)       &
         ,+1.d0            , 0.d0    , 0.d0    ,+D                   )

      else                   !D<0.
       Label='D<0. Returning Fh=I:      '
       write(6,"(a1)") char(7) !beep
       Fh=0.d0; do i=1,4; Fh(i,i)=1.d0; enddo!i
     endif!D==0.d0
    !Save the values in V%
     V%Cv(1:14   ,jVG) = (/D,E,N,F,L,R,T,B,Mx,Bx,My,By,Mz,Bz/)
     V%Fh(1:4,1:4,jVG) = Fh
     V%iFh(       jVG) = 1

     if(iP>5) then
       write(iP,"('ViewGeom: ',30a1:)") (Label(i:i),i=1,len_trim(Label))
       write(iP,"(' D=',f17.9,' N=' ,f17.9,' L=' ,f17.9,' T=' ,f17.9 )") &
                    D        ,  N        ,   L         ,  T
       write(iP,"(' E=',f17.9,' F=' ,f17.9,' R=' ,f17.9,' B=' ,f17.9 )") &
                    E        ,  F        ,   R         ,  B
       write(iP,"(20x        ,' Mx=',f16.9,' My=',f16.9,' Mz=',f16.9 )") &
                                Mx        ,  My        ,  Mz
       write(iP,"(20x        ,' Bx=',f16.9,' By=',f16.9,' Bz=',f16.9/)") &
                                Bx        ,  By        ,  Bz
       write(iP,"(20x        ,' N2=',f16.9,' L2=',f16.9,' T2=',f16.9 )") &
                                N2        ,  L2        ,  T2
       write(iP,"(20x        ,' F2=',f16.9,' R2=',f16.9,' B2=',f16.9 )") &
                                F2        ,  R2        ,  B2
       write(iP,"(20x        ,' Mi=',f16.9,' Mh=',f16.9,' Mv=',f16.9 )") &
                                Mi        ,  Mh        ,  Mv
       write(iP,"(20x        ,' Bi=',f16.9,' Bh=',f16.9,' Bv=',f16.9 )") &
                                Bi        ,  Bh        ,  Bv
       if(Key%SFSOut==0) write(iP, &
         "('In ""Standard Flight Simulation Coordinates"":')")
       do i=1,4; write(iP,"(4f20.9)") (Fh(i,j),j=1,4); enddo

       if(Key%SFSOut==0) write(iP,"('Resequenced for GlScreen:')")
     endif!iP>5
     if(Key%SFSOut==0) call HfsToHgl(Fh,V%Fo(1  ,1  ,jVG) )
     if(Key%SFSOut==1 )                 V%Fo(1:4,1:4,jVG)=Fh
     if((iP>5).and.(Key%SFSOut==0)) then
       do i=1,4; write(iP,"(4f20.9)") (V%Fo(i,j,jVG),j=1,4); enddo
     endif!iP>5 & Key%SFSOut=0
   enddo!iEye
   if(Ip>5) write(Ip,"('End ViewGeom: ',36('/'))")
   return
End Subroutine ViewGeom
!---------------------------------------------------------------------------7-9

Subroutine UnPackCv(Cv,D,E,N,F,L,R,T,B,Mx,Bx,My,By,Mz,Bz)
!2020.05.23.1230cdt JMS- Unpacks a Unit Cube vector into its 14 components.
 implicit none
 !--Arguments
  real(8)   ::Cv(14)                       !Unit Cube- vector
  real(8)   ::D,E,N,F,L,R,T,B,Mx,Bx,My,By,Mz,Bz     !- individual values.
  !          1 2 3 4 5 6 7 8  9 10 11 12 13 14
  !--EndDefs-----------------------------------------------
   D = Cv(1); N = Cv( 3); L = Cv( 5); T = Cv( 7)
   E = Cv(2); F = Cv( 4); R = Cv( 6); B = Cv( 8)
              Mx= Cv( 9); My= Cv(11); Mz= Cv(13)
              Bx= Cv(10); By= Cv(12); Bz= Cv(14)                        ;return
End Subroutine UnPackCv
!---------------------------------------------------------------------------7-9

Subroutine UnPackDv(Dv,N2,F2,L2,R2,T2,B2,Mi,Bi,Mh,Bh,Mv,Bv)
!2020.05.23.1230cdt JMS- Unpacks a Destination vector into its 12 components.
 implicit none
 !--Arguments
  real(8)   ::Dv(12)                   !Destination- vector
  real(8)   ::N2,F2,L2,R2,T2,B2,Mi,Bi,Mh,Bh,Mv,Bv  !- individual values.
  !          1  2  3  4  5  6  7  8  9  10 11 12
  !--EndDefs-----------------------------------------------
              N2= Dv( 1); L2= Dv( 3); T2= Dv( 5)
              F2= Dv( 2); R2= Dv( 4); B2= Dv( 6)
              Mi= Dv( 7); Mh= Dv( 9); Mv= Dv(11)
              Bi= Dv( 8); Bh= Dv(10); Bv= Dv(12)                        ;return
End Subroutine UnPackDv
!---------------------------------------------------------------------------7-9
