diff options
Diffstat (limited to 'fortran/navy_four_levels/FourLevelPulseProp_v3_Double.f95')
-rw-r--r-- | fortran/navy_four_levels/FourLevelPulseProp_v3_Double.f95 | 40 |
1 files changed, 22 insertions, 18 deletions
diff --git a/fortran/navy_four_levels/FourLevelPulseProp_v3_Double.f95 b/fortran/navy_four_levels/FourLevelPulseProp_v3_Double.f95 index f2b0f7a..5672a42 100644 --- a/fortran/navy_four_levels/FourLevelPulseProp_v3_Double.f95 +++ b/fortran/navy_four_levels/FourLevelPulseProp_v3_Double.f95 @@ -29,7 +29,7 @@ integer nmat,npts,Nfrac,Nframe,Nframemax,NSkip,NWrite,tpts,zpts parameter (nmat=3,npts=100) !matrix size, number of detuning points in dispersion curve !REMEMBER TO CHANGE NMAT IN LMatConstruct Routine - parameter (tpts=100,zpts=tpts+1) !Caution: funny things happened when tpts=200 (and presumably greater) + parameter (tpts=10,zpts=tpts+1) !Caution: funny things happened when tpts=200 (and presumably greater) !tpts is the number of temporal points in the cell parameter (Nframemax=2000000) parameter ( NWrite=100) !number of frames to actually write @@ -43,7 +43,7 @@ complex*16 g1,g2,g3,g4,g5,g6,g7 complex*16 h1,h2,h3,h4,h5 complex*16 i1,i2,i3,i4,i5,i6,i7 - complex*16 j1,j2,j3,j4,j5,j6,j7 + complex*16 j1,j2,j3,j4,j5,j6,j7,j8 complex*16 k1,k2,k3,k4,k5,k6,k7,k8,k9,k10 complex*16 l1,l2,l3,l4,l5 @@ -110,9 +110,10 @@ ! ! Atomic parameters ! + write (*,*)'New version from moved folder' ! write (*,*)'Enter density in m^-1' ! read (*,*)eta - eta=6.9e13 + eta=6.9e11 alpha1=3*eta*lambda*lambda/(2*pi) alpha1tilde=alpha1*c/beta alpha2=3*eta*lambda*lambda/(2*pi) @@ -150,7 +151,8 @@ Om_crit=sqrt(Om1peak**4+4*Om1peak*Om1peak*(Ga4*Ga4+Ga2*Ga4)) Om_crit=Om_crit-Om1peak*Om1peak-2*Ga2*Ga4 Om_crit=sqrt(Om_crit/2) -! write (*,*)'Om_crit = ',Om_crit + write (*,*)'Om_crit = ',Om_crit + ! write (*,*)'Enter peak scaled Rabi frequency for the coupling field at entrance of cell' ! read (*,*)Omcpeak Omcpeak=0.1 @@ -195,9 +197,10 @@ tp=beta*tp !Now dimensionless ! write (*,*)'Enter length of cell in m' ! read (*,*)Lcell - Lcell=1; + Lcell=1 Lcell=beta*Lcell/c !Now dimensionless t_start=secnds(0.E0) + write (*,*)'t_start = ',t_start ! XXXXXXX ! ! Set up initial pulse. @@ -217,7 +220,10 @@ Omold_vac=cmplx(0.,0.) tpeak=-1 tpeak_vac=-1 + write (*,*)'Nframe= ', Nframe +! pause ! do 110 n=1,Nframe + do 100 m=1,zpts Om1(m)=cmplx(0.,0.) Om2(m)=cmplx(0.,0.) @@ -314,12 +320,13 @@ i7=0.25*ci*dt j1=1-W12*dt - j2=W12*dt + j2=W21*dt j3=W31*dt j4=0.25*ci*dt j5=-0.25*ci*dt j6=0.25*ci*dt j7=-0.25*ci*dt + j8=W41*dt k1=1-(W32+W31+W34)*dt k2=W43*dt @@ -338,11 +345,6 @@ l4=-0.25*ci*dt l5=0.25*ci*dt - - - - - NSkip=int(NFrame/NWrite) fname='MovieParameters4level_v3.txt' @@ -369,10 +371,11 @@ open(10,file=fname) do 60 n=1,Nframe +! write (*,*)'n = ',n t=float(n-1)*dt Om1(1)=Om1peak Om2(1)=Om2peak*exp(-(t-tshift)**2/(tp*tp)) - Omc(1)=Omcpeak*exp(-(t-tshift)**2/(tp*tp)) + Omc(1)=Omcpeak Om_vac(1)=Om2(1) if (int(n/10).eq.0) write(fname,130)'Movie',n if (int(n/10).ge.1.and.int(n/100).eq.0) write (fname,131)'Movie',n @@ -414,7 +417,8 @@ rho11(m)=j1*rho11_last(m)+j2*rho22_last(m)+j3*rho33_last(m)+j4*conjg(Om1(m))*rho31_last(m) rho11(m)=rho11(m)+j5*Om1(m)*rho13_last(m)+j6*conjg(Om1(m-1))*rho31_last(m)+j7*Om1(m-1)*rho13_last(m) - + rho11(m)=rho11(m)+j8*rho44_last(m) + rho12(m)=d1*rho12_last(m)+d2*conjg(Om1(m))*rho32_last(m)+d3*Om2(m)*rho13_last(m) rho12(m)=rho12(m)+d4*Omc(m)*rho14_last(m)+d5*conjg(Om1(m-1))*rho32_last(m) rho12(m)=rho12(m)+d6*Om2(m-1)*rho13_last(m)+d7*Omc(m-1)*rho14_last(m) @@ -423,7 +427,7 @@ rho13(m)=rho13(m)+e3*conjg(Om2(m))*rho12_last(m)+e4*conjg(Om1(m-1))*(rho33_last(m)-rho11_last(m)) rho13(m)=rho13(m)+e5*conjg(Om2(m-1))*rho12_last(m) - rho14(m)=f1*rho14_last(m)+f2*conjg(Om1(m))*rho34_last(m)*f3*conjg(Omc(m))*rho12_last(m) + rho14(m)=f1*rho14_last(m)+f2*conjg(Om1(m))*rho34_last(m)+f3*conjg(Omc(m))*rho12_last(m) rho14(m)=rho14(m)+f4*conjg(Om1(m-1))*rho34_last(m)+f5*conjg(Omc(m-1))*rho12_last(m) rho21(m)=conjg(rho12(m)) @@ -434,8 +438,8 @@ rho23(m)=rho23(m)+g4*conjg(Omc(m))*rho43_last(m)+g5*conjg(Om1(m-1))*rho21_last(m) rho23(m)=rho23(m)+g6*conjg(Om2(m-1))*(rho33_last(m)-rho22_last(m))+g7*conjg(Omc(m-1))*rho43_last(m) - rho24(m)=h1*rho24_last(m)+h2*conjg(Om2(m))*rho34_last(m)+h3*Omc(m)*(rho44_last(m)-rho22_last(m)) - rho24(m)=rho24(m)+h4*conjg(Om2(m-1))*rho34_last(m)+h5*Omc(m-1)*(rho44_last(m)-rho22_last(m)) + rho24(m)=h1*rho24_last(m)+h2*conjg(Om2(m))*rho34_last(m)+h3*conjg(Omc(m))*(rho44_last(m)-rho22_last(m)) + rho24(m)=rho24(m)+h4*conjg(Om2(m-1))*rho34_last(m)+h5*conjg(Omc(m-1))*(rho44_last(m)-rho22_last(m)) rho31(m)=conjg(rho13(m)) @@ -499,7 +503,7 @@ 120 format(1x,f12.6,',',f12.6,',',f12.6,',',f12.6,',',f12.6,',',f12.6,',',f12.6) t_end=secnds(0.E0) t_elapsed=t_end-t_start -! write(*,*)'T elapsed = ',t_elapsed + write(*,*)'T elapsed = ',t_elapsed stop end @@ -624,7 +628,7 @@ do 11 j=1,n if (cabs(a(i,j)).gt.aamax) aamax=cabs(a(i,j)) 11 continue - if (aamax.eq.0.) write (*,*) 'singular matrix in ludcmp' + if (aamax.eq.0.) write (*,*) 'singular matrix in ludcmp' vv(i)=1./aamax 12 continue do 19 j=1,n |