c     
c   Copyright (c) 1992  by  Dwight Meglan
c
      subroutine Draw3DSingle( OPT3D,VU3D_FLG,NmMrk,MrkNm,NumSeg,SegNum,NumFp,
     &                         FpNum,NumFt,FtNum,VwPnt,VwDir,UpVec,VwWin,ratio )
      implicit none                                                      
                      
      include 'vogle.fi'
      include 'show3d.inc'             
     
      include '..\anz\a_const.inc'
      include '..\anz\a_struct.inc'
      include '..\anz\a_names.inc'
      include '..\anz\a_prm.inc'
      include '..\anz\a_mrk.inc'
      include '..\anz\a_seg.inc'
      include '..\anz\a_gls2.inc'
      include '..\anz\a_frc.inc'

      record /options_3d/  OPT3D
      record /Plot3D_flag/ VU3D_FLG

      integer*4 NmMrk,MrkNm(MAX_MRK),NumSeg,SegNum(MAX_SEG),NumFp,     
     &          FpNum(MAX_PLT),NumFt,FtNum(2)
      real*4    VwPnt(3),VwDir(3),UpVec(3),VwWin,ratio

      integer*4 frm,mrk,seg,frcfrm,i,size,fplt,fft,efrm,junk
      real*4    TmpSegPos(3,4),GCSSegPnts(3,8,MAX_SEG),scale,
     &          LCSaxes(3,4,MAX_SEG),TmpSegCntr(3,MAX_SEG)
      logical*4 error,erase
                                 
                                                      
c                             
c     Draw an axis representing the lab coordinate system
c       - add force plates later
c                                                                        
      call dviewport( -1.0,1.0,-ratio,ratio )
 10   if ( OPT3D.ShowGCS ) then
        if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(YELLOW)
        call DrawGCS
        if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(CYAN)
      end if
      call textsize( 0.005,0.005 )
c
c     Draw force plate outline(s)
c                                     
      if ( OPT3D.ShowFrcPlt ) then 
        if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(BLUE)
        call DrawFpOutLine                          
        if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(CYAN)
      end if
c
c     draw average segment positions if desired
c
      if ( VU3D_FLG.AvgPos ) then
        call DisplayAllAvgSeg( OPT3D,NumSeg,SegNum,VwPnt,VwDir,VwWin,error )
        if ( error ) return
      end if
c                           
c     plot the data frame by frame
c                                     
      do frm= OPT3D.StartFrm, OPT3D.EndFrm, OPT3D.FrmInc
        efrm= frm - OPT3D.FrmInc
c         
c       Plot Markers                                   
c               
        if ( VU3D_FLG.MrkPos ) then  ! plot markers

          if ( OPT3D.EraseFrm .and. (.not. OPT3D.Print) .and. ! Erase the old
     &         (frm .gt. OPT3D.StartFrm)                        ) then
            call color(BLACK)
            do mrk= 1, NmMrk
              call dmark3( MrkData(x,efrm,MrkNm(mrk)),
     &                     MrkData(y,efrm,MrkNm(mrk)),
     &                     MrkData(z,efrm,MrkNm(mrk)),0.005,0.005,mrk+1 )
            end do                                                           
          end if

          if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(YELLOW)
          do mrk= 1, NmMrk
            call dmark3( MrkData(x,frm,MrkNm(mrk)), 
     &                   MrkData(y,frm,MrkNm(mrk)),
     &                   MrkData(z,frm,MrkNm(mrk)),0.005,0.005,mrk+1 ) 
          end do

        end if ! display markers
c                                        
c       Draw the body segments
c              
        if ( VU3D_FLG.SegPos ) then
          call DisplayAllSeg( OPT3D,NumSeg,SegNum,VwPnt,VwDir,VwWin,frm,error )
          if ( error ) return
        end if
c                               
c       Display Force plate GRL
c
        if ( VU3D_FLG.FrcPlt ) then
          if ( OPT3D.EraseFrm .and. (.not. OPT3D.Print) .and. ! Erase the old
     &         (frm .gt. OPT3D.StartFrm)                        ) then
            call color(BLACK)
            frcfrm= FP.frm_offset + efrm*FP.av_frm_ratio
            do i= 1, NumFp
              fplt= FpNum(i)
              if ( FpDataOK(frcfrm,fplt) ) 
     &          call DrawGRL( FpData(fx,frcfrm,fplt),FpCp(x,frcfrm,fplt),
     &                        efrm,OPT3D,.true. )
            end do
          end if
          if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(RED)
          frcfrm= FP.frm_offset + frm*FP.av_frm_ratio
          do i= 1, NumFp
            fplt= FpNum(i)
            if ( FpDataOK(frcfrm,fplt) ) 
     &        call DrawGRL( FpData(fx,frcfrm,fplt),FpCp(x,frcfrm,fplt),
     &                      frm,OPT3D,.false. )
          end do           
        end if
c               
c         Display Combined Force plate GRL
c               
        if ( VU3D_FLG.CmbGRL ) then
          if ( OPT3D.EraseFrm .and. (.not. OPT3D.Print) .and. ! Erase the old
     &         (frm .gt. OPT3D.StartFrm)                        ) then
            call color(BLACK)
            frcfrm= FP.frm_offset + efrm*FP.av_frm_ratio
            if  (FcDataOK(frcfrm) ) 
     &        call DrawGRL( CmbGrl(fx,frcfrm),CmbCp(x,frcfrm),efrm,OPT3D,.true. )
          end if                         
          if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(RED)
          frcfrm= FP.frm_offset + frm*FP.av_frm_ratio
          if  (FcDataOK(frcfrm) ) 
     &      call DrawGRL( CmbGrl(fx,frcfrm),CmbCp(x,frcfrm),frm,OPT3D,.false. )
        end if
