-
Notifications
You must be signed in to change notification settings - Fork 0
/
mappar.f
203 lines (202 loc) · 8.98 KB
/
mappar.f
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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
c***********************************************************************
SUBROUTINE MAPPAR(NISTP,PV,FORBAC)
c***********************************************************************
c** This subroutine will convert external logical physical parameters
c into the generic NLLSSRR parameter array PV or the reverse.
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c++ COPYRIGHT 1997-2016 by J.Y. Seto & R.J. Le Roy (ver. 27/03/2016)+
c Dept. of Chemistry, Univ. of Waterloo, Waterloo, Ontario, Canada +
c This software may not be sold or any other commercial use made +
c of it without the express written permission of the authors. +
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c PV(i) is the NLLSSRR parameter array.
c FORBAC is a flag to determine which way the parameters are mapped
c FORBAC = 0 : Map internal PV to external variables.
c FORBAC = 1 : Map external varuables to internal PV.
c* NSTATES is the number of states being considered (in BLKPARAM)
c=======================================================================
INCLUDE 'arrsizes.h'
INCLUDE 'BLKPOT.h'
INCLUDE 'BLKPARAM.h'
INCLUDE 'BLKBOB.h'
c-----------------------------------------------------------------------
INTEGER NISTP, m, FORBAC, ISTATE, IPV, I, J, ISOT
REAL*8 PV(NPARMX)
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c** Map external free parameters (De, Re, etc.) onto internal NLLSSRR
c parameters PV(j)
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
IF(FORBAC.EQ.0) THEN
IPV= 0
DO ISTATE= 1,NSTATES
IF(PSEL(ISTATE).EQ.-1) THEN
c*** Manage parameters for term value mappings ...
DO ISOT= 1, NISTP
DO I= VMIN(ISTATE,ISOT),VMAX(ISTATE,ISOT)
IF(NBC(I,ISOT,ISTATE).GT.0) THEN
DO J=1,NBC(I,ISOT,ISTATE)
IPV= IPV+1
PV(IPV)= ZBC(I,J-1,ISOT,ISTATE)
ENDDO
IF(NQC(I,ISOT,ISTATE).GT.0) THEN
DO J=1,NQC(I,ISOT,ISTATE)
IPV= IPV+1
PV(IPV)= ZQC(I,J-1,ISOT,ISTATE)
ENDDO
ENDIF
ENDIF
ENDDO
DO I= VMIN(ISTATE,ISOT),VMAX(ISTATE,ISOT)
ENDDO
ENDDO
ENDIF
IF(PSEL(ISTATE).GT.0) THEN
c*** Manage parameters for potential function mapping ...
IF(PSEL(ISTATE).LT.4) THEN
IPV= IPV+ 1
PV(IPV)= DE(ISTATE)
ENDIF
IF(PSEL(ISTATE).LE.4) THEN
IPV= IPV+ 1
PV(IPV)= RE(ISTATE)
IPV= IPV+ 1 !! count RREFq
PV(IPV)= RREFq(ISTATE)
ENDIF
IF(PSEL(ISTATE).EQ.2) THEN
IPV= IPV+ 1 !! count RREFp
PV(IPV)= RREFp(ISTATE)
ENDIF
IF((PSEL(ISTATE).EQ.2).OR.(PSEL(ISTATE).EQ.3)) THEN
DO m= 1,NCMM(ISTATE)
IPV= IPV+ 1 !! count Cm's
PV(IPV)= CmVAL(m,ISTATE)
ENDDO
ENDIF
J= 0 !! for all PECs except SE-MLR, TT or HDF
IF((APSE(ISTATE).GT.0).OR.(PSEL(ISTATE).GE.6)) J=1
DO I= J,Nbeta(ISTATE)
IPV= IPV+ 1 !! count \beta_i's
PV(IPV)= BETA(I,ISTATE)
ENDDO
IF(NUA(ISTATE).GE.0) THEN
DO I= 0,NUA(ISTATE)
IPV= IPV+ 1
PV(IPV) = UA(I,ISTATE)
ENDDO
ENDIF
IF(NUB(ISTATE).GE.0) THEN
DO I= 0,NUB(ISTATE)
IPV= IPV+ 1
PV(IPV) = UB(I,ISTATE)
ENDDO
ENDIF
IF(NTA(ISTATE).GE.0) THEN
DO I= 0,NTA(ISTATE)
IPV= IPV+ 1
PV(IPV) = TA(I,ISTATE)
ENDDO
ENDIF
IF(NTB(ISTATE).GE.0) THEN
DO I= 0,NTB(ISTATE)
IPV= IPV+ 1
PV(IPV) = TB(I,ISTATE)
ENDDO
ENDIF
IF(NwCFT(ISTATE).GE.0) THEN
DO I= 0, NwCFT(ISTATE)
IPV= IPV+ 1
PV(IPV) = wCFT(I,ISTATE)
ENDDO
ENDIF
ENDIF
ENDDO
ELSEIF(FORBAC.EQ.1) THEN
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c** Convert internal NLLSSRR parameter array back into external
c (logical) variable system (De, Re, etc.).
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
IPV = 0
DO ISTATE=1,NSTATES
IF(PSEL(ISTATE).EQ.-1) THEN
c*** Manage parameters for term value mappings ...
DO ISOT= 1, NISTP
DO I= VMIN(ISTATE,ISOT),VMAX(ISTATE,ISOT)
IF(NBC(I,ISOT,ISTATE).GT.0) THEN
DO J= 1,NBC(I,ISOT,ISTATE)
IPV= IPV+1
ZBC(I,J-1,ISOT,ISTATE)= PV(IPV)
ENDDO
IF(NQC(I,ISOT,ISTATE).GT.0) THEN
DO J= 1,NQC(I,ISOT,ISTATE)
IPV= IPV+1
ZQC(I,J-1,ISOT,ISTATE)= PV(IPV)
ENDDO
ENDIF
ENDIF
ENDDO
ENDDO
ENDIF
IF(PSEL(ISTATE).GT.0) THEN
c*** Manage parameters for potential function mappings ...
IF(PSEL(ISTATE).LT.4) THEN
IPV= IPV + 1 !! count D_e
DE(ISTATE)= PV(IPV)
ENDIF
IF(PSEL(ISTATE).LE.4) THEN
IPV= IPV + 1 !! count r_e
RE(ISTATE) = PV(IPV)
IPV= IPV+ 1 !! count RREFq
RREFq(ISTATE)= PV(IPV)
ENDIF
IF(PSEL(ISTATE).EQ.2) THEN
IPV= IPV+ 1 !! count RREFp
RREFp(ISTATE)= PV(IPV)
ENDIF
IF((PSEL(ISTATE).EQ.2).OR.(PSEL(ISTATE).EQ.3)) THEN
DO m= 1,NCMM(ISTATE)
IPV= IPV+ 1
CmVAL(m,ISTATE)= PV(IPV)
ENDDO
ENDIF
J=0 !! count for all PECs except SE-MLR, TT or HDF
IF((APSE(ISTATE).GT.0).OR.(PSEL(ISTATE).GE.6)) J=1
DO I= J, Nbeta(ISTATE)
IPV = IPV + 1
BETA(I,ISTATE) = PV(IPV)
ENDDO
IF(NUA(ISTATE).GE.0) THEN
DO I= 0,NUA(ISTATE)
IPV = IPV + 1
UA(I,ISTATE) = PV(IPV)
ENDDO
ENDIF
IF(NUB(ISTATE).GE.0) THEN
DO I= 0,NUB(ISTATE)
IPV = IPV + 1
UB(I,ISTATE) = PV(IPV)
ENDDO
ENDIF
IF(NTA(ISTATE).GE.0) THEN
DO I= 0,NTA(ISTATE)
IPV = IPV + 1
TA(I,ISTATE) = PV(IPV)
ENDDO
ENDIF
IF(NTB(ISTATE).GE.0) THEN
DO I= 0,NTB(ISTATE)
IPV = IPV + 1
TB(I,ISTATE) = PV(IPV)
ENDDO
ENDIF
IF(NwCFT(ISTATE).GE.0) THEN
DO I=0,NwCFT(ISTATE)
IPV = IPV + 1
wCFT(I,ISTATE) = PV(IPV)
ENDDO
ENDIF
ENDIF
ENDDO
ENDIF
RETURN
END
c23456789 123456789 123456789 123456789 123456789 123456789 123456789 12