print_mod.f95
print_mod.f95 ! -*- f90 -*-
!-----------------------------------------------------------------------------
! 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 print_mod
use aos_mod
use configurations_mod
use mos_menu_mod
use mos_mod
use parser_mod
use step_bywlk_mod
contains
! ========================================================================
subroutine print_menu
! ------------------------------------------------------------------------
!
! Name : print_menu
!
! Description : print command menu
!
! Authors:X. Krokidis, F. Colonna
! Date :12 Oct 2000
! Revision : 07 Oct 2002 F. Colonna
! ------------------------------------------------------------------------
implicit none
! i/o:
! local:
character(len=max_string_len_routine_name) :: l_here
character(len=32) :: what
logical(bool) :: done
logical(bool) :: print
! begin:
l_here ='print_menu'
call enter (l_here)
! initialization
what = blanks
print = .false.
done = .false.
call next_command_get ('print')
do while (.not.done)
call next_word_get ('print')
if(cur_word(1:4) .eq. 'help') then
write (logf,*) 'print: print command'
write (logf,*) 'print: syntax:'
write (logf,*) 'print: print'
write (logf,*) 'print: help'
write (logf,*) 'print: aos = [string] cart:sphe:cart_normed'
write (logf,*) 'print: epf{s} = [boolean] true:false'
write (logf,*) 'print: fil{es} = [boolean] file catalogue'
write (logf,*) 'print: jas{trow} = [boolean]'
write (logf,*) 'print: mos = [command]'
write (logf,*) 'print: ste{p} = [boolean]'
write (logf,*) 'print: xpf{s} = [string] cart:sphe:c_overlap'
write (logf,*) 'print: end_pri'
write (logf,*) 'print: example'
write (logf,*) 'print: print epfs = true end_pri '
write (logf,*) 'print: print aos = cart_normed end_pri '
else if(token_is ('aos', what)) then
select case(what)
case ("cart_normed")
call aos_c_nrmd_print
case ("cart")
call aos_c_print
case ("sphe")
call aos_s_print
case default
call die (l_here, &
'aos type >'//trim(what)//' should be "cart" or "sphe"')
end select
else if(token_is ('epfs', print)) then
if (print) call epfs_print
else if(token_is ('jas', print)) then
if (print) call conf_jastr_print
call conf_jastr_print_res ('')
else if(token_is ('fil', print)) then
if (print) call files_print_res
else if(cur_word(1:3) == 'mos') then
call mos_print_menu
else if(token_is('xpfs', what)) then
select case(what)
case ("cart")
call xpfs_c_print
case ("c_overlap")
call xpfs_overlap_print ("xpfs_c")
case ("sphe")
call xpfs_s_print
case default
call die (l_here, &
'aos type >'//trim(what)//' should be "cart" or "sphe" or "c_overlap"')
end select
else if(token_is('step', print)) then
if (print) call step_bywlk_print
else
call menu_exit (l_here, done)
end if
end do
if(debug)write (logf,*)trim(l_here),'-d: what >',trim(what),'<'
call exit (l_here)
end subroutine print_menu
end module print_mod
back to top