!Sa-TubeMod.f95      Auxiliary        Stereo-3D Simulation Environment Vsn:1.00
!2025.05.24.1840cdt- Lines drawn as tubes with hemispherical ends.
!                 - Herein My understanding of lighting & materials is very
!                     limited; any expert could improve on the code.  

!            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...
!Module TubeDef
!  type,public::TubeRec:Tu(:),TuIn,TuZero
!  type,public::LightMaterialRec  ;sequence
!  contains
!  Subroutine Lighting(iOffOn)
!  Subroutine LightShow
!  Subroutine Material
!  Subroutine Tubes(iDone,nPoint,pXyzh,Radius,iP)
!  Subroutine Sphere(SphRad,pXyz)
!End Module TubeDef

!///////////////////////////////////////////////////////////////////////////7 9
Module TubeDef
!use TubeDef
!------------------------------------------------------------------------------
 type,public::TubeRec ;sequence                                     !2013.11.22
  integer(4)::n           !Number
  integer(4)::iSpare      !
  real(8)   ::C(4)        !Center
  real(8)   ::BangleD     !Bend angle (degrees)
  real(8)   ::iSphere     !>0:draw a sphere also... when BangelD >10. deg
  real(8)   ::Rdown       !Radius-(transverse to plane of bend, or of sphere)
  real(8)   ::Rout        !      -(in plane of bend) =Rdown/cosd(BangleD)
  real(8)   ::Vcln(1:5)   !Unit vector- C/L vector toward Tu(n+1).C- (5)= mag
  real(8)   ::Vdn( 1:5)   !           - down (transverse)          -
  real(8)   ::Von( 1:5)   !           - outward                    -
  real(8)   ::Ring(4,0:36)!Ring of points- around Tu(n).C
  real(8)   ::RingN(4,0:36)!             - vertex normals
 end type     TubeRec ;type(TubeRec),public,allocatable::Tu(:) !(0:LM%nTubes)
                       type(TubeRec),public            ::TuIn,TuZero

 !-----------------------------------------------------------------------------
  !----- Light & material characterization: 
 type,public::LightMaterialRec  ;sequence                           !2013.11.18
  integer(4):: nTubes !Number of allocated tube sections Tu(0:nTubes)

  real(4)   :: lit_Null(4)   = (/   .0,   .0,   .0,   .0 /)
 !-- Light#0
  integer(4):: lit2_On       =1
  real(4)   :: lit2_Amb(4)   = (/   .0,   .0,   .0,   .0 /)
  real(4)   :: lit2_Dif(4)   = (/   .7,   .7,   .7,  1.  /)
  real(4)   :: lit2_Spec(4)  = (/  1.0,  1.0,  1.0,  1.  /)
  real(4)   :: lit2_Pos(4)   = (/ -3.0,  3.0, -3.0,  0.  /)

 !-- Light#1
  integer(4):: lit3_On       =1
  real(4)   :: lit3_Amb(4)   = (/   .0,   .0,   .0,   .0 /)
  real(4)   :: lit3_Dif(4)   = (/   .7,   .7,   .7,  1.  /) !<-- use S.StdColor
  real(4)   :: lit3_Spec(4)  = (/  1.0,  1.0,  1.0,  1.  /)
  real(4)   :: lit3_Pos(4)   = (/ -3. , -3.0, -3. ,  1.  /)

 !-- Material#0
  real(4)   :: mat0_AmbDif(4) = (/   .5,   .5 ,   .5 ,   .5  /)
  real(4)   :: mat0_EmisF(4)  = (/  .1 ,   .1 ,   .1 ,   .0  /) !Outside
 !real(4)   :: mat0_EmisF(4)  = (/  .0 ,   .0 ,   .0 ,   .0  /) !Outside
  real(4)   :: mat0_EmisB(4)  = (/  .0 ,   .1 ,   .1 ,   .0  /) !Inside
 !real(4)   :: mat0_Spec(4)   = (/  1.0,  1.0 ,  1.0 ,  1.0  /)
  real(4)   :: mat0_Spec(4)   = (/   .5,   .5 ,   .5 ,   .5  /)
  real(4)   :: mat0_Shin(1)   = (/ 40.  /)                      ![0.,128.]
  real(4)   :: mat0_Null(4)   = (/   .0,   .0 ,   .0 ,   .0  /)
 end type     LightMaterialRec ;type(LightMaterialRec),public::LM
