Skip to content
Snippets Groups Projects
Commit d939d01e authored by Philipp Rüssmann's avatar Philipp Rüssmann
Browse files

Make gfortran compile again

parent 09e008d4
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
source/common/mathtools.f90
+ 28
− 21
View file @ d939d01e
......@@ -252,6 +252,7 @@ contains
!-------------------------------------------------------------------------------
function matmat(mat1,mat2)
use mod_datatypes, only: dp
use mod_constants, only: cone, czero
implicit none
complex (kind=dp), intent(in) :: mat1(:,:),mat2(:,:)
complex (kind=dp) :: matmat(size(mat1,1),size(mat2,2))
......@@ -260,7 +261,7 @@ contains
n = size(mat1,2)
n2 = size(mat2,2)
if(size(mat2,1).ne.n) stop 'matmat: dimensions of matrices are inconsistent.'
call zgemm('N','N',n1,n2,n,(1d0,0d0),mat1,n1,mat2,n,(0d0,0d0),matmat,n1)
call zgemm('N','N',n1,n2,n,cone,mat1,n1,mat2,n,czero,matmat,n1)
end function matmat
!-------------------------------------------------------------------------------
......@@ -271,16 +272,17 @@ contains
!-------------------------------------------------------------------------------
function matmat1T(mat1,mat2)
use mod_datatypes, only: dp
use mod_constants, only: cone, czero
implicit none
complex(8), intent(in) :: mat1(:,:),mat2(:,:)
complex(8) :: matmat1T(size(mat1,1),size(mat2,1))
complex(kind=dp), intent(in) :: mat1(:,:),mat2(:,:)
complex(kind=dp) :: matmat1T(size(mat1,1),size(mat2,1))
integer :: n11,n12,n21,n22
n11 = size(mat1,1)
n12 = size(mat1,2)
n21 = size(mat2,1)
n22 = size(mat2,2)
if(n12.ne.n22) stop 'matmat1T: dimensions of matrices are inconsistent.'
call zgemm('N','T',n11,n21,n12,(1d0,0d0),mat1,n11,mat2,n11,(0d0,0d0),matmat1T,n21)
call zgemm('N','T',n11,n21,n12,cone,mat1,n11,mat2,n11,czero,matmat1T,n21)
end function matmat1T
!-------------------------------------------------------------------------------
......@@ -291,6 +293,7 @@ contains
!-------------------------------------------------------------------------------
function matmatT1(mat1,mat2)
use mod_datatypes, only: dp
use mod_constants, only: cone, czero
implicit none
complex (kind=dp), intent(in) :: mat1(:,:),mat2(:,:)
complex (kind=dp) :: matmatT1(size(mat1,2),size(mat2,2))
......@@ -300,7 +303,7 @@ contains
n21 = size(mat2,1)
n22 = size(mat2,2)
if(n11.ne.n21) stop 'matmatT1: dimensions of matrices are inconsistent.'
call zgemm('T','N',n12,n22,n11,(1d0,0d0),mat1,n11,mat2,n21,(0d0,0d0),matmatT1,n22)
call zgemm('T','N',n12,n22,n11,cone,mat1,n11,mat2,n21,czero,matmatT1,n22)
end function matmatT1
!-------------------------------------------------------------------------------
......@@ -311,6 +314,7 @@ contains
!-------------------------------------------------------------------------------
function matmat_dmdm(mat1,mat2)
use mod_datatypes, only: dp
use mod_constants, only: cone, czero
implicit none
real (kind=dp), intent(in) :: mat1(:,:),mat2(:,:)
real (kind=dp) :: matmat_dmdm(size(mat1,1),size(mat2,2))
......@@ -319,7 +323,7 @@ contains
n = size(mat1,2)
n2 = size(mat2,2)
if(size(mat2,1).ne.n) stop 'matmat: dimensions of matrices are inconsistent.'
call dgemm('N','N',n1,n2,n,(1d0,0d0),mat1,n1,mat2,n,(0d0,0d0),matmat_dmdm,n1)
call dgemm('N','N',n1,n2,n,cone,mat1,n1,mat2,n,czero,matmat_dmdm,n1)
end function matmat_dmdm
!-------------------------------------------------------------------------------
......@@ -330,6 +334,7 @@ contains
!-------------------------------------------------------------------------------
function matmat1T_dmdm(mat1,mat2)
use mod_datatypes, only: dp
use mod_constants, only: cone, czero
implicit none
real (kind=dp), intent(in) :: mat1(:,:),mat2(:,:)
real (kind=dp) :: matmat1T_dmdm(size(mat1,1),size(mat2,1))
......@@ -339,7 +344,7 @@ contains
n21 = size(mat2,1)
n22 = size(mat2,2)
if(n12.ne.n22) stop 'matmat1T: dimensions of matrices are inconsistent.'
call dgemm('N','T',n11,n21,n12,(1d0,0d0),mat1,n11,mat2,n11,(0d0,0d0),matmat1T_dmdm,n21)
call dgemm('N','T',n11,n21,n12,cone,mat1,n11,mat2,n11,czero,matmat1T_dmdm,n21)
end function matmat1T_dmdm
!-------------------------------------------------------------------------------
......@@ -350,6 +355,7 @@ contains
!-------------------------------------------------------------------------------
function matmatT1_dmdm(mat1,mat2)
use mod_datatypes, only: dp
use mod_constants, only: cone, czero
implicit none
real (kind=dp), intent(in) :: mat1(:,:),mat2(:,:)
real (kind=dp) :: matmatT1_dmdm(size(mat1,2),size(mat2,2))
......@@ -359,7 +365,7 @@ contains
n21 = size(mat2,1)
n22 = size(mat2,2)
if(n11.ne.n21) stop 'matmatT1: dimensions of matrices are inconsistent.'
call dgemm('T','N',n12,n22,n11,(1d0,0d0),mat1,n11,mat2,n21,(0d0,0d0),matmatT1_dmdm,n22)
call dgemm('T','N',n12,n22,n11,cone,mat1,n11,mat2,n21,czero,matmatT1_dmdm,n22)
end function matmatT1_dmdm
!-------------------------------------------------------------------------------
......@@ -390,6 +396,7 @@ contains
!-------------------------------------------------------------------------------
function matvec_dzdz(mat1,vec1)
use mod_datatypes, only: dp
use mod_constants, only: cone, czero
implicit none
complex (kind=dp), intent(in) :: mat1(:,:),vec1(:)
complex (kind=dp) :: matvec_dzdz(size(mat1,1))
......@@ -399,7 +406,7 @@ contains
if(size(vec1,1).ne.n) stop 'matvec_dzdz: dimensions of first input array differ.'
! if(size(mat2,1).ne.n) stop 'matmat_dmdm: second input array has wrong dimensions.'
! if(size(mat2,2).ne.n) stop 'matmat_dmdm: dimensions of second input array differ.'
call ZGEMV('N',M,N,(1.0D0,0.0D0),mat1,M,vec1,1,(0.0D0,0.0D0),matvec_dzdz,1)
call ZGEMV('N',M,N,cone,mat1,M,vec1,1,czero,matvec_dzdz,1)
end function matvec_dzdz
!-------------------------------------------------------------------------------
......@@ -429,38 +436,38 @@ contains
function rotvector(theta1,phi1,m2,fac1)
use mod_datatypes, only: dp
implicit none
real(kind=8) theta1,phi1
real(kind=8) m2(3)
real(kind=8) fac1
real(kind=8) rotvector(3)
real(kind=dp) theta1,phi1
real(kind=dp) m2(3)
real(kind=dp) fac1
real(kind=dp) rotvector(3)
real(kind=8) :: absm2,e1(3),m1(3),nvec(3),absnvec,alpha
real(kind=8) :: cosa,sina,n1,n2,n3,rotmat(3,3)
real(kind=dp) :: absm2,e1(3),m1(3),nvec(3),absnvec,alpha
real(kind=dp) :: cosa,sina,n1,n2,n3,rotmat(3,3)
absm2=dsqrt(m2(1)**2+m2(2)**2+m2(3)**2)
absm2=sqrt(m2(1)**2+m2(2)**2+m2(3)**2)
print *,'absm2',absm2
e1=(/dcos(phi1)*dsin(theta1),dsin(phi1)*dsin(theta1),dcos(theta1) /)
e1=(/cos(phi1)*sin(theta1),sin(phi1)*sin(theta1),cos(theta1) /)
print *,'e1',e1
m1=absm2*e1
print *,'m1',m1
nvec=cross(m1,m2)/absm2**2
print *,'nvec',nvec
absnvec=dsqrt ( nvec(1)**2+nvec(2)**2+nvec(3)**2)
absnvec=sqrt ( nvec(1)**2+nvec(2)**2+nvec(3)**2)
print *,'absnvec',absnvec
! This gives errors for theta>180deg
!alpha = dasin( absnvec )
! better do this
alpha=dacos(DOT_PRODUCT(m1,m2)/absm2**2)
alpha=acos(DOT_PRODUCT(m1,m2)/absm2**2)
print *,'alpha',alpha, 'and in deg',alpha/3.1515926*180
alpha=alpha*fac1
print *,'new alpha',alpha
cosa=dcos(alpha)
sina=dsin(alpha)
cosa=cos(alpha)
sina=sin(alpha)
n1=nvec(1)/absnvec
n2=nvec(2)/absnvec
n3=nvec(3)/absnvec
......
source/common/wronskian.f90
+ 2
− 2
View file @ d939d01e
......@@ -122,13 +122,13 @@ contains
do ilm1=1, lmsize
do ilm2=1, lmsize
write(3246762,'(2i5,50000E)') ilm2, ilm1, wronskian(ilm2,ilm1,:)
write(3246762,'(2i5,50000E25.14)') ilm2, ilm1, wronskian(ilm2,ilm1,:)
end do
end do
do ilm1=1, lmsize2
do ilm2=1, lmsize2
write(3246763,'(2i5,50000E)') ilm2, ilm1, wronskian2(ilm2,ilm1,:)
write(3246763,'(2i5,50000E25.14)') ilm2, ilm1, wronskian2(ilm2,ilm1,:)
end do
end do
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment