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

客戶端APP下載

論文輔導

調(diào)劑小程序

登錄注冊

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

24小時熱門版塊排行榜

返回列表

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

xk6891

至尊木蟲 (著名寫手)

應助: 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

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

zzy870720z

榮譽版主 (文壇精英)

應助: 47 (小學生)
貴賓: 9.05
金幣: 30914.3
帖子: 12592
在線: 23567.6小時
蟲號: 745488

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

★★★★★ 五星級

贊一下

回復此樓

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

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

wo_PLHN

金蟲 (小有名氣)

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

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

絕對的好貼啊，收藏了啊

贊一下

回復此樓

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

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

hutuya

新蟲 (小有名氣)

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

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

不錯呀，好人呀

回復此樓

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

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

kervinzhao

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

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

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

good good

回復此樓

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

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

簡單回復

sg184089263樓

2011-09-07 19:59 回復

五星好評

houqz5206樓

2011-12-13 19:46 回復

五星好評謝謝分享！

相關版塊跳轉我要訂閱樓主 xk6891 的主題更新

返回列表

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

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

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

[考研] 一志愿天津大學化學工藝專業(yè)（081702）315分求調(diào)劑 +11	yangfz 2026-03-17	11/550	2026-03-19 15:06 by houyaoxu
[考研] 324分 085600材料化工求調(diào)劑 +3	llllkkkhh 2026-03-18	3/150	2026-03-19 14:22 by houyaoxu
[考研] 求調(diào)劑 +3	Mqqqqqq 2026-03-19	3/150	2026-03-19 14:11 by peike
[考研] 化學求調(diào)劑 +3	臨澤境llllll 2026-03-17	4/200	2026-03-19 13:59 by houyaoxu
[考研] 一志愿吉林大學材料學碩321求調(diào)劑 +6	Ymlll 2026-03-18	9/450	2026-03-19 10:28 by 星空星月
[考研] 274求調(diào)劑 +6	S.H1 2026-03-18	6/300	2026-03-19 09:34 by 花店相見
[考研] 330求調(diào)劑 +3	小材化本科 2026-03-18	3/150	2026-03-18 21:55 by 無懈可擊111
[考研] 一志愿西南交大，求調(diào)劑 +4	材化逐夢人 2026-03-18	4/200	2026-03-18 14:22 by 007_lilei
[考研] 0854，計算機類招收調(diào)劑 +3	胡辣湯放糖 2026-03-15	6/300	2026-03-18 12:09 by 上岸上岸……..
[考博] 環(huán)境領域全國重點實驗室招收博士1-2名 +3	QGZDSYS 2026-03-13	5/250	2026-03-18 11:13 by QGZDSYS
[考研] 265求調(diào)劑 +3	梁梁校校 2026-03-17	3/150	2026-03-18 09:12 by zhukairuo
[考博] 26博士申請 +3	1042136743 2026-03-17	3/150	2026-03-17 23:30 by 輕松不少隨
[考研] 296求調(diào)劑 +5	大口吃飯身體健 2026-03-13	5/250	2026-03-17 21:05 by 不惑可樂
[考研] 301求調(diào)劑 +4	A_JiXing 2026-03-16	4/200	2026-03-17 17:32 by ruiyingmiao
[考研] 085601求調(diào)劑 +4	Du.11 2026-03-16	4/200	2026-03-17 17:08 by ruiyingmiao
[考研] 26考研求調(diào)劑 +6	丶宏Sir 2026-03-13	6/300	2026-03-17 16:13 by 醉在風里
[考研] 一志愿211 0703方向310分求調(diào)劑 +3	努力奮斗112 2026-03-15	3/150	2026-03-16 16:44 by houyaoxu
[考研] 085600調(diào)劑 +5	漾漾123sun 2026-03-12	6/300	2026-03-16 15:58 by 漾漾123sun
[考研] 288求調(diào)劑 +4	奇點0314 2026-03-14	4/200	2026-03-14 23:04 by JourneyLucky
[考研] ［0860］321分求調(diào)劑，ab區(qū)皆可 +4	寶貴熱 2026-03-13	4/200	2026-03-13 22:01 by 星空星月

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

24小時熱門版塊排行榜

xk6891

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

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

» 猜你喜歡

» 本主題相關價值貼推薦，對您同樣有幫助:

zzy870720z

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

wo_PLHN

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

hutuya

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

kervinzhao

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

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

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