c
c           
c                                
c
c     Copyright by Dwight Meglan 1990
c
c     Purpose: This file contains routines to export into text files information 
c              describing the body segments analyzed by ANZ. 
c
c     NOTE: There is a trick in these routines which makes life alot easier when
c           you are dumping all of the segments at once for a specific quantity.
c           Normally, you would have to type in an export command for every segment
c           you wanted to export. However, by including a wild card, *, in the 
c           export command all the segments can be dumped in one command. For example,
c
c           EXP SEG POS RTFT RFT_FILE.TXT  : dumps only the right foot position/orientation
c           EXP SEG POS ALL _FILE.TXT      : dumps all segment positions/orientations
c
c           The file names in this example will be RTFT_FILE.TXT,RTCF_FILE.TXT and so on.
c           You can change where the segment name is inserted by placing a wild card in
c           the file name of the command:
c
c           EXP SEG POS ALL BOB_*.SGP
c
c           This will produce files with the names BOB_RTFT.SGP, BOB_RTCF.SGP, etc.
c
      subroutine ExportSeg( CMND,inc,RegHeader,IgorHeader,
     &                      SF,MF,OF )
      implicit none
      include 'a_const.inc'
                                   
      include 'a_struct.inc'
      include 'a_prm.inc'
      include 'a_names.inc'
      include 'a_seg.inc'
      include 'a_jnt.inc'
      include 'a_mrk.inc'

      record /CmndLine/     CMND
      record /segment_flag/ SF
      record /marker_flag/  MF
      record /option_flag/  OF

      integer*4 inc
      logical*4 IgorHeader,RegHeader

      real*4    angsign(3),TimeInc,MrkSize
      integer*4 SegNum,frm,i,j,k,seg,NumMrk,NumExpSegVar,CSType,NumOpt,
     &          ExpVarNumCmnd(12),NumCmnd,Start,NumFile,ExpVarNum,ierr,
     &          AllSegNum(MAX_SEG),End,NumSeg,ns,nrep
      logical*4 GetSegNum,OpenTextFile,ExportLCS,UseAngles,Error,GetCSType,
     &          Animate,AnatomicModel,SegPosRM,AllSeg,BodyTotal,SegPosErnie,
     &          SegPrmBYU,ZeroOnPelvis,SegPrmMrk,SegPosMrk,SegPosSIMM,
     &          SegPrmSIMM
      character SegEndNames(4,15)*4,LineText*80,SegText*3,
     &          ExpSegVarName(12)*3,FileName(15)*40,OptText(5)*3,name*4
                            
      data NumExpSegVar / 12 /
      data ExpSegVarName / 'PRM','POS','VEL','ACC','ENR','FSC',
     &                     'ISC','MOM','BCM','BCV','ANG','SWI' /
      data ExpVarNumCmnd / 4 , 5 , 5 , 5 , 5 , 5 , 5 , 5 , 4 , 4 , 5 , 4 /
                            
      data SegEndNames / 'NONE','RTAK','NONE','NONE',  ! rtak
     &                   'RTAK','RTKN','NONE','NONE',  ! rtkn
     &                   'RTKN','RTHP','NONE','NONE',  ! rtth
     &                   'NONE','LFAK','NONE','NONE',  ! lfak
     &                   'LFAK','LFKN','NONE','NONE',  ! lfkn
     &                   'LFKN','LFHP','NONE','NONE',  ! lfth
     &                   'RTHP','LFHP','TRNK','NONE',  ! pelv
     &                   'RTSH','LFSH','PELV','NECK',  ! trnk
     &                   'RTEL','RTSH','NONE','NONE',  ! rtua
     &                   'RTWR','RTEL','NONE','NONE',  ! rtla
     &                   'LFEL','LFSH','NONE','NONE',  ! lfua
     &                   'LFWR','LFEL','NONE','NONE',  ! lfla
     &                   'NONE','NECK','NONE','NONE',  ! head
     &                   'NONE','RTWR','NONE','NONE',  ! rthd
     &                   'NONE','LFWR','NONE','NONE' / ! lfhd

      data angsign / -1,1,-1 /                                          

c
c     Check validity of export quantity name
c
      Error= .true.
      do i= 1, NumExpSegVar
        if ( CMND.CmndText(3) .eq. ExpSegVarName(i) ) then
          Error= .false.
          ExpVarNum= i
        end if
      end do
      if ( Error ) goto 1000 ! bad name
c
c     Now check options if present
c                        
      CSType= GCS_CS
      Animate= .false.
      AnatomicModel= .false.
      SegPosRM= .false.
      SegPosSIMM= .false.
      SegPosErnie= .false.
      SegPosMrk= .false.
      SegPrmBYU= .false.
      SegPrmSIMM= .false.
      SegPrmMrk= .false.
      ZeroOnPelvis= .false.
      nrep= 1
      if ( CMND.NumOpt(3) .gt. 0 ) then
        NumOpt= CMND.NumOpt(3)            ! stupid trick needed to make mac 
        do i= 1, CMND.NumOpt(3)           ! version work correctly !!!!
          OptText(i)= CMND.OptText(i,3)
        end do
c        if ( CMND.NumOpt(3) .gt. 1 ) goto 1010     

        if ( (ExpVarNum .eq. 3) .or. (ExpVarNum .eq. 4) ) then
          if ( .not. GetCSType( NumOpt,OptText,CSType) ) goto 1020
          if ( CSType .gt. LCS_CS ) goto 1020

        else if ( ExpVarNum .eq. 1 ) then
          do i= 1, CMND.NumOpt(3)
            if ( OptText(i) .eq. 'ANI' ) then
              Animate= .true.
            else if ( (OptText(i) .eq. 'BYU') .or.
     &                (OptText(i) .eq. 'VIS')      ) then
              SegPrmBYU= .true.
            else if ( OptText(i) .eq. 'SIM' ) then 
              SegPrmSIMM= .true.
            else if ( OptText(i) .eq. 'MRK' ) then
              SegPrmBYU= .true.
              SegPrmMrk= .true.
              MrkSize= 0.02
              if ( CMND.OptNumOK(i,3) .and.
     &             (CMND.OptRealVal(i,3) .gt. 0.0) .and.
     &             (CMND.OptRealVal(i,3) .le. 0.1)       ) 
     &          MrkSize= CMND.OptRealVal(i,3) 
            else
              goto 1030 ! error - bad option
            end if
          end do

        else if ( ExpVarNum .eq. 2 ) then
          do i= 1, CMND.NumOpt(3)
            if ( OptText(i) .eq. 'MAT' ) then
              SegPosRM= .true.
            else if ( OptText(i) .eq. 'ANI' ) then
              Animate= .true.
            else if ( OptText(i) .eq. 'SIM' ) then
              SegPosSIMM= .true.
            else if ( (OptText(i) .eq. 'ERN') .or.
     &                (OptText(i) .eq. 'VIS')      ) then
              SegPosErnie= .true.
            else if ( OptText(i) .eq. 'MRK' ) then
              SegPosErnie= .true.
              SegPosMrk= .true.
            else if ( OptText(i) .eq. 'ZPV' ) then
              ZeroOnPelvis= .true.
            else if ( OptText(i) .eq. 'REP' ) then
              if ( .not. CMND.OptNumOK(i,3) ) goto 2010
              if ( (CMND.OptIntVal(i,3) .lt. 1) .or. 
     &             (CMND.OptIntVal(i,3) .gt. 20)     ) goto 2020
              nrep= CMND.OptIntVal(i,3)
            else               
              goto 1040 ! error - bad option
            end if
          end do               

        else if ( ExpVarNum .eq. 12 ) then
          if ( OptText(1) .eq. 'ANA' ) AnatomicModel= .true.

        else
          goto 1050 ! error - no options valid
        end if
      end if
c
c     Figure out which segment will be exported
c
      NumCmnd= ExpVarNumCmnd(ExpVarNum)       
      if ( (ExpVarNum .eq. 2) .and. Animate ) NumCmnd= NumCmnd-1
      if ( (ExpVarNum .eq. 2) .and. SegPosErnie ) NumCmnd= NumCmnd-1
      if ( (ExpVarNum .eq. 2) .and. SegPosSIMM ) NumCmnd= NumCmnd-1
      if ( CMND.NumCmnd .lt. NumCmnd ) goto 1060 ! error
      AllSeg= .false.  
      BodyTotal= .false.
      if ( (ExpVarNum .ne. 1)  .and.          ! PRM
     &     (ExpVarNum .ne. 9)  .and.          ! BCM
     &     (ExpVarNum .ne. 10) .and.          ! BCV
     &     (.not. Animate)     .and.          ! POS/ANI
     &     (.not. SegPosErnie)     .and.      ! POS/ERN
     &     (.not. SegPosSIMM)     .and.       ! POS/SIM
     &     (ExpVarNum .ne. 12)       ) then   ! SWI
        if ( CMND.CmndText(NumCmnd-1) .eq. 'ALL' ) then
          AllSeg= .true.
        else if ( ((ExpVarNum .eq. 5) .or. (ExpVarNum .eq. 8)) .and.
     &            (CMND.CmndText(NumCmnd-1) .eq. 'TOT')       ) then
          BodyTotal= .true.
        else        
          SegText= CMND.CmndText(NumCmnd-1)
          if ( .not. GetSegNum( SegText,SegNum ) ) goto 1070
        end if
      end if
c
c     Open Text output file...
c
      LineText= CMND.Text(1)  
      Start= CMND.CmndStart(NumCmnd)
      if ( AllSeg ) then
        End=   CMND.CmndEnd(NumCmnd)
        NumSeg= GP.num_seg
        do i= 1, NumSeg
          AllSegNum(i)= GP.seg_num(i)
        end do
        call BuildFileNames( LineText,Start,End,seg_names,
     &                       NumSeg,AllSegNum,FileName     )
      else
        if ( .not. OpenTextFile(LineText,Start,.true.) ) goto 1080 ! error
      end if
