C FORTRAN PROGRAM gesol_init_f
C WRITTEN BY ALEK MARENICH (AVM) ON 07/24/2008
C LAST TIME MODIFIED BY ALEK MARENICH (AVM) ON 03/12/2009
C
C THIS PROGRAM CALLED BY gesol
C 1) READS INPUT FOR gesol
C 2) CREATES WORK FILES FOR gesol
C  
      IMPLICIT REAL*8 (A-H,O-Z)

      CHARACTER*32 PCM,READPCM,READRAD,SOLVENT

      CHARACTER*32 W32,WNONE
      CHARACTER*36 W36

      CHARACTER*78 WERR,WNERR
      LOGICAL LREAD
      LOGICAL LVERB,LCDS

      NAMELIST /GESOL/ IGAS,EGAS,PCM,READPCM,READRAD,
     $SOLVENT,DIELEC,SOLN,SOLA,SOLB,SOLG,
     $SOLC,SOLH,LVERB,LCDS

      SMALL=1.0D-08
      WNONE='NONE'
      WNERR='NERR'


C DEFAULT SETTINGS

      LREAD=.FALSE.
      LVERB=.FALSE.
      LCDS=.TRUE.
      WERR=WNERR

      EGAS=0.D0
      IGAS=0
      PCM='IEFPCM'
      SOLVENT='WATER'
      DIELEC=78.35D0
      SOLA=0.D0
      SOLB=0.D0
      SOLC=0.D0
      SOLG=0.D0
      SOLH=0.D0
      SOLN=0.D0
      READPCM=WNONE
      READRAD=WNONE

C END OF DEFAULT SETTINGS


C READING $GESOL

      OPEN (1,FILE='wrkinput')
      READ(1,NML=GESOL,ERR=20,END=10)
      GOTO 30
10    WERR='$GESOL IS NOT FOUND! STOP.'
      CLOSE (1,STATUS='DELETE')
      CALL GESOLERROR(WERR) 
20    WERR='ERROR IN READING $GESOL! STOP.'
      CLOSE (1,STATUS='DELETE')
      CALL GESOLERROR(WERR)
30    CONTINUE
      CLOSE (1,STATUS='DELETE')

C END OF READING $GESOL


