c
c     Copyright by Dwight Meglan (1992)
c
c     Purpose: Read Motion Analysis Corporation Expertvision P3D marker 
c              trajectory files
c
      subroutine read_p3d_file( filename,AnalysisType,Diagnose,MakeMtn60Hz,
     &                          IgnoreExMrk,CKCNoMedAkl,P3dCm,
     &                          MF,OF,data_read )
      implicit none
      include 'a_const.inc'

      include 'a_struct.inc'
      include 'a_prm.inc'
      include 'a_mrk.inc'
      include 'a_names.inc'
                                                               
      record /marker_flag/  MF
      record /option_flag/  OF

      integer*4 AnalysisType
      character filename*60
      logical*4 data_read,Diagnose,MakeMtn60Hz,IgnoreExMrk,CKCNoMedAkl,
     &          P3dCm
                                                               
      real*4    mrkfrm1time(MAX_MRK),temptime,mrkfrmetime(MAX_MRK),frmrate
      integer*4 errnum,numfrm,nummrk,mn,nchar,i,j,k,chn,frm,
     &          mrkfrm1(MAX_MRK),prevfrm,nfrmskip,nowfrm,skipfrm,frm1,frme,
     &          mrkfrme(MAX_MRK),mrknfrm(MAX_MRK),nmfrm1fix,nmfrmefix,frmadd,
     &          mfrm1fix(MAX_MRK),mfrmefix(MAX_MRK),anl_nm,
     &          ch1,dm_num,dm_nch(MAX_MRK),p3d_anl(MAX_MRK),anl_p3d(MAX_MRK)
      logical*4 SkipToNext,MrkOK(MAX_MRK),KnownMrkSet,error
      character textline*80,p3d_name(MAX_MRK)*20,blank60*60,anl_name(MAX_MRK)*4,
     &          dm_name(MAX_MRK)*20
                                                         
      record /CmndLine/ cmnd
c
c     Do some initialization
c
      do i= 1, 60
        blank60(i:i)= ' '                                             
      end do
      do i= 1, MAX_MRK
        MrkOK(i)= .false.
        mrkfrm1(i)= 0
        mrkfrme(i)= 0
        mrknfrm(i)= 0
        p3d_name(i)= blank60(1:20)
      end do
c             
c     Set up marker set definitions, if any
c
      if ( CKCNoMedAkl ) AnalysisType= CKC_NMA_ANL
      call SetUpMrkDef( AnalysisType,dm_name,dm_num,dm_nch,p3d_anl,anl_p3d,
     &                  anl_name,anl_nm,KnownMrkSet )                       
      if ( CKCNoMedAkl ) AnalysisType= CKC_ANL
c
c     Open the file                                      
c
      data_read= .false.                                   
      open(unit=1,file=filename,status='old',iostat=errnum,err=1000)
c
c     read file until error or end of file
c
      read(1,120,iostat=errnum,err=1010) textline
120   format(a80)                               
      numfrm= 0
      nummrk= 0
      if ( OF.UpDate ) write (6,200)
200   format(/)             
      do while ( errnum .eq. 0 )
c                                       
c       skip to line starting with Object
c                 
        call ParseLine( textline,cmnd )                            
        do while ( cmnd.cmndtext(1) .ne. 'OBJ' )
          read(1,120,iostat=errnum,err=900) textline
          call ParseLine( textline,cmnd )
        end do
c
c       starting to read in another marker
c 
        nummrk= nummrk + 1
        if ( nummrk .gt. MAX_MRK ) then
          write(6,300) MAX_MRK
          if ( OF.ToLog ) write(3,300) MAX_MRK
300       format(' WARNING- The number of markers in the file exceeds the maximum that'/
     &           '          allowed (',i2,') for this program version. Marker data has'/
     &           '          been truncated'/)
          nummrk= MAX_MRK
          goto 910
        end if                        
c
c       Identify marker name & corresponding number if data being read
c       belongs to a known marker set
c                    
        if ( KnownMrkSet ) then
          call FindP3dMrkName( cmnd,dm_name,dm_num,dm_nch,p3d_anl,mn,error )
          if ( error ) then
            ch1= cmnd.cmndstart(4)
            write(6,410) CMND.Text(1)(ch1:ch1+9)
            if ( OF.ToLog ) write(3,410) CMND.Text(1)(ch1:ch1+9)
410         format(/' NOTE- Marker named ',a10,' not recognized'/
     &              '       Marker data will be skipped')
            read(1,120,iostat=errnum,err=900) textline
            nummrk= nummrk - 1
            SkipToNext= .true.
          else
            SkipToNext= .false.
            MrkOK(mn)= .true.
          end if
        else
          mn= nummrk
          p3d_anl(mn)= mn
          SkipToNext= .false.
          MrkOK(mn)= .true.
        end if
c
c       Initialize marker data set for reading
c                                       
c        nchar= cmnd.cmndend(4) - cmnd.cmndstart(4) + 1
        if ( .not. SkiptoNext ) then
          nchar= cmnd.cmndend(cmnd.numcmnd) - cmnd.cmndstart(4) + 1
          if ( nchar .gt. 20 ) nchar= 20
          do i= 1, nchar
            chn= cmnd.cmndstart(4)+i-1
            p3d_name(mn)(i:i)= cmnd.text(1)(chn:chn)
          end do                      
          read(1,120,iostat=errnum,err=900) textline
          call ParseLine( textline,cmnd )

          if ( mrkfrm1(mn) .ne. 0 ) then ! partial marker already read in...
            prevfrm= mrkfrme(mn)
            frm= mrknfrm(mn)
            nummrk= nummrk - 1
          else ! new marker
            mrkfrm1(mn)= cmnd.cmndintval(2)                       
            mrkfrm1time(mn)= cmnd.cmndrealval(3)
            prevfrm= mrkfrm1(mn) - 1
            frm= 0
          end if                         
        end if
        nfrmskip= 0
