C**********************************************************************
C PROGRAM TO CALCULATE delta-G# or BACK CALCULATE Tc OF NMR COALESCENSE
C   H.Kessler, Angew. Chem., 82, 237 (1970).   (modified)
C**********************************************************************
        INTEGER OPT,TCI1,TCI2,TCC,TCE
        REAL DELNEU,TC,DELG,DIFF,ACS1,ACS2,DELG1,DELG2,DELGE
1       WRITE(*,*)' PLEASE TYPE YOUR CHOICE:' 
        WRITE(*,*)' (0 = Tc BACK CALC.; 9 = QUIT; OTHERS = delta-G#)'
        READ(*,'(I1)')OPT
        IF (OPT.EQ.9) STOP
        IF (OPT.EQ.0) GOTO 1000
C**********************************************************************
2       WRITE(*,*)' PLEASE INPUT delta-NEU (in Hz); [0 for STOP]'
        READ(*,*)DELNEU
        IF (DELNEU.EQ.0) STOP
        WRITE(*,*) 'PLEASE INPUT Tc (in K):'
        READ(*,*)TC
        DELG=1.987*TC*(23+LOG(TC/DELNEU))
        TC1=TC-2.0
        TC2=TC+2.0
        DELG1=1.987*TC1*(23+LOG(TC1/DELNEU))
        DELG2=1.987*TC2*(23+LOG(TC2/DELNEU))
        DELGE=ABS(DELG-DELG1)+ABS(DELG-DELG2)
        DELGE=DELGE/2000
        DELG=DELG/1000
        WRITE(*,10)DELG,DELGE
10      FORMAT(/' delta-G# = ',F6.3,' +- ',F3.1,'  KCal/mole' /)
        GOTO 2
1000    WRITE(*,*)' PLEASE INPUT delta-NEU (in Hz); [0 for STOP]'
        READ(*,*)DELNEU
        IF (DELNEU.EQ.0) STOP
        WRITE(*,*)' PLEASE INPUT delta-G# (in KCal/mole):' 
        READ(*,*)DELG
        DELG=1000*DELG
        DO 1100 TCI1=100,600
        ACS1=1.987*TCI1*(23+LOG(TCI1/DELNEU))
        DIFF=ABS(DELG-ACS1)
        IF(DIFF.LE.300) GOTO 1200
1100    CONTINUE
        WRITE(*,*)' NO POSSIBLE Tc WITHIN 600 K !!!'
        GOTO 1000
1200    CONTINUE
        DO 1300 TCI2=600,100,-1
        ACS2=1.987*TCI2*(23+LOG(TCI2/DELNEU))
        DIFF=ABS(DELG-ACS2)
        IF(DIFF.LE.300) GOTO 1400
1300    CONTINUE
1400    CONTINUE
        TCC=(TCI1+TCI2)/2.0
        TCE=ABS(TCC-TCI1)
        WRITE(*,20)TCC,TCE
20      FORMAT(' POSSIBLE  Tc = ',I5,' +- ',I2,'  K')
        GOTO 1000
        END
C**********************************************************************