C @@ 2004 12/26 MODIFY EVOU2 VER.1.3D@@
C----------------------------------------------------------------
SUBROUTINE EVOU2(IRATIO,HCPHEX,ALFA)
IMPLICIT REAL(A-H,O-Y)
IMPLICIT COMPLEX(Z)
INCLUDE 'PACVPP'
DIMENSION BONDL(KATM,KATM),BSORT(KATM*KATM)
& ,IBIA(KATM*KATM),IBIB(KATM*KATM)
C
AUAA = 0.529177D0
AUAA2 = AUAA*AUAA
AUAA3 = AUAA2*AUAA
AUEV = 27.2D0
C
REWIND 11
REWIND 20
REWIND 25
WRITE (20,300) EF
300 FORMAT(1H ,'E-K CURVE EF =',F12.6)
DO 100 NNN=1,KV3
WRITE(20,303) VX(NNN),VY(NNN),VZ(NNN)
303 FORMAT((1H ,3(F10.6,2X)))
WRITE(20,302) (EKO(I,NNN),I=1,KEG)
302 FORMAT((1H ,5(F10.6,2X)))
100 CONTINUE
C'''''WRITE 11!'''''''''''''''''''''''''''''''''''''''''''''''''''
WRITE(11,399) ITEMAX,PINIT,CONV,GMAX,ICONT
399 FORMAT(' ',I6,F8.4,D12.4,F8.4,I4)
DO 400 I=1,3
WRITE(11,500) ALTV(1,I),ALTV(2,I),ALTV(3,I)
400 CONTINUE
WRITE(11,*) KCOTYP,' COORDINATES 0:NORMALIZED 1:CARTESIAN '
IF(KCOTYP.EQ.0) THEN
DO 410 IA=1,KATM
PPOS(IA) = ALINV(1,1)*CATX(IA)
& + ALINV(1,2)*CATY(IA) + ALINV(1,3)*CATZ(IA)
QPOS(IA) = ALINV(2,1)*CATX(IA)
& + ALINV(2,2)*CATY(IA) + ALINV(2,3)*CATZ(IA)
RPOS(IA) = ALINV(3,1)*CATX(IA)
& + ALINV(3,2)*CATY(IA) + ALINV(3,3)*CATZ(IA)
WRITE (6,*) CATX(IA),CATY(IA),CATZ(IA)
WRITE (6,*) PPOS(IA),QPOS(IA),RPOS(IA)
410 CONTINUE
WRITE(11,500)(PPOS(IA),QPOS(IA),RPOS(IA),IA=1,KATM)
WRITE (6,*) ALINV(1,1),ALINV(1,2),ALINV(1,3)
WRITE (6,*) ALINV(2,1),ALINV(2,2),ALINV(2,3)
WRITE (6,*) ALINV(3,1),ALINV(3,2),ALINV(3,3)
ELSE
WRITE(11,500)(CATX(IA),CATY(IA),CATZ(IA),IA=1,KATM)
END IF
NNATM=0
DO 420 IT=1,KTYP
NNATM=NNATM+IATOM(IT)
WRITE(11,*) IATOM(IT),NLSPD(IT)
WRITE(11,502) AICHG(NNATM),ALFA
WRITE(11,502) ACHG(IT),AC(IT,1),AC(IT,2),BC(IT,1),BC(IT,2)
420 CONTINUE
500 FORMAT(3(F20.10))
502 FORMAT(5(F15.8))
WRITE(11,503) HCPHEX,IRATIO
503 FORMAT(F12.6,I6)
C
C BORH (a.u.) ---> A
C a.u. ---> eV
C c/a RATIO
C
WRITE(6,*) "A.U. : ATOMIC UNIT = BORH"
WRITE(6,*) "AA : ANGSTROME = 0.529177*A.U."
WRITE(25,*) "A.U. : ATOMIC UNIT = BORH"
WRITE(25,*) "AA : ANGSTROME = 0.529177*A.U."
WRITE(6,*) "VOLUME OF UNIT CELL = ",UNIVOL," A.U.^3"
WRITE(25,*) "VOLUME OF UNIT CELL = ",UNIVOL," A.U.^3"
WRITE(6,*) "VOLUME OF UNIT CELL = ",AUAA3*UNIVOL," AA^3"
WRITE(25,*) "VOLUME OF UNIT CELL = ",AUAA3*UNIVOL," AA^3"
WRITE(6,*) "ALTV : A.U."
WRITE(25,*) "ALTV : A.U."
DO 1400 I=1,3
WRITE(6,500) ALTV(1,I),ALTV(2,I),ALTV(3,I)
WRITE(25,500) ALTV(1,I),ALTV(2,I),ALTV(3,I)
1400 CONTINUE
WRITE(6,*) "ALTV : A.U. --> AA"
WRITE(25,*) "ALTV : A.U. --> AA"
DO 1401 I=1,3
WRITE(6,500) AUAA*ALTV(1,I),AUAA*ALTV(2,I),AUAA*ALTV(3,I)
WRITE(25,500) AUAA*ALTV(1,I),AUAA*ALTV(2,I),AUAA*ALTV(3,I)
1401 CONTINUE
C
WRITE (25,*) "C <-- ALTV(1,1)"
WRITE (6,*) "C <-- ALTV(1,1)"
WRITE (25,*) "B <-- ALTV(2,2)"
WRITE (6,*) "B <-- ALTV(2,2)"
WRITE (25,*) "A <-- ALTV(3,3)"
WRITE (6,*) "A <-- ALTV(3,3)"
C
RCB = ALTV(1,1)/ALTV(2,2)
RCA = ALTV(1,1)/ALTV(3,3)
RBC = ALTV(2,2)/ALTV(3,3)
WRITE (25,*) "C/B RATIO = ",RCB," <-- HEXAGONAL C/A"
WRITE (6,*) "C/B RATIO = ",RCB," <-- HEXAGONAL C/A"
WRITE (25,*) "C/A RATIO = ",RCA
WRITE (6,*) "C/A RATIO = ",RCA
WRITE (25,*) "B/A RATIO = ",RBC
WRITE (6,*) "B/A RATIO = ",RBC
C
WRITE (6,*) "CATX,Y,Z : A.U."
DO 1410 IA=1,KATM
C PPOS(IA) = ALINV(1,1)*CATX(IA)
C & + ALINV(1,2)*CATY(IA) + ALINV(1,3)*CATZ(IA)
C QPOS(IA) = ALINV(2,1)*CATX(IA)
C & + ALINV(2,2)*CATY(IA) + ALINV(2,3)*CATZ(IA)
C RPOS(IA) = ALINV(3,1)*CATX(IA)
C & + ALINV(3,2)*CATY(IA) + ALINV(3,3)*CATZ(IA)
WRITE (6,500) CATX(IA),CATY(IA),CATZ(IA)
1410 CONTINUE
WRITE (6,*) "PQRPOS"
WRITE (25,*) "PQRPOS"
DO 1411 IA=1,KATM
WRITE (6,500) PPOS(IA),QPOS(IA),RPOS(IA)
WRITE (25,500) PPOS(IA),QPOS(IA),RPOS(IA)
1411 CONTINUE
WRITE (6,*) "CATX,Y,Z : A.U. --> AA"
WRITE (25,*)"CATX,Y,Z : A.U. --> AA"
DO 1412 IA=1,KATM
WRITE (6,500) AUAA*CATX(IA),AUAA*CATY(IA),AUAA*CATZ(IA)
WRITE (25,500) AUAA*CATX(IA),AUAA*CATY(IA),AUAA*CATZ(IA)
1412 CONTINUE
WRITE (25,*)"CATX,Y,Z : A.U."
WRITE(25,500)(CATX(IA),CATY(IA),CATZ(IA),IA=1,KATM)
WRITE (25,*)"PQRPOS"
WRITE(25,500)(PPOS(IA),QPOS(IA),RPOS(IA),IA=1,KATM)
C
WRITE (6,*) "BOND LENGTH <--- CATX : A.U."
WRITE (25,*) "BOND LENGTH <--- CATX : A.U."
DO 1600 IA=1,KATM
DO 1610 IB=IA+1,KATM
BLX = CATX(IB) - CATX(IA)
BLY = CATY(IB) - CATY(IA)
BLZ = CATZ(IB) - CATZ(IA)
BLT = BLX*BLX + BLY*BLY + BLZ*BLZ
BLT = DSQRT(BLT)
BONDL(IA,IB) = BLT
WRITE (6,*) "IA - IB = ",IA,IB," BOND LENGTH = ",BLT," a.u."
WRITE (25,*) "IA - IB = ",IA,IB," BOND LENGTH = ",BLT," a.u."
1610 CONTINUE
1600 CONTINUE
C
WRITE (6,*) "BOND LENGTH <--- CATX : AA"
WRITE (25,*) "BOND LENGTH <--- CATX : AA"
DO 1601 IA=1,KATM
DO 1611 IB=IA+1,KATM
BLT = AUAA*BONDL(IA,IB)
WRITE (6,*) "IA - IB = ",IA,IB," BOND LENGTH = ",BLT," AA"
WRITE (25,*) "IA - IB = ",IA,IB," BOND LENGTH = ",BLT," AA"
1611 CONTINUE
1601 CONTINUE
C
C SEARCH MINIMUM BOND LENGTH
C
BMIN = BONDL(1,2)
DO 1602 IA=1,KATM
DO 1612 IB=IA+1,KATM
BLT = BONDL(IA,IB)
IF (BLT .LE. BMIN) THEN
BMIN = BLT
IAMIN= IA
IBMIN= IB
END IF
1612 CONTINUE
1602 CONTINUE
WRITE(6,*) "IA,IB = ",IAMIN,IBMIN," MIN OF BL = ",BMIN," a.u."
WRITE(25,*) "IA,IB = ",IAMIN,IBMIN," MIN OF BL = ",BMIN," a.u."
WRITE(6,*) "IA,IB = ",IAMIN,IBMIN," MIN OF BL = ",AUAA*BMIN," AA"
WRITE(25,*) "IA,IB = ",IAMIN,IBMIN," MIN OF BL = ",AUAA*BMIN," AA"
C
C SORT BOND LENGTH
C
I = 1
DO 1603 IA=1,KATM
DO 1613 IB=IA+1,KATM
BSORT(I) = BONDL(IA,IB)
IBIA(I) = IA
IBIB(I) = IB
I = I + 1
1613 CONTINUE
1603 CONTINUE
IMAX = I - 1
WRITE(6,*) "NUMBER OF BONDS = ",IMAX
WRITE(25,*) "NUMBER OF BONDS = ",IMAX
DO 1604 J = 1,IMAX
DO 1614 K = J,IMAX
IF (BSORT(J) .LT. BSORT(K)) THEN
BLT = BSORT(J)
IBSA= IBIA(J)
IBSB= IBIB(J)
BSORT(J) = BSORT(K)
IBIA(J) = IBIA(K)
IBIB(J) = IBIB(K)
BSORT(K) = BLT
IBIA(K) = IBSA
IBIB(K) = IBSB
END IF
1614 CONTINUE
1604 CONTINUE
C
WRITE(6,*) "RESULTS OF SORT OF BOND LENGTH"
WRITE(25,*) "RESULTS OF SORT OF BOND LENGTH"
DO 1605 J = 1,IMAX
BLT = BSORT(J)
IA = IBIA(J)
IB = IBIB(J)
WRITE (6,*) "IA - IB = ",IA,IB," BOND LENGTH = ",BLT," a.u."
WRITE (25,*) "IA - IB = ",IA,IB," BOND LENGTH = ",BLT," a.u."
1605 CONTINUE
C'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
RETURN
END