      MODULE mod_Tnum
      USE mod_system
      USE mod_dnSVM
      IMPLICIT NONE
        TYPE Type_BFTransfo
          !----------------------------------------------------------------
          logical                     :: init0,notinit0
          logical                     :: allo ! If allocated => T

          integer :: nb_vect,nb_BF
          integer :: nb_var,nb_var_Rot
          integer :: num_Frame
          character (len=Name_len) :: name_Frame

          logical :: Frame

          integer, pointer                  :: type_Q(:)
          character (len=Name_len), pointer :: name_Q(:)


          TYPE (Type_BFTransfo), pointer :: tab_BFTransfo(:) ! dim: nb_vect or nb_BF

        END TYPE Type_BFTransfo
      CONTAINS
c=======================================================================
c
c     Read BF transfo: BF and vectors
c
c=======================================================================
      SUBROUTINE init0_BFTransfo(BFTransfo)
        TYPE (Type_BFTransfo),intent(out) :: BFTransfo

        BFTransfo%init0     = .TRUE.
        BFTransfo%notinit0  = .FALSE.

        BFTransfo%allo      = .FALSE.

        BFTransfo%nb_vect    = 0
        BFTransfo%nb_BF      = 0
        BFTransfo%nb_var     = 0
        BFTransfo%nb_var_Rot = 0
        BFTransfo%num_Frame  = 0
        BFTransfo%name_Frame = "F0"

        BFTransfo%Frame      = .FALSE.

        nullify(BFTransfo%type_Q)
        nullify(BFTransfo%name_Q)
        nullify(BFTransfo%tab_BFTransfo)

      END SUBROUTINE init0_BFTransfo
      SUBROUTINE check_init0_BFTransfo(A,name_A,name_sub)
      TYPE (Type_BFTransfo), intent(in) :: A
      character (len=*), intent(in) :: name_A
      character (len=*), intent(in) :: name_sub

      IF ( (A%init0 .EQV. A%notinit0) .OR.
     *       (A%notinit0 .AND. .NOT. A%init0) ) THEN
        write(6,*) ' ERROR in ',name_sub
        write(6,*) name_A,
     *  ' has NOT been initiated with "init0_BFTransfo"'
        write(6,*) ' CHECK the source!!!!!'
        write(6,*) '.%init0, %notinit0',A%init0,A%notinit0
        STOP
      END IF
      END SUBROUTINE check_init0_BFTransfo
      RECURSIVE SUBROUTINE dealloc_BFTransfo(BFTransfo)
      TYPE (Type_BFTransfo),intent(inout) :: BFTransfo

      integer :: iv
      character (len=*), parameter :: name_sub='dealloc_BFTransfo'

      IF (.NOT. BFTransfo%Frame) RETURN
      write(6,*) 'BEGINNING ',name_sub

      CALL check_init0_BFTransfo(BFTransfo,'BFTransfo',name_sub)

      deallocate(BFTransfo%type_Q)
      deallocate(BFTransfo%name_Q)

      DO iv=1,BFTransfo%nb_vect
        CALL dealloc_BFTransfo(BFTransfo%tab_BFTransfo(iv))
      END DO

      deallocate(BFTransfo%tab_BFTransfo)

      BFTransfo%allo = .FALSE.
      CALL init0_BFTransfo(BFTransfo)

      write(6,*) 'END ',name_sub

      END SUBROUTINE dealloc_BFTransfo
!      SUBROUTINE Read_BFTransfo(BFTransfo,Qtransfo,i_Q,
!     *                          in_unitp,out_unitp)
      RECURSIVE SUBROUTINE Read_BFTransfo(BFTransfo,Qtransfo,i_Q,
     *                                    in_unitp,out_unitp)
      TYPE (Type_BFTransfo),intent(inout) :: BFTransfo
      TYPE (Type_Qtransfo), intent(inout) :: Qtransfo
      integer, intent(inout) :: i_Q
      integer :: in_unitp,out_unitp


      integer :: nb_vect,nb_var,iq,iv
      logical :: Frame,cos_th,cart
      character (len=Name_len) :: name_d,name_th,name_dih,
     *                            name_x,name_y,name_z
      character (len=Name_len) :: name_F,name_v

      NAMELIST /BF/ nb_vect
      NAMELIST /vector/ Frame,cos_th,name_d,name_th,name_dih,
     *                          cart,name_x,name_y,name_z

      character (len=*), parameter :: name_sub='Read_BFTransfo'


      IF (.NOT. BFTransfo%Frame) RETURN