c               
c        Display Individual Foot GRL
c
        if ( VU3D_FLG.FtGRL ) then
          if ( OPT3D.EraseFrm .and. (.not. OPT3D.Print) .and. ! Erase the old
     &         (frm .gt. OPT3D.StartFrm)                        ) then
            call color(BLACK)
            frcfrm= FP.frm_offset + efrm*FP.av_frm_ratio
            do i= 1, NumFt
              fft= FtNum(i)
              if ( FpDataOK(frcfrm,fft) .or. 
     &             (abs(FtGRL(fz,frcfrm,fft)) .gt. 5.0 ) )
     &          call DrawGRL( FtGrl(fx,frcfrm,fft),FtCpGCS(x,frcfrm,fft),
     &                        efrm,OPT3D,.true. )
            end do                                                       
          end if
          if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(RED)
          frcfrm= FP.frm_offset + frm*FP.av_frm_ratio
*$ifdef DEBUG
          write( 4,211) frm,frcfrm,FP.frm_offset,FP.av_frm_ratio
 211      format(/' Ind Ft GRL'/' frm   : ',i4,' frcfrm: ',i4,' offset: ',i4,
     &           ' ratio: ',f10.5)
*$endif
          do i= 1, NumFt
            fft= FtNum(i)
            if ( FpDataOK(frcfrm,fft) .or. 
     &           (abs(FtGRL(fz,frcfrm,fft)) .gt. 5.0 ) )
     &        call DrawGRL( FtGrl(fx,frcfrm,fft),FtCpGCS(x,frcfrm,fft),
     &                      frm,OPT3D,.false. )
*$ifdef DEBUG
            write(4,212) fft,fpDataOK(frcfrm,fft),ftgrl(fz,frcfrm,fft),
     &                   ftgrl(mz,frcfrm,fft),ftcpgcs(x,frcfrm,fft)
 212        format(' ft: ',i2,' ok: ',l2,' fz: ',f10.5,' mz: ',f10.5,' cpx: ',f10.5/)
*$endif
          end do                                                       
        end if                                 
c         
c       Control of looping of frames of data
c               
        if ( OPT3D.StepControl .and. OPT3D.Screen ) then
          junk= getkey()
          if ( (junk .eq. ichar('q')) .or. (junk .eq. ichar('Q')) ) goto 999
        else if ( OPT3D.StepControl .and. OPT3D.Print ) then
          goto 999
        else if ( OPT3D.Continuous .and. (checkkey() .ne. 0) ) then
          goto 999
        end if                                 

      end do ! frame            
      
      if ( OPT3D.Continuous .and. (checkkey() .eq. 0) .and. 
     &     (.not. OPT3D.Print) ) then
         call clear()
         goto 10 
      end if
      
 999  if ( OPT3D.Screen )  junk= getkey()
      return
      end                            
c
c     Copyright by Dwight Meglan 1992
c
      subroutine DrawGCS
      implicit none
      
      include 'vogle.fi'

      call textsize(0.05,0.05)
      call move( 0.0,0.0,0.0 )   ! draw and label x axis 
      call draw( 0.25,0.0,0.0 )
c      call jbase( 1.0,0.0,0.0 )
c      call jplane( 0.0,0.0,1.0 )
      call dstrg( ' X ' )
      call move( 0.25,0.0,0.0 )
c      call jplane( 0.0,1.0,0.0 )
      call rotate(-90.0,ichar('x'))
      call dstrg( ' X ' )                  
      call rotate(90.0,ichar('x'))
      call move( 0.0,0.0,0.0 )   ! draw and label y axis
      call draw( 0.0,0.25,0.0 )
c      call jbase( 0.0,1.0,0.0 )
c      call jplane( 0.0,0.0,1.0 )
      call rotate(90.0,ichar('z'))
      call dstrg( ' Y ' )
      call move( 0.0,0.25,0.0 )
c      call jplane( 1.0,0.0,0.0 )
      call rotate(-90.0,ichar('y'))
      call dstrg( ' Y ' )
      call rotate(90.0,ichar('y'))
      call rotate(-90.0,ichar('z'))
      call move( 0.0,0.0,0.0 )   ! draw and label z axis
      call draw( 0.0,0.0,0.25 )
c      call jbase( 0.0,0.0,1.0 )
c      call jplane( 1.0,0.0,0.0 )
      call rotate(90.0,ichar('y'))
      call dstrg( ' Z ' )
      call move( 0.0,0.0,0.25 )
c      call jplane( 0.0,1.0,0.0 )
      call rotate(90.0,ichar('z'))
      call dstrg( ' Z ' )
      call rotate(-90.0,ichar('z'))
      call rotate(-90.0,ichar('y'))
      return
      end
