应《网络安全法》要求，自2017年10月1日起，未进行实名认证将不得使用互联网跟帖服务。为保障您的帐号能够正常使用，请尽快对帐号进行手机号验证，感谢您的理解与支持！

24小时热门版块排行榜    

小木虫论坛-学术科研互动平台 » 专业学科区 » 物理 » 统计、非线性&软物质 » CG系数--Fortran code
71/1返回列表
查看: 1817  |  回复: 6
只看楼主 @他人 存档 新回复提醒 (忽略) 收藏    在APP中查看
【奖励】 本帖被评价6次，作者xk6891增加金币 4.8 个

xk6891

至尊木虫 (著名写手)

[资源] CG系数--Fortran code

计算CG系数的一个Fortran代码，这种东西已经很多了，贴出来希望大家能够多多指导帮助验证，也希望和大家分享
————————————————————————————————————
CODE:
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!08.30.2011. BY XK @SCU!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!Input j1,j2,output the CG coefficient!!!!!!!!!!!!!!!!!!!!

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!MAIN PROGRAM!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program main
implicit none
real    j1,j2,j3,m1,m2,m3,cg,jmax,jmin
integer m1_cont,m2_cont,j3_cont
write(*,*)"Please Input the values of j1:"
read(*,*)j1
write(*,*)"Please Input the values of j2:"
read(*,*)j2
!write(*,*)"Please Input the values of j3:"
!read(*,*)j3
!write(*,*)"Please Input the values of m1:"
!read(*,*)m1
!write(*,*)"Please Input the values of m2:"
!read(*,*)m2
!write(*,*)"Please Input the values of m3:"
!read(*,*)m3

jmax=j1+j2
jmin=abs(j1-j2)

   m1=-j1
do m1_cont=1,INT(2*j1+1)
   m2=-j2
do m2_cont=1,INT(2*j2+1)
   m3=m1+m2
   j3=max(jmin,abs(m3))
   
do j3_cont=1,INT(jmax-j3+1)
   call cgfactor(j1,j2,j3,m1,m2,m3,cg)
   write(*,*)":"
   write(*,"(1A,F4.1,1A,F4.1,1A,F4.1,1A,F4.1,1A,F4.1,1A,F4.1,1A)")"<",j1,",",j2,",",m1,",",m2,"|",j3,",",m3,">"
   write(*,*)"The Clebsh-Gordan Factor value:"
   write(*,*)cg
   j3=j3+1
end do

   m2=m2+1
end do

   m1=m1+1
end do

end program
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!SUBROUTINE ONE PROGRAM!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine cgfactor(j1,j2,j3,m1,m2,m3,cg)
implicit none
real    j1,j2,j3,m1,m2,m3
real    cgs
integer cgs1,cgs2,cgs3,cgs4,cgs5,cgs6,cgs7,cgs8,cgs9,cgs10
integer facs1,facs2,facs3,facs4,facs5,facs6,facs7,facs8,facs9,facs10,facs11
real    facsr1,facsr2,facsr3,facsr4,facsr5,facsr6,facsr7,facsr8,facsr9,facsr10,facsr11
integer vs1,vs2,vs3,vx1,vx2,vx3,vmax,vmin,v,vabs,vmod
real    cgxr,cgx,cgxv
integer cgx1,cgx2,cgx3,cgx4,cgx5,cgx6
integer facx1,facx2,facx3,facx4,facx5,facx6
real    cg

!if((m1+m2).ne.m3)then
!write(*,*)"the input values is BAD!!! Please rerun the program."
!else if((m1+m2).eq.m3) then
if((m1+m2).eq.m3) then
cgs1=j1+j2-j3
    if(cgs1.lt.0)then
      write(*,*)"The input value is BAD!!!"
!      exit
    else if(cgs1.eq.0)then
      facs1=1
    else if(cgs1.gt.0)then
      call factorial(cgs1,facs1)
    end if
    facsr1=REAL(facs1)
