GRIDMAN
grid managment library
test_index.f
Go to the documentation of this file.
1 C> @file tests/test_index.f
2 C> Unit test for the data type GRIDMAN_INDEX and it's methods
3 C GRIDMAN, grid managment library. Author: Vladislav Kotov, v.kotov@fz-juelich.de
4 
5 ! Copyright (c) 2017 Forschungszentrum Juelich GmbH
6 ! Vladislav Kotov
7 !
8 ! This file is part of GRIDMAN.
9 !
10 ! GRIDMAN is free software: you can redistribute it and/or modify
11 ! it under the terms of the GNU General Public License as published by
12 ! the Free Software Foundation, either version 3 of the License, or
13 ! (at your option) any later version.
14 !
15 ! GRIDMAN is distributed in the hope that it will be useful,
16 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ! GNU General Public License for more details.
19 !
20 ! You should have received a copy of the GNU General Public License
21 ! along with GRIDMAN. If not, see <http://www.gnu.org/licenses/>.
22 
23  PROGRAM test_index
24  USE gridman
25  USE gridman_lib
26  IMPLICIT NONE
27 
28  TYPE(gridman_index) :: ind1,ind2,ind,ind0
29  INTEGER :: ierr,res,is,itmp2
30  INTEGER(GRIDMAN_SP),ALLOCATABLE :: elmap(:)
31  INTEGER(GRIDMAN_SP) ::itmp,n,nmin,nmax,i
32  INTEGER(GRIDMAN_SP) :: elmap_test(8)=(/4,5,6,7,0,1,2,3/)
33  INTEGER(GRIDMAN_SP),PARAMETER :: n12_1=7,n12_2=7
34  INTEGER(GRIDMAN_SP) :: imap12_1(2,n12_1),imap12_2(2,n12_2)
35 
36  gridman_dbg=.true.
37  gridman_dbg=.false.
38 
39 C-----------------------------------------------------------
40 C TEST CHECK
41 C-----------------------------------------------------------
42 
43  CALL gridman_index_check(ind1,res,ierr)
44  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
45  IF(res.NE.1) THEN
46  WRITE(*,*) "ERORR in GRIDMAN_INDEX_CHECK"
47  WRITE(*,*) " expected value 1, RES ",res
48  stop "TEST_INDEX TERMINATED"
49  END IF
50 
51  n=9
52  CALL gridman_index_create121(ind1,n,ierr)
53  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
54 
55  CALL gridman_index_check(ind1,res,ierr)
56  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
57  IF(res.NE.0) THEN
58  WRITE(*,*) "ERORR in GRIDMAN_INDEX_CHECK"
59  WRITE(*,*) " expected value 0, RES ",res
60  stop "TEST_INDEX TERMINATED"
61  END IF
62 
63  itmp2=ind1%NINDEX
64  ind1%NINDEX=0
65  CALL gridman_index_check(ind1,res,ierr)
66  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
67  IF(res.NE.2) THEN
68  WRITE(*,*) "ERORR in GRIDMAN_INDEX_CHECK"
69  WRITE(*,*) " expected value 2, RES ",res
70  stop "TEST_INDEX TERMINATED"
71  END IF
72  ind1%NINDEX=itmp2
73 
74  itmp=ind1%NELEMENTS
75  ind1%NELEMENTS=0
76  CALL gridman_index_check(ind1,res,ierr)
77  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
78  IF(res.NE.2) THEN
79  WRITE(*,*) "ERORR in GRIDMAN_INDEX_CHECK"
80  WRITE(*,*) " expected value 2, RES ",res
81  stop "TEST_INDEX TERMINATED"
82  END IF
83  ind1%NELEMENTS=itmp
84 
85  itmp2=ind1%NINDEX
86  ind1%NINDEX=2
87  CALL gridman_index_check(ind1,res,ierr)
88  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
89  IF(res.NE.4) THEN
90  WRITE(*,*) "ERORR in GRIDMAN_INDEX_CHECK"
91  WRITE(*,*) " expected value 4, RES ",res
92  stop "TEST_INDEX TERMINATED"
93  END IF
94  ind1%NINDEX=itmp2
95 
96  itmp=ind1%NELEMENTS
97  ind1%NELEMENTS=5
98  CALL gridman_index_check(ind1,res,ierr)
99  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
100  IF(res.NE.4) THEN
101  WRITE(*,*) "ERORR in GRIDMAN_INDEX_CHECK"
102  WRITE(*,*) " expected value 4, RES ",res
103  stop "TEST_INDEX TERMINATED"
104  END IF
105  ind1%NELEMENTS=itmp
106 
107 C-----------------------------------------------------------
108 C TEST WRITE/READ
109 C-----------------------------------------------------------
110 
111  gridman_check=.true.
112 
113  OPEN(3,file='test.ind',status='REPLACE',iostat=is)
114  IF(is.NE.0) stop "ERROR: CAN'T CREATE test.ind"
115  CALL gridman_index_write(ind1,3,ierr)
116  CLOSE(3)
117  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
118 
119  OPEN(3,file='test.ind',status='OLD',iostat=is)
120  IF(is.NE.0) stop "ERROR: CAN'T OPEN test.ind"
121  CALL gridman_index_read(ind2,3,ierr)
122  CLOSE(3)
123  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
124 
125  CALL gridman_index_compare(ind1,ind2,res,ierr)
126  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
127  IF(res.NE.0) THEN
128  WRITE(*,*) "ERORR in GRIDMAN_INDEX_COMPARE after READ/WRITE"
129  WRITE(*,*) " expected value 0, RES ",res
130  stop "TEST_INDEX TERMINATED"
131  END IF
132 
133  CALL gridman_index_deallocate(ind1,ierr)
134  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
135  CALL gridman_index_deallocate(ind2,ierr)
136  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
137 
138 C-----------------------------------------------------------
139 C TEST WRITE/READ WHEN NINDEX>1
140 C-----------------------------------------------------------
141 
142  n=7
143  CALL gridman_index_allocate(ind1,2,n,ierr)
144  ind1%INDEXES(:,1)=(/6,6,7/)
145  ind1%INDEXES(:,2)=(/2,1,1/)
146  ind1%INDEXES(:,3)=(/2,2,1/)
147  ind1%INDEXES(:,4)=(/5,3,2/)
148  ind1%INDEXES(:,5)=(/4,4,3/)
149  ind1%INDEXES(:,6)=(/4,5,3/)
150  ind1%INDEXES(:,7)=(/4,6,3/)
151  ind1%DESCRIPTION="2D"
152  ind1%COLUMNS(1)="IX"
153  ind1%COLUMNS(2)="IY"
154 
155  OPEN(3,file='test.ind',status='REPLACE',iostat=is)
156  IF(is.NE.0) stop "ERROR: CAN'T CREATE test.ind"
157  CALL gridman_index_write(ind1,3,ierr)
158  CLOSE(3)
159  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
160 
161  OPEN(3,file='test.ind',status='OLD',iostat=is)
162  IF(is.NE.0) stop "ERROR: CAN'T OPEN test.ind"
163  CALL gridman_index_read(ind2,3,ierr)
164  CLOSE(3)
165  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
166 
167  CALL gridman_index_compare(ind1,ind2,res,ierr)
168  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
169  IF(res.NE.0) THEN
170  WRITE(*,*) "ERORR in GRIDMAN_INDEX_COMPARE"
171  WRITE(*,*) " expected value 0, RES ",res
172  stop "TEST_INDEX TERMINATED"
173  END IF
174 
175 C-----------------------------------------------------------
176 C TEST COMPARE
177 C-----------------------------------------------------------
178 
179  gridman_check=.false.
180 
181  itmp2=ind2%NINDEX
182  ind2%NINDEX=1
183  CALL gridman_index_compare(ind1,ind2,res,ierr)
184  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
185  IF(res.NE.1) THEN
186  WRITE(*,*) "ERORR in GRIDMAN_INDEX_COMPARE"
187  WRITE(*,*) " expected value 1, RES ",res
188  stop "TEST_INDEX TERMINATED"
189  END IF
190  ind2%NINDEX=itmp2
191 
192  itmp=ind1%NELEMENTS
193  ind1%NELEMENTS=10
194  CALL gridman_index_compare(ind1,ind2,res,ierr)
195  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
196  IF(res.NE.1) THEN
197  WRITE(*,*) "ERORR in GRIDMAN_INDEX_COMPARE"
198  WRITE(*,*) " expected value 1, RES ",res
199  stop "TEST_INDEX TERMINATED"
200  END IF
201  ind1%NELEMENTS=itmp
202 
203  gridman_check=.true.
204 
205  itmp=ind2%INDEXES(0,2)
206  ind2%INDEXES(0,2)=-1
207  CALL gridman_index_compare(ind1,ind2,res,ierr)
208  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
209  IF(res.NE.2) THEN
210  WRITE(*,*) "ERORR in GRIDMAN_INDEX_COMPARE"
211  WRITE(*,*) " expected value 2, RES ",res
212  stop "TEST_INDEX TERMINATED"
213  END IF
214  ind2%INDEXES(0,2)=itmp
215 
216  itmp=ind1%INDEXES(2,3)
217  ind1%INDEXES(2,3)=0
218  CALL gridman_index_compare(ind1,ind2,res,ierr)
219  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
220  IF(res.NE.3) THEN
221  WRITE(*,*) "ERORR in GRIDMAN_INDEX_COMPARE"
222  WRITE(*,*) " expected value 3, RES ",res
223  stop "TEST_INDEX TERMINATED"
224  END IF
225  ind1%INDEXES(2,3)=itmp
226 
227  ind2%DESCRIPTION='leer'
228  CALL gridman_index_compare(ind1,ind2,res,ierr)
229  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
230  IF(res.NE.4) THEN
231  WRITE(*,*) "ERORR in GRIDMAN_INDEX_COMPARE"
232  WRITE(*,*) " expected value 4, RES ",res
233  stop "TEST_INDEX TERMINATED"
234  END IF
235 
236  CALL gridman_index_copy(ind2,ind1,ierr)
237  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
238 
239 C-----------------------------------------------------------
240 C TEST GRIDMAN_INDEX_ELMAP
241 C-----------------------------------------------------------
242 
243  CALL gridman_index_elmap(elmap,nmin,nmax,ind2,ierr)
244  IF(ierr.NE.150) THEN
245  WRITE(*,*) "ERORR in GRIDMAN_INDEX_CHECK"
246  WRITE(*,*) " expected value 150, IERR ",ierr
247  stop "TEST_INDEX TERMINATED"
248  END IF
249 
250  ind2%INDEXES(:,1)=(/6,1,1/)
251  ind2%INDEXES(:,2)=(/7,2,1/)
252  ind2%INDEXES(:,3)=(/8,2,1/)
253  ind2%INDEXES(:,4)=(/1,2,2/)
254  ind2%INDEXES(:,5)=(/2,4,3/)
255  ind2%INDEXES(:,6)=(/3,5,4/)
256  ind2%INDEXES(:,7)=(/4,6,3/)
257  CALL gridman_index_elmap(elmap,nmin,nmax,ind2,ierr)
258  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
259 
260  WRITE(*,*) " NMIN, NMAX ",nmin,nmax
261  DO i=nmin,nmax
262 cc IF(ELMAP(I).GT.0)
263 cc w WRITE(*,*) I,IND2%INDEXES(1:,ELMAP(I))
264  IF(elmap(i).NE.elmap_test(i)) THEN
265  WRITE(*,*) "ERORR in GRIDMAN_INDEX_ELMAP: ",
266  w "incorrect ELMAP generated"
267  WRITE(*,*) " ELMAP ",elmap
268  stop "TEST_INDEX TERMINATED"
269  END IF
270  END DO
271 
272 C-----------------------------------------------------------
273 C TEST GRIDMAN_INDEX_TRANSFORM
274 C-----------------------------------------------------------
275  imap12_1(1,:)=(/1,2,3,4,5,6,7/)
276  imap12_1(2,:)=(/1,2,3,4,5,6,7/)
277  CALL gridman_index_transform(ind2,ind1,imap12_1,n12_1,ierr)
278  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
279  CALL gridman_index_compare(ind1,ind2,res,ierr)
280  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
281  IF(res.NE.0) THEN
282  WRITE(*,*) "ERORR in GRIDMAN_INDEX_TRANSFORM"
283  WRITE(*,*) " expected value 0, RES ",res
284  stop "TEST_INDEX TERMINATED"
285  END IF
286 
287 
288  imap12_2(1,:)=(/2,4,4, 7,6,6,6/)
289  imap12_2(2,:)=(/1,2,3,-1,1,2,3/)
290  CALL gridman_index_transform(ind2,ind1,imap12_2,n12_2,ierr)
291  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
292  IF(ind2%NELEMENTS.NE.11) THEN
293  WRITE(*,*) "ERORR in GRIDMAN_INDEX_TRANSFORM"
294  WRITE(*,*) " Incorrect resulting index"
295  WRITE(*,*) " Expected NELEMENTS=11, actual value ",
296  w ind2%NELEMENTS
297  stop "TEST_INDEX TERMINATED"
298  END IF
299  IF( any( ind2%INDEXES(0,:).NE.
300  f (/1,2,3,1,1,2,3,2,3,2,3/) ) ) THEN
301  WRITE(*,*) "ERORR in GRIDMAN_INDEX_TRANSFORM"
302  WRITE(*,*) " Incorrect resulting index"
303  WRITE(*,*) " IND2%INDEXES(0,:) ",ind2%INDEXES(0,:)
304  WRITE(*,*) " Expected ",(/1,2,3,1,1,2,3,2,3,2,3/)
305  stop "TEST_INDEX TERMINATED"
306  END IF
307  IF( any( ind2%INDEXES(1,:).NE.
308  f (/6,6,6,1,2,4,4,5,5,6,6/) ) ) THEN
309  WRITE(*,*) "ERORR in GRIDMAN_INDEX_TRANSFORM"
310  WRITE(*,*) " Incorrect resulting index"
311  WRITE(*,*) " IND2%INDEXES(1,:) ",ind2%INDEXES(1,:)
312  WRITE(*,*) " Expected ",(/6,6,6,1,2,4,4,5,5,6,6/)
313  stop "TEST_INDEX TERMINATED"
314  END IF
315  IF( any( ind2%INDEXES(2,:).NE.
316  f (/7,7,7,1,1,3,3,3,3,3,3/) ) ) THEN
317  WRITE(*,*) "ERORR in GRIDMAN_INDEX_TRANSFORM"
318  WRITE(*,*) " Incorrect resulting index"
319  WRITE(*,*) " IND2%INDEXES(2,:) ",ind2%INDEXES(2,:)
320  WRITE(*,*) " Expected ",(/6,6,6,1,3,4,4,5,5,6,6/)
321  stop "TEST_INDEX TERMINATED"
322  END IF
323 
324  OPEN(3,file='transform.ind',status='REPLACE',iostat=is)
325  IF(is.NE.0) stop "ERROR: CAN'T CREATE transform.ind"
326  CALL gridman_index_write(ind2,3,ierr)
327  CLOSE(3)
328  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
329 
330 C-----------------------------------------------------------
331 C TEST GRIDMAN_INDEX_MERGE
332 C-----------------------------------------------------------
333  n=6
334  CALL gridman_index_allocate(ind0,2,n,ierr)
335  ind0%INDEXES(:,1)=(/6,6,7/)
336  ind0%INDEXES(:,2)=(/2,1,1/)
337  ind0%INDEXES(:,3)=(/2,2,1/)
338  ind0%INDEXES(:,4)=(/5,3,2/)
339  ind0%INDEXES(:,5)=(/4,5,3/)
340  ind0%INDEXES(:,6)=(/4,6,3/)
341  ind0%DESCRIPTION="2D"
342  ind0%COLUMNS(1)="IX"
343  ind0%COLUMNS(2)="IY"
344 
345  n=4
346  CALL gridman_index_allocate(ind1,2,n,ierr)
347  ind1%INDEXES(:,1)=(/6,6,7/)
348  ind1%INDEXES(:,2)=(/2,1,1/)
349  ind1%INDEXES(:,3)=(/2,2,1/)
350  ind1%INDEXES(:,4)=(/5,3,2/)
351  ind1%DESCRIPTION="2D"
352  ind1%COLUMNS(1)="IX"
353  ind1%COLUMNS(2)="IY"
354 
355  n=3
356  CALL gridman_index_allocate(ind2,2,n,ierr)
357  ind2%INDEXES(:,1)=(/2,4,3/)
358  ind2%INDEXES(:,2)=(/4,5,3/)
359  ind2%INDEXES(:,3)=(/4,6,3/)
360  ind2%DESCRIPTION="2D"
361  ind2%COLUMNS(1)="IX"
362  ind2%COLUMNS(2)="IR"
363 
364  CALL gridman_index_merge(ind,ind1,ind2,ierr)
365  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
366 
367  OPEN(3,file='merged.ind',status='REPLACE',iostat=is)
368  IF(is.NE.0) stop "ERROR: CAN'T CREATE merged.ind"
369  CALL gridman_index_write(ind,3,ierr)
370  CLOSE(3)
371  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
372 
373  ind%COLUMNS(2)="IY"
374  CALL gridman_index_compare(ind,ind0,res,ierr)
375  IF(ierr.NE.0) stop "TEST_INDEX TERMINATE"
376  IF(res.NE.0) THEN
377  WRITE(*,*) "ERORR in GRIDMAN_INDEX_MERGE"
378  WRITE(*,*) "Indexes must be equal"
379  stop "TEST_INDEX TERMINATED"
380  END IF
381 
382  CALL gridman_index_deallocate(ind,ierr)
383  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
384  CALL gridman_index_deallocate(ind0,ierr)
385  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
386 
387  CALL gridman_index_deallocate(ind1,ierr)
388  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
389  CALL gridman_index_deallocate(ind2,ierr)
390  IF(ierr.NE.0) stop "TEST_INDEX TERMINATED"
391 
392  WRITE(*,*) "TEST_INDEX COMPLETED"
393 
394  END PROGRAM test_index
395 
396 
gridman::gridman_check
logical, save, public gridman_check
Switch to enforce extra checks of input parameters.
Definition: gridman.f:133
gridman_index_create121
subroutine gridman_index_create121(INDEX, N, IERR)
Create index table for "one-to-one" mapping.
Definition: index.f:733
gridman_index_check
subroutine gridman_index_check(INDEX, RES, IERR)
Check index object.
Definition: index.f:149
gridman_lib
Explicit interfaces to GRIDMAN subroutines and functions.
Definition: gridman.f:251
gridman_index_compare
subroutine gridman_index_compare(INDEX1, INDEX2, RES, IERR)
Compare two index objects.
Definition: index.f:423
gridman_index_copy
subroutine gridman_index_copy(INDEX2, INDEX1, IERR)
Create a copy of the index object.
Definition: index.f:538
gridman_index_transform
subroutine gridman_index_transform(INDEX2, INDEX1, IMAP12, N12, IERR)
Transform indices of elements - IND(0,:)
Definition: index.f:788
gridman_index_allocate
subroutine gridman_index_allocate(INDEX, NINDEX, NELEMENTS, IERR)
Allocate index object.
Definition: index.f:28
gridman::gridman_dbg
logical, save, public gridman_dbg
Switch for debugging mode.
Definition: gridman.f:122
gridman_index_elmap
subroutine gridman_index_elmap(ELMAP, NMIN, NMAX, INDEX, IERR)
Create an aray which maps elements into the table of indices.
Definition: index.f:643
gridman::gridman_index
Data-type which stores indices defined on the grid cells or edges.
Definition: gridman.f:144
gridman_index_merge
subroutine gridman_index_merge(INDEX, INDEX1, INDEX2, IERR)
Merge INDEX2 into INDEX1.
Definition: index.f:880
gridman_index_read
subroutine gridman_index_read(INDEX, IIN, IERR)
Read index object from file.
Definition: index.f:327
gridman_index_write
subroutine gridman_index_write(INDEX, IOUT, IERR)
Save index object in a file.
Definition: index.f:234
gridman
Definition of data types, global constants and variables.
Definition: gridman.f:83
gridman_index_deallocate
subroutine gridman_index_deallocate(INDEX, IERR)
Allocate index object.
Definition: index.f:98
Generated on Thu Oct 5 2017 09:49:57 for GRIDMAN by   doxygen 1.8.9.1