C CHECKING THE INPUT DATA


      IF (IGAS.NE.0.AND.IGAS.NE.1) 
     $WERR='INVALID VALUE FOR igas IN $GESOL! STOP.'

      IF (DABS(EGAS).LE.SMALL) EGAS=0.D0
      IF (DABS(EGAS-1.D0).LE.SMALL) EGAS=1.D0

      CALL CAPS(PCM)
      IPCM=-1
      IF (PCM.EQ.WNONE) IPCM=0
      IF (PCM.EQ.'IEFPCM') IPCM=1
      IF (PCM.EQ.'CPCM') IPCM=2
      IF (IPCM.EQ.-1)
     $WERR='INVALID VALUE FOR pcm IN $GESOL: '//PCM

      IF (DIELEC.LT.(1.D0+SMALL))
     $WERR='INVALID VALUE FOR dielec IN $GESOL! STOP.'
      IF (SOLA.LT.-SMALL)
     $WERR='INVALID VALUE FOR sola IN $GESOL! STOP.'

      IF (READRAD.NE.WNONE) THEN
      INQUIRE (FILE=READRAD,EXIST=LREAD)
       IF (LREAD) THEN
        ELSE  
       WERR='THE FILE DOES NOT EXIST: '//READRAD
       ENDIF
      ENDIF

      IF (READPCM.NE.WNONE) THEN
      INQUIRE (FILE=READPCM,EXIST=LREAD)
       IF (LREAD) THEN
        ELSE  
       WERR='THE FILE DOES NOT EXIST: '//READPCM
       ENDIF
      ENDIF

      IF (WERR.NE.WNERR) 
     $ CALL GESOLERROR(WERR)

      OPEN (3,FILE='wrkoutput')

      CALL CAPS(SOLVENT)

      IF (SOLVENT.EQ.'H2O') SOLVENT='WATER'
      IF (SOLVENT.EQ.'CH3CN') SOLVENT='ACETONITRILE'
      IF (SOLVENT.EQ.'DMSO') SOLVENT='DIMETHYLSULFOXIDE'
      IF (SOLVENT.EQ.'CH3SOCH3') SOLVENT='DIMETHYLSULFOXIDE'
      IF (SOLVENT.EQ.'CH3OH') SOLVENT='METHANOL'            
      IF (SOLVENT.EQ.'CH3CH2OH') SOLVENT='ETHANOL' 
      IF (SOLVENT.EQ.'CHCL3') SOLVENT='CHLOROFORM'       
      IF (SOLVENT.EQ.'TRICHLOROMETHANE') SOLVENT='CHLOROFORM'
      IF (SOLVENT.EQ.'ETHER') SOLVENT='DIETHYLETHER'       
      IF (SOLVENT.EQ.'CH3CH2OCH2CH3') SOLVENT='DIETHYLETHER' 
      IF (SOLVENT.EQ.'METHYLENECHLORIDE') SOLVENT='DICHLOROMETHANE'          
      IF (SOLVENT.EQ.'CH2CL2') SOLVENT='DICHLOROMETHANE'      
      IF (SOLVENT.EQ.'CH2CLCH2CL') SOLVENT='1,2-DICHLOROETHANE'
      IF (SOLVENT.EQ.'CCL4') SOLVENT='CARBONTETRACHLORIDE'      
      IF (SOLVENT.EQ.'C6H6') SOLVENT='BENZENE'
      IF (SOLVENT.EQ.'C6H5CH3') SOLVENT='TOLUENE'     
      IF (SOLVENT.EQ.'C6H5CL') SOLVENT='CHLOROBENZENE'    
      IF (SOLVENT.EQ.'CH3NO2') SOLVENT='NITROMETHANE'
      IF (SOLVENT.EQ.'HEPTANE') SOLVENT='N-HEPTANE'      
      IF (SOLVENT.EQ.'C7H16') SOLVENT='N-HEPTANE'
      IF (SOLVENT.EQ.'C6H12') SOLVENT='CYCLOHEXANE'
      IF (SOLVENT.EQ.'C6H5NH2') SOLVENT='ANILINE'
      IF (SOLVENT.EQ.'PROPANONE') SOLVENT='ACETONE'
      IF (SOLVENT.EQ.'CH3COCH3') SOLVENT='ACETONE'        
      IF (SOLVENT.EQ.'THF') SOLVENT='TETRAHYDROFURAN'        

      IF (SOLVENT.NE.'OTHER'.AND.SOLVENT.NE.'WATER') THEN
      INQUIRE (FILE='wrksolvent',EXIST=LREAD)
       IF (LREAD) THEN
       OPEN (2,FILE='wrksolvent')
       READ (2,*) NSOL
         DO I=1,NSOL
         READ (2,*) 
     $W32, BSOLN,BSOLA,BSOLB,BSOLG,BDIELEC,BSOLC,BSOLH
         IF (SOLVENT.EQ.W32) GOTO 50
         ENDDO
       OPEN (1,FILE='wrkerr')
       WRITE (1,'(/,1X,A,A,/)') 'UNKNOWN SOLVENT: ',SOLVENT
       WRITE (1,'(1X,A,A,/,A,/,A,/)') 
     $'YOU NEED TO PROVIDE dielec, sola, solb, solc, solg, solh, ',
     $'soln FOR YOUR SOLVENT IN $GESOL',
     $' OR',
     $' YOU NEED TO SELECT A SOLVENT FROM THE LIST BELOW: '
       WRITE (2,'(A)') 'WATER'
       REWIND (2)
       READ (2,*) NSOL
         DO I=1,NSOL
         READ (2,*) W32
         WRITE (1,'(A)') W32
         ENDDO 
       CLOSE (2)
       CLOSE (1)
       STOP
       ELSE
       WRITE (3,'(/,1X,A,A)') 'UNKNOWN SOLVENT: ',SOLVENT
       WRITE (3,'(1X,A,/)') 'IT IS CHANGED TO WATER.'
       ENDIF  
50    CONTINUE
      SOLN=BSOLN
      SOLA=BSOLA
      SOLB=BSOLB
      SOLG=BSOLG
      DIELEC=BDIELEC
      SOLC=BSOLC
      SOLH=BSOLH
      ENDIF

      ISOL=0
      IF (SOLVENT.EQ.'WATER') ISOL=1
      IF (DABS(SOLA+SOLB+SOLC+SOLG+SOLH+SOLN).GE.SMALL) THEN
      ISOL=0
      IF (SOLVENT.EQ.'WATER') SOLVENT='OTHER'
      ENDIF

      IF (SOLVENT.EQ.'WATER') SOLA=1.0D0
      
      ICDS=1
      IF (LCDS) THEN
      ICDS=1
           ELSE
      ICDS=0
      ENDIF 

      IF (IPCM.EQ.0) ICDS=0