!write(*,*)"the facsr1 value:"
!write(*,*)facsr1
cgs2=j2+j3-j1
    if(cgs2.lt.0)then
      write(*,*)"The input value is BAD!!!"
!      exit
    else if(cgs2.eq.0)then
      facs2=1
    else if(cgs2.gt.0)then
      call factorial(cgs2,facs2)
    end if
    facsr2=REAL(facs2)
!write(*,*)"the facsr2 value:"
!write(*,*)facsr2
cgs3=j3+j1-j2
    if(cgs3.lt.0)then
      write(*,*)"The input value is BAD!!!"
!      exit
    else if(cgs3.eq.0)then
      facs3=1
    else if(cgs3.gt.0)then
      call factorial(cgs3,facs3)
    end if
    facsr3=REAL(facs3)
!write(*,*)"the facsr3 value:"
!write(*,*)facsr3
cgs4=j1+j2+j3+1
    if(cgs4.lt.0)then
      write(*,*)"The input value is BAD!!!"
!      exit
    else if(cgs4.eq.0)then
      facs4=1
    else if(cgs4.gt.0)then
      call factorial(cgs4,facs4)
    end if
    facsr4=REAL(facs4)
!write(*,*)"the facsr4 value:"
!write(*,*)facsr4
cgs5=j1+m1
    if(cgs5.lt.0)then
      write(*,*)"The input value is BAD!!!"
!      exit
    else if(cgs5.eq.0)then
      facs5=1
    else if(cgs5.gt.0)then
      call factorial(cgs5,facs5)
    end if
    facsr5=REAL(facs5)
!write(*,*)"the facsr5 value:"
!write(*,*)facsr5
cgs6=j1-m1
    if(cgs6.lt.0)then
      write(*,*)"The input value is BAD!!!"
!      exit
    else if(cgs6.eq.0)then
      facs6=1
    else if(cgs6.gt.0)then
      call factorial(cgs6,facs6)
    end if
    facsr6=REAL(facs6)
!write(*,*)"the facsr6 value:"
!write(*,*)facsr6
cgs7=j2+m2
    if(cgs7.lt.0)then
      write(*,*)"The input value is BAD!!!"
!      exit
    else if(cgs7.eq.0)then
      facs7=1
    else if(cgs7.gt.0)then
      call factorial(cgs7,facs7)
    end if
    facsr7=REAL(facs7)
!write(*,*)"the facsr7 value:"
!write(*,*)facsr7
cgs8=j2-m2
    if(cgs8.lt.0)then
      write(*,*)"The input value is BAD!!!"
!      exit
    else if(cgs8.eq.0)then
      facs8=1
    else if(cgs8.gt.0)then
      call factorial(cgs8,facs8)
    end if
    facsr8=REAL(facs8)
!write(*,*)"the facsr8 value:"
!write(*,*)facsr8
cgs9=j3+m3
    if(cgs9.lt.0)then
      write(*,*)"The input value is BAD!!!"
!      exit
    else if(cgs9.eq.0)then
      facs9=1
    else if(cgs9.gt.0)then
      call factorial(cgs9,facs9)
    end if
    facsr9=REAL(facs9)
!write(*,*)"the facsr9 value:"
!write(*,*)facsr9
cgs10=j3-m3
    if(cgs10.lt.0)then
      write(*,*)"The input value is BAD!!!"
!      exit
    else if(cgs10.eq.0)then
      facs10=1
    else if(cgs10.gt.0)then
      call factorial(cgs10,facs10)
    end if
    facsr10=REAL(facs10)
!write(*,*)"the facsr10 value:"
!write(*,*)facsr10
facs11=INT(2*j3+1)
facsr11=REAL(facs11)
!write(*,*)"the facsr11 value:"
!write(*,*)facsr11

!!!!!!!!!!!!!!!!!!!!!!!!!!!AFTER SQRTed the cgs value!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!cgs=sqrt(facsr1*facsr2*facsr3/facsr4*facsr5*facsr6*facsr7*facsr8*facsr9*facsr10*facsr11)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!NOT SQRTed the cgs value!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
cgs=facsr1*facsr2*facsr3/facsr4*facsr5*facsr6*facsr7*facsr8*facsr9*facsr10*facsr11
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

