c
c   Copyright (c) 1990 by Dwight Meglan
c
      subroutine ReadFileParam( CMND,error )
c                              
c     This subroutine reads general gait and marker position information
c     from a number of different file formats.  It decides which file type
c     is going to be read and calls the appropriate file reading subroutine.
c     NOTE: Only the status of the file is determined here, i.e. no data is 
c     read in only the presence of the data is recorded.
c                                
      implicit none
      
      include 'tel_cons.inc'
      include 'tel_strc.inc'
      include 'tel_file.inc'
      include 'tel_name.inc'
                   
      record /CmndLine/ CMND
      logical*4 error
                 
      integer*4 NumFileTypes,FileTypeNum,i,NameLength,j,FileNum,k
      character extension*3,FileType(9)*3,Fname*40
      logical*4 nameOK,GetFileName,newCS,OldGain,ZeroChnl,AddFile

      data NumFileTypes / 9 /
      data FileType / 'TR3','TRU','C3D','ANZ','FPD',
     &                'M  ','GLS','GL1','GL2' /

      if ( CMND.NumCmnd .lt. 2 ) goto 1000 !error- there must a filename present
c                   
c     First check for proper options if any are present
c     check for file type option.
c     NOTE: If options are not present the default is ANZ file, full body marker
c     set, and motion data.
c
      FileNum= 0
      FileTypeNum= 0
      newCS=    .false.
      OldGain=  .false.
      ZeroChnl= .false.              
      AddFile=  .false.
      if ( CMND.NumOpt(1) .gt. 0 ) then
        do k= 1, CMND.NumOpt(1)
          if ( CMND.OptNumOK(k,1) ) then
            if ( (CMND.OptIntVal(k,1) .lt. 1) .or. 
     &           (CMND.OptIntVal(k,1) .gt. NumFileOpen+1) ) goto 1003 
            FileNum= CMND.OptIntVal(k,1)                         
          else
            do i= 1, NumFileTypes
              do j= 1, 2
                if ( CMND.OptText(j,k) .eq. FileType(i) ) FileTypeNum= i
                if ( CMND.OptText(j,k) .eq. 'NCZ' ) newCS=    .true.
                if ( CMND.OptText(j,k) .eq. 'OGN' ) OldGain=  .true.
                if ( CMND.OptText(j,k) .eq. 'ZER' ) ZeroChnl= .true.
              end do ! j                            
            end do ! i                                           
            if ( (FileTypeNum .eq. 0) .and. (.not. newCS) .and. 
     &           (.not. OldGain) .and. (.not. ZeroChnl)     ) goto 1020 ! error
          end if ! Text or number option
        end do ! k
      end if ! options are present                                 
      if ( FileNum .eq. 0 ) then 
        FileNum= NumFileOpen + 1
        if ( FileNum .gt. 6 ) goto 1007      ! error- no more files can be read
        AddFile= .true.
        write(6,97) FileNum
97      format(' File will be accessed as #',i1/)
      else if ( FileNum .le. NumFileOpen ) then
        close( unit=FD(FileNum).LU )
        write(6,99) FileNum,FD(FileNum).Name
