Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Fixed warnings, etc. - problem still remains

  • Loading branch information...
commit 30e1a9c482a83e1293edecbe8dc5c55dde43d513 1 parent d97e14f
jamesmcm authored
View
19 transfermatrix/driver.f
@@ -5,16 +5,14 @@ PROGRAM TRANSFERMATIXTWO
EXTERNAL CONDUCTANCE
DOUBLE PRECISION GETTRANS
EXTERNAL GETTRANS
-c$$ NB LIMX CHANGED TO 2
+c$$ NB LIMX CHANGED TO 2
INTEGER, PARAMETER :: LIMX=2, WRAPY=0, WRAPX=0,
+ MSIZE=4*LIMX*LIMX, M2SIZE=LIMX*LIMX
- INTEGER I/1/, K/1/, F/1/,LIMY/10/
- CHARACTER*3 VALUE
-
+ INTEGER F/1/, LIMY/10/
+c$$$ CHARACTER*3 VALUE
DOUBLE PRECISION TVALS(LIMX)
- DOUBLE PRECISION COND/-1.0/, FLUX/0.0/, E/-3/, G, DLVAL
- DOUBLE COMPLEX ZEROC/0.0/, ONEC/1.0/
+ DOUBLE PRECISION COND/-1.0/, FLUX/0.0/, E/-3/, G
C$$$ READS COMMAND LINE ARGUMENT AS LIMY
c CALL GETARG(1, VALUE)
@@ -24,23 +22,20 @@ PROGRAM TRANSFERMATIXTWO
DO F = 1, 1201
COND = GETTRANS(TVALS, LIMX, LIMY, E, FLUX, WRAPX)
-
-C$$$ ERROR RETURN TYPE MISMATCH OF FUNCTION CHECKUNI REAL(4)/REAL(8)
+C$$$ ERROR RETURN TYPE MISMATCH OF FUNCTION CHECKUNI REAL(4)/REAL(8)
c$$$ COND = CHECKUNI(LIMX,T,R,TTILDE,RTILDE)
G = CONDUCTANCE (TVALS, LIMX)
c$$$ WRITES ENERGY, CONDUCTANCE, UNITARITY
WRITE(*,50) E, G, COND
-
+
c WRITE(*,60) E,(TVALS(I)*TVALS(I), I = 1, LIMX)
c$$$ 'E' STEPS CONSISTANT WITH ANALYTICAL.C
E=E+0.005
END DO
- 50 FORMAT (F8.5,15ES15.5E3)
- 60 FORMAT (15ES15.5E3)
-
+ 50 FORMAT (F8.5,15ES15.5E3)
STOP
END
View
193 transfermatrix/lingalg.f
@@ -1,193 +0,0 @@
- SUBROUTINE INVERTMATRIX(MATRIX, LIMX)
- IMPLICIT NONE
- INTEGER S
- INTEGER LIMX, PIVOT(LIMX, LIMX)
- DOUBLE COMPLEX MATRIX(LIMX, LIMX), WORK(LIMX*LIMX)
-
- CALL ZGETRF(LIMX, LIMX, MATRIX, LIMX, PIVOT, S)
- CALL ZGETRI(LIMX, MATRIX, LIMX, PIVOT, WORK, LIMX*LIMX, S)
- IF (S .NE. 0) THEN
- WRITE (*,*) 'NON-INVERTABLE MATRIX WITH S=', S
- STOP
- END IF
-
- RETURN
- END
-
- SUBROUTINE SV_DECOMP(LIMX, MATRIX, OUTPUTS)
-
- INTEGER LIMX, MSIZE, S
- DOUBLE PRECISION SVALS(LIMX), OUTPUTS(LIMX), RWORK(5*LIMX)
- DOUBLE COMPLEX MATRIX(LIMX, LIMX), TEMP2(LIMX, LIMX),
- + SVCPY(LIMX, LIMX), WORK(4*LIMX*LIMX)
-
- MSIZE=4*LIMX*LIMX
-
-C$$$ MAKE COPY OF MATRIX FOR SVD SINCE IT IS DESTROYED
-C$$$ SVCPY=MATRIX
- CALL ZCOPY(LIMX*LIMX, MATRIX, 1, SVCPY, 1)
- CALL ZGESVD('N', 'N', LIMX, LIMX, SVCPY, LIMX, SVALS, TEMP2,
- + LIMX, TEMP2, LIMX , WORK, MSIZE, RWORK, S)
- IF (S .NE. 0) THEN
- WRITE (*,*) 'SVD FAILED WITH S=', S
- STOP
- END IF
-
-C$$$ OUTPUTS=SVALS
- CALL DCOPY(LIMX, SVALS, 1, OUTPUTS, 1)
-
- RETURN
- END
-
- DOUBLE PRECISION FUNCTION CHECKUNI(LIMX, T,R,TTILDE,RTILDE)
- IMPLICIT NONE
-
- INTEGER LIMX, X/1/, Y/1/
- DOUBLE PRECISION ZLANGE
- DOUBLE COMPLEX ZEROC/0.0/, ONEC/1.0/
- DOUBLE COMPLEX T(LIMX,LIMX), BETA/-1/,ALPHA/1/,
- + R(LIMX,LIMX),TTILDE(LIMX,LIMX),RTILDE(LIMX,LIMX),
- + U(LIMX*2,LIMX*2), CHECK(LIMX*2,LIMX*2)
-
-
-C$$$ TEST CASES OF T,R,T~ R~
-
-C$$$ FILLS A UNIT MATRIX
- CALL ZLASET ('ALL', 2*LIMX, 2*LIMX, ZEROC, ONEC, CHECK, 2*LIMX)
- DO X=1, LIMX
- DO Y=1, LIMX
-C$$$ TOP LEFT
- U(X,Y)=T(X,Y)
-C$$$ BOTTOM LEFT
- U(X+LIMX,Y)=R(X,Y)
-C$$$ TOP RIGHT
- U(X,Y+LIMX)=RTILDE(X,Y)
-C$$$ BOTTOM RIGHT
- U(X+LIMX,Y+LIMX)=TTILDE(X,Y)
- END DO
- END DO
-
-C$$$ ZGEMM HAS INBUILT FUNCTION TO FIND U**H
-C$$ CALL PRINTT (U, 2*LIMX, 'U1 ')
- CALL ZGEMM('N', 'C', 2*LIMX, 2*LIMX, 2*LIMX, ALPHA, U,
- + 2*LIMX, U, 2*LIMX, BETA, CHECK, 2*LIMX)
-C$$$ ZLANGE FINDS MATRIX NORM
-C$$ CALL PRINTT (CHECK, 2 * LIMX, 'C2 ')
- CHECKUNI = ZLANGE('F', 2*LIMX, 2*LIMX, CHECK, 2*LIMX)
-C$$ WRITE (*, *) 'CHECKUNI:', CHECKUNI
-
- RETURN
- END
-
-C$$$ ROUTINE TO CHECK FOR UNITARY MATRICES
-
- DOUBLE PRECISION FUNCTION CHECKUNI2(LIMX, T,R,TTILDE,RTILDE)
- IMPLICIT NONE
-
- INTEGER LIMX
- DOUBLE PRECISION ZLANGE
- DOUBLE PRECISION DNORM1, DNORM2, DNORM3, DNORM
- DOUBLE PRECISION ONED/1.0/
- DOUBLE COMPLEX AU/0.0/, BU/1.0/, ZEROC/0.0/, ONEC/1.0/
- DOUBLE COMPLEX T(LIMX,LIMX), R(LIMX,LIMX),
- + TTILDE(LIMX,LIMX),RTILDE(LIMX,LIMX),
- + CK(LIMX, LIMX)
-
-
-C$$$ TEST CASES OF T,R,T~ R~
-
-C$$$ FILLS A UNIT MATRIX
-
-C DO X = 1, 2*LIMX
-C DO Y = 1, 2*LIMX
-C CHECK(X, Y) = (0.0, 0.0)
-C END DO
-C CHECK(X, X) = 1.0
-C END DO
-
-C$$$ ZGEMM HAS INBUILT FUNCTION TO FIND U**H
-C$$ CALL PRINTT (U, 2*LIMX, 'U1 ')
-
-c Unitarity can be also checked using subblocks only
-c The definition of unitarity can be easily cast into the form
-c |T|^2 + |R|^2 = 1, T*R~ + R* T~ = 0
-c
-c Check that T * T + R* R = 1 (* is the Hermitian conjugate)
-c Here I use zherk, which does T^+T
-c Beware: it computes only the upper-diagonal part!
- CALL ZLASET ('ALL', LIMX, LIMX, AU, BU, CK, LIMX)
- CALL ZHERK ('U', 'C', LIMX, LIMX, ONED, T, LIMX,
- + -ONED, CK, LIMX)
- CALL ZHERK ('U', 'C', LIMX, LIMX, ONED, R, LIMX,
- + ONED, CK, LIMX)
-C$$$ ZLANGE FINDS MATRIX NORM
- DNORM1 = ZLANGE ('F', LIMX, LIMX, CK, LIMX)
-
-c Check that T~* T~ + R~* R~ = 1
- CALL ZLASET ('ALL', LIMX, LIMX, AU, BU, CK, LIMX)
- CALL ZHERK ('U', 'C', LIMX, LIMX, ONED, TTILDE, LIMX,
- + -ONED, CK, LIMX)
- CALL ZHERK ('U', 'C', LIMX, LIMX, ONED, RTILDE, LIMX,
- + ONED, CK, LIMX)
- DNORM2 = ZLANGE ('F', LIMX, LIMX, CK, LIMX)
-
-c Now check that T* R~ + R* T~ = 0
-c CALL ZLASET ('ALL', LIMX, LIMX, AU, AU, CK, LIMX)
- CALL ZGEMM ('C', 'N', LIMX, LIMX, LIMX, ONEC, T,
- + LIMX, RTILDE, LIMX, ZEROC, CK, LIMX)
- CALL ZGEMM ('C', 'N', LIMX, LIMX, LIMX, ONEC, R,
- + LIMX, TTILDE, LIMX, ONEC, CK, LIMX)
- DNORM3 = ZLANGE ('F', LIMX, LIMX, CK, LIMX)
-
-C$$ CALL PRINTT (CHECK, 2 * LIMX, 'C2 ')
-c ZHERK does only the upper-triangular part. Therefore, the norm
-c DNORM1 should be roughly doubled, ditto DNORM2
-c There are two related off-diagonal blocks in the cross-product,
-c this doubles the norm DNORM3. (The relation is not exact,
-c since, the diagonal is not doubled)
- DNORM = 2.0* DNORM1 + 2.0 * DNORM2 + 2.0 * DNORM3
-c WRITE (*, *) 'CHECKUNI2:', DNORM1, DNORM2, DNORM3, DNORM
- CHECKUNI2 = DNORM
- RETURN
- END
-C$$$ ROUTINE TO CHECK FOR UNITARY MATRICES
-
- DOUBLE PRECISION FUNCTION CHECKUNI3(LIMX, T,R,TTILDE,RTILDE)
- IMPLICIT NONE
-
- INTEGER LIMX, X/1/, Y/1/
- DOUBLE PRECISION ZLANGE
- DOUBLE PRECISION ONED/1.0/
- DOUBLE COMPLEX ZEROC/0.0/, ONEC/1.0/
- DOUBLE COMPLEX T(LIMX,LIMX),
- + R(LIMX,LIMX),TTILDE(LIMX,LIMX),RTILDE(LIMX,LIMX),
- + U(LIMX*2,LIMX*2), CHECK(LIMX*2,LIMX*2)
-
-
-C$$$ TEST CASES OF T,R,T~ R~
-
-C$$$ FILLS A UNIT MATRIX
- CALL ZLASET ('A', 2*LIMX, 2*LIMX, ZEROC, ONEC, CHECK, 2*LIMX)
- DO X=1, LIMX
- DO Y=1, LIMX
-C$$$ TOP LEFT
- U(X,Y)=T(X,Y)
-C$$$ BOTTOM LEFT
- U(X+LIMX,Y)=R(X,Y)
-C$$$ TOP RIGHT
- U(X,Y+LIMX)=RTILDE(X,Y)
-C$$$ BOTTOM RIGHT
- U(X+LIMX,Y+LIMX)=TTILDE(X,Y)
- END DO
- END DO
-
-C$$$ ZHERK calculates U^H * U, and then subtracts 1.
-C$$$ However, this is perfomed in the upper triangular part only
-C$$ Therefore, we double the norm.
- CALL ZHERK('U', 'C', 2*LIMX, 2*LIMX, ONED, U, 2*LIMX,
- + -ONED, CHECK, 2*LIMX)
-C$$$ ZLANGE FINDS MATRIX NORM
- CHECKUNI3 = 2 * ZLANGE('F', 2*LIMX, 2*LIMX, CHECK, 2*LIMX)
-
- RETURN
- END
View
40 transfermatrix/tmatrix.f
@@ -1,22 +1,21 @@
SUBROUTINE CALCMULT(LIMX, WRAPX, MODD, MEVEN, E, FLUX)
- IMPLICIT NONE
+ IMPLICIT NONE
INTEGER LIMX, WRAPX, SZ/1/
INTEGER I/1/, NEIGH/1/
c$$$ CHANGED FLUX FROM DOUBLE COMPLEX TO DOUBLE PRECISION
DOUBLE PRECISION E, FLUX
- DOUBLE COMPLEX ZEROC / 0.0 /
+ DOUBLE COMPLEX ZEROC / 0.0 /
DOUBLE COMPLEX CNUM
c$$$ May need to move this
DOUBLE COMPLEX MODD(2*LIMX, 2*LIMX), MEVEN(2*LIMX, 2*LIMX)
IF ((MOD(LIMX,2) .NE. 0)) THEN
WRITE (*,*) 'ERROR: LIMX must be even for physical results'
- STOP
+ STOP
ENDIF
c$$$ HAMMERTIME! Program terminates here if LIMX is odd
SZ = 2 * LIMX
-
CALL ZLASET ('A', SZ, SZ, ZEROC, ZEROC, MODD, SZ)
CALL ZLASET ('A', SZ, SZ, ZEROC, ZEROC, MEVEN, SZ)
@@ -43,7 +42,7 @@ SUBROUTINE CALCMULT(LIMX, WRAPX, MODD, MEVEN, E, FLUX)
C$$$ THE FOLLOWING CODE WAS MODIFIED --- AVS
C$$$ NEIGHBOURING SITE FOR ODD ROW, ON THE LEFT/RIGHT, DEPENDING ON I
- NEIGH = I + (2*MOD(I,2)-1)
+ NEIGH = I + (2*MOD(I,2)-1)
C$$$ WRITE (*, *) '? I = ', I, ' NEIGH = ', NEIGH
C$$$ NEIGHBOUR CAN BE < 0, OR > LIMX. IF WRAPX IS TRUE, THIS INDICATES
C$$$ A VALID SITE. THE FOLLOWING CODE IS A BIT UGLY, AS I AM NOT SURE
@@ -71,7 +70,7 @@ SUBROUTINE CALCMULT(LIMX, WRAPX, MODD, MEVEN, E, FLUX)
MEVEN(LIMX + I, LIMX + NEIGH) = -1*CNUM
END IF
END DO
-c$$$ Originally the first M matrix was set here
+c$$$ Originally the first M matrix was set here
RETURN
END
@@ -99,6 +98,7 @@ DOUBLE PRECISION FUNCTION GETTRANS(TVALS, LIMX, LIMY,
CALL ZLASET ('ALL', 2*LIMX, 2*LIMX, ZEROC, ZEROC, MULT, LIMX)
CALL ZLASET ('ALL', 2*LIMX, 2*LIMX, ZEROC, ZEROC, O, LIMX)
CALL ZLASET ('ALL', 2*LIMX, 2*LIMX, ZEROC, ZEROC, IO, LIMX)
+ CALL ZLASET ('ALL', 2*LIMX, 2*LIMX, ZEROC, ZEROC, ABCD, LIMX)
CALL CALCMULT(LIMX, WRAPX, MODD, MEVEN, E, FLUX)
@@ -109,12 +109,13 @@ DOUBLE PRECISION FUNCTION GETTRANS(TVALS, LIMX, LIMY,
DO I = 1, LIMX
MULT(I, I)=1
MULT(LIMX+I, LIMX+I)=1
+ ABCD(I, I) =1
+ ABCD(LIMX+I, LIMX+I) =1
END DO
- CALL FILLOANDINVERT(O, IO, LIMX)
+ CALL FILLOANDINVERT(O, IO, LIMX, FLUX)
c$$$ This was previously moved outside the loop
-
c$$$ CALL GENABCD(LIMX, MULT, O, IO, ABCD, A, B, C, D)
-c$$$ CALL GENTANDRINC(LIMX, T, R, TTILDE, RTILDE, A, B, C, D)
+c$$$ CALL GENTANDRINC(LIMX, T, R, TTILDE, RTILDE, A, B, C, D)
CALL ZLASET ('ALL', LIMX, LIMX, ZEROC, ONEC, A, LIMX)
CALL ZLASET ('ALL', LIMX, LIMX, ZEROC, ZEROC, B, LIMX)
CALL ZLASET ('ALL', LIMX, LIMX, ZEROC, ZEROC, C, LIMX)
@@ -127,28 +128,26 @@ DOUBLE PRECISION FUNCTION GETTRANS(TVALS, LIMX, LIMY,
DO I = 1, LIMY
IF (MOD(LIMY,2) .EQ. 1) THEN
IF (MOD(I,2) .EQ. 1) THEN
- CALL ZCOPY(4*LIMX*LIMX, MEVEN, 1, MULT, 1)
+ CALL ZCOPY(4*LIMX*LIMX, MEVEN, 1, MULT, 1)
ELSE
- CALL ZCOPY(4*LIMX*LIMX, MODD, 1, MULT, 1)
+ CALL ZCOPY(4*LIMX*LIMX, MODD, 1, MULT, 1)
END IF
ELSE
IF (MOD(I,2) .EQ. 1) THEN
- CALL ZCOPY(4*LIMX*LIMX, MODD, 1, MULT, 1)
+ CALL ZCOPY(4*LIMX*LIMX, MODD, 1, MULT, 1)
ELSE
- CALL ZCOPY(4*LIMX*LIMX, MEVEN, 1, MULT, 1)
+ CALL ZCOPY(4*LIMX*LIMX, MEVEN, 1, MULT, 1)
END IF
END IF
CALL GENABCD(LIMX, MULT, O, IO, ABCD, A, B, C, D)
- CALL GENTANDRINC(LIMX, TINC, RINC, TTILDEINC, RTILDEINC,
+ CALL GENTANDRINC(LIMX, TINC, RINC, TTILDEINC, RTILDEINC,
+ A, B, C,D)
CALL UPDATETANDR(TINC, TTILDEINC, R, RTILDEINC, T, TTILDE,
+ RTILDE, LIMX, RINC)
-
- END DO
+ END DO
CALL SV_DECOMP(LIMX, T, TVALS)
-
GETTRANS=CHECKUNI(LIMX,T,R,TTILDE,RTILDE)
RETURN
END
@@ -159,8 +158,8 @@ SUBROUTINE FILLOANDINVERT(O, IO, LIMX, FLUX)
DOUBLE COMPLEX O(2*LIMX, 2*LIMX), IO(2*LIMX, 2*LIMX)
DOUBLE PRECISION SQRT05, FLUX
DOUBLE COMPLEX ZISQRT05, CNUM
-
-c It is slightly more efficient to calculate square root once
+
+c It is slightly more efficient to calculate square root once
SQRT05 = SQRT(0.5)
ZISQRT05 = DCMPLX(0, SQRT05)
C$$$ GENERATE O-MATRIX
@@ -174,7 +173,6 @@ SUBROUTINE FILLOANDINVERT(O, IO, LIMX, FLUX)
c$$$ Hopefully this is correct - test analytically later
ENDDO
CALL ZCOPY(4*LIMX*LIMX, O, 1, IO, 1)
- CALL INVERTMATRIX(IO, 2*LIMX)
-
+ CALL INVERTMATRIX(IO, 2*LIMX)
RETURN
END
View
27 transfermatrix/trupdate.f
@@ -8,18 +8,18 @@ SUBROUTINE GENABCD(LIMX, MULT, O, IO, ABCD, A, B, C, D)
+ O(2*LIMX, 2*LIMX), IO(2*LIMX, 2*LIMX),
+ TEMP(2*LIMX, 2*LIMX),
+ ABCD(2*LIMX, 2*LIMX)
-
+
UNITY = 1.0
- ZERO = 0.0
-
-C$$$ ZGEMM MULTIPLIES MATRICES TOGTHER
+ ZERO = 0.0
+
+C$$$ ZGEMM MULTIPLIES MATRICES TOGETHER
CALL ZGEMM('N', 'N', 2*LIMX, 2*LIMX, 2*LIMX, UNITY, MULT,
+ 2*LIMX, O, 2*LIMX, ZERO, TEMP, 2*LIMX)
CALL ZGEMM('N', 'N', 2*LIMX, 2*LIMX, 2*LIMX, UNITY, IO,
- + 2*LIMX, TEMP, 2*LIMX, ZERO, ABCD, 2*LIMX)
+ + 2*LIMX, TEMP, 2*LIMX, ZERO, ABCD, 2*LIMX)
-C$$$ THIS IS FORTRAN 90 SYNTAX, REMOVE IN FUTURE REVISION WHEN BLAS/LAPACK SUBROUTINE IS FOUND
+c$$$ To be removed for block matrices
A=ABCD(1:LIMX, 1:LIMX)
B=ABCD((LIMX+1):2*LIMX, 1:LIMX)
C=ABCD(1:LIMX, LIMX+1:2*LIMX)
@@ -28,8 +28,7 @@ SUBROUTINE GENABCD(LIMX, MULT, O, IO, ABCD, A, B, C, D)
C$$$ I HAVE VERIFIED THAT AD-BC=1 (IDENTITY MATRIX) AS EXPECTED
RETURN
END
-
-C$$$ ROUTINE TO GENERATE T AND R F
+C$$$ ROUTINE TO GENERATE T AND R
SUBROUTINE GENTANDRINC(LIMX, TINC,RINC,TTILDEINC,RTILDEINC,A,B,
+ C,D)
IMPLICIT NONE
@@ -39,14 +38,13 @@ SUBROUTINE GENTANDRINC(LIMX, TINC,RINC,TTILDEINC,RTILDEINC,A,B,
+ C(LIMX, LIMX), D(LIMX, LIMX),
+ TINC(LIMX, LIMX), TTILDEINC(LIMX, LIMX),
+ RINC(LIMX, LIMX), RTILDEINC(LIMX, LIMX)
-c UNITMATRIX is no longer needed
+c UNITMATRIX is no longer needed
c UNITMATRIX(LIMX, LIMX)
UNITY = 1.0
ZERO = 0.0
c Not needed
c CALL ZLASET ('ALL', LIMX, LIMX, ZERO, ONE, UNITMATRIX, LIMX)
-
C$$$ T~ = D^-1
CALL ZCOPY(LIMX*LIMX, D, 1, TTILDEINC, 1)
CALL INVERTMATRIX(TTILDEINC, LIMX)
@@ -83,14 +81,12 @@ SUBROUTINE UPDATETANDR(TINC, TTILDEINC, R, RTILDEINC, T, TTILDE,
DOUBLE COMPLEX BRACKET12(LIMX, LIMX), BRACKET21(LIMX, LIMX),
+ TRTEMP(LIMX, LIMX), TRTEMP2(LIMX, LIMX),
+ UNITMATRIX(LIMX, LIMX), ALLZERO(LIMX, LIMX)
-
UNITY = 1.0
ZERO = 0.0
-
CALL ZCOPY(LIMX*LIMX, T, 1, T1TEMP, 1)
CALL ZCOPY(LIMX*LIMX, TTILDE, 1, TTILDE1TEMP, 1)
- CALL ZCOPY(LIMX*LIMX, R, 1, R1TEMP, 1)
- CALL ZCOPY(LIMX*LIMX, RTILDE, 1, RTILDE1TEMP, 1)
+ CALL ZCOPY(LIMX*LIMX, R, 1, R1TEMP, 1)
+ CALL ZCOPY(LIMX*LIMX, RTILDE, 1, RTILDE1TEMP, 1)
CALL ZLASET ('ALL', LIMX, LIMX, ZERO, ZERO, ALLZERO, LIMX)
CALL ZLASET ('ALL', LIMX, LIMX, ZERO, UNITY, UNITMATRIX, LIMX)
@@ -136,8 +132,5 @@ SUBROUTINE UPDATETANDR(TINC, TTILDEINC, R, RTILDEINC, T, TTILDE,
+ RINC, LIMX, ZERO, TRTEMP2, LIMX)
CALL ZGEMM ('N', 'N', LIMX, LIMX, LIMX, UNITY, TRTEMP2, LIMX,
+ T1TEMP, LIMX, UNITY, R, LIMX)
-
RETURN
END
-
-
View
15 transfermatrix/util.f
@@ -1,16 +1,13 @@
-C$$$ ROUTINE TO PRINT OUTPUT TO THE SCREEN
+C$$$ ROUTINE TO PRINT OUTPUT TO THE SCREEN
SUBROUTINE PRINTVECTOR(INPUT, LIMX, MNAME)
IMPLICIT NONE
INTEGER LIMX, I
DOUBLE PRECISION INPUT(LIMX)
CHARACTER*2 MNAME
-
WRITE (*,200) MNAME, (INPUT(I)*INPUT(I), I = 1, LIMX)
200 FORMAT (A, ' =', ES15.5E2, ES15.5E2)
-
RETURN
END
-
SUBROUTINE PRINTT(T, LIMX, MNAME)
IMPLICIT NONE
INTEGER LIMX, J, K
@@ -29,7 +26,6 @@ SUBROUTINE PRINTT(T, LIMX, MNAME)
RETURN
END
-
SUBROUTINE PRINTM(M, LIMX, MNAME)
IMPLICIT NONE
INTEGER LIMX, J, K
@@ -43,7 +39,7 @@ SUBROUTINE PRINTM(M, LIMX, MNAME)
C WRITE (*,401) MNAME, 'I', AIMAG(T(2,1)), AIMAG(T(2, 2))
500 FORMAT (A, 100F6.2)
- 501 FORMAT (A, A, 100ES15.5E3, ES15.5E3)
+c$$$ 501 FORMAT (A, A, 100ES15.5E3, ES15.5E3)
RETURN
END
@@ -54,7 +50,7 @@ SUBROUTINE ZPRINTM(M, LIMX, MNAME)
DOUBLE COMPLEX M(2*LIMX, 2*LIMX)
CHARACTER*3 MNAME
DO J=1, 2*LIMX
- WRITE (*,600) MNAME,(REAL(M(J, K)), '+', DIMAG(M(J, K)),
+ WRITE (*,600) MNAME,(REAL(M(J, K)), '+', DIMAG(M(J, K)),
+ 'I | ', K=1,2*LIMX)
END DO
C WRITE (*,400) MNAME, REAL(T(2,1)), REAL(T(2, 2))
@@ -69,10 +65,9 @@ SUBROUTINE ZPRINTM(M, LIMX, MNAME)
SUBROUTINE ZPOLAR(ARG, ZCOMPLEX)
IMPLICIT NONE
c$$$ Subroutine to change e^i*arg in to a complex number in sin and cos, stored in zcomplex
-
+
DOUBLE PRECISION ARG
DOUBLE COMPLEX ZCOMPLEX
-
ZCOMPLEX = DCMPLX(COS(ARG), SIN(ARG))
RETURN
END
@@ -81,7 +76,7 @@ DOUBLE PRECISION FUNCTION CONDUCTANCE (TVALS, LIMX)
IMPLICIT NONE
INTEGER LIMX
DOUBLE PRECISION TVALS(LIMX)
- DOUBLE PRECISION DDOT
+ DOUBLE PRECISION DDOT
CONDUCTANCE = DDOT (LIMX, TVALS, 1, TVALS, 1)
RETURN
END
Please sign in to comment.
Something went wrong with that request. Please try again.