summaryrefslogtreecommitdiff
path: root/fortran/navy_four_levels/FourLevelPulseProp_Double.f95
diff options
context:
space:
mode:
authorEugeniy Mikhailov <evgmik@gmail.com>2011-07-12 21:47:27 -0400
committerEugeniy Mikhailov <evgmik@gmail.com>2011-07-12 21:49:10 -0400
commitc2c58782c3b7042ec877c4a6e9b8b96121d80269 (patch)
tree9dc134aa1b8928d67692f0695c864daf17d35326 /fortran/navy_four_levels/FourLevelPulseProp_Double.f95
parent6b4e252cb43889a06fae07ed024bbbec08984df9 (diff)
downloadNresonances-c2c58782c3b7042ec877c4a6e9b8b96121d80269.tar.gz
Nresonances-c2c58782c3b7042ec877c4a6e9b8b96121d80269.zip
Remove unused subroutines
Diffstat (limited to 'fortran/navy_four_levels/FourLevelPulseProp_Double.f95')
-rw-r--r--fortran/navy_four_levels/FourLevelPulseProp_Double.f95124
1 files changed, 0 insertions, 124 deletions
diff --git a/fortran/navy_four_levels/FourLevelPulseProp_Double.f95 b/fortran/navy_four_levels/FourLevelPulseProp_Double.f95
index 06f7353..6c4be5b 100644
--- a/fortran/navy_four_levels/FourLevelPulseProp_Double.f95
+++ b/fortran/navy_four_levels/FourLevelPulseProp_Double.f95
@@ -578,131 +578,7 @@
return
end
-!
- subroutine plotit(x,y,nmat,npts)
-!
-! See MATLAB routine that will do this plotting.
-
- implicit none
- integer i,n,nmat,npts
- real*8 x(npts)
- complex*8 y(nmat,npts)
-
- write (*,*)'For now, we are just going to write the file'
- open(9, FILE='TwoLevelPulseProp.txt')
- do 10 n=1,npts
- write (9,100)x(n),(y(i,n),i=1,3)
-! write(*,100)x(n),(y(i,n),i=1,3)
-10 continue
-100 format(1x,f9.6,',',3(f9.6,',',f9.6,','))
-
-
- return
- end
-
-!********************************************************
-! Numerical Recipes
-!********************************************************
-
-
- SUBROUTINE ludcmp(a,n,np,indx,d)
- implicit none
-
- INTEGER n,np,indx(n),NMAX
- REAL*8 d,TINY
- PARAMETER (NMAX=500,TINY=1.0e-20)
- INTEGER i,imax,j,k
- REAL aamax,dum,vv(NMAX)
-! My changed variables
- complex*8 sum,dum2
- complex*8 a(np,np)
-
-
- d=1.
- do 12 i=1,n
- aamax=0.
- 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'
- vv(i)=1./aamax
-12 continue
- do 19 j=1,n
- do 14 i=1,j-1
- sum=a(i,j)
- do 13 k=1,i-1
- sum=sum-a(i,k)*a(k,j)
-13 continue
- a(i,j)=sum
-14 continue
- aamax=0.
- do 16 i=j,n
- sum=a(i,j)
- do 15 k=1,j-1
- sum=sum-a(i,k)*a(k,j)
-15 continue
- a(i,j)=sum
- dum=vv(i)*cabs(sum)
- if (dum.ge.aamax) then
- imax=i
- aamax=dum
- endif
-16 continue
- if (j.ne.imax)then
- do 17 k=1,n
- dum2=a(imax,k)
- a(imax,k)=a(j,k)
- a(j,k)=dum2
-17 continue
- d=-d
- vv(imax)=vv(j)
- endif
- indx(j)=imax
- if (cabs(a(j,j)).eq.0.) a(j,j)=cmplx(TINY,TINY)
- if(j.ne.n)then
- dum2=1./a(j,j)
- do 18 i=j+1,n
- a(i,j)=a(i,j)*dum2
-18 continue
- endif
-19 continue
- return
- END
-
- SUBROUTINE lubksb(a,n,np,indx,b)
- implicit none
- INTEGER n,np,indx(n)
- INTEGER i,ii,j,ll
-
-! My changed variables
- complex*8 sum
- complex*8 b(n)
- complex*8 a(np,np)
- ii=0
- do 12 i=1,n
- ll=indx(i)
- sum=b(ll)
- b(ll)=b(i)
- if (ii.ne.0)then
- do 11 j=ii,i-1
- sum=sum-a(i,j)*b(j)
-11 continue
- else if (sum.ne.0.) then
- ii=i
- endif
- b(i)=sum
-12 continue
- do 14 i=n,1,-1
- sum=b(i)
- do 13 j=i+1,n
- sum=sum-a(i,j)*b(j)
-13 continue
- b(i)=sum/a(i,i)
-14 continue
- return
- END
-