99      format(' Note: File number ',i1,' : ',a40/
     &         '       is being replaced.'//)
      else
        write(6,97) FileNum
        AddFile= .true.
      end if
      if ( FileTypeNum .eq. 8 ) FileTypeNum= GL1_FILE ! alternate GLS1/2 names
      if ( FileTypeNum .eq. 9 ) FileTypeNum= GL2_FILE
c              
c     Now that the options have been figured out- determine the file type
c     based on either the option or the extension of the filename given
c     immediately after the READ command.  If a file type option was given
c     then it is assumed that the file will not need an extension added.
c     If no file type option is given and no valid file extension is found
c     then .ANZ is added to the filename.
c
      nameOK= GetFileName( CMND.Text(1),CMND.CmndStart(2),
     &                     Fname,extension,NameLength  )
      if ( .not. nameOK ) goto 1030 !error- messed up file name
      if ( FileTypeNum .eq. 0 ) then ! check filename extension for type
        FileTypeNum= 0               ! since file type option not given
        do i= 1, NumFileTypes                          
          if ( extension .eq. FileType(i) ) FileTypeNum= i
        end do
        if ( (extension(1:1) .eq. 'R') .or. (extension(1:1) .eq. 'M') ) 
     &    FileTypeNum= GL1_FILE ! Old GLS file
        if ( FileTypeNum .eq. 0 ) then ! ANZ is default file type
          FileTypeNum= ANZ_FILE
          Fname= Fname(1:NameLength)//'.'//FileType(FileTypeNum)
        end if                                        
      endif

      call ZeroFlags( FileNum )      
      if ( FileTypeNum .eq. TR3_FILE ) then                           
        call ReadTr3FileParam( Fname,FileNum,error )
                                                               
      else if ( FileTypeNum .eq. TRU_FILE ) then
        call ReadTruFileParam( Fname,FileNum,error )
                                            
      else if ( FileTypeNum .eq. C3D_FILE ) then                           
        newCS= .true.
        call ReadC3dFileParam( Fname,FileNum,error )
                                                  
      else if ( FileTypeNum .eq. ANZ_FILE ) then                 
        call ReadAnzFileParam( Fname,FileNum,error )
                                                         
      else if ( FileTypeNum .eq. FPD_FILE ) then
        call ReadFpdFileParam( Fname,FileNum,newCS,error )
                         
      else if ( FileTypeNum .eq. GL1_FILE ) then
        call ReadGlsFileParam( Fname,FileNum,newCS,error )

      else if ( FileTypeNum .eq. GL2_FILE ) then
        call ReadGls2FileParam( Fname,FileNum,newCS,error )
        
      end if                                                        
      if ( .not. error ) then
        FD(FileNum).newCS= newCS
        FD(FileNum).OldGain= OldGain
        FD(FileNum).ZeroChnl= ZeroChnl
        FD(FileNum).Name= Fname
        FD(FileNum).Type= FileTypeNum
        if ( AddFile ) NumFileOpen= NumFileOpen + 1
      end if
      return             
                                                                              
1000  write(6,1002)
1002  format(' Error- You must give the name of the file to be read.')
      return

1003  write(6,1004) CMND.OptIntVal(k,1),NumFileOpen
1004  format(' Error- ',i5,' is an invalid file number'/
     &       '        File number must be between 1 and ',i1)
      return

1007  write(6,1009)
1009  format(' Error- 6 files have already been read in.  If you want to'/
     &       '        access another file then read over one of the files'/
     &       '        currently active')
      return

1020  write(6,1025)
1025  format(' Error- Option given is not valid for the READ command.'/
     &       '        Valid options are: TR3,TRU,ANZ,C3D,FPD,GLS,GL2'/
     &       '                           NewCoordZ,ZERo,OldGaiN.')
      return

1030  write(6,1035)
1035  format(' Error- File name as given invalid.')
      return
      end
c
c   Copyright (c) 1990 by Dwight Meglan
c
      subroutine ReadFileData( FileNum,VarNum,CompNum,Axis1Num,Axis2Num,CSNum,
     &                         Start,End,Data,DataOK,error )
      implicit none

      include 'tel_cons.inc'
      include 'tel_strc.inc'
      include 'tel_file.inc'
                       
      integer*4 FileNum,VarNum,CompNum,Axis1Num,Axis2Num,CSNum,Start,End
      real*4    Data(MAX_PLOT_SIZE)
      logical*4 error,DataOK(MAX_PLOT_SIZE)

      error= .true.
      if ( FD(FileNum).Type .eq. TR3_FILE ) then
        call ReadTr3FileData( FileNum,VarNum,CompNum,Axis1Num,Start,End,
     &                        Data,error )
        call SetAllDataOK( DataOK )                            

      else if ( FD(FileNum).Type .eq. TRU_FILE ) then
        call ReadTruFileData( FileNum,VarNum,CompNum,Axis1Num,Start,End,
     &                        Data,error )
        call SetAllDataOK( DataOK )                            

      else if ( FD(FileNum).Type .eq. C3D_FILE ) then
        call ReadC3dFileData( FileNum,VarNum,CompNum,Axis1Num,Start,End,
     &                        Data,error )
        call SetAllDataOK( DataOK )                            

      else if ( FD(FileNum).Type .eq. ANZ_FILE ) then
        call ReadANZFileData( FileNum,VarNum,CompNum,Axis1Num,Axis2Num,
     &                        CSNum,Start,End,Data,DataOK,error )

      else if ( FD(FileNum).Type .eq. FPD_FILE ) then
        call ReadFpdFileData( FileNum,VarNum,CompNum,Axis1Num,Start,End,
     &                        Data,error )
        call SetAllDataOK( DataOK )                            

      else if ( FD(FileNum).Type .eq. GL1_FILE ) then
        call ReadGlsFileData( FileNum,VarNum,CompNum,Axis1Num,Start,End,
     &                        Data,error )
        call SetAllDataOK( DataOK )                            

      else if ( FD(FileNum).Type .eq. GL2_FILE ) then
        call ReadGls2FileData( FileNum,VarNum,CompNum,Axis1Num,Start,End,
     &                         Data,error )
        call SetAllDataOK( DataOK )                            

      end if
      return
      end
c        
c   Copyright (c) 1990 by Dwight Meglan
c
      function GetFileName( line,pos1,Fname,extension,NameLength )
      implicit none                 
         
      integer*4 pos1,NameLength,bracket
      character line*80,Fname*40,extension*3
      logical*4 GetFileName

      integer*4 i,j

      GetFileName= .true.
      i= pos1 
      do while ( (line(i:i) .ne. ' ') .or. (i .gt. 80) )
        i= i + 1
      end do
      if ( i .gt. 80 ) goto 999      !error- messed up filename
      do j= 1, 40
        Fname(j:j)= ' '
      end do   
      Fname= line(pos1:i-1)
      NameLength= i - pos1
      do j= 1, 3
        extension(j:j)= ' '
      end do
      i= NameLength
      do while ( (Fname(i:i) .ne. '.') .and. (i .gt. 1) )
        i= i - 1      
      end do
      bracket= index(Fname,']')
      if ( bracket .gt. 0 ) then ! filename has path information
        if ( i .lt. bracket ) return ! no extension on filename
      end if  
      if ( i .ge. 37 ) i= 36
      extension= Fname(i+1:i+4)
      return
999   GetFileName= .false.
      return
      end      
c              
c   Copyright (c) 1990 by Dwight Meglan                                    
c
      subroutine ZeroFlags( FileNum )
      implicit none

      include 'tel_cons.inc'
      include 'tel_strc.inc'
      include 'tel_file.inc'

      integer*4 i,j,FileNum

      do i= 1, 7
        FD(FileNum).MF.Flag(i)= .false.
      end do

      do i= 1, 12
        FD(FileNum).SF.Flag(i)= .false.
      end do
                           
      do i= 1, 16
        FD(FileNum).JF.Flag(i)= .false.
      end do

      do i= 1, 5
        FD(FileNum).AF.Flag(i)= .false.
      end do

      FD(FileNum).CF.GaitEvent=  .false.  
      FD(FileNum).CF.Statistics= .false.
 
      do i= 1, 26
        FD(FileNum).FF.Flag(i)= .false.
      end do

      do i= 1, 56
        FD(FileNum).EF.Flag(i)= .false.
      end do
c
c     Zero Out the Parameter files also
c
      do i= 1, 512
        FD(FileNum).GP.array(i)= 0
      end do
      do i= 1, 512
        FD(FileNum).MP.array(i)= 0
      end do
      do i= 1, 304
        FD(FileNum).FP.array(i)= 0
      end do      
      do j= 1, MAX_JNT
        do i= 1, 128
          FD(FileNum).SP(j).array(i)= 0
        end do
      end do
      do i= 1, 100
        FD(FileNum).CP.array(i)= 0
      end do
      do i= 1, 512
        FD(FileNum).EP.array(i)= 0
      end do
c
c     Zero out the processing operation counts and the history
c
      FD(FileNum).MF.NumProcOps= 0
      FD(FileNum).SF.NumProcOps= 0
      FD(FileNum).JF.NumProcOps= 0
      FD(FileNum).History(1).NumHistory= 1
      FD(FileNum).History(1).NumLine= 1
      FD(FileNum).History(1).Line(1)= 'No History Available'          
      return
      end                 
c
c   Copyright (c) 1990 by Dwight Meglan
c                          
      subroutine ReadC3dFileParam( filename,FileNum,error )
      implicit none

      include 'tel_cons.inc' 
      include 'tel_strc.inc'
      include 'tel_file.inc'
      include 'tel_name.inc'

      integer*4 FileNum                                         
      character filename*40     
      logical*4 error
                                    
      integer*2 junk1,nummrk,numchnl,frmstart,frmend,junk2,sc(2),hdr_length,
     &          avratio
      integer*4 ErrNum,frm,i
      real*4    scale
                          
      equivalence ( sc(1),scale )                
c
c     Open the file
c
      error= .true.
      open(unit=FD(FileNum).LU,file=filename,access='direct',status='old',
     &     recl=128,form='unformatted',iostat=ErrNum,err=1000  )
c                                   
c     read in file header
c
      frm= 0
      read(FD(FileNum).LU,rec=1,err=1010,iostat=ErrNum) 
     &  junk1,nummrk,numchnl,frmstart,frmend,junk2,sc(1),sc(2),
     &  hdr_length,avratio
      FD(FileNum).MP.num_frm= frmend - frmstart + 1
      FD(FileNum).MP.num_mrk= nummrk
      FD(FileNum).MP.cycle_first_frm(1)= frmstart
      FD(FileNum).MP.frm_rate= 50
      FD(FileNum).rMtnFrmRate= 50.0
      FD(FileNum).MP.first_frm= frmstart                   
      FD(FileNum).NumChnl= numchnl
      FD(FileNum).HdrLnth= hdr_length
      FD(FileNum).AvRatio= avratio
      FD(FileNum).C3dScale= scale
      error= .false.
      FD(FileNum).MF.read= .true.
      do i= 1, 40
         FD(FileNum).GP.motion_file= ' '
      end do
      i= lentrim(filename)
      FD(FileNum).GP.motion_file(1:i)= filename(1:i)
      if ( FD(FileNum).MP.num_frm .gt. MAX_MTN_FRM ) then ! this check is just a
        FD(FileNum).MP.num_frm= MAX_MTN_FRM               ! precaution...
        write(6,101) FD(FileNum).Name,MAX_MTN_FRM
101     format(' Warning- Data from ',a40,' will be clipped'/
     &         ' at ',i5,' points')
      end if
      return
                   
1000  write(6,1005) filename,ErrNum
1005  format(' Error- Trouble opening ',a40/
     &       '        Error number ',i2,' occurred.')                
      return
            
1010  write(6,1015) ErrNum,filename
1015  format(' Error- Error number ',i2,' occurred while reading ',a40)
      return
      end
c
c   Copyright (c) 1990 by Dwight Meglan                                
c
c     -- This routine should be cleaned up later on once it gets used
c
      subroutine ReadC3dFileData( FileNum,VarNum,CompNum,AxisNum,Start,End,
     &                            Data,error )
      implicit none

      include 'tel_cons.inc'
      include 'tel_strc.inc'
      include 'tel_file.inc'
      include 'tel_name.inc'
                       
      integer*4 FileNum,VarNum,CompNum,AxisNum,Start,End
      real*4    Data(1)
      logical*4 error

      real*4    MrkData(3,MAX_MTN_FRM,MAX_MRK)
      integer*2 buffer(256)
      integer*4 record_num,word_in_rec,prev_record,words_to_frm,i,
     &          axis,mrk,c3d_tru(21),ErrNum,frm,frm_length,PrevFileNum
                            
c      data c3d_tru /9,20,8,24,7,22,1,2,12,21,11,25,10,23,3,16,15,14,19,18,17/
      data c3d_tru /14,15,16,1,22,7,8,9,17,18,19,3,23,10,11,12,20,21,2,24,25/
c                 
c     read in marker position data.  Note the array c3d_tru is used as an
c     indirection operator to line up the marker data in the marker_data
c     array in the same order that is for a tru file.  I.e., the markers
c     are in different orders in the two files.                   
c
      if ( FileNum .ne. PrevFileNum ) then       
        error= .true.
        frm_length= FD(FileNum).MP.num_mrk*4 + FD(FileNum).NumChnl
        prev_record= 0
        do frm= 1, FD(FileNum).MP.num_frm
          if ( mod(frm,10) .eq. 0 ) write(6,102) frm,FD(FileNum).Name,
     &                                            FD(FileNum).MP.num_frm
102       format('+Reading ',a4,' at frame # ',i3,'/',i3)
          words_to_frm= (frm-1)*frm_length
          record_num= words_to_frm/256. + 0.001                            
          word_in_rec= (words_to_frm - float(record_num)*256.) + 0.001 + 1
          record_num= record_num + FD(FileNum).HdrLnth
          if ( record_num .ne. prev_record ) then
            read(FD(FileNum).LU,rec=record_num,err=1010,iostat=ErrNum) buffer
            prev_record= record_num         
          end if         
          do mrk= 1, FD(FileNum).MP.num_mrk                       
            do axis= x, z
              if ( word_in_rec .gt. 256 ) then
                word_in_rec= word_in_rec - 256
                prev_record= prev_record + 1
                read(FD(FileNum).LU,rec=prev_record,err=1010,iostat=ErrNum) buffer
              end if                        
              if ( FD(FileNum).MP.num_mrk .eq. 21 ) i= c3d_tru(mrk)       
              MrkData(axis,frm,i)= buffer(word_in_rec)*FD(FileNum).C3dScale*
     &                             0.001
              word_in_rec= word_in_rec + 1   
            end do ! axis
            if ( .not. FD(FileNum).NewCS ) MrkData(z,frm,i)=
     &                                       MrkData(z,frm,i) - 0.483
            word_in_rec= word_in_rec + 1 + FD(FileNum).NumChnl
          end do ! mrk
        end do ! frm
        do frm= Start, End                                                
          Data(frm-Start+1)= MrkData(AxisNum,frm,CompNum)
        end do
        PrevFileNum= FileNum
        error= .false.
      else
        do frm= Start, End
          Data(frm-Start+1)= MrkData(AxisNum,frm,CompNum)
        end do
        error= .false.
      end if
      return          
                                                                      
1010  write(6,1015) ErrNum,FD(FileNum).Name
1015  format(' Error- Error number ',i2,' occurred while reading ',a40)
      return
      end                
c                           
c   Copyright (c) 1990 by Dwight Meglan        
c                            
      subroutine ReadTr3FileParam( filename,FileNum,error )
      implicit none

      include 'tel_cons.inc'
      include 'tel_strc.inc'
      include 'tel_file.inc'
      include 'tel_name.inc'                                 

      integer*4 FileNum
      character filename*40
      logical*4 error
                             
      integer*4 ErrNum,frm,i,mrk,tr3_tru(25)
      integer*2 frmstart,frmend,numhdr,junk(4),nummrk
      character mrk_names(25)*8

      data tr3_tru /14,15,16,1,22,7,30,30,8,9,17,18,19,3,23,10,30,30,11,12,
     &              20,21,2,24,25                                   /
                     
      data mrk_names / 'rtshldr  ','rtelbow ','rtwrist ','rtasis  ','rtfmstk ',
     &                 'rtknee   ','raknee  ','raakle  ','rtankle ','rttoe   ',
     &                 'lfshldr  ','lfelbow ','lfwrist ','lfasis  ','lffmstk ',
     &                 'lfknee   ','laknee  ','laakle  ','lfankle ','lftoe   ',
     &                 'rtheel   ','lfheel  ','sacstk  ','rttbstk ','lftbstk '/
c 
c     Open file
c
      error= .true.
      open(unit=FD(FileNum).LU,file=filename,access='direct',status='old',
     &     recl=4,form='unformatted',err=1000,iostat=ErrNum  )
c                                 
c     Read in the header of the tr3 file
c        
      frm= 0
      read(FD(FileNum).LU,rec=1,err=1010,iostat=ErrNum) numhdr,nummrk,frmstart,
     &                                              frmend,(junk(i),i=1,4)
      FD(FileNum).MP.num_frm= frmend-frmstart+1 
      FD(FileNum).MP.num_mrk= nummrk
      FD(FileNum).MP.frm_rate= 50                                
      FD(FileNum).rMtnFrmRate= 50.0
      FD(FileNum).MP.cycle_first_frm(1)= frmstart
      FD(FileNum).MP.cycle_last_frm(1)=  frmend
      FD(FileNum).MP.first_frm= frmstart
      FD(FileNum).NumHdr= numhdr
c
c     Assign marker names- This must be changed if the marker configuration
c     is modified                      
c                               
      do mrk= 1, FD(FileNum).MP.num_mrk
        FD(FileNum).MP.mrk_name(tr3_tru(mrk))= mrk_names(mrk)
      end do ! mrk                  
      FD(FileNum).MF.read= .true.   
      FD(FileNum).GP.motion_file= filename
      if ( FD(FileNum).MP.num_frm .gt. MAX_MTN_FRM ) then ! this check is just a
        FD(FileNum).MP.num_frm= MAX_MTN_FRM               ! precaution...
        write(6,101) FD(FileNum).Name,MAX_MTN_FRM
101     format(' Warning- Data from ',a40,' will be clipped'/
     &         ' at ',i5,' points')
      end if
      error= .false.
      return              
      
1000  write(6,1005) filename,ErrNum
1005  format(' Error- Error opening ',a40/
     &       '        Error number ',i2,' occurred.')
      return      

1010  write(6,1015) ErrNum,filename
1015  format(' Error- Error number ',i2,' occurred while reading ',a40)
      return
      end     
c
c   Copyright (c) 1990 by Dwight Meglan
c
      subroutine ReadTr3FileData( FileNum,VarNum,CompNum,AxisNum,Start,End,
     &                            Data,error )
      implicit none

      include 'tel_cons.inc'
      include 'tel_strc.inc'
      include 'tel_file.inc'
      include 'tel_name.inc'

      integer*4 FileNum,VarNum,CompNum,AxisNum,Start,End
      real*4    Data(1)
      logical*4 error
                       
      real*4    MrkData(3,MAX_MTN_FRM,MAX_MRK),point(3)
      integer*4 temp(4),pntr,mrk,axis,i,tr3_tru(25),ErrNum,frm,PrevFileNum
      integer*2 junk(2)               
    
      data tr3_tru /14,15,16,1,22,7,30,30,8,9,17,18,19,3,23,10,30,30,11,12,
     &              20,21,2,24,25                                   /
c             
c     Read in the marker position data.  Note that marker#'s 7,8,17,18 are
c     skipped.  These markers existed in the older tr3 files but are not
c     used anymore.  Also, note that the indirection array tr3_tru is
c     used to place the markers in the same position as they would be if
c     a tru file were read in.                   
c
      if ( FileNum .ne. PrevFileNum ) then
        error= .true.
        pntr= FD(FileNum).NumHdr+1
        do frm= 1, FD(FileNum).MP.num_frm
          if ( mod(frm,10) .eq. 0 ) write(6,102) frm,FD(FileNum).MP.num_frm
102       format('+Reading frame # ',i3,'/',i3)                       
          do mrk= 1, FD(FileNum).MP.num_mrk
            if ( (mrk .ne. 7)  .and. (mrk .ne. 8) .and.
     &           (mrk .ne. 17) .and. (mrk .ne. 18)      ) then
              read(FD(FileNum).LU,rec=pntr,err=1010,iostat=ErrNum) 
     &          temp(1),temp(2),temp(3),temp(4)
              if ( temp(1) .eq. '00008000'X ) then ! this is -0 when the data
                do axis= x, z                      ! is bad
                  MrkData(axis,frm,tr3_tru(mrk))= 0.0
                end do ! axis
              else              
                read(FD(FileNum).LU,rec=pntr,err=1010,iostat=ErrNum) 
     &            point(x),point(y),point(z),junk(1),junk(2)
c                                       
c             swap x and y axes since ANZ has the global coordinate system
c             rotated about the z axis relative to that used previously
c
                i= tr3_tru(mrk)                              
                MrkData(x,frm,i)= point(y)            
                MrkData(y,frm,i)= -point(x)
                MrkData(z,frm,i)= point(z)
                if ( .not. FD(FileNum).newCS ) MrkData(z,frm,i)=
     &                                           MrkData(z,frm,i) + 0.483 !m
              end if
            end if                  
            pntr= pntr + 1
          end do ! mrk      
        end do ! frm
        do frm= Start, End
          Data(frm-Start+1)= MrkData(AxisNum,frm,CompNum)
        end do
        PrevFileNum= FileNum
        error= .false.
      else
        do frm= Start, End
          Data(frm-Start+1)= MrkData(AxisNum,frm,CompNum)  
        end do
        error= .false.
      end if
      return          

1010  write(6,1015) ErrNum,FD(FileNum).Name
1015  format(' Error- Error number ',i2,' occurred while reading ',a40)
      return
      end                
c      
c   Copyright (c) 1990 by Dwight Meglan                           
c                        
      subroutine ReadTruFileParam( filename,FileNum,error )
      implicit none      

      include 'tel_cons.inc'
      include 'tel_strc.inc'
      include 'tel_file.inc'
      include 'tel_name.inc'
                                                                        
      integer*4 FileNum
      character filename*40 
      logical*4 error
                                                                              
      real*4     meter,VecMag,sign(3)
      integer*2  anat_name_ptr,word_size_of_frm,NumFrm,FrmRate,NumMrk,
     &           frm1_ptr,value,gait_event
      integer*4  ptr,frm,i,ErrNum,mrk,Order,EventFrmNum(5)
      character  mrk_names(34)*8,pair(4)*2
      logical*4  AngleOnly,EventOrderOK
c
c     Open file
c
      error= .true.
      open( unit=FD(FileNum).LU,file=filename,access='direct',status='old',
     &      recl=2,carriagecontrol='none',
     &      form='formatted',recordtype='fixed',iostat=ErrNum,err=1000 )
c                                   
c     read in file header parameters
c
      AngleOnly= .false.
      ErrNum= 0   
      read(FD(FileNum).LU,rec=1,fmt=101,err=1010,iostat=ErrNum) NumFrm
      FD(FileNum).MP.num_frm= NumFrm
101   format(a2)      
      if ( FD(FileNum).MP.num_frm .gt. MAX_MTN_FRM ) then ! this check is just a
        FD(FileNum).MP.num_frm= MAX_MTN_FRM               ! precaution...
        write(6,102) FD(FileNum).Name,MAX_MTN_FRM
102     format(' Warning- Data from ',a40,' will be clipped'/
     &         ' at ',i5,' points')
      end if
      read(FD(FileNum).LU,rec=3,fmt=101,err=1010,iostat=ErrNum) FrmRate
      FD(FileNum).MP.frm_rate= FrmRate
      FD(FileNum).rMtnFrmRate= float(FrmRate)
      read(FD(FileNum).LU,rec=4,fmt=101,err=1010,iostat=ErrNum) word_size_of_frm
      read(FD(FileNum).LU,rec=6,fmt=101,err=1010,iostat=ErrNum) anat_name_ptr
      read(FD(FileNum).LU,rec=7,fmt=101,err=1010,iostat=ErrNum) frm1_ptr
      FD(FileNum).FrmWordSize= word_size_of_frm
      FD(FileNum).Frm1Ptr=     frm1_ptr
      FD(FileNum).MP.first_frm= 1                            
c                            
c     read in marker names
c
      ptr= anat_name_ptr
      read(FD(FileNum).LU,rec=ptr,fmt=101,err=1010,iostat=ErrNum) NumMrk
      FD(FileNum).MP.num_mrk= NumMrk
      if ( NumMrk .eq. 7 ) then ! joint angles only
        FD(FileNum).JF.AngEUL= .true.
        AngleOnly= .true.
      else if ( NumMrk .gt. 27 ) then  ! this means there is marker and angle
        FD(FileNum).MP.num_mrk= 27     ! data in the file
        FD(FileNum).JF.AngEUL= .true.
      end if        
      if ( .not. AngleOnly ) then
        do mrk= 1, FD(FileNum).MP.num_mrk
          do i= 1, 4                  
            ptr= ptr+1
            read(FD(FileNum).LU,rec=ptr,fmt=101,err=1010,iostat=ErrNum) pair(i)
          end do ! i
          mrk_names(mrk)= pair(1)//pair(2)//pair(3)//pair(4)
          FD(FileNum).MP.mrk_name(mrk)= mrk_names(mrk)(1:4)
        end do ! mrk
      end if
c
c     Read in Gait Events
c
      do frm= 1, FD(FileNum).MP.num_frm
        ptr= frm1_ptr + (frm-1)*word_size_of_frm + 1
        read(FD(FileNum).LU,rec=ptr,fmt=101,err=1010,iostat=ErrNum) gait_event
        FD(FileNum).GaitEvent(frm)= gait_event
        if ( gait_event .eq. 1 ) then
          FD(FileNum).MP.num_rhs= FD(FileNum).MP.num_rhs + 1
          FD(FileNum).MP.rhs_frm(FD(FileNum).MP.num_rhs)= frm   
        else if ( gait_event .eq. 2 ) then
          FD(FileNum).MP.num_lhs= FD(FileNum).MP.num_lhs + 1
          FD(FileNum).MP.lhs_frm(FD(FileNum).MP.num_lhs)= frm
        else if ( gait_event .eq. 3 ) then
          FD(FileNum).MP.num_rto= FD(FileNum).MP.num_rto + 1
          FD(FileNum).MP.rto_frm(FD(FileNum).MP.num_rto)= frm
        else if ( gait_event .eq. 4 ) then
          FD(FileNum).MP.num_lto= FD(FileNum).MP.num_lto + 1
          FD(FileNum).MP.lto_frm(FD(FileNum).MP.num_lto)= frm
        end if
      end do ! frm
      if ( AngleOnly )  write(6,111)
111   format(' NOTE- This TRU file contains only joint angles')
c
c     Check the gait event pattern and set the appropriate cycle parameters
c                           
      FD(FileNum).CF.GaitEvent= .false.
      if ( EventOrderOK(FD(FileNum).GaitEvent,FD(FileNum).MP.num_frm,
     &                  Order,EventFrmNum) ) FD(FileNum).CF.GaitEvent= .true.
      if ( .not. AngleOnly ) FD(FileNum).MF.read= .true.
      FD(FileNum).GP.motion_file= filename
      FD(FileNum).GP.num_jnt= 7
      do i= 1, 7
        FD(FileNum).GP.jnt_num(i)= i
      end do
      error= .false.
      return
                                   
1000  write(6,1005) filename,ErrNum
1005  format(' Error- Error opening ',a40/
     &       '        Error number ',i2,' occurred.'/)
      return      
                   
1010  write(6,1015) ErrNum,filename
1015  format(' Error- Error number ',i2,' occurred while reading ',a40)
      return
      end     
c
c   Copyright (c) 1990 by Dwight Meglan                      
c
      subroutine ReadTruFileData( FileNum,VarNum,CompNum,AxisNum,Start,End,
     &                            Data,error )
      implicit none

      include 'tel_cons.inc'
      include 'tel_strc.inc'
      include 'tel_file.inc'
      include 'tel_name.inc'

      integer*4 FileNum,VarNum,CompNum,AxisNum,Start,End
      real*4    Data(1)                     
      logical*4 error
                                  
      real*4     meter,sign(3)
      integer*4  ptr,frm,i,AnzAxis(3),ErrNum,AnzAng(7),AngOrder(3),
     &           PlvAngOrder(3)
      integer*2  value                 
                            
      data meter,sign /0.0254,1.0,-1.0,1.0/
      data AnzAxis / 2,1,3 /
      data AnzAng  / 4,3,2,7,6,5,1 /
      data AngOrder,PlvAngOrder / 1,3,2,1,2,3 /              
                                            
c
c     Decide whether mark position or angle data is to be read
c
      error= .true.   
      if ( VarNum .eq. MPN_DATA ) then
        do frm= Start, End 
          if ( mod(frm,10) .eq. 0 ) write(6,200) CompNum,CSAxes(AxisNum),
     &                                            frm,End-Start+1
200       format('+Reading marker # ',i2,1x,a4,' frame # ',i3,'/',i3)
          ptr= FD(FileNum).Frm1Ptr + (frm-1)*FD(FileNum).FrmWordSize + 2 +
     &         (CompNum-1)*3 + AnzAxis(AxisNum) - 1
          read(FD(FileNum).LU,rec=ptr,fmt=101,err=1010,iostat=ErrNum) value
101       format(a2)
          Data(frm-Start+1)= value*0.1*meter*sign(AxisNum)
          if ( (.not. FD(FileNum).NewCS) .and. (AxisNum .eq. 3) ) 
     &      Data(frm-Start+1)= Data(frm-Start+1) + 0.483
        end do
        error= .false.
      else if ( VarNum .eq. JAN_DATA ) then                     
        do frm= Start, End      
          if ( mod(frm,10) .eq. 0 ) write(6,210) JntNames(CompNum),
     &                                            AngAxes(AxisNum),
     &                                            frm,End-Start+1
210       format('+Reading Joint angle ',a4,1x,a4,' frame # ',i3,'/',i3)
          if ( CompNum .ne. pvlb ) then
            ptr= FD(FileNum).Frm1Ptr + (frm-1)*FD(FileNum).FrmWordSize + 2 +
     &           FD(FileNum).MP.num_mrk*3 +
     &           (AnzAng(CompNum)-1)*3 + AngOrder(AxisNum) - 1 
          else
            ptr= FD(FileNum).Frm1Ptr + (frm-1)*FD(FileNum).FrmWordSize + 2 +
     &           FD(FileNum).MP.num_mrk*3 +
     &           (AnzAng(CompNum)-1)*3 + PlvAngOrder(AxisNum) - 1 
          end if
          read(FD(FileNum).LU,rec=ptr,fmt=101,err=1010,iostat=ErrNum) value
          Data(frm-Start+1)= 0.1*value
        end do
        error= .false.
      end if
      return
                   
1010  write(6,1015) ErrNum,FD(FileNum).Name
1015  format(' Error- Error number ',i2,' occurred while reading ',a40)
      return
      end     
c                  
c   Copyright (c) 1990 by Dwight Meglan                   
c
      subroutine ReadFpdFileParam( filename,FileNum,NewCS,error )
      implicit none

      include 'tel_cons.inc'      
      include 'tel_strc.inc'
      include 'tel_file.inc'
      include 'tel_name.inc'
      include 'tel_plt.inc'

      integer*4 FileNum
      character filename*40
      logical*4 error,NewCS  

      integer*2 int_buffer(12)
      integer*4 i,j,k,flip(3),ErrNum

      data flip / 1,3,2 /
c                                                                
c     Assign force plate locations and sizes.  Note that the flip redirection
c     array is being used because the 2nd and 3rd plates are accidentally
c     switched in the VICON fpd files.
c
      do i= 1, 3
        do j= 1, 2                 
          FD(FileNum).FP.plt_size(j,i)= PltSize(j,flip(i))
        end do       
        do j= x, cntr
          do k= x, z
            FD(FileNum).FP.plt_loc(i).LCS(k,j)= PltLoc(k,j,flip(i))
          end do
        end do
      end do
      if ( .not. NewCS ) then
        do i= 1, 3
          FD(FileNum).FP.plt_loc(i).LCS(z,cntr)= -0.483 !m
        end do ! i
      end if
c                                                    
c       Open file                                                         
c 
      error= .true.
      open(unit=FD(FileNum).LU,file=filename,access='direct',status='old',
     &     iostat=ErrNum,err=1000 )
c
c     Get data file pointers
c              
      read(FD(FileNum).LU,rec=1,err=1010,iostat=ErrNum) int_buffer
      FD(FileNum).FP.num_plt= int_buffer(2)
      FD(FileNum).DataStartPtr= int_buffer(3)+2*FD(FileNum).FP.num_plt
      FD(FileNum).DataEndPtr=   int_buffer(4)*FD(FileNum).FP.num_plt + 
     &                          2*FD(FileNum).FP.num_plt
      FD(FileNum).FP.num_frm= ( FD(FileNum).DataEndPtr - 
     &                          FD(FileNum).DataStartPtr )/
     &                          FD(FileNum).FP.num_plt
      FD(FileNum).FP.frm_rate= 50           
      error= .false.
      FD(FileNum).FF.read= .true.
      FD(FileNum).GP.force_file= filename
      if ( FD(FileNum).FP.num_frm .gt. MAX_ELEC_FRM ) then ! this check is just a
        FD(FileNum).FP.num_frm= MAX_ELEC_FRM               ! precaution...
        write(6,101) FD(FileNum).Name,MAX_ELEC_FRM
101     format(' Warning- Data from ',a40,' will be clipped'/
     &         ' at ',i5,' points')
      end if
      return 

1000  write(6,1005) filename,ErrNum
1005  format(' Error- Trouble opening ',a40/
     &       '        Error number ',i2,' occurred.'/)
      return      
      
1010  write(6,1015) ErrNum,filename
1015  format(' Error- Error # ',i2,' occured while reading ',a40/
     &       '        at pointer # 1')
      return      
      end
c
c   Copyright (c) 1990 by Dwight Meglan
c
      subroutine ReadFpdFileData( FileNum,VarNum,CompNum,AxisNum,Start,End,
     &                            Data,error )
      implicit none
  
      include 'tel_cons.inc'
      include 'tel_strc.inc'
      include 'tel_file.inc'           
      include 'tel_name.inc'

      integer*4 FileNum,VarNum,CompNum,AxisNum,Start,End
      real*4    Data(1)                     
      logical*4 error
                                  
      real*4    real_buffer(6),newton,meter
      integer*4 ptr,ErrNum,frm

      data newton,meter  / 4.4481,0.0254 /  ! N/lb , m/in
c                    
c     read in forceplate data
c
      do frm= Start, End
        if ( mod(frm,10) .eq. 0 ) 
     &    write(6,102) CompNum,FrcNames(AxisNum),frm,FD(FileNum).FP.num_frm
102     format('+Reading Plate #',i1,1x,a3,' sample # ',i5,'/',i5)
        ptr= FD(FileNum).DataStartPtr + (CompNum-1) + 
     &       (frm-1)*FD(FileNum).FP.num_plt
        read(FD(FileNum).LU,rec=ptr,err=1010,iostat=ErrNum) real_buffer
        if ( AxisNum .le. fz ) then
          Data(frm)= real_buffer(AxisNum)*newton
        else
          Data(frm)= real_buffer(AxisNum)*newton*meter
        end if
      end do
      return

1010  write(6,1015) ErrNum,FD(FileNum).Name,ptr
1015  format(' Error- Error # ',i2,' occured while reading ',a40/
     &       '        at pointer # ',i5)
      return      
      end
c
c   Copyright (c) 1990 by Dwight Meglan                                   
c                         
      subroutine ReadGlsFileParam( filename,FileNum,newCS,error )
      implicit none                 
      
      include 'tel_cons.inc'
      include 'tel_strc.inc'
      include 'tel_file.inc'
      include 'tel_name.inc'
      include 'tel_plt.inc'
                                                      
      integer*4 FileNum
      character filename*40
      logical*4 error,newCS

      real*4    gain,kg
      integer*4 end,ErrNum,PltCode(12),ChnlCode,frm,plt,axis,i,j,k,LUN1,LUN2
      integer*2 HdrPtr,group,f1,f2,f3                  
      character Root*40,mfile*40,rfile*40,blank*20

      data kg / 2.2209 / ! kg/lb
                                    
      structure / GenInfo /              ! These structures are based upon
        union                            ! the program EPLOT written by
          map                            ! Jim Feller at OSU to extract and
            integer*2 array(17)          ! plot EMG signals from the old
          end map                        ! GLS files
          map
            integer*2   filla
            integer*2   ChnlHdrPtr
            integer*2   MiscHdrPtr
            integer*2   NumSample
            integer*2   SampleStart
            integer*2   Mode
            integer*2   TakeNum
            integer*2   Base
            character*9 Date
            character*1 fillb
            character*8 Time
          end map
        end union
      end structure

      structure / MiscInfo /
        union
          map
            integer*2 array(6)
          end map
          map
            integer*2 weight
            integer*2 direction
            integer*2 foot
            real*4    convertFactor
            integer*2 SampleRate
          end map
        end union
      end structure
             
      structure / ChnlGain /
        real*8 FWord
        real*8 Gain                            
      end structure

      structure / ChnlInfo /
        union    
          map     
            integer*2 array(256)
          end map
          map
            record /ChnlGain/ Num(32)
          end map
        end union
      end structure

      record /GenInfo/  HDR
      record /MiscInfo/ MISC         
      record /ChnlInfo/ CHNL
                                                                 
      data PltCode  / 3,2,1,6,5,4,3,2,1,6,5,4 /
      data blank / '                    '/
c                   
c     Assign force plate sizes and locations to FD(FileNum).FP.  Only 2 plates
c     present in GLS files. NOTE: In GLS only the second and third plates in 
c     the lab are active, therefore the second and third plate sizes and 
c     locations are assigned to plates 1 and 2.
c                                              
      do i= 1, 2                                                
        do j= 1, 2
          FD(FileNum).FP.plt_size(j,i)= PltSize(j,i+1)
        end do
        do j= x, cntr
          do k= x, z
            FD(FileNum).FP.plt_loc(i).LCS(k,j)= PltLoc(k,j,i+1)
          end do           
        end do
      end do
c      if ( .not. newCS ) then
c        do i= 1, 2
c          FD(FileNum).FP.plt_loc(i).LCS(z,cntr)= -0.483 !m
c        end do ! i
c      end if
c                                                                 
c     Form file root name and open M and R files
c
      error= .true.
      end= 0
      i= 40
      do while( (i .gt. 0) .and. (end .eq. 0) ) 
        if ( filename(i:i) .eq. '.' ) end= i-1
        i= i - 1
      end do
      if ( end .gt. 0 ) then
        Root= filename(1:end)
        mfile= Root(1:end)//'.M'//filename(end+3:end+4)
        rfile= Root(1:end)//'.R'//filename(end+3:end+4)
      else                                     
        Root= filename
        mfile= filename(1:index(filename,' ')-1)//'.M'//filename(end+3:end+4)
        rfile= filename(1:index(filename,' ')-1)//'.R'//filename(end+3:end+4)
      end if
      LUN1= FD(FileNum).LU
      LUN2= LUN1 + 10
      open ( unit=LUN2,file=mfile,status='OLD',access='DIRECT',
     &       iostat=ErrNum,err=1000 )
      open ( unit=LUN1,file=rfile,status='OLD',access='DIRECT',
     &       iostat=ErrNum,err=1010 )
c
c     Files have been opened successfully.  Now read in M file header info
c                     
      read(LUN2,rec=4,err=1020,iostat=ErrNum) HdrPtr
      do i= 1, 17                                                           
        read(LUN2,rec=HdrPtr+i,err=1020,iostat=ErrNum) HDR.array(i)
      end do
      do i= 1, 6
        read(LUN2,rec=HDR.MiscHdrPtr+i,err=1020,iostat=ErrNum) MISC.array(i)
      end do        
      do i= 1, 256
        read(LUN2,rec=HDR.ChnlHdrPtr+i,err=1020,iostat=ErrNum) CHNL.array(i)
      end do
      close(unit=LUN2)
c                
c     Determine which of the electrical channels are from force plates
c     and which are from EMG's
c
      do plt= 1, 3    ! zero out physical channel pointers for force plates
        do i= 1, 6
          FD(FileNum).FrcChnlNum(i,plt)= 0
        end do
      end do
      FD(FileNum).EP.NumChnl= 0        
      FD(FileNum).FP.num_plt= 0
      do i= 1, 31
        group= CHNL.Num(i).FWord / 1.0d9   
        f1= group/100              ! force channel number
        f2= mod(abs(group),100)/10 ! force plate number - 1
        f3= mod(abs(group),10)
        gain= sngl( CHNL.Num(i).Gain / 1.0d5 )
        FD(FileNum).ChnlGain(i)= gain / 1000.
        if ( FD(FileNum).ChnlGain(i) .le. 0.0 ) FD(FileNum).ChnlGain(i)= 1.0
        if ( f1 .gt. 0 ) then ! it's a force channel...
          if ( f1 .gt. 2 ) goto 1030 ! error bad plate number
          if ( f1 .gt. FD(FileNum).FP.num_plt ) FD(FileNum).FP.num_plt= f1
          ChnlCode= 6*(f1-1) + f2 + f3**2                   
          if ( (ChnlCode .gt. 0) .and. (ChnlCode .lt. 7) ) then ! plate # 1
            FD(FileNum).FrcChnlNum(PltCode(ChnlCode),1)= i
          else if ( (ChnlCode .gt. 6) .and. (ChnlCode .lt. 13) ) then ! plate #2
            FD(FileNum).FrcChnlNum(PltCode(ChnlCode),2)= i
          else
            goto 1040 ! bad force plate channel code
          end if
        else if ( f1 .lt. 0 ) then ! EMG channel
          if ( FD(FileNum).EP.NumChnl .lt. 16 ) then    ! limit # of channels
            FD(FileNum).EP.NumChnl= FD(FileNum).EP.NumChnl + 1
            FD(FileNum).EMGChnlNum(FD(FileNum).EP.NumChnl)= i
            FD(FileNum).EP.CodeNum(FD(FileNum).EP.NumChnl)= abs(f1)
            FD(FileNum).EP.Surface(FD(FileNum).EP.NumChnl)= .true.
            FD(FileNum).EP.Name(FD(FileNum).EP.NumChnl)= blank
          end if
        end if
      end do           
      do plt= 1, FD(FileNum).FP.num_plt   ! check whether all 6 pointers for each plate
        do i= 1, 6                 ! have been set- if not...
          if ( FD(FileNum).FrcChnlNum(i,plt) .eq. 0 ) goto 1060 ! error
        end do                                             
      end do
c                
c     Assign various run parameters   NOTE- there seems to be something
c     wrong in the sampling rate recorded in the gls file because everyone
c     tells me that the data is taken at 500 Hz but the file header says
c     that the sampling rate is 125 Hz.  I have hard coded the sampling
c     rate at 500 as a result. 
c
      if ( FD(FileNum).FP.num_plt .gt. 0 ) FD(FileNum).FF.Read= .true.
      if ( FD(FileNum).EP.NumChnl .gt. 0 ) FD(FileNum).EF.Read= .true.
      FD(FileNum).FP.num_frm=      HDR.NumSample
      FD(FileNum).EP.NumSamples=   HDR.NumSample
      FD(FileNum).FP.frm_rate=     500 ! should really be MISC.SampleRate
      FD(FileNum).EP.SampleRate=   500 ! should really be MISC.SampleRate
      if ( FD(FileNum).FP.frm_rate .le. 0 ) FD(FileNum).FP.frm_rate= 500 ! default, Hz
      if ( FD(FileNum).rMtnFrmRate .gt. 0 ) then
        FD(FileNum).FP.av_frm_ratio= float(FD(FileNum).FP.frm_rate)/
     &                               FD(FileNum).rMtnFrmRate
      else
        FD(FileNum).FP.av_frm_ratio= 1.0
      end if                                           
      FD(FileNum).GP.weight= float(MISC.weight)*MISC.convertFactor/kg      
      FD(FileNum).FP.FirstFoot= MISC.foot
      FD(FileNum).FP.Direction= MISC.direction
      FD(FileNum).GP.force_file= rfile
      if ( FD(FileNum).FP.num_frm .gt. MAX_ELEC_FRM ) then ! this check is just a
        FD(FileNum).FP.num_frm= MAX_ELEC_FRM               ! precaution...
        FD(FileNum).EP.NumSamples= MAX_ELEC_FRM
        write(6,101) FD(FileNum).Name,MAX_ELEC_FRM
101     format(' Warning- Data from ',a40,' will be clipped'/
     &         ' at ',i5,' points')
      end if
      error= .false.
      return                                            
                  
1000  write(6,1005) mfile,ErrNum
1005  format(' Error- Could not open GLS Mfile : ',a40/
     &       '        Error # ',i3,' occured.')
      return
                  
1010  write(6,1015) rfile,ErrNum
1015  format(' Error- Could not open GLS Rfile : ',a40/
     &       '        Error # ',i3,' occured.')
      close(unit=LUN2)
      return
                  
1020  write(6,1025) ErrNum
1025  format(' Error- Trouble reading M file header information.'/
     &       '        Error # ',i3,' occured.')
      close(unit=LUN2)
      close(unit=LUN1)
      return
 
1030  write(6,1035) f1
1035  format(' Error- Bad information in M file header.'/
     &       '        ',i3,' force plates indicated but only',
     &       ' 0,1 or 2 allowed.')
      close(unit=LUN1)
      return
                     
1040  write(6,1045) ChnlCode
1045  format(' Error- Bad information in M file header.'/
     &       '        Force plate channel code calculated to be ',i3/
     &       '        but only codes from 1 to 12 allowed.')
      close(unit=LUN1)                             
      return
            
1060  write(6,1065) FrcNames(i),plt
1065  format(' Error- The data channel # of the ',a3,' axis of plate ',i2/
     &       '        is set to 0 which is not physically possible.'/
     &       '        Something is not right with the M file header.')
      close(unit=LUN1)
      return       
      end   
c
c   Copyright (c) 1990 by Dwight Meglan
c
      subroutine ReadGlsFileData( FileNum,VarNum,CompNum,AxisNum,Start,End,
     &                            Data,error )
      implicit none
  
      include 'tel_cons.inc'     
      include 'tel_strc.inc'
      include 'tel_file.inc'           
      include 'tel_name.inc'
                                  
      integer*4 FileNum,VarNum,CompNum,AxisNum,Start,End
      real*4    Data(1)                     
      logical*4 error                                  

      real*4    kg,newton,meter
      integer*4 ErrNum,frm,plt,axis,ChnlNum
                 
      structure / ChnlData /
        union      
          map
            integer*2 IntVal(32)
          end map
          map
            character*64 Ascii
          end map
        end union
      end structure

      record /ChnlData/ ChnlDATA
                                        
      data kg / 2.2241 / ! convert lbs to kg
      data newton,meter  / 4.4482,0.0254 /  ! N/lb, m/in
c                                    
c     Determine whether Force or EMG data is to be read in
c     NOTE: The 10x on the moments is purely based upon observed error
c           in the calculation of center of pressure
c                                       
      error= .true.
      if ( VarNum .eq. FPL_DATA ) then
        do frm= Start, End
          if ( mod(frm,20) .eq. 0 ) write(6,102) CompNum,FrcNames(AxisNum),
     &                                            frm,FD(FileNum).FP.num_frm
102       format('+Reading plate #',i1,1x,a3,' sample # ',i5,'/',i5)
          read(FD(FileNum).LU,rec=frm,iostat=ErrNum,err=1050) ChnlDATA.Ascii
          ChnlNum= FD(FileNum).FrcChnlNum(AxisNum,CompNum)
          Data(frm-Start+1)=  float(ChnlDATA.IntVal(ChnlNum))/
     &                        FD(FileNum).ChnlGain(ChnlNum)
          if ( AxisNum .ge. mx ) 
     &      Data(frm-Start+1)= Data(frm-Start+1)*meter*10.0
        end do ! frm      
        error= .false.
c                                    
c     Correct gain on plate #2 my and mz channels.  On all data acquired before 
c     May 1989, this plate had its gains on this channels set to 1000 rather
c     than 4000.
c
        if ( FD(FileNum).OldGain .and. (CompNum .eq. 2) ) then
          do frm= 1, End-Start+1
            Data(frm)= 4.0*Data(frm)
          end do                                              
        end if                                    
      else if ( VarNum .eq. EMG_DATA ) then
        do frm= Start, End              
          if ( mod(frm,20) .eq. 0 ) write(6,105) CompNum,frm,
     &                                            FD(FileNum).EP.NumSamples
105       format('+Reading EMG Channel #',i2,' sample # ',i5,'/',i5)
          read(FD(FileNum).LU,rec=frm,iostat=ErrNum,err=1050) ChnlDATA.Ascii
          ChnlNum= FD(FileNum).EMGChnlNum(CompNum)
          Data(frm-Start+1)= (20.0/4096.0)*float(ChnlDATA.IntVal(ChnlNum))/
     &                                     FD(FileNum).ChnlGain(ChnlNum) - 10.0
        end do                         
        error= .false.
      end if
      return                                      

1050  write(6,1055) frm,FD(FileNum).Name,ErrNum                    
1055  format(' Error- Trouble reading at frame ',i5,' in file ',a40/
     &       '        Error # ',i3,' occured.')
      return
      end
c                                                                    
c   Copyright (c) 1990 by Dwight Meglan                                    
c                   
      subroutine ReadGls2FileParam( filename,FileNum,NewCS,error )
      implicit none      

      include 'tel_gls2.inc'
      include 'tel_cons.inc'
      include 'tel_strc.inc'
      include 'tel_file.inc'
      include 'tel_name.inc'
      include 'tel_plt.inc'
                            
      integer*4 FileNum
      character filename*40          
      logical*4 error,newCS
                  
      record /FileHeader/ FileHdr
      record /SyncHeader/ SyncHdr
      record /FrcHeader/  FrcHdr(4)
      record /EMGHeader/  EMGHdr(16)
                 
      real*4    kg
      integer*4 ErrNum,i,j,k,plt,axis,emg,FrcPtr,EMGPtr,LUN
      logical*4 ReadError

      data kg / 2.2241 / ! lbs/kg
c              
c     Open GLS2 file and read in file, force and EMG headers
c                                               
      error= .true.
      LUN= FD(FileNum).LU                                  
      open( unit=LUN,file=filename,access='DIRECT',status='OLD',
     &      iostat=ErrNum,err=1000 ) 
      call readGLS2Bytes( LUN,1,FileHdrLen,FileHdr,ReadError,ErrNum )
      if ( ReadError ) goto 1010                    
      if ( FileHdr.NumPlt .gt. MAX_PLT ) then
        write(6,100) FileHdr.NumPlt,MAX_PLT,MAX_PLT
100     format( ' File indicates ',i3,' force plates, but only ',i3,
     &          ' plates allowed.'/' Reading only the first ',i3,' plates...'/)
        FileHdr.NumPlt= MAX_PLT
      end if         
      if ( FileHdr.NumEMG .gt. MAX_EMG  ) then
        write(6,110) FileHdr.NumEMG,MAX_EMG,MAX_EMG
110     format( ' File indicates ',i3,' EMG channels, but only ',i3,
     &          ' channels allowed.'/
     &          ' Reading only the first ',i3,' channels...'/)
        FileHdr.NumEMG= MAX_EMG
      end if                                       
      do i= 1, FileHdr.NumPlt
        FrcPtr= FileHdr.FrcPtr + (i-1)*FrcHdrLen
        call readGLS2Bytes( LUN,FrcPtr,FrcHdrLen,FrcHdr(i),ReadError,ErrNum )
        if ( ReadError ) goto 1010
        if ( FrcHdr(i).Type .ne. 31 ) goto 1040 ! only processed files allowed
      end do             
      do i= 1, FileHdr.NumEMG
        EMGPtr= FileHdr.EMGPtr + (i-1)*EMGHdrLen
        call readGLS2Bytes( LUN,EMGPtr,EMGHdrLen,EMGHdr(i),Error,ErrNum )
        if ( Error ) goto 1010
      end do    
c
c     Assign Force Parameters
c
      if ( FileHdr.NumPlt .gt. 0 ) then
        FD(FileNum).FF.read= .true.
        FD(FileNum).GP.force_file= filename
        FD(FileNum).GP.comment= FileHdr.diag
        FD(FileNum).GP.name=    FileHdr.name
        FD(FileNum).GP.weight=  FileHdr.weight/kg
        FD(FileNum).GP.age=     FileHdr.age
        FD(FileNum).FP.num_frm= FrcHdr(1).NumSample
        FD(FileNum).FP.frm_rate= FrcHdr(1).SampleRate                   
        if ( FD(FileNum).rMtnFrmRate .gt. 0 ) then
          FD(FileNum).FP.av_frm_ratio= float(FD(FileNum).FP.frm_rate)/
     &                                 FD(FileNum).rMtnFrmRate
        else             
          FD(FileNum).FP.av_frm_ratio= 1.0
        end if
        FD(FileNum).FP.num_plt= FileHdr.NumPlt         
        do plt= 1, FileHdr.NumPlt
          do axis= fx, mz
            FD(FileNum).FrcConvFactor(axis,plt)= FrcHdr(plt).ConvFactor(axis)
            FD(FileNum).FrcDataPtr(axis,plt)= FrcHdr(plt).DataPtr(axis)
          end do                 
          do j= 1, 2
            FD(FileNum).FP.plt_size(j,plt)= PltSize(j,plt)
          end do                                
          do j= x, cntr
            do k= x, z
              FD(FileNum).FP.plt_loc(plt).LCS(k,j)= PltLoc(k,j,plt)
            end do           
          end do
        end do ! plt
c        if ( .not. newCS ) then    
c          do plt= 1, FileHdr.NumPlt  
c            FD(FileNum).FP.plt_loc(plt).LCS(z,cntr)= -0.483 !m
c          end do 
c        end if
      end if ! force plates are present
c       
c     Assign EMG Parameters
c                               
      if ( FileHdr.NumEMG .gt. 0 ) then     
        do emg= 1, FileHdr.NumEMG
          FD(FileNum).EP.Name(emg)= EMGHdr(emg).Name(1:20)
          FD(FileNum).EP.Surface(emg)= .true.
          if ( EMGHdr(emg).ElecType .eq. 1 ) FD(FileNum).EP.Surface(emg)= .false.
          FD(FileNum).EP.CodeNum(emg)= EMGHdr(emg).PhysChnl
          FD(FileNum).EmgDataPtr(emg)= EMGHdr(emg).DataPtr
        end do ! emg
        FD(FileNum).GP.force_file= filename
        FD(FileNum).GP.name=    FileHdr.name
        FD(FileNum).GP.weight=  FileHdr.weight/kg
        FD(FileNum).GP.age=     FileHdr.age    
        FD(FileNum).GP.comment= FileHdr.diag
        FD(FileNum).EP.NumChnl= FileHdr.NumEMG
        FD(FileNum).EP.NumSamples= EMGHdr(1).NumSample
        FD(FileNum).EP.SampleRate= EMGHdr(1).SampleRate
        FD(FileNum).EF.read= .true.
      end if ! emg's are present
      FD(FileNum).ExcessNumFrcFrm= .false.
      FD(FileNum).ExcessNumEmgFrm= .false.
      if ( FD(FileNum).FP.num_frm .gt. MAX_ELEC_FRM ) then ! this check is just a
        FD(FileNum).ExcessNumFrcFrm= .true.
        FD(FileNum).OrigNumFrcFrm= FD(FileNum).FP.num_frm
        FD(FileNum).FP.num_frm= MAX_ELEC_FRM               ! precaution...
        FD(FileNum).ExcessNumEmgFrm= .true.
        FD(FileNum).OrigNumEmgFrm= EMGHdr(1).NumSample
        FD(FileNum).EP.NumSamples= MAX_ELEC_FRM
        write(6,101) filename,MAX_ELEC_FRM,FD(FileNum).OrigNumFrcFrm
101     format(' Warning- Data from ',a40,' will be clipped at ',i5,' points'/
     &         '          Originally ',i5,' points in file')
      end if
      error= .false.
      return               

1000  write(6,1005) filename,ErrNum         
1005  format(' Error - Trouble opening ',a40/
     &       '         Error number ',i3,' occured.')
      return     
                 
1010  write(6,1015) filename,ErrNum
1015  format(' Error - Trouble reading the headers of ',a40/
     &       '         Error number ',i3,' occured.')
      close(unit=FD(FileNum).LU)
      return
                                            
1040  write(6,1045) 
1045  format( ' Error- The force plate data in the GLS2 file has not been'/
     &        '        processed by ANALYZE.  Only processed data may be',
     &                 ' read in')
      close(unit=FD(FileNum).LU)
      return
      end                         
c
c   Copyright (c) 1990 by Dwight Meglan                    
c                              
      subroutine ReadGls2Bytes( LUN,BeginPtr,DataLen,Data,Error,ErrNum )
      implicit none
         
      integer*4 BeginPtr,DataLen,ErrNum,LUN
      integer*1 Data(1)
      logical*4 Error

      integer*4 RecNum,RecPtr,DataPtr
      integer*1 Record(512)
                                         
      error= .true.                                                 
      ErrNum= 999    ! err # to indicate bad BeginPtr or DataLen
      If ( (BeginPtr .gt. 0) .and. (DataLen .gt. 0) ) then
        RecNum= (BeginPtr-1)/512 + 1     ! record # to be read
        RecPtr= (BeginPtr-1) - (RecNum-1)*512 + 1 ! first byte within record
        DataPtr= 1
        do while ( DataPtr .le. DataLen )
          read(LUN,rec=RecNum,err=1000,iostat=ErrNum) Record
          do while( (RecPtr .le. 512) .and. (DataPtr .le. DataLen) )
            Data(DataPtr)= Record(RecPtr)
            RecPtr=  RecPtr + 1
            DataPtr= DataPtr + 1
          end do
          RecPtr= 1                      
          RecNum= RecNum + 1
        end do
        error= .false.
        ErrNum= 0
      end if
1000  return               
      end
c
c   Copyright (c) 1990 by Dwight Meglan
c
      subroutine ReadGls2FileData( FileNum,VarNum,CompNum,AxisNum,Start,End,
     &                             Data,error )
      implicit none
  
      include 'tel_cons.inc'     
      include 'tel_strc.inc'
      include 'tel_file.inc'           
      include 'tel_name.inc'
                                  
      integer*4 FileNum,VarNum,CompNum,AxisNum,Start,End
      real*4    Data(1)                     
      logical*4 error                                  

      integer*4 ErrNum,frm,FrcDataLen,EmgDataLen,LUN
      integer*2 TempData(MAX_ELEC_FRM)
      logical*4 ReadError
               
      error= .true.
      LUN= FD(FileNum).LU
      if ( VarNum .eq. FPL_DATA ) then
        if ( FD(fileNum).ExcessNumFrcFrm ) then
          FrcDataLen= FD(FileNum).OrigNumFrcFrm*2
        else
          FrcDataLen= FD(FileNum).FP.num_frm*2   
        end if
        write(6,130) CompNum,FrcNames(AxisNum)      
130     format('+Reading force plate # ',i1,1x,a3)
        call ReadGLS2Bytes( LUN,FD(FileNum).FrcDataPtr(AxisNum,CompNum),
     &                      FrcDataLen,TempData,ReadError,ErrNum )
        if ( ReadError ) goto 1020
        do frm= Start, End
          Data(frm-Start+1)= FD(FileNum).FrcConvFactor(AxisNum,CompNum)*
     &                       float(TempData(frm))
        end do ! frm
        error= .false.
      else if ( VarNum .eq. EMG_DATA ) then
        write(6,150) CompNum
150     format('+Reading EMG channel # ',i2)
        if ( FD(FileNum).ExcessNumEmgFrm ) then
          EMGDataLen= FD(FileNum).OrigNumEmgFrm*2
        else
          EMGDataLen= FD(FileNum).EP.NumSamples*2     
        end if
        call ReadGLS2Bytes( LUN,FD(FileNum).EmgDataPtr(CompNum),EMGDataLen,
     &                      TempData,ReadError,ErrNum )
        if ( ReadError ) goto 1030
        do frm= Start, End
          Data(frm-Start+1)= (20.0/4096.0)*float(TempData(frm))
        end do ! frm
        error= .false.
      end if
      return

1020  write(6,1025) FD(FileNum).Name,ErrNum
1025  format(' Error- Trouble reading the force plate data from ',a40/
     &       '        Error number ',i3,' occured.')
      return                      
      
1030  write(6,1035) FD(FileNum).Name,ErrNum
1035  format(' Error - Trouble reading the EMG data from ',a40/
     &       '         Error number ',i3,' occured.')                 
      return                   
      end
