 |
 |
 |
 |
 |
 |
||
 |
 |
 |
 |
 |
| 5 | 1/1 | 返回列表 |
| 查看: 3058 | 回復(fù): 3 | ||
| 當(dāng)前只顯示滿足指定條件的回帖，點(diǎn)擊這里查看本話題的所有回帖 | ||
dailjiao0706新蟲 (初入文壇)
|
[求助]
fortran中的數(shù)組越界問(wèn)題，
|
|
|
MODULE my_Constants !------------------------------------------------------------------------------------ IMPLICIT NONE integer, parameter :: r8=selected_real_kind(p=13) !double precision real(r8), PARAMETER :: pi = 3.1415926535897932 !pi real(r8), PARAMETER :: c = 2.99792458e08 !Speed of light (m/s) real(r8), PARAMETER :: e0=1.0e07/(4*pi*c**2) !vacuum permittivity real(r8), PARAMETER :: er=1 !relative permittivity real(r8), PARAMETER :: u0=pi*4e-07 !vacuum permeability real(r8), PARAMETER :: mp=1.6726231e-27 !Proton rest mass(kg) real(r8), PARAMETER :: me=9.1093897e-31 !Electron rest mass(kg) real(r8), PARAMETER :: e=1.60217733e-19 !Elementary charge (C) END MODULE my_Constants !==================================================================================== program CE !------------------------------------------------------ use my_Constants implicit none !------------- parameters ----------------------------------------- real(r8), PARAMETER :: e2_4pie0=e*e/(4*pi*e0) real(r8), PARAMETER :: Iinner=4.3247737e19 !intensity for full inner ionization(W/m2) real(r8), PARAMETER :: lambda=8e-7 !electric field's wavelength(m) real(r8), PARAMETER :: we=2*pi*c/lambda !electric field's frequency real(r8), PARAMETER :: th=50e-15 !FWHM: tp=th/(2*sqrt(log(2.0))) real(r8), PARAMETER :: tstart=0.0 INTEGER, PARAMETER :: M=5005 !M----t INTEGER, PARAMETER :: iduation=5004 real(r8), dimension(M) :: RH_bord,RI_bord,Ne,Inten,pou_e,ttime real(r8), PARAMETER :: IeV=1.6e19 !intensity for ionic energy ~300eV(W/m2) real(r8), PARAMETER :: er0=1e-4 real(r8), PARAMETER :: KeV=1000*e ! change energy unit from J to KeV real(r8), PARAMETER :: dt=10.0e-17 real(r8), PARAMETER :: dt2=dt*dt real(r8), PARAMETER :: dr=5.0e-11 real(r8), PARAMETER :: F0=2.0e21 !peak intensity of electric field(W/cm2) INTEGER :: i,j,b,y,y0,y1,i_inner,yHmax,yImax,y2,dy2,jmax real(r8) :: t,tp,Nemin,RH_y,RI_y,EH,EI real(r8) :: yminH,yminI,RIHmin,RHImin,yHbord,yIbord real(r8) :: EkHmax,EkImax,EaverH,EaverI,dNH,dNI,EH_term,EI_term,sumH,sumI !-----------the following parameters relates to the size distribution --------------------- real(r8), PARAMETER :: R0=5.0e-9 !4e-9 for 2w, 2e-9 for 3w real(r8), PARAMETER :: n0=1.6e28 !cluster density (/m**3) real(r8), PARAMETER :: NI=(4.0/3)*pi*(R0**3)*n0 real(r8), PARAMETER :: NH=NI*4 real(r8), PARAMETER :: pou0_I=n0 real(r8), PARAMETER :: pou0_H=n0*4 INTEGER, PARAMETER :: QI=4 real(r8), PARAMETER :: mI=12*mp !---------------------------------------------- real(r8), PARAMETER :: dr_alongr=5.0e-11 integer :: Ndr ! Ndr=int(R0(j)/dr_alongr)+1 INTEGER :: ierr real(r8),dimension(  , allocatable :: RH_0,RI_0real(r8),dimension(:, , allocatable :: RH,RI,pout_H,pout_I,NHH_y,NIH_y,NHI_y,NII_y,F_HH,F_HI,F_IH,F_II,F_He,F_Ie ! 原程序?yàn)镽H,RIwrite(*,*) "i_inner=",i_inner ! 輸出i_inner 值為0，說(shuō)明在默認(rèn)情況下不賦值則系統(tǒng)給整數(shù)參數(shù)賦值為0，這就導(dǎo)致i_inner-1=-1,顯然數(shù)組的下標(biāo)不能為負(fù)值。再有，新版fortran數(shù)組下標(biāo)從1開(kāi)始,所以給i_inner賦初值為2 i_inner=2 !-------------------------------------------------------- write(*,*) "i_inner=",i_inner !------------------------------------------------------------------ open(unit=9,file='F_t.dat') ! open(unit=15,file='pout_H.dat') ! open(unit=16,file='RH_r_t_R0_5.dat') ! open(unit=17,file='RI_r_t_R0_5.dat') ! open(unit=18,file='pout_I.dat') ! open(unit=19,file='NII.dat') ! open(unit=20,file='NIH.dat') ! open(unit=21,file='NHH.dat') ! open(unit=22,file='NHI.dat') ! !************************************************************************************ !========== loop for the cluster-size distribution ==================================== Ndr=int(R0/dr_alongr)+1 write(*,*) "Ndr=",Ndr !======= Allocate arrays according to the exact different cluster-size =============== allocate (RH_0(Ndr),stat=ierr) if(ierr/=0)then write(*,*)"Unable to allocate memory for array RH_0 " stop "Stopping" end if ! allocate (RI_0(Ndr),stat=ierr) if(ierr/=0)then write(*,*)"Unable to allocate memory for array RI_0 " stop "Stopping" end if ! allocate (RH(Ndr,M),stat=ierr) if(ierr/=0)then write(*,*)"Unable to allocate memory for array RH " stop "Stopping" end if ! allocate (RI(Ndr,M),stat=ierr) if(ierr/=0)then write(*,*)"Unable to allocate memory for array RI " stop "Stopping" end if !RH_0=0 !pause !======= divide many layers along the radius ======================================== layer1_loop: do y=1,Ndr RH_0(y)=(y-1)*dr_alongr RI_0(y)=(y-1)*dr_alongr end do layer1_loop !======== initialize the cluster radius & charge ========================= t=tstart layer2_loop: do i=1,iduation-1 ttime(i)=t RH_bord(i)=R0 RI_bord(i)=R0 Ne(i)=0.0 layer3_loop: do y=1,Ndr RH(y,i)=RH_0(y) RI(y,i)=RI_0(y) end do layer3_loop t=t+dt end do layer2_loop !------ set the connecting condition between inner and outer ionization ---------------- Ne(i_inner-1)=0.0 Ne(i_inner)=0.0 Ne(i_inner)=0.0 pou_e(i_inner)=0.0 !==== compute temporal evolution of layers along radius during outer ionization period === ! outer1_loop: do i=2,iduation !------ judge if the cluster is outer-ionized fully ---------- full_check1: if (Ne(i)<=0.0) then Ne(i)=0.0 ! pou_e(i)=0.0 end if full_check1 !---- Ne(t) at the next time point must be smaller than that of the present time ---- reasonable_check: if (Ne(i)>Ne(i-1)) then Ne(i)=0.0 end if reasonable_check pou_e(i)=0.0 !==== compute temporal evolution of layers along radius========== layer4_loop: do y0=2,Ndr RH_bord(i+1)=RH_bord(i) RI_bord(i+1)=RI_bord(i) !------ set the RH_y/RC_y as the layer subjeIt ----------- RH_y=RH(y0,i) RI_y=RI(y0,i) !----- assume the electrons distribute uniformly within the cluster ----------- F_He=0.0 F_Ie=0.0 !------------------------ NHH_y=0.0 NIH_y=0.0 NHI_y=0.0 NII_y=0.0 RIHmin=0.0 RHImin=0.0 !==== count the number of C/H ions included in a certain radius RH_y/RI_y ========== layer5_loop: do y1=2,Ndr !------------------------ NHH_count: if (RH(y1,i)<=RH_y) then NHH_y(y1,1)=NHH_y(y1-1,1)+pou0_H*4*pi/3* (RH(y1,1)**3-RH(y1-1,1)**3) end if NHH_count !------------------------ NII_count: if (RI(y1,i)<=RI_y) then NII_y(y1,1)=NII_y(y1-1,1)+pou0_I*4*pi/3*(RI(y1,1)**3-RI(y1-1,1)**3) end if NII_count !------------------------ NIH_count: if (RH(y1,i)<=RI_y) then NIH_y(y1,1)=NIH_y(y1-1,1)+pou0_H*4*pi/3*(RH(y1,1)**3-RH(y1-1,1)**3) if (RH(y1,i)>RIHmin) then RIHmin=RH(y1,i) yminH=y1 end if end if NIH_count !------------------------ NHI_count: if (RI(y1,i)<=RH_y) then NHI_y(y1,1)=NHI_y(y1-1,1)+pou0_I*4*pi/3*(RI(y1,1)**3-RI(y1-1,1)**3) if (RI(y1,i)>RHImin) then RHImin=RI(y1,i) yminI=y1 end if end if NHI_count !------------------------ end do layer5_loop !===== make some repairs for perfect ============================================= if (NIH_y(y0,i)==0.0) then pout_H(y0,i)=pou0_H*(RH(2,1)/RH(y0,i))**3 NIH_y(y0,i)=4*pi/3*RI_y**3*pout_H(2,i) else if (RI_y<=RH_bord(i)) then ! pout_H(y0,i)=NH/(4*pi/3*RH_bord(i)**3) !--little effected--! pout_H(y0,i)=pou0_H*(RH(yminH,1)**3-RH(yminH-1,1)**3)/abs(RH(yminH,i)**3-RH(yminH-1,i)**3) NIH_y(y0,i)=NIH_y(y0-1,i)+pout_H(y0,i)*4*pi/3*(RI_y**3-RIHmin**3) end if !--------------------------------------------- if (NHI_y(y0,i)==0.0) then pout_I(y0,i)=pou0_I*(RI(2,1)/RI(y0,i))**3 ! NHI_y(y0,i)=4*pi/3*RH_y**3*pout_I(y0,i) else if(RH_y<=RI_bord(i)) then ! pout_I=NI/(4*pi/3*RI_bord(i)**3) !--little effected--! pout_I(y0,i)=pou0_I*(RI(yminI,1)**3-RI(yminI-1,1)**3)/abs(RI(yminI,i)**3-RI(yminI-1,i)**3) NHI_y(y0,i)=NHI_y(y0-1,i)+pout_I(y0,i)*4*pi/3*(RH_y**3-RHImin**3) end if !------------------------ F_HH(y0,i)=e2_4pie0*NHH_y(y0,i)/(RH_y**2) F_HI(y0,i)=e2_4pie0*QI*NHI_y(y0,i)/(RH_y**2) F_IH(y0,i)=QI*e2_4pie0*NIH_y(y0,i)/(RI_y**2) F_II(y0,i)=QI*QI*e2_4pie0*NII_y(y0,i)/(RI_y**2) !------------------------------------------------------------------------ RH(y0,i+1)=dt2/mp*(F_HH(y0,i+1)+F_HI(y0,i+1)+F_He(y0,i+1))+2*RH(y0,i)-RH(y0,i-1) RI(y0,i+1)=dt2/mI*(F_IH(y0,i+1)+F_II(y0,i+1)+F_Ie(y0,i+1))+2*RI(y0,i)-RI(y0,i-1) !---------- find the new maximum borders -------------------------------- RH_border: if (RH(y0,i+1)>RH_bord(i+1)) then yHbord=y0 RH_bord(i+1)=RH(y0,i+1) end if RH_border RI_border: if (RI(y0,i+1)>RI_bord(i+1)) then yIbord=y0 RI_bord(i+1)=RI(y0,i+1) end if RI_border !------------------------------------------------------------------------ end do layer4_loop !--------- set Ne(t) at the next time point --------------------------------- full_check2: if (Ne(i)<=0.0) then ! if Ne(i)<=0 "it's full outer ionization." Ne(i+1)=0.0 ! pou_e(i+1)=0.0 else full_check2 Ne(i+1)=0.0 ! pou_e(i+1)=Ne(i+1)/(4.0*pi*RH_bord(i+1)**3/3) end if full_check2 !-------------------------------------------------------------------- end do outer1_loop !****************************************************************************************** !======== output the necessary data ===================================== write(16,*) R0 write(16,*) Ndr out_time: do i=3,iduation,50 write(16,*) ttime(i)/1e-15 write(17,*) ttime(i)/1e-15 out_layer: do y=1,Ndr write(16,*) RH(y,i) write(16,*) RH(y,i-1) write(15,*) pout_H(y,i) write(18,*) pout_I(y,i) write(19,*) NII_y(y,i) write(20,*) NIH_y(y,i) write(21,*) NHH_y(y,i) write(22,*) NHI_y(y,i) end do out_layer end do out_time !======It is important to deallocate the arrays ==================================== deallocate(RH_0,RI_0,RH,RI) !********************************************************************* close(15) close(16) close(17) !---------------------------------------------------------------------------- end program CE !================================================ |
回復(fù)此樓» 猜你喜歡
求調(diào)劑材料學(xué)碩080500，總分289分
已經(jīng)有20人回復(fù)
-
070300化學(xué)求調(diào)劑
已經(jīng)有5人回復(fù)
-
085600材料與化工
已經(jīng)有10人回復(fù)
-
北科281學(xué)碩材料求調(diào)劑
已經(jīng)有7人回復(fù)
-
276求調(diào)劑。有半年電池和半年高分子實(shí)習(xí)經(jīng)歷
已經(jīng)有4人回復(fù)
-
284求調(diào)劑
已經(jīng)有6人回復(fù)
-
306求調(diào)劑
已經(jīng)有7人回復(fù)
-
291求調(diào)劑
已經(jīng)有5人回復(fù)
-
070300，一志愿北航320求調(diào)劑
已經(jīng)有5人回復(fù)
-
0703 調(diào)劑
已經(jīng)有6人回復(fù)
» 本主題相關(guān)價(jià)值貼推薦，對(duì)您同樣有幫助:
- fortran的array bounds exceeded錯(cuò)誤
已經(jīng)有5人回復(fù)
- 求助數(shù)組越界問(wèn)題！
已經(jīng)有8人回復(fù)
- fortran 程序有write和沒(méi)有write兩種情況計(jì)算的結(jié)果為什么會(huì)不一樣?
已經(jīng)有14人回復(fù)
- fortran讀寫問(wèn)題
已經(jīng)有6人回復(fù)
- 求助：關(guān)于fortran建數(shù)組問(wèn)題，謝謝！
已經(jīng)有4人回復(fù)
- ABAQUS中的用戶子程序fortran編寫問(wèn)題
已經(jīng)有4人回復(fù)
- Fortran中數(shù)組的使用
已經(jīng)有4人回復(fù)
- FORTRAN新手 求助主程序循環(huán)問(wèn)題
已經(jīng)有10人回復(fù)
- 請(qǐng)教Fortran下如何給二維或三維數(shù)組賦初值，謝謝
已經(jīng)有3人回復(fù)
- intel fortran局部變量自動(dòng)更新
已經(jīng)有19人回復(fù)
- Fortran中關(guān)于數(shù)組的變化
已經(jīng)有5人回復(fù)
- Fortran的格式化輸入輸出問(wèn)題
已經(jīng)有14人回復(fù)
- 請(qǐng)教一個(gè)while loop程序的問(wèn)題
已經(jīng)有5人回復(fù)
- fortran兩個(gè)問(wèn)題，文件中的空格，屏幕同一行覆蓋輸出
已經(jīng)有23人回復(fù)
- 【求助】一點(diǎn)FORTRAN的問(wèn)題【已完結(jié)】
已經(jīng)有3人回復(fù)
- 【求助】求指點(diǎn)，在Fortran里面，怎樣實(shí)現(xiàn)“數(shù)組維度可調(diào)”的數(shù)組?
已經(jīng)有5人回復(fù)
- 【求助】fortran中怎么存儲(chǔ)不確定長(zhǎng)度的數(shù)據(jù)【已完結(jié)】
已經(jīng)有6人回復(fù)
dailjiao0706
新蟲 (初入文壇)
- 應(yīng)助: 0 (幼兒園)
- 金幣: 4
- 帖子: 10
- 在線: 4.9小時(shí)
- 蟲號(hào): 2059068
- 注冊(cè): 2012-10-13
- 專業(yè): 原子和分子物理
3樓2013-10-17 13:45:26
virtualzx
木蟲 (著名寫手)
- 應(yīng)助: 263 (大學(xué)生)
- 金幣: 7161.3
- 紅花: 54
- 帖子: 1605
- 在線: 317.6小時(shí)
- 蟲號(hào): 2069080
- 注冊(cè): 2012-10-18
- 性別: GG
- 專業(yè): 理論和計(jì)算化學(xué)
2樓2013-10-16 21:56:02
| 最具人氣熱帖推薦 [查看全部] | 作者 | 回/看 | 最后發(fā)表 | |
|---|---|---|---|---|
|
[考研] 招08考數(shù)學(xué) +4 | laoshidan 2026-03-20 | 11/550 |
|
|---|---|---|---|---|
|
[考研] 305分求調(diào)劑（食品工程） +4 | Sxy112 2026-03-21 | 6/300 |
|
|
|
[考研] 能源材料化學(xué)課題組招收碩士研究生8-10名 +5 | 脫穎而出 2026-03-16 | 17/850 |
|
|
|
[考研] 311求調(diào)劑 +3 | 26研0 2026-03-20 | 3/150 |
|
|
|
[考研] 285求調(diào)劑 +6 | ytter 2026-03-22 | 6/300 |
|
|
|
[考研] 求助 +5 | 夢(mèng)里的無(wú)言 2026-03-21 | 6/300 |
|
|
|
[考研] 299求調(diào)劑 +5 | shxchem 2026-03-20 | 7/350 |
|
|
|
[考研] 求調(diào)劑 +3 | .m.. 2026-03-21 | 4/200 |
|
|
|
[考研] 材料與化工（0856）304求 B區(qū) 調(diào)劑 +3 | 邱gl 2026-03-21 | 3/150 |
|
|
|
[考研] 316求調(diào)劑 +6 | 梁茜雯 2026-03-19 | 6/300 |
|
|
|
[考研] 324分 085600材料化工求調(diào)劑 +4 | llllkkkhh 2026-03-18 | 4/200 |
|
|
|
[考研] 22408 344分 求調(diào)劑 一志愿 華電計(jì)算機(jī)技術(shù) +4 | solanXXX 2026-03-20 | 4/200 |
|
|
|
[考研] 一志愿 西北大學(xué) ，070300化學(xué)學(xué)碩，總分287，雙非一本，求調(diào)劑。 +4 | 晨昏線與星海 2026-03-19 | 4/200 |
|
|
|
[考研] 求調(diào)劑，一志愿:南京航空航天大學(xué)大學(xué) ，080500材料科學(xué)與工程學(xué)碩，總分289分 +4 | @taotao 2026-03-19 | 4/200 |
|
|
|
[考研] 求調(diào)劑一志愿南京航空航天大學(xué)289分 +3 | @taotao 2026-03-19 | 3/150 |
|
|
|
[考研] 材料學(xué)碩318求調(diào)劑 +5 | February_Feb 2026-03-19 | 5/250 |
|
|
|
[考研] 081700化工學(xué)碩調(diào)劑 +3 | 【1】 2026-03-16 | 3/150 |
|
|
|
[考研] 材料考研調(diào)劑 +3 | xwt。 2026-03-19 | 3/150 |
|
|
|
[考研] 085601專碩，總分342求調(diào)劑，地區(qū)不限 +5 | share_joy 2026-03-16 | 5/250 |
|
|
|
[考研] 275求調(diào)劑 +4 | 太陽(yáng)花天天開(kāi)心 2026-03-16 | 4/200 |
|