-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathengouth.f90
106 lines (106 loc) · 4.03 KB
/
engouth.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
!***********************************************************************
! *
SUBROUTINE ENGOUTH(EAV, E, JTOT, IPAR, ILEV, NN, MODE)
! *
! This subroutine prints energy levels, splittings, and energies *
! relative to the lowest in Hartrees, Kaysers, and eV, using the *
! reduced mass corrected value for the Rydberg. If MODE is 0, only *
! the eigenenergies are printed. If MODE is 1, the eigenenergies *
! and separations are printed. If MODE is 2, the eigenenergies and *
! energies relative to level 1 are printed. If MODE is 3, the eig- *
! enenergies, separations, and energies relative to level 1 are *
! printed. *
! Last updated: 15 Oct 1992 *
! *
!***********************************************************************
!...Translated by Pacific-Sierra Research 77to90 4.3E 14:06:03 1/ 3/07
!...Modified by Charlotte Froese Fischer
! Gediminas Gaigalas 11/01/17
!-----------------------------------------------
! M o d u l e s
!-----------------------------------------------
USE vast_kind_param, ONLY: DOUBLE
USE def_C, ONLY: aucm, auev, ccms, fasi, fbsi
USE jlabl_C, LABJ=> JLBR, LABP=>JLBP
IMPLICIT NONE
!-----------------------------------------------
! D u m m y A r g u m e n t s
!-----------------------------------------------
INTEGER, INTENT(IN) :: NN
INTEGER, INTENT(IN) :: MODE
INTEGER, DIMENSION(NN), INTENT(IN) :: JTOT
INTEGER, DIMENSION(NN), INTENT(IN) :: IPAR
INTEGER, DIMENSION(NN), INTENT(IN) :: ILEV
REAL(DOUBLE), DIMENSION(NN), INTENT(IN) :: E
REAL(DOUBLE), INTENT(IN) :: EAV
!-----------------------------------------------
! L o c a l V a r i a b l e s
!-----------------------------------------------
INTEGER :: J, I, IP
REAL(DOUBLE) :: EAU, ECM, EEV
!-----------------------------------------------
!
! Always print the eigenenergies
!
!GG WRITE (24, 300)
!GG WRITE (24, 301)
WRITE (29, 300)
WRITE (29, 301)
DO J = 1, NN
I = ILEV(J)
EAU = E(J) + EAV
ECM = EAU*AUCM
EEV = EAU*AUEV
IP = (IPAR(J)+3)/2
!GG WRITE (24, 302) I, LABJ(JTOT(J)), LABP(IP), EAU, ECM, EEV
WRITE (29, 302) I, LABJ(JTOT(J)), LABP(IP), EAU, ECM, EEV
END DO
!
IF (NN > 1) THEN
!
! Energy separations
!
IF (MODE==1 .OR. MODE==3) THEN
!GG WRITE (24, 303)
!GG WRITE (24, 301)
WRITE (29, 303)
WRITE (29, 301)
DO J = 2, NN
I = ILEV(J)
EAU = E(J) - E(J-1)
ECM = EAU*AUCM
EEV = EAU*AUEV
IP = (IPAR(J)+3)/2
!GG WRITE (24, 302) I, LABJ(JTOT(J)), LABP(IP), EAU, ECM, EEV
WRITE (29, 302) I, LABJ(JTOT(J)), LABP(IP), EAU, ECM, EEV
END DO
ENDIF
!
! Energies relative to level 1
!
IF (MODE==2 .OR. MODE==3) THEN
!GG WRITE (24, 304)
!GG WRITE (24, 301)
WRITE (29, 304)
WRITE (29, 301)
DO J = 2, NN
I = ILEV(J)
EAU = E(J) - E(1)
ECM = EAU*AUCM
EEV = EAU*AUEV
IP = (IPAR(J)+3)/2
!GG WRITE (24, 302) I, LABJ(JTOT(J)), LABP(IP), EAU, ECM, EEV
WRITE (29, 302) I, LABJ(JTOT(J)), LABP(IP), EAU, ECM, EEV
END DO
ENDIF
!
ENDIF
!
300 FORMAT(/,'Eigenenergies:')
301 FORMAT(/,'Level J Parity',7X,'Hartrees',14X,'Kaysers',16X,'eV'/)
302 FORMAT(1I3,2X,2A4,1P,3D22.14)
303 FORMAT(/,'Energy of each level relative to immediately lower',' level:')
304 FORMAT(/,'Energy of each level relative to lowest level:')
RETURN
!
END SUBROUTINE ENGOUTH