Skip to content

Commit

Permalink
Partial OOP
Browse files Browse the repository at this point in the history
  • Loading branch information
@lauvergn
lauvergn committed Jul 1, 2024
1 parent a08f4b0 commit 8c9d8cc
Show file tree
Hide file tree
Showing 10 changed files with 222 additions and 107 deletions.
Binary file modified Ext_Lib/Save_AD_dnSVM_devloc.zip
View file
Binary file not shown.
3 changes: 2 additions & 1 deletion Source_TnumTana_Coord/QtransfoOOP/ActiveTransfo_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -239,7 +239,8 @@ FUNCTION Init_ActiveTransfo_Tnum(QtBase_old,TnumPrint_level) RESULT(this)
IF(debug .OR. TnumPrint_level > 1) &
write(out_unitp,*) 'this%QMLib,flex',this%QMLib,flex

this%list_QMLMapping(:) = 0
allocate(this%list_QMLMapping(this%nb_Qout))
this%list_QMLMapping(:) = 0
IF (this%QMLib .AND. flex) THEN
read(in_unitp,*,IOSTAT=err_io) this%list_QMLMapping(:)
IF (err_io /= 0) THEN
Expand Down
71 changes: 46 additions & 25 deletions Source_TnumTana_Coord/QtransfoOOP/CartTransfo_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -55,6 +55,8 @@ MODULE CartTransfo_m
real (kind=Rkind) :: Mtot_inv = ZERO

CONTAINS
!PROCEDURE, PRIVATE, PASS(CartTransfo1) :: CartTransfo2_TO_CartTransfo1
!GENERIC, PUBLIC :: assignment(=) => CartTransfo2_TO_CartTransfo1
PROCEDURE :: Write => Write_CartTransfo_Tnum
PROCEDURE :: get_TransfoType => get_TransfoType_CartTransfo_Tnum
PROCEDURE :: dealloc => dealloc_CartTransfo_Tnum
Expand All @@ -67,6 +69,27 @@ MODULE CartTransfo_m
END INTERFACE

CONTAINS

!================================================================
! Copy two CartTransfo_t variables
!================================================================
SUBROUTINE CartTransfo2_TO_CartTransfo1(CartTransfo1,CartTransfo2)
IMPLICIT NONE
CLASS (CartTransfo_t), intent(inout) :: CartTransfo1
TYPE (CartTransfo_t), intent(in) :: CartTransfo2

CartTransfo1%ncart = CartTransfo2%ncart
CartTransfo1%ncart_act = CartTransfo2%ncart_act
CartTransfo1%nat0 = CartTransfo2%nat0
CartTransfo1%nat = CartTransfo2%nat
CartTransfo1%nat_act = CartTransfo2%nat_act
CartTransfo1%Mtot = CartTransfo2%Mtot
CartTransfo1%Mtot_inv = CartTransfo2%Mtot_inv

IF (allocated(CartTransfo2%masses)) CartTransfo1%masses = CartTransfo2%masses
IF (allocated(CartTransfo2%d0sm)) CartTransfo1%d0sm = CartTransfo2%d0sm

END SUBROUTINE CartTransfo2_TO_CartTransfo1
SUBROUTINE Write_CartTransfo_Tnum(this)
USE mod_MPI
IMPLICIT NONE
Expand Down Expand Up @@ -137,14 +160,17 @@ FUNCTION Init_CartTransfo_Tnum(Qt_old,TnumPrint_level) RESULT(this)
flush(out_unitp)
END IF

this%name_transfo = 'CartTransfo'
this%name_transfo = 'Cart'
this%inTOout = .TRUE.
this%Primitive_Coord = .FALSE.

write(out_unitp,*) '======= Qt_old ==========='
CALL Qt_old%Write()
write(out_unitp,*) '=========================='
flush(out_unitp)
IF (debug) THEN
write(out_unitp,*) '======= Qt_old ==========='
CALL Qt_old%Write()
write(out_unitp,*) '=========================='
flush(out_unitp)
END IF


SELECT TYPE (Qt_old)
TYPE IS (ZmatTransfo_t)
Expand All @@ -169,13 +195,14 @@ FUNCTION Init_CartTransfo_Tnum(Qt_old,TnumPrint_level) RESULT(this)
END SELECT

this%d0sm = sqrt(this%masses)
this%Mtot = sum(this%masses)
this%Mtot = sum(this%masses(1::3))
this%Mtot_inv = ONE/this%Mtot


this%nb_Qin = Qt_old%nb_Qout
this%type_Qin = Qt_old%type_Qout
this%name_Qin = Qt_old%name_Qout

this%nb_Qout = Qt_old%nb_Qout
this%type_Qout = Qt_old%type_Qout
this%name_Qout = Qt_old%name_Qout ! for the allocate

