MODULE module_generic ! Module with generic functions !!!!!!! Subroutines/Functions ! ErrMsg: Subroutine to stop execution and provide an error message ! ErrWarnMsg: Function to print error/warning message ! index_list_coordsI: Function to provide the index of a given coordinate within a list of integer coordinates ! Index1DArrayR: Function to provide the first index of a given value inside a 1D real array ! Index1DArrayR_K: Function to provide the first index of a given value inside a 1D real(r_k) array ! Index2DArrayR: Function to provide the first index of a given value inside a 2D real array ! Nstrings: Function to repeat a number of times a given string ! RangeI: Function to provide a range of d1 values from 'iniv' to 'endv', of integer values in a vector ! RangeR: Function to provide a range of d1 values from 'iniv' to 'endv', of real values in a vector ! RangeR_K: Function to provide a range of d1 from 'iniv' to 'endv', of real(r_k) values in a vector ! vectorR_KS: Function to transform a vector of reals to a string of characters USE module_definitions CONTAINS INTEGER FUNCTION index_list_coordsI(Ncoords, coords, icoord) ! Function to provide the index of a given coordinate within a list of integer coordinates IMPLICIT NONE INTEGER, INTENT(in) :: Ncoords INTEGER, DIMENSION(Ncoords,2), INTENT(in) :: coords INTEGER, DIMENSION(2), INTENT(in) :: icoord ! Local INTEGER, DIMENSION(Ncoords) :: dist INTEGER :: i,mindist INTEGER, DIMENSION(1) :: iloc !!!!!!! Variables ! Ncoords: number of coordinates in the list ! coords: list of coordinates ! icoord: coordinate to find fname = 'index_list_coordsI' dist = (coords(:,1)-icoord(1))**2+(coords(:,2)-icoord(2))**2 IF (ANY(dist == 0)) THEN iloc = MINLOC(dist) index_list_coordsI = iloc(1) ELSE index_list_coordsI = -1 END IF END FUNCTION index_list_coordsI CHARACTER(len=1000) FUNCTION vectorR_KS(d1, vector) ! Function to transform a vector of reals(r_k) to a string of characters IMPLICIT NONE INTEGER, INTENT(in) :: d1 REAL(r_k), DIMENSION(d1), INTENT(in) :: vector ! Local INTEGER :: iv CHARACTER(len=50) :: RS !!!!!!! Variables ! d1: length of the vector ! vector: values to transform fname = 'vectorR_KS' vectorR_KS = '' DO iv=1, d1 WRITE(RS, '(F50.25)')vector(iv) IF (iv == 1) THEN vectorR_KS = TRIM(RS) ELSE vectorR_KS = TRIM(vectorR_KS) // ', ' // TRIM(RS) END IF END DO END FUNCTION vectorR_KS CHARACTER(len=1000) FUNCTION Nstrings(Strval, Ntimes) ! Function to repeat a number of times a given string IMPLICIT NONE CHARACTER(LEN=50), INTENT(in) :: Strval INTEGER, INTENT(in) :: Ntimes ! Local INTEGER :: i !!!!!!! Variables ! Strval: String to repeat ! Ntimes: number of repetitions fname = 'Nstrings' Nstrings = '' Do i=1, Ntimes Nstrings = TRIM(Nstrings) // TRIM(Strval) END DO END FUNCTION Nstrings INTEGER FUNCTION Index1DArrayR(array1D, d1, val) ! Function to provide the first index of a given value inside a 1D real array IMPLICIT NONE INTEGER, PARAMETER :: r_k = KIND(1.d0) INTEGER, INTENT(in) :: d1 REAL(r_k), INTENT(in) :: val REAL(r_k), DIMENSION(d1), INTENT(in) :: array1D ! Local INTEGER :: i fname = 'Index1DArrayR' Index1DArrayR = -1 DO i=1,d1 IF (array1d(i) == val) THEN Index1DArrayR = i EXIT END IF END DO END FUNCTION Index1DArrayR INTEGER FUNCTION Index1DArrayR_K(array1D, d1, val) ! Function to provide the first index of a given value inside a 1D real(r_k) array IMPLICIT NONE INTEGER, INTENT(in) :: d1 REAL(r_k), INTENT(in) :: val REAL(r_k), DIMENSION(d1), INTENT(in) :: array1D ! Local INTEGER :: i fname = 'Index1DArrayR_K' Index1DArrayR_K = -1 DO i=1,d1 IF (array1d(i) == val) THEN Index1DArrayR_K = i EXIT END IF END DO END FUNCTION Index1DArrayR_K FUNCTION Index2DArrayR(array2D, d1, d2, val) ! Function to provide the first index of a given value inside a 2D real array IMPLICIT NONE INTEGER, PARAMETER :: r_k = KIND(1.d0) INTEGER, INTENT(in) :: d1, d2 REAL(r_k), INTENT(in) :: val REAL(r_k), DIMENSION(d1,d2), INTENT(in) :: array2D INTEGER, DIMENSION(2) :: Index2DArrayR ! Local INTEGER :: i, j fname = 'Index2DArrayR' Index2DArrayR = -1 DO i=1,d1 DO j=1,d2 IF (array2d(i,j) == val) THEN Index2DArrayR(1) = i Index2DArrayR(2) = j EXIT END IF END DO END DO END FUNCTION Index2DArrayR FUNCTION RangeI(d1, iniv, endv) ! Function to provide a range of d1 values from 'iniv' to 'endv', of integer values in a vector IMPLICIT NONE INTEGER, INTENT(in) :: d1, iniv, endv INTEGER, DIMENSION(d1) :: RangeI ! Local INTEGER :: i, intv fname = 'RangeI' intv = (endv - iniv) / (d1*1 - 1) RangeI(1) = iniv DO i=2,d1 RangeI(i) = RangeI(i-1) + intv END DO END FUNCTION RangeI FUNCTION RangeR(d1, iniv, endv) ! Function to provide a range of d1 from 'iniv' to 'endv', of real values in a vector IMPLICIT NONE INTEGER, INTENT(in) :: d1 REAL, INTENT(in) :: iniv, endv REAL, DIMENSION(d1) :: RangeR ! Local INTEGER :: i REAL :: intv fname = 'RangeR' intv = (endv - iniv) / (d1*1. - 1.) RangeR(1) = iniv DO i=2,d1 RangeR(i) = RangeR(i-1) + intv END DO END FUNCTION RangeR FUNCTION RangeR_K(d1, iniv, endv) ! Function to provide a range of d1 from 'iniv' to 'endv', of real(r_k) values in a vector IMPLICIT NONE INTEGER, INTENT(in) :: d1 REAL(r_k), INTENT(in) :: iniv, endv REAL(r_k), DIMENSION(d1) :: RangeR_K ! Local INTEGER :: i REAL(r_k) :: intv fname = 'RangeR_K' intv = (endv - iniv) / (d1*oneRK-oneRK) RangeR_K(1) = iniv DO i=2,d1 RangeR_K(i) = RangeR_K(i-1) + intv END DO END FUNCTION RangeR_K SUBROUTINE ErrMsg(msg, funcn, errN) ! Subroutine to stop execution and provide an error message IMPLICIT NONE CHARACTER(LEN=*), INTENT(in) :: msg, funcn INTEGER, INTENT(in) :: errN ! Local CHARACTER(LEN=50) :: emsg !!!!!!! Variables ! msg: message to print with the error ! funcn: name of the funciton, section to localize the error ! errN: number of the error provided for a given FORTRAN function emsg = 'ERORR -- error -- ERROR -- error' IF (errN /= 0) THEN PRINT *,TRiM(emsg) PRINT *,' ' // TRIM(funcn) // ': ' // TRIM(msg) // ' !!' PRINT *,' error number:', errN STOP END IF RETURN END SUBROUTINE ErrMsg CHARACTER(LEN=50) FUNCTION ErrWarnMsg(msg) ! Function to print error/warning message IMPLICIT NONE CHARACTER(LEN=3), INTENT(in) :: msg ! Local fname = 'ErrWarnMsg' IF (msg == 'err') THEN ErrWarnMsg = 'ERROR -- error -- ERROR -- error' ELSE IF (msg == 'wrn') THEN ErrWarnMsg = 'WARNING -- warning -- WARNING -- warning' ELSE PRINT *,'ERROR -- error -- ERROR -- error' PRINT *,' ' // TRIM(fname) // ": '" // TRIM(msg) // "' does not exist!!" STOP END IF END FUNCTION ErrWarnMsg END MODULE module_generic