fortran
哪位大哥懂fortran帮忙转换成matlab后者c语言,谢谢了Fc
c****************************************************************
c OUTPUT POWER SIMULATION FOR A STRAIGHT STRIPE SLED
c****************************************************************
DOUBLE PRECISION Nto,Ao,c,h,Nold,delta,qel,PI,n2,n1
&,v,Ncar,df,dr,gain,Psp,LHS,Qsp,Po,Qo,PN,QN,RHS
&,Pow,Imax,ISTEP,Iinj,Br,Conf,Clad,Scat,Jinj,lambda
&,Ro,RL,Pin,W,L,d,PL,QZ(500,500),PZ(500,500),z,DZ
&,gmth,gth,Nth,Ith
INTEGER itest,count,Icount,Insteps,IZ,countz
c---------INPUT DATA ----------------------------------------------
OPEN(51,FILE='in4.idat')
read(51,*) W
read(51,*) L
read(51,*) d
read(51,*) Ro
read(51,*) RL
read(51,*) Pin
read(51,*) Imax
read(51,*) Insteps
read(51,*) lambda
read(51,*) Conf
read(51,*) Br
read(51,*) Clad
read(51,*) Scat
read(51,*) Nto
read(51,*) delta
read(51,*) IZ
close(51)
c------------------------------------------------------------------
c... All lengths in um and current in A:
Ao=1.5d-08
c=3.0d+14
n2=3.38d0
n1=3.55d0
h=6.626d-34
qel=1.602d-19
PI=4.0d0*datan(1.0d0)
df=dacos(n2/n1)*(W/L)/(2.0d0*PI)
dr=df
v=c/n1
ISTEP=Imax/dble(Insteps)
DZ=L/dble(IZ)
c------------------------------------------------------------------
c...Threshold modal gain (um-1):
gmth=-dlog(Ro*RL)/(2.0d0*L)
c...Material gain at threshold (um-1):
gth=(gmth-(1.0d0-Conf)*Clad-Scat)/Conf
c...Carrier denisty at threshold (um-3):
Nth=Nto+gth/Ao
c...Threshold current(printed in mA):
Ith=W*L*qel*d*Br*Nth*Nth
print*,Ith*1.0d+03
c------------------------------------------------------------------
OPEN(30,FILE='licurve.dat')
OPEN(32,FILE='pz.dat')
c------------------------------------------------------------------
Nold=1.0d04
DO 100 Icount=1,Insteps
Iinj=dble(Icount)*ISTEP
Jinj=Iinj/(W*L)
LHS=Jinj/(qel*d*v)
call stripe(Conf,Ao,Nto,Br,Pin,Clad,Scat
&,df,dr,Ro,RL,v,L,LHS,delta,Ncar,Psp,Qsp,gain,count
&,Po,Qo)
PL=dexp(gain*L)*Pin/(1.0d0-Ro*RL*dexp(2.0d0*gain*L))
&+(dexp(gain*L)-1.0d0)*(Psp+Ro*dexp(gain*L)*Qsp)
&/(1.0d0-Ro*RL*dexp(2.0d0*gain*L))
Pow=(1.0d0-RL)*PL*v*W*d*h*c*1.0d+03/lambda
c..note Power Output in mW
WRITE(30,9991) Iinj,Pow,count
print *,Iinj,count,Ncar,dsqrt(Jinj/(qel*d*Br))
c &(1.0d0-Ro
c &*RL*dexp(2.0d0*gain*L)),gain
do 50 countz=1,IZ
z=dble(countz)*DZ
PZ(Icount,countz)=Po*dexp(gain*z)+Psp*(dexp(gain*z)-1.0d0)
QZ(Icount,countz)=Qo*dexp(-gain*z)+Qsp*(dexp(-gain*z)-1.0d0)
write(32,9992) z,PZ(Icount,countz),QZ(Icount,countz)
50 continue
write(32,*)
100 CONTINUE
9991 FORMAT(E16.5,4x,E16.5,4x,I8)
9992 FORMAT(E16.5,4x,E16.5,4x,E16.5)
CLOSE(30)
CLOSE(32)
END
c------------------------------------------------------------------------------c
SUBROUTINE stripe(Conf,Ao,Nto,Br,Pin,Clad,Scat
&,df,dr,Ro,RL,v,L,LHS,delta,Ncar,Psp,Qsp,gain,count
&,Po,Qo)
DOUBLE PRECISION Nto,Ao,Nold,delta,v,Ncar,df,dr,gain,LHS
&,Qsp,Po,Qo,PN,QN,RHS,Br,Conf,Clad,Scat,Ro,RL,Pin,L,Psp
INTEGER itest,count
itest=0
count=0
Nold=1.0d+05
do 50 while(itest.eq.0)
Ncar=Nold
gain=Conf*Ao*(Ncar-Nto)+(1.0d0-Conf)*Clad+Scat
Psp=df*Ncar*Ncar*Br/(gain*v)
Qsp=dr*Ncar*Ncar*Br/(gain*v)
Po=(Pin+Ro*(dexp(gain*L)-1.0d0)*(RL*dexp(gain*L)*Psp+Qsp))
&/(1.0d0-Ro*RL*dexp(2.0d0*gain*L))
Qo=RL*dexp(2.0d0*gain*L)*Po
&+RL*dexp(gain*L)*(dexp(gain*L)-1.0d0)*Psp
&+(dexp(gain*L)-1.0d0)*Qsp
PN=(dexp(gain*L)-1.0d0)*(Po+Psp)/(gain*L)-Psp
QN=(1.0d0-dexp(-gain*L))*(Qo+Qsp)/(gain*L)-Qsp
RHS=gain*(PN+QN)+Br*Ncar*Ncar/v
if(dabs(LHS-RHS).lt.delta)then
itest=1
Nold=Ncar
else
itest=0
if(LHS.lt.RHS)then
Nold=Ncar-Ncar*0.001d0
elseif(LHS.gt.RHS)then
Nold=Ncar+Ncar*0.001d0
endif
endif
count=count+1
50 continue
RETURN
END
c------------------------------------------------------------------------------c