!write(*,*)"the cgs value:"
!write(*,*)cgs

vs1=j1+j2-j3
vs2=j1-m1
vs3=j2+m2
vx1=0
vx2=j1+m2-j3
vx3=j2-j3-m1

vmax=min(vs1,vs2,vs3)
vmin=max(vx1,vx2,vx3)

if(vmax.lt.vmin)then
  write(*,*)"The input value is BAD!!!"
!  exit
else if(vmax.eq.vmin)then
   v=vmax
   cgx1=v
     if(cgx1.lt.0)then
       write(*,*)"The input value is BAD!!!"
!       exit
     else if(cgx1.eq.0)then
       facx1=1
     else if(cgx1.gt.0)then
       call factorial(cgx1,facx1)
     end if
   cgx2=j1+j2-j3-v
     if(cgx2.lt.0)then
       write(*,*)"The input value is BAD!!!"
!       exit
     else if(cgx2.eq.0)then
       facx2=1
     else if(cgx2.gt.0)then
       call factorial(cgx2,facx2)
     end if
   cgx3=j1-m1-v
     if(cgx3.lt.0)then
       write(*,*)"The input value is BAD!!!"
!       exit
     else if(cgx3.eq.0)then
       facx3=1
     else if(cgx3.gt.0)then
       call factorial(cgx3,facx3)
     end if
   cgx4=j2+m2-v
     if(cgx4.lt.0)then
       write(*,*)"The input value is BAD!!!"
!       exit
     else if(cgx4.eq.0)then
       facx4=1
     else if(cgx4.gt.0)then
       call factorial(cgx4,facx4)
     end if
   cgx5=j3-j1-m2+v
     if(cgx5.lt.0)then
       write(*,*)"The input value is BAD!!!"
!       exit
     else if(cgx5.eq.0)then
       facx5=1
     else if(cgx5.gt.0)then
       call factorial(cgx5,facx5)
     end if
   cgx6=j3-j2+m1+v
     if(cgx6.lt.0)then
       write(*,*)"The input value is BAD!!!"
!       exit
     else if(cgx6.eq.0)then
       facx6=1
     else if(cgx6.gt.0)then
       call factorial(cgx6,facx6)
     end if
   
   vmod=MOD(v,2)
   
   if(vmod.eq.1)then
     cgx=1.0/REAL((-1)*facx1*facx2*facx3*facx4*facx5*facx6)
   else if(vmod.eq.0)then
     cgx=1.0/REAL(facx1*facx2*facx3*facx4*facx5*facx6)
   end if
   
else if(vmax.gt.vmin)then
cgx=0
do v=vmin,vmax,1
   cgx1=v
     if(cgx1.lt.0)then
       write(*,*)"The input value is BAD!!!"
!       exit
     else if(cgx1.eq.0)then
       facx1=1
     else if(cgx1.gt.0)then
       call factorial(cgx1,facx1)
     end if
   cgx2=j1+j2-j3-v
     if(cgx2.lt.0)then
       write(*,*)"The input value is BAD!!!"
!       exit
     else if(cgx2.eq.0)then
       facx2=1
     else if(cgx2.gt.0)then
       call factorial(cgx2,facx2)
     end if
   cgx3=j1-m1-v
     if(cgx3.lt.0)then
       write(*,*)"The input value is BAD!!!"
!       exit
     else if(cgx3.eq.0)then
       facx3=1
     else if(cgx3.gt.0)then
       call factorial(cgx3,facx3)
     end if
   cgx4=j2+m2-v
     if(cgx4.lt.0)then
       write(*,*)"The input value is BAD!!!"
!       exit
     else if(cgx4.eq.0)then
       facx4=1
     else if(cgx4.gt.0)then
       call factorial(cgx4,facx4)
     end if
   cgx5=j3-j1-m2+v
     if(cgx5.lt.0)then
       write(*,*)"The input value is BAD!!!"