C END OF CHECKING THE INPUT DATA
    

C WRITING IN AN OUTPUT FILE

      WRITE(3,'(/," ***************************************",        
     ."**********************************************")')      
      WRITE(3,'(5X,A)')
     .  'GESOL keywords (see manual for more information):'            
      WRITE (3,'(" ***************************************",          
     ."**********************************************")')        
      W36  = ' : Density model for electrostatics'
      WRITE (3,'(A,A32,T40,A)' )  '  PCM      =  ',PCM,W36
      IF (IPCM.EQ.0) GOTO 60        
      IF (DABS(EGAS).LE.SMALL) THEN
      WRITE (3,'(A,T40,A)') '  EGAS     =  0',
     $' : E(gas) to be updated for each geometry'
      ENDIF
      IF (DABS(EGAS-1.D0).LE.SMALL.AND.IGAS.EQ.0) THEN
      WRITE (3,'(A,T40,A)') '  EGAS     =  1',
     $' : E(gas) of the input geometry to be used'
      ENDIF
      IF (DABS(EGAS-1.D0).LE.SMALL.AND.IGAS.EQ.1) THEN
      WRITE (3,'(A,T40,A)') '  EGAS     =  1',
     $' : E(gas) of the gas-phase geometry to be used'
      ENDIF
      IF (DABS(EGAS-1.D0).GT.SMALL.
     $AND.DABS(EGAS).GT.SMALL) THEN
      WRITE (3,'(A,G15.9,T40,A)') '  EGAS     =  ',EGAS,
     $' : User-provided E(gas) to be used'
      ENDIF
      IF (IGAS.EQ.0) THEN
      WRITE (3,'(A,T40,A)') '  IGAS     =  0',
     $' : Gas-phase optimization to be skipped'
      ENDIF
      IF (IGAS.EQ.1) THEN
      WRITE (3,'(A,T40,A)') '  IGAS     =  1',
     $' : Gas-phase optimization to be done'
      ENDIF
      IF (SOLVENT.EQ.'WATER') W36  = ' : Aqueous solution'
      IF (SOLVENT.NE.'WATER') W36  = ' : Nonaqueous solution'
      WRITE (3,'(A,A32,T40,A)')  '  SOLVENT  =  ',SOLVENT,W36        

      W36  = ' : Dielectric constant'                   
      WRITE (3,'(A,F8.4,T40,A)') '  DIELEC   = ',DIELEC,W36    

      W36  = ' : User-provided Coulomb radii'
      IF (READRAD.EQ.WNONE) W36  = ' : Default Coulomb radii'
      WRITE (3,'(A,A32,T40,A)')  '  READRAD  =  ',READRAD,W36

      W36  = ' : User-provided PCM keywords'
      IF (READPCM.EQ.WNONE) W36  = ' : Default PCM keywords'
      WRITE (3,'(A,A32,T40,A)')  '  READPCM  =  ',READPCM,W36

      IF (ISOL.EQ.0) THEN
      W36  = ' : Refractive index'                                   
      WRITE (3,'(A,F8.4,T40,A)' ) '  SOLN     = ',SOLN,W36                                                                                
      W36  = ' : Abraham''s hydrogen bond acidity'                   
      WRITE (3,'(A,F8.4,T40,A)' ) '  SOLA     = ',SOLA,W36        
      W36  = ' : Abraham''s hydrogen bond basicity'                  
      WRITE (3,'(A,F8.4,T40,A)' ) '  SOLB     = ',SOLB,W36                          
      W36  = ' : Macroscopic surface tension'                        
      WRITE (3,'(A,F8.4,T40,A)' ) '  SOLG     = ',SOLG,W36                                                                               
      W36  = ' : Solvent aromaticity'                                
      WRITE (3,'(A,F8.4,T40,A)' ) '  SOLC     = ',SOLC,W36                          
      W36  = ' : Electronegative halogenicity'                       
      WRITE (3,'(A,F8.4,T40,A)' ) '  SOLH     = ',SOLH,W36        
      ENDIF

      IF (LCDS) THEN
      W36  = ' : CDS contributions turned on'                   
      WRITE (3,'(A,A,T40,A)') '  LCDS     =  ','.TRUE.',W36    
      ELSE
      W36  = ' : CDS contributions turned off'                   
      WRITE (3,'(A,A,T40,A)') '  LCDS     =  ','.FALSE.',W36    
      ENDIF


