main_singlet.F90

Path: SingletMesons_Simple_v1.3/VERYOLD/OLD2/main_singlet.F90
Last Update: Tue May 26 15:33:57 +0900 2009
dot/f_3.png

Required files

Methods

Included Modules

lattice_class noisy_wavefunc_class fftw3_class wavefunc_class quark_prop_class hadron_class main_hadron_class

Public Instance methods

Main Program :

**********************************************************************

  • hadron propagator solver (includes quark prop solver)

**********************************************************************

[Source]

program main_hadron
!**********************************************************************
!* hadron propagator solver (includes quark prop solver)
!**********************************************************************
  use lattice_class
  use noisy_wavefunc_class
  use fftw3_class
  use wavefunc_class
  use quark_prop_class
  use hadron_class
  use main_hadron_class
  implicit none
  type(main_hadron_obj) :: main
  type(quark_prop_obj), allocatable :: qprop(:,:)
  integer :: traj,mu
  character(len=_CHARLEN_), parameter :: prog_ver="$Id: main_hadron.F90,v 1.1 2006/10/04 01:52:25 ishikawa Exp $"
  character(len=_CHARLEN_)  :: char
  type(meson_prop_obj)      :: meson
  type(meson_mom_prop_obj)  :: meson_mom
  type(hadrons_obj)         :: hadrons
  integer :: isrc,iqk,isrc1,isrc2,isrcd,iflv
  integer :: ifm,iout

  integer :: nfl,nfh,nf,iqk1,iqk2

  call new(main)

  if (nodeid == 0) then
    write(*,'(80("-"))')
    write(*,'(1X,A," for ",A)')TRIM(prog_ver),TRIM(_VERSION_)
    write(*,'(80("-"))')
  endif

  call new(hadrons)
  iout=66
  call read(iout,main)
  close(iout)
  call print(main)

  allocate(qprop(2,2))
  qprop(1,1)%parameter=main%quark_parameter(1)
  qprop(2,1)%parameter=main%quark_parameter(2)
  qprop(1,2)%parameter=main%quark_parameter(1)
  qprop(2,2)%parameter=main%quark_parameter(2)

  do traj=main%ini_traj,main%end_traj,main%traj_skip

    meson%itraj    =traj
    meson_mom%itraj=traj
    meson%path     =main%hadron_path
    meson_mom%path =main%hadron_path
    call new(meson)
    call new(meson_mom)

    call read(traj,main%config_path,main%config_name,main%config_prof,main%u)

    do isrc=1,2
    do iqk=1,2
      qprop(iqk,isrc)%parameter%wavefunc_sous=main%wavefunc(isrc)
      qprop(iqk,isrc)%parameter%smear_sous=isrc-1
      qprop(iqk,isrc)%parameter%smear_sink=0

      if (nodeid==0) then
        write(*,'("")')
        write(*,'(80("="))')
        write(*,'("Begin ==== Quark #",I3," Source #",I3)')iqk,isrc
      endif
      call print(qprop(iqk,isrc)%parameter)
      if (nodeid==0) then
        write(*,'("")')
      endif

      call get_prop(qprop(iqk,isrc),main%u)

      if (nodeid==0) then
        write(*,'("")')
      endif
      call print_statistics(qprop(iqk,isrc))
      if (nodeid==0) then
        write(*,'("End ==== Quark #",I3," Source #",I3)')iqk,isrc
        write(*,'("")')
      endif

    enddo
    enddo

    nfl=1
    nfh=1
    nf=nfl+nfh
    
    ifm=1

! Light-Light flavor loop
    do iqk=1,nfl
    do isrc1=1,2
    do isrcd=1,2
      isrc2=mod(isrc1-1+isrcd-1,2)+1
      call get_prop(meson,    qprop(iqk,isrc1),qprop(iqk,isrc2),main%u)
      call get_prop(meson_mom,qprop(iqk,isrc1),qprop(iqk,isrc2))
      call save(meson,ifm)
      call save(meson_mom,ifm)
      ifm=ifm+1
    enddo
    enddo
    enddo

! Light-Strange flavor loop
    do iqk1=1,nfl
    do iqk2=nfl+1,nfl+nfh
    do isrc1=1,2
    do isrcd=1,2
      isrc2=mod(isrc1-1+isrcd-1,2)+1
      call get_prop(meson,    qprop(iqk1,isrc1),qprop(iqk2,isrc2),main%u)
      call get_prop(meson_mom,qprop(iqk1,isrc1),qprop(iqk2,isrc2))
      call save(meson,ifm)
      call save(meson_mom,ifm)
      ifm=ifm+1
    enddo
    enddo
    enddo
    enddo

! Strange-Strange loop
    do iqk=nfl+1,nfl+nfh
    do isrc1=1,2
    do isrcd=1,2
      isrc2=mod(isrc1-1+isrcd-1,2)+1
      call get_prop(meson,    qprop(iqk,isrc1),qprop(iqk,isrc2),main%u)
      call get_prop(meson_mom,qprop(iqk,isrc1),qprop(iqk,isrc2))
      call save(meson,ifm)
      call save(meson_mom,ifm)
      ifm=ifm+1
    enddo
    enddo
    enddo

    call delete(meson)
    call delete(meson_mom)

  enddo

  call delete(main)

  stop
end program