!------------------------------------------------------------------------------
 contains
!---------------------------------------------------------------------------7 9

Subroutine Lighting(iOffOn)                                    !2013.11.18.0720
!2013.11.18.0720cst JMS- Creates two call lists (#1 & #2) to toggle lighting.
!                      - Supports viewer-anchored lighting.
!2025.04.14.1445cdt JMS- Using lights 2 & 3.
 use OpenGLRec,only:  & !Ref: OpenGL GL/GLU/GLUT docs
      glnewlist,GL_COMPILE,glDisable,GL_LIGHTING,GL_BLEND,glendlist   &
     ,glShadeModel,GL_SMOOTH,glEnable,glLightModeli                   &
     ,GL_LIGHT_MODEL_TWO_SIDE,GL_TRUE,GL_LIGHT_MODEL_LOCAL_VIEWER     &
     ,GL_LIGHT0,glLightfv,GL_AMBIENT,GL_DIFFUSE,GL_SPECULAR           &
     ,GL_POSITION,GL_DEPTH_TEST,GL_AUTO_NORMAL,glcalllist,glFlush     &
     ,GL_LIGHT0,GL_LIGHT1,GL_LIGHT2,GL_LIGHT3
!use TubeDef, only:LM

 implicit none                                                       !arguments
  integer(4)::iOffOn
  !--                                                                !internals
  integer(4):: Init

  !-- Initialization:
   if(Init.eq.0) then

     call glnewlist(1, GL_COMPILE)  !-- Turn off lighting
       call glEnable( GL_LIGHTING)
       call glDisable(GL_LIGHT2)
       call glDisable(GL_LIGHT3)
       call glLightModeli(GL_LIGHT_MODEL_TWO_SIDE    ,0)
       call glLightModeli(GL_LIGHT_MODEL_LOCAL_VIEWER,0)

       call glDisable(GL_LIGHTING)
     call glendlist !(1)

     call glnewlist(2, GL_COMPILE)    !<-if ( LM%lit2_on > 0 )
       !-- Draws the light locations as a small spheres:
      !call LightShow       
       !-- Set the light color:
       call glShadeModel(GL_SMOOTH)
       !-- Turn on lighting:
       call glEnable(GL_LIGHTING   )
       !-- Set the light color:
      !call glColor4fv(LM%lit2_Dif) 
      !call glLightModeli(GL_LIGHT_MODEL_TWO_SIDE    ,GL_TRUE)
      !call glLightModeli(GL_LIGHT_MODEL_LOCAL_VIEWER,GL_TRUE) !Flawed.
       call glLightModeli(GL_LIGHT_MODEL_TWO_SIDE    ,1)
       call glLightModeli(GL_LIGHT_MODEL_LOCAL_VIEWER,1)
       !-- Turn on Light#0
       call glEnable(GL_LIGHT2     )
       call glLightfv(GL_LIGHT2,GL_AMBIENT  ,LM%lit2_Amb )
       call glLightfv(GL_LIGHT2,GL_DIFFUSE  ,LM%lit2_Dif )
       call glLightfv(GL_LIGHT2,GL_SPECULAR ,LM%lit2_Spec)
       call glLightfv(GL_LIGHT2,GL_POSITION ,LM%lit2_Pos )
       !-- Turn on Light#1
       call glEnable(GL_LIGHT3     )
       call glLightfv(GL_LIGHT3,GL_AMBIENT  ,LM%lit3_Amb )
       call glLightfv(GL_LIGHT3,GL_DIFFUSE  ,LM%lit3_Dif )
       call glLightfv(GL_LIGHT3,GL_SPECULAR ,LM%lit3_Spec)
       call glLightfv(GL_LIGHT3,GL_POSITION ,LM%lit3_Pos )
       call glEnable(GL_DEPTH_TEST )
       call glEnable(GL_AUTO_NORMAL)

      !-- if lighting is disabled, this colors it:
      !call glColor4fv(LM%lit2_Dif) 
       call glFlush
     call glendlist !(2)

     Init=1
   endif !Init=0

  !-- Recurring processing:
   if(iOffOn.le.0)    call glcalllist(1)  !Turns off lighting
   if(iOffOn.ge.1)    call glcalllist(2)  !Turns on  lighting
   return
End Subroutine Lighting
!---------------------------------------------------------------------------7-9
Subroutine LightShow                                          !2013.11.15.0830
!2013.11.15.0830cst JMS- Shows where Lignt#0 & Light#1 are in 3D.
!                      - Traveler2/Athlon64/WinXPPro/APF9.0/Ogl1.2.1
 use OpenGLRec,only:  & !Ref: OpenGL GL/GLU/GLUT docs
      glEnable,GL_COLOR_MATERIAL,glColor4fv,glTranslatef,glutSolidSphere &
     ,glDisable
!use TubeDef, only:LM

 implicit none                                                       !arguments
  !--                                                                !internals
   !---
    if(LM%lit2_on.gt.0) then
       !-- Set the light color:
!      call glEnable(GL_COLOR_MATERIAL) !This uses ColorStd()
!      call glColor4fv(LM%lit2_Dif)
       !-- Draw the light location as a small sphere:
       call glTranslatef( LM%lit2_Pos(1), LM%lit2_Pos(2), LM%lit2_Pos(3)) 
       call glutSolidSphere(.1d0, 20, 20)
       call glTranslatef(-LM%lit2_Pos(1),-LM%lit2_Pos(2),-LM%lit2_Pos(3))
!      call glDisable(GL_COLOR_MATERIAL)
    endif !LM%lit2_on>0
 
    if(LM%lit3_on.gt.0) then
       !-- Set the light color:
!      call glEnable(GL_COLOR_MATERIAL) !This uses ColorStd()
!      call glColor4fv(LM%lit3_Dif)
       !-- Draw the light location as a small sphere:
       call glTranslatef( LM%lit3_Pos(1), LM%lit3_Pos(2), LM%lit3_Pos(3))
       call glutSolidSphere(.1d0, 20, 20)
       call glTranslatef(-LM%lit3_Pos(1),-LM%lit3_Pos(2),-LM%lit3_Pos(3))
!      call glDisable(GL_COLOR_MATERIAL)
    endif !LM%lit3_on>0
   return
End Subroutine LightShow
!---------------------------------------------------------------------------7 9
Subroutine Material                                           !2013.11.20.0640
!2013.11.20.0640cst JMS- Material colored defined by sub ColorStd's output.
!2013.11.18.0555cst JMS- !GLUT Fortran 90 program to draw red light sphere.
 use OpenGLRec,only:                                                    &
      glEnable,GL_DEPTH_TEST,GL_NORMALIZE,GL_AUTO_NORMAL,glShadeModel   &
     ,GL_SMOOTH,glMaterialfv,GL_FRONT,GL_AMBIENT,GL_DIFFUSE,GL_EMISSION &
     ,GL_BACK,GL_SPECULAR,GL_SHININESS,glFlush
!use TubeDef   ,only:LM
 use ScreenDef ,only:ColorRGBA
 implicit none                                                       !arguments
  !--                                                                !internals
 !integer*4:: Init

  !-- Initialization:
  !-- Lighting must be enabled (done elsewhere):
      !call glEnable(GL_LIGHTING)
      !call Lighting(1)

   call glEnable(GL_DEPTH_TEST)
  !call glEnable(GL_CULL_FACE)
  !call glCullFace(GL_BACK)
   call glEnable(GL_NORMALIZE)
   call glEnable(GL_AUTO_NORMAL)
   call glShadeModel(GL_SMOOTH)

  !call glEnable(GL_COLOR_MATERIAL) !This uses glColor4fv/ColorStd()
  !call glColor4fv(LM%mat0_AmbDif) 
 !!call glColorMaterial(GL_FRONT_AND_BACK, GL_DIFFUSE)
  !call glColorMaterial(GL_FRONT,GL_AMBIENT_AND_DIFFUSE)
  !call glDisable(GL_COLOR_MATERIAL)
 
   call glMaterialfv(GL_FRONT, GL_AMBIENT  , LM%mat0_Null  )
  !call glMaterialfv(GL_FRONT, GL_DIFFUSE  , LM%mat0_AmbDif)
   call glMaterialfv(GL_FRONT, GL_DIFFUSE  , ColorRGBA     ) !S.StdColor)
   call glMaterialfv(GL_FRONT, GL_EMISSION , LM%mat0_EmisF ) !Outside
   call glMaterialfv(GL_BACK , GL_EMISSION , LM%mat0_EmisB ) !Inside
   call glMaterialfv(GL_FRONT, GL_SPECULAR , LM%mat0_Spec  )
   call glMaterialfv(GL_FRONT, GL_SHININESS, LM%mat0_Shin  )

  !-- Blending can be turned on as follows:
      !call glenable(GL_BLEND)
      !call glblendfunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA)
 
  !-- If lighting is turned on, surfaces should display as materials.
      !call glutSolidSphere(.5d0, 100, 100)
   call glFlush

  !-- Recurring processing:
  !call glTranslated( pXyz(1), pXyz(2), pXyz(3)) 
  !call glcalllist(3)
  !call glutSolidSphere(SphRad, 100, 100)
  !call glDisable(GL_COLOR_MATERIAL)
  !call glTranslated(-pXyz(1),-pXyz(2),-pXyz(3)) 

   return
