版塊導航: 正在加載中...

客戶端APP下載

論文輔導

調(diào)劑小程序

登錄注冊

應(yīng)《網(wǎng)絡(luò)安全法》要求，自2017年10月1日起，未進行實名認證將不得使用互聯(lián)網(wǎng)跟帖服務(wù)。為保障您的帳號能夠正常使用，請盡快對帳號進行手機號驗證，感謝您的理解與支持！

24小時熱門版塊排行榜

返回列表

【獎勵】本帖被評價6次，作者xk6891增加金幣 4.8 個

xk6891

至尊木蟲 (著名寫手)

應(yīng)助: 0 (幼兒園)
金幣: 13735.8
帖子: 1514
在線: 546小時
蟲號: 890342

[資源] CG系數(shù)--Fortran code

計算CG系數(shù)的一個Fortran代碼，這種東西已經(jīng)很多了，貼出來希望大家能夠多多指導幫助驗證，也希望和大家分享
————————————————————————————————————

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 ]

回復此樓

1樓 2011-09-05 15:13:31

已閱回復此樓關(guān)注TA 給TA發(fā)消息送TA紅花 TA的回帖

zzy870720z

榮譽版主 (文壇精英)

★★★★★ 五星級,優(yōu)秀推薦

★★★★★ 五星級

贊一下

回復此樓

2樓2011-09-06 10:24:56

已閱回復此樓關(guān)注TA 給TA發(fā)消息送TA紅花 TA的回帖

wo_PLHN

金蟲 (小有名氣)

應(yīng)助: 0 (幼兒園)
金幣: 1010.3
帖子: 109
在線: 54.1小時
蟲號: 1130819

★★★★★ 五星級,優(yōu)秀推薦

絕對的好貼啊，收藏了啊

贊一下

回復此樓

4樓2011-09-08 10:52:24

已閱回復此樓關(guān)注TA 給TA發(fā)消息送TA紅花 TA的回帖

hutuya

新蟲 (小有名氣)

應(yīng)助: 2 (幼兒園)
金幣: 858.5
帖子: 195
在線: 39.7小時
蟲號: 210873

★★★★★ 五星級,優(yōu)秀推薦

不錯呀，好人呀

回復此樓

5樓2011-12-13 16:51:56

已閱回復此樓關(guān)注TA 給TA發(fā)消息送TA紅花 TA的回帖

kervinzhao

鐵桿木蟲 (職業(yè)作家)

應(yīng)助: 12 (小學生)
金幣: 10246.7
帖子: 4369
在線: 408.3小時
蟲號: 1455056

★★★★★ 五星級,優(yōu)秀推薦

good good

回復此樓

7樓2011-12-18 20:32:12

已閱回復此樓關(guān)注TA 給TA發(fā)消息送TA紅花 TA的回帖

簡單回復

sg184089263樓

2011-09-07 19:59 回復

五星好評

houqz5206樓

2011-12-13 19:46 回復

五星好評謝謝分享！

相關(guān)版塊跳轉(zhuǎn) 我要訂閱樓主 xk6891 的主題更新

返回列表

☆ 無星級 ★ 一星級 ★★★ 三星級 ★★★★★ 五星級

普通表情龍兔虎貓高級回復 (可上傳附件)

最具人氣熱帖推薦 [查看全部]		作者	回/看	最后發(fā)表

[考研] 085601材料工程專碩求調(diào)劑 +10	慕寒mio 2026-03-16	10/500	2026-03-19 15:26 by 丁丁*
[考研] 材料與化工求調(diào)劑 +7	為學666 2026-03-16	7/350	2026-03-19 14:48 by 盡舜堯1
[考研] 287求調(diào)劑 +3	晨昏線與星海 2026-03-19	4/200	2026-03-19 12:32 by peike
[考研] 332求調(diào)劑 +3	ydfyh 2026-03-17	3/150	2026-03-19 10:14 by 功夫瘋狂
[考研] 0703化學調(diào)劑 +8	妮妮ninicgb 2026-03-15	12/600	2026-03-19 05:55 by anny19840123
[考研] 085700資源與環(huán)境308求調(diào)劑 +3	墨墨漠 2026-03-18	3/150	2026-03-18 22:35 by bingxueer79
[考研] 0854可跨調(diào)劑，一作一項核心論文五項專利，省、國級證書40+數(shù)一英一287 +8	小李0854 2026-03-16	8/400	2026-03-18 14:35 by 搏擊518
[考研] 收復試調(diào)劑生 +4	雨后秋荷 2026-03-18	4/200	2026-03-18 14:16 by elevennnne
[考研] 277調(diào)劑 +5	自由煎餅果子 2026-03-16	6/300	2026-03-17 19:26 by 李leezz
[考研] 332求調(diào)劑 +6	Zz版 2026-03-13	6/300	2026-03-17 17:03 by ruiyingmiao
[考研] 材料工程專碩274一志愿211求調(diào)劑 +6	薛云鵬 2026-03-15	6/300	2026-03-17 11:05 by 學員h26Tkc
[考研] 東南大學364求調(diào)劑 +5	JasonYuiui 2026-03-15	5/250	2026-03-16 21:28 by 木瓜膏
[考研] 中科院材料273求調(diào)劑 +4	yzydy 2026-03-15	4/200	2026-03-16 15:59 by Gaodh_82
[考研] 070303 總分349求調(diào)劑 +3	LJY9966 2026-03-15	5/250	2026-03-16 14:24 by xwxstudy
[考研] 0856求調(diào)劑 +3	劉夢微 2026-03-15	3/150	2026-03-16 10:00 by houyaoxu
[考研] 070305求調(diào)劑 +3	mlpqaz03 2026-03-14	4/200	2026-03-15 11:04 by peike
[考研] 中科大材料與化工319求調(diào)劑 +3	孟鑫材料 2026-03-14	3/150	2026-03-14 20:10 by ms629
[考研] 297一志愿上交085600求調(diào)劑 +5	指尖八千里 2026-03-14	5/250	2026-03-14 17:26 by a不易
[基金申請] 現(xiàn)在如何回避去年的某一個專家，不知道名字 +3	zk200107 2026-03-12	6/300	2026-03-14 17:13 by zk200107
[考研] 081200-11408-276學碩求調(diào)劑 +3	崔wj 2026-03-12	4/200	2026-03-12 19:33 by 求調(diào)劑zz

亭亭五月天在线观看,亭亭五月天在线观看,国产最新av一区二区,国产 高清 中文字幕,99re热久久亚洲综合精品成人,熟妇 一区二区三区,一级做a爰片性色毛片武则天,美女的骚穴视频播放,国产美女午夜免费视频

24小時熱門版塊排行榜

xk6891

[資源] CG系數(shù)--Fortran code

» 收錄本帖的淘帖專輯推薦

» 猜你喜歡

» 本主題相關(guān)價值貼推薦，對您同樣有幫助:

zzy870720z

★★★★★ 五星級,優(yōu)秀推薦

wo_PLHN

★★★★★ 五星級,優(yōu)秀推薦

hutuya

★★★★★ 五星級,優(yōu)秀推薦

kervinzhao

★★★★★ 五星級,優(yōu)秀推薦

亭亭五月天在线观看,亭亭五月天在线观看,国产最新av一区二区,国产高清中文字幕,99re热久久亚洲综合精品成人,熟妇一区二区三区,一级做a爰片性色毛片武则天,美女的骚穴视频播放,国产美女午夜免费视频