main_hadron.F90

Path: SingletMesons_Simple_v1.3/VERYOLD/OLDS/main_hadron.F90
Last Update: Sun May 24 13:58:24 +0900 2009
dot/f_3.png

Required files

Methods

Included Modules

lattice_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 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(baryon_prop_obj)     :: baryon
  type(hadrons_obj)         :: hadrons
  integer :: isrc,iqk,isrc1,isrc2,isrcd,iflv
  integer :: ifm,ifb

  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)
  call read(main)
  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
    baryon%itraj   =traj
    meson%path     =main%hadron_path
    meson_mom%path =main%hadron_path
    baryon%path    =main%hadron_path
    call new(meson)
    call new(meson_mom)
    call new(baryon)

    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
    ifb=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
      if (isrc1 == isrc2) then
        call get_prop(baryon,qprop(iqk,isrc1))
      else
        call get_prop(baryon,qprop(iqk,isrc1),qprop(iqk,isrc2))
      endif
      call save(baryon,ifb)
      ifb=ifb+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
! Light-Light-Strange baryon
      call get_prop(baryon,qprop(iqk1,isrc1),qprop(iqk2,isrc2))
      call save(baryon,ifb)
      ifb=ifb+1
! Strange-Strange-Light baryon
      call get_prop(baryon,qprop(iqk2,isrc2),qprop(iqk1,isrc1))
      call save(baryon,ifb)
      ifb=ifb+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
      if (isrc1 == isrc2) then
        call get_prop(baryon,qprop(iqk,isrc1))
      else
        call get_prop(baryon,qprop(iqk,isrc1),qprop(iqk,isrc2))
      endif
      call save(baryon,ifb)
      ifb=ifb+1
    enddo
    enddo
    enddo

    call delete(meson)
    call delete(meson_mom)
    call delete(baryon)

  enddo

  call delete(main)

  stop
end program