Homec4science
Diffusion COSOlver (new_coulomb) Browse

cosolver/gkcoulomb_suite/Pipjm/src/basis_transformation_mod.f90
138972b69f9dnew_coulomb

Last Change
Raw File

basis_transformation_mod.f90
View Options

MODULE basis_transformation
! Basis transformation
!
! T5: associatedLegendre/AssociatedLaguerre -> Hermite-Laguerre
USE prec_const
USE basic
USE array
USE FMZM
IMPLICIT NONE
PUBLIC
INTEGER, SAVE:: T5FID
CHARACTER(len=*), PARAMETER :: T5TabListFile ='T5_TabList.txt'
CONTAINS
SUBROUTINE LOAD_BASIS_TRANSFORMATION
! loads T4 or T5 basis transformation coefficients
IMPLICIT NONE
!
!
CALL GET_NNT5
!
END SUBROUTINE LOAD_BASIS_TRANSFORMATION
!
!______________________________________________________________________________________________
!
SUBROUTINE GET_NNT5
!
! Inquire Non-Null T5 coefficients and store them as array of character strings f
! Inquire T5 coefficients in files *.csv
!
IMPLICIT NONE
!
! local variables
!
INTEGER :: NTables, iTable
CHARACTER(len=100),DIMENSION(:),ALLOCATABLE :: T5TableNames ! string array containing the names of T5 tables in srcT5 dir
CHARACTER(len=100) :: buff_
CHARACTER(len=200) :: filename_ ! ... includes absolute path and filename
INTEGER :: ENDOF,ierr
INTEGER, save :: FID
!
INTEGER :: IT1,IT2,IT3,IT4,IT5
INTEGER :: NN ! ... number of NN T5 coeff with indices less than FMAXX,GMAXX ...
INTEGER :: iNN
!
INTEGER :: FMAXX,GMAXX,HMAXX,INDT5MAX
!
CHARACTER*2 :: SIT1,SIT2,SIT3,SIT4,SIT5
CHARACTER(len =T5len) :: T5STR_
!
INDT5MAX = idMAXT5
!
! load global arrays
WRITE(*,*) 'Load basis T5 coeff. up to (p,j,k,m,l) <= ', INDT5MAX
! load local arrays
!! WRITE(*,*) 'Load basis T5 coeff. up to (p,j,k,m,l) <= ', pmax_l,tmax_l,mmax_l,lmax_l,fmax_l
!
! open T5TablesList.txt files containg the namees of the T5 tables
!
OPEN(FID,FILE=T5TabListFile)
! Count the number of files
NTables = 0
ENDOF = 0
!
DO WHILE (ENDOF .eq. 0 )
READ(FID,*,IOSTAT=ENDOF) buff_
NTables = NTables+1
ENDDO
!
NTables = NTables -1
!
CLOSE(FID)
!
! Allocate array of T5 tables
ALLOCATE(T5TableNames(1:NTables))
!
OPEN(FID,FILE=T5TabListFile)
ENDOF = 0
iTable = 1
!
! Get the name of the table containing T5 coeff.
!
DO WHILE (ENDOF .eq. 0 )
READ(FID,*,IOSTAT=ENDOF) buff_
IF (iTable .le. NTables) THEN
T5TableNames(iTable) = adjustl(trim(buff_))
iTable = iTable +1
ENDIF
ENDDO
! Get the number of NN T5 coeff contained in T5TableNames.csv files
write(*,*) 'Get T5 coeffs from ',trim(adjustl(T5dir))
NN = 0
DO iTable=1,NTables
filename_ = trim(adjustl(trim(adjustl(T5dir))//trim(adjustl(T5TableNames(iTable)))))
OPEN(FID,FILE = filename_)
ENDOF = 0
DO WHILE (ENDOF .eq. 0 )
READ(FID,*,IOSTAT=ENDOF) IT1,IT2,IT3,IT4,IT5
! Load global arrays
IF (IT1 .le. INDT5MAX .and. IT2 .le. INDT5MAX .and. IT3 .le. INDT5MAX .and. IT4 .le. INDT5MAX .and. IT5 .le. INDT5MAX) THEN
NN = NN+1
ENDIF
! load local arrays
! IF( IT1 .le. pmax_l .and. IT1 .ge. pmin_l &
! .and. IT2 .le. tmax_l .and. IT2 .ge. tmin_l &
! .and. IT3 .le. mmax_l .and. IT3 .ge. mmin_l &
! .and. IT4 .le. lmax_l .and. IT4 .ge. lmin_l &
! .and. IT5 .le. fmax_l .and. IT5 .ge. fmin_l) THEN
! NN = NN+1
! ENDIF
ENDDO
CLOSE(FID)
ENDDO
!
! Get the T5 coefficients
allocate(NNLKMPJ(1:NN))
allocate(T5STR(1:NN))
!
! Inquire NN indices
!
iNN = 1
!
DO iTable =1, NTables
filename_ = trim(adjustl(T5dir))//trim(adjustl(T5TableNames(iTable)))
OPEN(FID,FILE = filename_)
ENDOF = 0
DO WHILE (ENDOF .eq. 0 )
READ(FID,*,IOSTAT=ENDOF) IT1,IT2,IT3,IT4,IT5,T5STR_
! load global array
IF (IT1 .le. INDT5MAX .and. IT2 .le. INDT5MAX .and. IT3 .le. INDT5MAX .and. IT4 .le. INDT5MAX .and. IT5 .le. INDT5MAX ) THEN
! load local arrays
! IF( IT1 .le. pmax_l .and. IT1 .ge. pmin_l &
! .and. IT2 .le. tmax_l .and. IT2 .ge. tmin_l &
! .and. IT3 .le. mmax_l .and. IT3 .ge. mmin_l &
! .and. IT4 .le. lmax_l .and. IT4 .ge. lmin_l &
! .and. IT5 .le. fmax_l .and. IT5 .ge. fmin_l) THEN
!
CALL GET_NNLKMPJ(IT1,IT2,IT3,IT4,IT5,NNLKMPJ(iNN))
T5STR(iNN) = T5STR_
!! write(*,*) NNLKMPJ(iNN),T5STR(iNN)
IF(ENDOF .eq. 0) iNN = iNN+1
ENDIF
ENDDO
!
CLOSE(FID)
ENDDO
!
END SUBROUTINE GET_NNT5
!
!______________________________________________________________________________________________
!
SUBROUTINE GET_NNLKMPJ(l,k,m,p,j,NNLKMPJ_)
!
! construct character string l//$//k//$//m//$//p//$//j, called str id
!
IMPLICIT NONE
!
INTEGER,intent(in) :: l,k,p,j,m
CHARACTER(len=NNLKMPJlen),intent(inout) :: NNLKMPJ_
!
CHARACTER*2 :: SIT1,SIT2,SIT3,SIT4,SIT5
!
! Convert int to string
WRITE(SIT1,'(i2)') l
WRITE(SIT2,'(i2)') k
WRITE(SIT3,'(i2)') m
WRITE(SIT4,'(i2)') p
WRITE(SIT5,'(i2)') j
!
NNLKMPJ_ = trim(adjustl(SIT1))//'$'//trim(adjustl(SIT2))//'$'//trim(adjustl(SIT3))//'$'//trim(adjustl(SIT4))//'$'//trim(adjustl(SIT5))
!
END SUBROUTINE GET_NNLKMPJ
!______________________________________________________________________________________________
!
FUNCTION GET_T5(l,k,m,p,j) RESULT(T5STR_)
!
! Returns the T5 string from character string array T5STR
!
! Note: (l,k,m,p,j) in the table is T_{lkm}^{pj}
!
IMPLICIT NONE
!
INTEGER,intent(in) :: l,k,m,p,j
CHARACTER(len=T5len) :: T5STR_
! Local variables
CHARACTER(len=NNLKMPJlen) :: NNLKMPJ_
INTEGER :: POS,i
LOGICAL :: IS_NULL
!
! Test on global array
IF( l .le. idMAXT5 .and. k .le. idMAXT5 .and. m .le. idMAXT5 .and. p .le. idMAXT5 .and. j .le. idMAXT5) THEN
!
! Inquire if T5 is zero
! Avoids to loop over array
IS_NULL = T5zero( l, k, m, p, j )
T5STR_ = '0.0'
!
IF(.not. IS_NULL) THEN
! Get T5 coeff
POS =0
! Inquire if T5 coeff is null
! Get string id
CALL GET_NNLKMPJ(l,k,m,p,j,NNLKMPJ_)
! Get T5 position
DO i=1,size(NNLKMPJ)
IF( NNLKMPJ(i) == NNLKMPJ_) THEN
POS = i
GOTO 55
ENDIF
ENDDO
55 CONTINUE
! Retrieve T5 string from array
IF( POS .gt. 0) THEN
T5STR_ = T5str(POS)
!! WRITE(*,*),NNLKPJ_,T4STR_
ELSE
T5STR_ = '0.0'
ENDIF
ENDIF
ELSE
! Test on global arrays
! IF ( l .ge. INDT5MAX .or. k .ge. INDT5MAX .or. p .ge. INDT5MAX .or. j .ge. INDT5MAX) THEN
write(*,*) 'WARNING !!!! NEED TO LOAD MORE T5 coeff ..... !!!!!!!!!!'
write(*,*) 'Inquire ',max(l,k,p,j)
STOP
!
ENDIF
!
END FUNCTION GET_T5
!______________________________________________________________________________________________
!
logical function T5zero( l, k, m, p, j ) result( return_value )
! return true if T5 is zero
implicit none
integer, intent(in) :: l, k, m, p, j
integer :: off1, off2, D
return_value = .false.
off1 = mod(l-m,2)
off2 = mod(off1+1,2)
D = (l-m)/2 ! Floor of l-m, Delta in script
if( mod(l+m+p,2) /= 0 .or. &
& D+k<0 .or. &
& 2*D+k+(1-off2-p)/2<0 .or. &
& 2*off2+2*k+l-m-p-2*j<0 .or. &
& (m==0 .and. T4zero(l,k,p,j)) .or. &
& .not. (l-m>=max(0,p+2*j-2*k) .and. mod(l-m+p,2)==0) ) then
return_value = .true.
end if
!
end function T5zero
!______________________________________________________________________________________________
!
logical function T4zero( l, k, p, j ) result( return_value )
! returns true if T4 is zeros
implicit none
integer, intent(in) :: l, k, p, j
integer :: tmp
return_value = .false.
tmp = 1 - modulo(l-p,2)
if( tmp == 0 .or. l+2*k/=p+2*j ) return_value = .true.
end function T4zero
!
END MODULE basis_transformation
c4science · Help