c
c     Copyright by Dwight Meglan 1992
c
      subroutine DisplayAllAvgSeg( OPT3D,NumSeg,SegNum,VwPnt,VwDir,VwWin,error )
      implicit none
        
      include 'vogle.fi'
      include 'show3d.inc'

      include '..\anz\a_const.inc'
      include '..\anz\a_struct.inc'
      include '..\anz\a_names.inc'
      include '..\anz\a_prm.inc'
      include '..\anz\a_seg.inc'
      
      record /options_3d/ OPT3D

      real*4    VwPnt(3),VwDir(3),VwWin(4)                                    
      integer*4 NumSeg,SegNum(MAX_SEG)
      logical*4 error

      real*4    SegPntGCS(3,8,MAX_SEG),scale,LCSaxes(3,4,MAX_SEG)
      integer*4 i,j,k

      if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(MAGENTA)     
      do j= 1, NumSeg
        call SegPntToGCS( SgpAvg(x,x,SegNum(j)),
     &                    SP(SegNum(j)).shape(x,1),SegPntGCS(x,1,j) )
      end do 
      if ( OPT3D.HiddenLine ) then
        call PlotHiddenLine( SegPntGCS,NumSeg,MAX_SEG,VwPnt,VwDir,VwWin,error )
        if ( error ) return
      else if ( OPT3D.WireFrame ) then                        
        do j= 1, NumSeg                          
          call DrawSegment( SegPntGCS(x,1,j),OPT3D.HideFace,VwDir )
        end do   
      end if ! hidden line or regular wire frame
      if ( OPT3D.ShowSegCntr ) then
        do j= 1, NumSeg
          call dmark3( SgpAvg(x,cntr,SegNum(j)),
     &                 SgpAvg(y,cntr,SegNum(j)),
     &                 SgpAvg(z,cntr,SegNum(j)),0.005,0.005,j+1 )  
        end do            
      end if   

      if ( OPT3D.ShowSegLCS ) then                
        if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(YELLOW)
        do i= 1, NumSeg
          scale= 0.1
          do j= x, cntr
            if ( j .eq. cntr ) scale= 1.0
            do k= x, z             
              LCSaxes(k,j,i)= SgpAvg(k,j,SegNum(i))*scale
            end do                                        
          end do
          call DrawLCS( LCSaxes(x,x,i) )
        end do
        if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(CYAN)
      end if ! display LCS axes
      error= .false.
      return
      end
c
c     Copyright by Dwight Meglan 1992
c
      subroutine DrawFpOutLine
      implicit none
        
      include 'vogle.fi'

      include '..\anz\a_const.inc'
      include '..\anz\a_struct.inc'
      include '..\anz\a_names.inc'
      include '..\anz\a_prm.inc'
 
      integer*4 i,j,k
      real*4    PltPnt(3,4),PltPntGCS(3,4),PltLCS(3,4)
 
      do i= 1, FP.num_plt
        PltPnt(x,1)= FP.plt_size(1,i)/2.0  ! 1/2 width      
        PltPnt(y,1)= FP.plt_size(2,i)/2.0  ! 1/2 length
        PltPnt(x,2)= PltPnt(x,1) - FP.plt_size(1,i)
        PltPnt(y,2)= PltPnt(y,1)                   
        PltPnt(x,3)= PltPnt(x,2)
        PltPnt(y,3)= PltPnt(y,1) - FP.plt_size(2,i)
        PltPnt(x,4)= PltPnt(x,1)
        PltPnt(y,4)= PltPnt(y,3)
        do k= 1, 4
          do j= 1, 3
            PltLCS(j,k)= FP.plt_loc(i).LCS(j,k)
          end do
          PltPnt(z,k)= 0.0
        end do
        call PltPntToGCS( PltLCS,PltPnt,PltPntGCS )
        call move( PltPntGCS(x,1),PltPntGCS(y,1),PltPntGCS(z,1) )
        do j= 2, 4
          call draw( PltPntGCS(x,j),PltPntGCS(y,j),PltPntGCS(z,j) )
        end do    
        call draw( PltPntGCS(x,1),PltPntGCS(y,1),PltPntGCS(z,1) )
      end do
      return
      end 
c                                                                  
c     Copyright (c) 1992  by  Dwight Meglan
c
      subroutine PltPntToGCS( LCS,PntLCS,PntGCS )
      implicit none        

      real*4    LCS(3,4),PntLCS(3,4),PntGCS(3,4)
       
      real*4    sum
      integer*2 i,j,k,x,z,cntr

      data x,z,cntr / 1,3,4 /

      do i= 1, 4              
        do j= x, z
          sum= 0.0
          do k= x, z
            sum= sum + LCS(j,k)*PntLCS(k,i)
          end do
          PntGCS(j,i)= sum + LCS(j,cntr)
        end do
      end do    
      return
      end       
c
c
c     Copyright by Dwight Meglan 1992
c
      subroutine DisplayAllSeg( OPT3D,NumSeg,SegNum,VwPnt,VwDir,VwWin,frm,error )
      implicit none
        
      include 'vogle.fi'
      include 'show3d.inc'

      include '..\anz\a_const.inc'
      include '..\anz\a_struct.inc'
      include '..\anz\a_names.inc'
      include '..\anz\a_prm.inc'
      include '..\anz\a_seg.inc'
      
      record /options_3d/ OPT3D

      real*4    VwPnt(3),VwDir(3),VwWin(4)
      integer*4 NumSeg,SegNum(MAX_SEG),frm
      logical*4 error
                           
      real*4    SegPntGCS(3,8,MAX_SEG),scale,LCSaxes(3,4,MAX_SEG),
     &          TmpSegPos(3,4),TmpSegCntr(3,MAX_SEG)
      integer*4 i,j,k,seg,prevfrm

c                   
c     Erase the segments from the previous frame
c                         
      if ( OPT3D.EraseFrm .and. (.not. OPT3D.Print) .and. 
     &     (frm .gt. OPT3D.StartFrm)                     ) then
         call color(BLACK)
         if ( OPT3D.Hiddenline ) then
            call PlotHiddenLine( SegPntGCS,NumSeg,MAX_SEG,VwPnt,VwDir,VwWin,error )
         else
            do j= 1, NumSeg
               call color(BLACK)
               if ( .not. OPT3D.StickFigure ) then
                  call DrawSegment( SegPntGCS(x,1,j),.false.,VwDir )
               else
                  call DrawStkFig( j,prevfrm,OPT3D.SegCentered,
     &                 SgpGCS(z,cntr,OPT3D.StartFrm,OPT3D.CntrSegNum))
               end if
            end do                                 
         end if
         if ( OPT3D.ShowSegLCS ) then
            do j= 1, NumSeg
               call color(BLACK)
               call DrawLCS( LCSaxes(x,x,j) ) 
            end do
         end if
      end if 
      if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(CYAN)