c                                          
c       Now read in all frames for this marker or part of marker
c                             
        do while ( (cmnd.numcmnd .eq. 6) .and. cmnd.cmndnumOK(1) )
          if ( .not. SkipToNext ) then
            if ( OF.UpDate .and. (mod(frm,10) .eq. 0) ) 
     &        write(6,210) mn,nummrk,p3d_name(mn),anl_name(mn),cmnd.cmndintval(2)
210         format('+Reading marker # ',i2,'/',i2,' : ',a20,'/',a4,'  frame # ',i3)
            nowfrm= cmnd.cmndintval(2)
            if ( nowfrm .ne. prevfrm+1 ) then ! some frames skipped...
              skipfrm= nowfrm - prevfrm - 1             
              do i= frm+1, frm+skipfrm
                do j= 1, 3                
                  MrkData(j,i,mn)= 0.0
                end do                            
              end do
              frm= frm + skipfrm             
              nfrmskip= nfrmskip + skipfrm
            end if 
            if ( frm .ge. MAX_MTN ) then
              write(6,310) MAX_MTN
              if ( OF.ToLog ) write(3,310) MAX_MTN
310           format(' WARNING- This file contains too many frames of marker data'/
     &               '          The number of frames is being truncated to ',i3)
              SkipToNext= .true.
            else
              frm= frm + 1
              if ( P3dCm ) then
                MrkData(x,frm,mn)= cmnd.cmndrealval(4)/100.0
                MrkData(y,frm,mn)= cmnd.cmndrealval(5)/100.0
                MrkData(z,frm,mn)= cmnd.cmndrealval(6)/100.0
              else
                MrkData(x,frm,mn)= cmnd.cmndrealval(4)
                MrkData(y,frm,mn)= cmnd.cmndrealval(5)
                MrkData(z,frm,mn)= cmnd.cmndrealval(6)
              end if
              prevfrm= nowfrm
              temptime= cmnd.cmndrealval(3)
            end if ! not exceed max number of frames
          end if ! Skip remaining frames of marker...
          read(1,120,iostat=errnum,err=900) textline
          call ParseLine( textline,cmnd )
        end do
c
c       done with this marker
c
        if ( .not. SkiptoNext ) then
          if ( nfrmskip .ne. 0 ) then
            write(6,250) nfrmskip
            if ( OF.ToLog ) write(3,250) nfrmskip
250         format('  Note- A total of ',i3,' frames skipped in this marker'/)
          else
            if ( OF.UpDate ) write(6,215) blank60
215         format('+',a60)
          end if
          mrkfrme(mn)= nowfrm 
          mrkfrmetime(mn)= temptime
          mrknfrm(mn)= frm 
        end if
      end do                      
c                                 
c     All done reading file, now check begin & end frame numbers of all
c     markers and resolve if they are different                               
c             
900   if ( .not. SkiptoNext ) then
        mrkfrme(mn)= nowfrm
        mrkfrmetime(mn)= temptime
        mrknfrm(mn)= frm     
      end if
910   close(unit=1)

      if ( KnownMrkSet .and. ( nummrk .gt. dm_num ) ) then
        write(6,730) nummrk,dm_num,ANLNames(GP.analysis_type),dm_num
        if ( OF.ToLog ) 
     &    write(3,730) nummrk,dm_num,ANLNames(GP.analysis_type),dm_num
730     format(' NOTE- Something has gone wrong in reading the file'/
     &         '       ',i2,' markers have been read in but only ',i2,'markers'/
     &         '       are required for the ',a20,' marker set. Markers are being'/
     &         '       truncated at ',i2)
        nummrk= dm_num
      end if

      i= 1  
      do while ( (.not. MrkOK(p3d_anl(i))) .and. (i .le. nummrk) )
        i= i + 1
      end do        
      mn= p3d_anl(i)
      frm1= mrkfrm1(mn)
      frme= mrkfrme(mn)
      if ( MakeMtn60Hz ) then
        frmrate= 60
      else
        frmrate= float(frme-frm1)/(mrkfrmetime(mn)-mrkfrm1time(mn))
      end if

      do j= i+1, nummrk 
        mn= p3d_anl(j)
        if ( MrkOK(mn) ) then
          if ( mrkfrm1(mn) .lt. frm1 ) frm1= mrkfrm1(mn)
          if ( mrkfrme(mn) .gt. frme ) frme= mrkfrme(mn)
        end if
      end do
                      
      nmfrm1fix= 0       
      nmfrmefix= 0
      do i= 1, nummrk
        mn= p3d_anl(i)
        if ( MrkOK(mn) ) then
          if ( mrkfrm1(mn) .ne. frm1 ) then
            nmfrm1fix= nmfrm1fix + 1
            mfrm1fix(nmfrm1fix)= mn
          end if
          if ( mrkfrme(mn) .ne. frme ) then
            nmfrmefix= nmfrmefix + 1           
            mfrmefix(nmfrmefix)= mn
          end if
        end if
      end do         

      do i= 1, nmfrm1fix    
        mn= mfrm1fix(i)
        frmadd= mrkfrm1(mn) - frm1
        write(6,330) p3d_name(mn),frmadd
        if ( OF.ToLog ) write(3,330) p3d_name(mn),frmadd
330     format(1x,a20,' has ',i3,' missing frames at the start')
        do j= mrknfrm(mn),1,-1
          do k= 1, 3
            MrkData(k,j+frmadd,mn)= MrkData(k,j,mn)
          end do
        end do
        do j= 1, frmadd
          do k= 1, 3
            MrkData(k,j,mn)= 0.0
          end do
        end do
        mrknfrm(mn)= mrknfrm(mn) + frmadd
      end do  

      do i= 1, nmfrmefix    
        mn= mfrmefix(i)                              
        frmadd= frme - mrkfrme(mn)
        write(6,340) p3d_name(mn),frmadd
        if ( OF.ToLog ) write(3,340) p3d_name(mn),frmadd