!       exit
     else if(cgx5.eq.0)then
       facx5=1
     else if(cgx5.gt.0)then
       call factorial(cgx5,facx5)
     end if
   cgx6=j3-j2+m1+v
     if(cgx6.lt.0)then
       write(*,*)"The input value is BAD!!!"
!       exit
     else if(cgx6.eq.0)then
       facx6=1
     else if(cgx6.gt.0)then
       call factorial(cgx6,facx6)
     end if

   vabs=ABS(v)
   vmod=MOD(vabs,2)
   
   if(vmod.eq.1)then
     cgxv=1.0/REAL((-1)*facx1*facx2*facx3*facx4*facx5*facx6)
   else if(vmod.eq.0)then
     cgxv=1.0/REAL(facx1*facx2*facx3*facx4*facx5*facx6)
   end if
   
   cgx=cgx+cgxv
   
end do
end if
!write(*,*)"the cgx value:"
!write(*,*)cgx

!!!!!!!!!!!!!!!!!!!!!!!!!!!AFTER SQRTed the cgs value!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!if(cgx.eq.0)then
!  cg=0
!!  write(*,*)"The Clebsh-Gordan Factor value:"
!!  write(*,*)cg
!else if(cgx.ne.0)then
!  cgxr=REAL(cgx)

!!!write(*,*)"the cgxr value:"
!!!write(*,*)cgxr

!  cg=cgs*cgxr
!!  write(*,*)"The Clebsh-Gordan Factor value:"
!!  write(*,*)cg
!end if
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!NOT SQRTed the cgs value!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
if(cgx.eq.0)then
   cg=0
!  write(*,*)"The Clebsh-Gordan Factor value:"
!  write(*,*)cg
else if(cgx.gt.0)then
  cgxr=(REAL(cgx))**(2)

!!write(*,*)"the cgxr value:"
!!write(*,*)cgxr

  cg=cgs*cgxr
!  write(*,*)"The Clebsh-Gordan Factor value:"
!  write(*,*)cg
else if(cgx.lt.0)then
   cgxr=(REAL((-1)*cgx))**(2)

!!write(*,*)"the cgxr value:"
!!write(*,*)cgxr

  cg=(-1)*cgs*cgxr
!  write(*,*)"The Clebsh-Gordan Factor value:"
!  write(*,*)cg
end if
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

end if
end subroutine
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!SUBROUTINE TWO PROGRAM!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine factorial(k,fac)
implicit none
integer k,fac,fac_cont
!     if(k.lt.0)then
!     write(*,*)"the values of i, j are BAD"
!else if(k.eq.0)then
!     write(*,*)"the value of factorial:"
!     write(*,*)1
!else if(k.gt.0)then
     fac=1
     if(k.gt.0)then
     do fac_cont=1,k
        fac=fac*fac_cont
     end do
!     write(*,*)"the value of factorial:"
!     write(*,*)fac
     end if
end subroutine
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

[ Last edited by xk6891 on 2011-9-5 at 15:14 ]
回复此楼

» 收录本帖的淘帖专辑推荐

第一性原理计算辅助工具 condensed matter physics

» 猜你喜欢

» 本主题相关价值贴推荐，对您同样有帮助:
1楼 2011-09-05 15:13:31
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

zzy870720z

荣誉版主 (文坛精英)

★★★★★ 五星级,优秀推荐

★★★★★ 五星级
赞一下 回复此楼
2楼2011-09-06 10:24:56
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

wo_PLHN

金虫 (小有名气)

★★★★★ 五星级,优秀推荐

绝对的好贴啊，收藏了啊
赞一下 回复此楼
4楼2011-09-08 10:52:24
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

hutuya

新虫 (小有名气)

★★★★★ 五星级,优秀推荐

不错呀，好人呀
回复此楼
5楼2011-12-13 16:51:56
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

kervinzhao

铁杆木虫 (职业作家)

★★★★★ 五星级,优秀推荐

