Skip to content

Commit

Permalink
Improve the test files+fix a bug in the IRC
Browse files Browse the repository at this point in the history
  • Loading branch information
lauvergn authored and lauvergn committed Dec 23, 2021
1 parent c17eb4e commit 90ead3e
Show file tree
Hide file tree
Showing 27 changed files with 183 additions and 146 deletions.
13 changes: 3 additions & 10 deletions SRC/Model_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -456,11 +456,6 @@ SUBROUTINE Init_Model(QModel,pot_name,ndim,nsurf,adiabatic,Cart_TO_Q, &
write(out_unitp,*) 'You have decided to perform a numeric checking of the analytic formulas.'
END IF

!read_param_loc = (read_param_loc .AND. read_nml) ! this enables to not read the next namelist when read_param_loc=t

!CALL QModel_in%Write_QModel(nio=out_unitp)


CALL string_uppercase_TO_lowercase(pot_name_loc)
IF (Print_init_loc) write(out_unitp,*) 'pot_name_loc: ',pot_name_loc

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

CALL QModel%QM%Write_QModel(nio=out_unitp)

IF (present(ndim)) THEN
IF (ndim > QModel%QM%ndim) THEN
write(out_unitp,*) ' ERROR in Init_Model'
Expand Down Expand Up @@ -2571,7 +2564,7 @@ SUBROUTINE Check_analytical_numerical_derivatives(QModel,Q,nderiv)
ndim=QModel%QM%ndim,nderiv=nderiv)


IF (QModel%QM%adiabatic) THEN
IF (QModel%QM%adiabatic .AND. QModel%QM%nsurf > 1) THEN
CALL Eval_Pot(QModel,Q,PotVal_ana,nderiv,NAC_ana,Vec_ana,numeric=.FALSE.)
ELSE
CALL Eval_Pot(QModel,Q,PotVal_ana,nderiv,numeric=.FALSE.)
Expand All @@ -2583,7 +2576,7 @@ SUBROUTINE Check_analytical_numerical_derivatives(QModel,Q,nderiv)
flush(out_unitp)
END IF

IF (QModel%QM%adiabatic) THEN
IF (QModel%QM%adiabatic .AND. QModel%QM%nsurf > 1) THEN
CALL Eval_Pot(QModel,Q,PotVal_num,nderiv,NAC_num,Vec_num,numeric=.TRUE.)
ELSE
CALL Eval_Pot(QModel,Q,PotVal_num,nderiv,numeric=.TRUE.)
Expand All @@ -2610,7 +2603,7 @@ SUBROUTINE Check_analytical_numerical_derivatives(QModel,Q,nderiv)
CALL QML_Write_dnMat(Mat_diff,nio=out_unitp)
END IF

IF (QModel%QM%adiabatic) THEN
IF (QModel%QM%adiabatic .AND. QModel%QM%nsurf > 1) THEN

MaxMat = QML_get_maxval_OF_dnMat(NAC_ana)
IF (MaxMat < ONETENTH**6) MaxMat = ONE
Expand Down
5 changes: 3 additions & 2 deletions SRC/Opt/IRC_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -328,8 +328,9 @@ SUBROUTINE QML_IRC(Q,QModel,IRC_p,Q0)

END SUBROUTINE QML_IRC

SUBROUTINE QML_IRC_ODE(s,QactOld,QactNew,Ene_AT_s,QModel,IRC_p,forward, &
grad_AT_s,Method,order)
RECURSIVE SUBROUTINE QML_IRC_ODE(s,QactOld,QactNew,Ene_AT_s, &
QModel,IRC_p,forward, &
grad_AT_s,Method,order)
USE QMLLib_UtilLib_m
USE Model_m
IMPLICIT NONE
Expand Down
19 changes: 17 additions & 2 deletions SRC/Opt/Opt_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -287,8 +287,8 @@ SUBROUTINE QML_Opt(Q,QModel,Opt_param,Q0)

!----- for debuging --------------------------------------------------
character (len=*), parameter :: name_sub='QML_Opt'
!logical, parameter :: debug = .FALSE.
logical, parameter :: debug = .TRUE.
logical, parameter :: debug = .FALSE.
!logical, parameter :: debug = .TRUE.
!-----------------------------------------------------------

IF (debug) THEN
Expand All @@ -297,6 +297,14 @@ SUBROUTINE QML_Opt(Q,QModel,Opt_param,Q0)
CALL Write_QML_Opt(Opt_param)
CALL Write_Model(QModel)
flush(out_unitp)
ELSE
write(out_unitp,*) '=================================================='
write(out_unitp,*) '=================================================='
write(out_unitp,*) '=== Optimization on the "',QModel%QM%pot_name,'" model.'
write(out_unitp,*) '=== model option:',QModel%QM%option
write(out_unitp,*) '=================================================='
write(out_unitp,*) '=================================================='
flush(out_unitp)
END IF

