PROGRAM DistriCorrection ! Empty program to compuile the modules for the modification of a Distribution ! L. Fita, CIMA August 2017 ! !! This is because I do not know enough about 'Makefile' USE module_generic USE module_scientific USE module_DistriCorrection IMPLICIT NONE INTEGER :: dim1, dim2, dim3, dimrng, dimpercen, Numquants REAL(r_k) :: Highquant, fValue REAL(r_k), DIMENSION(:,:,:), ALLOCATABLE :: values REAL(r_k), DIMENSION(:), ALLOCATABLE :: rangeValues REAL(r_k), DIMENSION(:), ALLOCATABLE :: PercentagesRange CHARACTER(len=50) :: KRemove, ReplacevalS LOGICAL :: debug REAL(r_k), DIMENSION(:,:,:), ALLOCATABLE :: newvalues REAL(r_k), DIMENSION(:,:,:), ALLOCATABLE :: rangeamount INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: redistributedindices, aboveindices REAL(r_k), DIMENSION(:,:), ALLOCATABLE :: Highabovequant ! Local INTEGER :: i,j !!!!!!! Variables ! dim[1/2/3]: size of the values to treat ! values: values to re-distribute ! fValue: value for the missing ones ! dimrng: number of ranges provided ! rangeValues: ',' values from which establish the ranges of removals ! dimpercen: number of percentages provided ! PercentagesRange: ',' percentages of removing to apply to each range (one value less than [rangeVals]) ! KRemove: kind of methodology to select which values to remove ! 'rand': randomly selection within the correspondent range ! Numquants: quantity of percentiles to compute ! Highquant: percentile of the distribution of values above which total removed amount will be equi-distributed ! ReplacevalS: replacing value to be assigned at the removed values ! 'min': initial minimal value of the distribution ! 'mean': initial mean value of the distribution ! '[value]': any given value otherwise ! ! Outcome: ! newvalues: Values of the new distribution ! redistributedindices: List of positions changed for each range ! rangeamount: Amount re-distributed from each range ! Highabovequant: value from which the amount is distributed ! aboveindices: Indices of the values which received the distributed amount fname = 'DistriCorrection' dim1 = 5 dim2 = 3 dim3 = 100 dimrng = 3 dimpercen = 2 fValue = -99999.*oneRK ALLOCATE(values(dim1,dim2,dim3)) ALLOCATE(rangeValues(dimrng)) ALLOCATE(percentagesRange(dimpercen)) ALLOCATE(newvalues(dim1,dim2,dim3)) ALLOCATE(rangeamount(dim1,dim2,dimrng)) ALLOCATE(redistributedindices(dim1,dim2,dim3)) ALLOCATE(aboveindices(dim1,dim2,dim3)) ALLOCATE(Highabovequant(dim1,dim2)) DO i=1,dim1 DO j=1,dim2 values(i,j,:) = RangeR_K(dim3, oneRK, dim3*oneRK) END DO END DO PRINT *,values(1,1,:) rangeValues = (/ 0., 5., 25./) rangeValues = (/ 0., 5., 25./) percentagesRange = (/ 0.8, 0.5/) KRemove = 'rand' Numquants = 20 Highquant = 0.9d0 ReplaceValS = '0.' debug = .TRUE. ! Testing the module CALL randLowRemovePercent_HighEqui3D(dim1, dim2, dim3, values, dimrng, rangeValues, dimpercen, & PercentagesRange, KRemove, Numquants, Highquant, ReplacevalS, fvalue, debug, newvalues, & redistributedindices, rangeamount, Highabovequant, aboveindices) END PROGRAM DistriCorrection