c                                               
c     Calculate the segment points in global coordinates
c                                         
      do i= 1, NumSeg ! calculate segment outline in GCS
        seg= SegNum(i)
        do j= x, cntr
          do k= x, z
            TmpSegPos(k,j)= SgpGCS(k,j,frm,seg)
          end do
        end do   

        if ( OPT3D.UseInitRotCor )
     &    call RemInitRot( TmpSegPos,SgpAvg,TmpSegPos )

        if ( OPT3D.SegCentered ) then
          do j= x, z          
            TmpSegPos(j,cntr)= TmpSegPos(j,cntr) -
     &                         SgpGCS(j,cntr,frm,OPT3D.CntrSegNum)
          end do
          TmpSegPos(z,cntr)= TmpSegPos(z,cntr) +
     &                   SgpGCS(z,cntr,OPT3D.StartFrm,OPT3D.CntrSegNum)
        end if
                                                    
        call SegPntToGCS( TmpSegPos,SP(seg).shape(x,1),SegPntGCS(x,1,i) )
         
        if ( OPT3D.ShowSegLCS ) then                
           scale= 0.1
           do j= x, cntr
             if ( j .eq. cntr ) scale= 1.0
             do k= x, z 
               LCSaxes(k,j,i)= TmpSegPos(k,j)*scale
             end do                                        
           end do
         end if ! display LCS axes
            
         if ( OPT3D.ShowSegCntr ) then
           do j= x, z
             TmpSegCntr(j,i)= TmpSegPos(j,cntr)
           end do          
         end if
                                 
       end do ! seg
c
c          Now draw the segments
c                                  
       if ( OPT3D.HiddenLine ) then
         call PlotHiddenLine( SegPntGCS,NumSeg,MAX_SEG,VwPnt,VwDir,VwWin,error )
         if ( error ) return                                  
       else if ( OPT3D.WireFrame ) then
         do j= 1, NumSeg
           call DrawSegment( SegPntGCS(x,1,j),OPT3D.HideFace,VwDir )
         end do
       else if ( OPT3D.StickFigure ) then
         do j= 1, NumSeg
           call DrawStkFig( j,frm,OPT3D.SegCentered,
     &                      SgpGCS(z,cntr,OPT3D.StartFrm,OPT3D.CntrSegNum))
         end do
       end if ! hidden or just plain wire frames       
                             
       if ( OPT3D.ShowSegCntr ) then
         if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(MAGENTA)
         do j= 1, NumSeg
           call dmark3( TmpSegCntr(x,j),TmpSegCntr(y,j),TmpSegCntr(z,j),
     &                  0.005,0.005,j+1 )
         end do
       end if ! show centers of segments
          
       if ( OPT3D.ShowSegLCS ) then
         if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(YELLOW)
         do j= 1, NumSeg
           call DrawLCS( LCSaxes(x,x,j) )
        end do         
      end if ! display segment LCS     
      prevfrm= frm
      error= .false.
      return
      end
c
c     Copyright by Dwight Meglan 1992
c
      subroutine DrawGRL( grl,cpr,frm,OPT3D,erase )
      implicit none
        
      include 'vogle.fi'
      include 'show3d.inc'
                                      
      include '..\anz\a_const.inc'
      include '..\anz\a_struct.inc'
      include '..\anz\a_names.inc'
      include '..\anz\a_prm.inc'
      include '..\anz\a_seg.inc'

      record /options_3d/ OPT3D
 
      real*4    grl(6),cpr(3)
      integer*4 frm
      logical*4 erase

      integer*4 i
      real*4    scfrc(3),scmz,scale,tcpr(3)
                                      
      if ( OPT3D.SegCentered ) then
         do i= 1, 3          
            tcpr(i)= cpr(i) - SgpGCS(i,4,frm,OPT3D.CntrSegNum)
         end do
         tcpr(3)= tcpr(3) + SgpGCS(3,4,OPT3D.StartFrm,OPT3D.CntrSegNum)
      else
         do i= 1, 3          
            tcpr(i)= cpr(i)
         end do
      end if

      if ( OPT3D.ShowCP ) then
        call move( tcpr(1)-0.01,tcpr(2),tcpr(3) )
        call rdraw( 0.02,0.0,0.0 )
        call move( tcpr(1),tcpr(2)-0.01,tcpr(3) )    
        call rdraw( 0.0,0.02,0.0 )
c*$ifdef DEBUG
c        write(4,100) cpr(1),cpr(2),cpr(3)
c 100    format('cpr  : ',3(f10.4))
c*$endif
      end if
      if ( OPT3D.ShowGRF ) then 
        if ( ((.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print))
     &       .and. (.not. erase) ) call color(GREEN)
        if ( GP.weight .gt. 0.0 ) then
          scale= GP.weight*9.81*OPT3D.ScaleFRC
        else       
          scale= OPT3D.ScaleFRC
        end if
        do i= 1, 3
          scfrc(i)= grl(i)/scale
        end do