340     format(1x,a20,' has ',i3,' missing frames at the end')
        do j= mrknfrm(mn), mrknfrm(mn)+frmadd
          do k= 1, 3
            MrkData(k,j,mn)= 0.0
          end do
        end do
        mrknfrm(mn)= mrknfrm(mn) + frmadd
      end do  
      numfrm= frme - frm1 + 1
c
c     Assign results of read to MRK_PRM structure                         
c
      MF.read= .true.                      
      data_read= .true.
      GP.MtnFile= filename(1:40)
      MP.nfrm= numfrm
      MP.num_mrk= anl_nm
      MP.frm_rate= frmrate
      rMtnFrmRate= MP.frm_rate
      MP.cycle_first_frm(1)= frm1
      MP.cycle_last_frm(1)= frme
      MP.first_frm= frm1
c
c     If analysis type is known then check for blank markers and if any
c     are found then place a sine wave in them so that later filtering
c     procedures (GCVSPL) don't blow up...
c                            
      if ( KnownMrkSet ) then
        do i= 1, dm_num
          mn= p3d_anl(i)
          if ( .not. MrkOK(mn) ) then
            write(6,500) dm_name(i)
500         format(' WARNING- Marker named ',a20,' is blank')
            do frm= 1, numfrm
              do j= 1, 3   
                MrkData(j,frm,mn)= 0.01*sin(2.0*3.14157*frm/numfrm)
              end do
            end do
          end if
        end do
        do i= 1, anl_nm
          MP.mrk_name(i)= anl_name(i)
        end do
      else
        do i= 1, nummrk
          MP.mrk_name(i)= p3d_name(i)(1:4)
        end do
      end if                              
c
c     Dump info about file read if Diagnose flag is set
c
      if ( Diagnose ) then
        write(6,390) nummrk,frmrate,frm1,frme,numfrm
        if ( OF.ToLog ) write(3,390) nummrk,frmrate,frm1,frme,numfrm
