! Copyright (C) 1997-1998 by Mario Carpino (carpino@brera.mi.astro.it)  
! Version: June 21, 1998                                                
! Version December 18, 1998 Steven Chesley (chesley@dm.unipi.it)        
! Added ELTYPE, Changed time field to F13.4 to handle jpleph406         
! --------------------------------------------------------------------- 
!                                                                       
!  *****************************************************************    
!  *                                                               *    
!  *                         W R O 1 L R                           *    
!  *                                                               *    
!  *  Writes an orbital element record in an orbital element file  *    
!  *   (single-line format, different epochs, keplerian elements)  *    
!  *                     (multi-line format)                       *    
!  *                                                               *    
!  *****************************************************************    
!                                                                       
! OUTPUT:   UNIT      -  Output FORTRAN unit                            
!           NAME      -  Name of planet/asteroid/comet                  
!           ELEM(6)   -  Orbital element vector (keplerian elements)    
!           ELTYPE    -  Type of orbital elements (KEP/EQU/CAR)         
!           T0        -  Epoch of orbital elements (MJD, TDT)           
!           H         -  H absolute magnitude (if <-100, missing)       
!           G         -  G slope parameter                              
!                                                                       
! WARNING: the routine does not write the header of the file: this      
!          must be generated by calling subroutine wro1lh               
!                                                                       
SUBROUTINE wro1lr(unit,name,elem,eltype,t0,h,g) 
  USE fund_const
  IMPLICIT NONE
  INTEGER unit 
  DOUBLE PRECISION elem(6),t0,h,g 
  CHARACTER*(*) name,eltype 
! Expected max length of name                                           
  INTEGER, PARAMETER :: namtl=12 
  DOUBLE PRECISION cnvele(6)                                         
  INTEGER ln,nb,i 
  CHARACTER*(namtl) blanks
  INTEGER lench 
  EXTERNAL lench 
  CHARACTER*80 elefmt 
! Name                                                                  
  ln=MAX(1,lench(name)) 
  nb=MAX(1,namtl-ln) 
  blanks=' ' 
! Convert to degrees 
  cnvele=elem 
  IF(eltype .eq. 'CAR')THEN 
     elefmt='('''''''',A,'''''''',A,1x,F13.6,'//                    &
     &        '6(1x,F17.13),'//                                     &
     &        '2F6.2)'                                                  
  ELSEIF(eltype .eq. 'KEP')THEN 
     cnvele(3:6)=cnvele(3:6)*degrad 
     elefmt='('''''''',A,'''''''',A,F13.6,'//                       &
     &        '1p,6(e25.16),'//                                     &
     &        '0p,2F6.2)'                                               
!        elefmt='('''''''',A,'''''''',A,F13.6,'//                       
!    +        'F16.12,1x,F12.10,4(1x,F12.7),'//                         
!    +        '2F6.2)' 
  ELSEIF(eltype .eq. 'COM')THEN 
     cnvele(3:5)=cnvele(3:5)*degrad 
     elefmt='('''''''',A,'''''''',A,F13.6,'//                       &
     &        '1p,5(e25.16),0p,f14.6,'//                            &
     &        '0p,2F6.2)'                             
  ELSEIF(eltype .eq. 'EQU')THEN 
     cnvele(6)=cnvele(6)*degrad 
     elefmt='('''''''',A,'''''''',A,F13.6,'//                       &
     &        'F16.12,4(1x,f12.9),1x,F12.7,'//                      &
     &        '2F6.2)'                                                  
  ELSEIF(eltype.eq.'ATT')THEN
     WRITE(*,*)' wro1lr: warning, the ATT elelments in  this format have no station code '
     cnvele(1:4)=cnvele(1:4)*degrad
     elefmt='('''''''',A,'''''''',A,F13.6,'//                       &
     &        '1p,6(e25.16),'//                                     &
     &        '0p,2F6.2)'  
  ELSE 
     WRITE(*,*)'*** wro1lr: unsupported coordinate type', eltype
     STOP '*** wro1lr: unsupported coordinate type' 
  ENDIF
! Write                                                                 
  IF(h.GT.-100.d0) THEN 
     WRITE(unit,elefmt) name(1:ln),blanks(1:nb),t0,cnvele,h,g 
  ELSE 
     WRITE(unit,elefmt) name(1:ln),blanks(1:nb),t0,cnvele 
  ENDIF                                                                      
END SUBROUTINE wro1lr