c*$ifdef DEBUG
c        write(4,100) cpr(1),cpr(2),cpr(3)
c        write(4,110) grl(1),grl(2),grl(3)
c 110    format('frc  : ',3(f10.4))
c        write(4,120) scfrc(1),scfrc(2),scfrc(3)
c 120    format('scfrc: ',3(f10.4))
c*$endif
        call move( tcpr(1),tcpr(2),tcpr(3) )
        call rdraw( scfrc(1),scfrc(2),scfrc(3) )
        if ( ((.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print))
     &        .and. (.not. erase) ) call color(CYAN)
      end if
      if ( OPT3D.ShowGRM ) then 
        if ( ((.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print))
     &       .and. (.not. erase) ) call color(RED)
        if ( (GP.weight .gt. 0.0) .and. (GP.height .gt. 0.0) ) then
          scale= GP.weight*9.81*GP.height*OPT3D.ScaleMOM
        else                      
          scale= OPT3D.ScaleMOM
        end if
        do i= 1, 3
          scmz= grl(6)/scale
        end do
        call move( tcpr(1),tcpr(2),tcpr(3) )
        call rdraw( 0.0,0.0,scmz )
        if ( ((.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print))
     &       .and. (.not. erase) ) call color(CYAN)
      end if
      return                    
      end   
c
c   Copyright (c) 1992  by  Dwight Meglan                   
c                        
      subroutine Draw3DMultiple( OPT3D,VU3D_FLG,NmMrk,MrkNm,NumSeg,SegNum,NumFp,
     &                           FpNum,NumFt,FtNum,VwPnt,VwDir,UpVec,VwWin,ratio )
      implicit none                                                      
                      
      include 'vogle.fi'
      include 'show3d.inc'             
     
      include '..\anz\a_const.inc'
      include '..\anz\a_struct.inc'
      include '..\anz\a_names.inc'
      include '..\anz\a_prm.inc'
      include '..\anz\a_mrk.inc'
      include '..\anz\a_seg.inc'
      include '..\anz\a_gls2.inc'
      include '..\anz\a_frc.inc'

      record /options_3d/  OPT3D
      record /Plot3D_flag/ VU3D_FLG

      integer*4 NmMrk,MrkNm(MAX_MRK),NumSeg,SegNum(MAX_SEG),NumFp,     
     &          FpNum(MAX_PLT),NumFt,FtNum(2)
      real*4    VwPnt(3),VwDir(3),UpVec(3),VwWin,ratio
                    
      integer*4 frm,mrk,seg,frcfrm,NumVp,NumVpWide,NumVpTall,NumVpInRow,i,size,
     &          fft,fplt,junk
      real*4    TmpSegPos(3,4),GCSSegPnts(3,8,MAX_SEG),scale,VpWidth,VpHeight,
     &          LCSaxes(3,4,MAX_SEG),TmpSegCntr(3,MAX_SEG),VpXmax,VpXmin,
     &          VpYmax,VpYmin,spacing
      character chfrm*3
      logical*4 error
                                 
c               
c     First, figure out how many frames will be displayed and set up their
c     individual vuports.  Note that figures will progress from the upper
c     left corner of the screen across to the right and then downward until
c     the last figure is in the lower right corner.
c           
      NumVp= int( float(OPT3D.EndFrm-OPT3D.StartFrm+1)/float(OPT3D.FrmInc) ) + 1
      if ( NumVp .le. 6 ) then ! vuport layout is 3 wide by 2 tall
        NumVpWide= 3
        NumVpTall= 2
      else if ( (NumVp .gt. 6)  .and. (NumVp .le. 12) ) then ! 4x3
        NumVpWide= 4                 
        NumVpTall= 3
      else if ( (NumVp .gt. 12) .and. (NumVp .le. 20) ) then ! 5x4
        NumVpWide= 5
        NumVpTall= 4
      else if ( (NumVp .gt. 20) .and. (NumVp .le. 30) ) then ! 6x5
        NumVpWide= 6
        NumVpTall= 5
      else ! layout will be 7x6 and extra frames will be cut
        NumVpWide= 7
        NumVpTall= 6
      end if
      VpWidth= 2.0/NumVpWide
      VpHeight= VpWidth*ratio            
      spacing= ( 2.0*ratio - VpHeight*NumVpTall )/(NumVpTall-1)
      VpXmin= -1.0
      VpYmin= ratio - VpHeight
      VpXmax= VpXmin + VpWidth
      VpYmax= ratio
      NumVpInRow= 1
      NumVp= 1
c                                      
c     Display the individual viewports
c
      do frm= OPT3D.StartFrm, OPT3D.EndFrm, OPT3D.FrmInc
        call dviewport( VpXmin,VpXmax,VpYmin,VpYmax )
c
c       Display optional frame number in lower left corner of viewport
c
        if ( OPT3D.ShowFrmNum ) then
          call pushmatrix()
          call up(  0.0,0.0,1.0 )
          call lookat( 3.0,0.0,0.0,0.0,0.0,0.0,0.0 )
c          call jnorml( -1.0,0.0,0.0 )
c          call jvupnt( 3.0,0.0,0.0 )
          call ortho2( -VpWidth,VpWidth,-VpHeight,VpHeight )
          call textsize(0.06,0.06)
          call leftjustify()
          call bottomjustify()
          call move2(-VpWidth+0.01,-VpHeight+0.06)
          write(chfrm,100) frm
100       format(i3)
          call dstrg(chfrm)
          call popmatrix
        end if
c                               
c       Draw an axis representing the lab coordinate system
c                                      
        if ( OPT3D.ShowGCS ) then
          if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(YELLOW)
          call DrawGCS
          if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(CYAN)
        end if
        call textsize( 0.005,0.005 )