390     format(//' MAC P3D File Read Summary'/
     &       '   Number of markers: ',i2/
     &       '   Frame rate       : ',f8.4/
     &       '   First frame #    : ',i4/
     &       '   Last frame #     : ',i4/
     &       '   Number of frames : ',i4//
     &       '  Marker #     # Frame     Marker Name'//)
        do i= 1, nummrk
          mn= p3d_anl(i)
          if ( OF.ToLog ) write(3,400) mn,mrknfrm(mn),p3d_name(mn)
          write(6,400) mn,mrknfrm(mn),p3d_name(mn)
400       format(4x,i3,5x,i4,5x,a20)
        end do         
      end if
      return
      
1000  write(6,1005) filename,errnum    
      if ( OF.ToLog ) write(3,1005) filename,errnum
1005  format(' Error- Trouble opening ',a60/
     &       '        Error number ',i3,' occurred.')
      return                            

1010  write(6,1015) errnum,filename
      if ( OF.ToLog ) write(3,1015) errnum,filename
1015  format(' Error- Error number ',i3,' occurred while reading ',a60)
      close (unit=1)
      return
      end
c
c     
c
      subroutine SetUpMrkDef( AnalysisType,dm_name,dm_num,dm_nch,p3d_anl,
     &                        anl_p3d,anl_name,anl_nmrk,KnownMrkSet )
      implicit none             

      include 'a_const.inc'
      include 'a_names.inc'
      include 'a_rdmac.inc'
  
      integer*4 AnalysisType,dm_num,dm_nch(MAX_MRK),p3d_anl(MAX_MRK),
     &          anl_nmrk,anl_p3d(MAX_MRK)
      logical*4 KnownMrkSet
      character dm_name(MAX_MRK)*20,anl_name(MAX_MRK)*4
                           
      integer*4 i,j

      KnownMrkSet= .true.                                                
      do i= 1, MAX_MRK
        do j= 1, 20
          dm_name(i)(j:j)= ' '               
        end do
      end do      
  
      if ( AnalysisType .eq. HH_ANL ) then
        dm_num= 21
        do i= 1, dm_num
          dm_nch(i)= hh_nch(i)
          p3d_anl(i)= hh_tru(i)
          do j= 1, dm_nch(i)
            dm_name(i)(j:j)= hh_names(i)(j:j)
          end do
        end do
        anl_nmrk= 25       
        do i= 1, anl_nmrk
          do j= 1, 4
            anl_name(i)(j:j)= hh_names_new(i)(j:j)
          end do                 
        end do

      else if ( AnalysisType .eq. CKC_ANL ) then
        dm_num= 17
        do i= 1, dm_num
          dm_nch(i)= ckc_nch(i)
          p3d_anl(i)= i
          do j= 1, dm_nch(i)
            dm_name(i)(j:j)= ckc_names(i)(j:j)
          end do
        end do
        anl_nmrk= 20
        do i= 1, anl_nmrk
          do j= 1, 4
            anl_name(i)(j:j)= ckc_names_new(i)(j:j)
          end do    
        end do  

      else if ( AnalysisType .eq. CKC_NMA_ANL ) then
        dm_num= 16
        do i= 1, dm_num
          dm_nch(i)= ckc_nch(i)
          p3d_anl(i)= i
          do j= 1, dm_nch(i)
            dm_name(i)(j:j)= ckc_nma_names(i)(j:j)
          end do
        end do
        anl_nmrk= 19
        do i= 1, anl_nmrk
          do j= 1, 4
            anl_name(i)(j:j)= ckc_nma_names_new(i)(j:j)
          end do    
        end do    
                            
      else if ( AnalysisType .eq. CC_ANL ) then
        dm_num= 27
        do i= 1, dm_num
          dm_nch(i)= cc_nch(i)
          p3d_anl(i)= i
          do j= 1, dm_nch(i)
            dm_name(i)(j:j)= cc_names(i)(j:j)
          end do
        end do
        anl_nmrk= 33
        do i= 1, anl_nmrk
          do j= 1, 4
            anl_name(i)(j:j)= cc_names_new(i)(j:j)
          end do    
        end do    

      else if ( AnalysisType .eq. CCR_ANL ) then
        dm_num= 17
        do i= 1, dm_num
          dm_nch(i)= ccr_nch(i)
          p3d_anl(i)= i
          do j= 1, dm_nch(i)
            dm_name(i)(j:j)= ccr_names(i)(j:j)
          end do
        end do
        anl_nmrk= 17
        do i= 1, anl_nmrk
          do j= 1, 4
            anl_name(i)(j:j)= ccr_names_new(i)(j:j)
          end do    
        end do

      else if ( AnalysisType .eq. CCL_ANL ) then
        dm_num= 17
        do i= 1, dm_num
          dm_nch(i)= ccl_nch(i)
          p3d_anl(i)= i
          do j= 1, dm_nch(i)
            dm_name(i)(j:j)= ccl_names(i)(j:j)
          end do
        end do
        anl_nmrk= 17
        do i= 1, anl_nmrk
          do j= 1, 4            
            anl_name(i)(j:j)= ccl_names_new(i)(j:j)
          end do    
        end do

      else if ( AnalysisType .eq. MAYO_ANL ) then
        dm_num= 27
        do i= 1, dm_num
          dm_nch(i)= mayo_nch(i)
          p3d_anl(i)= i
          do j= 1, dm_nch(i)
            dm_name(i)(j:j)= mayo_names(i)(j:j)
          end do
        end do
        anl_nmrk= 33
        do i= 1, anl_nmrk
          do j= 1, 4
            anl_name(i)(j:j)= mayo_names_new(i)(j:j)
          end do    
        end do    

      else if ( AnalysisType .eq. MIR_ANL ) then
        dm_num= 19
        do i= 1, dm_num
          dm_nch(i)= mir_nch(i)
          p3d_anl(i)= i
          do j= 1, dm_nch(i)
            dm_name(i)(j:j)= mir_names(i)(j:j)
          end do
        end do
        anl_nmrk= 19
        do i= 1, anl_nmrk
          do j= 1, 4
            anl_name(i)(j:j)= mir_names_new(i)(j:j)
          end do    
        end do

      else if ( AnalysisType .eq. MIL_ANL ) then
        dm_num= 19
        do i= 1, dm_num
          dm_nch(i)= mil_nch(i)
          p3d_anl(i)= i
          do j= 1, dm_nch(i)
            dm_name(i)(j:j)= mil_names(i)(j:j)
          end do
        end do
        anl_nmrk= 19
        do i= 1, anl_nmrk
          do j= 1, 4            
            anl_name(i)(j:j)= mil_names_new(i)(j:j)
          end do    
        end do

      else if ( (AnalysisType .eq. F3DR_ANL) .or. 
     &          (AnalysisType .eq. F3DL_ANL)      ) then
        dm_num= 15
        do i= 1, dm_num
          dm_nch(i)= f3d_nch(i)
          p3d_anl(i)= i
          do j= 1, dm_nch(i)
            dm_name(i)(j:j)= f3d_names(i)(j:j)
          end do       
        end do
        anl_nmrk= 15
        do i= 1, anl_nmrk
          do j= 1, 4
            anl_name(i)(j:j)= f3d_names_new(i)(j:j)
          end do    
        end do         

      else
        KnownMrkSet= .false.
      end if
      return
      end           
c
c
c
      subroutine FindP3dMrkName( cmnd,mname,nmrk,nch,p3d_anl,mn,error )
      implicit none

      include 'a_const.inc'
      include 'a_struct.inc'

      record /CmndLine/ cmnd

      integer*4 nch(MAX_MRK),p3d_anl(MAX_MRK),mn,nmrk
      logical*4 error
      character mname(MAX_MRK)*20

      integer*4 ch1,i

      ch1= cmnd.cmndstart(4)
      mn= 0
      error= .true.
      do i= 1, nmrk
        if ( mname(i)(1:nch(i)) .eq. cmnd.text(1)(ch1:ch1+nch(i)-1) ) mn= i
      end do
      if ( mn .ne. 0 ) error= .false.
      if ( .not. error ) mn= p3d_anl(mn)
      return
      end
c                              
c                            
c                  
      subroutine read_ads_file( filename,AnalysisType,Calibrate,Diagnose,
     &                          NumPlt,PltType,EMGOnly,OldMayoLCS,
     &                          ManZeroK,ZeroK,AutoZeroK,AutoZeroPct,
     &                          SkipFrm,AutoZeroB,ZeroChnlRegion,
     &                          FF,EF,OF,data_read )
      implicit none
      include 'a_const.inc'

      include 'a_struct.inc'
      include 'a_prm.inc'
      include 'a_gls2.inc'                
      include 'a_frc.inc'                                          
      include 'a_emg.inc'
      include 'a_names.inc'
                                                               
      record /marker_flag/  FF
      record /emg_flag/     EF
      record /option_flag/  OF

      real*4    ZeroK(8),AutoZeroPct
      integer*4 AnalysisType,SkipFrm,NumPlt
      character filename*60,PltType(4)*3
      logical*4 data_read,Diagnose,Calibrate,OldMayoLCS,EMGOnly,
     &          ManZeroK,AutoZeroK,AutoZeroB,ZeroChnlRegion
                                                                            
      integer*4 MAX_CHNL

      parameter ( MAX_CHNL = 32 )

      integer*4 errnum,numfrm,numchnl,chnlnum(MAX_CHNL),i,j,k,trialnum,smplfreq,
     &          smplint,ZERO,chnl,frm,chnlgain(MAX_CHNL),chn,ONE,chbegin,chend,
     &          skipchnl,NumFpChnl,NumEMGChnl,FpChnl1(4),plt
      real*4    smpltime,chdata(MAX_ELC,MAX_CHNL),BertecLCSEarly(3,4),BertecCalMat(6,6),
     &          KistlerLCSearly(3,4),BertecGain,BertecLCS_CKC(3,4),F3DLCS(3,4),
     &          frmdata(8),KistlerLCSNew(3,4),BertecLCS(3,4),KistlerLCSOld(3,4),
     &          okx,oky,okz,nkx,nky,nkz,ZeroB(6)
      character textline*80,intfilename*20,chnlname(MAX_CHNL)*20,FpType(3)*3

      record /CmndLine/ cmnd

      data FpType /'BER','KOL','KNE' / ! Bertec, KistlerOld, KistlerNew

      data BertecGain /10.0/

      data BertecLCSEarly  /  0.0, 1.0, 0.0, 
     &                        1.0, 0.0, 0.0,
     &                        0.0, 0.0,-1.0, 
     &                        0.3,-0.2,-0.025 /
                                                
      data BertecLCS  /  0.0,-1.0, 0.0, 
     &                  -1.0, 0.0, 0.0,
     &                   0.0, 0.0,-1.0, 
     &                   0.3,-0.2,-0.025 /


      data BertecLCS_CKC  /  0.0, 1.0, 0.0, 
     &                       1.0, 0.0, 0.0,
     &                       0.0, 0.0,-1.0, 
     &                      -0.3,-0.2, 0.006 /
                                                                       
      data F3DLCS  /  0.0,-1.0, 0.0,           ! Kistler- New or Old
     &               -1.0, 0.0, 0.0,
     &                0.0, 0.0,-1.0,           
     &                0.0, 0.0,-0.054 /

      data BertecCalMat / 1465.0,  -15.0,    0.0,    0.0,   44.0,    2.0,
     &                       4.0, 1483.0,  -11.0,  -50.0,    0.0,   -7.0,
     &                       2.0,   21.0, 2929.0,   -3.0,   -2.0,   -1.0,
     &                      11.0,  -24.0,   19.0,  756.0,    0.0,    0.0,
     &                       9.0,    5.0,   11.0,   -3.0,  529.0,    3.0,
     &                       9.0,    7.0,   -2.0,    6.0,    1.0,  340.0 /

      data okx,oky,okz / 100.0,100.0,500.0 / ! N/V
      data nkx,nky,nkz / 62.5,62.5,263.16 /  ! N/V

      data KistlerLCSEarly / 0.0,-1.0, 0.0, 
     &                      -1.0, 0.0, 0.0, 
     &                       0.0, 0.0,-1.0, 
     &                       0.0, 0.2,-0.054 /

      data KistlerLCSNew / 0.0,-1.0, 0.0, 
     &                    -1.0, 0.0, 0.0, 
     &                     0.0, 0.0,-1.0, 
     &                     0.0, 0.2,-0.054 /

      data KistlerLCSOld / 0.0,-1.0, 0.0, 
     &                    -1.0, 0.0, 0.0, 
     &                     0.0, 0.0,-1.0, 
     &                    -0.3,-0.2,-0.054 /

c
c     Open the file
c
      data_read= .false.
      open(unit=1,file=filename,status='OLD',iostat=errnum,err=1000)
c                                       
c     read first line descriptive info
c
      read(1,120,iostat=errnum,err=1010) textline
120   format(a80)  
      call cleanline( textline )
      call ParseLine( textline,cmnd )
      j= 1
      do i= cmnd.cmndstart(1)+1, cmnd.cmndend(1)
        intfilename(j:j)= textline(i:i)      
        j= j + 1
      end do                         
      trialnum= cmnd.cmndintval(2)
      smpltime= cmnd.cmndrealval(3)
      smplint=  cmnd.cmndintval(5)
      if (smplint .eq. 0) smplint= 1
      smplfreq= cmnd.cmndintval(4)/smplint
      numchnl=  cmnd.cmndintval(6)
      numfrm=   smpltime*smplfreq
      skipchnl= 0
      if ( numchnl .gt. MAX_CHNL ) then
        write(6,500) numchnl,MAX_CHNL,MAX_CHNL
        if ( OF.ToLog ) write(3,500) numchnl,MAX_CHNL,MAX_CHNL
500     format(/' WARNING- The number of channels of electrical data in this file'/
     &          '          (',i5,') exceeds the maximum allowed of ',i2,'. Only the'/
     &          '          first ',i2,' channels will be read in from the file.'/)
        skipchnl= numchnl - MAX_CHNL
        numchnl= MAX_CHNL
      end if
      if ( numfrm .gt. MAX_ELC ) then
        write(6,510) numfrm,MAX_ELC,MAX_ELC
        if ( OF.ToLog ) write(3,510) numfrm,MAX_ELC,MAX_ELC
510     format(/' WARNING- The number of frames of electrical data in this file'/
     &          '          (',i5,') exceeds the maximum allowed of ',i5,'. Only the'/
     &          '          first ',i5,' frames will be read in from the file.'/)
        numfrm= MAX_ELC
      end if
c
c     set up the proper force plate descriptive info
c
      if ( .not. EMGOnly ) then
        NumFpChnl= 0
        do plt= 1, NumPlt
          if ( PltType(plt) .eq. 'BER' ) then
            FpChnl1(plt)= NumFpChnl + 1
            NumFpChnl= NumFpChnl + 6
          else if ( PltType(plt) .eq. 'KOL' ) then
            FpChnl1(plt)= NumFpChnl + 1 
            NumFpChnl= NumFpChnl + 8
          else if ( PltType(plt) .eq. 'KNE' ) then
            FpChnl1(plt)= NumFpChnl + 1 
            NumFpChnl= NumFpChnl + 8
          else
            goto 3020 ! error
          end if
        end do
        if ( NumFpChnl .gt. numchnl ) goto 3000 ! error
        FP.num_plt= NumPlt
        do plt= 1, NumPlt              
          FP.plt_size(1,plt)= 0.4 ! m
          FP.plt_size(2,plt)= 0.6 ! m
          if ( AnalysisType .eq. CKC_ANL ) then
            do i= x, cntr
               do j= x, z
                FP.plt_loc(plt).LCS(j,i)= BertecLCS_CKC(j,i)
              end do
            end do                                      

          else if ( (AnalysisType .eq. F3DR_ANL) .or.
     &              (AnalysisType .eq. F3DL_ANL)      ) then
            do i= x, cntr
               do j= x, z
                FP.plt_loc(plt).LCS(j,i)= F3DLCS(j,i)
              end do
            end do                                      

          else if ( OldMayoLCS ) then
            if ( PltType(plt) .eq. 'KOL' ) then
              do i= x, cntr
                 do j= x, z
                  FP.plt_loc(plt).LCS(j,i)= KistlerLCSEarly(j,i)
                end do
              end do                                      
            else if ( PltType(plt) .eq. 'BER' ) then
              do i= x, cntr
                 do j= x, z
                  FP.plt_loc(plt).LCS(j,i)= BertecLCSEarly(j,i)
                end do                     
              end do                                      
            else
              goto 3010 ! error- new kistler wasn't installed
            end if

          else
            if ( PltType(plt) .eq. 'KOL' ) then
              do i= x, cntr
                 do j= x, z
                  FP.plt_loc(plt).LCS(j,i)= KistlerLCSOld(j,i)
                end do
              end do                                      
            else if ( PltType(plt) .eq. 'KNE' ) then
              do i= x, cntr
                 do j= x, z
                  FP.plt_loc(plt).LCS(j,i)= KistlerLCSNew(j,i)
                end do
              end do                                      
            else if ( PltType(plt) .eq. 'BER' ) then
              do i= x, cntr
                 do j= x, z
                  FP.plt_loc(plt).LCS(j,i)= BertecLCS(j,i)
                end do
              end do                                      
            end if
          end if
        end do
        NumEMGChnl= numchnl - NumFpChnl
        write(6,554) NumEMGChnl
554     format(' NOTE- Assuming ',i2,' emg signals in data file')
      else
        FP.num_plt= 0
        NumPlt= 0
        NumEMGChnl= numchnl
        NumFpChnl= 0
        write(6,454)
454     format(' NOTE- Assuming only emg signals in data file')
      end if                                                
c
c     read info describing each channel
c             
      ZERO= ichar('0')                                       
      ONE=  ichar('1')
      do chnl= 1, numchnl
        read(1,120,iostat=errnum,err=1010) textline
        call cleanline( textline )      
        chnlnum(chnl)= (ichar(textline(2:2)) - ONE)*MAX_CHNL +
     &                  ichar(textline(3:3)) - ZERO
        call ParseLine( textline,cmnd )
        chnlgain(chnl)= cmnd.cmndintval(2)
	if ( chnlgain(chnl) .le. 0 ) goto 3030
        j= 1
        chbegin= cmnd.cmndstart(3)
        chend= cmnd.cmndend(cmnd.numcmnd)
        if ( chend - chbegin + 1 .gt. 20 ) chend= chbegin + 19
        do i= chbegin, chend
          chnlname(chnl)(j:j)= textline(i:i)
          j= j + 1
        end do
      end do
      if ( skipchnl .gt. 0 ) then
        do i= 1, skipchnl
          read(1,120,iostat=errnum,err=1010) textline
        end do
      end if
c                             
c     Now read in the coded values of the channel voltages, frame by frame
c     
      do frm= 1, numfrm
        if ( mod(frm,10) .eq. 0 ) write(6,150) frm,numfrm
150     format('+Reading frame # ',i5,'/',i5)
        read(1,120,iostat=errnum,err=1010) textline
        call cleanline( textline )
        chn= 1
        do chnl= 1, numchnl
          chdata(frm,chnl)= (ichar(textline(chn:chn)) - ZERO)*64 +
     &                       ichar(textline(chn+1:chn+1)) - ZERO
          chn= chn + 2 
        end do
      end do
      close(unit=1)
c
c    Done reading data now convert it to voltages rather than a/d counts
c
      do frm= 1, numfrm
        do chnl= 1, numchnl               
          chdata(frm,chnl)= 20.0*(chdata(frm,chnl) - 2048)/
     &                      (4096*chnlgain(chnl))
        end do
      end do    
c
c     Now that read is done, assign force and emg info to structures and
c     assign data to force plates and emgs according to AnalysisType
c                                                                        
      FP.nfrm= numfrm
      FP.frm_rate= smplfreq
      FP.first_frm= 1
      if ( rMtnFrmRate .gt. 0.0 ) then
        FP.av_frm_ratio= smplfreq/rMtnFrmRate
      else
        FP.av_frm_ratio= 1.0
      end if
      GP.FrcFile= filename(1:40)
      data_read= .true.
      FF.read= .true.           
      EF.read= .false.
      if ( ZeroChnlRegion ) then
         do i= 1, numchnl	
            call ZeroSignal(chdata(1,chnl),numfrm)
         end do
      end if

      do plt= 1, NumPlt
        if ( PltType(plt) .eq. 'BER' ) then
          do i= 1, 6
            ZeroB(i)= 0.0
          end do
          if ( AutoZeroB ) then
c            call ZeroChnlSum( chdata,MAX_ELC,FP.nfrm,
c     &                        FpChnl1(plt),FpChnl1(plt)+5,AutoZeroPct,ZeroB )
            do i= 1, 8
              call ZeroChnl( chdata(1,FpChnl1(plt)+i-1),FP.nfrm,SkipFrm,
     &                       AutoZeroPct,ZeroB(i) )
            end do
          end if
          if ( Calibrate ) then
            write(6,550) plt
550         format(/' Converting Plate # ',i1,' as Bertec force plate data...')
            do i= 1, numfrm 
              do j= 1, 6
                FpData(j,i,1)= 0.0
                do k= 1, 6
                  FpData(j,i,1)= FpData(j,i,1) + 
     &                (BertecCalMat(j,k)/BertecGain)*
     &                (chdata(i,FpChnl1(plt)+k-1)-ZeroB(k))
                end do
              end do        
            end do                   
          else  
            write(6,560) plt
560         format(/' Assigning Plate # ',i1,' as Bertec force plate data...')
            do i= 1, numfrm                
              do j= 1, 6
                FpData(j,i,1)= chdata(i,FpChnl1(plt)+j-1)
              end do
            end do                                  
          end if      

        else if ( (PltType(plt) .eq. 'KOL') .or. 
     &            (PltType(plt) .eq. 'KNE')      ) then
          if ( AutoZeroK ) then
c            call ZeroChnlSum( chdata,MAX_ELC,FP.nfrm,
c     &                        FpChnl1(plt),FpChnl1(plt)+7,AutoZeroPct,ZeroK )
            do i= 1, 8
              call ZeroChnl( chdata(1,FpChnl1(plt)+i-1),FP.nfrm,SkipFrm,
     &                       AutoZeroPct,ZeroK(i) )
            end do
          end if
          if ( Calibrate ) then                       
            if (PltType(plt) .eq. 'KOL') write(6,570) plt
570         format(/' Converting Plate # ',i1,' as OLD Kistler force plate data...')
            if (PltType(plt) .eq. 'KNE') write(6,571) plt
571         format(/' Converting Plate # ',i1,' as NEW Kistler force plate data...')
            do i= 1, numfrm
              if ( ManZeroK ) then
                do j= 1, 8
                  frmdata(j)= chdata(i,FpChnl1(plt)+j-1) - ZeroK(j)
                end do
              else
                do j= 1, 8
                  frmdata(j)= chdata(i,FpChnl1(plt)+j-1)
                end do
              end if 
            if (PltType(plt) .eq. 'KOL')
     &         call ConvertKistler( frmdata,okx,oky,okz,FpData(fx,i,plt) )
            if (PltType(plt) .eq. 'KNE')
     &         call ConvertKistler( frmdata,nkx,nky,nkz,FpData(fx,i,plt) )
            end do                      
          else
            if (PltType(plt) .eq. 'KOL') write(6,580) plt
580         format(/' Assigning Plate # ',i1,' as OLD Kistler force plate data...')
            if (PltType(plt) .eq. 'KNE') write(6,581) plt
581         format(/' Assigning Plate # ',i1,' as NEW Kistler force plate data...')
            do i= 1, numfrm
              if ( ManZeroK ) then
                do j= 1, 8
                  chdata(i,j)= chdata(i,FpChnl1(plt)+j-1) - ZeroK(j)
                end do
              end if
              do j= 1, 4 
                FpData(j,i,plt)= chdata(i,FpChnl1(plt)+j-1)
              end do
              FpData(5,i,plt)= chdata(i,FpChnl1(plt)+5) + 
     &                            chdata(i,FpChnl1(plt)+6)
              FpData(6,i,plt)= chdata(i,FpChnl1(plt)+7) + 
     &                            chdata(i,FpChnl1(plt)+8)
            end do                                                   
          end if
        end if                      
      end do ! plt

      if ( NumEMGChnl .gt. 0 ) then
        EF.read= .true.
        write(6,595) NumEMGChnl
595     format(' Assigning ',i2,' EMG channels')
        EP.NumChnl= NumEMGChnl
        EP.NumSamples= numfrm
        EP.SampleRate= smplfreq
        do i= 1, EP.NumChnl
          EP.name(i)= chnlname(i+NumFpChnl)
          EP.Surface(i)= .true.
          EP.CodeNum(i)= chnlnum(i+NumFpChnl)
          do j= 1, numfrm          
            EMGData(j,i)= chdata(j,i+NumFpChnl)
          end do         
        end do                     
      end if

      if ( AnalysisType .eq. CKC_ANL ) FP.plt_loc(1).LCS(z,cntr)= -0.029
c                                       
c     Summarize read results if Diagnose Flag is set
c               
      if ( Diagnose ) then
        write(6,390) intfilename,trialnum,numchnl,smplfreq,smplint,
     &               smpltime,numfrm
        if ( OF.ToLog ) write(3,390) intfilename,trialnum,numchnl,
     &                           smplfreq,smplint,smpltime,numfrm
390     format(//' MAC ADS File Read Summary'/
     &         '   Internal file name: ',a20/
     &         '   Trial number      : ',i5/                      
     &         '   Number of channels: ',i5/
     &         '   Frame rate        : ',i5/
     &         '   Sample interval   : ',i5/
     &         '   Sample time       : ',f8.4/
     &         '   Number of frames  : ',i5//
     &         '  Channel #    Gain    Name'//)
        do i= 1, numchnl
          write(6,400) chnlnum(i),chnlgain(i),chnlname(i)
          if ( OF.ToLog ) write(3,400) chnlnum(i),chnlgain(i),chnlname(i)
400       format(4x,i3,5x,i4,5x,a20)
        end do
        if ( AutoZeroK ) then
          write(6,420)
420       format(/' Kistler auto zero voltages used'/
     &           ' Channel#   Voltage')
          do i= 1, 8
            write(6,430) i,ZeroK(i)
430         format(4x,i2,4x,f12.6)
          end do
        end if
        if ( AutoZeroB ) then
          write(6,421)
421       format(/' Bertec auto zero voltages used'/
     &           ' Channel#   Voltage')
          do i= 1, 6
            write(6,430) i,ZeroB(i)
          end do
        end if
      end if
      return
                                       
1000  write(6,1005) filename,errnum
      if ( OF.ToLog ) write(3,1005) filename,errnum
1005  format(' Error- Trouble opening ',a60/
     &       '        Error number ',i3,' occurred.')
      return                            

1010  write(6,1015) errnum,filename
      if ( OF.ToLog ) write(3,1015) errnum,filename
1015  format(' Error- Error number ',i3,' occurred while reading ',a60)
      close (unit=1)
      return

3000  write(6,3005) NumFpChnl,NumPlt,numchnl
      if ( OF.ToLog ) write(3,3005) NumFpChnl,NumPlt,numchnl
3005  format(' Error- ',i2,' channels of data are required for the ',i1,' force plates'/
     &       '        indicated but there are only ',i2,' channels in the file')
      close (unit=1)
      return

3010  write(6,3015) plt
      if ( OF.ToLog ) write(3,3015) plt
3015  format(' Error- Early Mayo force plate arrangement did not include the'/
     &       '        newer Kistler force plate which is indicated as plate # ',
     &       i1)
      close (unit=1)
      return

3020  write(6,3025) plt,PltType(plt)
      if ( OF.ToLog ) write(3,3025) plt,PltType(plt)
3025  format(' Error- Force plate # ',i1,' has an invalid type of ',a3/
     &       '        Recheck the read command line options')
      close (unit=1)
      return
 
3030  write(6,3035) chnl,chnlgain(chnl)
      if ( OF.ToLog ) write(3,3035) chnl,chnlgain(chnl)
3035  format(' Error- There is something wrong with ANA file'/
     &       '        Channel ',i2,' has a gain of ',i5)
      close (unit=1)
      return
      end
c
c
c
      subroutine cleanline ( text )
      implicit none

      character text*(*)
      integer*4 i
      
      do i= 1, len(text)
        if ( ichar(text(i:i)) .eq. 13 ) text(i:i)= ' '
      end do
      return
      end
c
c     Zero a voltage channel from the force plate by scanning it for a region
c     which has a voltage change of less than the range of the voltage in the
c     channel*pct. The region is hard coded to 10 frames here.
c                           
c
      subroutine ZeroChnl( data,np,ns,pct,zero )
      implicit none
      
      integer*4 np,ns
      real*4    data(*),pct,zero

      real*4    mind,maxd,range
      integer*4 i,nr,ni,start,end
c
c     Determine the range of the voltage in the data
c
      maxd= data(ns+1)
      mind= data(ns+1)
      do i= ns+2, np
        if ( data(i) .gt. maxd ) maxd= data(i)
        if ( data(i) .lt. mind ) mind= data(i)
      end do
      range= maxd-mind                              
c
c     Hunt for a region 10 frames wide that has a maximum variation of pct*
c     range of the voltage in the data
c
      nr= 10
      if ( nr .gt. np ) nr= np
      ni= 1
      start= ns+1
      do while ( (ni .lt. nr) .and. (end .lt. np) )
        end= start + ni      
        if ( (abs(data(end)-data(start)) .le. pct*abs(range)/100.0) .and.
     &       (abs(data(end)-mind) .lt. pct*abs(range)/100.0)             ) then
          ni= ni + 1
        else
          start= start + ni + 1
          end =  start      
          ni= 1
        end if
      end do   
c
c     if region was found before end of data set then zero it. Otherwise
c     return without changing the voltages.
c
      zero= 0.0
      if ( end .lt. np ) then
        do i= start, end
          zero= zero + data(i)
        end do
        zero= zero/float(end-start+1)
        do i= 1, np
          data(i)= data(i) - zero
        end do
      end if   
      return
      end
c
c     Zero voltages in all channels from the force plate by scanning it for a
c     region in which the norm of the voltages is less than a specified
c     percentage of the range of the norm. This region is hard coded to be
c     10 frames long and must have a mgnitude of less than the percentage
c     of the norm.
c                           
c
      subroutine ZeroChnlSum( data,nf,np,ch1,che,pct,zero )
      implicit none
      
      integer*4 np,ch1,che,nf
      real*4    data(nf,*),pct,zero(*)

      real*4    mins,maxs,range,sum(6000)
      integer*4 i,j,nr,ni,start,end,zj
c
c     Determine the range of the voltage in the data
c
      maxs= -1.0
      mins= 1.0e10
      do i= 1, np
        sum(i)= 0.0
        do j= ch1, che
          sum(i)= sum(i) + data(i,j)*data(i,j)
        end do
        sum(i)= sqrt(sum(i))
        if ( sum(i) .gt. maxs ) maxs= sum(i)
        if ( sum(i) .lt. mins ) mins= sum(i)
      end do
      range= maxs-mins
c
c     Hunt for a region 10 frames wide that has a maximum variation of pct*
c     range of the voltage in the data
c
      nr= 10
      if ( nr .gt. np ) nr= np
      ni= 1
      start= 1                                                
      do while ( (ni .lt. nr) .and. (end .lt. np) )
        end= start + ni      
        if ( (abs(sum(end)-sum(start)) .le. pct*range/100.0) .and.
     &       (abs(sum(end)-mins) .lt. pct*range/100.0)             ) then
          ni= ni + 1
        else
          start= start + ni + 1
          end =  start      
          ni= 1
        end if
      end do   
c
c     if region was found before end of data set then zero it. Otherwise
c     return without changing the voltages.
c
      if ( end .lt. np ) then
        do j= ch1, che
          zj= j-ch1+1
          zero(zj)= 0.0
          do i= start, end
            zero(zj)= zero(zj) + data(i,j)
          end do
          zero(zj)= zero(zj)/float(end-start+1)
          do i= 1, np
            data(i,j)= data(i,j) - zero(zj)
          end do
        end do
      else
        do i= 1, che-ch1+1
          zero(i)= 0.0
        end do
      end if       
      return          
      end
c                                
c
c
      subroutine ConvertKistler( volt,kfx,kfy,kfz,load )
      implicit none

      real*4    volt(8),load(6),kfx,kfy,kfz

      integer*4 fx,fy,fz,mx,my,mz,z1,z2,z3,z4,x12,x34,y14,y23 
      real*4    ka,kb

      data fx,fy,fz,mx,my,mz / 1,2,3,4,5,6 /
      data z1,z2,z3,z4,x12,x34,y14,y23 / 1,2,3,4,5,6,7,8 /
      data ka,kb / 0.20,0.12 /
c                   m    m

      load(fx)= kfx*( volt(x12) + volt(x34) )
      load(fy)= kfy*( volt(y14) + volt(y23) )
      load(fz)= kfz*( volt(z1) + volt(z2) + volt(z3) + volt(z4) )
      load(mx)= ka*kfz*( volt(z1) + volt(z2) - volt(z3) - volt(z4) )
      load(my)= kb*kfz*( volt(z2) + volt(z3) - volt(z1) - volt(z4) )
      load(mz)= ka*kfx*( volt(x34) - volt(x12) )
     &        + kb*kfy*( volt(y14) - volt(y23) )
      return
      end
           
