PROGRAM GNMR
      implicit integer*4 (i-n)
      implicit real*8 (a-h,o-z)
      parameter (np0=100000)
      DIMENSION r(3,300),iz(300)
      CHARACTER*50 FN,FNT
      LOGICAL lzmat
      CHARACTER*1 OK,element,prvek
      dimension spec(np0)
c
      WRITE(*,*)' Full filename of the Gaussian output:'
      READ(*,'(A)')FN
      WRITE(*,*)' Full filename of the NMR table:'
      READ(*,'(A)')FNT
      OPEN(2,FILE=FN)
      OPEN(4,FILE=FNT)
      NG=0
1     READ(2,2000,END=1000)FN
2000  FORMAT(A50)
c 1  H    Isotropic =    18.2408   Anisotropy =    11.5688
c234567890123456789012345678901234567890
      IF(FN(11:21).EQ.'Isotropic =')then
       NG=NG+1
       WRITE(4,20000)FN(1:32),NG
20000  FORMAT(A32,i5)
      ENDIF
      GOTO 1
1000  CLOSE(2)
      CLOSE(4)
      write(*,*)ng,' shieldings found'
c
      if(ng.gt.0)then
       write(6,*)'Simulate spectrum (y/n)? '
       read(5,'(a)')ok
       write(6,*)'Which atom (H, C, N, O, F ...):'
       read(5,'(a)')element
       if(ok.eq.'y'.or.ok.eq.'Y')then
        write(6,*)'Reference value: (put "0" for absulute scale): '
        read(5,*)sr
        write(6,*)'Remember sh = Reference - Absolute !'
999     write(6,*)'Input 4 numbers:'
        write(6,*)'Smin, smax, number of points, peak width:'
        read(5,*)si,sa,np,w
        if(np.gt.np0)then
         write(6,*)'too many points, max is ',np0
         goto 999
        endif
        ds=(sa-si)/real(np-1)
        do ii=1,np
         spec(i)=0.0d0
        enddo
        open(4,file=fnt)
        ifo=0
        do i=1,ng
         read(4,4000)prvek,sigma
4000     format(5x,a1,15x,f11.4)
         if(prvek.eq.element)then
          ifo=ifo+1
          sigma=sr-sigma
          s=si-ds
          do ii=1,np
           s=s+ds
           ee=((sigma-s)/w)**2
           if(ee.lt.25.0d0)spec(ii)=spec(ii)+exp(-ee)
          enddo
         endif
        enddo
        close(4)
        write(6,*)ifo,' of ',element,' found'
        write(6,*)'Filename (with .PRN):'
        read(5,'(a)')fn
        open(4,file=fn)
        s=si-ds
        do ii=1,np
         s=s+ds
         write(4,4001)s,spec(ii)
4001     format(f9.3,f10.5)
        enddo
        close(4)
       endif
      endif
c
      STOP
      END