IF (Opt_param%Max_it < 0) THEN
Expand Down Expand Up @@ -424,6 +432,13 @@ SUBROUTINE QML_Opt(Q,QModel,Opt_param,Q0)
write(out_unitp,*) ' Q',Q
write(out_unitp,*) ' END ',name_sub
flush(out_unitp)
ELSE
write(out_unitp,*) '=================================================='
write(out_unitp,*) '=================================================='
write(out_unitp,*) '=== End of the optimization'
write(out_unitp,*) '=================================================='
write(out_unitp,*) '=================================================='
flush(out_unitp)
END IF

END SUBROUTINE QML_Opt
Expand Down
8 changes: 5 additions & 3 deletions SRC/QML/Buck_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -150,9 +150,11 @@ SUBROUTINE Init0_QML_Buck(QModel,A,B,C,model_name)
flush(out_unitp)
END IF

QModel%ndim = 1
QModel%nsurf = 1
QModel%pot_name = 'Buck'
QModel%In_a_Model = .TRUE.

QModel%ndim = 1
QModel%nsurf = 1
QModel%pot_name = 'Buck'
IF (present(model_name)) QModel%pot_name = model_name

IF (debug) write(out_unitp,*) 'init Buck parameters (A,B,C), if present'
Expand Down
30 changes: 17 additions & 13 deletions SRC/QML/CH5_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -110,8 +110,8 @@ FUNCTION Init_QML_CH5(QModel_in,read_param,nio_param_file) RESULT(QModel)

!----- for debuging --------------------------------------------------
character (len=*), parameter :: name_sub='Init_QML_CH5'
!logical, parameter :: debug = .FALSE.
logical, parameter :: debug = .TRUE.
logical, parameter :: debug = .FALSE.
!logical, parameter :: debug = .TRUE.
!-----------------------------------------------------------
IF (debug) THEN
write(out_unitp,*) 'BEGINNING ',name_sub
Expand Down Expand Up @@ -164,8 +164,9 @@ FUNCTION Init_QML_CH5(QModel_in,read_param,nio_param_file) RESULT(QModel)
END SELECT

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

!write(out_unitp,*) ii,'FileName: ',FileName ; flush(out_unitp)
CALL QML_read_para4d(QModel%a(ii,jj),QModel%b(ii,jj),QModel%F(:,ii,jj),QModel%nn(:,ii,jj), &
ndim,QModel%nt(ii,jj),max_nn,FileName,QModel%file_exist(ii,jj))
CALL QML_read_para4d(QModel%a(ii,jj),QModel%b(ii,jj),QModel%F(:,ii,jj), &
QModel%nn(:,ii,jj),ndim,QModel%nt(ii,jj),max_nn, &
FileName,QModel%file_exist(ii,jj),print_info=debug)
!write(out_unitp,*) ii,'Read done' ; flush(out_unitp)

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

CALL QML_read_para4d(QModel%a(ii,jj),QModel%b(ii,jj),QModel%F(:,ii,jj),QModel%nn(:,ii,jj), &
ndim,QModel%nt(ii,jj),max_nn,FileName,QModel%file_exist(ii,jj))
CALL QML_read_para4d(QModel%a(ii,jj),QModel%b(ii,jj),QModel%F(:,ii,jj), &
QModel%nn(:,ii,jj),ndim,QModel%nt(ii,jj),max_nn, &
FileName,QModel%file_exist(ii,jj),print_info=debug)

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

Expand Down Expand Up @@ -619,18 +622,19 @@ FUNCTION QML_sc_fit3(x,a,b)

END FUNCTION QML_sc_fit3

SUBROUTINE QML_read_para4d(a,b,F,n,ndim,nt,max_points,nom1,exist)
SUBROUTINE QML_read_para4d(a,b,F,n,ndim,nt,max_points,nom1,exist,print_info)
IMPLICIT NONE

integer, intent(in) :: max_points,ndim
integer, intent(inout) :: n(0:ndim),nt
real (kind=Rkind), intent(inout) :: a,b,F(max_points)
character (len=*), intent(in) :: nom1
logical, intent(inout) :: exist
logical, intent(in) :: print_info

integer :: no,ios,kl,i

write(out_unitp,*) 'QML_read_para4d: nom1,max_points: ',nom1,max_points
IF (print_info) write(out_unitp,*) 'QML_read_para4d: nom1,max_points: ',nom1,max_points


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

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