c
c     Now dump whatever has been requested
c
      TimeInc= float(inc)/rMtnFrmRate
c
c     Segment parameters
c
      if ( ExpVarNum .eq. 1 ) then
        if ( .not. SF.param ) goto 1090 ! error         
        if ( Animate ) then
          do i=1, GP.num_seg                              
            seg= GP.seg_num(i)
            write(2,245) seg
245         format(1x,i2)
            do j= 1, 8
              write(2,247) (SP(seg).shape(k,j),k=1,3)
247           format(1x,3f10.4)
            end do
          end do
        else if ( SegPrmBYU ) then ! write out BYU movie geometry file
          ns= GP.num_seg
          if ( SegPrmMrk ) ns= GP.num_seg + MP.num_mrk
          write(2,600) ns,8*ns,6*ns,24*ns,0
600       format(5i5)
          do i= 1, ns
            write(2,610) 6*i-5,6*i        
610         format(2i5)
          end do
          do i=1, GP.num_seg                              
            seg= GP.seg_num(i)
            do j= 1, 8
              write(2,247) (SP(seg).shape(k,j),k=1,3)
            end do     
          end do          
          if ( SegPrmMrk ) then  ! include marker outlines...
            do i= 1, MP.num_mrk
              write(2,247)  MrkSize/2.0, MrkSize/2.0, -MrkSize/2.0
              write(2,247) -MrkSize/2.0, MrkSize/2.0, -MrkSize/2.0
              write(2,247) -MrkSize/2.0,-MrkSize/2.0, -MrkSize/2.0
              write(2,247)  MrkSize/2.0,-MrkSize/2.0, -MrkSize/2.0
              write(2,247)  MrkSize/2.0, MrkSize/2.0,  MrkSize/2.0
              write(2,247) -MrkSize/2.0, MrkSize/2.0,  MrkSize/2.0
              write(2,247) -MrkSize/2.0,-MrkSize/2.0,  MrkSize/2.0
              write(2,247)  MrkSize/2.0,-MrkSize/2.0,  MrkSize/2.0
            end do
          end if
          do i= 1, ns
            j= 8*(i-1)
            write(2,620) j+1,j+5,j+6,-(j+2)
            write(2,620) j+4,j+8,j+5,-(j+1)
            write(2,620) j+3,j+7,j+8,-(j+4)
            write(2,620) j+2,j+6,j+7,-(j+3)
            write(2,620) j+5,j+8,j+7,-(j+6)
            write(2,620) j+4,j+1,j+2,-(j+3)
