![(please configure the [header_logo] section in trac.ini)](/LMDZ_WRF/chrome/site/your_project_logo.png){kind=logo}
Changeset 2317 in lmdz_wrf
- Timestamp:
- Feb 5, 2019, 4:12:35 PM (6 years ago)
- File:
-
- 1 edited
-
trunk/tools/module_scientific.f90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/tools/module_scientific.f90
r2316 r2317 44 44 ! multi_index_mat3DRK: Subroutine to provide the indices of the different locations of a value inside a 3D RK matrix 45 45 ! multi_index_mat4DRK: Subroutine to provide the indices of the different locations of a value inside a 4D RK matrix 46 ! multi_spaceweightstats_in 3DRK3_slc3v3: Subroutine to compute an spatial statistics value from a 3D RK matrix using 3rd dimension as46 ! multi_spaceweightstats_in1DRKno_slc3v3: Subroutine to compute an spatial statistics value from a 1D RK matrix without 47 47 ! running one into a matrix of 3-variables slices of rank 3 using spatial weights 48 ! multi_spaceweightstats_in3DRK3_slc3v4: Subroutine to compute an spatial statistics value from a 3D RK matrix using 3rd dimension as 49 ! running one into a matrix of 3-variables slices of rank 4 using spatial weights 48 ! multi_spaceweightstats_in2DRKno_slc3v3: Subroutine to compute an spatial statistics value from a 2D RK matrix without 49 ! running one into a matrix of 3-variables slices of rank 3 using spatial weights 50 ! multi_spaceweightstats_in3DRK3_slc3v3: Subroutine to compute an spatial statistics value from a 3D RK matrix using 51 ! 3rd dimension as running one into a matrix of 3-variables slices of rank 3 using spatial weights 52 ! multi_spaceweightstats_in3DRK3_slc3v4: Subroutine to compute an spatial statistics value from a 3D RK matrix using 53 ! 3rd dimension as running one into a matrix of 3-variables slices of rank 4 using spatial weights 50 54 ! NcountR: Subroutine to count real values 51 55 ! paths_border: Subroutine to search the paths of a border field. … … 5638 5642 END SUBROUTINE spaceweightstats 5639 5643 5644 SUBROUTINE multi_spaceweightstats_in1DRKno_slc3v3(varin, Ngridsin, gridsin, percentages, varout, & 5645 di1, ds1, ds2, ds3, maxNgridsin) 5646 ! Subroutine to compute an spatial statistics value from a 1D RK matrix without running one into a 5647 ! matrix of 3-variables slices of rank 3 using spatial weights 5648 5649 IMPLICIT NONE 5650 5651 INTEGER, INTENT(in) :: di1, ds1, ds2, ds3 5652 INTEGER, INTENT(in) :: maxNgridsin 5653 INTEGER, DIMENSION(ds1,ds2,ds3), INTENT(in) :: Ngridsin 5654 INTEGER, DIMENSION(ds1,ds2,ds3,maxNgridsin,2), & 5655 INTENT(in) :: gridsin 5656 REAL(r_k), DIMENSION(di1), INTENT(in) :: varin 5657 REAL(r_k), INTENT(in), & 5658 DIMENSION(ds1,ds2,ds3,maxNgridsin) :: percentages 5659 REAL(r_k), DIMENSION(ds1,ds2,ds3,7), INTENT(out) :: varout 5660 5661 ! Local 5662 INTEGER :: i1, i2, i3, s1, s2, s3, iv 5663 INTEGER :: ii3, ss1, ss2, ss3 5664 INTEGER :: Ncounts, Nin 5665 CHARACTER(len=3) :: val1S, val2S 5666 CHARACTER(len=30) :: val3S 5667 REAL(r_k) :: minv, maxv, meanv, mean2v, stdv, medv 5668 REAL(r_k), DIMENSION(:), ALLOCATABLE :: pin 5669 INTEGER, DIMENSION(:,:), ALLOCATABLE :: gin 5670 REAL(r_k), DIMENSION(:), ALLOCATABLE :: svin 5671 REAL(r_k), DIMENSION(:), ALLOCATABLE :: vin 5672 5673 !!!!!!! Variables 5674 ! di1: length of dimensions of the 1D matrix of values 5675 ! ds[1-3]: length of dimensions of matrix with the slices 5676 ! maxNgridsin: maximum number of grid points from the 3D matrix in any slice 5677 ! varin: 1D RK variable to be used 5678 ! Ngridsin: number of grids from 3D RK matrix for each slice 5679 ! gridsin: coordinates of grids of the 3D RK matrix B to matrix of slices 5680 ! percentages: weights as percentages of space of 3D RK matrix for each slice 5681 !!!!! 5682 ! Available spatial statistics to compute inside each slice using values from 3D RK matrix 5683 ! 'min': minimum value 5684 ! 'max': maximum value 5685 ! 'mean': space weighted mean value 5686 ! 'mean2': space weighted quadratic mean value 5687 ! 'stddev': space weighted standard deviation value 5688 ! 'median': median value 5689 ! 'count': percentage of the space of matrix A covered by each different value of matrix B 5690 ! varout: output statistical variable 5691 5692 fname = 'multi_spaceweightstats_in1DRKno_slc3v3' 5693 5694 varout = fillval64 5695 5696 ss1 = 8 + 1 5697 ss2 = 5 + 1 5698 ss3 = 3 + 1 5699 ii3 = 1 + 1 5700 5701 ! Let's be efficient? 5702 varout = fillVal64 5703 DO s1 =1, ds1 5704 DO s2 =1, ds2 5705 DO s3 =1, ds3 5706 Nin = Ngridsin(s1,s2,s3) 5707 ! Computing along d3 5708 IF (Nin > 1) THEN 5709 IF (ALLOCATED(gin)) DEALLOCATE(gin) 5710 ALLOCATE(gin(Nin,2)) 5711 IF (ALLOCATED(pin)) DEALLOCATE(pin) 5712 ALLOCATE(pin(Nin)) 5713 IF (ALLOCATED(vin)) DEALLOCATE(vin) 5714 ALLOCATE(vin(Nin)) 5715 IF (ALLOCATED(svin)) DEALLOCATE(svin) 5716 ALLOCATE(svin(Nin)) 5717 gin = gridsin(s1,s2,s3,1:Nin,:) 5718 pin = percentages(s1,s2,s3,1:Nin) 5719 5720 ! Getting the values 5721 DO iv=1, Nin 5722 i1 = gin(iv,1) 5723 vin(iv) = varin(i1) 5724 END DO 5725 minv = fillVal64 5726 maxv = -fillVal64 5727 meanv = zeroRK 5728 mean2v = zeroRK 5729 stdv = zeroRK 5730 minv = MINVAL(vin) 5731 maxv = MAXVAL(vin) 5732 meanv = SUM(vin*pin) 5733 mean2v = SUM(vin**2*pin) 5734 DO iv=1,Nin 5735 stdv = stdv + ( (meanv - vin(iv))*pin(iv) )**2 5736 END DO 5737 stdv = SQRT(stdv) 5738 svin = vin(:) 5739 CALL SortR_K(svin, Nin) 5740 medv = svin(INT(Nin/2)) 5741 varout(s1,s2,s3,1) = minv 5742 varout(s1,s2,s3,2) = maxv 5743 varout(s1,s2,s3,3) = meanv 5744 varout(s1,s2,s3,4) = mean2v 5745 varout(s1,s2,s3,5) = stdv 5746 varout(s1,s2,s3,6) = medv 5747 varout(s1,s2,s3,7) = Nin*1. 5748 ELSE 5749 i1 = gridsin(s1,s2,s3,1,1) 5750 varout(s1,s2,s3,1) = varin(i1) 5751 varout(s1,s2,s3,2) = varin(i1) 5752 varout(s1,s2,s3,3) = varin(i1) 5753 varout(s1,s2,s3,4) = varin(i1)*varin(i1) 5754 varout(s1,s2,s3,5) = zeroRK 5755 varout(s1,s2,s3,6) = varin(i1) 5756 varout(s1,s2,s3,7) = Nin*1. 5757 END IF 5758 END DO 5759 END DO 5760 END DO 5761 5762 IF (ALLOCATED(gin)) DEALLOCATE(gin) 5763 IF (ALLOCATED(pin)) DEALLOCATE(pin) 5764 IF (ALLOCATED(vin)) DEALLOCATE(vin) 5765 IF (ALLOCATED(svin)) DEALLOCATE(svin) 5766 5767 RETURN 5768 5769 END SUBROUTINE multi_spaceweightstats_in1DRKno_slc3v3 5770 5771 SUBROUTINE multi_spaceweightstats_in2DRKno_slc3v3(varin, Ngridsin, gridsin, percentages, varout, & 5772 di1, di2, ds1, ds2, ds3, maxNgridsin) 5773 ! Subroutine to compute an spatial statistics value from a 2D RK matrix without running one into a 5774 ! matrix of 3-variables slices of rank 3 using spatial weights 5775 5776 IMPLICIT NONE 5777 5778 INTEGER, INTENT(in) :: di1, di2, ds1, ds2, ds3 5779 INTEGER, INTENT(in) :: maxNgridsin 5780 INTEGER, DIMENSION(ds1,ds2,ds3), INTENT(in) :: Ngridsin 5781 INTEGER, DIMENSION(ds1,ds2,ds3,maxNgridsin,2), & 5782 INTENT(in) :: gridsin 5783 REAL(r_k), DIMENSION(di1,di2), INTENT(in) :: varin 5784 REAL(r_k), INTENT(in), & 5785 DIMENSION(ds1,ds2,ds3,maxNgridsin) :: percentages 5786 REAL(r_k), DIMENSION(ds1,ds2,ds3,7), INTENT(out) :: varout 5787 5788 ! Local 5789 INTEGER :: i1, i2, i3, s1, s2, s3, iv 5790 INTEGER :: ii3, ss1, ss2, ss3 5791 INTEGER :: Ncounts, Nin 5792 CHARACTER(len=3) :: val1S, val2S 5793 CHARACTER(len=30) :: val3S 5794 REAL(r_k) :: minv, maxv, meanv, mean2v, stdv, medv 5795 REAL(r_k), DIMENSION(:), ALLOCATABLE :: pin 5796 INTEGER, DIMENSION(:,:), ALLOCATABLE :: gin 5797 REAL(r_k), DIMENSION(:), ALLOCATABLE :: svin 5798 REAL(r_k), DIMENSION(:), ALLOCATABLE :: vin 5799 5800 !!!!!!! Variables 5801 ! di1, di2: length of dimensions of the 2D matrix of values 5802 ! ds[1-3]: length of dimensions of matrix with the slices 5803 ! maxNgridsin: maximum number of grid points from the 3D matrix in any slice 5804 ! varin: 2D RK variable to be used 5805 ! Ngridsin: number of grids from 3D RK matrix for each slice 5806 ! gridsin: coordinates of grids of the 3D RK matrix B to matrix of slices 5807 ! percentages: weights as percentages of space of 3D RK matrix for each slice 5808 !!!!! 5809 ! Available spatial statistics to compute inside each slice using values from 3D RK matrix 5810 ! 'min': minimum value 5811 ! 'max': maximum value 5812 ! 'mean': space weighted mean value 5813 ! 'mean2': space weighted quadratic mean value 5814 ! 'stddev': space weighted standard deviation value 5815 ! 'median': median value 5816 ! 'count': percentage of the space of matrix A covered by each different value of matrix B 5817 ! varout: output statistical variable 5818 5819 fname = 'multi_spaceweightstats_in2DRKno_slc3v3' 5820 5821 varout = fillval64 5822 5823 ss1 = 8 + 1 5824 ss2 = 5 + 1 5825 ss3 = 3 + 1 5826 ii3 = 1 + 1 5827 5828 ! Let's be efficient? 5829 varout = fillVal64 5830 DO s1 =1, ds1 5831 DO s2 =1, ds2 5832 DO s3 =1, ds3 5833 Nin = Ngridsin(s1,s2,s3) 5834 ! Computing along d3 5835 IF (Nin > 1) THEN 5836 IF (ALLOCATED(gin)) DEALLOCATE(gin) 5837 ALLOCATE(gin(Nin,2)) 5838 IF (ALLOCATED(pin)) DEALLOCATE(pin) 5839 ALLOCATE(pin(Nin)) 5840 IF (ALLOCATED(vin)) DEALLOCATE(vin) 5841 ALLOCATE(vin(Nin)) 5842 IF (ALLOCATED(svin)) DEALLOCATE(svin) 5843 ALLOCATE(svin(Nin)) 5844 gin = gridsin(s1,s2,s3,1:Nin,:) 5845 pin = percentages(s1,s2,s3,1:Nin) 5846 5847 ! Getting the values 5848 DO iv=1, Nin 5849 i1 = gin(iv,1) 5850 i2 = gin(iv,2) 5851 vin(iv) = varin(i1,i2) 5852 END DO 5853 minv = fillVal64 5854 maxv = -fillVal64 5855 meanv = zeroRK 5856 mean2v = zeroRK 5857 stdv = zeroRK 5858 minv = MINVAL(vin) 5859 maxv = MAXVAL(vin) 5860 meanv = SUM(vin*pin) 5861 mean2v = SUM(vin**2*pin) 5862 DO iv=1,Nin 5863 stdv = stdv + ( (meanv - vin(iv))*pin(iv) )**2 5864 END DO 5865 stdv = SQRT(stdv) 5866 svin = vin(:) 5867 CALL SortR_K(svin, Nin) 5868 medv = svin(INT(Nin/2)) 5869 varout(s1,s2,s3,1) = minv 5870 varout(s1,s2,s3,2) = maxv 5871 varout(s1,s2,s3,3) = meanv 5872 varout(s1,s2,s3,4) = mean2v 5873 varout(s1,s2,s3,5) = stdv 5874 varout(s1,s2,s3,6) = medv 5875 varout(s1,s2,s3,7) = Nin*1. 5876 ELSE 5877 i1 = gridsin(s1,s2,s3,1,1) 5878 i2 = gridsin(s1,s2,s3,1,2) 5879 varout(s1,s2,s3,1) = varin(i1,i2) 5880 varout(s1,s2,s3,2) = varin(i1,i2) 5881 varout(s1,s2,s3,3) = varin(i1,i2) 5882 varout(s1,s2,s3,4) = varin(i1,i2)*varin(i1,i2) 5883 varout(s1,s2,s3,5) = zeroRK 5884 varout(s1,s2,s3,6) = varin(i1,i2) 5885 varout(s1,s2,s3,7) = Nin*1. 5886 END IF 5887 END DO 5888 END DO 5889 END DO 5890 5891 IF (ALLOCATED(gin)) DEALLOCATE(gin) 5892 IF (ALLOCATED(pin)) DEALLOCATE(pin) 5893 IF (ALLOCATED(vin)) DEALLOCATE(vin) 5894 IF (ALLOCATED(svin)) DEALLOCATE(svin) 5895 5896 RETURN 5897 5898 END SUBROUTINE multi_spaceweightstats_in2DRKno_slc3v3 5899 5640 5900 SUBROUTINE multi_spaceweightstats_in3DRK3_slc3v3(varin, Ngridsin, gridsin, percentages, varout, & 5641 5901 di1, di2, di3, ds1, ds2, ds3, maxNgridsin) … … 5746 6006 END DO 5747 6007 ELSE 6008 i1 = gridsin(s1,s2,s3,1,1) 6009 i2 = gridsin(s1,s2,s3,1,2) 5748 6010 varout(s1,s2,s3,:,1) = varin(i1,i2,:) 5749 6011 varout(s1,s2,s3,:,2) = varin(i1,i2,:) … … 5872 6134 END DO 5873 6135 ELSE 6136 i1 = gridsin(s1,s2,s3,s4,1,1) 6137 i2 = gridsin(s1,s2,s3,s4,1,2) 5874 6138 varout(s1,s2,s3,s4,:,1) = varin(i1,i2,:) 5875 6139 varout(s1,s2,s3,s4,:,2) = varin(i1,i2,:)
Note: See TracChangeset
for help on using the changeset viewer.