Expand Down Expand Up @@ -243,9 +270,9 @@ FUNCTION QinTOQout_CartTransfo_Tnum(this,Qin) RESULT(Qout)
integer :: i,n_size

!-----------------------------------------------------------------
integer :: nderiv_debug = 0
logical, parameter :: debug = .FALSE.
!logical, parameter :: debug = .TRUE.
integer :: nderiv_debug = 1
!logical, parameter :: debug = .FALSE.
logical, parameter :: debug = .TRUE.
character (len=*), parameter :: name_sub='QinTOQout_CartTransfo_Tnum'
!-----------------------------------------------------------------
IF (debug) THEN
Expand All @@ -254,35 +281,29 @@ FUNCTION QinTOQout_CartTransfo_Tnum(this,Qin) RESULT(Qout)
write(out_unitp,*) 'nderiv',get_nderiv(Qin)
write(out_unitp,*)
CALL this%Write()
write(out_unitp,*) 'Final Cartesian coordinates NOT recentered for the COM:'
write(out_unitp,*) 'Cartesian coordinates NOT recentered for the COM:'
CALL write_dnx(1,this%nb_Qin,Qin,nderiv_debug)
flush(out_unitp)
END IF
!-----------------------------------------------------------------


!dnS_Qin = Qin
n_size = get_size(Qin)
allocate(dnS_Qin(n_size))
DO i=1,n_size
CALL dnVec_TO_dnS(Qin, dnS_Qin(i), i=i)
END DO

dnS_Qin = Qin

dnG(1) = dot_product(this%masses(1::3),dnS_Qin(1::3)) * this%Mtot_inv
dnG(2) = dot_product(this%masses(2::3),dnS_Qin(2::3)) * this%Mtot_inv
dnG(3) = dot_product(this%masses(3::3),dnS_Qin(3::3)) * this%Mtot_inv

IF (debug) write(out_unitp,*) 'COM:',get_d0(dnG)

dnS_Qin(1::3) = dnS_Qin(1::3) - dnG(1)
dnS_Qin(2::3) = dnS_Qin(2::3) - dnG(2)
dnS_Qin(3::3) = dnS_Qin(3::3) - dnG(3)

!Qout = dnS_Qin
DO i=1,n_size
CALL dnS_TO_dnVec(dnS_Qin(i), Qout, i=i)
END DO
Qout = dnS_Qin

!-----------------------------------------------------------------
IF (debug) THEN
write(out_unitp,*) 'Final Cartesian coordinates recentered for the COM:'
write(out_unitp,*) 'Cartesian coordinates recentered for the COM:'
CALL write_dnx(1,this%nb_Qout,Qout,nderiv_debug)
write(out_unitp,*) 'END ',name_sub
write(out_unitp,*)
Expand Down Expand Up @@ -318,7 +339,7 @@ FUNCTION QoutTOQin_CartTransfo_Tnum(this,Qout) RESULT(Qin)
END IF
!-----------------------------------------------------------------

! we cannot find the Qin, because we don't have the Euler angles and the position of the COM
! we cannot find the true Qin, because we don't have the Euler angles and the position of the COM
Qin = Qout

!-----------------------------------------------------------------
Expand Down
131 changes: 70 additions & 61 deletions Source_TnumTana_Coord/QtransfoOOP/Qtransfo_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,13 +40,13 @@ MODULE Qtransfo_m
USE ActiveTransfo_m
IMPLICIT NONE

PRIVATE :: Read_QTransfo_Tnum
PRIVATE :: Init_QTransfo_Tnum
PRIVATE :: Write_Qtransfo_Tnum,dealloc_QTransfo_Tnum
PRIVATE :: QinTOQout_QTransfo_Tnum,QoutTOQin_QTransfo_Tnum
PRIVATE :: QactTOdnQact_QTransfo_Tnum
PRIVATE :: Read_RefGeom_QTransfo_Tnum

PUBLIC :: Qtransfo_t,Init_Qtransfo,Read_Qtransfo,QactTOdnQact,Read_RefGeom
PUBLIC :: Qtransfo_t,Init_Qtransfo,QactTOdnQact,Read_RefGeom

TYPE :: Qtransfo_t
CLASS (QtransfoBase_t), allocatable :: Qtransfo
Expand All @@ -61,10 +61,7 @@ MODULE Qtransfo_m
MODULE PROCEDURE Read_RefGeom_QTransfo_Tnum
END INTERFACE
INTERFACE Init_Qtransfo
MODULE PROCEDURE Read_QTransfo_Tnum
END INTERFACE
INTERFACE Read_Qtransfo
MODULE PROCEDURE Read_QTransfo_Tnum
MODULE PROCEDURE Init_QTransfo_Tnum
END INTERFACE
INTERFACE QactTOdnQact
MODULE PROCEDURE QactTOdnQact_QTransfo_Tnum
Expand Down Expand Up @@ -135,19 +132,21 @@ FUNCTION QactTOdnQact_QTransfo_Tnum(this,Qact,nderiv) RESULT(dnQact)