End Subroutine Material
!---------------------------------------------------------------------------7-9

Subroutine Tubes(iDone,nPoint,pXyzh,Radius,iP)
!2025.04.15.0720cdt JMS- Used by Sn3D for Dodecahedron visualization.
!2013.11.22.0820cst JMS- Generating a solid cylinder(tube) from its centerline.
!                      - nPoints: produce nPL[1:[-nPoint]] -> [0:[-nPoint]+1]

!Each tube segment is located and "bends" at its beginning end.
 use OpenGLRec ,only:  & !Ref: OpenGL GL/GLU/GLUT docs
      glDisable,GL_COLOR_MATERIAL,glEnable,GL_LIGHTING,glEnable   &
     ,GL_DEPTH_TEST,GL_AUTO_NORMAL,glShadeModel,GL_SMOOTH,glbegin &
     ,GL_QUAD_STRIP,glNormal3dv,glVertex4dv,glEnd,glFlush
 use hVecMath8Mod                                                   !2013.10.23

 implicit none                                                       !arguments
  integer(4):: iDone        !<0:-nPMax;=0:next point;>0:nPmax to finish&display
  integer(4):: nPoint       !Current point number [1:nPMax]
  real(8)   :: pXyzh(4)
  real(8)   :: Radius
  integer(4):: iP
  !--                                                                !internals
  integer(4):: i,iBend,iFault,nP,nP2,nPMax
  real(8)   :: Vdown(4)
  real(8)   :: Temp1

 !real(8)   :: R=.2d0,H=.4d0
 !character::cW*120

