Path: | SingletMesons_Simple_v1.3/VERYOLD/OLDS/main_hadron.F90 |
Last Update: | Sun May 24 13:58:24 +0900 2009 |
Main Program : |
**********************************************************************
**********************************************************************
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