c     write(6,*) 'BEGINNING ',name_sub

      CALL check_init0_BFTransfo(BFTransfo,'BFTransfo',name_sub)

      nb_vect = 0

      read(in_unitp,BF)
c     write(out_unitp,BF)

      IF (nb_vect < 1) THEN
        write(out_unitp,*) ' ERROR in ',name_sub
        write(out_unitp,*) ' the number of vector is < 1',nb_vect
        STOP
      END IF
      BFTransfo%nb_vect = nb_vect
      nb_var = max(1,3*nb_vect-3)
      IF (BFTransfo%num_Frame > 0) THEN
        nb_var = nb_var + 2
        IF (nb_vect > 1) nb_var = nb_var + 1
      END IF
      BFTransfo%nb_var = nb_var

      allocate(BFTransfo%type_Q(nb_var))
      allocate(BFTransfo%name_Q(nb_var))

      allocate(BFTransfo%tab_BFTransfo(nb_vect))
      BFTransfo%allo = .TRUE.

      write(name_F,*) BFTransfo%num_Frame
      name_F = "F" // trim(adjustl(name_F))
      IF (BFTransfo%num_Frame > 0) name_F =
     *     trim(adjustl(name_F)) // trim(adjustl(BFTransfo%name_Frame))

      BFTransfo%name_Frame = name_F

c     write(6,*) 'num_Frame,name_Frame',
c    *         BFTransfo%num_Frame,BFTransfo%name_Frame

      iq = 0
      DO iv=1,nb_vect
        Frame    = .FALSE.
        cos_th   = .TRUE.
        cart     = .FALSE.
        write(name_v,*) iv
        name_v = trim(adjustl(name_v)) // "_" // trim(adjustl(name_F))
        name_x   = "x" // trim(adjustl(name_v))
        name_y   = "y" // trim(adjustl(name_v))
        name_z   = "z" // trim(adjustl(name_v))
        name_d   = "d" // trim(adjustl(name_v))
        name_th  ="th" // trim(adjustl(name_v))
        name_dih="dih" // trim(adjustl(name_v))
        read(in_unitp,vector)
