 |
 |
 |
 |
 |
 |
||
 |
 |
 |
 |
 |
| 4 | 1/1 | 返回列表 |
| 查看: 3052 | 回復(fù): 3 | ||
dailjiao0706新蟲 (初入文壇)
|
[求助]
fortran中的數(shù)組越界問題，
|
|
|
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 ! 原程序為RH,RIwrite(*,*) "i_inner=",i_inner ! 輸出i_inner 值為0，說明在默認情況下不賦值則系統(tǒng)給整數(shù)參數(shù)賦值為0，這就導(dǎo)致i_inner-1=-1,顯然數(shù)組的下標(biāo)不能為負值。再有，新版fortran數(shù)組下標(biāo)從1開始,所以給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ù)此樓» 猜你喜歡
0703化學(xué)調(diào)劑
已經(jīng)有12人回復(fù)
-
0703化學(xué) 305求調(diào)劑
已經(jīng)有4人回復(fù)
-
0703化學(xué)調(diào)劑，求各位老師收留
已經(jīng)有10人回復(fù)
-
271材料工程求調(diào)劑
已經(jīng)有5人回復(fù)
-
281求調(diào)劑（0805）
已經(jīng)有16人回復(fù)
-
304求調(diào)劑
已經(jīng)有6人回復(fù)
-
材料工程專碩調(diào)劑
已經(jīng)有6人回復(fù)
-
一志愿天大材料與化工（085600）總分338
已經(jīng)有4人回復(fù)
-
085700資源與環(huán)境308求調(diào)劑
已經(jīng)有3人回復(fù)
-
求材料調(diào)劑
已經(jīng)有8人回復(fù)
» 本主題相關(guān)價值貼推薦，對您同樣有幫助:
- fortran的array bounds exceeded錯誤
已經(jīng)有5人回復(fù)
- 求助數(shù)組越界問題！
已經(jīng)有8人回復(fù)
- fortran 程序有write和沒有write兩種情況計算的結(jié)果為什么會不一樣?
已經(jīng)有14人回復(fù)
- fortran讀寫問題
已經(jīng)有6人回復(fù)
- 求助：關(guān)于fortran建數(shù)組問題，謝謝！
已經(jīng)有4人回復(fù)
- ABAQUS中的用戶子程序fortran編寫問題
已經(jīng)有4人回復(fù)
- Fortran中數(shù)組的使用
已經(jīng)有4人回復(fù)
- FORTRAN新手 求助主程序循環(huán)問題
已經(jīng)有10人回復(fù)
- 請教Fortran下如何給二維或三維數(shù)組賦初值，謝謝
已經(jīng)有3人回復(fù)
- intel fortran局部變量自動更新
已經(jīng)有19人回復(fù)
- Fortran中關(guān)于數(shù)組的變化
已經(jīng)有5人回復(fù)
- Fortran的格式化輸入輸出問題
已經(jīng)有14人回復(fù)
- 請教一個while loop程序的問題
已經(jīng)有5人回復(fù)
- fortran兩個問題，文件中的空格，屏幕同一行覆蓋輸出
已經(jīng)有23人回復(fù)
- 【求助】一點FORTRAN的問題【已完結(jié)】
已經(jīng)有3人回復(fù)
- 【求助】求指點，在Fortran里面，怎樣實現(xiàn)“數(shù)組維度可調(diào)”的數(shù)組?
已經(jīng)有5人回復(fù)
- 【求助】fortran中怎么存儲不確定長度的數(shù)據(jù)【已完結(jié)】
已經(jīng)有6人回復(fù)
dailjiao0706
新蟲 (初入文壇)
- 應(yīng)助: 0 (幼兒園)
- 金幣: 4
- 帖子: 10
- 在線: 4.9小時
- 蟲號: 2059068
- 注冊: 2012-10-13
- 專業(yè): 原子和分子物理
3樓2013-10-17 13:45:26
virtualzx
木蟲 (著名寫手)
- 應(yīng)助: 263 (大學(xué)生)
- 金幣: 7161.3
- 紅花: 54
- 帖子: 1605
- 在線: 317.6小時
- 蟲號: 2069080
- 注冊: 2012-10-18
- 性別: GG
- 專業(yè): 理論和計算化學(xué)
2樓2013-10-16 21:56:02
virtualzx
木蟲 (著名寫手)
- 應(yīng)助: 263 (大學(xué)生)
- 金幣: 7161.3
- 紅花: 54
- 帖子: 1605
- 在線: 317.6小時
- 蟲號: 2069080
- 注冊: 2012-10-18
- 性別: GG
- 專業(yè): 理論和計算化學(xué)
4樓2013-10-17 23:58:35
相關(guān)版塊跳轉(zhuǎn)
我要訂閱樓主 dailjiao0706 的主題更新
| 4 | 1/1 | 返回列表 |
| 最具人氣熱帖推薦 [查看全部] | 作者 | 回/看 | 最后發(fā)表 | |
|---|---|---|---|---|
|
[考研]
 271材料工程求調(diào)劑
+5
|
.6lL 2026-03-18 | 5/250 |
|
|---|---|---|---|---|
|
|
[考研] 304求調(diào)劑 +6 | 司空. 2026-03-18 | 6/300 |
|
|
|
[考研] 一志愿吉林大學(xué)材料學(xué)碩321求調(diào)劑 +4 | Ymlll 2026-03-18 | 6/300 |
|
|
[考研] 330求調(diào)劑 +3 | 小材化本科 2026-03-18 | 3/150 |
|
|
|
[考研] 274求調(diào)劑 +5 | S.H1 2026-03-18 | 5/250 |
|
|
|
[考研] 【同濟軟件】軟件（085405）考研求調(diào)劑 +3 | 2026eternal 2026-03-18 | 3/150 |
|
|
|
[考研] 311求調(diào)劑 +11 | 冬十三 2026-03-15 | 12/600 |
|
|
|
[考研] 0703化學(xué)調(diào)劑 +3 | 妮妮ninicgb 2026-03-17 | 3/150 |
|
|
|
[考研] 301求調(diào)劑 +9 | yy要上岸呀 2026-03-17 | 9/450 |
|
|
|
[考博] 26申博 +4 | 八旬速覽 2026-03-16 | 4/200 |
|
|
|
[考研] 275求調(diào)劑 +4 | 太陽花天天開心 2026-03-16 | 4/200 |
|
|
|
[考研] 一志愿，福州大學(xué)材料專碩339分求調(diào)劑 +3 | 木子momo青爭 2026-03-15 | 3/150 |
|
|
|
[考研] [導(dǎo)師推薦]西南科技大學(xué)國防/材料導(dǎo)師推薦 +3 | 尖角小荷 2026-03-16 | 6/300 |
|
|
|
[考研] 327求調(diào)劑 +6 | 拾光任染 2026-03-15 | 11/550 |
|
|
|
[考研] 080500，材料學(xué)碩302分求調(diào)劑學(xué)校 +4 | 初識可樂 2026-03-14 | 5/250 |
|
|
|
[考研] 308 085701 四六級已過求調(diào)劑 +7 | 溫喬喬喬喬 2026-03-12 | 14/700 |
|
|
|
[考研] 304求調(diào)劑 +7 | 7712b 2026-03-13 | 7/350 |
|
|
|
[考研] 材料專碩350 求調(diào)劑 +4 | 王金科 2026-03-12 | 4/200 |
|
|
|
[考研] 274求調(diào)劑 +3 | S.H1 2026-03-12 | 3/150 |
|
|
|
[考研] 321求調(diào)劑（食品/專碩） +3 | xc321 2026-03-12 | 6/300 |
|