GRIDMAN
grid managment library
test_grid1.f
Go to the documentation of this file.
1 C> @file tests/test_grid1.f
2 C> Unit test for the data type GRIDMAN_GRID 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_grid1
24  USE gridman
25  USE gridman_lib
26  IMPLICIT NONE
27 
28  WRITE(*,*) "GRIDMAN_DBG ",gridman_dbg
29  WRITE(*,*) "GRIDMAN_TOL ",gridman_tol
30  WRITE(*,*) "GRIDMAN_UNIT ",gridman_unit
31  WRITE(*,*) "GRIDMAN_CHEK ",gridman_check
32 
33  gridman_dbg=.false.
34  gridman_check=.true.
35 
36  CALL test_check
37 
38  CALL test_compare !_COPY is tested here as well
39 
40  CALL test_readwrite
41 
42  CALL test_take
43 
44  CALL test_count
45 
46  WRITE(*,*) "TEST_GRID1 COMPLETED"
47 
48  END PROGRAM test_grid1
49 
50 C
51 C
52 C
53  SUBROUTINE test_count
54  USE gridman
55  USE gridman_lib
56  IMPLICIT NONE
57  TYPE(gridman_grid) :: grid
58  INTEGER :: ierr
59  INTEGER(GRIDMAN_SP) :: ncount
60 
61  CALL grid_example1(grid,ierr)
62  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
63 
64  CALL gridman_grid_count(grid,ncount,ierr)
65  IF(ierr.GT.0) stop "TEST_GRID1 TERMINATED"
66  IF(ncount.NE.10) THEN
67  WRITE(*,*) "ERORR in GRIDMAN_GRID_NCOUNT"
68  WRITE(*,*) "Expected value NCOUNT=10, NCOUNT ",ncount
69  stop "TEST_GRID1 TERMINATED"
70  END IF
71 
72  CALL gridman_grid_deallocate(grid,ierr)
73  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
74 
75  END SUBROUTINE test_count
76 
77 C
78 C
79 C
80  SUBROUTINE test_take
81  USE gridman
82  USE gridman_lib
83  IMPLICIT NONE
84 
85  TYPE(gridman_grid) :: grid,grid1
86  INTEGER(GRIDMAN_SP) :: ncells,nedges,npoints
87  INTEGER :: TYPE,res,ierr
88 
89  CALL grid_example1(grid,ierr)
90  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
91 
92  TYPE=grid%TYPE
93  ncells=grid%NCELLS
94  nedges=grid%NEDGES
95  npoints=grid%NPOINTS
96 
97  gridman_check=.false.
98 
99  CALL gridman_grid_allocate(grid1,TYPE,nedges,npoints,ncells,ierr)
100  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
101 
102  CALL gridman_grid_take(grid1,grid,ierr)
103  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
104 
105  CALL gridman_grid_compare(grid1,grid,res,ierr)
106  IF(res.NE.8.OR.ierr.NE.0) THEN
107  WRITE(*,*) "ERROR in GRIDMAN_GRID_TAKE"
108  stop "TEST_GRID1 TERMINATED"
109  END IF
110 
111  CALL gridman_grid_allocate(grid1,TYPE,nedges-1,
112  c npoints,ncells,ierr)
113  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
114  CALL gridman_grid_take(grid1,grid,ierr)
115  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
116 
117  CALL gridman_grid_allocate(grid1,TYPE,nedges+1,
118  c npoints,ncells,ierr)
119  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
120  CALL gridman_grid_take(grid1,grid,ierr)
121  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
122  grid1%NEDGES=grid1%NEDGES-1
123  CALL gridman_grid_compare(grid1,grid,res,ierr)
124  IF(res.NE.8.OR.ierr.NE.0) THEN
125  WRITE(*,*) "ERROR in GRIDMAN_GRID_TAKE"
126  stop "TEST_GRID1 TERMINATED"
127  END IF
128 
129  npoints=npoints-1
130  CALL gridman_grid_allocate(grid1,TYPE,nedges,
131  c npoints,ncells,ierr)
132  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
133  CALL gridman_grid_take(grid1,grid,ierr)
134  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
135 
136  npoints=npoints+2
137  CALL gridman_grid_allocate(grid1,TYPE,nedges,
138  c npoints,ncells,ierr)
139  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
140  CALL gridman_grid_take(grid1,grid,ierr)
141  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
142  grid1%NPOINTS=npoints-1
143  CALL gridman_grid_compare(grid1,grid,res,ierr)
144  IF(res.NE.8.OR.ierr.NE.0) THEN
145  WRITE(*,*) "ERROR in GRIDMAN_GRID_TAKE"
146  stop "TEST_GRID1 TERMINATED"
147  END IF
148 
149  CALL gridman_grid_deallocate(grid,ierr)
150  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
151  CALL gridman_grid_deallocate(grid1,ierr)
152  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
153 
154  gridman_check=.true.
155 
156  END SUBROUTINE test_take
157 
158 C
159 C
160 C
161  SUBROUTINE test_readwrite
162  USE gridman
163  USE gridman_lib
164  IMPLICIT NONE
165  TYPE(gridman_grid) :: grid,grid1
166  INTEGER(GRIDMAN_SP) :: itmp
167  INTEGER :: res,ierr,is
168 
169  CALL grid_example1(grid,ierr)
170  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
171 
172  itmp=grid%CELLS(2,1)
173  grid%CELLS(2,1)=11 !DAMAGE THE GRID
174  gridman_check=.true.
175  CALL gridman_grid_write(grid,'test.grd',ierr)
176  IF(ierr.NE.100) THEN
177  WRITE(*,*) "ERORR in GRIDMAN_GRID_WRITE"
178  WRITE(*,*) " expected value 100, IERR ",ierr
179  stop "TEST_GRID1 TERMINATED"
180  END IF
181  CALL gridman_grid_read(grid1,'testXX.grd',ierr)
182  IF(ierr.NE.300) THEN
183  WRITE(*,*) "ERORR in GRIDMAN_GRID_READ"
184  WRITE(*,*) " expected value 300, IERR ",ierr
185  stop "TEST_GRID1 TERMINATED"
186  END IF
187 
188  grid%CELLS(2,1)=itmp !RESTORE GRID
189  OPEN(3,file='test.grd',status='REPLACE',iostat=is)
190  IF(is.NE.0) stop "ERROR: CAN'T CREATE test.grd"
191  CALL gridman_grid_write(grid,3,ierr)
192  CLOSE(3)
193  IF(ierr.GT.0) stop "TEST_GRID1 TERMINATED"
194  OPEN(3,file='test.grd',status='OLD',iostat=is)
195  IF(is.NE.0) stop "ERROR: CAN'T OPEN test.grd"
196  CALL gridman_grid_read(grid1,3,ierr)
197  CLOSE(3)
198  IF(ierr.GT.0) stop "TEST_GRID1 TERMINATED"
199  CALL gridman_grid_compare(grid,grid1,res,ierr)
200  IF(res.NE.0) stop "TEST_GRID1 TERMINATED"
201 
202 C ONLY ONE EDGE INDEX
203  gridman_check=.false.
204  CALL gridman_index_deallocate(grid%EDGEINDEX(2),ierr)
205  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
206  grid%NEDGEINDEX=1
207 
208  OPEN(3,file='test.grd',status='REPLACE',iostat=is)
209  IF(is.NE.0) stop "ERROR: CAN'T CREATE test.grd"
210  CALL gridman_grid_write(grid,3,ierr)
211  CLOSE(3)
212  IF(ierr.GT.0) stop "TEST_GRID1 TERMINATED"
213  OPEN(3,file='test.grd',status='OLD',iostat=is)
214  IF(is.NE.0) stop "ERROR: CAN'T OPEN test.grd"
215  CALL gridman_grid_read(grid1,3,ierr)
216  CLOSE(3)
217  IF(ierr.GT.0) stop "TEST_GRID1 TERMINATED"
218  CALL gridman_grid_compare(grid,grid1,res,ierr)
219  IF(res.NE.0) stop "TEST_GRID1 TERMINATED"
220  gridman_check=.true.
221 
222 C NO EDGE INDEX
223  CALL gridman_index_deallocate(grid%EDGEINDEX(1),ierr)
224  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
225  DEALLOCATE(grid%EDGEINDEX)
226  grid%NEDGEINDEX=0
227 
228  OPEN(3,file='test.grd',status='REPLACE',iostat=is)
229  IF(is.NE.0) stop "ERROR: CAN'T CREATE test.grd"
230  CALL gridman_grid_write(grid,3,ierr)
231  CLOSE(3)
232  IF(ierr.GT.0) stop "TEST_GRID1 TERMINATED"
233  OPEN(3,file='test.grd',status='OLD',iostat=is)
234  IF(is.NE.0) stop "ERROR: CAN'T OPEN test.grd"
235  CALL gridman_grid_read(grid1,3,ierr)
236  CLOSE(3)
237  IF(ierr.GT.0) stop "TEST_GRID1 TERMINATED"
238  CALL gridman_grid_compare(grid,grid1,res,ierr)
239  IF(res.NE.0) stop "TEST_GRID1 TERMINATED"
240 
241 C ONLY ONE CELL INDEX
242  gridman_check=.false.
243  CALL gridman_index_deallocate(grid%CELLINDEX(2),ierr)
244  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
245  grid%NCELLINDEX=1
246 
247  OPEN(3,file='test.grd',status='REPLACE',iostat=is)
248  IF(is.NE.0) stop "ERROR: CAN'T CREATE test.grd"
249  CALL gridman_grid_write(grid,3,ierr)
250  CLOSE(3)
251  IF(ierr.GT.0) stop "TEST_GRID1 TERMINATED"
252  OPEN(3,file='test.grd',status='OLD',iostat=is)
253  IF(is.NE.0) stop "ERROR: CAN'T OPEN test.grd"
254  CALL gridman_grid_read(grid1,3,ierr)
255  CLOSE(3)
256  IF(ierr.GT.0) stop "TEST_GRID1 TERMINATED"
257  CALL gridman_grid_compare(grid,grid1,res,ierr)
258  IF(res.NE.0) stop "TEST_GRID1 TERMINATED"
259  gridman_check=.true.
260 
261 C NO CELL INDEX
262  gridman_check=.false.
263  CALL gridman_index_deallocate(grid%CELLINDEX(1),ierr)
264  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
265  DEALLOCATE(grid%CELLINDEX)
266  grid%NCELLINDEX=0
267 
268  OPEN(3,file='test.grd',status='REPLACE',iostat=is)
269  IF(is.NE.0) stop "ERROR: CAN'T CREATE test.grd"
270  CALL gridman_grid_write(grid,3,ierr)
271  CLOSE(3)
272  IF(ierr.GT.0) stop "TEST_GRID1 TERMINATED"
273  OPEN(3,file='test.grd',status='OLD',iostat=is)
274  IF(is.NE.0) stop "ERROR: CAN'T OPEN test.grd"
275  CALL gridman_grid_read(grid1,3,ierr)
276  CLOSE(3)
277  IF(ierr.GT.0) stop "TEST_GRID1 TERMINATED"
278  CALL gridman_grid_compare(grid,grid1,res,ierr)
279  IF(res.NE.0) stop "TEST_GRID1 TERMINATED"
280  gridman_check=.true.
281 
282  CALL gridman_grid_deallocate(grid,ierr)
283  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
284  CALL gridman_grid_deallocate(grid1,ierr)
285  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
286 
287  END SUBROUTINE test_readwrite
288 
289 C
290 C
291 C
292  SUBROUTINE test_compare
293  USE gridman
294  USE gridman_lib
295  IMPLICIT NONE
296  TYPE(gridman_grid) :: grid1,grid2,
297  t grid1_save,grid2_save
298  INTEGER :: ierr,res,itmp
299 
300  CALL grid_example1(grid1,ierr)
301  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
302  CALL grid_example1(grid2,ierr)
303  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
304 
305  gridman_check=.false.
306 
307  CALL gridman_grid_copy(grid1_save,grid1,ierr)
308  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
309  CALL gridman_grid_copy(grid2_save,grid2,ierr)
310  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
311 
312 C DIFFERENT GRID TYPES
313  grid1%TYPE=0
314  CALL gridman_grid_compare(grid1,grid2,res,ierr)
315  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
316  IF(res.NE.1) THEN
317  WRITE(*,*) "ERROR in GRIDMAN_GRID_COMP"
318  WRITE(*,*) " expected value 1, RES ",res
319  stop "TEST_GRID1 TERMINATED"
320  END IF
321  CALL gridman_grid_copy(grid1,grid1_save,ierr) !RESTORING GRID
322  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
323 
324 C DIFFERENT DIMENSIONS
325  grid2%NCELLS=1
326  CALL gridman_grid_compare(grid1,grid2,res,ierr)
327  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
328  IF(res.NE.2) THEN
329  WRITE(*,*) "ERROR in GRIDMAN_GRID_COMP"
330  WRITE(*,*) " expected value 2, RES ",res
331  stop "TEST_GRID1 TERMINATED"
332  END IF
333  CALL gridman_grid_copy(grid2,grid2_save,ierr) !RESTORING GRID
334  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
335 
336  grid1%NPOINTS=grid1%NPOINTS+1
337  CALL gridman_grid_compare(grid1,grid2,res,ierr)
338  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
339  IF(res.NE.2) THEN
340  WRITE(*,*) "ERROR in GRIDMAN_GRID_COMP"
341  WRITE(*,*) " expected value 2, RES ",res
342  stop "TEST_GRID1 TERMINATED"
343  END IF
344  CALL gridman_grid_copy(grid1,grid1_save,ierr) !RESTORING GRID
345  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
346 
347 C DIFFERENT TOPOLOGIES
348  grid2%CELLS(1,23)=grid2%CELLS(1,23)+1
349  CALL gridman_grid_compare(grid1,grid2,res,ierr)
350  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
351  IF(res.NE.3) THEN
352  WRITE(*,*) "ERROR in GRIDMAN_GRID_COMP"
353  WRITE(*,*) " expected value 3, RES ",res
354  stop "TEST_GRID1 TERMINATED"
355  END IF
356  CALL gridman_grid_copy(grid2,grid2_save,ierr) !RESTORING GRID
357  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
358 
359  grid1%POINTS(1,11)=grid1%POINTS(1,11)+1
360  CALL gridman_grid_compare(grid1,grid2,res,ierr)
361  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
362  IF(res.NE.4) THEN
363  WRITE(*,*) "ERROR in GRIDMAN_GRID_COMP"
364  WRITE(*,*) " expected value 4, RES ",res
365  stop "TEST_GRID1 TERMINATED"
366  END IF
367  CALL gridman_grid_copy(grid1,grid1_save,ierr) !RESTORING GRID
368  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
369 
370 C DIFFERENT UNITS
371  grid1%UNIT2SI=grid1%UNIT2SI*10.
372  CALL gridman_grid_compare(grid1,grid2,res,ierr)
373  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
374  IF(res.NE.5) THEN
375  WRITE(*,*) "ERROR in GRIDMAN_GRID_COMP"
376  WRITE(*,*) " expected value 5, RES ",res
377  stop "TEST_GRID1 TERMINATED"
378  END IF
379  CALL gridman_grid_copy(grid1,grid1_save,ierr) !RESTORING GRID
380  grid2%UNITS='meter'
381  CALL gridman_grid_compare(grid1,grid2,res,ierr)
382  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
383  IF(res.NE.5) THEN
384  WRITE(*,*) "ERROR in GRIDMAN_GRID_COMP"
385  WRITE(*,*) " expected value 5, RES ",res
386  stop "TEST_GRID1 TERMINATED"
387  END IF
388  CALL gridman_grid_copy(grid2,grid2_save,ierr) !RESTORING GRID
389  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
390 
391 C DIFFERENT COORDINATES
392  grid1%X(1,1)=grid1%X(1,1)+1.
393  CALL gridman_grid_compare(grid1,grid2,res,ierr)
394  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
395  IF(res.NE.6) THEN
396  WRITE(*,*) "ERROR in GRIDMAN_GRID_COMP"
397  WRITE(*,*) " expected value 6, RES ",res
398  stop "TEST_GRID1 TERMINATED"
399  END IF
400  CALL gridman_grid_copy(grid1,grid1_save,ierr) !RESTORING GRID
401  grid2%X(2,10)=grid2%X(2,10)-1.
402  CALL gridman_grid_compare(grid1,grid2,res,ierr)
403  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
404  IF(res.NE.6) THEN
405  WRITE(*,*) "ERROR in GRIDMAN_GRID_COMP"
406  WRITE(*,*) " expected value 6, RES ",res
407  stop "TEST_GRID1 TERMINATED"
408  END IF
409  CALL gridman_grid_copy(grid2,grid2_save,ierr) !RESTORING GRID
410  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
411 
412 C DIFFERENT DESCRIPTIONS
413  grid2%DESCRIPTION="EXAMPLE 2"
414  CALL gridman_grid_compare(grid1,grid2,res,ierr)
415  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
416  IF(res.NE.7) THEN
417  WRITE(*,*) "ERROR in GRIDMAN_GRID_COMP"
418  WRITE(*,*) " expected value 7, RES ",res
419  stop "TEST_GRID1 TERMINATED"
420  END IF
421  CALL gridman_grid_copy(grid2,grid2_save,ierr) !RESTORING GRID
422  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
423 
424 C DIFFERENT EDGE INDICES
425  grid1%EDGEINDEX(2)%INDEXES(1,1)=100
426  CALL gridman_grid_compare(grid1,grid2,res,ierr)
427  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
428  IF(res.NE.8) THEN
429  WRITE(*,*) "ERROR in GRIDMAN_GRID_COMP"
430  WRITE(*,*) " expected value 8, RES ",res
431  stop "TEST_GRID1 TERMINATED"
432  END IF
433  CALL gridman_grid_copy(grid1,grid1_save,ierr) !RESTORING GRID
434  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
435 
436 C DIFFERENT NUMBER OF EDGE INDICES
437  itmp=grid1%NEDGEINDEX
438  grid1%NEDGEINDEX=1
439  CALL gridman_grid_compare(grid1,grid2,res,ierr)
440  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
441  IF(res.NE.8) THEN
442  WRITE(*,*) "ERROR in GRIDMAN_GRID_COMP"
443  WRITE(*,*) " expected value 8, RES ",res
444  stop "TEST_GRID1 TERMINATED"
445  END IF
446  grid1%NEDGEINDEX=itmp
447 
448 C DIFFERENT CELL INDICES
449  grid2%CELLINDEX(2)%INDEXES(1,1)=100
450  CALL gridman_grid_compare(grid1,grid2,res,ierr)
451  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
452  IF(res.NE.9) THEN
453  WRITE(*,*) "ERROR in GRIDMAN_GRID_COMP"
454  WRITE(*,*) " expected value 9, RES ",res
455  stop "TEST_GRID1 TERMINATED"
456  END IF
457  CALL gridman_grid_copy(grid2,grid2_save,ierr) !RESTORING GRID
458  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
459 
460 C DIFFERENT NUMBER OF CELL INDICES
461  itmp=grid1%NCELLINDEX
462  grid1%NCELLINDEX=1
463  CALL gridman_grid_compare(grid1,grid2,res,ierr)
464  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
465  IF(res.NE.9) THEN
466  WRITE(*,*) "ERROR in GRIDMAN_GRID_COMP"
467  WRITE(*,*) " expected value 9, RES ",res
468  stop "TEST_GRID1 TERMINATED"
469  END IF
470  grid1%NCELLINDEX=itmp
471 
472 C TEST CONSISTENCY OF COPY AND COMPARE
473  CALL gridman_grid_copy(grid2,grid2_save,ierr) !RESTORING GRID
474  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
475  CALL gridman_grid_compare(grid2,grid2_save,res,ierr)
476  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
477  IF(res.NE.0) THEN
478  WRITE(*,*) "ERROR in GRIDMAN_GRID_COMP"
479  WRITE(*,*) " expected value 0, RES ",res
480  stop "TEST_GRID1 TERMINATED"
481  END IF
482 
483  CALL gridman_grid_deallocate(grid1_save,ierr)
484  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
485  CALL gridman_grid_deallocate(grid2_save,ierr)
486  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
487 
488  gridman_check=.true.
489 
490  END SUBROUTINE test_compare
491 
492 C
493 C
494 C
495  SUBROUTINE test_check
496 
497  USE gridman
498  USE gridman_lib
499  IMPLICIT NONE
500  TYPE(gridman_grid) :: grid
501  INTEGER :: ierr,res,itmp
502 
503  CALL gridman_grid_check(grid,res,ierr)
504  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
505  IF(res.NE.1) THEN
506  WRITE(*,*) "ERORR in GRIDMAN_GRID_CHECK"
507  WRITE(*,*) " expected value 1, RES ",res
508  stop "TEST_GRID1 TERMINATED"
509  END IF
510 
511  CALL grid_example1(grid,ierr)
512  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
513 
514 C CORRECT GRID
515  CALL gridman_grid_check(grid,res,ierr)
516  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
517  IF(res.NE.0) stop "TEST_GRID1 TERMINATED"
518 
519 C CORRUPTED NCELLS
520  grid%NCELLS=-1
521  CALL gridman_grid_check(grid,res,ierr)
522  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
523  IF(res.NE.2) THEN
524  WRITE(*,*) "ERORR in GRIDMAN_GRID_CHECK"
525  WRITE(*,*) " expected value 2, RES ",res
526  stop "TEST_GRID1 TERMINATED"
527  END IF
528  CALL grid_example1(grid,ierr) !RESTORING GRID
529  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
530 C CORRUPTED NEDGES
531  grid%NEDGES=0
532  CALL gridman_grid_check(grid,res,ierr)
533  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
534  IF(res.NE.2) THEN
535  WRITE(*,*) "ERORR in GRIDMAN_GRID_CHECK"
536  WRITE(*,*) " expected value 2, RES ",res
537  stop "TEST_GRID1 TERMINATED"
538  END IF
539  CALL grid_example1(grid,ierr) !RESTORING GRID
540  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
541 C CORRUPTED EDIM
542  grid%EDIM=0
543  CALL gridman_grid_check(grid,res,ierr)
544  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
545  IF(res.NE.2) THEN
546  WRITE(*,*) "ERORR in GRIDMAN_GRID_CHECK"
547  WRITE(*,*) " expected value 2, RES ",res
548  stop "TEST_GRID1 TERMINATED"
549  END IF
550  CALL grid_example1(grid,ierr) !RESTORING GRID
551  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
552 C CORRUPTED PDIM
553  grid%PDIM=-1
554  CALL gridman_grid_check(grid,res,ierr)
555  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
556  IF(res.NE.2) THEN
557  WRITE(*,*) "ERORR in GRIDMAN_GRID_CHECK"
558  WRITE(*,*) " expected value 2, RES ",res
559  stop "TEST_GRID1 TERMINATED"
560  END IF
561  CALL grid_example1(grid,ierr) !RESTORING GRID
562  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
563 C MISMATCH OF DIMENSIONS
564  grid%NEDGES=grid%NEDGES+1
565  CALL gridman_grid_check(grid,res,ierr)
566  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
567  IF(res.NE.3) THEN
568  WRITE(*,*) "ERORR in GRIDMAN_GRID_CHECK"
569  WRITE(*,*) " expected value 3, RES ",res
570  stop "TEST_GRID1 TERMINATED"
571  END IF
572  CALL grid_example1(grid,ierr) !RESTORING GRID
573  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
574  grid%EDIM=grid%EDIM+1
575  CALL gridman_grid_check(grid,res,ierr)
576  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
577  IF(res.NE.3) THEN
578  WRITE(*,*) "ERORR in GRIDMAN_GRID_CHECK"
579  WRITE(*,*) " expected value 3, RES ",res
580  stop "TEST_GRID1 TERMINATED"
581  END IF
582  CALL grid_example1(grid,ierr) !RESTORING GRID
583  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
584  grid%NPOINTS=grid%NPOINTS+1
585  CALL gridman_grid_check(grid,res,ierr)
586  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
587  IF(res.NE.3) THEN
588  WRITE(*,*) "ERORR in GRIDMAN_GRID_CHECK"
589  WRITE(*,*) " expected value 3, RES ",res
590  stop "TEST_GRID1 TERMINATED"
591  END IF
592  CALL grid_example1(grid,ierr) !RESTORING GRID
593  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
594  grid%PDIM=grid%PDIM+1
595  CALL gridman_grid_check(grid,res,ierr)
596  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
597  IF(res.NE.3) THEN
598  WRITE(*,*) "ERORR in GRIDMAN_GRID_CHECK"
599  WRITE(*,*) " expected value 3, RES ",res
600  stop "TEST_GRID1 TERMINATED"
601  END IF
602  CALL grid_example1(grid,ierr) !RESTORING GRID
603  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
604 C CELL INDICES OUT OF BOUNDS
605  grid%CELLS(2,2)=11
606  grid%CELLS(1,2)=-11
607  CALL gridman_grid_check(grid,res,ierr)
608  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
609  IF(res.NE.4) THEN
610  WRITE(*,*) "ERORR in GRIDMAN_GRID_CHECK"
611  WRITE(*,*) " expected value 4, RES ",res
612  stop "TEST_GRID1 TERMINATED"
613  END IF
614  CALL grid_example1(grid,ierr) !RESTORING GRID
615  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
616 C DUPLICATE CELL INDICES
617  grid%CELLS(2,23)=10
618  grid%CELLS(1,23)=10
619  CALL gridman_grid_check(grid,res,ierr)
620  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
621  IF(res.NE.5) THEN
622  WRITE(*,*) "ERORR in GRIDMAN_GRID_CHECK"
623  WRITE(*,*) " expected value 5, RES ",res
624  stop "TEST_GRID1 TERMINATED"
625  END IF
626  CALL grid_example1(grid,ierr) !RESTORING GRID
627  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
628 C WRONG NCELLS
629  grid%NCELLS=11
630  CALL gridman_grid_check(grid,res,ierr)
631  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
632  IF(res.NE.6) THEN
633  WRITE(*,*) "ERORR in GRIDMAN_GRID_CHECK"
634  WRITE(*,*) " expected value 6, RES ",res
635  stop "TEST_GRID1 TERMINATED"
636  END IF
637  CALL grid_example1(grid,ierr) !RESTORING GRID
638  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
639 C POINT INDEX IS OUT OF BOUNDS
640  grid%POINTS(2,1)=0
641  CALL gridman_grid_check(grid,res,ierr)
642  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
643  IF(res.NE.7) THEN
644  WRITE(*,*) "ERORR in GRIDMAN_GRID_CHECK"
645  WRITE(*,*) " expected value 7, RES ",res
646  stop "TEST_GRID1 TERMINATED"
647  END IF
648  CALL grid_example1(grid,ierr) !RESTORING GRID
649  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
650 C INCORRECT UNIT SCALE
651  grid%UNIT2SI=0.
652  CALL gridman_grid_check(grid,res,ierr)
653  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
654  IF(res.NE.8) THEN
655  WRITE(*,*) "ERORR in GRIDMAN_GRID_CHECK"
656  WRITE(*,*) " expected value 8, RES ",res
657  stop "TEST_GRID1 TERMINATED"
658  END IF
659  CALL grid_example1(grid,ierr) !RESTORING GRID
660  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
661 C EDGE INDICES
662  itmp=grid%NEDGEINDEX
663  grid%NEDGEINDEX=0
664  CALL gridman_grid_check(grid,res,ierr)
665  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
666  IF(res.NE.9) THEN
667  WRITE(*,*) "ERORR in GRIDMAN_GRID_CHECK"
668  WRITE(*,*) " expected value 9, RES ",res
669  stop "TEST_GRID1 TERMINATED"
670  END IF
671  grid%NEDGEINDEX=itmp
672  grid%EDGEINDEX%NINDEX=-1
673  CALL gridman_grid_check(grid,res,ierr)
674  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
675  IF(res.NE.9) THEN
676  WRITE(*,*) "ERORR in GRIDMAN_GRID_CHECK"
677  WRITE(*,*) " expected value 9, RES ",res
678  stop "TEST_GRID1 TERMINATED"
679  END IF
680  CALL grid_example1(grid,ierr) !RESTORING GRID
681  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
682 C CELL INDICES
683  itmp=grid%NCELLINDEX
684  grid%NCELLINDEX=0
685  CALL gridman_grid_check(grid,res,ierr)
686  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
687  IF(res.NE.10) THEN
688  WRITE(*,*) "ERORR in GRIDMAN_GRID_CHECK"
689  WRITE(*,*) " expected value 10, RES ",res
690  stop "TEST_GRID1 TERMINATED"
691  END IF
692  grid%NCELLINDEX=itmp
693  grid%CELLINDEX%NINDEX=-1
694  CALL gridman_grid_check(grid,res,ierr)
695  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
696  IF(res.NE.10) THEN
697  WRITE(*,*) "ERORR in GRIDMAN_GRID_CHECK"
698  WRITE(*,*) " expected value 10, RES ",res
699  stop "TEST_GRID1 TERMINATED"
700  END IF
701  CALL grid_example1(grid,ierr) !RESTORING GRID
702  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
703 
704  CALL gridman_grid_metadata(grid,6,ierr)
705  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
706 
707  CALL gridman_grid_deallocate(grid,ierr)
708  IF(ierr.NE.0) stop "TEST_GRID1 TERMINATED"
709 
710  END SUBROUTINE test_check
gridman::gridman_check
logical, save, public gridman_check
Switch to enforce extra checks of input parameters.
Definition: gridman.f:133
gridman_grid_check
subroutine gridman_grid_check(GRID, RES, IERR)
Check consistency of the grid data.
Definition: grid1.f:289
gridman::gridman_unit
integer, save, public gridman_unit
Index of the standard output unit.
Definition: gridman.f:116
gridman::gridman_tol
real(gridman_dp), save, public gridman_tol
Tolerance parameter which is used to compare two real numbers.
Definition: gridman.f:127
gridman_lib
Explicit interfaces to GRIDMAN subroutines and functions.
Definition: gridman.f:251
gridman_grid_allocate
subroutine gridman_grid_allocate(GRID, TYPE, NEDGES, NPOINTS, NCELLS, IERR, NEDGEINDEX, NCELLINDEX)
Allocate GRIDMAN_GRID object.
Definition: grid1.f:30
gridman_grid_take
subroutine gridman_grid_take(GRID2, GRID1, IERR)
Take data from one grid object to another.
Definition: grid1.f:1283
gridman_grid_count
subroutine gridman_grid_count(GRID, NCOUNT, IERR)
Return the number of cells plus the number of edges not belonging to any cell.
Definition: grid1.f:1360
gridman::gridman_grid
Data-type which describes a grid as a set of edges, methods in grid.f.
Definition: gridman.f:168
gridman_grid_deallocate
subroutine gridman_grid_deallocate(GRID, IERR)
Deallocate grid object.
Definition: grid1.f:184
gridman_grid_copy
subroutine gridman_grid_copy(GRID2, GRID1, IERR)
Create a copy of the grid object.
Definition: grid1.f:981
gridman::gridman_dbg
logical, save, public gridman_dbg
Switch for debugging mode.
Definition: gridman.f:122
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
gridman_grid_compare
subroutine gridman_grid_compare(GRID1, GRID2, RES, IERR)
Compare two grid objects.
Definition: grid1.f:1068
Generated on Thu Oct 5 2017 09:49:57 for GRIDMAN by   doxygen 1.8.9.1