libsim  Versione 7.2.6
grid_transform_test.f90
1 ! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2 ! authors:
3 ! Davide Cesari <dcesari@arpa.emr.it>
4 ! Paolo Patruno <ppatruno@arpa.emr.it>
5 
6 ! This program is free software; you can redistribute it and/or
7 ! modify it under the terms of the GNU General Public License as
8 ! published by the Free Software Foundation; either version 2 of
9 ! the License, or (at your option) any later version.
10 
11 ! This program is distributed in the hope that it will be useful,
12 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ! GNU General Public License for more details.
15 
16 ! You should have received a copy of the GNU General Public License
17 ! along with this program. If not, see <http://www.gnu.org/licenses/>.
18 ! Programma di test per il module simple_stat
19 ! migliorare a piacimento
20 PROGRAM grid_transform_test
23 IMPLICIT NONE
24 
25 
26 INTEGER,PARAMETER :: ninterv=5, nval=7
27 REAL :: interv_lower(ninterv)=(/20.,20.,rmiss,20.,20./), &
28  interv_upper(ninterv)=(/40.,rmiss,40.,20.,10./), &
29  interv_testval(nval)=(/5.,10.,15.,20.,30.,40.,50./)
30 REAL :: interv_ffresult(nval,ninterv)=reshape((/ &
31  0,0,0,0,1,0,0, &
32  0,0,0,0,1,1,1, &
33  1,1,1,1,1,0,0, &
34  0,0,0,0,0,0,0, &
35  0,0,0,0,0,0,0 &
36  /), (/nval,ninterv/))
37 REAL :: &
38 interv_ftresult(nval,ninterv)=reshape((/ &
39  0,0,0,0,1,1,0, &
40  0,0,0,0,1,1,1, &
41  1,1,1,1,1,1,0, &
42  0,0,0,0,0,0,0, &
43  0,0,0,0,0,0,0 &
44  /), (/nval,ninterv/)), &
45 interv_tfresult(nval,ninterv)=reshape((/ &
46  0,0,0,1,1,0,0, &
47  0,0,0,1,1,1,1, &
48  1,1,1,1,1,0,0, &
49  0,0,0,0,0,0,0, &
50  0,0,0,0,0,0,0 &
51  /), (/nval,ninterv/)), &
52 interv_ttresult(nval,ninterv)=reshape((/ &
53  0,0,0,1,1,1,0, &
54  0,0,0,1,1,1,1, &
55  1,1,1,1,1,1,0, &
56  0,0,0,1,0,0,0, &
57  0,0,0,0,0,0,0 &
58  /), (/nval,ninterv/)), &
59  tmpresult(nval,ninterv)
60 
61 INTEGER :: i, j
62 TYPE(interval_info) :: interv, interv_init
63 
64 print*,'=== Testing grid_transform module ==='
65 
66 print*,'Checking intervals a<x<b'
67 DO j = 1, ninterv
68  interv = interval_info_new(interv_gt=interv_lower(j), interv_lt=interv_upper(j))
69  DO i = 1, nval
70  tmpresult(i,j) = interval_info_valid(interv, interv_testval(i))
71  ENDDO
72 ENDDO
73 CALL interv_print_result(tmpresult, interv_ffresult)
74 
75 print*,'Checking intervals a<x<=b'
76 DO j = 1, ninterv
77  interv = interval_info_new(interv_gt=interv_lower(j), interv_le=interv_upper(j))
78  DO i = 1, nval
79  tmpresult(i,j) = interval_info_valid(interv, interv_testval(i))
80  ENDDO
81 ENDDO
82 CALL interv_print_result(tmpresult, interv_ftresult)
83 
84 print*,'Checking intervals a<=x<b'
85 DO j = 1, ninterv
86  interv = interval_info_new(interv_ge=interv_lower(j), interv_lt=interv_upper(j))
87  DO i = 1, nval
88  tmpresult(i,j) = interval_info_valid(interv, interv_testval(i))
89  ENDDO
90 ENDDO
91 CALL interv_print_result(tmpresult, interv_tfresult)
92 
93 print*,'Checking intervals a<=x<=b'
94 DO j = 1, ninterv
95  interv = interval_info_new(interv_ge=interv_lower(j), interv_le=interv_upper(j))
96  DO i = 1, nval
97  tmpresult(i,j) = interval_info_valid(interv, interv_testval(i))
98  ENDDO
99 ENDDO
100 CALL interv_print_result(tmpresult, interv_ttresult)
101 
102 CONTAINS
103 
104 SUBROUTINE interv_print_result(res, ref)
105 REAL,INTENT(in) :: res(nval,ninterv), ref(nval,ninterv)
106 
107 IF (count(res == ref) == nval*ninterv) THEN
108 ELSE
109 
110  DO j = 1, ninterv
111  DO i = 1, nval
112  IF (res(i,j) /= ref(i,j)) THEN
113  print*,'Failing: ',interv_lower(j),'<(=)',interv_testval(i),'<(=)',interv_upper(j)
114  print*,'Result: ',res(i,j),' Reference: ',ref(i,j)
115  ENDIF
116  ENDDO
117  ENDDO
118  CALL exit(1)
119 ENDIF
120 
121 END SUBROUTINE interv_print_result
122 
123 
124 
125 END PROGRAM grid_transform_test
Module for defining transformations between rectangular georeferenced grids and between grids and spa...
Definitions of constants and functions for working with missing values.

Generated with Doxygen.