bug fix with get_name_Qtransfo and openmp

Source_TnumTana_Coord/Qtransfo/FlexibleTransfo.f90

@@ -431,8 +431,8 @@ SUBROUTINE calc_FlexibleTransfo_new(dnQin,dnQout,FlexibleTransfo,nderiv,inTOout)
 
     !----- for debuging ----------------------------------
     character (len=*),parameter :: name_sub='calc_FlexibleTransfo_new'
-    !logical, parameter :: debug=.FALSE.
-    logical, parameter :: debug=.TRUE.
+    logical, parameter :: debug=.FALSE.
+    !logical, parameter :: debug=.TRUE.
     !----- for debuging ----------------------------------
 
     nb_flex_act = FlexibleTransfo%nb_flex_act

Source_TnumTana_Coord/Qtransfo/Qtransfo.f90

@@ -227,12 +227,12 @@ SUBROUTINE read_Qtransfo(Qtransfo,nb_Qin,nb_extra_Coord,                  &
 
         IF (debug) write(out_unitp,Coord_transfo)
 
-        Qtransfo%name_transfo = trim(adjustl(name_transfo))
+        Qtransfo%name_transfo = TO_lowercase(trim(adjustl(name_transfo)))
         Qtransfo%inTOout      = inTOout
         Qtransfo%opt_transfo  = opt_transfo
         Qtransfo%skip_transfo = skip_transfo
         IF(MPI_id==0) THEN
-          write(out_unitp,'(a,a)' )  ' transfo:               ',get_name_Qtransfo(Qtransfo)
+          write(out_unitp,'(a,a)' )  ' transfo:               ',Qtransfo%name_transfo
           write(out_unitp,'(a,i0)')  ' Option of the transfo: ',Qtransfo%opt_transfo
           write(out_unitp,'(a,l1)' ) ' Skip the transfo:      ',Qtransfo%skip_transfo
           write(out_unitp,'(a,i0)')  ' num_transfo:           ',Qtransfo%num_transfo
@@ -241,9 +241,7 @@ SUBROUTINE read_Qtransfo(Qtransfo,nb_Qin,nb_extra_Coord,                  &
         ENDIF
         flush(out_unitp)
 
-        name_transfo = get_name_Qtransfo(Qtransfo,lower=.TRUE.)
-
-        SELECT CASE (name_transfo)
+        SELECT CASE (Qtransfo%name_transfo)
         CASE ('identity')
           Tana_Is_Possible = Tana_Is_Possible .AND. .TRUE.
           Qtransfo%nb_Qin  = nb_Qin
@@ -784,13 +782,17 @@ END SUBROUTINE Write_list_Qtransfo
       SUBROUTINE dealloc_Qtransfo(Qtransfo)
         TYPE (Type_Qtransfo), intent(inout) :: Qtransfo
 
+        character (len=:), allocatable :: name_transfo
+
         character (len=*),parameter :: name_sub='dealloc_Qtransfo'
         !logical, parameter :: debug = .TRUE.
         logical, parameter :: debug = .FALSE.
 
-
         IF (debug) THEN
-          write(out_unitp,*) 'BEGINNING : ',name_sub,' : ',get_name_Qtransfo(Qtransfo)
+          name_transfo = 'not_allocated'
+          IF (allocated(Qtransfo%name_transfo)) name_transfo = Qtransfo%name_transfo
+
+          write(out_unitp,*) 'BEGINNING : ',name_sub,' : ',name_transfo
           flush(out_unitp)
         END IF
 
@@ -890,8 +892,9 @@ SUBROUTINE dealloc_Qtransfo(Qtransfo)
         nullify(Qtransfo%name_Qout)  ! because it is a true pointer
 
         IF (debug) THEN
-          write(out_unitp,*) 'END : ',name_sub,' : ',get_name_Qtransfo(Qtransfo)
+          write(out_unitp,*) 'END : ',name_sub,' : ',name_transfo
           flush(out_unitp)
+          deallocate(name_transfo)
         END IF
   END SUBROUTINE dealloc_Qtransfo
 
@@ -959,24 +962,28 @@ SUBROUTINE Qtransfo1TOQtransfo2(Qtransfo1,Qtransfo2)
         TYPE (Type_Qtransfo), intent(in)    :: Qtransfo1
         TYPE (Type_Qtransfo), intent(inout) :: Qtransfo2
         integer :: it,n
-      !-----------------------------------------------------------------
+        character (len=:), allocatable :: name_transfo
+
+        !-----------------------------------------------------------------
       logical, parameter :: debug = .FALSE.
       !logical, parameter :: debug = .TRUE.
       character (len=*), parameter :: name_sub='Qtransfo1TOQtransfo2'
       !-----------------------------------------------------------------
 
+      name_transfo = 'not_allocated'
+      IF (allocated(Qtransfo1%name_transfo)) name_transfo = Qtransfo1%name_transfo
       IF (debug) THEN
         write(out_unitp,*)
         write(out_unitp,*) 'BEGINNING ',name_sub
-        write(out_unitp,*) 'name_transfo: ',get_name_Qtransfo(Qtransfo1)
+        write(out_unitp,*) 'name_transfo: ',name_transfo
         CALL Write_Qtransfo(Qtransfo1)
         flush(out_unitp)
       END IF
       !-----------------------------------------------------------------
       Qtransfo2%print_done      = .FALSE.
 
       IF (allocated(Qtransfo1%name_transfo)) THEN
-        Qtransfo2%name_transfo    = get_name_Qtransfo(Qtransfo1)
+        Qtransfo2%name_transfo    = Qtransfo1%name_transfo
       END IF
       Qtransfo2%inTOout         = Qtransfo1%inTOout
 
@@ -997,12 +1004,10 @@ SUBROUTINE Qtransfo1TOQtransfo2(Qtransfo1,Qtransfo2)
       Qtransfo2%Primitive_Coord = Qtransfo1%Primitive_Coord
 
 
-      CALL alloc_array(Qtransfo2%type_Qin,shape(Qtransfo1%type_Qin),    &
-                      "Qtransfo2%type_Qin",name_sub)
+      CALL alloc_array(Qtransfo2%type_Qin,shape(Qtransfo1%type_Qin),"Qtransfo2%type_Qin",name_sub)
       Qtransfo2%type_Qin(:) = Qtransfo1%type_Qin(:)
 
-      CALL alloc_array(Qtransfo2%name_Qin,shape(Qtransfo1%name_Qin),    &
-                      "Qtransfo2%name_Qin",name_sub)
+      CALL alloc_array(Qtransfo2%name_Qin,shape(Qtransfo1%name_Qin),"Qtransfo2%name_Qin",name_sub)
       Qtransfo2%name_Qin(:) = Qtransfo1%name_Qin(:)
 
       ! for type_Qout and name_Qout, it will be done after (from another type_Qin, name_Qin)
@@ -1015,7 +1020,7 @@ SUBROUTINE Qtransfo1TOQtransfo2(Qtransfo1,Qtransfo2)
         Qtransfo2%name_Qout(:) = Qtransfo1%name_Qout(:)
       END IF
 
-      SELECT CASE (get_name_Qtransfo(Qtransfo1,lower=.TRUE.))
+      SELECT CASE (name_transfo)
       CASE ('identity')
         CONTINUE ! nothing to do
 
@@ -1093,8 +1098,7 @@ SUBROUTINE Qtransfo1TOQtransfo2(Qtransfo1,Qtransfo2)
           STOP
         END IF
 
-        CALL oneDTransfo1TOoneDTransfo2(Qtransfo1%oneDTransfo,          &
-                                        Qtransfo2%oneDTransfo)
+        CALL oneDTransfo1TOoneDTransfo2(Qtransfo1%oneDTransfo,Qtransfo2%oneDTransfo)
 
       CASE ('twod')
         Qtransfo2%TwoDTransfo = Qtransfo1%TwoDTransfo
@@ -1151,20 +1155,21 @@ SUBROUTINE Qtransfo1TOQtransfo2(Qtransfo1,Qtransfo2)
 
       CASE default
         write(out_unitp,*) ' ERROR in ',name_sub
-        write(out_unitp,*) ' The transformation is UNKNOWN: ',get_name_Qtransfo(Qtransfo1)
+        write(out_unitp,*) ' The transformation is UNKNOWN: ',name_transfo
         CALL Write_list_Qtransfo(out_unitp)
         write(out_unitp,*) ' Check the source!'
         STOP
       END SELECT
-
       !-----------------------------------------------------------------
       IF (debug) THEN
         write(out_unitp,*)
         write(out_unitp,*) 'END ',name_sub
         flush(out_unitp)
       END IF
       !-----------------------------------------------------------------
-  END SUBROUTINE Qtransfo1TOQtransfo2
+      deallocate(name_transfo)
+
+    END SUBROUTINE Qtransfo1TOQtransfo2
   SUBROUTINE calc_Qtransfo(dnQin,dnQout,Qtransfo,nderiv,inTOout)
     USE ADdnSVM_m
     USE mod_MPI
@@ -1180,6 +1185,7 @@ SUBROUTINE calc_Qtransfo(dnQin,dnQout,Qtransfo,nderiv,inTOout)
         TYPE (Type_dnS)   :: dnR
         integer           :: iv,it,i,iQ,iQin,iQout
         TYPE (Type_dnVec), pointer :: tab_dnXVect(:)   ! dim: nb_vect_tot
+        character (len=:), allocatable :: name_transfo
 
       !-----------------------------------------------------------------
       integer :: nderiv_debug = 1
@@ -1195,10 +1201,13 @@ SUBROUTINE calc_Qtransfo(dnQin,dnQout,Qtransfo,nderiv,inTOout)
         inTOout_loc = .TRUE.
       END IF
 
+      name_transfo = 'not_allocated'
+      IF (allocated(Qtransfo%name_transfo)) name_transfo = Qtransfo%name_transfo
+
       IF (debug) THEN
         write(out_unitp,*)
         write(out_unitp,*) 'BEGINNING ',name_sub
-        write(out_unitp,*) 'New Qtransfo',it,' ',get_name_Qtransfo(Qtransfo)
+        write(out_unitp,*) 'New Qtransfo',it,' ',name_transfo
         write(out_unitp,*) 'nderiv',nderiv
         write(out_unitp,*) 'Qtransfo%nb_act',Qtransfo%nb_act
         write(out_unitp,*) 'inTOout',inTOout_loc
@@ -1227,7 +1236,7 @@ SUBROUTINE calc_Qtransfo(dnQin,dnQout,Qtransfo,nderiv,inTOout)
         STOP 'ERROR in calc_Qtransfo: skip_transfo=t MUST be treated before'
       END IF
 
-      SELECT CASE (get_name_Qtransfo(Qtransfo,lower=.TRUE.))
+      SELECT CASE (name_transfo)
       CASE ('identity')
         IF (inTOout_loc) THEN
           CALL sub_dnVec1_TO_dnVec2(dnQin,dnQout,nderiv)
@@ -1390,7 +1399,7 @@ SUBROUTINE calc_Qtransfo(dnQin,dnQout,Qtransfo,nderiv,inTOout)
           STOP 'ERROR in calc_Qtransfo: name_transfo is NOT allocated'
       CASE default
         write(out_unitp,*) ' ERROR in ',name_sub
-        write(out_unitp,*) ' The transformation is UNKNOWN: ',get_name_Qtransfo(Qtransfo)
+        write(out_unitp,*) ' The transformation is UNKNOWN: ',name_transfo
         CALL Write_list_Qtransfo(out_unitp)
         write(out_unitp,*) ' Check the source!'
         STOP 'ERROR in calc_Qtransfo: The transformation is UNKNOWN'
@@ -1409,6 +1418,7 @@ SUBROUTINE calc_Qtransfo(dnQin,dnQout,Qtransfo,nderiv,inTOout)
         write(out_unitp,*) 'END ',name_sub
         flush(out_unitp)
       END IF
+      deallocate(name_transfo)
 
   END SUBROUTINE calc_Qtransfo
 
@@ -1426,18 +1436,21 @@ SUBROUTINE Write_Qtransfo(Qtransfo,force_print)
         integer :: err
         integer :: i,it,i_Q
         logical :: force_print_loc
+        character (len=:), allocatable :: name_transfo
 
         character (len=*), parameter :: name_sub = "Write_Qtransfo"
 
+        name_transfo = 'not_allocated'
+        IF (allocated(Qtransfo%name_transfo)) name_transfo = Qtransfo%name_transfo
+
         IF (present(force_print)) THEN
           force_print_loc = force_print
         ELSE
           force_print_loc = .FALSE.
         END IF
 
         IF (Qtransfo%print_done .AND. .NOT. force_print_loc) THEN
-          write(out_unitp,*) 'name_transfo,num_transfo: ',     &
-                         trim(Qtransfo%name_transfo),Qtransfo%num_transfo
+          write(out_unitp,*) 'name_transfo,num_transfo: ',name_transfo,Qtransfo%num_transfo
           write(out_unitp,*) ' Writing already done.'
           flush(out_unitp)
           RETURN
@@ -1448,8 +1461,7 @@ SUBROUTINE Write_Qtransfo(Qtransfo,force_print)
         Qtransfo%print_done = .TRUE.
 
         IF(MPI_id==0) THEN
-          write(out_unitp,*) 'name_transfo,num_transfo: ',     &
-                        get_name_Qtransfo(Qtransfo),Qtransfo%num_transfo
+          write(out_unitp,*) 'name_transfo,num_transfo: ',name_transfo,Qtransfo%num_transfo
           write(out_unitp,*) 'BeforeActive: ',Qtransfo%BeforeActive
           write(out_unitp,*) 'Primitive_Coord: ',Qtransfo%Primitive_Coord
 
@@ -1492,7 +1504,7 @@ SUBROUTINE Write_Qtransfo(Qtransfo,force_print)
           write(out_unitp,*) '---------------------------------------'
         ENDIF ! for MPI_id==0
 
-        SELECT CASE (get_name_Qtransfo(Qtransfo,lower=.TRUE.))
+        SELECT CASE (name_transfo)
         CASE ('identity')
           CONTINUE ! nothing !
 
@@ -1589,15 +1601,17 @@ SUBROUTINE Write_Qtransfo(Qtransfo,force_print)
 
         CASE default ! ERROR: wrong transformation !
           write(out_unitp,*) ' ERROR in ',name_sub
-          write(out_unitp,*) ' The transformation is UNKNOWN: ',get_name_Qtransfo(Qtransfo)
+          write(out_unitp,*) ' The transformation is UNKNOWN: ',name_transfo
           CALL Write_list_Qtransfo(out_unitp)
           write(out_unitp,*) ' Check the source!'
           STOP
         END SELECT
+        deallocate(name_transfo)
 
         write(out_unitp,*) 'END ',name_sub
         flush(out_unitp)
-  END SUBROUTINE Write_Qtransfo
+
+      END SUBROUTINE Write_Qtransfo
 
   SUBROUTINE sub_Type_Name_OF_Qin(Qtransfo,name_coord)
         USE mod_Lib_QTransfo, ONLY : make_nameQ
@@ -1694,17 +1708,13 @@ SUBROUTINE Sub_Check_LinearTransfo(Qtransfo)
 
   END SUBROUTINE Sub_Check_LinearTransfo
 
-  FUNCTION get_name_Qtransfo(Qtransfo,lower) RESULT(name_Qtransfo)
+  FUNCTION get_name_Qtransfo(Qtransfo) RESULT(name_Qtransfo)
 
     character (len=:), allocatable                      :: name_Qtransfo ! RESULT
     TYPE (Type_Qtransfo),          intent(in)           :: Qtransfo
-    logical,                       intent(in), optional :: lower
 
     IF (allocated(Qtransfo%name_transfo)) THEN
       name_Qtransfo = Qtransfo%name_transfo
-      IF (present(lower)) THEN
-        IF (lower) name_Qtransfo = TO_lowercase(Qtransfo%name_transfo)
-      END IF
     ELSE
       name_Qtransfo = 'not_allocated'
     END IF

Source_TnumTana_Coord/Tana/sub_module_Tana_keo.f90

@@ -110,7 +110,7 @@ SUBROUTINE compute_analytical_KEO(TWOxKEO,mole, para_Tnum, Qact)
       poly = .false.
       i_transfo = -1
       do i = 1, size(mole%tab_Qtransfo)
-        if(get_name_Qtransfo(mole%tab_Qtransfo(i),lower=.TRUE.) == 'poly') then
+        if(get_name_Qtransfo(mole%tab_Qtransfo(i)) == 'poly') then
           poly = .true.
           i_transfo = i
           exit
@@ -473,7 +473,7 @@ SUBROUTINE compute_analytical_KEO_old(TWOxKEO,mole, para_Tnum, Qact)
       poly = .false.
       i_transfo = -1
       do i = 1, size(mole%tab_Qtransfo)
-        if(get_name_Qtransfo(mole%tab_Qtransfo(i),lower=.TRUE.) == 'poly') then
+        if(get_name_Qtransfo(mole%tab_Qtransfo(i)) == 'poly') then
           poly = .true.
           i_transfo = i
           exit

Source_TnumTana_Coord/sub_module_Tnum.f90

@@ -292,7 +292,7 @@ SUBROUTINE Set_masses_Z_TO_CoordType(mole,Qtransfo)
       END IF
       !-----------------------------------------------------------
 
-        SELECT CASE (get_name_Qtransfo(Qtransfo,lower=.TRUE.))
+        SELECT CASE (get_name_Qtransfo(Qtransfo))
 
         CASE ('zmat') ! It should be one of the first transfo read
 
@@ -999,7 +999,7 @@ SUBROUTINE Read_CoordType(mole,para_Tnum,const_phys)
 
           CALL Set_masses_Z_TO_CoordType(mole,mole%tab_Qtransfo(it))
 
-          SELECT CASE (get_name_Qtransfo(mole%tab_Qtransfo(it),lower=.TRUE.))
+          SELECT CASE (get_name_Qtransfo(mole%tab_Qtransfo(it)))
           CASE ('bunch','bunch_poly')
             ! because we need BunchTransfo for Poly transfo
             mole%tab_Qtransfo(it+1)%BunchTransfo => mole%tab_Qtransfo(it)%BunchTransfo
@@ -1064,7 +1064,7 @@ SUBROUTINE Read_CoordType(mole,para_Tnum,const_phys)
 
         !=======================================================================
         ! analyzis of the transformations:
-        name_transfo = get_name_Qtransfo(mole%tab_Qtransfo(1),lower=.TRUE.)
+        name_transfo = get_name_Qtransfo(mole%tab_Qtransfo(1))
 
 
         IF (name_transfo /= 'zmat'  .AND. name_transfo /= 'bunch' .AND. &
@@ -1080,7 +1080,7 @@ SUBROUTINE Read_CoordType(mole,para_Tnum,const_phys)
 
         !=======================================================================
 
-        name_transfo = get_name_Qtransfo(mole%tab_Qtransfo(nb_Qtransfo),lower=.TRUE.)
+        name_transfo = get_name_Qtransfo(mole%tab_Qtransfo(nb_Qtransfo))
 
         IF (name_transfo /= 'active') THEN
            write(out_unitp,*) ' ERROR in ',name_sub
@@ -1500,7 +1500,7 @@ SUBROUTINE Read_CoordType(mole,para_Tnum,const_phys)
       !check is Tana is possible : nb_Qtransfo = 3
      para_Tnum%Tana = para_Tnum%Tana .AND. mole%nb_Qtransfo == 3
      !check is Tana is possible : 2st transfo poly
-     name_transfo = get_name_Qtransfo(mole%tab_Qtransfo(2),lower=.TRUE.)
+     name_transfo = get_name_Qtransfo(mole%tab_Qtransfo(2))
 
      para_Tnum%Tana = para_Tnum%Tana .AND. name_transfo == "poly"
      ! we don't need to check the 1st and the last Qtransfo
@@ -1696,7 +1696,7 @@ SUBROUTINE CoordType2_TO_CoordType1(mole1,mole2)
         CALL Qtransfo1TOQtransfo2(mole2%tab_Qtransfo(it),               &
                                   mole1%tab_Qtransfo(it))
 
-        SELECT CASE (get_name_Qtransfo(mole1%tab_Qtransfo(it),lower=.TRUE.))
+        SELECT CASE (get_name_Qtransfo(mole1%tab_Qtransfo(it)))
         CASE ("nm")
           mole1%NMTransfo => mole1%tab_Qtransfo(it)%NMTransfo
         CASE ("rph")

Source_TnumTana_Coord/sub_module_paramQ.f90

@@ -507,7 +507,7 @@ SUBROUTINE read_RefGeom_CoordType(mole,para_Tnum)
 !======================================================================
 !     IF Cart_transfo=t
 !======================================================================
-      IF (get_name_Qtransfo(mole%tab_Qtransfo(1),lower=.TRUE.) == 'zmat'  .AND. &
+      IF (get_name_Qtransfo(mole%tab_Qtransfo(1)) == 'zmat'  .AND. &
               mole%tab_Qtransfo(1)%ZmatTransfo%New_Orient .AND.         &
          sum(abs(mole%tab_Qtransfo(1)%ZmatTransfo%vAt1)) == ZERO .AND.  &
          sum(abs(mole%tab_Qtransfo(1)%ZmatTransfo%vAt2)) == ZERO .AND.  &
@@ -988,7 +988,7 @@ SUBROUTINE sub_QxyzTOexeyez(Qxyz,VT,mole)
 
       VT(:) = ZERO
 
-      SELECT CASE (get_name_Qtransfo(mole%tab_Qtransfo(1),lower=.TRUE.))
+      SELECT CASE (get_name_Qtransfo(mole%tab_Qtransfo(1)))
       CASE ('zmat')
         IF (debug) write(out_unitp,*) 'zmat'
         nc1 = mole%tab_Qtransfo(1)%ZmatTransfo%ind_zmat(1,1)
@@ -1144,7 +1144,7 @@ SUBROUTINE sub_vAtiTOexeyez(VT,mole)
 
       VT(:) = mole%tab_Cart_transfo(1)%CartesianTransfo%vAt1(:)
 
-      SELECT CASE (get_name_Qtransfo(mole%tab_Qtransfo(1),lower=.TRUE.))
+      SELECT CASE (get_name_Qtransfo(mole%tab_Qtransfo(1)))
       CASE ('zmat')
         IF (debug) write(out_unitp,*) 'zmat'
         nc1 = mole%tab_Qtransfo(1)%ZmatTransfo%ind_zmat(1,1)
@@ -1250,7 +1250,7 @@ SUBROUTINE sub_Qxyz0TORot(Qxyz,Rot_initial,mole)
 
       ncart = min(size(Qxyz),size(mole%d0sm))
 
-      SELECT CASE (get_name_Qtransfo(mole%tab_Qtransfo(1),lower=.TRUE.))
+      SELECT CASE (get_name_Qtransfo(mole%tab_Qtransfo(1)))
       CASE ('zmat')
         nc1 = mole%tab_Qtransfo(1)%ZmatTransfo%ind_zmat(1,1)
         nc2 = mole%tab_Qtransfo(1)%ZmatTransfo%ind_zmat(1,2)