mos_menu_mod.f95

mos_menu_mod.f95
!-----------------------------------------------------------------------------
!     This file is part of QmcMol A GNU QMC program for molecules.
!    Copyright (C) 2002 CNRS - U.P.M.C. Paris 6 - FRANCE
!     R. Assaraf, M. Caffarel, F. Colonna, X. Krokidis, B. Levy,
!     P. Pernod, and P. Reinhardt - qmcmol@lct.jussieu.fr
!            http://www.lct.jussieu.fr/QmcMol
! QmcMol is free software; you can redistribute it and/or modify it
! under the terms of the GNU General Public License as published by the Free
! Software Foundation; either version 2, or (at your option) any later
! version. QmcMol is distributed in the hope that it will be useful,but
! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
! for more details. You should have received a copy of the GNU General
! Public License along with QmcMol; see the file COPYING. If not,
! write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
! Boston, MA 02111-1307, USA.
!-----------------------------------------------------------------------------

module mos_menu_mod

 use mos_at_point_mod

 contains

! ========================================================================
 subroutine mos_menu
! ------------------------------------------------------------------------
!
! Name      : mos_menu
!
! Description  : collects information from menu to read mos from file
!
! Authors:X. Krokidis, F. Colonna
! Date :09 Oct 2000
! ------------------------------------------------------------------------
 implicit none

! local:
 character(len=max_string_len_routine_name) :: l_here
 character(len=max_string_len)       :: what
 logical(bool)                :: done
 integer(i4b)                :: unit

! begin:
 l_here ='mos_menu'
 call enter (l_here)

! initializations:

 done = .false.
 call next_command_get ('mos')
 do while (.not.done)
  call next_word_get ('mos')
  if(cur_word(1:4) .eq. 'help') then

   write (logf,*) 'mos: mos definitions'
   write (logf,*) 'mos: syntax:'
   write (logf,*) 'mos: mos'
   write (logf,*) 'mos:  help'
   write (logf,*) 'mos:  pro{gram} = [string]'
   write (logf,*) 'mos:   [string] may be one among:'
   write (logf,*) 'mos:    GAMESS'
   write (logf,*) 'mos:    GAUSSI'
   write (logf,*) 'mos:    MOLPRO'
   write (logf,*) 'mos:    QMCMOL'
   write (logf,*) 'mos:  fil{e}   [command]'
   write (logf,*) 'mos:  end_mos'
   write (logf,*) 'mos: example        '
   write (logf,*) 'mos: mos          '
   write (logf,*) 'mos: program = GAMESS   '
   write (logf,*) 'mos: file  ... end    '
   write (logf,*) 'mos: end_mos'

  else if(token_is ('pro', what)) then
   interfaced_program = string_to_upper (what)

  else if(trim(cur_word) == 'fil') then
   call files_menu

  else
   call menu_exit (l_here, done)
  end if

 end do

 unit = unit_from_type ('mos-in')
 
 if(debug) write (logf,*)trim(l_here),'-d: unit =',unit
 
 require_unit: if(unit <= 0) then
  message = 'in routine'*l_here*' unit = '*unit &
  +CR*' probably file name missing in input'
  call require (message, unit .gt. 0)
 end if require_unit

 if(files_programs(unit) == '?') then
  message = 'in routine'*l_here*' interfaced_program is not defined in file command' &
  +CR*' should be one of "GAMESS" "GAUSSIAN" "MOLPRO" "QMCMOL"'
  call die (l_here, message)
 end if 

 interfaced_program = files_programs (unit)

 if(debug) then
  write (logf,*)trim(l_here),'-d: interfaced_program >',trim(interfaced_program),'<'
  write (logf,*)trim(l_here),'-d: mos_mos_basis_type >',trim(interfaced_program),'<'
 end if

 if(interfaced_program == '?') then
  interfaced_program = files_programs(unit)
 end if

 if(trim(interfaced_program) /= trim(files_programs(unit))) then
   message = 'in routine'*l_here*' interfaced_program from mos ' &
        *interfaced_program &
   +CR*' interfaced_program from file '*files_programs(unit) &
   +CR*' should be the same '
   call die (l_here, message)
 end if 

 call exit (l_here)

 end subroutine mos_menu

! ========================================================================
 subroutine mos_print_menu
! ------------------------------------------------------------------------
!
! Name      : mos_print_menu
!
! Description  : input for mos_print
!
! Author: F. Colonna
! Date : 16 Nov 2000
! ------------------------------------------------------------------------
 implicit none