END FUNCTION QactTOdnQact_QTransfo_Tnum

SUBROUTINE Read_QTransfo_Tnum(this,nb_extra_Coord,QMLib_in,mendeleev, &
TnumPrint_level,QtBase_old)
SUBROUTINE Init_QTransfo_Tnum(this,nb_extra_Coord,QMLib_in,mendeleev, &
TnumPrint_level,Read_nml,QtBase_old)
USE mod_Constant, only: table_atom
USE QtransfoBase_m
USE ActiveTransfo_m
USE ZmatTransfo_m
USE CartTransfo_m
IMPLICIT NONE


TYPE(Qtransfo_t), intent(inout) :: this
TYPE (QtransfoBase_t), optional, intent(in) :: QtBase_old
integer, intent(in) :: nb_extra_Coord,TnumPrint_level
logical, intent(in) :: QMLib_in
TYPE (table_atom), intent(in) :: mendeleev
TYPE(Qtransfo_t), intent(inout) :: this
CLASS (QtransfoBase_t), optional, intent(in) :: QtBase_old
integer, intent(in) :: nb_extra_Coord,TnumPrint_level
logical, intent(in) :: QMLib_in,Read_nml
TYPE (table_atom), intent(in) :: mendeleev


character (len=Name_len) :: name_transfo
Expand Down Expand Up @@ -176,7 +175,7 @@ SUBROUTINE Read_QTransfo_Tnum(this,nb_extra_Coord,QMLib_in,mendeleev, &

!----- for debuging --------------------------------------------------
integer :: err_mem,memory,err_io
character (len=*), parameter :: name_sub = "Tnum_Read_Qtransfo"
character (len=*), parameter :: name_sub = "Init_QTransfo_Tnum"
logical, parameter :: debug=.FALSE.
!logical, parameter :: debug=.TRUE.
!-----------------------------------------------------------
Expand All @@ -186,53 +185,60 @@ SUBROUTINE Read_QTransfo_Tnum(this,nb_extra_Coord,QMLib_in,mendeleev, &
END IF
!-----------------------------------------------------------

name_transfo = "identity"
QMLib = QMLib_in
opt_transfo = 0
skip_transfo = .FALSE.
inTOout = .TRUE.
nat = 0
nb_vect = 0
nb_G = 0
nb_X = 0
cos_th = .TRUE.
purify_hess = .FALSE.
eq_hess = .FALSE.
k_Half = .FALSE.
with_vectors = .TRUE.
hessian_old = .TRUE.
hessian_cart = .TRUE.
hessian_onthefly = .FALSE.
file_hessian = 'xx_freq.fchk'
hessian_read = .FALSE.
k_read = .FALSE.
d0c_read = .FALSE.
nb_read = 0
nb_transfo = 1
not_all = .FALSE.
check_LinearTransfo = .TRUE.

err_io = 0
read(in_unitp,Coord_transfo,IOSTAT=err_io)
IF (err_io < 0) THEN
write(out_unitp,*) ' ERROR in ',name_sub
write(out_unitp,*) ' while reading the namelist "Coord_transfo"'
write(out_unitp,*) ' end of file or end of record'
write(out_unitp,*) ' Probably, nb_transfo is to large in the namelist "variables"'
write(out_unitp,*) ' or you have forgotten a coordinate tranformation ...'
write(out_unitp,*) ' or you have forgotten the "Cartesian transfo"'
write(out_unitp,*) ' Check your data !!'
STOP 'ERROR in Tnum_Read_Qtransfo: while reading the namelist "Coord_transfo"'
END IF
IF (err_io > 0) THEN
write(out_unitp,Coord_transfo)
write(out_unitp,*) ' ERROR in ',name_sub
write(out_unitp,*) ' while reading the namelist "Coord_transfo"'
write(out_unitp,*) ' Probably, some arguments of namelist are wrong.'
write(out_unitp,*) ' Check your data !!'
STOP 'ERROR in Tnum_Read_Qtransfo: while reading the namelist "Coord_transfo"'
IF (Read_nml) THEN
name_transfo = "identity"
QMLib = QMLib_in
opt_transfo = 0
skip_transfo = .FALSE.
inTOout = .TRUE.
nat = 0
nb_vect = 0
nb_G = 0
nb_X = 0
cos_th = .TRUE.
purify_hess = .FALSE.
eq_hess = .FALSE.
k_Half = .FALSE.
with_vectors = .TRUE.
hessian_old = .TRUE.
hessian_cart = .TRUE.
hessian_onthefly = .FALSE.
file_hessian = 'xx_freq.fchk'
hessian_read = .FALSE.
k_read = .FALSE.
d0c_read = .FALSE.
nb_read = 0
nb_transfo = 1
not_all = .FALSE.
check_LinearTransfo = .TRUE.

err_io = 0
read(in_unitp,Coord_transfo,IOSTAT=err_io)
IF (err_io < 0) THEN
write(out_unitp,*) ' ERROR in ',name_sub
write(out_unitp,*) ' while reading the namelist "Coord_transfo"'
write(out_unitp,*) ' end of file or end of record'
write(out_unitp,*) ' Probably, nb_transfo is to large in the namelist "variables"'
write(out_unitp,*) ' or you have forgotten a coordinate tranformation ...'
write(out_unitp,*) ' or you have forgotten the "Cartesian transfo"'
write(out_unitp,*) ' Check your data !!'
STOP 'ERROR in Tnum_Read_Qtransfo: while reading the namelist "Coord_transfo"'
END IF
IF (err_io > 0) THEN
write(out_unitp,Coord_transfo)
write(out_unitp,*) ' ERROR in ',name_sub
write(out_unitp,*) ' while reading the namelist "Coord_transfo"'
write(out_unitp,*) ' Probably, some arguments of namelist are wrong.'
write(out_unitp,*) ' Check your data !!'
STOP 'ERROR in Tnum_Read_Qtransfo: while reading the namelist "Coord_transfo"'
END IF
IF (debug .OR. TnumPrint_level > 1) write(out_unitp,Coord_transfo)
ELSE
name_transfo = 'Cart'
opt_transfo = 0
skip_transfo = .FALSE.
inTOout = .TRUE.
END IF
IF (debug .OR. TnumPrint_level > 1) write(out_unitp,Coord_transfo)

name_transfo = TO_lowercase(trim(adjustl(name_transfo)))

Expand Down Expand Up @@ -286,6 +292,9 @@ SUBROUTINE Read_QTransfo_Tnum(this,nb_extra_Coord,QMLib_in,mendeleev, &
allocate(ZmatTransfo_t :: this%Qtransfo)
this%Qtransfo = Init_ZmatTransfo(nat,cos_th,nb_extra_Coord,mendeleev,TnumPrint_level)

CASE ('cart') ! it is a special transformation
allocate(CartTransfo_t :: this%Qtransfo)
this%Qtransfo = Init_CartTransfo(QtBase_old,TnumPrint_level)
CASE DEFAULT ! ERROR: wrong transformation !
write(out_unitp,*) ' ERROR in ',name_sub
write(out_unitp,*) ' The transformation is UNKNOWN: ',trim(name_transfo)
Expand All @@ -305,7 +314,7 @@ SUBROUTINE Read_QTransfo_Tnum(this,nb_extra_Coord,QMLib_in,mendeleev, &
write(out_unitp,*) 'END ',name_sub
END IF
!-----------------------------------------------------------
END SUBROUTINE Read_QTransfo_Tnum
END SUBROUTINE Init_QTransfo_Tnum
SUBROUTINE dealloc_QTransfo_Tnum(this)
IMPLICIT NONE

Expand Down
4 changes: 2 additions & 2 deletions Source_TnumTana_Coord/QtransfoOOP/ZmatTransfo_m.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -991,7 +991,7 @@ FUNCTION QinTOQout_ZmatTransfo_Tnum(this,Qin) RESULT(Qout)
i_q = i_q + 1
CALL dnVec_TO_dnS(Qin,dnQdih,i_q)

dnAt(iAtf) = [dnd*dnSval*cos(dnQdih), dnd*dnSval*sin(dnQdih), dnd*dnCval]
dnAt(iAtf) = dnAt(i1) + [dnd*dnSval*cos(dnQdih), dnd*dnSval*sin(dnQdih), dnd*dnCval]

ELSE ! true zmat

Expand Down Expand Up @@ -1073,7 +1073,7 @@ FUNCTION QinTOQout_ZmatTransfo_Tnum(this,Qin) RESULT(Qout)
deallocate(dnat)
!-----------------------------------------------------------------
IF (debug) THEN
write(out_unitp,*) 'Final Cartesian coordinates:'
write(out_unitp,*) 'Zmatrix Cartesian coordinates:'
CALL write_dnx(1,this%nb_Qout,Qout,nderiv_debug)
write(out_unitp,*) 'END ',name_sub
write(out_unitp,*)
Expand Down
Loading

0 comments on commit 8c9d8cc

Please sign in to comment.