write(out_unitp,*) 'nom1,nt,ndim: ',nom1,nt,ndim
IF (print_info) write(out_unitp,*) 'nom1,nt,ndim: ',nom1,nt,ndim
read(no,*) n(0:ndim)
write(out_unitp,*) 'nom1,n ',nom1,n(0:ndim)
IF (print_info) write(out_unitp,*) 'nom1,n ',nom1,n(0:ndim)
IF (n(0) > max_points) THEN
write(out_unitp,*) ' ERROR : The number of coefficients (',n(0),') >'
write(out_unitp,*) ' than max_points (',max_points,')'
Expand All @@ -658,7 +662,7 @@ SUBROUTINE QML_read_para4d(a,b,F,n,ndim,nt,max_points,nom1,exist)
CLOSE(no)
exist = .TRUE.
ELSE
write(out_unitp,*) 'The file (',nom1,') does not exist !!'
IF (print_info) write(out_unitp,*) 'The file (',nom1,') does not exist !!'
exist = .FALSE.
END IF

Expand Down
8 changes: 7 additions & 1 deletion SRC/QML/Empty_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -60,6 +60,8 @@ MODULE QML_Empty_m
logical :: adiabatic = .TRUE.
integer :: option = 0
logical :: PubliUnit = .FALSE. ! when PubliUnit=.TRUE., the units of a reference (publi ...) are used. Default (atomic unit)
logical :: In_a_Model = .FALSE.


logical :: Vib_adia = .FALSE.
integer :: nb_Channels = 0
Expand Down Expand Up @@ -308,17 +310,21 @@ SUBROUTINE Write_QML_Empty(QModel,nio)
IMPLICIT NONE

CLASS (QML_Empty_t), intent(in) :: QModel
integer, intent(in) :: nio
integer, intent(in) :: nio

IF (QModel%In_a_Model) RETURN

write(nio,*) 'Init: ',QModel%Init
write(nio,*) 'In_a_Model: ',QModel%In_a_Model

write(nio,*) 'nsurf: ',QModel%nsurf
write(nio,*) 'ndim: ',QModel%ndim
write(nio,*) 'numeric: ',QModel%numeric
write(nio,*) 'adiabatic: ',QModel%adiabatic
write(nio,*) 'Vib_adia: ',QModel%Vib_adia
write(nio,*) 'Phase_Following: ',QModel%Phase_Following
write(nio,*) 'Phase_Checking: ',QModel%Phase_Checking

IF (QModel%Vib_adia) THEN
write(nio,*) 'nb_Channels: ',QModel%nb_Channels
IF (allocated(QModel%list_act)) &
Expand Down
6 changes: 3 additions & 3 deletions SRC/QML/H2NSi_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -58,7 +58,7 @@ MODULE QML_H2NSi_m
integer, allocatable :: tab_func(:,:)

CONTAINS
PROCEDURE :: EvalPot_QModel => EvalPot_QML_H2NSi
PROCEDURE :: EvalPot_QModel => EvalPot_QML_H2NSi
PROCEDURE :: Write_QModel => Write_QML_H2NSi
PROCEDURE :: Write0_QModel => Write_QML_H2NSi
END TYPE QML_H2NSi_t
Expand Down Expand Up @@ -87,8 +87,8 @@ FUNCTION Init_QML_H2NSi(QModel_in,read_param,nio_param_file) RESULT(QModel)

!----- for debuging --------------------------------------------------
character (len=*), parameter :: name_sub='Init_QML_H2NSi'
!logical, parameter :: debug = .FALSE.
logical, parameter :: debug = .TRUE.
logical, parameter :: debug = .FALSE.
!logical, parameter :: debug = .TRUE.
!-----------------------------------------------------------
IF (debug) THEN
write(out_unitp,*) 'BEGINNING ',name_sub
Expand Down
4 changes: 2 additions & 2 deletions SRC/QML/H2SiN_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -72,8 +72,8 @@ FUNCTION Init_QML_H2SiN(QModel_in,read_param,nio_param_file) RESULT(QModel)

!----- for debuging --------------------------------------------------
character (len=*), parameter :: name_sub='Init_QML_H2SiN'
!logical, parameter :: debug = .FALSE.
logical, parameter :: debug = .TRUE.
logical, parameter :: debug = .FALSE.
!logical, parameter :: debug = .TRUE.
!-----------------------------------------------------------
IF (debug) THEN
write(out_unitp,*) 'BEGINNING ',name_sub
Expand Down
4 changes: 2 additions & 2 deletions SRC/QML/HNNHp_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -82,8 +82,8 @@ FUNCTION Init_QML_HNNHp(QModel_in,read_param,nio_param_file) RESULT(QModel)

