files_menu_mod.f95
files_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 files_menu_mod
use parser_mod
use files_mod
use arrays_mod
implicit none
contains
! ========================================================================
subroutine catalogue_menu
! ------------------------------------------------------------------------
!
! Name : catalogue_menu
!
! Description : input catalogue
!
! Authors:F. Colonna
! Date :14 Oct 2000
! ------------------------------------------------------------------------
implicit none
! local:
logical(bool) :: done
character(len=max_string_len_routine_name) :: l_here
! begin:
l_here ='catalogue_menu'
call enter (l_here)
! initialize:
if(debug)write (logf,*)trim(l_here),'-d: '
done = .false.
call next_command_get ('catalogue')
do while (.not.done)
call next_word_get ('catalogue')
if(trim(cur_word) .eq. 'help') then
write (logf,*) 'catalogue: catalogue definitions'
write (logf,*) 'catalogue:syntax:'
write (logf,*) 'catalogue: cat{alogue}: '
write (logf,*) 'catalogue: help'
write (logf,*) 'catalogue: fil{e} [command]'
write (logf,*) 'catalogue: end_cat'
write (logf,*) 'catalogue: example'
else if(cur_word(1:3) .eq. 'fil') then
call files_menu
else
call menu_exit (l_here, done)
end if
end do
call exit (l_here)
end subroutine catalogue_menu
! ========================================================================
subroutine files_menu
! ------------------------------------------------------------------------
!
! Name : files_menu
!
! Description : gets current file catalogue parameters from input
! Description : catalogue the file if file new
! Description : re-catalogue the file if file already catalogued
!
! Authors:F. Colonna
! Date :13 Oct 2000
! ------------------------------------------------------------------------
implicit none
! local:
character(len=max_string_len_routine_name) :: l_here
integer(i4b) :: unit
logical(bool) :: done
character(len=max_string_len_action) :: f_action
character(len=max_string_len_file_name) :: f_name
character(len=max_string_len_format) :: f_format
character(len=max_string_len_file_type) :: f_type
character(len=max_string_len_position) :: f_position
character(len=max_string_len_file_name) :: f_path
character(len=max_string_len_program) :: f_program
character(len=max_string_len_title) :: f_title
character(len=max_string_len_status) :: f_status
! logical(bool) :: f_delete
logical(bool) :: f_is_open
logical(bool) :: f_close
logical(bool) :: f_open
! begin:
l_here ='files_menu'
call enter (l_here)
! initialize:
f_path = './'
f_status = blanks
f_action = 'readwrite'
f_name = '?'
f_format = '?'
f_type = '?'
f_position = 'asis'
f_program = 'qmcmol'
f_title = NOT_INIT_S
f_status = ' '
! f_delete = .false.
f_is_open = .false.
f_open = .false.
f_close = .false.
done = .false.
call next_command_get ('file')
do while (.not.done)
call next_word_get ('file')
if(trim(cur_word) .eq. 'help') then
write (logf,*) 'file-h: syntax:'
write (logf,*) 'file-h: fil{e}'
write (logf,*) 'file-h: help'
write (logf,*) 'file-h: act{ion} = [string] delete:read:write:readwrite'
write (logf,*) 'file-h: clo{se} = [boolean] '
write (logf,*) 'file-h: for{mat} = [string] binary:(3a..)'
write (logf,*) 'file-h: nam{e} = [string] '
write (logf,*) 'file-h: pat{h} = [string] '
write (logf,*) 'file-h: pos{ition}= [string] asis:rewind:append'
write (logf,*) 'file-h: pro{gram} = [string] (interfaced program)'
write (logf,*) 'file-h: sta{tus} = [string] replace:new:old:'
write (logf,*) 'file-h: tit{le} = [string_with_blanks] '
write (logf,*) 'file-h: typ{e} = [string] one among:'
write (logf,*) 'file-h: aos Atomic Orbitals'
write (logf,*) 'file-h: epfs Elementary Primitive Functions'
write (logf,*) 'file-h: jastrow Jastrow Factors Parameters'
write (logf,*) 'file-h: mos Molecular Orbitals'
write (logf,*) 'file-h: param '
write (logf,*) 'file-h: pseudo '
write (logf,*) 'file-h: pseudo_SBK '
write (logf,*) 'file-h: walkers '
write (logf,*) 'file-h: end_fil'
write (logf,*) 'file-h: example'
write (logf,*) 'file-h: file name = truc.dat type = mos action = read prog = molpro end'
write (logf,*) 'file-h: file name = truc.dat action = delete end'
else if(token_is ('act', f_action)) then
else if(token_is ('clo', f_close)) then
else if(token_is ('for', f_format)) then
else if(token_is ('nam', f_name)) then
else if(token_is ('pat', f_path)) then
else if(token_is ('ope', f_open)) then
else if(token_is ('pos', f_position)) then
else if(token_is ('pro', f_program)) then
interfaced_program = string_to_upper (f_program)
else if(token_is ('sta', f_status)) then
else if(token_is ('tit', f_title)) then
else if(token_is ('typ', f_type)) then
else
call menu_exit (l_here, done)
end if
end do
if(debug) then
write (logf,*)trim(l_here),'-d: f_name >',trim(f_name),'<'
write (logf,*)trim(l_here),'-d: f_action >',trim(f_action),'<'
write (logf,*)trim(l_here),'-d: f_format >',trim(f_format),'<'
write (logf,*)trim(l_here),'-d: f_path >',trim(f_path),'<'
write (logf,*)trim(l_here),'-d: f_position >',trim(f_position),'<'
write (logf,*)trim(l_here),'-d: f_program >',trim(f_program),'<'
write (logf,*)trim(l_here),'-d: f_title >',trim(f_title),'<'
write (logf,*)trim(l_here),'-d: f_type >',trim(f_type),'<'
write (logf,*)trim(l_here),'-d: f_status >',trim(f_status),'<'
write (logf,*)trim(l_here),'-d: interfaced_program >',trim(interfaced_program),'<'
end if
message =' in routine'*l_here*' file-name is required '
call require (message, f_name /= NOT_INIT_S )
if(f_action(1:3) /= 'del' .and. f_type == NOT_INIT_S) then
message =' in routine'*l_here*CR*'file-type is required ' &
*' for file '*f_name
call require (message, f_type /= NOT_INIT_S )
end if
! special results file:
if(trim(f_type) == "results") then
if(f_path /= NOT_INIT_S) files_paths(res) = f_path
if(f_title /= NOT_INIT_S) files_titles(res) = f_title
files_names(res) = f_name
unit = res
close (res)
call unit_open_append (res)
else
unit = file_catalogue (f_name, &
f_type, &
f_action, &
f_format, &
f_path, &
f_position, &
f_program, &
f_title, &
f_status, &
f_is_open)
end if
if(debug)write (logf,*)trim(l_here),'-d: unit=',unit
if (interfaced_program(1:1) == NOT_INIT_S ) then
message ='in routine'*l_here*' interfaced_program is >'* &
interfaced_program*'< should be one of GAMESS|GAUSSI|MOLPRO|'
call ensure (message, interfaced_program(1:1) /= '?')
end if
! delete file
if(f_action(1:3) == 'del') then
call file_delete (f_name, f_path)
end if
! close file
if(f_close) call file_close_by_name (f_name)
! open file
if(f_open) call unit_open (unit)
call exit (l_here)
end subroutine files_menu
end module files_menu_mod
back to top