620         format(4i5)
          end do
        else if ( SegPrmSIMM ) then ! write out SIMM bone file
           do i=1, GP.num_seg                              
              seg= GP.seg_num(i)
              call lower_name( seg_names(seg),name )
              write(2,888) name
 888          format(/a4//' 8 6')
              do j= 1, 8
                 write(2,247) SP(seg).shape(1,j),SP(seg).shape(3,j),
     &                       -SP(seg).shape(2,j)
              end do     
              write(2,887)
 887          format(' 4 1 2 3 4'/' 4 1 5 6 2'/' 4 2 6 7 3'/
     &               ' 4 3 7 8 4'/' 4 4 1 5 8'/' 4 8 7 6 5')
           end do  
        else
          do i= 1, GP.num_seg
            SegNum= GP.seg_num(i)
            write(2,250) Seg_Names(SegNum),SP(SegNum).length,
     &                   SP(SegNum).mass,(SP(SegNum).inertia(k),k=1,3)
250         format('1',' Segment Parameters for ',a4//
     &             '  Length    : ',f10.4,' m'/
     &             '  Mass      : ',f10.4,' kg'/
     &             '  Inertia x : ',e12.6,' kg*m^2'/
     &             '          y : ',e12.6,' kg*m^2'/
     &             '          z : ',e12.6,' kg*m^2'///
     &             ' Segment outline'/
     &             '  Distal shape  Pnt#',5x,'x',9x,'y',9x,'z'/)
            do j= 1, 4
              write(2,265) j,(SP(SegNum).shape(k,j),k=1,3)
265           format(17x,i1,2x,3f10.4)  
            end do
            write(2,267)
267         format(/'  Proximal shape  Pnt#',5x,'x',9x,'y',9x,'z'/)
            do j= 5, 8         
              write(2,265) j,(SP(SegNum).shape(k,j),k=1,3)
            end do
            write(2,260)
260         format(/' Location of Segment Ends'/
     &             '  End ',6x,'x',9x,'y',9x,'z'/)
c            if ( SP(SegNum).num_end .eq. 1 ) then
c              write(2,270) jnt_names(SegJntNum(proximal,SegNum)),
c     &                     (SP(SegNum).end(k,proximal),k=1,3)
270           format(2x,a4,2x,3f10.4)
c            else                                    
              do j= 1, SP(SegNum).num_end
                write(2,270) jnt_names(SegJntNum(j,SegNum)),
     &                       (SP(SegNum).end(k,j),k=1,3)
              end do
c            end if
            write(2,271)
271         format(//' Segment TCS to LCS transformation'/)
            do j= 1, 3
              write(2,272) (SP(SegNum).TCStoLCS(j,k),k=1,4)
272           format(1x,4(1x,f10.5))
            end do
            write(2,273) SP(SegNum).nmTCS
273         format(/' Number of markers in segment TCS: ',i2/
     &              ' Marker #   Name      LCS position'/)
            do j= 1, SP(SegNum).nmTCS
              write(2,274) SP(SegNum).mnTCS(j),
     &                     MP.mrk_name(SP(SegNum).mnTCS(j)),
     &                     (SP(SegNum).mpnLCS(k,j),k=1,3)
274           format(5x,i2,5x,a4,5x,3(f10.5,1x))
            end do 
          end do ! i => SegNum                             
        end if                               
        close(unit=2)   
                                           
      else if ( ExpVarNum .eq. 2 ) then ! Segment Position/Orientation 
        if ( SegPosErnie ) then                              
          call ExpSegPosErnie( inc,nrep,ZeroOnPelvis,SegPosMrk,
     &                         SF,OF,error )
          close(unit=2)
          if ( error ) return
        else if ( SegPosSIMM ) then
          call ExpSegPoseSIMM( inc,SF,OF,error )
          close(unit=2)
          if ( error ) return
        else if ( .not. AllSeg ) then
          call ExpSegPos( inc,RegHeader,IgorHeader,
     &                    Animate,SegPosRM,SegNum,
     &                    SF,OF,error )        
          close(unit=2)
          if ( error ) return
        else
          do i= 1, GP.num_seg        
            SegNum= GP.seg_num(i)
            open( unit=2,file=filename(i),status='unknown',iostat=ierr,err=2000 )
            call ExpSegPos( inc,RegHeader,IgorHeader,
     &                      Animate,SegPosRM,SegNum,
     &                      SF,OF,error ) 
            close(unit=2)
            if ( error ) return
          end do
        end if

      else if ( ExpVarNum .eq. 3 ) then ! Segment Velocity
        if ( .not. AllSeg ) then
          call ExpSegVel( inc,RegHeader,IgorHeader,CSType,SegNum,
     &                    SF,OF,error ) 
          close(unit=2)
          if ( error ) return
        else
          do i= 1, GP.num_seg
            SegNum= GP.seg_num(i)
            open( unit=2,file=filename(i),status='unknown',iostat=ierr,err=2000 )
            call ExpSegVel( inc,RegHeader,IgorHeader,CSType,SegNum,
     &                      SF,OF,error ) 
            close(unit=2)
            if ( error ) return
          end do
        end if

      else if ( ExpVarNum .eq. 4 ) then ! Segment Acceleration
        if ( .not. AllSeg ) then
          call ExpSegAcc( inc,RegHeader,IgorHeader,CSType,SegNum,
     &                    SF,OF,error ) 
          close(unit=2)
          if ( error ) return
        else
          do i= 1, GP.num_seg
            SegNum= GP.seg_num(i)
            open( unit=2,file=filename(i),status='unknown',iostat=ierr,err=2000 )
            call ExpSegAcc( inc,RegHeader,IgorHeader,CSType,SegNum,
     &                      SF,OF,error ) 
            close(unit=2)
            if ( error ) return
          end do
        end if

      else if ( ExpVarNum .eq. 5 ) then ! Segment Energy
        if ( .not. AllSeg ) then
          call ExpSegEnergy( inc,RegHeader,IgorHeader,BodyTotal,
     &                       SegNum,SF,OF,error ) 
          close(unit=2)
          if ( error ) return
        else
          do i= 1, GP.num_seg
            SegNum= GP.seg_num(i)
            open( unit=2,file=filename(i),status='unknown',iostat=ierr,err=2000 )
            call ExpSegEnergy( inc,RegHeader,IgorHeader,BodyTotal,
     &                         SegNum,SF,OF,error ) 
            close(unit=2)
            if ( error ) return
          end do
        end if

      else if ( ExpVarNum .eq. 6 ) then ! Segment Finite Screw
        if ( .not. AllSeg ) then
          call ExpSegFinScrew( inc,RegHeader,IgorHeader,
     &                         SegNum,SF,OF,error ) 
          close(unit=2)
          if ( error ) return
        else
          do i= 1, GP.num_seg
            SegNum= GP.seg_num(i)
            open( unit=2,file=filename(i),status='unknown',iostat=ierr,err=2000 )
            call ExpSegFinScrew( inc,RegHeader,IgorHeader,
     &                           SegNum,SF,OF,error ) 
            close(unit=2)
            if ( error ) return
          end do
        end if
                 
      else if ( ExpVarNum .eq. 7 ) then ! Segment Instantaneous Screw
        if ( .not. AllSeg ) then
          call ExpSegInsScrew( inc,RegHeader,IgorHeader,
     &                         SegNum,SF,OF,error ) 
          close(unit=2)
          if ( error ) return
        else
          do i= 1, GP.num_seg
            SegNum= GP.seg_num(i)
            open( unit=2,file=filename(i),status='unknown',iostat=ierr,err=2000 )
            call ExpSegInsScrew( inc,RegHeader,IgorHeader,
     &                           SegNum,SF,OF,error ) 
            close(unit=2)
            if ( error ) return
          end do
        end if

      else if ( ExpVarNum .eq. 8 ) then ! Segment Momentum
        if ( .not. AllSeg ) then
          call ExpSegMom( inc,RegHeader,IgorHeader,BodyTotal,
     &                    SegNum,SF,OF,error ) 
          close(unit=2)
          if ( error ) return
        else
          do i= 1, GP.num_seg
            SegNum= GP.seg_num(i)
            open( unit=2,file=filename(i),status='unknown',iostat=ierr,err=2000 )
            call ExpSegMom( inc,RegHeader,IgorHeader,BodyTotal,
     &                      SegNum,SF,OF,error ) 
            close(unit=2)
            if ( error ) return
          end do
        end if

      else if ( ExpVarNum .eq. 9 ) then
        call ExpBodyCM( inc,RegHeader,IgorHeader,
     &                  SF,OF,error ) 
        close(unit=2)
        if ( error ) return

      else if ( ExpVarNum .eq. 10 ) then
        call ExpBodyCMVel( inc,RegHeader,IgorHeader,
     &                     SF,OF,error ) 
        close(unit=2)
        if ( error ) return

      else if ( ExpVarNum .eq. 11 ) then
        if ( .not. AllSeg ) then
          call ExpSegAng( inc,RegHeader,IgorHeader,SegNum,
     &                    SF,OF,error ) 
          close(unit=2)
          if ( error ) return
        else
          do i= 1, GP.num_seg
            SegNum= GP.seg_num(i)
            open( unit=2,file=filename(i),status='unknown',iostat=ierr,err=2000 )
            call ExpSegAng( inc,RegHeader,IgorHeader,SegNum,
     &                      SF,OF,error ) 
            close(unit=2)
            if ( error ) return
          end do
        end if
                        
      else if ( ExpVarNum .eq. 12 ) then ! Swivel3D output
        call ExportSwivel3D( AnatomicModel,SF,OF )
        close(unit=2)
        
      end if                                           
      return

1000  write(6,1005) CMND.CmndText(3)
      if ( OF.ToLog ) write(3,1005) CMND.CmndText(3)
1005  format(' Error- ',a3,' is not a valid EXPort SEGment command'/
     &         '        Valid commands are: POSition     VELocity'/
     &       28x,'ENeRgy       ACCeleration'/
     &       28x,'FiniteSCrew  InstantSCrew'/
     &       28x,'SWIvel3d     PaRaMeters'/
     &       28x,'MOMentum     BodyCenterMass'/
     &       28x,'ANGle')
      return
      
1010  write(6,1015) CMND.NumOpt(3)
      if ( OF.ToLog ) write(6,1015) CMND.NumOpt(3)
1015  format(' Error- There are ',i2,' options present for the command'/
     &       '        but only 1 option at a time is valid here')
      return

1020  write(6,1025) OptText(1)
      if ( OF.ToLog ) write(6,1025) OptText(1)
1025  format(' Error- ',a3,' is not a valid coordinate system'/
     &       '        Valid Coordinate systems are GCS or LCS')
      return

1030  write(6,1035) OptText(1)
      if ( OF.ToLog ) write(6,1035) OptText(1)
1035  format(' Error- ',a3,' is not a valid option for EXP SEG PRM'/
     &       '        The valid options are: /ANImate /BYU /VIS')
      return

1040  write(6,1045) OptText(i)
      if ( OF.ToLog ) write(6,1045) OptText(i)
1045  format(' Error- ',a3,' is not a valid option for EXP SEG POS'/
     &       '        Valid options are: /ANImate  /MATrix  /ERNie'/
     &       '                           /ZeroPeLvis  /REPeat /VIS')
      return

1050  write(6,1055) OptText(1)
      if ( OF.ToLog ) write(6,1055) OptText(1)
1055  format(' Error- ',a3,' is not a valid option for any EXP SEG quantities'/
     &       '        Valid option combinations are:'/
     &       '          EXP SEG POS (/ANI,/MAT,/ERN,/ZPV,/REP,/VIS)'/
     &       '                  VEL (/GCS,/LCS)'/
     &       '                  ACC (/GCS,/LCS)'/
     &       '                  PRM  /ANI,/BYU,/VIS'/
     &       '                  SWI  /ANA')
      return

1060  write(6,1065) CMND.NumCmnd,NumCmnd
      if ( OF.ToLog ) write(6,1065) CMND.NumCmnd,NumCmnd
1065  format(' Error- There are only ',i2,' commands present for EXP SEG'/
     &       '        but there must be ',i2,' commands for this quantity')
      return

1070  write(6,1075) SegText,(seg_names(GP.seg_num(i)),
     &                       i= 1, GP.num_seg)
      if ( OF.ToLog ) write(6,1075) SegText,
     &                          (seg_names(GP.seg_num(i)),
     &                           i= 1, GP.num_seg)
1075  format(' Error- ',a3,' is not a valid segment name'/
     &       '        Valid segment names are : ALL TOTal'/
     &       3(34x,5a5/))
      return
      
1080  write(6,1085)                                      
      if ( OF.ToLog ) write(3,1085)
1085  format(' Error- File could not be opened')        
      return

1090  write(6,1095)                 
      if ( OF.ToLog ) write(3,1095)
1095  format(' Error- Segment parameters have not been calculated yet')
      return

2000  write(6,2005) filename(i),ierr
      if ( OF.ToLog ) write(3,2005) filename(i),ierr
2005  format(' Error- Trouble opening ',a40/
     &       '        Error # ',i4,' occured')        
      return

2010  write(6,2015) OptText(i)
      if ( OF.ToLog ) write(6,2015) OptText(i)
2015  format(' Error- ',a3,' is not a valid number of repeats')
      return

2020  write(6,2025) CMND.OptIntVal(i,3)
      if ( OF.ToLog ) write(6,2025) CMND.OptIntVal(i,3)
2025  format(' Error- ',i5,' is not a valid number of repeats'/
     &       '        The number of repeats must be between 1 and 20')
      return
      end
c
c
c      
c
c     Copyright by Dwight Meglan 1990
c
      subroutine BuildFileNames( Text,Start,End,ObjNames,
     &                           NumObj,ObjNum,FileName      )
      implicit none
      
      integer*4 Start,End,NumObj,ObjNum(1)
      character Text*80,ObjNames(1)*4,FileName(1)*40
      
      integer*4 i,PlacePt
c
c     check for * indicating position of placement of object name
c     if it is not present then add the object name to the beginning
c     of the file name
c
      PlacePt= 0
      i= start
      do while ( (PlacePt .eq. 0) .and. (i .le. end) )
        if ( Text(i:i) .eq. '*' ) PlacePt= i 
        i= i + 1
      end do
      if ( PlacePt .ne. 0 ) then
        do i= 1, NumObj
          FileName(i)= Text(start:PlacePt-1)//ObjNames(ObjNum(i))//
     &                 Text(PlacePt+1:end)
        end do
      else  
        do i= 1, NumObj
          FileName(i)= ObjNames(ObjNum(i))//Text(start:end)
        end do
      end if
      return
      end
c
c
c
c
c     Copyright by Dwight Meglan 1990
c
      subroutine ExportSwivel3D( AnatomicModel,SF,OF )
      implicit none
      include 'a_const.inc'

      include 'a_struct.inc'
      include 'a_prm.inc'
      include 'a_seg.inc'
      include 'a_names.inc'

      record /segment_flag/ SF
      record /option_flag/  OF
      
      logical*4 AnatomicModel

      integer*4 i,j,k,l,seg,frm,OutFrm,inc,Error,ProxSeg(15)
      real*4    Pnt(3),GCS(3,3),Angles(3),TempRM(3,3),RotXY(3,3),RotFt(3,3),
     &          TempRotMatProx(3,3),TempRotMatDist(3,3),Scale,Pos1(3)

      data RotXY / 0,0,-1, 1,0,0, 0,1,0 / ! rotation of +90 x and then +90 y
      data RotFt / 0,0,-1, 0,1,0, 1,0,0 / ! for ankle angle correction in Ralph
                       
      data GCS / 1.0,0.0,0.0,0.0,1.0,0.0,0.0,0.0,1.0 /
c                    rtft rtcf rtth lfft lfcf lfth pelv trnk rtua rtla lfua
      data ProxSeg / 2,   3,   7,   5,   6,   7,   0,   7,   8,   9,   8,
     &               11,  8,   10,  12 /
c                    lfla head rthd lfhd
c
      if ( .not. SF.position ) goto 1020 ! error
      if ( .not. SF.param ) goto 1050 ! error
c      if ( .not. SF.angle ) goto 1060 ! error
      Scale= 6.0
c                
c     If Absolute angles then Setup the segment shapes
c
      if ( .not. AnatomicModel ) then
        write(2,100)
100     format(' ShowWork'/)
        do i= 1, GP.num_seg
          seg= GP.seg_num(i)
          if ( (seg .ne. rtft) .and. (seg .ne. lfft) ) then
            write(2,110)
110         format(' BeginPathObject'/' CrossPoints:')
            do j= 1, 4
              write(2,120)  SP(seg).shape(y,j)*Scale,
     &                      SP(seg).shape(x,j)*Scale
120           format(3x,2f9.4,' ,')
            end do
            write(2,120)  SP(seg).shape(y,1)*Scale,       
     &                    SP(seg).shape(x,1)*Scale
            write(2,122)
122         format(/' LathePoints:')
            write(2,124) -abs(SP(seg).shape(z,1)*Scale)
124         format(3x,f9.4,' 0.0 ,')
            write(2,120) -abs(SP(seg).shape(z,1)*Scale),
     &                    abs(SP(seg).shape(x,1)*Scale)
            write(2,120)  abs(SP(seg).shape(z,5)*Scale),
     &                    abs(SP(seg).shape(x,5)*Scale)
            write(2,124)  abs(SP(seg).shape(z,5)*Scale)
            write(2,130) seg_names(seg)
130         format(' EndPathObject'/' MakeName ',a4//)
          else ! special description for feet...
            write(2,110)
            write(2,120)  SP(seg).shape(y,1)*Scale,
     &                    SP(seg).shape(z,1)*Scale
            write(2,120)  SP(seg).shape(y,5)*Scale,
     &                    SP(seg).shape(z,5)*Scale
            write(2,120)  SP(seg).shape(y,6)*Scale,
     &                    SP(seg).shape(z,6)*Scale
            write(2,120)  SP(seg).shape(y,2)*Scale,
     &                    SP(seg).shape(z,2)*Scale
            write(2,120)  SP(seg).shape(y,1)*Scale,
     &                    SP(seg).shape(z,1)*Scale
            write(2,122)
            write(2,124) -abs(SP(seg).shape(x,6)*Scale)
            write(2,120) -abs(SP(seg).shape(x,6)*Scale),
     &                    abs(SP(seg).shape(y,6)*Scale)
            write(2,120)  abs(SP(seg).shape(x,7)*Scale),
     &                    abs(SP(seg).shape(y,7)*Scale)
            write(2,124)  abs(SP(seg).shape(x,7)*Scale)
            write(2,126)
126         format(/' SidePoints:')
            write(2,124) -abs(SP(seg).shape(x,5)*Scale)
            write(2,120) -abs(SP(seg).shape(x,5)*Scale),
     &                    abs(SP(seg).shape(z,5)*Scale)
            write(2,120)  abs(SP(seg).shape(x,8)*Scale),
     &                    abs(SP(seg).shape(z,8)*Scale)
            write(2,124)  abs(SP(seg).shape(x,8)*Scale)
            write(2,128)
128         format(/' DownSidePoints:')
            write(2,124) -abs(SP(seg).shape(x,1)*Scale)
            write(2,120) -abs(SP(seg).shape(x,1)*Scale),
     &                   -abs(SP(seg).shape(z,1)*Scale)
            write(2,120)  abs(SP(seg).shape(x,4)*Scale),
     &                   -abs(SP(seg).shape(z,4)*Scale)
            write(2,124)  abs(SP(seg).shape(x,4)*Scale)
            write(2,130) seg_names(seg)
          end if
        end do ! i => seg   
c
c       Now dump the segment positions for 15 frames spread across
c       the motion cycle                        
c                                                       
        inc= MP.nfrm/15
        frm= 1                     
        OutFrm= 1                      
        do while ( (frm .le. MP.nfrm) .and. (OutFrm .le. 15) )
          do i= 1, GP.num_seg
            seg= GP.seg_num(i)
            write(2,140) seg_names(seg)
140         format(' FindObject ',a4)
            Pnt(x)=  SgpGCS(y,cntr,frm,seg)*Scale
            Pnt(y)=  SgpGCS(z,cntr,frm,seg)*Scale
            Pnt(z)=  SgpGCS(x,cntr,frm,seg)*Scale
            write(2,150) (Pnt(k),k=1,3)
150         format(' AbsPos: ',3f11.4,' ,')
            if ( (seg .ne. rtft) .and. (seg .ne. lfft) ) then
              TempRM(1,1)=  SgpGCS(2,2,frm,seg)
              TempRM(2,1)=  SgpGCS(3,2,frm,seg)
              TempRM(3,1)=  SgpGCS(1,2,frm,seg)
              TempRM(1,2)=  SgpGCS(2,1,frm,seg)
              TempRM(2,2)=  SgpGCS(3,1,frm,seg)
              TempRM(3,2)=  SgpGCS(1,1,frm,seg)
              TempRM(1,3)= -SgpGCS(2,3,frm,seg)
              TempRM(2,3)= -SgpGCS(3,3,frm,seg)
              TempRM(3,3)= -SgpGCS(1,3,frm,seg)
            else
              TempRM(1,1)=  SgpGCS(2,2,frm,seg)
              TempRM(2,1)=  SgpGCS(3,2,frm,seg)
              TempRM(3,1)=  SgpGCS(1,2,frm,seg)
              TempRM(1,2)=  SgpGCS(2,3,frm,seg)
              TempRM(2,2)=  SgpGCS(3,3,frm,seg)
              TempRM(3,2)=  SgpGCS(1,3,frm,seg)                 
              TempRM(1,3)=  SgpGCS(2,1,frm,seg)
              TempRM(2,3)=  SgpGCS(3,1,frm,seg)
              TempRM(3,3)=  SgpGCS(1,1,frm,seg)
            end if
c            call SwivelAngles( TempRM,GCS,Angles,Error )
            call JCSAngles( TempRM,GCS,Angles,Error )
            write(2,160) Angles(3),Angles(2),Angles(1)
c            write(2,160) (SangGCS(j,frm,seg),j=1,3)
160         format(' AbsAtt: ',3f11.4,' ,'/)
          end do ! i => seg
          frm= frm + inc            
          OutFrm= OutFrm + 1
          write(2,170)
170       format(' AddKeyFrame'//)
        end do ! while

      else ! relative joint angles and pelvis position
        inc= MP.nfrm/15
        frm= 1                      
        OutFrm= 1                      
        do while ( (frm .le. MP.nfrm) .and. (OutFrm .le. 15) )      
          do i= 1, GP.num_seg
            seg= GP.seg_num(i)
            write(2,140) seg_names(seg)
            if ( seg .eq. pelv ) then ! special case 
              if ( OutFrm .eq. 1 ) then
                Pos1(x)=  SgpGCS(y,cntr,frm,seg)*Scale
                Pos1(y)=  SgpGCS(z,cntr,frm,seg)*Scale
                Pos1(z)=  SgpGCS(x,cntr,frm,seg)*Scale
              end if
              Pnt(x)=  SgpGCS(y,cntr,frm,seg)*Scale - Pos1(x)
              Pnt(y)=  SgpGCS(z,cntr,frm,seg)*Scale - Pos1(y)
              Pnt(z)=  SgpGCS(x,cntr,frm,seg)*Scale - Pos1(z)
              write(2,150) (Pnt(k),k=1,3)
              call SwivelJntAngles( SgpGCS(1,1,frm,seg),GCS,Angles,Error )
              if ( Error .ne. 0 ) goto 1010 ! error
              write(2,160) Angles(3),Angles(2),Angles(1)       
            else             
              if ( (seg .eq. rtft) .or. (seg .eq. lfft) ) then
                call MatMult( SgpGCS(1,1,frm,seg),RotFt,TempRM )
                call SwivelJntAngles( TempRM,
     &                                SgpGCS(1,1,frm,ProxSeg(seg)),
     &                                Angles,Error )
                Angles(3)= -Angles(3)
                Angles(1)= Angles(1)-180.0
              else
                call SwivelJntAngles( SgpGCS(1,1,frm,seg),
     &                                SgpGCS(1,1,frm,ProxSeg(seg)),
     &                                Angles,Error )
                if ( (seg .eq. rtcf) .or. (seg .eq. lfcf) ) 
     &            Angles(3)= Angles(3)-180.0
              end if
              if ( Error .ne. 0 ) goto 1010 ! error
              write(2,180) Angles(3),Angles(2),Angles(1)       
180           format(' RelAtt: ',3f11.4,' ,'/)
            end if
          end do ! i => seg
          frm= frm + inc            
          OutFrm= OutFrm + 1
          write(2,170)
        end do ! while
      endif
      return
                                    
1010  if ( Error .eq. 1 ) then
        write(6,1011) seg_names(seg),frm
        if ( OF.ToLog ) write(3,1011) seg_names(seg),frm
1011    format(' Error- Problem calculating flex/ext of ',a4,' frame # ',i3)
      else if ( Error .eq. 2 ) then
        write(6,1012) seg_names(seg),frm
        if ( OF.ToLog ) write(3,1012) seg_names(seg),frm
1012    format(' Error- Problem calculating int/ext of ',a4,' frame # ',i3)
      else if ( Error .eq. 4 ) then
        write(6,1013) seg_names(seg),frm
        if ( OF.ToLog ) write(3,1013) seg_names(seg),frm
1013    format(' Error- Problem calculating ab/ad of ',a4,' frame # ',i3)
      else if ( Error .eq. 3 ) then
        write(6,1014) seg_names(seg),frm
        if ( OF.ToLog ) write(3,1014) seg_names(seg),frm
1014    format(' Error- Problem calculating flex/ext int/ext of ',a4,' frame # ',i3)
      else if ( Error .eq. 5 ) then
        write(6,1015) seg_names(seg),frm
        if ( OF.ToLog ) write(3,1015) seg_names(seg),frm
1015    format(' Error- Problem calculating flex/ext ab/ad of ',a4,' frame # ',i3)
      else if ( Error .eq. 6 ) then
        write(6,1016) seg_names(seg),frm
        if ( OF.ToLog ) write(3,1016) seg_names(seg),frm
1016    format(' Error- Problem calculating int/ext ab/ad of ',a4,' frame # ',i3)
      else if ( Error .eq. 7 ) then
        write(6,1017) seg_names(seg),frm
        if ( OF.ToLog ) write(3,1017) seg_names(seg),frm
1017    format(' Error- Problem calculating flex/ext int/ext ab/ad of ',a4,' frame # ',i3)
      end if
      return

1020  write(6,1025)                 
      if ( OF.ToLog ) write(3,1025)
1025  format(' Error- Segment positions have not been calculated yet')        
      return

1050  write(6,1055)                 
      if ( OF.ToLog ) write(3,1055)
1055  format(' Error- Segment parameters have not been calculated yet')
      return
      
1060  write(6,1065)                 
      if ( OF.ToLog ) write(3,1065)
1065  format(' Error- Segment angles have not been calculated yet')
      return
      end
c
c
c
c
c     Copyright by Dwight Meglan 1990
c
      subroutine ExpSegPos( inc,RegHeader,IgorHeader,
     &                      Animate,SegPosRM,SegNum,
     &                      SF,OF,error )
      implicit none
      
      include 'a_const.inc'
      include 'a_struct.inc'
      include 'a_prm.inc'
      include 'a_names.inc'
      include 'a_seg.inc'
      
      record /segment_flag/ SF
      record /option_flag/  OF
      
      integer*4 SegNum,inc
      logical*4 Animate,SegPosRM,Error,RegHeader,IgorHeader
      
      integer*4 frm,seg,i,j,k
      real*4    TempRotMat(3,3),RotXY(3,3),TimeInc
      character chtrn(3)*2,chang(3)*5,chrm(9)*4

      data RotXY / 0,0,-1, 1,0,0, 0,1,0 / ! rotation of +90 x and then +90 y
      data chtrn / '_x','_y','_z' /
      data chang / '_angy','_angx','_angz' /
      data chrm  / '_r11','_r21','_r31','_r12','_r22','_r32',
     &             '_r13','_r23','_r33' /

      Error= .true.
      if ( .not. SF.position ) goto 1000 ! error
      TimeInc= float(inc)/rMtnFrmRate
      if ( Animate ) then
        do frm= 1, MP.nfrm                  
          do i= 1, GP.num_seg
            seg= GP.seg_num(i)
            call MatMult( RotXY,SgpGCS(1,1,frm,seg),TempRotMat )
            write(2,203) frm,seg,((TempRotMat(j,k),j=1,3),k=1,3),
     &                    SgpGCS(y,cntr,frm,seg),
     &                    SgpGCS(z,cntr,frm,seg),
     &                   -SgpGCS(x,cntr,frm,seg)               
203         format(1x,i4,2x,i2,2x,12(f8.3,1x))
          end do
        end do
      else
        if ( .not. SegPosRM ) then ! Use Segment angle
          if ( .not. SF.angle ) goto 1010 ! error
          if ( IgorHeader ) then
            write(2,100) (Seg_Names(SegNum),i=1,6)
100           format(' IGOR'/
     &               ' WAVES ',a4,'_x, ',a4,'_y, ',a4,'_z, ',
     &                         a4,'_angy, ',a4,'_angx, ',a4,'_angz'/
     &               ' BEGIN')
            do frm= 1, MP.nfrm, inc 
              write(2,110) (SgpGCS(i,4,frm,SegNum),i=1,3),
     &                     (SangGCS(i,frm,SegNum),i=1,3)
110           format(2x,6(f12.5,1x))
            end do    
            write(2,119)
119         format(' END')
            do i= 1, 3
              write(2,120) TimeInc,Seg_Names(SegNum),chtrn(i),
     &                     Seg_Names(SegNum),chtrn(i)
            end do
120         format(' X SetScale /P x 0,',f10.6,',"sec", ',a4,a2/
     &             ' X SetScale y 0,0,"m", ',a4,a2 )
            do i= 1, 3
              write(2,121) TimeInc,Seg_Names(SegNum),chang(i),
     &                     Seg_Names(SegNum),chang(i)
            end do
121         format(' X SetScale /P x 0,',f10.6,',"sec", ',a4,a5/
     &             ' X SetScale y 0,0,"deg", ',a4,a5 )
          else
            if ( RegHeader ) write(2,201) Seg_Names(SegNum)
201           format(' Segment position and orientation for ',a4/
     &               ' Position in m     Angles in deg'//
     &               ' Frame',7x,'Center',15x,'Euler Angles'/
     &               '   #  ',4x,'X',7x,'Y',7x,'Z',14x,'Y',7x,'X',7x,'Z'/)
            do frm= 1, MP.nfrm, inc 
              write(2,211) frm,(SgpGCS(i,4,frm,SegNum),i=1,3),
     &                     (SangGCS(i,frm,SegNum),i=1,3)
211           format(2x,i3,2x,6(f10.3,1x))
            end do
          end if                    
        else ! use rotation matrix...
          if ( IgorHeader ) then
            write(2,130) (Seg_Names(SegNum),i=1,12)
130           format(' IGOR'/
     &               ' WAVES ',a4,'_x, ',a4,'_y, ',a4,'_z, ',
     &                         a4,'_r11, ',a4,'_r21, ',a4,'_r31, ',
     &                         a4,'_r12, ',a4,'_r22, ',a4,'_r32, ',
     &                         a4,'_r13, ',a4,'_r23, ',a4,'_r33'/
     &               ' BEGIN')
            do frm= 1, MP.nfrm, inc
              write(2,140) ((SgpGCS(i,j,frm,SegNum),i=1,3),j=1,4)
140           format(2x,12(f10.3,1x))
            end do                    
            write(2,119)
            do i= 1, 3
              write(2,120) TimeInc,Seg_Names(SegNum),chtrn(i),
     &                     Seg_Names(SegNum),chtrn(i)
            end do
            do i= 1, 9
              write(2,150) TimeInc,Seg_Names(SegNum),chrm(i),
     &                     Seg_Names(SegNum),chrm(i)
            end do
150         format(' X SetScale /P x 0,',f10.6,',"sec", ',a4,a4/
     &             ' X SetScale y 0,0,"cos", ',a4,a4 )
          else
            if ( RegHeader ) write(2,200) Seg_Names(SegNum)
200         format(' Segment position and orientation for ',a4/
     &             '  Center in m     Rotation matrix in column order'//
     &             ' Frame',12x,'X',23x,'Y',23x,'Z',23x,'CNTR'/
     &             '   #  ',4x,4('X',7x,'Y',7x,'Z',7x)/)
            do frm= 1, MP.nfrm, inc
              write(2,210) frm,((SgpGCS(i,j,frm,SegNum),i=1,3),j=1,4)
210           format(2x,i3,2x,12(f10.3,1x))
            end do
          end if                    
        end if ! Segment angles or rotation matrix
      end if ! Animate or individual segment
      Error= .false.
      return

1000  write(6,1005)                 
      if ( OF.ToLog ) write(3,1005)
1005  format(' Error- Segment positions have not been calculated yet')        
      return
                              
1010  write(6,1015)                 
      if ( OF.ToLog ) write(3,1015)
1015  format(' Error- Segment angles have not been calculated yet')
      return
      end
c
c
c
c
c     Copyright by Dwight Meglan 1990
c
      subroutine ExpSegPosErnie( inc,numrep,zplv,mrkr,SF,OF,error )
      implicit none
      
      include 'a_const.inc'
      include 'a_struct.inc'
      include 'a_prm.inc'  
      include 'a_names.inc'
      include 'a_mrk.inc'
      include 'a_seg.inc'
      
      record /segment_flag/ SF
      record /option_flag/  OF
       
      integer*4 inc,numrep
      logical*4 error,zplv,mrkr
                                                                              
      integer*4 frm,seg,i,j,k,rep
      real*4    eprm(4),timeinc
      logical*4 rxplv              
                                   
      error= .true.
      if ( .not. SF.position ) goto 1000 ! error
      TimeInc= float(inc)/rMtnFrmRate
      k= 0
c
c     check for zeroing of forward motion by removing pelvis x travel
c
      rxplv= .false.                                                          
      if ( zplv ) then
        do i= 1, GP.num_seg
          if ( GP.seg_num(i) .eq. pelv ) rxplv= .true.
        end do
      end if
      do rep= 1, numrep
        do frm= 1, MP.nfrm,inc
          write(2,100) k,float(frm-1)*timeinc+(rep-1)*timeinc*float(MP.nfrm)
100       format(1x,i4,1x,f12.6)
          do i= 1, GP.num_seg
            seg= GP.seg_num(i)
            call RMtoEP( SgpGCS(1,1,frm,seg),ep,error )
            if ( error ) goto 1010
            if ( rxplv ) then
              write(2,110) SgpGCS(1,cntr,frm,seg)-SgpGCS(1,cntr,frm,pelv),
     &                     (SgpGCS(j,cntr,frm,seg),j=2,3),(eprm(j),j=1,4)
            else
              write(2,110) (SgpGCS(j,cntr,frm,seg),j=1,3),(eprm(j),j=1,4)
110           format(1x,7(1x,e12.5))
            end if    
          end do
          if ( mrkr ) then
            do i= 1, MP.num_mrk
              write(2,110) (MrkData(j,frm,i),j=1,3),0.0,0.0,0.0,0.0
            end do
          end if
          write(2,120)
120       format(/)
          k= k + 1  
        end do
      end do
      error= .false.
      return

1000  write(6,1005)                 
      if ( OF.ToLog ) write(3,1005)
1005  format(' Error- Segment positions have not been calculated yet')        
      return               
                              
1010  write(6,1015) frm,seg_names(seg)
      if ( OF.ToLog ) write(3,1015)
1015  format(' Error- Calculation of euler parameters failed at frame # ',i4/
     &       '        of the segment ',a4)
      return
      end
c        
c
c
c
c     Copyright by Dwight Meglan 1990
c
      subroutine ExpSegVel( inc,RegHeader,IgorHeader,CSType,SegNum,
     &                      SF,OF,error ) 
      implicit none

      include 'a_const.inc'
      include 'a_struct.inc'
      include 'a_prm.inc'
      include 'a_names.inc'
      include 'a_seg.inc'
      
      record /segment_flag/ SF
      record /option_flag/  OF
      
      integer*4 SegNum,inc,CSType
      logical*4 Error,RegHeader,IgorHeader

      integer*4 frm,i
      real*4    TimeInc
      character chvlg(6)*4,chvll(6)*4

      data chvlg /'_vgx','_vgy','_vgz','_wgx','_wgy','_wgz'/
      data chvll /'_vlx','_vly','_vlz','_wlx','_wly','_wlz'/

      Error= .true.
      if ( .not. SF.vel_acc ) goto 1000 ! error
      TimeInc= float(inc)/rMtnFrmRate
      if ( CSType .eq. GCS_CS ) then
        if ( IgorHeader ) then
          write(2,100) (Seg_Names(SegNum),i=1,6)
100         format(' IGOR'/
     &             ' WAVES ',a4,'_vgx, ',a4,'_vgy, ',a4,'_vgz, ',
     &                       a4,'_wgx, ',a4,'_wgy, ',a4,'_wgz'/
     &             ' BEGIN')
          do frm= 1, MP.nfrm, inc
            write(2,110) (SvlGCS(i,frm,SegNum),i=1,6)
110         format(2x,6(e13.5))
          end do    
          write(2,119)
119       format(' END')
          do i= 1, 6                
            write(2,120) TimeInc,Seg_Names(SegNum),chvlg(i),
     &                   Seg_Names(SegNum),chvlg(i)
          end do
120       format(' X SetScale /P x 0,',f10.6,',"sec", ',a4,a4/
     &           ' X SetScale y 0,0,"m/s", ',a4,a4 )
        else
          if ( RegHeader ) write(2,130) Seg_Names(SegNum)
130       format(' Segment velocity in GCS for ',a4//
     &           ' Translation : m/s'/
     &           ' Rotation    : rad/sec'//
     &           ' Frame ',6x,'X',11x,'Y',11x,'Z',10x,'RX',10x,'RY',10x,'RZ'/)
          do frm= 1, MP.nfrm, inc
            write(2,140) frm,(SvlGCS(i,frm,SegNum),i=1,6)
140         format(2x,i3,2x,6(e13.5))
          end do 
        end if                   
      else ! then export LCS velocity....
        if ( IgorHeader ) then
          write(2,150) (Seg_Names(SegNum),i=1,6)
150         format(' IGOR'/
     &             ' WAVES ',a4,'_vlx, ',a4,'_vly, ',a4,'_vlz, ',
     &                       a4,'_wlx, ',a4,'_wly, ',a4,'_wlz'/
     &             ' BEGIN')
          do frm= 1, MP.nfrm, inc
            write(2,110) (SvlLCS(i,frm,SegNum),i=1,6)
          end do                    
          write(2,119)
          do i= 1, 6
            write(2,120) TimeInc,Seg_Names(SegNum),chvll(i),
     &                   Seg_Names(SegNum),chvll(i)
          end do
        else
          if ( RegHeader ) write(2,170) Seg_Names(SegNum)
170       format(' Segment velocity in LCS for ',a4//
     &           ' Translation : m/s'/
     &           ' Rotation    : rad/sec'//
     &           ' Frame ',6x,'X',11x,'Y',11x,'Z',10x,'RX',10x,'RY',10x,'RZ'/)
          do frm= 1, MP.nfrm, inc
            write(2,140) frm,(SvlLCS(i,frm,SegNum),i=1,6)
          end do 
        end if                   
      end if
      Error= .false.
      return
      
1000  write(6,1005)                 
      if ( OF.ToLog ) write(3,1005)
1005  format(' Error- Segment velocities have not been calculated yet')
      return
      end
c
c
c
c
c     Copyright by Dwight Meglan 1990
c
      subroutine ExpSegAcc( inc,RegHeader,IgorHeader,CSType,SegNum,
     &                      SF,OF,error ) 
      implicit none

      include 'a_const.inc'
      include 'a_struct.inc'
      include 'a_prm.inc'
      include 'a_names.inc'
      include 'a_seg.inc'
      
      record /segment_flag/ SF
      record /option_flag/  OF
      
      integer*4 SegNum,inc,CSType
      logical*4 Error,RegHeader,IgorHeader

      integer*4 frm,i
      real*4    TimeInc
      character chacg(6)*5,chacl(6)*5

      data chacg /'_agx ','_agy ','_agz ','_aagx','_aagy','_aagz'/
      data chacl /'_alx ','_aly ','_alz ','_aalx','_aaly','_aalz'/

      Error= .true.
      if ( .not. SF.vel_acc ) goto 1000 ! error
      TimeInc= float(inc)/rMtnFrmRate
      if ( CSType .eq. GCS_CS ) then
        if ( IgorHeader ) then
          write(2,100) (Seg_Names(SegNum),i=1,6)
100         format(' IGOR'/
     &             ' WAVES ',a4,'_agx, ',a4,'_agy, ',a4,'_agz, ',
     &                       a4,'_aagx, ',a4,'_aagy, ',a4,'_aagz'/
     &             ' BEGIN')
          do frm= 1, MP.nfrm, inc
            write(2,110) (SacGCS(i,frm,SegNum),i=1,6)
110         format(2x,6(e13.5))
          end do                    
          write(2,119)
119       format(' END' )
          do i= 1, 6
            write(2,120) TimeInc,Seg_Names(SegNum),chacg(i),
     &                   Seg_Names(SegNum),chacg(i)
          end do
120       format(' X SetScale /P x 0,',f10.6,',"sec", ',a4,a5/
     &           ' X SetScale y 0,0,"ms2", ',a4,a5 )
        else
          if ( RegHeader ) write(2,130) Seg_Names(SegNum)
130       format(' Segment acceleration in GCS for ',a4//
     &           ' Translation : m/s^2'/
     &           ' Rotation    : rad/sec^2'//
     &           ' Frame ',6x,'X',11x,'Y',11x,'Z',10x,'RX',10x,'RY',10x,'RZ'/)
          do frm= 1, MP.nfrm, inc
            write(2,140) frm,(SacGCS(i,frm,SegNum),i=1,6)
140         format(2x,i3,2x,6(e13.5))
          end do
        end if                    
      else ! then export LCS acceleration....
        if ( IgorHeader ) then
          write(2,150) (Seg_Names(SegNum),i=1,6)
150         format(' IGOR'/
     &             ' WAVES ',a4,'_alx, ',a4,'_aly, ',a4,'_alz, ',
     &                       a4,'_aalx, ',a4,'_aaly, ',a4,'_aalz'/
     &             ' BEGIN')
          do frm= 1, MP.nfrm, inc
            write(2,110) (SacLCS(i,frm,SegNum),i=1,6)
          end do                    
          write(2,119)
          do i= 1, 6
            write(2,120) TimeInc,Seg_Names(SegNum),chacl(i),
     &                   Seg_Names(SegNum),chacl(i)
          end do
        else
          if ( RegHeader ) write(2,170) Seg_Names(SegNum)
170       format(' Segment acceleration in LCS for ',a4//
     &           ' Translation : m/s^2'/
     &           ' Rotation    : rad/sec^2'//
     &           ' Frame ',6x,'X',11x,'Y',11x,'Z',10x,'RX',10x,'RY',10x,'RZ'/)
          do frm= 1, MP.nfrm, inc
            write(2,140) frm,(SacLCS(i,frm,SegNum),i=1,6)
          end do                    
        end if
      end if
      Error= .false.
      return
      
1000  write(6,1005)                 
      if ( OF.ToLog ) write(3,1005)
1005  format(' Error- Segment acceleration has not been calculated yet')
      return
      end
c
c
c
c
c     Copyright by Dwight Meglan 1990
c
      subroutine ExpSegAng( inc,RegHeader,IgorHeader,SegNum,
     &                      SF,OF,error ) 
      implicit none

      include 'a_const.inc'
      include 'a_struct.inc'
      include 'a_prm.inc'
      include 'a_names.inc'
      include 'a_seg.inc'
      
      record /segment_flag/ SF
      record /option_flag/  OF
      
      integer*4 SegNum,inc
      logical*4 Error,RegHeader,IgorHeader

      character chax(3)*1
      integer*4 frm,i
      real*4    TimeInc

      data chax / 'y','x','z' /

      Error= .true.
      if ( .not. SF.angle ) goto 1000 ! error
      TimeInc= float(inc)/rMtnFrmRate
      if ( IgorHeader ) then
        write(2,100) (Seg_Names(SegNum),i=1,3)
100       format(' IGOR'/
     &           ' WAVES ',a4,'_angy, ',a4,'_angx, ',a4,'_angz'/
     &           ' BEGIN')
        do frm= 1, MP.nfrm, inc
          write(2,110) (SangGCS(i,frm,SegNum),i=1,3)
110       format(2x,3(f9.3))
        end do         
        write(2,119)
119     format(' END')
        do i= 1, 3           
          write(2,120) TimeInc,Seg_Names(SegNum),chax(i),
     &                 Seg_Names(SegNum),chax(i)
        end do
120     format(' X SetScale /P x 0,',f10.6,',"sec", ',a4,'_ang',a1/
     &         ' X SetScale y 0,0,"deg", ',a4,'_ang',a1)
      else 
        if ( RegHeader ) write(2,130) Seg_Names(SegNum)
130     format(' Segment YXZ euler angle relative to GCS for ',a4/
     &         ' Angles in degrees'//
     &         ' Frame',6x,'Y',8x,'X',8x,'Z'//)
        do frm= 1, MP.nfrm, inc
          write(2,140) frm,(SangGCS(i,frm,SegNum),i=1,3)
140       format(2x,i4,2x,3(f9.3))
        end do 
      end if
      Error= .false.
      return

1000  write(6,1005)                 
      if ( OF.ToLog ) write(3,1005)
1005  format(' Error- Segment angle has not been calculated yet')
      return
      end                         
c
c
c
c
c     Copyright by Dwight Meglan 1990
c
      subroutine ExpSegEnergy( inc,RegHeader,IgorHeader,BodyTotal,
     &                         SegNum,SF,OF,error ) 
      implicit none

      include 'a_const.inc'
      include 'a_struct.inc'
      include 'a_prm.inc'
      include 'a_names.inc'
      include 'a_enr.inc'
      
      record /segment_flag/ SF
      record /option_flag/  OF
      
      integer*4 SegNum,inc
      logical*4 Error,RegHeader,IgorHeader,BodyTotal

      integer*4 frm,i
      real*4    TimeInc

      Error= .true.
      if ( .not. SF.energy ) goto 1000 ! error
      TimeInc= float(inc)/rMtnFrmRate
      if ( BodyTotal ) then
        if ( IgorHeader ) then
          write(2,100) 
100       format(' IGOR'/
     &           ' WAVES BodyKE_t, BodyKE_r, BodyKE_m,  BodyPE, BodyTE'/
     &           ' BEGIN')
          do frm= 1, MP.nfrm, inc
            write(2,110) (BodyKE(i,frm),i=1,3),BodyPE(frm),BodyTE(frm)
110         format(2x,5(e13.5))
          end do                    
          write(2,120) (TimeInc,i=1,5)
120       format(' END'/
     &           ' X SetScale /P x 0,',f10.6,',"sec", BodyKE_t'/
     &           ' X SetScale y 0,0,"Nm", BodyKE_t'/
     &           ' X SetScale /P x 0,',f10.6,',"sec", BodyKE_r'/
     &           ' X SetScale y 0,0,"Nm", BodyKE_r'/
     &           ' X SetScale /P x 0,',f10.6,',"sec", BodyKE_m'/
     &           ' X SetScale y 0,0,"Nm", BodyKE_m'/
     &           ' X SetScale /P x 0,',f10.6,',"sec", BodyPE'/
     &           ' X SetScale y 0,0,"Nm", BodyPE'/
     &           ' X SetScale /P x 0,',f10.6,',"sec", BodyTE'/
     &           ' X SetScale y 0,0,"Nm", BodyTE')
        else
          if ( RegHeader ) write(2,130) 
130       format(' Total body kinetic, potential and summed energy'/
     &           ' Energy in units of Nm'/
     &           ' Kinetic energy components are relative to segment LCS'//
     &           ' Frame ',4x,'KE_Trn',4x,'KE_Rot',4x,'KE_Mag',5x,'PE',8x,'TE'/)
          do frm= 1, MP.nfrm, inc
            write(2,140) frm,(BodyKE(i,frm),i=1,3),BodyPE(frm),BodyTE(frm)
140         format(2x,i3,2x,5(e13.5,1x))
          end do
        end if
      else ! segment energy
        if ( IgorHeader ) then
          write(2,150) (seg_names(SegNum),i=1,5)
150         format(' IGOR'/
     &             ' WAVES ',a4,'_KEt, ',a4,'_KEr, ',a4,'_KEm, ',
     &                       a4,'_PE, ',a4,'_TE'/
     &             ' BEGIN')
          do frm= 1, MP.nfrm, inc
            write(2,110) (SegKE(i,frm,SegNum),i=1,3),
     &                   SegPE(frm,SegNum),SegTE(frm,SegNum)
          end do                    
          write(2,160) (TimeInc,
     &                  seg_names(SegNum),seg_names(SegNum),i=1,5)
160       format(' END'/
     &           ' X SetScale /P x 0,',f10.6,',"sec", ',a4,'_KEt'/
     &           ' X SetScale y 0,0,"Nm", ',a4,'_KEt'/
     &           ' X SetScale /P x 0,',f10.6,',"sec", ',a4,'_KEr'/
     &           ' X SetScale y 0,0,"Nm", ',a4,'_KEr'/
     &           ' X SetScale /P x 0,',f10.6,',"sec", ',a4,'_KEm'/
     &           ' X SetScale y 0,0,"Nm", ',a4,'_KEm'/
     &           ' X SetScale /P x 0,',f10.6,',"sec", ',a4,'_PE'/
     &           ' X SetScale y 0,0,"Nm", ',a4,'_PE'/
     &           ' X SetScale /P x 0,',f10.6,',"sec", ',a4,'_TE'/
     &           ' X SetScale y 0,0,"Nm", ',a4,'_TE')
        else
          if ( RegHeader ) write(2,170) seg_names(SegNum)
170       format(' Segment kinetic, potential and summed energy for ',a4/
     &           ' Energy in units of Nm'/
     &           ' Kinetic energy components are relative to segment LCS'//
     &           ' Frame ',4x,'KE_Trn',4x,'KE_Rot',4x,'KE_Mag',5x,'PE',8x,'TE'/)
          do frm= 1, MP.nfrm, inc
            write(2,140) frm,(SegKE(i,frm,SegNum),i=1,3),
     &                   SegPE(frm,SegNum),SegTE(frm,SegNum)
          end do
        end if
      end if                    
      Error= .false.
      return
      
1000  write(6,1005)                 
      if ( OF.ToLog ) write(3,1005)
1005  format(' Error- Segment energy has not been calculated yet')
      return
      end
c
c
c
c
c     Copyright by Dwight Meglan 1990
c
      subroutine ExpSegFinScrew( inc,RegHeader,IgorHeader,SegNum,
     &                           SF,OF,error ) 
      implicit none

      include 'a_const.inc'
      include 'a_struct.inc'
      include 'a_prm.inc'
      include 'a_names.inc'
      include 'a_seg.inc'
      
      record /segment_flag/ SF
      record /option_flag/  OF
      
      integer*4 SegNum,inc
      logical*4 Error,RegHeader,IgorHeader

      integer*4 frm,i
      real*4    TimeInc
      character SegText*8,chscr(8)*3

      data chscr / 'nx ','ny ','nz ','px ','py ','pz ','ang','trn' /

      Error= .true.
      if ( .not. SF.FiniteScrew ) goto 1000 ! error
      TimeInc= float(inc)/rMtnFrmRate
      SegText= Seg_Names(SegNum)//'_fs_'
      if ( IgorHeader ) then
        write(2,100) (SegText,i=1,8)
100     format(' IGOR'/
     &         ' WAVES ',a8,'nx, ',a8,'ny, ',a8,'nz, ',
     &                   a8,'px, ',a8,'py, ',a8,'pz, ',
     &                   a8,'ang, ',a8,'trn'/
     &         ' BEGIN')
        do frm= 1, MP.nfrm, inc
          write(2,110) (SgFinScrGCS(i,frm,SegNum),i=1,8)
110       format(2x,8(e13.5))
        end do    
        write(2,119)
119     format(' END') 
        do i= 1, 8               
          write(2,120) TimeInc,SegText,chscr(i),SegText,chscr(i)
        end do
120     format(' X SetScale /P x 0,',f10.6,',"sec", ',a8,a3/
     &         ' X SetScale y 0,0,"cos", ',a8,a3 )
      else 
        if ( RegHeader ) write(2,130) Seg_Names(SegNum)
130     format(' Segment Finite Screw relative to GCS for ',a4/
     &         ' (nx, ny, nz) : Direction cosines of screw axis'/
     &         ' (px, py, pz) : Point on the screw axis (m)'/
     &         ' angle        : Rotation about screw axis (deg)'/
     &         ' trans        : Translation along screw axis (m)'//
     &         ' Frame',6x,'nx',8x,'ny',8x,'nz',8x,'px',8x,'py',8x,'pz',
     &          6x,'angle',4x,'trans'//)
        do frm= 1, MP.nfrm, inc
          write(2,140) frm,(SgFinScrGCS(i,frm,SegNum),i=1,8)
140       format(2x,i4,2x,8(e13.5))
        end do 
      end if
      Error= .false.
      return

1000  write(6,1005)                 
      if ( OF.ToLog ) write(3,1005)
1005  format(' Error- Segment Finite Screw has not been calculated yet')
      return
      end                         
c
c
c
c
c     Copyright by Dwight Meglan 1990
c
      subroutine ExpSegInsScrew( inc,RegHeader,IgorHeader,SegNum,
     &                           SF,OF,error ) 
      implicit none

      include 'a_const.inc'
      include 'a_struct.inc'
      include 'a_prm.inc'
      include 'a_names.inc'
      include 'a_seg.inc'
      
      record /segment_flag/ SF
      record /option_flag/  OF
      
      integer*4 SegNum,inc
      logical*4 Error,RegHeader,IgorHeader

      integer*4 frm,i
      real*4    TimeInc
      character SegText*8,chscr(8)*3

      data chscr / 'nx ','ny ','nz ','px ','py ','pz ','ang','trn' /

      Error= .true.
      if ( .not. SF.InstantScrew ) goto 1000 ! error
      TimeInc= float(inc)/rMtnFrmRate
      SegText= Seg_Names(SegNum)//'_is_'
      if ( IgorHeader ) then
        write(2,100) (SegText,i=1,8)
100     format(' IGOR'/
     &         ' WAVES ',a8,'nx, ',a8,'ny, ',a8,'nz, ',
     &                   a8,'px, ',a8,'py, ',a8,'pz, ',
     &                   a8,'ang, ',a8,'trn'/
     &         ' BEGIN')
        do frm= 1, MP.nfrm, inc
          write(2,110) (SgInsScrGCS(i,frm,SegNum),i=1,8)
110       format(2x,8(e13.5))
        end do                    
        write(2,119)
119     format(' END') 
        do i= 1, 8               
          write(2,120) TimeInc,SegText,chscr(i),SegText,chscr(i)
        end do
120     format(' X SetScale /P x 0,',f10.6,',"sec", ',a8,a3/
     &         ' X SetScale y 0,0,"cos", ',a8,a3 )
      else 
        if ( RegHeader ) write(2,130) Seg_Names(SegNum)
130     format(' Segment Instantaneous Screw relative to GCS for ',a4/
     &         ' (nx, ny, nz) : Direction cosines of screw axis'/
     &         ' (px, py, pz) : Point on the screw axis (m)'/
     &         ' angle        : Rotation about screw axis (deg/s)'/
     &         ' trans        : Translation along screw axis (m/s)'//
     &         ' Frame',6x,'nx',8x,'ny',8x,'nz',8x,'px',8x,'py',8x,'pz',
     &          6x,'angle',4x,'trans'//)
        do frm= 1, MP.nfrm, inc
          write(2,140) frm,(SgInsScrGCS(i,frm,SegNum),i=1,8)
140       format(2x,i4,2x,8(e13.5))
        end do 
      end if
      Error= .false.
      return

1000  write(6,1005)                 
      if ( OF.ToLog ) write(3,1005)
1005  format(' Error- Segment Instantaneous Screw has not been calculated yet')
      return
      end                         
c
c
c
c
c     Copyright by Dwight Meglan 1990
c
      subroutine ExpSegMom( inc,RegHeader,IgorHeader,BodyTotal,
     &                      SegNum,SF,OF,error ) 
      implicit none

      include 'a_const.inc'
      include 'a_struct.inc'
      include 'a_prm.inc'
      include 'a_names.inc'
      include 'a_seg.inc'
      
      record /segment_flag/ SF
      record /option_flag/  OF
      
      integer*4 SegNum,inc
      logical*4 Error,RegHeader,IgorHeader,BodyTotal

      integer*4 frm,i
      real*4    TimeInc
      character SegText*8,chmom(8)*3

      data chmom / 'tx ','ty ','tz ','rx ','ry ','rz ','trn','rot' /

      Error= .true.
      if ( .not. SF.momentum ) goto 1000 ! error
      TimeInc= float(inc)/rMtnFrmRate
      if ( BodyTotal ) then
        if ( IgorHeader ) then
          write(2,100) 
100         format(' IGOR'/
     &             ' WAVES bmom_tx, bmom_ty, bmom_tz, ',
     &                    'bmom_rx, bmom_ry, bmom_rz, ',
     &                    'bmom_trn, bmom_rot'/
     &             ' BEGIN')
          do frm= 1, MP.nfrm, inc
            write(2,110) (BdMom(i,frm),i=1,8)
110         format(2x,8(e13.5))
          end do                    
          write(2,120) (TimeInc,i=1,8)
120       format(' END'/
     &           ' X SetScale /P x 0,',f10.6,',"sec", bmom_tx'/
     &           ' X SetScale y 0,0,"Ns", bmom_tx'/
     &           ' X SetScale /P x 0,',f10.6,',"sec", bmom_ty'/
     &           ' X SetScale y 0,0,"Ns", bmom_ty'/
     &           ' X SetScale /P x 0,',f10.6,',"sec", bmom_tz'/
     &           ' X SetScale y 0,0,"Ns", bmom_tz'/
     &           ' X SetScale /P x 0,',f10.6,',"sec", bmom_rx'/
     &           ' X SetScale y 0,0,"Nms", bmom_rx'/
     &           ' X SetScale /P x 0,',f10.6,',"sec", bmom_ry'/
     &           ' X SetScale y 0,0,"Nms", bmom_ry'/
     &           ' X SetScale /P x 0,',f10.6,',"sec", bmom_rz'/
     &           ' X SetScale y 0,0,"Nms", bmom_rz'/
     &           ' X SetScale /P x 0,',f10.6,',"sec", bmom_trn'/
     &           ' X SetScale y 0,0,"Ns", bmom_trn'/
     &           ' X SetScale /P x 0,',f10.6,',"sec", bmom_rot'/
     &           ' X SetScale y 0,0,"Nms", bmom_rot')
        else
          if ( RegHeader ) write(2,130) 
130       format(' Total body momentum'/
     &           ' (tx, ty, tz) : Translational momentum components (Ns)'/
     &           ' (rx, ry, rz) : Rotational momentum components (Nms)'/
     &           ' trans        : Magnitude of translational momentum'/
     &           ' rot          : Magnitude of rotational momentum'/
     &           ' Momentum is expressed relative segment LCS'//
     &           ' frame',7x,'tx',11x,'ty',11x,'tz',11x,
     &           'rx',11x,'ry',11x,'rz',10x,'trans',7x,'rot'/)
          do frm= 1, MP.nfrm, inc
            write(2,140) frm,(BdMom(i,frm),i=1,8)
140         format(2x,i4,2x,8(e13.5))
          end do                    
       end if
      else ! segment momentum...
        if ( IgorHeader ) then
          SegText= seg_names(SegNum)//'_Mom'
          write(2,150) (SegText,i=1,8)
150         format(' IGOR'/
     &             ' WAVES ',a8,'Tx, ',a8,'Ty, ',a8,'Tz, ',
     &                       a8,'Rx, ',a8,'Ry, ',a8,'Rz, ',
     &                       a8,'Trn, ',a8,'Rot'/
     &             ' BEGIN')
          do frm= 1, MP.nfrm, inc
            write(2,110) (SgMom(i,frm,SegNum),i=1,8)
          end do                    
          write(2,159)
159       format(' END')
          do i= 1, 8
            write(2,160) TimeInc,SegText,chmom(i),SegText,chmom(i)
          end do
160       format(' X SetScale /P x 0,',f10.6,',"sec", ',a8,a3/
     &           ' X SetScale y 0,0,"Ns", ',a8,a3 )
        else
          if ( RegHeader ) write(2,170) seg_names(SegNum)
170       format(' Segment momentum for ',a4/
     &           ' (tx, ty, tz) : Translational momentum components (Ns)'/
     &           ' (rx, ry, rz) : Rotational momentum components (Nms)'/
     &           ' trans        : Magnitude of translational momentum'/
     &           ' rot          : Magnitude of rotational momentum'/
     &           ' Momentum is expressed relative segment LCS'//
     &           ' frame',7x,'tx',11x,'ty',11x,'tz',11x,
     &           'rx',11x,'ry',11x,'rz',10x,'trans',7x,'rot'/)
          do frm= 1, MP.nfrm, inc
            write(2,140) frm,(SgMom(i,frm,SegNum),i=1,8)
          end do                    
       end if
      end if
      Error= .false.
      return
      
1000  write(6,1005)                 
      if ( OF.ToLog ) write(3,1005)
1005  format(' Error- Segment momentum has not been calculated yet')
      return
      end                         
c
c
c
c
c     Copyright by Dwight Meglan 1990
c
      subroutine ExpBodyCM( inc,RegHeader,IgorHeader,
     &                      SF,OF,error ) 
      implicit none

      include 'a_const.inc'
      include 'a_struct.inc'
      include 'a_prm.inc'
      include 'a_names.inc'
      include 'a_seg.inc'
      
      record /segment_flag/ SF
      record /option_flag/  OF
      
      integer*4 inc
      logical*4 Error,RegHeader,IgorHeader

      integer*4 frm,i
      real*4    TimeInc

      Error= .true.
      if ( .not. SF.cntr_mass ) goto 1000 ! error
      TimeInc= float(inc)/rMtnFrmRate
      if ( IgorHeader ) then
        write(2,100) 
100       format(' IGOR'/
     &           ' WAVES bcm_x, bcm_y, bcm_z'/
     &           ' BEGIN')
        do frm= 1, MP.nfrm, inc
          write(2,110) (BodyCM(i,frm),i=1,3)
110       format(2x,3(f9.3))
        end do                    
        write(2,120) (TimeInc,i=1,3)
120     format(' END'/
     &         ' X SetScale /P x 0,',f10.6,',"sec", bcm_x'/
     &         ' X SetScale y 0,0,"m", bcm_x'/
     &         ' X SetScale /P x 0,',f10.6,',"sec", bcm_y'/
     &         ' X SetScale y 0,0,"m", bcm_y'/
     &         ' X SetScale /P x 0,',f10.6,',"sec", bcm_z'/
     &         ' X SetScale y 0,0,"m", bcm_z')
      else 
        if ( RegHeader ) write(2,130) 
130     format(' Body center of mass relative to GCS'/
     &         ' Position in meters'//
     &         ' Frame',6x,'X',8x,'Y',8x,'Z'//)
        do frm= 1, MP.nfrm, inc
          write(2,140) frm,(BodyCM(i,frm),i=1,3)
140       format(2x,i4,2x,3(f9.3))
        end do 
      end if
      Error= .false.
      return

1000  write(6,1005)                 
      if ( OF.ToLog ) write(3,1005)
1005  format(' Error- Body center of mass has not been calculated yet')
      return
      end                         
c
c
c
c
c     Copyright by Dwight Meglan 1990
c
      subroutine ExpBodyCMVel( inc,RegHeader,IgorHeader,
     &                         SF,OF,error ) 
      implicit none

      include 'a_const.inc'
      include 'a_struct.inc'
      include 'a_prm.inc'
      include 'a_names.inc'
      include 'a_seg.inc'
      
      record /segment_flag/ SF
      record /option_flag/  OF
      
      integer*4 inc
      logical*4 Error,RegHeader,IgorHeader

      integer*4 frm,i
      real*4    TimeInc

      Error= .true.
      if ( .not. SF.BCMVel ) goto 1000 ! error
      TimeInc= float(inc)/rMtnFrmRate
      if ( IgorHeader ) then
        write(2,100) 
100       format(' IGOR'/
     &           ' WAVES bcm_vx, bcm_vy, bcm_vz'/
     &           ' BEGIN')
        do frm= 1, MP.nfrm, inc
          write(2,110) (BCMVel(i,frm),i=1,3)
110       format(2x,3(f9.3))
        end do                    
        write(2,120) (TimeInc,i=1,3)
120     format(' END'/
     &         ' X SetScale /P x 0,',f10.6,',"sec", bcm_vx'/
     &         ' X SetScale y 0,0,"m/s", bcm_vx'/
     &         ' X SetScale /P x 0,',f10.6,',"sec", bcm_vy'/
     &         ' X SetScale y 0,0,"m/s", bcm_vy'/
     &         ' X SetScale /P x 0,',f10.6,',"sec", bcm_vz'/
     &         ' X SetScale y 0,0,"m/s", bcm_vz')
      else 
        if ( RegHeader ) write(2,130) 
130     format(' Body center of mass velocity relative to GCS'/
     &         ' Velocity in meters per second'//
     &         ' Frame',5x,'VX',7x,'VY',7x,'VZ'//)
        do frm= 1, MP.nfrm, inc
          write(2,140) frm,(BCMVel(i,frm),i=1,3)
140       format(2x,i4,2x,3(f9.3))
        end do 
      end if
      Error= .false.
      return

1000  write(6,1005)                 
      if ( OF.ToLog ) write(3,1005)
1005  format(' Error- Body center of mass velocity has not been calculated yet')
      return
      end                         