60    CONTINUE
      IF (LVERB) THEN
      W36  = ' : Verbose output'                   
      WRITE (3,'(A,A,T40,A)') '  LVERB    =  ','.TRUE.',W36    
      ELSE
      W36  = ' : Normal output'                   
      WRITE (3,'(A,A,T40,A)') '  LVERB    =  ','.FALSE.',W36    
      ENDIF
      WRITE (3,'(" ***************************************",          
     ."**********************************************")')        

      WRITE (3,*)
      CLOSE (3)

C END OF WRITING IN AN OUTPUT FILE


C WRITING IN A WORK FILE

      OPEN (1,FILE='wrk')
      IEGAS=2
      IF (DABS(EGAS-1.D0).LE.SMALL) IEGAS=1
      IF (DABS(EGAS).LE.SMALL) IEGAS=0
      IF (IPCM.EQ.0) IEGAS=2
      WRITE (1,*) 
     $IPCM,ISOL,ICDS,DIELEC,SOLN,
     $SOLA,SOLB,SOLG,SOLC,SOLH,IEGAS
      CLOSE (1)
      IF (READRAD.NE.WNONE) THEN
      OPEN (1,FILE='wrkrad')
      WRITE (1,*) READRAD
      CLOSE (1)
      ENDIF 
      IF (READPCM.NE.WNONE) THEN
      OPEN (1,FILE='wrkpcm')
      WRITE (1,*) READPCM
      CLOSE (1)
      ENDIF 
      IF (LVERB) THEN
      OPEN (1,FILE='wrkverb')
      WRITE (1,*) 
      CLOSE (1)
      ENDIF 
      IF ((DABS(EGAS).GT.SMALL.AND.DABS(EGAS-1.D0).GT.SMALL).
     $OR.IPCM.EQ.0) THEN
      OPEN (1,FILE='wrkegas')
      WRITE (1,'(A,F32.16)') 
     $' <psi(0)|   H    |psi(0)>                     (a.u.) =    ',
     $EGAS
      CLOSE (1)
      ENDIF
      OPEN (1,FILE='g03_optgas.com')
      CLOSE (1,STATUS='DELETE')
      IF (IGAS.EQ.1) THEN
      OPEN (1,FILE='g03_optgas.com')
      WRITE (1,*)      
      CLOSE (1)
      ENDIF

C END OF WRITING IN A WORK FILE


      END


      SUBROUTINE GESOLERROR(T)
      IMPLICIT REAL*8 (A-H,O-Z)
      CHARACTER*78 T
      OPEN (2,FILE='wrkerr')
      WRITE (2,'(/,1X,A,/)') T
      CLOSE (2)
      STOP
      END 


C  **** CAPS AND LENTRIM_USR OBTAINED FROM 
C       V.V.Sliznev (IGHTU, Ivanovo, Russia) ****      

      SUBROUTINE CAPS(WLNS)
      IMPLICIT REAL*8 (A-H,O-Z)
      CHARACTER*(*) WLNS
      ILN=LENTRIM_USR(WLNS)
      IUPA=ICHAR('A')
      IDNA=ICHAR('a') 
      IDNZ=ICHAR('z')
      IK=0
      DO I=1,ILN
      IC=ICHAR(WLNS(I:I))
      IF(IC.GE.IDNA.AND.IC.LE.IDNZ) WLNS(I:I)=CHAR(IC-IDNA+IUPA)
      IF(WLNS(I:I).NE.' ') THEN
      IK=IK+1 
      IF (IK.NE.I) WLNS(IK:IK)=WLNS(I:I)
      END IF   
      ENDDO
      IF (IK.LT.ILN) WLNS(IK+1:ILN)=' '
      RETURN
      END

      INTEGER FUNCTION LENTRIM_USR(WLINE)
      CHARACTER*(*) WLINE  
      ITL=LEN(WLINE)  
      IN=0
      DO I=1,ITL
      IC=ITL-I+1
      IF (WLINE(IC:IC).NE.' ') THEN
       IN=IC
       GO TO 1
      END IF
      END DO  
  1   LENTRIM_USR=IN
      RETURN   
      END 

C  **** CAPS AND LENTRIM_USR OBTAINED FROM 
C       V.V.Sliznev (IGHTU, Ivanovo, Russia) ****      


