GRIDMAN
grid managment library
tria.f
Go to the documentation of this file.
1 C> @file formats/tria.f
2 C> Read/write for EIRENE triangular grid
3 C GRIDMAN, grid managment library. Author: Vladislav Kotov, v.kotov@fz-juelich.de
4 C>
5 C> \todo To add reading of fort.33 in S.Lisgo's format
6 C>
7 
8 ! Copyright (c) 2017 Forschungszentrum Juelich GmbH
9 ! Vladislav Kotov
10 !
11 ! This file is part of GRIDMAN.
12 !
13 ! GRIDMAN is free software: you can redistribute it and/or modify
14 ! it under the terms of the GNU General Public License as published by
15 ! the Free Software Foundation, either version 3 of the License, or
16 ! (at your option) any later version.
17 !
18 ! GRIDMAN is distributed in the hope that it will be useful,
19 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ! GNU General Public License for more details.
22 !
23 ! You should have received a copy of the GNU General Public License
24 ! along with GRIDMAN. If not, see <http://www.gnu.org/licenses/>.
25 
26 C**********************************************************************************************
27 C> Read EIRENE triangular grid from fort.33-35, return set of arrays
28 C>
29 C> WARNING: arrays XYTRIAN, NECKE, NCHBAR, NSEITE must NOT be allocated -
30 C> they are allocated inside the subroutine.
31 C> Arrays which already exist will be re-allocated
32 C>
33 C> GRIDMAN_TRIA_READ_ARRAY and GRIDMAN_TRIA_READ_GRID
34 C> are combined in the interface GRIDMAN_TRIA_READ
35 C**********************************************************************************************
36  SUBROUTINE gridman_tria_read_array(FNAMES,NRKNOT,NTRII,XYTRIAN,
37  s necke,nchbar,nseite,itri,ierr)
38  USE gridman,ONLY:gridman_dp,gridman_sp,gridman_unit,gridman_dbg
39  IMPLICIT NONE
40  INTRINSIC len_trim
41 C> Strungs with names of three input files
42 C>
43 C> If FNAMES has zero length than standard names are used: fort.33, fort.34, fort.35
44  CHARACTER(*) :: FNAMES(3)
45 C> Number of nodes
46  INTEGER(GRIDMAN_SP),INTENT(OUT) :: NRKNOT
47 C> Number of triangles
48  INTEGER(GRIDMAN_SP),INTENT(OUT) :: NTRII
49 C> Coordinates of the nodes XYTRIAN(2,NRKNOT)
50 C>
51 C> XYTRIAN(1,:) is X coordinate, XYTRIAN(2,:) is Y coordinate,
52  REAL(GRIDMAN_DP),ALLOCATABLE :: XYTRIAN(:,:)
53 C> Indices of nodes for each triangle, NECKE(3,NTRII)
54  INTEGER(GRIDMAN_SP),ALLOCATABLE :: NECKE(:,:)
55 C> Indices of neighbour cells for each triangle, NCHBAR(3,NTRII)
56  INTEGER(GRIDMAN_SP),ALLOCATABLE :: NCHBAR(:,:)
57 C> Indices of sides of neighbour cells (for each triangle), NSEITE(3,NTRII)
58  INTEGER(GRIDMAN_SP),ALLOCATABLE :: NSEITE(:,:)
59 C> Tags from fort.35, ITRI(5,NTRII)
60 C>
61 C> ITRI(1,:) and ITRI(2,:) are IXTRI and IYTRI.
62 C> ITRI(3:5,:) are tags of each side of the triange.
63  INTEGER(GRIDMAN_SP),ALLOCATABLE :: ITRI(:,:)
64 C> Error code
65  INTEGER,INTENT(OUT) :: IERR
66 
67  INTEGER(GRIDMAN_SP) :: I,J,NTRII35
68  INTEGER :: IS,SL,IO
69 
70  IF(gridman_dbg)
71  f WRITE(gridman_unit,*) "Starting GRIDMAN_TRIA_READ_ARRAY"
72 
73  ierr=0
74  ntrii=0
75  nrknot=0
76 C
77 C READ FORT.33: COORDINATES OF THE NODES
78 C
79  sl=len_trim(fnames(1))
80  IF(sl.GT.0) THEN
81  OPEN (unit=33,file=fnames(1),status='OLD',
82  o access='SEQUENTIAL',form='FORMATTED',iostat=io)
83  ELSE
84  OPEN (unit=33,status='OLD',access='SEQUENTIAL',
85  o form='FORMATTED',iostat=io)
86  END IF
87  IF(io.NE.0) THEN
88  ierr=300
89  IF(sl.GT.0) THEN
90  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_READ_ARRAY: ",
91  o "can not open ",fnames(1)(1:sl)," (fort.33)"
92  ELSE
93  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_READ_ARRAY: ",
94  o "can not open fort.33"
95  END IF
96  RETURN
97  END IF
98 
99  READ(33,*,iostat=io) nrknot
100  IF(io.NE.0) GOTO 203
101  IF(ALLOCATED(xytrian)) DEALLOCATE(xytrian)
102  ALLOCATE(xytrian(2,nrknot),stat=is)
103  IF(is.NE.0) THEN
104  ierr=200
105  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_READ_ARRAY: ",
106  w "can not perform allocation (33)"
107  WRITE(gridman_unit,*) " NRKNOT ",nrknot
108  nrknot=0
109  CLOSE(33)
110  RETURN
111  END IF
112 
113  READ(33,*,iostat=io) (xytrian(1,i),i=1,nrknot)
114  IF(io.NE.0) GOTO 203
115  READ(33,*,iostat=io) (xytrian(2,i),i=1,nrknot)
116  IF(io.NE.0) GOTO 203
117 
118  CLOSE(33)
119 
120 C
121 C READ FORT.34: TABLE OF CELLS
122 C
123  sl=len_trim(fnames(2))
124  IF(sl.GT.0) THEN
125  OPEN (unit=34,file=fnames(2),status='OLD',
126  o access='SEQUENTIAL',form='FORMATTED',iostat=io)
127  ELSE
128  OPEN (unit=34,status='OLD',access='SEQUENTIAL',
129  o form='FORMATTED',iostat=io)
130  END IF
131  IF(io.NE.0) THEN
132  ierr=300
133  IF(sl.GT.0) THEN
134  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_READ_ARRAY: ",
135  o "can not open ",fnames(2)(1:sl)," (fort.34)"
136  ELSE
137  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_READ_ARRAY: ",
138  o "can not open fort.34"
139  END IF
140  ntrii=0
141  nrknot=0
142  RETURN
143  END IF
144 
145  READ(34,*,iostat=io) ntrii
146  IF(io.NE.0) GOTO 204
147 
148  IF(ALLOCATED(necke)) DEALLOCATE(necke)
149  ALLOCATE(necke(3,ntrii))
150  IF(is.NE.0) THEN
151  ierr=200
152  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_READ_ARRAY: ",
153  w "can not perform allocation (34)"
154  WRITE(gridman_unit,*) " NTRII ",ntrii
155  CLOSE(34)
156  ntrii=0
157  nrknot=0
158  RETURN
159  END IF
160 
161  DO i=1,ntrii
162  READ(34,*,iostat=io) j,necke(1,i),necke(2,i),necke(3,i)
163  IF(io.NE.0) GOTO 204
164  END DO
165 
166  CLOSE(34)
167 C
168 C READ FORT.35: TABLE OF NEIGHBOURS
169 C
170  sl=len_trim(fnames(3))
171  IF(sl.GT.0) THEN
172  OPEN (unit=35,file=fnames(3),status='OLD',
173  o access='SEQUENTIAL',form='FORMATTED',iostat=io)
174  ELSE
175  OPEN (unit=35,status='OLD',access='SEQUENTIAL',
176  o form='FORMATTED',iostat=io)
177  END IF
178  IF(io.NE.0) THEN
179  ierr=300
180  IF(sl.GT.0) THEN
181  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_READ_ARRAY: ",
182  o "can not open ",fnames(3)(1:sl)," (fort.35)"
183  ELSE
184  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_READ_ARRAY: ",
185  o "can not open fort.35"
186  END IF
187  ntrii=0
188  nrknot=0
189  RETURN
190  END IF
191 
192  READ(35,*,iostat=io) ntrii35
193  IF(io.NE.0) GOTO 204
194  IF(ntrii.NE.ntrii35) THEN
195  ierr=300
196  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_READ_ARRAY: ",
197  o "fort.34 and fort.35 have different dimensions"
198  WRITE(gridman_unit,*) "NTRII, NTRII2 ",ntrii,ntrii35
199  CLOSE(35)
200  ntrii=0
201  nrknot=0
202  RETURN
203  END IF
204 
205  IF(ALLOCATED(nchbar)) DEALLOCATE(nchbar)
206  IF(ALLOCATED(nseite)) DEALLOCATE(nseite)
207  IF(ALLOCATED(itri)) DEALLOCATE(itri)
208  ALLOCATE(nchbar(3,ntrii),nseite(3,ntrii),itri(5,ntrii),stat=is)
209  IF(is.NE.0) THEN
210  ierr=200
211  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_READ_ARRAY: ",
212  w "can not perform allocation (35)"
213  WRITE(gridman_unit,*) " NTRII ",ntrii
214  CLOSE(35)
215  ntrii=0
216  nrknot=0
217  RETURN
218  END IF
219 
220  DO i=1,ntrii
221  READ(35,*,iostat=io)
222  r j,nchbar(1,i),nseite(1,i),itri(3,i),
223  r nchbar(2,i),nseite(2,i),itri(4,i),
224  r nchbar(3,i),nseite(3,i),itri(5,i),
225  r itri(1,i),itri(2,i)
226  IF(io.NE.0) GOTO 205
227  END DO
228 
229  CLOSE(35)
230 
231  IF(gridman_dbg)
232  f WRITE(gridman_unit,*) "GRIDMAN_TRIA_READ_ARRAY finished"
233 
234  RETURN
235 
236  203 CLOSE(33)
237  ierr=300
238  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_READ_ARRAY: ",
239  o "can not read fort.33"
240  ntrii=0
241  nrknot=0
242  RETURN
243  204 CLOSE(34)
244  ierr=300
245  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_READ_ARRAY: ",
246  o "can not read fort.34"
247  ntrii=0
248  nrknot=0
249  RETURN
250  205 CLOSE(35)
251  ierr=300
252  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_READ_ARRAY: ",
253  o "can not read fort.35"
254  ntrii=0
255  nrknot=0
256  RETURN
257 
258  END SUBROUTINE gridman_tria_read_array
259 
260 C**********************************************************************************************
261 C> Write EIRENE triangular grid - defined as set of arrays - into fort.33-35
262 C>
263 C> Output of GRIDMAN_TRIA_READ is input of GRIDMAN_TRIA_WRITE
264 C>
265 C> GRIDMAN_TRIA_WRITE_ARRAY and GRIDMAN_TRIA_WRITE_GRID
266 C> are combined in the interface GRIDMAN_TRIA_WRITE
267 C**********************************************************************************************
268  SUBROUTINE gridman_tria_write_array(FNAMES,NRKNOT,NTRII,XYTRIAN,
269  s necke,nchbar,nseite,itri,ierr)
270  USE gridman,ONLY:gridman_dp,gridman_sp,gridman_unit,gridman_dbg
271  IMPLICIT NONE
272 C> Strungs with names of three input files
273 C>
274 C> If FNAMES has zero length than standard names are used: fort.33, fort.34, fort.35
275  CHARACTER(*) :: FNAMES(3)
276 C> Number of nodes
277  INTEGER(GRIDMAN_SP),INTENT(IN) :: NRKNOT
278 C> Number of triangles
279  INTEGER(GRIDMAN_SP),INTENT(IN) :: NTRII
280 C> Coordinates of the nodes
281 C>
282 C> XYTRIAN(1,:) is X coordinate, XYTRIAN(2,:) is Y coordinate,
283  REAL(GRIDMAN_DP),INTENT(IN) :: XYTRIAN(2,nrknot)
284 C> Indices of nodes for each triangle
285  INTEGER(GRIDMAN_SP),INTENT(IN) :: NECKE(3,ntrii)
286 C> Indices of neighbour cells for each triangle
287  INTEGER(GRIDMAN_SP),INTENT(IN) :: NCHBAR(3,ntrii)
288 C> Indices of sides of neighbour cells (for each triangle)
289  INTEGER(GRIDMAN_SP),INTENT(IN) :: NSEITE(3,ntrii)
290 C> Tags for fort.35
291 C>
292 C> ITRI(1,:) and ITRI(2,:) are IXTRI and IYTRI.
293 C> ITRI(3:5,:) are tags of each side of the triangle
294  INTEGER(GRIDMAN_SP),INTENT(IN) :: ITRI(5,ntrii)
295 C> Error code
296  INTEGER,INTENT(OUT) :: IERR
297 
298  INTEGER(GRIDMAN_SP) :: I
299  INTEGER :: IO,SL
300 
301  IF(gridman_dbg)
302  f WRITE(gridman_unit,*) "Starting GRIDMAN_TRIA_WRITE_ARRAY"
303 
304  ierr=0
305 C
306 C WRITE FORT.33: COORDINATES OF THE CORNERS
307 C
308  sl=len_trim(fnames(1))
309  IF(sl.GT.0) THEN
310  OPEN (unit=33,file=fnames(1),status='REPLACE',
311  o access='SEQUENTIAL',form='FORMATTED',iostat=io)
312  ELSE
313  OPEN (unit=33,file='fort.33',status='REPLACE',
314  o access='SEQUENTIAL',form='FORMATTED',iostat=io)
315  END IF
316  IF(io.NE.0) THEN
317  ierr=300
318  IF(sl.GT.0) THEN
319  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_WRITE_ARRAY: ",
320  o "can not open ",fnames(1)(1:sl)," (fort.33)"
321  ELSE
322  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_WRITE_ARRAY: ",
323  o "can not open fort.33"
324  END IF
325  RETURN
326  END IF
327 
328  WRITE(33,'(I12)',iostat=io) nrknot
329 
330  WRITE(33,'(4E19.7)',iostat=io) (xytrian(1,i),i=1,nrknot)
331  IF(io.NE.0) GOTO 203
332  WRITE(33,'(4E19.7)',iostat=io) (xytrian(2,i),i=1,nrknot)
333  IF(io.NE.0) GOTO 203
334  CLOSE(33)
335 C
336 C WRITE FORT.34: TABLE OF CELLS
337 C
338  sl=len_trim(fnames(2))
339  IF(sl.GT.0) THEN
340  OPEN (unit=34,file=fnames(2),status='REPLACE',
341  o access='SEQUENTIAL',form='FORMATTED',iostat=io)
342  ELSE
343  OPEN (unit=34,file='fort.34',status='REPLACE',
344  o access='SEQUENTIAL',form='FORMATTED',iostat=io)
345  END IF
346  IF(io.NE.0) THEN
347  ierr=300
348  IF(sl.GT.0) THEN
349  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_WRITE_ARRAY: ",
350  o "can not open ",fnames(2)(1:sl)," (fort.34)"
351  ELSE
352  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_WRITE_ARRAY: ",
353  o "can not open fort.34"
354  END IF
355  RETURN
356  END IF
357 
358  WRITE(34,'(I12)',iostat=io) ntrii
359  IF(io.NE.0) GOTO 204
360  DO i=1,ntrii
361  WRITE(34,303,iostat=io) i,necke(1,i),necke(2,i),necke(3,i)
362  IF(io.NE.0) GOTO 204
363  END DO
364 303 FORMAT(i6,2x,3i6,4x)
365  CLOSE(34)
366 C
367 C WRITE FORT.35: TABLE OF NEIGHBOURS
368 C
369  sl=len_trim(fnames(3))
370  IF(sl.GT.0) THEN
371  OPEN (unit=35,file=fnames(3),status='REPLACE',
372  o access='SEQUENTIAL',form='FORMATTED',iostat=io)
373  ELSE
374  OPEN (unit=35,file='fort.35',status='REPLACE',
375  o access='SEQUENTIAL',form='FORMATTED',iostat=io)
376  END IF
377  IF(io.NE.0) THEN
378  ierr=300
379  IF(sl.GT.0) THEN
380  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_WRITE_ARRAY: ",
381  o "can not open ",fnames(3)(1:sl)," (fort.35)"
382  ELSE
383  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_WRITE_ARRAY: ",
384  o "can not open fort.35"
385  END IF
386  RETURN
387  END IF
388 
389  WRITE(35,'(I12)',iostat=io) ntrii
390  IF(io.NE.0) GOTO 205
391 
392  DO i=1,ntrii
393  WRITE(35,304,iostat=io)
394  r i,nchbar(1,i),nseite(1,i),itri(3,i),
395  r nchbar(2,i),nseite(2,i),itri(4,i),
396  r nchbar(3,i),nseite(3,i),itri(5,i),
397  r itri(1,i),itri(2,i)
398  IF(io.NE.0) GOTO 205
399  END DO
400 304 FORMAT(i6,2x,4(3i6,4x))
401  CLOSE(35)
402 
403  IF(gridman_dbg)
404  f WRITE(gridman_unit,*) "GRIDMAN_TRIA_WRITE_ARRAY finished"
405 
406  RETURN
407 
408  203 CLOSE(33)
409  ierr=300
410  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_WRITE_ARRAY: ",
411  o "can not write fort.33"
412  RETURN
413  204 CLOSE(34)
414  ierr=300
415  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_READ_ARRAY: ",
416  o "can not write fort.34"
417  RETURN
418  205 CLOSE(35)
419  ierr=300
420  WRITE(gridman_unit,*) "ERROR in GRIDMAN_TRIA_READ_ARRAY: ",
421  o "can not write fort.35"
422  RETURN
423 
424  END SUBROUTINE gridman_tria_write_array
425 
426 
gridman::gridman_unit
integer, save, public gridman_unit
Index of the standard output unit.
Definition: gridman.f:116
gridman::gridman_dp
integer, parameter, public gridman_dp
Kind parameter for real numbers.
Definition: gridman.f:93
gridman_tria_write_array
subroutine gridman_tria_write_array(FNAMES, NRKNOT, NTRII, XYTRIAN, NECKE, NCHBAR, NSEITE, ITRI, IERR)
Write EIRENE triangular grid - defined as set of arrays - into fort.33-35.
Definition: tria.f:270
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::gridman_sp
integer, parameter, public gridman_sp
Kind parameter for integer numbers.
Definition: gridman.f:95
gridman_tria_read_array
subroutine gridman_tria_read_array(FNAMES, NRKNOT, NTRII, XYTRIAN, NECKE, NCHBAR, NSEITE, ITRI, IERR)
Read EIRENE triangular grid from fort.33-35, return set of arrays.
Definition: tria.f:38
Generated on Thu Oct 5 2017 09:49:56 for GRIDMAN by   doxygen 1.8.9.1