| 1 | PROGRAM DistriCorrection |
|---|
| 2 | ! Empty program to compuile the modules for the modification of a Distribution |
|---|
| 3 | ! L. Fita, CIMA August 2017 |
|---|
| 4 | ! |
|---|
| 5 | !! This is because I do not know enough about 'Makefile' |
|---|
| 6 | |
|---|
| 7 | USE module_generic |
|---|
| 8 | USE module_scientific |
|---|
| 9 | USE module_DistriCorrection |
|---|
| 10 | |
|---|
| 11 | IMPLICIT NONE |
|---|
| 12 | |
|---|
| 13 | INTEGER :: dim1, dim2, dim3, dimrng, dimpercen, Numquants |
|---|
| 14 | REAL(r_k) :: Highquant, fValue |
|---|
| 15 | REAL(r_k), DIMENSION(:,:,:), ALLOCATABLE :: values |
|---|
| 16 | REAL(r_k), DIMENSION(:), ALLOCATABLE :: rangeValues |
|---|
| 17 | REAL(r_k), DIMENSION(:), ALLOCATABLE :: PercentagesRange |
|---|
| 18 | CHARACTER(len=50) :: KRemove, ReplacevalS |
|---|
| 19 | LOGICAL :: debug |
|---|
| 20 | REAL(r_k), DIMENSION(:,:,:), ALLOCATABLE :: newvalues |
|---|
| 21 | REAL(r_k), DIMENSION(:,:,:), ALLOCATABLE :: rangeamount |
|---|
| 22 | INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: redistributedindices, aboveindices |
|---|
| 23 | REAL(r_k), DIMENSION(:,:), ALLOCATABLE :: Highabovequant |
|---|
| 24 | |
|---|
| 25 | ! Local |
|---|
| 26 | INTEGER :: i,j |
|---|
| 27 | |
|---|
| 28 | !!!!!!! Variables |
|---|
| 29 | ! dim[1/2/3]: size of the values to treat |
|---|
| 30 | ! values: values to re-distribute |
|---|
| 31 | ! fValue: value for the missing ones |
|---|
| 32 | ! dimrng: number of ranges provided |
|---|
| 33 | ! rangeValues: ',' values from which establish the ranges of removals |
|---|
| 34 | ! dimpercen: number of percentages provided |
|---|
| 35 | ! PercentagesRange: ',' percentages of removing to apply to each range (one value less than [rangeVals]) |
|---|
| 36 | ! KRemove: kind of methodology to select which values to remove |
|---|
| 37 | ! 'rand': randomly selection within the correspondent range |
|---|
| 38 | ! Numquants: quantity of percentiles to compute |
|---|
| 39 | ! Highquant: percentile of the distribution of values above which total removed amount will be equi-distributed |
|---|
| 40 | ! ReplacevalS: replacing value to be assigned at the removed values |
|---|
| 41 | ! 'min': initial minimal value of the distribution |
|---|
| 42 | ! 'mean': initial mean value of the distribution |
|---|
| 43 | ! '[value]': any given value otherwise |
|---|
| 44 | ! |
|---|
| 45 | ! Outcome: |
|---|
| 46 | ! newvalues: Values of the new distribution |
|---|
| 47 | ! redistributedindices: List of positions changed for each range |
|---|
| 48 | ! rangeamount: Amount re-distributed from each range |
|---|
| 49 | ! Highabovequant: value from which the amount is distributed |
|---|
| 50 | ! aboveindices: Indices of the values which received the distributed amount |
|---|
| 51 | |
|---|
| 52 | fname = 'DistriCorrection' |
|---|
| 53 | |
|---|
| 54 | dim1 = 5 |
|---|
| 55 | dim2 = 3 |
|---|
| 56 | dim3 = 100 |
|---|
| 57 | dimrng = 3 |
|---|
| 58 | dimpercen = 2 |
|---|
| 59 | fValue = -99999.*oneRK |
|---|
| 60 | |
|---|
| 61 | ALLOCATE(values(dim1,dim2,dim3)) |
|---|
| 62 | ALLOCATE(rangeValues(dimrng)) |
|---|
| 63 | ALLOCATE(percentagesRange(dimpercen)) |
|---|
| 64 | ALLOCATE(newvalues(dim1,dim2,dim3)) |
|---|
| 65 | ALLOCATE(rangeamount(dim1,dim2,dimrng)) |
|---|
| 66 | ALLOCATE(redistributedindices(dim1,dim2,dim3)) |
|---|
| 67 | ALLOCATE(aboveindices(dim1,dim2,dim3)) |
|---|
| 68 | ALLOCATE(Highabovequant(dim1,dim2)) |
|---|
| 69 | |
|---|
| 70 | DO i=1,dim1 |
|---|
| 71 | DO j=1,dim2 |
|---|
| 72 | values(i,j,:) = RangeR_K(dim3, oneRK, dim3*oneRK) |
|---|
| 73 | END DO |
|---|
| 74 | END DO |
|---|
| 75 | PRINT *,values(1,1,:) |
|---|
| 76 | |
|---|
| 77 | rangeValues = (/ 0., 5., 25./) |
|---|
| 78 | rangeValues = (/ 0., 5., 25./) |
|---|
| 79 | percentagesRange = (/ 0.8, 0.5/) |
|---|
| 80 | |
|---|
| 81 | KRemove = 'rand' |
|---|
| 82 | Numquants = 20 |
|---|
| 83 | Highquant = 0.9d0 |
|---|
| 84 | ReplaceValS = '0.' |
|---|
| 85 | debug = .TRUE. |
|---|
| 86 | |
|---|
| 87 | ! Testing the module |
|---|
| 88 | |
|---|
| 89 | CALL randLowRemovePercent_HighEqui3D(dim1, dim2, dim3, values, dimrng, rangeValues, dimpercen, & |
|---|
| 90 | PercentagesRange, KRemove, Numquants, Highquant, ReplacevalS, fvalue, debug, newvalues, & |
|---|
| 91 | redistributedindices, rangeamount, Highabovequant, aboveindices) |
|---|
| 92 | |
|---|
| 93 | END PROGRAM DistriCorrection |
|---|
| 94 | |
|---|