10 select case(iDone) !////////////////////////////////////////////////////////
   !//////////
    case(:-1) !Initialization & first point:
     if(LM%nTubes.gt.0)      deallocate(Tu               )
        LM%nTubes=iabs(iDone) ;allocate(Tu(0:LM%nTubes+1)) ;Tu=TuZero
        nP   =0       ;iDone=0  ;nPMax=nP
     nPoint=1                                                       ;goto 10
   !//////////
    case( 0 ) !Point accumulation:
        nP=nP+1                 ;nPMax=nP
     if(nP.ne.nPoint) call jPause("Tubes: nPoint #'s not sequential.")
     Tu(nP)      = TuZero
     Tu(nP)%n    = nPoint
     Tu(nP)%C    = pXyzh
     Tu(nP)%Rdown= Radius
     Vdown=Tu(nP)%C
     call hVnorm(Vdown,Vdown,Temp1)
     if(nP.eq.LM%nTubes) then; iDone=1 ; goto 10 ;endif !nP=LM%nTubes
     nPoint=nPoint+1
   !//////////
    case( 1 )  !Process points for display:
    !-- Compute the interpoint spacings:
     do nP=2,nPMax
       call hSubtract(Tu(nP-1)%Vcln,Tu(nP  )%C,Tu(nP-1)%C)
       call hVnorm(   Tu(nP-1)%Vcln,Tu(nP-1)%Vcln,Tu(nP-1)%Vcln(5))
     enddo!nP
    !-- Use the first point with non-zero spacing to back-out the 0th point:
     Tu(0)=Tu(1)                                     ;iFault=1
     do nP=1,nPMax-1
       if(Tu(nP)%Vcln(5).gt.0.d0) then
          Tu(0)%C(1:3)=Tu(0)%C(1:3)-Tu(nP)%Vcln(1:3);iFault=0
          exit
       endif !Tu(nP).Vcln(0)>0.
     enddo!nP
     if(iFault.gt.0) then          ![Note: ...could draw a sphere instead.]
       call jPause("Tubes: pointset has no extent. Hence`ends`are undef.")
      !stop             "Tubes: pointset has no extent. Hence`ends`are undef."
       return !For debugging only  
     endif !iFault>0
    !-- Use the last point with non-zero spacing to extend the nPMax+1 point:
     Tu(nPMax+1)=Tu(nPMax)
     do nP=nPMax-1,1,-1
       if(Tu(nP)%Vcln(5).gt.0.d0) then
          Tu(nPmax+1)%C(1:3)=Tu(nPmax+1)%C(1:3)+Tu(nP)%Vcln(1:3)
         exit
       endif !Tu(nP)%Vcln(0)>0.
     enddo!nP
    !-- Complete computing the interpoint spacings:
     do nP=1,nPMax+1 ;if((nP.gt.1).and.(nP.lt.nPMax)) cycle
       call hSubtract(Tu(nP-1)%Vcln,Tu(nP  )%C,Tu(nP-1)%C)
       call hVnorm(   Tu(nP-1)%Vcln,Tu(nP-1)%Vcln,Tu(nP-1)%Vcln(5))
     enddo!nP
    !-- Define the tube bends:
                                                          iBend=0
   do nP=1,nPMax
     if(Tu(nP-1)%Vcln(5).eq.0.d0) cycle
     if(Tu(nP  )%Vcln(5).eq.0.d0) cycle
     call hDot(Tu(nP-1)%Vcln,Tu(nP)%Vcln,Tu(nP)%BangleD)
       if(Tu(nP)%BangleD.gt. 1.d0) Tu(nP)%BangleD= 1.d0
       if(Tu(nP)%BangleD.lt.-1.d0) Tu(nP)%BangleD=-1.d0
     Tu(nP)%BangleD=dacosd(Tu(nP)%BangleD)             ![0.,180.]
     if(Tu(nP)%BangleD.lt.1.d-4) Tu(nP)%BangleD=0.d0
     if(Tu(nP)%BangleD.gt.0.d0 ) then;                    iBend=iBend+1
       call hCross( Tu(nP  )%Vdn, Tu(nP-1)%Vcln, Tu(nP  )%Vcln  ) 
       call hVnorm( Tu(nP  )%Vdn, Tu(nP  )%Vdn , Tu(nP  )%Vdn(5))
                                                 Tu(nP  )%Vdn(5) =1.d0
       call hCross( Tu(nP  )%Von, Tu(nP  )%Vcln, Tu(nP  )%Vdn   )
       call hCross( Tu(nP+1)%Von, Tu(nP-1)%Vcln, Tu(nP  )%Vdn   )
       call   hAdd( Tu(nP  )%Von, Tu(nP  )%Von , Tu(nP+1)%Von   )
       call hVnorm( Tu(nP  )%Von, Tu(nP  )%Von , Tu(nP  )%Von(5))
                                                 Tu(nP  )%Von(5) =1.d0
      !-- Define default "down" vectors for straight segments      
       do nP2=nP-1,0,-1 ;if(Tu(nP2)%BangleD.gt.0.d0) exit
                            Tu(nP2)%Vdn=Tu(nP)%Vdn      ;enddo!nP2
       do nP2=nP+1,nPMax+1 ;Tu(nP2)%Vdn=Tu(nP)%Vdn      ;enddo!nP2
     endif !BangleD>0.
    !write(cW,"('nP=',i4,' Bangle=',f8.3,5f10.3 )") &
    !            nP     ,  Tu(nP)%BangleD ,Tu(nP)%Vcln     ;call WriteSF(cW, 6)
   enddo!nP
  !-- If there are no bends (the tube is straight,e.g. 1 segment) assign "down"
   if(iBend.eq.0) then                           ! X    Y    Z    h    Mag
     if(dabs(Tu(0)%Vcln(3)).lt..9d0) then; vDown=(/0.d0,0.d0,1.d0,1.d0/)
                                     else; vDown=(/1.d0,0.d0,0.d0,1.d0/)
     endif !|Tu(0).Vcln(3)|<.9
     call hCross( Tu(0)%Von   , Tu(0)%Vcln ,       vDown   )
     call hVnorm( Tu(0)%Von   , Tu(0)%Von  , Tu(0)%Von( 5) )
     call hCross( Tu(0)%Vdn   , Tu(0)%Von  , Tu(0)%Vcln    )
                  Tu(0)%Vdn(5)=1.d0
     do nP=1,nPMax+1            ;Tu(nP)%Vdn=Tu(0)%Vdn        ;enddo!nP
   endif !iBend=0

  !-- Compute the remaining Tu().Von's:
                 !Tu(nPMax ).Vcln(1:4)=Tu(nPMax-1)%Vcln(1:4)
   do nP=0,nPMax    ;if(Tu(nP  )%BangleD.gt.0.d0) cycle
     call hCross( Tu(nP)%Von, Tu(nP)%Vcln, Tu(nP)%Vdn     )
     call hVnorm( Tu(nP)%Von, Tu(nP)%Von , Tu(nP)%Von( 5) )
   enddo!nP
  !-- Create the ring of points at point nP:
   do nP=0,nPMax
     if(Tu(nP)%BangleD.le.0.d0) then
            Tu(nP)%Rout=Tu(nP)%Rdown
      else; Tu(nP)%Rout=Tu(nP)%Rdown/dcosd(Tu(nP)%BangleD/2.d0)
     endif !Tu(nP).BangleD<=0.    
     do i=0,36
       Tu(nP)%Ring(1:3,i)=  Tu(nP)%Rdown*Tu(nP)%Vdn(1:3)*dcosd(dble(i*10)) &
                           +Tu(nP)%Rout *Tu(nP)%Von(1:3)*dsind(dble(i*10))
       Tu(nP)%Ring( 4 ,i)=1.d0  !<-Without this, the object was a no-show!
       call hVnorm(Tu(nP)%Ring(1,i) ,Tu(nP)%RingN(1,i) , Temp1 )
                                     Tu(nP)%RingN(4,i)=1.d0
       Tu(nP)%Ring(1:3,i)=Tu(nP)%Ring(1:3,i)+Tu(nP)%C(1:3)
     enddo!i
   enddo!nP
   iDone=nPMax ;goto 10
   !//////////
    case(2: )  !Draw the tubes:
   call glEnable(GL_LIGHTING)
   call lighting(1)                                                   !20250414
   call LightShow
  !-----
   call glEnable(GL_DEPTH_TEST)
   call glEnable(GL_AUTO_NORMAL)
   call glShadeModel(GL_SMOOTH)

   do nP=1,nPMax-1
     call glbegin(GL_QUAD_STRIP)
     do i=0,36       
       call glNormal3dv(Tu(nP+1)%RingN(1:3,i))
       call glVertex4dv(Tu(nP+1)%Ring( 1:4,i))
       call glNormal3dv(Tu(nP  )%RingN(1:3,i))
       call glVertex4dv(Tu(nP  )%Ring( 1:4,i))
     enddo!i
     call glEnd
     call glFlush
   enddo!nP
   call lighting(0)                                                   !20250414

  !-----
   end select !iDone //////////////////////////////////////////////////////////
   return