!----- for debuging --------------------------------------------------
character (len=*), parameter :: name_sub='Init_QML_HNNHp'
!logical, parameter :: debug = .FALSE.
logical, parameter :: debug = .TRUE.
logical, parameter :: debug = .FALSE.
!logical, parameter :: debug = .TRUE.
!-----------------------------------------------------------
IF (debug) THEN
write(out_unitp,*) 'BEGINNING ',name_sub
Expand Down
17 changes: 6 additions & 11 deletions SRC/QML/HONO_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -77,17 +77,17 @@ MODULE QML_HONO_m
FUNCTION Init_QML_HONO(QModel_in,read_param,nio_param_file) RESULT(QModel)
IMPLICIT NONE

TYPE (QML_HONO_t) :: QModel ! RESULT
TYPE (QML_HONO_t) :: QModel ! RESULT

TYPE(QML_Empty_t), intent(in) :: QModel_in ! variable to transfer info to the init
TYPE(QML_Empty_t), intent(in) :: QModel_in ! variable to transfer info to the init
integer, intent(in) :: nio_param_file
logical, intent(in) :: read_param


!----- for debuging --------------------------------------------------
character (len=*), parameter :: name_sub='Init_QML_HONO'
!logical, parameter :: debug = .FALSE.
logical, parameter :: debug = .TRUE.
logical, parameter :: debug = .FALSE.
!logical, parameter :: debug = .TRUE.
!-----------------------------------------------------------
IF (debug) THEN
write(out_unitp,*) 'BEGINNING ',name_sub
Expand Down Expand Up @@ -246,7 +246,7 @@ SUBROUTINE EvalPot_QML_HONO(QModel,Mat_OF_PotDia,dnQ,nderiv)
SELECT CASE (QModel%option)

CASE (0,1,2)
CALL EvalPot1_QML_HONO(Mat_OF_PotDia,dnQ,QModel,nderiv)
CALL EvalPot1_QML_HONO(Mat_OF_PotDia,dnQ)

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

SUBROUTINE EvalPot1_QML_HONO(Mat_OF_PotDia,dnQ,QModel,nderiv)
SUBROUTINE EvalPot1_QML_HONO(Mat_OF_PotDia,dnQ)
USE QMLdnSVM_dnS_m
IMPLICIT NONE

TYPE (dnS_t), intent(inout) :: Mat_OF_PotDia(:,:)
TYPE (dnS_t), intent(in) :: dnQ(:)
TYPE(QML_HONO_t), intent(in) :: QModel
integer, intent(in) :: nderiv


TYPE (dnS_t) :: Qw(6)
Expand Down
4 changes: 2 additions & 2 deletions SRC/QML/HOO_DMBE_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -173,8 +173,8 @@ FUNCTION Init_QML_HOO_DMBE(QModel_in,read_param,nio_param_file) RESULT(QModel)

!----- for debuging --------------------------------------------------
character (len=*), parameter :: name_sub='Init_QML_HOO_DMBE'
!logical, parameter :: debug = .FALSE.
logical, parameter :: debug = .TRUE.
logical, parameter :: debug = .FALSE.
!logical, parameter :: debug = .TRUE.
!-----------------------------------------------------------
IF (debug) THEN
write(out_unitp,*) 'BEGINNING ',name_sub
Expand Down
4 changes: 2 additions & 2 deletions SRC/QML/LinearHBond_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -105,8 +105,8 @@ FUNCTION Init_QML_LinearHBond(QModel_in,read_param,nio_param_file, &
real (kind=Rkind), parameter :: auTOkcalmol_inv = 627.51_Rkind
!----- for debuging --------------------------------------------------
character (len=*), parameter :: name_sub='Init_QML_LinearHBond'
!logical, parameter :: debug = .FALSE.
logical, parameter :: debug = .TRUE.
logical, parameter :: debug = .FALSE.
!logical, parameter :: debug = .TRUE.
!-----------------------------------------------------------
IF (debug) THEN
write(out_unitp,*) 'BEGINNING ',name_sub
Expand Down
10 changes: 6 additions & 4 deletions SRC/QML/Morse_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -159,9 +159,11 @@ SUBROUTINE Init0_QML_Morse(QModel,D,a,req,model_name)
flush(out_unitp)
END IF

QModel%ndim = 1
QModel%nsurf = 1
QModel%pot_name = 'morse'
QModel%In_a_Model = .TRUE.
QModel%ndim = 1
QModel%nsurf = 1
QModel%pot_name = 'morse'

IF (present(model_name)) QModel%pot_name = model_name

IF (debug) write(out_unitp,*) 'init morse parameters (D,a,req), if present'
Expand Down Expand Up @@ -266,7 +268,7 @@ SUBROUTINE Write_QML_Morse(QModel,nio)
IMPLICIT NONE

CLASS(QML_Morse_t), intent(in) :: QModel
integer, intent(in) :: nio
integer, intent(in) :: nio


write(nio,*) 'Morse current parameters:'
Expand Down
Loading

0 comments on commit 90ead3e

Please sign in to comment.