c       write(out_unitp,vector)

        CALL init0_BFTransfo(BFTransfo%tab_BFTransfo(iv))
        BFTransfo%tab_BFTransfo(iv)%num_Frame = iv
        BFTransfo%tab_BFTransfo(iv)%Frame = Frame
        BFTransfo%tab_BFTransfo(iv)%name_Frame = name_F
        IF (cart .AND. iv < 3) THEN
          write(out_unitp,*) ' ERROR in ',name_sub
          write(out_unitp,*) ' vector in cartesian and iv < 3',
     *       ' is not possible'
          write(out_unitp,*) 'cart,iv',cart,iv
          STOP
        END IF
        IF (cart) THEN
           iq = iq + 1
           BFTransfo%type_Q(iq) = 1 ! cart :x
           BFTransfo%name_Q(iq) = name_x
           i_Q = i_Q + 1
           Qtransfo%type_Q(i_Q) = BFTransfo%type_Q(iq)
           Qtransfo%name_Q(i_Q) = BFTransfo%name_Q(iq)
           iq = iq + 1
           BFTransfo%type_Q(iq) = 1 ! cart :y
           BFTransfo%name_Q(iq) = name_y
           i_Q = i_Q + 1
           Qtransfo%type_Q(i_Q) = BFTransfo%type_Q(iq)
           Qtransfo%name_Q(i_Q) = BFTransfo%name_Q(iq)
           iq = iq + 1
           BFTransfo%type_Q(iq) = 1 ! cart :z
           BFTransfo%name_Q(iq) = name_z
           i_Q = i_Q + 1
           Qtransfo%type_Q(i_Q) = BFTransfo%type_Q(iq)
           Qtransfo%name_Q(i_Q) = BFTransfo%name_Q(iq)
        ELSE
           iq = iq + 1
           BFTransfo%type_Q(iq) = 2 ! distance
           BFTransfo%name_Q(iq) = name_d
           i_Q = i_Q + 1
           Qtransfo%type_Q(i_Q) = BFTransfo%type_Q(iq)
           Qtransfo%name_Q(i_Q) = BFTransfo%name_Q(iq)
           IF (iv > 1) THEN
             iq = iq + 1
             BFTransfo%type_Q(iq) = 3 ! th
             IF (cos_th) BFTransfo%type_Q(iq) = -3 ! cos(th)
             BFTransfo%name_Q(iq) = name_th
             i_Q = i_Q + 1
             Qtransfo%type_Q(i_Q) = BFTransfo%type_Q(iq)
             Qtransfo%name_Q(i_Q) = BFTransfo%name_Q(iq)
           END IF
           IF (iv > 2) THEN
             iq = iq + 1
             BFTransfo%type_Q(iq) = 4 ! dih
             BFTransfo%name_Q(iq) = name_dih
             i_Q = i_Q + 1
             Qtransfo%type_Q(i_Q) = BFTransfo%type_Q(iq)
             Qtransfo%name_Q(i_Q) = BFTransfo%name_Q(iq)
           END IF
        END IF


        CALL Read_BFTransfo(BFTransfo%tab_BFTransfo(iv),Qtransfo,i_Q,
     *                      in_unitp,out_unitp)
      END DO

      IF (BFTransfo%num_Frame > 0) THEN
        iq = iq + 1
        BFTransfo%type_Q(iq) = 4
        BFTransfo%name_Q(iq) = "alpha_" // trim(adjustl(name_F))
        i_Q = i_Q + 1
        Qtransfo%type_Q(i_Q) = BFTransfo%type_Q(iq)
        Qtransfo%name_Q(i_Q) = BFTransfo%name_Q(iq)
        iq = iq + 1
        BFTransfo%type_Q(iq) = 3
        IF (cos_th) BFTransfo%type_Q(iq) = -3
        BFTransfo%name_Q(iq) = "beta_" // trim(adjustl(name_F))
        i_Q = i_Q + 1
        Qtransfo%type_Q(i_Q) = BFTransfo%type_Q(iq)
        Qtransfo%name_Q(i_Q) = BFTransfo%name_Q(iq)
        IF (nb_vect > 1) THEN
          iq = iq + 1
          BFTransfo%type_Q(iq) = 4
          BFTransfo%name_Q(iq) = "gamma_" // trim(adjustl(name_F))
          i_Q = i_Q + 1
          Qtransfo%type_Q(i_Q) = BFTransfo%type_Q(iq)
          Qtransfo%name_Q(i_Q) = BFTransfo%name_Q(iq)
        END IF
      END IF


c     write(out_unitp,*) 'END ',name_sub

      END SUBROUTINE Read_BFTransfo
      !SUBROUTINE Write_BFTransfo(BFTransfo,out_unitp)
      RECURSIVE SUBROUTINE Write_BFTransfo(BFTransfo,out_unitp)

      TYPE (Type_BFTransfo),intent(out) :: BFTransfo

      integer :: out_unitp

      integer :: iv,iq
      character (len=*), parameter :: name_sub='Write_BFTransfo'

      IF (.NOT. BFTransfo%Frame) RETURN
      write(out_unitp,*) 'BEGINNING ',name_sub

      CALL check_init0_BFTransfo(BFTransfo,'BFTransfo',name_sub)

      write(out_unitp,*) 'allo',BFTransfo%allo
      write(out_unitp,*) 'num_Frame',BFTransfo%num_Frame
      write(out_unitp,*) 'name_Frame: ',BFTransfo%name_Frame

      write(out_unitp,*) 'nb_vect,nb_BF',
     *                   BFTransfo%nb_vect,BFTransfo%nb_BF

      write(out_unitp,*) 'nb_var,nb_var_Rot',
     *                   BFTransfo%nb_var,BFTransfo%nb_var_Rot

      write(out_unitp,*) 'BF',BFTransfo%Frame


      write(out_unitp,*) 'type_Q',BFTransfo%type_Q(:)
      write(out_unitp,*) 'name_Q: ',
     *        (trim(BFTransfo%name_Q(iq))," ",iq=1,BFTransfo%nb_var)

      IF (BFTransfo%Frame) THEN
        DO iv=1,BFTransfo%nb_vect
          CALL Write_BFTransfo(BFTransfo%tab_BFTransfo(iv),out_unitp)
        END DO
      END IF

      write(6,*) 'END ',name_sub

      END SUBROUTINE Write_BFTransfo
      END MODULE mod_Tnum