Skip to content

Commit 90ead3e

Browse files
lauvergnlauvergn
lauvergn
authored and
lauvergn
committed
Improve the test files+fix a bug in the IRC
1 parent c17eb4e commit 90ead3e

27 files changed

+183
-146
lines changed

‎SRC/Model_m.f90

Lines changed: 3 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -456,11 +456,6 @@ SUBROUTINE Init_Model(QModel,pot_name,ndim,nsurf,adiabatic,Cart_TO_Q, &
456456
write(out_unitp,*) 'You have decided to perform a numeric checking of the analytic formulas.'
457457
END IF
458458

459-
!read_param_loc = (read_param_loc .AND. read_nml) ! this enables to not read the next namelist when read_param_loc=t
460-
461-
!CALL QModel_in%Write_QModel(nio=out_unitp)
462-
463-
464459
CALL string_uppercase_TO_lowercase(pot_name_loc)
465460
IF (Print_init_loc) write(out_unitp,*) 'pot_name_loc: ',pot_name_loc
466461

@@ -796,8 +791,6 @@ SUBROUTINE Init_Model(QModel,pot_name,ndim,nsurf,adiabatic,Cart_TO_Q, &
796791
STOP 'STOP in Init_Model: Other potentials have to be done'
797792
END SELECT
798793

799-
CALL QModel%QM%Write_QModel(nio=out_unitp)
800-
801794
IF (present(ndim)) THEN
802795
IF (ndim > QModel%QM%ndim) THEN
803796
write(out_unitp,*) ' ERROR in Init_Model'
@@ -2571,7 +2564,7 @@ SUBROUTINE Check_analytical_numerical_derivatives(QModel,Q,nderiv)
25712564
ndim=QModel%QM%ndim,nderiv=nderiv)
25722565

25732566

2574-
IF (QModel%QM%adiabatic) THEN
2567+
IF (QModel%QM%adiabatic .AND. QModel%QM%nsurf > 1) THEN
25752568
CALL Eval_Pot(QModel,Q,PotVal_ana,nderiv,NAC_ana,Vec_ana,numeric=.FALSE.)
25762569
ELSE
25772570
CALL Eval_Pot(QModel,Q,PotVal_ana,nderiv,numeric=.FALSE.)
@@ -2583,7 +2576,7 @@ SUBROUTINE Check_analytical_numerical_derivatives(QModel,Q,nderiv)
25832576
flush(out_unitp)
25842577
END IF
25852578

2586-
IF (QModel%QM%adiabatic) THEN
2579+
IF (QModel%QM%adiabatic .AND. QModel%QM%nsurf > 1) THEN
25872580
CALL Eval_Pot(QModel,Q,PotVal_num,nderiv,NAC_num,Vec_num,numeric=.TRUE.)
25882581
ELSE
25892582
CALL Eval_Pot(QModel,Q,PotVal_num,nderiv,numeric=.TRUE.)
@@ -2610,7 +2603,7 @@ SUBROUTINE Check_analytical_numerical_derivatives(QModel,Q,nderiv)
26102603
CALL QML_Write_dnMat(Mat_diff,nio=out_unitp)
26112604
END IF
26122605

2613-
IF (QModel%QM%adiabatic) THEN
2606+
IF (QModel%QM%adiabatic .AND. QModel%QM%nsurf > 1) THEN
26142607

26152608
MaxMat = QML_get_maxval_OF_dnMat(NAC_ana)
26162609
IF (MaxMat < ONETENTH**6) MaxMat = ONE

‎SRC/Opt/IRC_m.f90

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -328,8 +328,9 @@ SUBROUTINE QML_IRC(Q,QModel,IRC_p,Q0)
328328

329329
END SUBROUTINE QML_IRC
330330

331-
SUBROUTINE QML_IRC_ODE(s,QactOld,QactNew,Ene_AT_s,QModel,IRC_p,forward, &
332-
grad_AT_s,Method,order)
331+
RECURSIVE SUBROUTINE QML_IRC_ODE(s,QactOld,QactNew,Ene_AT_s, &
332+
QModel,IRC_p,forward, &
333+
grad_AT_s,Method,order)
333334
USE QMLLib_UtilLib_m
334335
USE Model_m
335336
IMPLICIT NONE

‎SRC/Opt/Opt_m.f90

Lines changed: 17 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -287,8 +287,8 @@ SUBROUTINE QML_Opt(Q,QModel,Opt_param,Q0)
287287

288288
!----- for debuging --------------------------------------------------
289289
character (len=*), parameter :: name_sub='QML_Opt'
290-
!logical, parameter :: debug = .FALSE.
291-
logical, parameter :: debug = .TRUE.
290+
logical, parameter :: debug = .FALSE.
291+
!logical, parameter :: debug = .TRUE.
292292
!-----------------------------------------------------------
293293

294294
IF (debug) THEN
@@ -297,6 +297,14 @@ SUBROUTINE QML_Opt(Q,QModel,Opt_param,Q0)
297297
CALL Write_QML_Opt(Opt_param)
298298
CALL Write_Model(QModel)
299299
flush(out_unitp)
300+
ELSE
301+
write(out_unitp,*) '=================================================='
302+
write(out_unitp,*) '=================================================='
303+
write(out_unitp,*) '=== Optimization on the "',QModel%QM%pot_name,'" model.'
304+
write(out_unitp,*) '=== model option:',QModel%QM%option
305+
write(out_unitp,*) '=================================================='
306+
write(out_unitp,*) '=================================================='
307+
flush(out_unitp)
300308
END IF
301309

302310
IF (Opt_param%Max_it < 0) THEN
@@ -424,6 +432,13 @@ SUBROUTINE QML_Opt(Q,QModel,Opt_param,Q0)
424432
write(out_unitp,*) ' Q',Q
425433
write(out_unitp,*) ' END ',name_sub
426434
flush(out_unitp)
435+
ELSE
436+
write(out_unitp,*) '=================================================='
437+
write(out_unitp,*) '=================================================='
438+
write(out_unitp,*) '=== End of the optimization'
439+
write(out_unitp,*) '=================================================='
440+
write(out_unitp,*) '=================================================='
441+
flush(out_unitp)
427442
END IF
428443

429444
END SUBROUTINE QML_Opt

‎SRC/QML/Buck_m.f90

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -150,9 +150,11 @@ SUBROUTINE Init0_QML_Buck(QModel,A,B,C,model_name)
150150
flush(out_unitp)
151151
END IF
152152

153-
QModel%ndim = 1
154-
QModel%nsurf = 1
155-
QModel%pot_name = 'Buck'
153+
QModel%In_a_Model = .TRUE.
154+
155+
QModel%ndim = 1
156+
QModel%nsurf = 1
157+
QModel%pot_name = 'Buck'
156158
IF (present(model_name)) QModel%pot_name = model_name
157159

158160
IF (debug) write(out_unitp,*) 'init Buck parameters (A,B,C), if present'

‎SRC/QML/CH5_m.f90

Lines changed: 17 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -110,8 +110,8 @@ FUNCTION Init_QML_CH5(QModel_in,read_param,nio_param_file) RESULT(QModel)
110110

111111
!----- for debuging --------------------------------------------------
112112
character (len=*), parameter :: name_sub='Init_QML_CH5'
113-
!logical, parameter :: debug = .FALSE.
114-
logical, parameter :: debug = .TRUE.
113+
logical, parameter :: debug = .FALSE.
114+
!logical, parameter :: debug = .TRUE.
115115
!-----------------------------------------------------------
116116
IF (debug) THEN
117117
write(out_unitp,*) 'BEGINNING ',name_sub
@@ -164,8 +164,9 @@ FUNCTION Init_QML_CH5(QModel_in,read_param,nio_param_file) RESULT(QModel)
164164
END SELECT
165165

166166
!write(out_unitp,*) ii,'FileName: ',FileName ; flush(out_unitp)
167-
CALL QML_read_para4d(QModel%a(ii,jj),QModel%b(ii,jj),QModel%F(:,ii,jj),QModel%nn(:,ii,jj), &
168-
ndim,QModel%nt(ii,jj),max_nn,FileName,QModel%file_exist(ii,jj))
167+
CALL QML_read_para4d(QModel%a(ii,jj),QModel%b(ii,jj),QModel%F(:,ii,jj), &
168+
QModel%nn(:,ii,jj),ndim,QModel%nt(ii,jj),max_nn, &
169+
FileName,QModel%file_exist(ii,jj),print_info=debug)
169170
!write(out_unitp,*) ii,'Read done' ; flush(out_unitp)
170171
IF ( .NOT. QModel%file_exist(ii,jj)) STOP ' ERROR while reading CH5 energy parameters'
171172
QModel%ifunc_TO_i1i2(:,ifunc) = [0,0]
@@ -192,8 +193,9 @@ FUNCTION Init_QML_CH5(QModel_in,read_param,nio_param_file) RESULT(QModel)
192193
END SELECT
193194

194195
!write(out_unitp,*) ii,'FileName: ',FileName ; flush(out_unitp)
195-
CALL QML_read_para4d(QModel%a(ii,jj),QModel%b(ii,jj),QModel%F(:,ii,jj),QModel%nn(:,ii,jj), &
196-
ndim,QModel%nt(ii,jj),max_nn,FileName,QModel%file_exist(ii,jj))
196+
CALL QML_read_para4d(QModel%a(ii,jj),QModel%b(ii,jj),QModel%F(:,ii,jj), &
197+
QModel%nn(:,ii,jj),ndim,QModel%nt(ii,jj),max_nn, &
198+
FileName,QModel%file_exist(ii,jj),print_info=debug)
197199
!write(out_unitp,*) ii,'Read done' ; flush(out_unitp)
198200

199201
IF ( .NOT. QModel%file_exist(ii,jj)) STOP ' ERROR while reading CH5 Qop parameters'
@@ -230,8 +232,9 @@ FUNCTION Init_QML_CH5(QModel_in,read_param,nio_param_file) RESULT(QModel)
230232
int_TO_char(ii) // '_' // int_TO_char(jj) )
231233
END SELECT
232234

233-
CALL QML_read_para4d(QModel%a(ii,jj),QModel%b(ii,jj),QModel%F(:,ii,jj),QModel%nn(:,ii,jj), &
234-
ndim,QModel%nt(ii,jj),max_nn,FileName,QModel%file_exist(ii,jj))
235+
CALL QML_read_para4d(QModel%a(ii,jj),QModel%b(ii,jj),QModel%F(:,ii,jj), &
236+
QModel%nn(:,ii,jj),ndim,QModel%nt(ii,jj),max_nn, &
237+
FileName,QModel%file_exist(ii,jj),print_info=debug)
235238

236239
!IF ( .NOT. QModel%file_exist(ii,jj)) STOP ' ERROR while reading CH5 hessian parameters'
237240

@@ -619,18 +622,19 @@ FUNCTION QML_sc_fit3(x,a,b)
619622

620623
END FUNCTION QML_sc_fit3
621624

622-
SUBROUTINE QML_read_para4d(a,b,F,n,ndim,nt,max_points,nom1,exist)
625+
SUBROUTINE QML_read_para4d(a,b,F,n,ndim,nt,max_points,nom1,exist,print_info)
623626
IMPLICIT NONE
624627

625628
integer, intent(in) :: max_points,ndim
626629
integer, intent(inout) :: n(0:ndim),nt
627630
real (kind=Rkind), intent(inout) :: a,b,F(max_points)
628631
character (len=*), intent(in) :: nom1
629632
logical, intent(inout) :: exist
633+
logical, intent(in) :: print_info
630634

631635
integer :: no,ios,kl,i
632636

633-
write(out_unitp,*) 'QML_read_para4d: nom1,max_points: ',nom1,max_points
637+
IF (print_info) write(out_unitp,*) 'QML_read_para4d: nom1,max_points: ',nom1,max_points
634638

635639

636640
CALL file_open2(name_file=nom1,iunit=no,lformatted=.TRUE., &
@@ -639,9 +643,9 @@ SUBROUTINE QML_read_para4d(a,b,F,n,ndim,nt,max_points,nom1,exist)
639643

640644
read(no,*) i ! for nb_fit (not used)
641645

642-
write(out_unitp,*) 'nom1,nt,ndim: ',nom1,nt,ndim
646+
IF (print_info) write(out_unitp,*) 'nom1,nt,ndim: ',nom1,nt,ndim
643647
read(no,*) n(0:ndim)
644-
write(out_unitp,*) 'nom1,n ',nom1,n(0:ndim)
648+
IF (print_info) write(out_unitp,*) 'nom1,n ',nom1,n(0:ndim)
645649
IF (n(0) > max_points) THEN
646650
write(out_unitp,*) ' ERROR : The number of coefficients (',n(0),') >'
647651
write(out_unitp,*) ' than max_points (',max_points,')'
@@ -658,7 +662,7 @@ SUBROUTINE QML_read_para4d(a,b,F,n,ndim,nt,max_points,nom1,exist)
658662
CLOSE(no)
659663
exist = .TRUE.
660664
ELSE
661-
write(out_unitp,*) 'The file (',nom1,') does not exist !!'
665+
IF (print_info) write(out_unitp,*) 'The file (',nom1,') does not exist !!'
662666
exist = .FALSE.
663667
END IF
664668

‎SRC/QML/Empty_m.f90

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -60,6 +60,8 @@ MODULE QML_Empty_m
6060
logical :: adiabatic = .TRUE.
6161
integer :: option = 0
6262
logical :: PubliUnit = .FALSE. ! when PubliUnit=.TRUE., the units of a reference (publi ...) are used. Default (atomic unit)
63+
logical :: In_a_Model = .FALSE.
64+
6365

6466
logical :: Vib_adia = .FALSE.
6567
integer :: nb_Channels = 0
@@ -308,17 +310,21 @@ SUBROUTINE Write_QML_Empty(QModel,nio)
308310
IMPLICIT NONE
309311

310312
CLASS (QML_Empty_t), intent(in) :: QModel
311-
integer, intent(in) :: nio
313+
integer, intent(in) :: nio
312314

315+
IF (QModel%In_a_Model) RETURN
313316

314317
write(nio,*) 'Init: ',QModel%Init
318+
write(nio,*) 'In_a_Model: ',QModel%In_a_Model
315319

316320
write(nio,*) 'nsurf: ',QModel%nsurf
317321
write(nio,*) 'ndim: ',QModel%ndim
318322
write(nio,*) 'numeric: ',QModel%numeric
319323
write(nio,*) 'adiabatic: ',QModel%adiabatic
320324
write(nio,*) 'Vib_adia: ',QModel%Vib_adia
321325
write(nio,*) 'Phase_Following: ',QModel%Phase_Following
326+
write(nio,*) 'Phase_Checking: ',QModel%Phase_Checking
327+
322328
IF (QModel%Vib_adia) THEN
323329
write(nio,*) 'nb_Channels: ',QModel%nb_Channels
324330
IF (allocated(QModel%list_act)) &

‎SRC/QML/H2NSi_m.f90

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -58,7 +58,7 @@ MODULE QML_H2NSi_m
5858
integer, allocatable :: tab_func(:,:)
5959

6060
CONTAINS
61-
PROCEDURE :: EvalPot_QModel => EvalPot_QML_H2NSi
61+
PROCEDURE :: EvalPot_QModel => EvalPot_QML_H2NSi
6262
PROCEDURE :: Write_QModel => Write_QML_H2NSi
6363
PROCEDURE :: Write0_QModel => Write_QML_H2NSi
6464
END TYPE QML_H2NSi_t
@@ -87,8 +87,8 @@ FUNCTION Init_QML_H2NSi(QModel_in,read_param,nio_param_file) RESULT(QModel)
8787

8888
!----- for debuging --------------------------------------------------
8989
character (len=*), parameter :: name_sub='Init_QML_H2NSi'
90-
!logical, parameter :: debug = .FALSE.
91-
logical, parameter :: debug = .TRUE.
90+
logical, parameter :: debug = .FALSE.
91+
!logical, parameter :: debug = .TRUE.
9292
!-----------------------------------------------------------
9393
IF (debug) THEN
9494
write(out_unitp,*) 'BEGINNING ',name_sub

‎SRC/QML/H2SiN_m.f90

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -72,8 +72,8 @@ FUNCTION Init_QML_H2SiN(QModel_in,read_param,nio_param_file) RESULT(QModel)
7272

7373
!----- for debuging --------------------------------------------------
7474
character (len=*), parameter :: name_sub='Init_QML_H2SiN'
75-
!logical, parameter :: debug = .FALSE.
76-
logical, parameter :: debug = .TRUE.
75+
logical, parameter :: debug = .FALSE.
76+
!logical, parameter :: debug = .TRUE.
7777
!-----------------------------------------------------------
7878
IF (debug) THEN
7979
write(out_unitp,*) 'BEGINNING ',name_sub

‎SRC/QML/HNNHp_m.f90

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -82,8 +82,8 @@ FUNCTION Init_QML_HNNHp(QModel_in,read_param,nio_param_file) RESULT(QModel)
8282

8383
!----- for debuging --------------------------------------------------
8484
character (len=*), parameter :: name_sub='Init_QML_HNNHp'
85-
!logical, parameter :: debug = .FALSE.
86-
logical, parameter :: debug = .TRUE.
85+
logical, parameter :: debug = .FALSE.
86+
!logical, parameter :: debug = .TRUE.
8787
!-----------------------------------------------------------
8888
IF (debug) THEN
8989
write(out_unitp,*) 'BEGINNING ',name_sub

‎SRC/QML/HONO_m.f90

Lines changed: 6 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -77,17 +77,17 @@ MODULE QML_HONO_m
7777
FUNCTION Init_QML_HONO(QModel_in,read_param,nio_param_file) RESULT(QModel)
7878
IMPLICIT NONE
7979

80-
TYPE (QML_HONO_t) :: QModel ! RESULT
80+
TYPE (QML_HONO_t) :: QModel ! RESULT
8181

82-
TYPE(QML_Empty_t), intent(in) :: QModel_in ! variable to transfer info to the init
82+
TYPE(QML_Empty_t), intent(in) :: QModel_in ! variable to transfer info to the init
8383
integer, intent(in) :: nio_param_file
8484
logical, intent(in) :: read_param
8585

8686

8787
!----- for debuging --------------------------------------------------
8888
character (len=*), parameter :: name_sub='Init_QML_HONO'
89-
!logical, parameter :: debug = .FALSE.
90-
logical, parameter :: debug = .TRUE.
89+
logical, parameter :: debug = .FALSE.
90+
!logical, parameter :: debug = .TRUE.
9191
!-----------------------------------------------------------
9292
IF (debug) THEN
9393
write(out_unitp,*) 'BEGINNING ',name_sub
@@ -246,7 +246,7 @@ SUBROUTINE EvalPot_QML_HONO(QModel,Mat_OF_PotDia,dnQ,nderiv)
246246
SELECT CASE (QModel%option)
247247

248248
CASE (0,1,2)
249-
CALL EvalPot1_QML_HONO(Mat_OF_PotDia,dnQ,QModel,nderiv)
249+
CALL EvalPot1_QML_HONO(Mat_OF_PotDia,dnQ)
250250

251251
CASE Default
252252
write(out_unitp,*) ' ERROR in EvalPot_QML_HONO '
@@ -262,18 +262,13 @@ END SUBROUTINE EvalPot_QML_HONO
262262
!!
263263
!! @param PotVal TYPE (dnMat_t): derived type with the potential (pot), the gradient (grad) and the hessian (hess).
264264
!! @param r real: value for which the potential is calculated
265-
!! @param QModel TYPE(QML_HONO_t): derived type in which the parameters are set-up.
266-
!! @param nderiv integer: it enables to specify up to which derivatives the potential is calculated:
267-
!! the pot (nderiv=0) or pot+grad (nderiv=1) or pot+grad+hess (nderiv=2).
268265

269-
SUBROUTINE EvalPot1_QML_HONO(Mat_OF_PotDia,dnQ,QModel,nderiv)
266+
SUBROUTINE EvalPot1_QML_HONO(Mat_OF_PotDia,dnQ)
270267
USE QMLdnSVM_dnS_m
271268
IMPLICIT NONE
272269

273270
TYPE (dnS_t), intent(inout) :: Mat_OF_PotDia(:,:)
274271
TYPE (dnS_t), intent(in) :: dnQ(:)
275-
TYPE(QML_HONO_t), intent(in) :: QModel
276-
integer, intent(in) :: nderiv
277272

278273

279274
TYPE (dnS_t) :: Qw(6)

0 commit comments

Comments
 (0)