c
c       Draw force plate outline(s)
c                                     
        if ( OPT3D.ShowFrcPlt ) then 
          if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(BLUE)
          call DrawFpOutLine                          
          if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(CYAN)
        end if
c         
c       Plot Markers                       
c               
        if ( VU3D_FLG.MrkPos ) then  ! plot markers
          if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(YELLOW)
          do mrk= 1, NmMrk
            call dmark3( MrkData(x,frm,MrkNm(mrk)), 
     &                   MrkData(y,frm,MrkNm(mrk)),
     &                   MrkData(z,frm,MrkNm(mrk)),0.005,0.005,mrk+1  )
          end do
        end if ! display markers
c                                        
c       Draw the body segments
c              
        if ( VU3D_FLG.SegPos ) then
          call DisplayAllSeg( OPT3D,NumSeg,SegNum,VwPnt,VwDir,VwWin,frm,error )
          if ( error ) return
        end if
c                               
c       Display Force plate GRL
c
        if ( VU3D_FLG.FrcPlt ) then
          if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(RED)
          frcfrm= FP.frm_offset + frm*FP.av_frm_ratio
          do i= 1, NumFp
            fplt= FpNum(i)
            if ( FpDataOK(frcfrm,fplt) ) 
     &        call DrawGRL( FpData(fx,frcfrm,fplt),FpCp(x,frcfrm,fplt),
     &                      frm,OPT3D,.false. )
          end do
        end if
c               
c         Display Combined Force plate GRL
c               
        if ( VU3D_FLG.CmbGRL ) then
          if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(RED)
          frcfrm= FP.frm_offset + frm*FP.av_frm_ratio   
          if  (FcDataOK(frcfrm) ) 
     &      call DrawGRL( CmbGrl(fx,frcfrm),CmbCp(x,frcfrm),frm,OPT3D,.false. )
        end if
c               
c        Display Individual Foot GRL     
c
        if ( VU3D_FLG.FtGRL ) then
          if ( (.not. OPT3D.UseMonoDisplay) .or. (.not. OPT3D.Print) ) call color(RED)
          frcfrm= FP.frm_offset + frm*FP.av_frm_ratio
*$ifdef DEBUG
          write( 4,211) frm,frcfrm,FP.frm_offset,FP.av_frm_ratio
 211      format(/' Ind Ft GRL'/' frm   : ',i4,' frcfrm: ',i4,' offset: ',i4,
     &           ' ratio: ',f10.5)
*$endif
          do i= 1, NumFt
            fft= FtNum(i)
*$ifndef DEBUG
            if ( FpDataOK(frcfrm,fft) .or.
     &           (abs(FtGRL(fz,frcfrm,fft)) .gt. 5.0 ) )
     &        call DrawGRL( FtGrl(fx,frcfrm,fft),FtCpGCS(x,frcfrm,fft),
     &                      frm,OPT3D,.false. )
*$endif
*$ifdef DEBUG
            write(4,212) fft,fpDataOK(frcfrm,fft),ftgrl(fz,frcfrm,fft),
     &                   ftgrl(mz,frcfrm,fft),ftcpgcs(x,frcfrm,fft)
 212        format(' ft: ',i2,' ok: ',l2,' fz: ',f10.5,' mz: ',f10.5,' cpx: ',f10.5/)
*$endif
          end do               
        end if
c                                     
c       Now update the vuport for the next frame
c
        NumVp= NumVp + 1
        if ( NumVp .gt. NumVpWide*NumVpTall ) then! hit vuport limit
          goto 999
        end if
        if ( NumVpInRow .eq. NumVpWide ) then ! go to the next row
          NumVpInRow= 1
          VpXmin= -1.0
          VpXmax= VpXmin + VpWidth
          VpYmax= VpYmin - spacing
          VpYmin= VpYmax - VpHeight
        else
          NumVpInRow= NumVpInRow + 1
          VpXmin= VpXmax
          VpXmax= VpXmin + VpWidth
        end if   
      end do ! frame      
999   if ( OPT3D.Screen ) junk= getkey() ! wait for key press
      return
      end
c                             
c   Copyright (c) 1992  by  Dwight Meglan
c                          
c     Remove initial rotation of segment when subject was standing, i.e.
c     make rotation matrix relative to initial orientation of the segment
c     instead of relative to the GCS.  This is to correct for misalignment
c     of the markers from their 'ideal' locations.
c
      subroutine RemInitRot( SegPos,InitSegRot,NewSegPos )
      implicit none

      real*4    SegPos(3,4),InitSegRot(3,3),NewSegPos(3,4)

      integer*2 axis,x,z,cntr
      real*4    mat1(3,3)
      data x,z,cntr / 1,3,4 /

      call Mat_Transpose( InitSegRot, mat1 ) ! same as inverse for rotation
      call Mat_Mult( mat1,SegPos(x,x),NewSegPos(x,x) ) ! matrix
      do axis= x, z
        NewSegPos(axis,cntr)= SegPos(axis,cntr)
      end do
      return
      end
c
c   Copyright (c) 1992  by  Dwight Meglan
c
      subroutine SegPntToGCS( SegPos,Shape,PntGCS )
      implicit none

      real*4    SegPos(3,4),Shape(3,8)

      real*4    PntGCS(3,8),sum
      integer*2 i,j,k,x,z,cntr

      data x,z,cntr / 1,3,4 /

      do i= 1, 8
        do j= x, z
          sum= 0.0
          do k= x, z
            sum= sum + SegPos(j,k)*Shape(k,i)
          end do
          PntGCS(j,i)= sum + SegPos(j,cntr)
        end do
      end do
      return
      end             