End Subroutine Tubes
!---------------------------------------------------------------------------7-9

Subroutine Sphere(SphRad,pXyz)
!2025.04.18.1605cdt JMS- !GLUT Fortran 90 program to draw a sphere.

 use OpenGLRec ,only:                                                    & 
      glDisable,GL_COLOR_MATERIAL,glEnable,GL_LIGHTING,glEnable          &
     ,GL_AUTO_NORMAL,glShadeModel,GL_SMOOTH,glTranslated,glutSolidSphere

 implicit none                                                       !arguments
  real(8)   ::SphRad
  real(8)   ::pXyz(4)
  !--                                                                !internals
  real(8)   ::H=.1d0
  real(8)   ::R=.25d0

  !-- Initialization:
   call glDisable(GL_COLOR_MATERIAL)
   call glEnable(GL_LIGHTING)
   call lighting(1)                                                   !20250414

   call Material
   call glEnable(GL_AUTO_NORMAL)
   call glShadeModel(GL_SMOOTH)
  !-- Recurring processing:
   call glTranslated( pXyz(1), pXyz(2), pXyz(3))
   call glutSolidSphere(SphRad, 20, 20)

   call lighting(0)                                                   !20250414
   call glTranslated(-pXyz(1),-pXyz(2),-pXyz(3))

   return
End Subroutine Sphere
!---------------------------------------------------------------------------7-9
End Module TubeDef
!///////////////////////////////////////////////////////////////////////////7 9