! local:
 character(len=max_string_len_routine_name) :: l_here
 logical(bool)    :: done
 logical(bool)    :: l_all  
 logical(bool)    :: l_overlap
 integer(i4b)     :: this_mo
 real(dp), pointer  :: this_point(:) => NULL()

! begin:
 l_here ='mos_print_menu'
 call enter (l_here)

! initialize:
 this_mo = 0
 l_all  = .false. 
 l_overlap = .false. 

 done = .false.
 call next_command_get ('mos_print')
 do while (.not.done)
  call next_word_get ('mos_print')
  if(trim(cur_word) .eq. 'help') then

  write (logf,'(a)') ' mos_print-h: mos subcommand'
  write (logf,'(a)') ' mos_print-h: syntax:'
  write (logf,'(a)') ' mos_print-h: mos_print'
  write (logf,'(a)') ' mos_print-h:  help'
  write (logf,'(a)') ' mos_print-h:  mo    = [integer]'
  write (logf,'(a)') ' mos_print-h:  ove{rlap} = [boolean] '
  write (logf,'(a)') ' mos_print-h:  poi{nt}  = [list_of_real]'
  write (logf,'(a)') ' mos_print-h:  all    = [boolean]'
  write (logf,'(a)') ' mos_print-h:  end_pri'
  write (logf,'(a)') ' mos_print-h: example'
  write (logf,'(a)') ' mos_print-h: {mos}'
  write (logf,'(a)') ' mos_print-h: mos_print mo = 2 point = (0.1, 6., 3.) end_mos'
  write (logf,'(a)') ' mos_print-h: {end_mos}'
  write (logf,'(a)') ' mos_print-h: print all end'

  else if(token_is ('mo', this_mo)) then

  else if(token_is ('ove', l_overlap)) then

  else if(token_is ('poi', this_point)) then

  else if(token_is ('all', l_all)) then

  else
  call menu_exit (l_here, done)
  end if
 end do

 if(debug) then
  write (logf,*)trim(l_here),'-d: this_mo =',this_mo
  write (logf,*)trim(l_here),'-d: this_point =',this_point
 end if

 if(this_mo > 0) call mo_values_print (this_mo, this_point)
 if(l_all)    call mos_print
 if(l_overlap)  call mos_overlap_print

 call exit (l_here)

 end subroutine mos_print_menu

! ========================================================================
 subroutine mo_values_print (this_mo, this_point)
! ------------------------------------------------------------------------
!
! Name      : mo_values_print
!
! Argument (in ) : this_mo
! Argument (in ) : this_point
!
! Description  : print on mo at x, y, z
!
! Authors  : F. Colonna
! Date    : 16 Nov 2000
! ------------------------------------------------------------------------
 implicit none

! i/o:
 integer(i4b)   :: this_mo
 real(dp), pointer :: this_point(:)

! local:
 character(len=max_string_len_routine_name) :: l_here
 real(dp)                  :: x, y, z
 real(dp)                  :: value
 real(dp)                  :: grad(3)
 real(dp)                  :: lapl
 integer(i4b)                :: dimensions_nb

! begin:
 l_here ='mo_values_print'
 call enter (l_here)

 x = this_point(1)
 y = this_point(2)
 z = this_point(3)

 if(debug) then 
  write (logf,*)trim(l_here),'-d: mo # ',this_mo
  write (logf,*)trim(l_here),'-d: point at x=',x,' y=',y,' z=',z 
 end if

 dimensions_nb = size(this_point)
! require_dimensions_nb:
 if(dimensions_nb == 0) call die (l_here,' nb of dimensions ='+dimensions_nb)

 call provide_bynam ('mos_names')

 call mo_at_point_clc (this_mo, this_point, value, grad, lapl)

 write (logf,'(1x,2a,i3,3(a,g23.15))') &
 trim(l_here),': mo # ',this_mo,' at x=',x,' y=',y,' z=',z 

 write (logf,'(1x,2a,g23.15)') &
 trim(l_here),': mo value   =',value

 write (logf,'(1x,2a,3g23.15)') &
 trim(l_here),': mo gradient =',grad(:)

 write (logf,'(1x,2a,g23.15)') &
 trim(l_here),': mo laplacian =',lapl

 call exit (l_here)

 end subroutine mo_values_print

end module mos_menu_mod

back to top