measure_main.F90

Path: MeasureClass/OLDS/measure_main.F90
Last Update: Wed Jun 08 18:07:51 +0900 2011
dot/f_3.png

Required files

Methods

Included Modules

comlib lattice_class error_class file_tools_class hmc_status_class field_gauge_class measure_class meson_class

Public Instance methods

Main Program :

[Source]

program measure_main
  use comlib
  use lattice_class
  use error_class
  use file_tools_class
  use hmc_status_class
  use field_gauge_class
  use measure_class
  use meson_class
  implicit none
  type(lattice_world) :: lattice
  type(hmc_status) :: status
  type(vfield_gluon_wg) :: u
  type(meson_prop) :: meson
  character(CHARLEN) :: fname,str,path,head,quark_file
  logical :: flag
  integer :: iargs,iout

  quark_file = REPEAT(' ',LEN(quark_file))

  call new(lattice)

  iargs = COMMAND_ARGUMENT_COUNT()
  if (iargs == 1) then
    call GET_COMMAND_ARGUMENT(1,fname)
  else
    call error_stop("Usage: measuremt_main Inputfile")
  endif

  call new(status)

  iout = search_free_file_unit()
  if (0==nodeid) then
    open(iout,file=TRIM(fname),status='old',form='formatted')
    read(iout,'(A)') str ! comment
    read(iout,'(A)') path 
    read(iout,'(A)') head
    read(iout,'(A)') str ! comment
  endif
#ifndef _singlePU
  call comlib_bcast(path,0)
  call comlib_bcast(head,0)
#endif
  
  call read(status,iout)

  if (0==nodeid) then
    read(iout,'(A)') str ! comment
    read(iout,'(A)') quark_file
    close(iout)
  endif
#ifndef _singlePU
  call comlib_bcast(quark_file,0)
#endif

  do
    flag = is_do_loop_ended(status)
    if (flag) exit
    call new(u)
    call load_config(path,head,status,u)

    if (is_save_config(status)) then
      ! type = 1 for wilson quarks
      ! type = 2 for overlap quarks
      call new(meson,TRIM(quark_file),status)
      call print(meson)
      call get(meson,u)
      call save(meson)
      call delete(meson)
    endif
  enddo

  call delete(status)
write(*,*)"delete hmc status"
  call delete(lattice)
write(*,*)"delete lattice"

  stop
end program