good   good
回复此楼
7楼2011-12-18 20:32:12
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
简单回复
sg184089263楼
2011-09-07 19:59   回复  
五星好评  
houqz5206楼
2011-12-13 19:46   回复  
五星好评  谢谢分享！
相关版块跳转 我要订阅楼主 xk6891 的主题更新
71/1返回列表
☆ 无星级 ★ 一星级 ★★★ 三星级 ★★★★★ 五星级
普通表情 龙 兔 虎 猫 高级回复 (可上传附件)
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[博后之家] 售SCI一区文章，我:8O5.5.1.O5.4,科目全,可伽急 +3 h4CP7TrQR8Lg 2026-08-22 3/150 2026-08-23 16:30 by lXgU0RvNTDC9
[硕博家园] 售SCI一区T0P文章，我:8.O55.1.O.54,科目全,可十急 +3 2JOx3r2CYEgw 2026-08-21 6/300 2026-08-23 14:21 by KM5EcsNQRBPn
[考博] 售SCI一区T0P文章，我:8.O.55.1.O.54,科目齐全,可+急 +3 h4CP7TrQR8Lg 2026-08-22 5/250 2026-08-23 12:09 by LR9qGULyN2ew
[基金申请] 2026国自然函评费到账 +15 羊腰板 2026-08-21 16/800 2026-08-23 10:45 by process2012
[基金申请] 今天放榜吗？ +15 布布和一二 2026-08-19 16/800 2026-08-23 09:55 by 张春生
[硕博家园] 售SCI一区T0P文章，我:8.O.55.1.O.5.4,科目全,可+急 +3 2JOx3r2CYEgw 2026-08-22 7/350 2026-08-23 03:55 by OEbVnUOu01ol
[论文投稿] 售SCI一区T0P文章，我:8.O.55.1.O.5.4,科目全,可+急 +3 QTy3jDtz1uLt 2026-08-21 9/450 2026-08-23 03:04 by OEbVnUOu01ol
[硕博家园] 售SCI一区T0P文章，我:8O.55.1.O.54,科目全,可伽急 +4 QTy3jDtz1uLt 2026-08-21 11/550 2026-08-23 02:55 by OEbVnUOu01ol
[基金申请] 范进中举一文的中心思想 +3 zjuhero 2026-08-22 4/200 2026-08-22 20:02 by mycsru
[基金申请] 只有每年这种时候来逛逛小木虫 +24 yaoyewhu2008 2026-08-20 26/1300 2026-08-22 17:43 by kammury
[基金申请] 人气不行了 +8 fansofjerry 2026-08-21 8/400 2026-08-22 16:30 by zyqchem
[基金申请] 时间戳今天，20号变了 +5 archvillain 2026-08-20 5/250 2026-08-22 06:12 by hui_daxiao
[基金申请] 建议基金发布提前给出明确的时间点 +10 kulium 2026-08-21 13/650 2026-08-21 21:58 by alongwaytogo
[基金申请] 今日不放榜？网传国自然预计 8 月 27 日可查结果 +16 医学老男孩 2026-08-20 20/1000 2026-08-21 21:13 by Ldrop2023
[基金申请] 今天放榜没戏了吧 +9 yuleib84 2026-08-19 11/550 2026-08-21 10:06 by gltch
[基金申请] 估计是周四 +3 archvillain 2026-08-18 3/150 2026-08-21 01:48 by jnhyjjm
[基金申请] 重要消息，中午系统在维护 +11 yuleib84 2026-08-18 12/600 2026-08-20 11:09 by xskun
[基金申请] 朋友圈看到的 +6 wangzilk 2026-08-18 8/400 2026-08-19 10:55 by Haru815
[基金申请] 明天放榜？ +5 Shxjjxjkx 2026-08-18 5/250 2026-08-18 18:14 by -大大大大大-
[基金申请] 今天维护系统维护 祝所有人 高中 +8 gjjjzhong 2026-08-18 9/450 2026-08-18 13:01 by 家与远方
信息提示
关闭
请填处理意见
关闭