Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
Autor |
Nachricht |
RelativKritisch Redaktion
Anmeldedatum: 29.12.2006 Beiträge: 240
|
Verfasst am: 03.01.2013, 19:44 Titel: Hypothesen, die niemand braucht (4) – Wolfgang Lange |
|
|
Dr.-Ing. Wolfgang Lange gehört zu jenen Rentnern mit naturwissenschaftlichem Background, der seine Altersfreizeit nutzt, um die Physik zu revolutionieren. Sein „Coming out“ als Welträtsellöser hatte Dr. Lange im Jahr 2011. Seine „Neue Lorentz-Transformation“ versuchte er als Physikrevolution bei keinem geringen Magazin als den „Annalen der Physik“ zu veröffentlichen. Über deren Ablehnung zeigte sich Dr. Lange genau so empört, wie über die „Zensur“ seiner Kommentare im Blog von Dr. Markus Pössel.
|
|
Nach oben |
|
|
Solkar
Anmeldedatum: 29.05.2009 Beiträge: 293
|
Verfasst am: 18.02.2013, 12:40 Titel: |
|
|
Hmmm.. vielleicht hilft dem einen oder anderen Welträsellöser ja ein Abakus?
Vielleicht rechnen die Herren dann ENDLICH mal Ihre "Findungen" gegen, BEVOR sie damit ans Tageslicht gehen...
Code: |
!-----------------------------------------------------------------------------80
!> @file checkit.f90
!-------------------------------------------------------------------------------
!> @author Solkar
!!
!> @date Feb 16th 2013
!> @brief
!! LAPACK usage example
!! sgetrf/sgetrs applied on Galilean transform matrices
!
!> @copyright
!! (c) Solkar 2013. All rights reserved.
!! http://www.relativ-kritisch.net/forum/profile.php?mode=viewprofile&u=308
!
!> @license
!! This work is released under the GNU Public License v3 as of June 29th 2007
!! http://www.gnu.org/licenses/gpl.html
!
! Warranty: NONE, neither implied nor expressed.
! Use at own risk!
!-------------------------------------------------------------------------------
! ACKNOWLEDGEMENTS:
! http://www.netlib.org/lapack/ (LAPACK - still THE lib for LUP, AX=B & Co.)
!-------------------------------------------------------------------------------
!-----------------------------------------------------------------------------80
! MODULE iso_fortran_substitute
!> @brief some useful constants from Fortran 2003
!-------------------------------------------------------------------------------
module iso_fortran_substitute
implicit none
integer, parameter :: INPUT_UNIT = 5
integer, parameter :: OUTPUT_UNIT = 6
integer, parameter :: ERROR_UNIT = 0
integer, parameter :: IOSTAT_END = -1
integer, parameter :: IOSTAT_EOR = -2
integer, parameter :: NUMERIC_STORAGE_SIZE = 32
integer, parameter :: CHARACTER_STORAGE_SIZE = 8
integer, parameter :: FILE_STORAGE_SIZE = 8
end module iso_fortran_substitute
!-----------------------------------------------------------------------------80
!> @brief dumps a matrix of arbitrary size
!
!> @param[in] A matrix of REAL
!> @param[in] m INTEGER number of rows
!> @param[in] n INTEGER number of columns
!> @param[in,optional] unit INTEGER unit id
!-------------------------------------------------------------------------------
subroutine dump(A, m, n, unit)
use iso_fortran_substitute
implicit none
integer, intent(in) :: m, n
real, dimension(m,n), intent(in) :: A
integer, intent(in), optional :: unit
integer :: i, u
if (present(unit)) then
u = unit
else
u = OUTPUT_UNIT
end if
do i=1,m
write (u,*) A(i,:)
end do
end subroutine dump
!-------------------------------------------------------------------------------
!> @brief main routine
!-------------------------------------------------------------------------------
program checkit
use iso_fortran_substitute
implicit none
integer, parameter :: m = 2
integer, parameter :: n = m
real, dimension(m,n), parameter :: ID = &
reshape((/1.0,0.0,0.0,1.0/), (/2,2/))
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real, parameter :: v = 0.5
! COLUMN-major order
real, dimension(m,n) :: G = reshape((/1.0,0.0,-v,1.0/), (/2,2/))
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real, dimension(m,n) :: GTinv ! (G^T)^(-1)) to be calc'ed
real, dimension(m,n) :: R, S ! auxiliary matrices
! auxiliaries for lapack routines
real, dimension(m,n) :: T ! [inout] for sgetrf
integer, dimension(n) :: ipiv ! dto for perm array
integer :: lda, nrhs, ldb, info ! see sgetrf/sgetrs man pgs
lda = m
nrhs = n
ldb = m
write (*,*) 'G'
call dump(G, m, n)
write (*,*)
T = transpose(G)
write (*,*) 'G^T'
call dump(T, m, n)
write (*,*)
! LAPACK LUP decomposition and reassembly into T
! T intent is input/output
! ipiv, info intent is output
call sgetrf(m, n, T, lda, ipiv, info)
if (info .eq. 0) then
!
! right side of
! A * (A^-1) = I
!
R = ID
! LAPACK solving,for LUP T, ipiv
! R intent is input/output
! info intent is output
call sgetrs( 'N', m, nrhs, T, lda, &
ipiv, R, ldb, info)
if (info .eq. 0) then
GTinv = R
write (*,*) '(G^T)^(-1):'
call dump(GTinv, m, n)
write (*,*)
S = matmul(transpose(G), GTinv)
write (*,*) '(G^T) * (G^T)^(-1):'
call dump(S, m, n)
write (*,*)
S = matmul(G, GTinv)
write (*,*) 'G * ((G^T)^(-1)):'
call dump(S, m, n)
else
write (ERROR_UNIT,*) 'inversion of triangular matrix'
call dump(T, m, n, ERROR_UNIT)
write (ERROR_UNIT,*) 'FAILED due to sgrts argument #', -info, '.'
write (ERROR_UNIT,*) 'Pls see sgrts man page for argument list!'
write (ERROR_UNIT,*) 'Aborting processing.'
end if
else
write (ERROR_UNIT,*) 'LUP decomposition of '
call dump(transpose(G), n, m, ERROR_UNIT)
if (info < 0) then
write (ERROR_UNIT,*) 'FAILED due to sgrtf argument #', -info, '.'
write (ERROR_UNIT,*) 'Pls see sgrtf man page for further info!'
else
write (ERROR_UNIT,*) 'found matrix is singular.'
end if
write (ERROR_UNIT,*) 'Aborting processing.'
end if ! info of sgetrf .eq. 0
! this
call exit(info)
! is NOT standard, but works e.g. with gfortran
! comment out if your compiler complains about it
end program checkit
|
Komplilierung (Linux/gfortran):
Code: | gfortran -o checkit checkit.f90 -llapack |
Verwendung (Linux):
Ausgabe:
Code: | G
1.0000000 -0.50000000
0.0000000 1.0000000
G^T
1.0000000 0.0000000
-0.50000000 1.0000000
(G^T)^(-1):
1.0000000 0.0000000
0.50000000 1.0000000
(G^T) * (G^T)^(-1):
1.0000000 0.0000000
0.0000000 1.0000000
G * ((G^T)^(-1)):
0.75000000 -0.50000000
0.50000000 1.0000000 |
_________________ Nein! Das ist bestimmt irgendwas mit Quanten!
Man muss das nämlich alles erstmal quantenmechanisch beurteilen, mit allem Drum und Dran... |
|
Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben. Du kannst auf Beiträge in diesem Forum nicht antworten. Du kannst deine Beiträge in diesem Forum nicht bearbeiten. Du kannst deine Beiträge in diesem Forum nicht löschen. Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|