c
c   Copyright (c) 1992  by  Dwight Meglan
c
      subroutine DrawSegment( SegPnt,SurfaceFlag,VwDir )
      implicit none

      include 'vogle.fi'

      real*4    SegPnt(3,8),VwDir(3)
      logical   SurfaceFlag

      integer*2 i,x,y,z,FaceLnNm(4,6),LnPt(2,12),FacePt(4,6),ln,fn
      real*4    vecA(3),vecB(3),vecC(3),Vec_Dprod
      logical   lnOK(12)

                  ! f1     f2       f3       f4       f5       f6
      data FacePt / 1,2,6,5, 2,3,7,6, 3,4,8,7, 4,1,5,8, 1,4,3,2, 5,6,7,8/
                ! l1  2   3   4   5   6   7   8   9   10  11  12
      data LnPt / 1,2,2,3,3,4,4,1,5,6,6,7,7,8,8,5,1,5,2,6,3,7,4,8 /
                    ! f1     f2        f3        f4
      data FaceLnNm / 1,10,5,9,2,11,6,10,3,12,7,11,4,9,8,12,
     &                4,3,2,1,5,6,7,8 /
                    ! f5    f6
      data x,y,z / 1,2,3 /
                               
      if ( SurfaceFlag ) then ! do hidden surface removal
        do ln= 1, 12
          lnOK(ln)= .false.
        end do
        do fn= 1, 6
          call Vec_Sub( SegPnt(x,FacePt(2,fn)),SegPnt(x,FacePt(1,fn)),VecA )
          call Vec_Sub( SegPnt(x,FacePt(3,fn)),SegPnt(x,FacePt(2,fn)),VecB )
          call Vec_Xprod( VecB,VecA,VecC )
          if ( Vec_Dprod( VecC,VwDir ) .lt. 0 ) then ! face is visible
            do ln= 1, 4
              lnOK( FaceLnNm(ln,fn) )= .true.
            end do
          end if
        end do ! fn
        do ln= 1, 12
          if ( lnOK(ln) ) then
            call move( SegPnt(x,LnPt(1,ln)),SegPnt(y,LnPt(1,ln)),SegPnt(z,LnPt(1,ln)) )
            call draw( SegPnt(x,LnPt(2,ln)),SegPnt(y,LnPt(2,ln)),SegPnt(z,LnPt(2,ln)) )
          end if
        end do ! line
      else ! just draw all the lines
        do i= 0, 4, 4
          call move( SegPnt(x,1+i),SegPnt(y,1+i),SegPnt(z,1+i) )
          call draw( SegPnt(x,2+i),SegPnt(y,2+i),SegPnt(z,2+i) )
          call draw( SegPnt(x,3+i),SegPnt(y,3+i),SegPnt(z,3+i) )
          call draw( SegPnt(x,4+i),SegPnt(y,4+i),SegPnt(z,4+i) )
          call draw( SegPnt(x,1+i),SegPnt(y,1+i),SegPnt(z,1+i) )
        end do
        do i= 1, 4               
          call move( SegPnt(x,i),SegPnt(y,i),SegPnt(z,i) )
          call draw( SegPnt(x,i+4),SegPnt(y,i+4),SegPnt(z,i+4) )
        end do
      end if ! hidden surface removal
      return
      end
c
c   Copyright (c) 1992  by  Dwight Meglan
c
      subroutine DrawStkFig( SegNum,frm,RemCntr,cpnt )
      implicit none

      include 'vogle.fi'
      include 'show3d.inc'
 
      include '..\anz\a_const.inc'
      include '..\anz\a_struct.inc'
      include '..\anz\a_names.inc'
      include '..\anz\a_prm.inc'
      include '..\anz\a_seg.inc'
      include '..\anz\a_mrk.inc'

      real*4    cpnt(3)
      integer*4 SegNum,frm,i,j
      logical*4 RemCntr

      if ( .not. RemCntr ) then
        do i= 1, SP(SegNum).num_mrk-1
          do j= i+1, SP(SegNum).num_mrk
            call move( MrkData(1,frm,SP(SegNum).mrk_num(i)),       
     &                   MrkData(2,frm,SP(SegNum).mrk_num(i)),
     &                   MrkData(3,frm,SP(SegNum).mrk_num(i)) )
            call draw( MrkData(1,frm,SP(SegNum).mrk_num(j)),
     &                   MrkData(2,frm,SP(SegNum).mrk_num(j)),
     &                   MrkData(3,frm,SP(SegNum).mrk_num(j)) )
          end do                                    
        end do                   
      else
        do i= 1, SP(SegNum).num_mrk-1
          do j= i+1, SP(SegNum).num_mrk
            call move( MrkData(1,frm,SP(SegNum).mrk_num(i))-cpnt(1),
     &                   MrkData(2,frm,SP(SegNum).mrk_num(i))-cpnt(2),
     &                   MrkData(3,frm,SP(SegNum).mrk_num(i)) )
            call draw( MrkData(1,frm,SP(SegNum).mrk_num(j))-cpnt(1),
     &                   MrkData(2,frm,SP(SegNum).mrk_num(j))-cpnt(2),
     &                   MrkData(3,frm,SP(SegNum).mrk_num(j)) )
          end do
        end do                   
      end if                                                    
      return                   
      end
c                                   
c   Copyright (c) 1992  by  Dwight Meglan
c
      subroutine DrawLCS( LCSaxes )
      implicit none

      include 'vogle.fi'

      real*4    LCSaxes(3,4)
      integer*2 x,y,z,cntr

      data x,y,z,cntr / 1,2,3,4 /

      call move( LCSaxes(x,cntr),LCSaxes(y,cntr),LCSaxes(z,cntr) )
      call rdraw( LCSaxes(x,x),LCSaxes(y,x),LCSaxes(z,x) )
      call move( LCSaxes(x,cntr),LCSaxes(y,cntr),LCSaxes(z,cntr) )
      call rdraw( LCSaxes(x,y),LCSaxes(y,y),LCSaxes(z,y) )
      call move( LCSaxes(x,cntr),LCSaxes(y,cntr),LCSaxes(z,cntr) )
      call rdraw( LCSaxes(x,z),LCSaxes(y,z),LCSaxes(z,z) )
      return       
      end
c
c                                       
c   Copyright (c) 1993 by Dwight Meglan
c
      subroutine dmark3( x,y,z,xsize,ysize,n )
      implicit none

      include 'vogle.fi'

      real*4    x,y,z,xsize,ysize
      integer*4 n

      integer*4 MrkNum

      MrkNum= n
      if ( (MrkNum .lt. 1) .or. (MrkNum .gt. 10) ) MrkNum= 1
      if ( MrkNum .eq. 1 ) then ! plus sign
        call move(x-xsize/2.0,y,z)   
        call rdraw(xsize,0.0,0.0)
        call move(x,y-ysize/2.0,z)
        call rdraw(0.0,ysize,0.0)
      else if ( MrkNum .eq. 2 ) then ! x 
        call move(x-xsize/2.0,y-ysize/2.0,z)
        call rdraw(xsize,ysize,0.0)
        call move(x+xsize/2.0,y-ysize/2.0,z)
        call rdraw(-xsize,ysize,0.0)
      else if ( MrkNum .eq. 3 ) then ! asterisk
        call move(x-xsize/2.0,y,z)
        call rdraw(xsize,0.0,0.0)
        call move(x,y-ysize/2.0,z)
        call rdraw(0.0,ysize,0.0)
        call move(x-xsize/2.0,y-ysize/2.0,z)
        call rdraw(xsize,ysize,0.0)
        call move(x+xsize/2.0,y-ysize/2.0,z)
        call rdraw(-xsize,ysize,0.0)
      else if ( MrkNum .eq. 4 ) then ! triangle
        call move(x+0.5774*xsize,y-ysize/2.0,z)
        call rdraw(-0.5774*xsize,ysize,0.0)
        call rdraw(-0.5774*xsize,-ysize,0.0)
        call rdraw( 1.1547*xsize,0.0,0.0)
      else if ( MrkNum .eq. 5 ) then ! square
        call move(x-xsize/2.0,y-ysize/2.0,z)
        call rdraw(xsize,0.0,0.0)
        call rdraw(0.0,ysize,0.0)
        call rdraw(-xsize,0.0,0.0)
        call rdraw(0.0,-ysize,0.0)
      else if ( MrkNum .eq. 6 ) then ! diamond
        call move(x,y-ysize/2.0,z)
        call rdraw(xsize/2.0,ysize/2.0,0.0)
        call rdraw(-xsize/2.0,ysize/2.0,0.0)
        call rdraw(-xsize/2.0,-ysize/2.0,0.0)
        call rdraw(xsize/2.0,-ysize/2.0,0.0)
      else if ( MrkNum .eq. 7 ) then ! square and plus
        call move(x-xsize/2.0,y-ysize/2.0,z)
        call rdraw(xsize,0.0,0.0)                              
        call rdraw(0.0,ysize,0.0)
        call rdraw(-xsize,0.0,0.0) 
        call rdraw(0.0,-ysize,0.0)
        call move(x-xsize/2.0,y,z)
        call rdraw(xsize,0.0,0.0)
        call move(x,y-ysize/2.0,z)
        call rdraw(0.0,ysize,0.0)
      else if ( MrkNum .eq. 8 ) then ! diamond and plus
        call move(x,y-ysize/2.0,z)
        call rdraw(xsize/2.0,ysize/2.0,0.0)
        call rdraw(-xsize/2.0,ysize/2.0,0.0)
        call rdraw(-xsize/2.0,-ysize/2.0,0.0)
        call rdraw(xsize/2.0,-ysize/2.0,0.0)
        call move(x-xsize/2.0,y,z)
        call rdraw(xsize,0.0,0.0)
        call move(x,y-ysize/2.0,z)
        call rdraw(0.0,ysize,0.0)
      else if ( MrkNum .eq. 9 ) then ! triangle and plus sign
        call move(x+0.5774*xsize,y-ysize/2.0,z)
        call rdraw(-0.5774*xsize,ysize,0.0)
        call rdraw(-0.5774*xsize,-ysize,0.0)
        call rdraw( 1.1547*xsize,0.0,0.0)
        call move(x-xsize/2.0,y,z)
        call rdraw(xsize,0.0,0.0)
        call move(x,y-ysize/2.0,z)
        call rdraw(0.0,ysize,0.0)
      else ! square and asterisk
        call move(x-xsize/2.0,y-ysize/2.0,z)
        call rdraw(xsize,0.0,0.0)
        call rdraw(0.0,ysize,0.0)
        call rdraw(-xsize,0.0,0.0)
        call rdraw(0.0,-ysize,0.0)
        call move(x-xsize/2.0,y,z)
        call rdraw(xsize,0.0,0.0)
        call move(x,y-ysize/2.0,z)
        call rdraw(0.0,ysize,0.0)
        call move(x-xsize/2.0,y-ysize/2.0,z)
        call rdraw(xsize,ysize,0.0)
        call move(x+xsize/2.0,y-ysize/2.0,z)
        call rdraw(-xsize,ysize,0.0)
      end if
      return
      end
