C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
c   PLANM - Simple calculations from rotational constants
c
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
c   Moments of inertia, planar moments, asymmetry parameters from rotational
c   constants.  Calculation with errors if available.
c
c
C       ver. 4.XIb.1999                           ----- Zbigniew KISIEL -----
C                          __________________________________________________
C                         | Institute of Physics, Polish Academy of Sciences |
C                         | Al.Lotnikow 32/46, Warszawa, POLAND              |
C                         |                             kisiel@ifpan.edu.pl  |
C                         |     http://info.ifpan.edu.pl/~kisiel/prospe.htm  |
C_________________________/--------------------------------------------------
c
C  Modification history:
c
c  4.XI.1999: years of faithful service rewarded with header and date!
c    XIa    : F20.6 formats
c
c----------------------------------------------------------------------------
c
      IMPLICIT REAL*8(A-H,O-Z)
      PARAMETER (CONV=505379.006D0)
C
      WRITE(*,3344)
3344  FORMAT(1X//'  ',76(1H_)/' |',T79,'|'/
     * ' |    PLANM  -  Planar moments etc. from rotational ',
     * 'constants',T79,'|'/
     * ' |',76(1H_),'|'/'  version 4.XIb.1999',T64,'Zbigniew KISIEL'/)
c
c
20    write(*,21)
21    format(1x/20x,'0 = no errors            '/
     *          20x,'1 = constants with errors'/
     *          20x,'2 = EXIT'//
     *          20x,'... ',$)
      read(*,'(i1)',err=20)ierror
      if(ierror.eq.2)goto 8
      if(ierror.ne.1.and.ierror.ne.0)goto 20
c
2     WRITE(*,1)
1     FORMAT(1X/4x,' A, B, C /MHz:  ',$)
      READ(*,*,ERR=2)A,B,C
      if(ierror.eq.1)then
22      write(*,11)
11      format(4x,'dA,dB,dC /MHz:  ',$)
        READ(*,*,ERR=22)dA,dB,dC
      endif
C
      open(3,file='planm.out',access='append')
c
      RIA=CONV/A
      RIB=CONV/B
      RIC=CONV/C
      defect=RIC-RIA-RIB
      if(ierror.eq.1)then
        dria=conv*da/(a*a)
        drib=conv*db/(b*b)
        dric=conv*dc/(c*c)
        ddefec=dsqrt(dria**2+drib**2+dric**2)
      endif
      rkappa=(2.d0*b-a-c)/(a-c)
      bp=(rkappa+1)/(rkappa-3)
      bo=(rkappa-1)/(rkappa+3)
      APLUSB=(A+B)/(2.D0*C)
      BPLUSC= 2.D0*A/(B+C)
C
      PA=0.5D0*(RIB+RIC-RIA)
      PB=0.5D0*(RIA+RIC-RIB)
      PC=0.5D0*(RIA+RIB-RIC)
      if(ierror.eq.1)then
        dpa=0.5d0*dsqrt(dria**2+drib**2+dric**2)
        dpb=dpa
        dpc=dpa
      endif
C
      write(3,'(1x,78(1h-)/)')
      WRITE(*,4)   '   A,   B,   C =  ',A,B,C
      WRITE(3,4)   '   A,   B,   C =  ',A,B,C
      if(ierror.eq.1)then
        write(*,3) '  dA,  dB,  dC =  ',DA,DB,DC
        write(3,3) '  dA,  dB,  dC =  ',DA,DB,DC
      endif
      WRITE(*,4)   '  IA,  IB,  IC =  ',RIA,RIB,RIC
      WRITE(3,4)   '  IA,  IB,  IC =  ',RIA,RIB,RIC
      if(ierror.eq.1)then
        write(*,3) ' dIA, dIB, dIC =  ',DRIA,DRIB,DRIC
        write(3,3) ' dIA, dIB, dIC =  ',DRIA,DRIB,DRIC
      endif
      WRITE(*,4)   '  PA,  PB,  PC =  ',PA,PB,PC
      WRITE(3,4)   '  PA,  PB,  PC =  ',PA,PB,PC
      if(ierror.eq.1)then
        write(*,3) ' dPA, dPB, dPC =  ',DPA,DPB,DPC
        write(3,3) ' dPA, dPB, dPC =  ',DPA,DPB,DPC
      endif
      IF(IERROR.EQ.0)THEN
        WRITE(*,4) 'Inertial Defect=  ',defect
        WRITE(3,4) 'Inertial Defect=  ',defect
      ELSE
        WRITE(*,45)'Inertial Defect=  ',defect,'  +-',ddefec
        WRITE(3,45)'Inertial Defect=  ',defect,'  +-',ddefec
45      FORMAT(1x/1X,A,F20.6,a,F16.6)
      endif
      WRITE(*,44)  '         Kappa =  ',rkappa,
     *             '               b_p =  ',bp
      WRITE(3,44)  '         Kappa =  ',rkappa,
     *             '               b_p =  ',bp
      WRITE(*,33)  '      (A+B)/2C =  ',APLUSB,
     *             '               b_o =  ',bo
      WRITE(3,33)  '      (A+B)/2C =  ',APLUSB,
     *             '               b_o =  ',bo
      WRITE(*,3)   '      2A/(B+C) =  ',BPLUSC
      WRITE(3,3)   '      2A/(B+C) =  ',BPLUSC
3     FORMAT(1X,A,3F20.6)
33    FORMAT(1X,A,F20.6,a,f18.6)
4     FORMAT(1x/1X,A,3F20.6)
44    FORMAT(1x/1X,A,F20.6,a,f18.6)
c
      write(3,'(1x/1x,78(1h-))')
      close(3)
      GOTO 20
C
C
8     STOP
      END
c------------------------------------------------------------------------
c------------------------------------------------------------------------