GRIDMAN
grid managment library
addsurf.f
Go to the documentation of this file.
1 C> @file formats/addsurf.f
2 C> Reading Additional Surfaces from EIRENE input file
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 C*********************************************************************************
24 C> Read planar (2D) Additional Surfaces from EIRENE input file
25 C>
26 C> This subroutine only reads surfaces defined as interval
27 C> on (X,Y) plane: 2.0<=RLBND<3.0
28 C>
29 C> WARNING: arrays X, Y, ISURF must NOT be allocated in advance,
30 C> they are allocated in the subroutine itself.
31 C> Arrays which already exist will be re-allocated
32 C>
33 C> GRIDMAN_ADDSURF2D_READ_ARRAY and GRIDMAN_ADDSURF2D_READ_GRID
34 C> are combined in the interface GRIDMAN_ADDSURF2D_READ
35 C*********************************************************************************
36  SUBROUTINE gridman_addsurf2d_read_array(FNAME,NSURF,X,Y,ISRF,IERR)
37  USE gridman,ONLY:gridman_dp,gridman_sp,gridman_dbg,gridman_unit
38  IMPLICIT NONE
39  INTRINSIC trim
40 C> String containing the name of input file
41  CHARACTER(*),INTENT(IN) :: FNAME
42 C> Number of read plane edges
43  INTEGER(GRIDMAN_SP),INTENT(OUT) :: NSURF
44 C> X coordinates of the edge vertices, X(2,NSURF)
45  REAL(GRIDMAN_DP),ALLOCATABLE :: X(:,:)
46 C> Y coordinates of the edge vertices, Y(2,NSURF)
47  REAL(GRIDMAN_DP),ALLOCATABLE :: Y(:,:)
48 C> Index of EIRENE surface, ISRF(NSURF)
49 C>
50 C> ISRF(I) is the index of EIRENE surface which corresponds
51 C> to edge I in arrays X,Y
52  INTEGER(GRIDMAN_SP),ALLOCATABLE :: ISRF(:)
53 C> Error code
54  INTEGER,INTENT(OUT) :: IERR
55 
56  INTEGER :: IO
57  INTEGER(GRIDMAN_SP) :: IAS,NLIM,ISF
58  CHARACTER(200) :: STR
59  REAL(GRIDMAN_DP) :: RLB,RTMP1,RTMP2
60  REAL(GRIDMAN_DP),ALLOCATABLE :: XB(:,:),YB(:,:)
61  LOGICAL,ALLOCATABLE :: LTAKE(:)
62 
63  IF(gridman_dbg)
64  w WRITE(gridman_unit,*) "Starting GRIDMAN_ADDSURF2D_READ_ARRAY"
65 
66  ierr=0
67  nsurf=0
68 
69  OPEN (unit=3,status='OLD',access='SEQUENTIAL',
70  o form='FORMATTED',file=fname,iostat=io)
71  IF(io.NE.0) THEN
72  ierr=300
73  WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF2D_READ_ARRAY: ",
74  o "can not open ",trim(fname)
75  RETURN
76  END IF
77 
78 C LOOK FOR BEGINNING OF THE ADDITIONAL SURFACES SECTION
79  10 READ(3,'(a200)',end=100,iostat=io) str
80  IF(io.NE.0) GOTO 200
81  IF(str(1:3).NE.'***') GOTO 10
82  IF(index(str,'3b').LT.1.AND.index(str,'3B').LT.1) GOTO 10
83 
84 C SKIP COMMENT BLOCK
85  20 READ(3,'(A200)',end=400,iostat=io) str
86  IF(io.NE.0) GOTO 200
87  IF(str(1:1).EQ.'*') GOTO 20
88 
89 C READ NUMBER OF SURFACES
90  IF(gridman_dbg) WRITE(gridman_unit,*) trim(str)
91  READ(str,*,iostat=io) nlim
92  IF(io.NE.0) GOTO 200
93 
94  IF(nlim.LT.1) THEN
95  WRITE(gridman_unit,*)
96  w "WARNING from GRIDMAN_ADDSURF2D_READ_ARRAY: ",
97  w "zero number of additional surfaces in file ",trim(fname)
98  WRITE(gridman_unit,*) " Nothing to return"
99  ierr=-100
100  CLOSE(3)
101  RETURN
102  END IF
103 
104  ALLOCATE(xb(2,nlim),yb(2,nlim),ltake(nlim),stat=io)
105  IF(io.NE.0) THEN
106  WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF2D_READ_ARRAY: ",
107  w "cannot allocate temporary arrays"
108  WRITE(gridman_unit,*) " NLIM ",nlim
109  ierr=200
110  CLOSE(3)
111  RETURN
112  END IF
113 
114  DO ias=1,nlim
115 C FIND BEGINNING OF THE INPUT CARD
116  30 READ(3,'(A200)',end=500,iostat=io) str
117  IF(io.NE.0) GOTO 300
118  IF(str(1:1).NE.'*') GOTO 30
119 C SKIP COMMENTS, CH1 AND CH2 CARDS
120  40 IF(gridman_dbg) WRITE(gridman_unit,*) trim(str)
121  READ(3,'(A200)',end=500,iostat=io) str
122  IF(io.NE.0) GOTO 300
123  IF(gridman_dbg) WRITE(gridman_unit,*) trim(str)
124  IF(str(1:1).EQ.'*'.OR.
125  f str(1:3).EQ.'CH1'.OR.str(1:3).EQ.'ch1'.OR.
126  f str(1:3).EQ.'CH2'.OR.str(1:3).EQ.'ch2') GOTO 40
127 C READ NUMBERS SECTION
128  READ(str,*,iostat=io) rlb,rtmp1,rtmp2
129  IF(io.NE.0) GOTO 300
130  READ(3,'(A200)',end=500,iostat=io) str
131  IF(io.NE.0) GOTO 300
132  IF(gridman_dbg) WRITE(gridman_unit,*) trim(str)
133 C READ COORDINATES
134  IF (rlb.GE.2.0.AND.rlb.LT.3.) THEN
135  nsurf=nsurf+1
136  ltake(ias)=.true.
137  READ (3,6664) xb(1,ias),yb(1,ias),rtmp1,
138  r xb(2,ias),yb(2,ias),rtmp2
139  6664 FORMAT (6e12.4)
140  ELSE
141  ltake(ias)=.false.
142  END IF
143  END DO
144  CLOSE(3)
145 
146  IF(nsurf.EQ.0) THEN
147  WRITE(gridman_unit,*)
148  w "WARNING from GRIDMAN_ADDSURF2D_READ_ARRAY: ",
149  w "no plane surfaces in file ",trim(fname)
150  WRITE(gridman_unit,*) "Nothing to return"
151  DEALLOCATE(xb,yb,ltake,stat=io)
152  RETURN
153  END IF
154 
155  IF(ALLOCATED(x)) DEALLOCATE(x,stat=io)
156  IF(ALLOCATED(y)) DEALLOCATE(y,stat=io)
157  IF(ALLOCATED(isrf)) DEALLOCATE(isrf,stat=io)
158  ALLOCATE(x(2,nsurf),y(2,nsurf),isrf(nsurf),stat=io)
159  IF(io.NE.0) THEN
160  WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF2D_READ_ARRAY: ",
161  w "cannot perform allocation"
162  WRITE(gridman_unit,*) " NLIM ",nlim
163  DEALLOCATE(xb,yb,ltake,stat=io)
164  ierr=200
165  RETURN
166  END IF
167 
168  isf=0
169  DO ias=1,nlim
170  IF(ltake(ias)) THEN
171  isf=isf+1
172  x(1:2,isf)=xb(1:2,ias)
173  y(1:2,isf)=yb(1:2,ias)
174  isrf(isf)=ias
175  END IF
176  END DO
177 
178  DEALLOCATE(xb,yb,ltake,stat=io)
179 
180  IF(gridman_dbg)
181  w WRITE(gridman_unit,*) "GRIDMAN_ADDSURF2D_READ_ARRAY finished"
182 
183  RETURN
184 
185  100 WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF2D_READ_ARRAY: ",
186  w "no Block 3b is found in file ",trim(fname)
187  ierr=100
188  CLOSE(3)
189  nsurf=0
190  RETURN
191  200 WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF2D_READ_ARRAY: ",
192  w "error while reading file ",trim(fname)
193  ierr=300
194  CLOSE(3)
195  nsurf=0
196  RETURN
197  300 WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF2D_READ_ARRAY: ",
198  w "error while reading file ",trim(fname)
199  WRITE(gridman_unit,*) " IADD, NLIM ",ias,nlim
200  ierr=300
201  DEALLOCATE(xb,yb,ltake,stat=io)
202  CLOSE(3)
203  nsurf=0
204  RETURN
205  400 WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF2D_READ_ARRAY: ",
206  w "Block 3b is incomplete in file ",trim(fname)
207  ierr=100
208  CLOSE(3)
209  nsurf=0
210  RETURN
211  500 WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF2D_READ_ARRAY: ",
212  w "Block 3b is incomplete in file ",trim(fname)
213  ierr=100
214  DEALLOCATE(xb,yb,ltake,stat=io)
215  CLOSE(3)
216  nsurf=0
217  RETURN
218 
219  END SUBROUTINE gridman_addsurf2d_read_array
220 
221 C>
222 C> \todo To add reader for ABAQUS format
223 C>
224 
225 C*********************************************************************************
226 C> Read triangular Additional Surfaces (3.0<=RLBND<4) from EIRENE input file
227 C>
228 C> WARNING: arrays X, Y, Z, ISURF must NOT be allocated in advance,
229 C> they are allocated in the subroutine itself.
230 C> Arrays which already exist will be re-allocated
231 C>
232 C> GRIDMAN_ADDSURF3D_READ_ARRAY and GRIDMAN_ADDSURF3D_READ_GRID
233 C> are combined in the interface GRIDMAN_ADDSURF_READ
234 C*********************************************************************************
235  SUBROUTINE gridman_addsurf3d_read_array(FNAME,NSURF,X,Y,Z,
236  s isrf,ierr)
237  USE gridman,ONLY:gridman_dp,gridman_sp,gridman_dbg,gridman_unit
238  IMPLICIT NONE
239  INTRINSIC trim
240 C> String containing the name of input file
241  CHARACTER(*),INTENT(IN) :: FNAME
242 C> Number of triangles read
243  INTEGER(GRIDMAN_SP),INTENT(OUT) :: NSURF
244 C> X coordinates of the triangle vertices, X(3,NSURF)
245  REAL(GRIDMAN_DP),ALLOCATABLE :: X(:,:)
246 C> Y coordinates ... , Y(3,NSURF)
247  REAL(GRIDMAN_DP),ALLOCATABLE :: Y(:,:)
248 C> Z coordinates ... , Z(3,NSURF)
249  REAL(GRIDMAN_DP),ALLOCATABLE :: Z(:,:)
250 C> Index of EIRENE surface, ISRF(NSURF)
251 C>
252 C> ISRF(I) is the index of EIRENE surface which corresponds
253 C> to edge I in arrays X,Y,Z
254  INTEGER(GRIDMAN_SP),ALLOCATABLE :: ISRF(:)
255 C> Error code
256  INTEGER,INTENT(OUT) :: IERR
257 
258  INTEGER :: IO
259  INTEGER(GRIDMAN_SP) :: IAS,NLIM,ISF
260  CHARACTER(200) :: STR
261  REAL(GRIDMAN_DP) :: RLB,RTMP1,RTMP2
262  REAL(GRIDMAN_DP),ALLOCATABLE :: XB(:,:),YB(:,:),ZB(:,:)
263  LOGICAL,ALLOCATABLE :: LTAKE(:)
264 
265  IF(gridman_dbg)
266  w WRITE(gridman_unit,*) "Starting GRIDMAN_ADDSURF3D_READ_ARRAY"
267 
268  ierr=0
269  nsurf=0
270 
271  OPEN (unit=3,status='OLD',access='SEQUENTIAL',
272  o form='FORMATTED',file=fname,iostat=io)
273  IF(io.NE.0) THEN
274  ierr=300
275  WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF3D_READ_ARRAY: ",
276  o "can not open ",trim(fname)
277  RETURN
278  END IF
279 
280 C LOOK FOR BEGINNING OF THE ADDITIONAL SURFACES SECTION
281  10 READ(3,'(a200)',end=100,iostat=io) str
282  IF(io.NE.0) GOTO 200
283  IF(str(1:3).NE.'***') GOTO 10
284  IF(index(str,'3b').LT.1.AND.index(str,'3B').LT.1) GOTO 10
285 
286 C SKIP COMMENT BLOCK
287  20 READ(3,'(A200)',end=400,iostat=io) str
288  IF(io.NE.0) GOTO 200
289  IF(str(1:1).EQ.'*') GOTO 20
290 
291 C READ NUMBER OF SURFACES
292  IF(gridman_dbg) WRITE(gridman_unit,*) trim(str)
293  READ(str,*,iostat=io) nlim
294  IF(io.NE.0) GOTO 200
295 
296  IF(nlim.LT.1) THEN
297  WRITE(gridman_unit,*)
298  w "WARNING from GRIDMAN_ADDSURF3D_READ_ARRAY: ",
299  w "zero number of additional surfaces in file ",trim(fname)
300  WRITE(gridman_unit,*) " Nothing to return"
301  CLOSE(3)
302  RETURN
303  END IF
304 
305  ALLOCATE(xb(3,nlim),yb(3,nlim),zb(3,nlim),ltake(nlim),stat=io)
306  IF(io.NE.0) THEN
307  WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF2D_READ_ARRAY: ",
308  w "cannot allocate temporary arrays"
309  WRITE(gridman_unit,*) " NLIM ",nlim
310  ierr=200
311  CLOSE(3)
312  RETURN
313  END IF
314 
315  DO ias=1,nlim
316 C FIND BEGINNING OF THE INPUT CARD
317  30 READ(3,'(A200)',end=500,iostat=io) str
318  IF(io.NE.0) GOTO 300
319  IF(str(1:1).NE.'*') GOTO 30
320 C SKIP COMMENTS, CH1 AND CH2 CARDS
321  40 IF(gridman_dbg) WRITE(gridman_unit,*) trim(str)
322  READ(3,'(A200)',end=500,iostat=io) str
323  IF(io.NE.0) GOTO 300
324  IF(gridman_dbg) WRITE(gridman_unit,*) trim(str)
325  IF(str(1:1).EQ.'*'.OR.
326  f str(1:3).EQ.'CH1'.OR.str(1:3).EQ.'ch1'.OR.
327  f str(1:3).EQ.'CH2'.OR.str(1:3).EQ.'ch2') GOTO 40
328 C READ NUMBERS SECTION
329  READ(str,*,iostat=io) rlb,rtmp1,rtmp2
330  IF(io.NE.0) GOTO 300
331  READ(3,'(A200)',end=500,iostat=io) str
332  IF(io.NE.0) GOTO 300
333  IF(gridman_dbg) WRITE(gridman_unit,*) trim(str)
334 C READ COORDINATES
335  IF (rlb.GE.3.0.AND.rlb.LT.4.) THEN
336  nsurf=nsurf+1
337  ltake(ias)=.true.
338  READ (3,6664) xb(1,ias),yb(1,ias),zb(1,ias),
339  r xb(2,ias),yb(2,ias),zb(2,ias)
340  READ (3,6664) xb(3,ias),yb(3,ias),zb(3,ias)
341  6664 FORMAT (6e12.4)
342  ELSE
343  ltake(ias)=.false.
344  END IF
345  END DO
346  CLOSE(3)
347 
348  IF(nsurf.EQ.0) THEN
349  WRITE(gridman_unit,*)
350  w "WARNING from GRIDMAN_ADDSURF3D_READ_ARRAY: ",
351  w "no triangles in file ",trim(fname)
352  WRITE(gridman_unit,*) "Nothing to return"
353  DEALLOCATE(xb,yb,zb,ltake,stat=io)
354  ierr=-100
355  RETURN
356  END IF
357 
358  IF(ALLOCATED(x)) DEALLOCATE(x,stat=io)
359  IF(ALLOCATED(y)) DEALLOCATE(y,stat=io)
360  IF(ALLOCATED(z)) DEALLOCATE(z,stat=io)
361  IF(ALLOCATED(isrf)) DEALLOCATE(isrf,stat=io)
362  ALLOCATE(x(3,nsurf),y(3,nsurf),z(3,nsurf),isrf(nsurf),stat=io)
363  IF(io.NE.0) THEN
364  WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF3D_READ_ARRAY: ",
365  w "cannot perform allocation"
366  WRITE(gridman_unit,*) " NLIM ",nlim
367  DEALLOCATE(xb,yb,zb,ltake,stat=io)
368  ierr=200
369  RETURN
370  END IF
371 
372  isf=0
373  DO ias=1,nlim
374  IF(ltake(ias)) THEN
375  isf=isf+1
376  x(1:3,isf)=xb(1:3,ias)
377  y(1:3,isf)=yb(1:3,ias)
378  z(1:3,isf)=zb(1:3,ias)
379  isrf(isf)=ias
380  END IF
381  END DO
382 
383  DEALLOCATE(xb,yb,zb,ltake,stat=io)
384 
385  IF(gridman_dbg)
386  w WRITE(gridman_unit,*) "GRIDMAN_ADDSURF3D_READ_ARRAY finished"
387 
388  RETURN
389 
390  100 WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF3D_READ_ARRAY: ",
391  w "no Block 3b is found in file ",trim(fname)
392  ierr=100
393  CLOSE(3)
394  nsurf=0
395  RETURN
396  200 WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF3D_READ_ARRAY: ",
397  w "error while reading file ",trim(fname)
398  ierr=300
399  CLOSE(3)
400  nsurf=0
401  RETURN
402  300 WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF3D_READ_ARRAY: ",
403  w "error while reading file ",trim(fname)
404  WRITE(gridman_unit,*) " IADD, NLIM ",ias,nlim
405  ierr=300
406  DEALLOCATE(xb,yb,zb,ltake,stat=io)
407  CLOSE(3)
408  nsurf=0
409  RETURN
410  400 WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF3D_READ_ARRAY: ",
411  w "Block 3b is incomplete in file ",trim(fname)
412  ierr=100
413  CLOSE(3)
414  nsurf=0
415  RETURN
416  500 WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF3D_READ_ARRAY: ",
417  w "Block 3b is incomplete in file ",trim(fname)
418  ierr=100
419  DEALLOCATE(xb,yb,zb,ltake,stat=io)
420  CLOSE(3)
421  nsurf=0
422  RETURN
423 
424  END SUBROUTINE gridman_addsurf3d_read_array
425 
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::gridman_dbg
logical, save, public gridman_dbg
Switch for debugging mode.
Definition: gridman.f:122
gridman_addsurf2d_read_array
subroutine gridman_addsurf2d_read_array(FNAME, NSURF, X, Y, ISRF, IERR)
Read planar (2D) Additional Surfaces from EIRENE input file.
Definition: addsurf.f:37
gridman
Definition of data types, global constants and variables.
Definition: gridman.f:83
gridman_addsurf3d_read_array
subroutine gridman_addsurf3d_read_array(FNAME, NSURF, X, Y, Z, ISRF, IERR)
Read triangular Additional Surfaces (3.0<=RLBND<4) from EIRENE input file.
Definition: addsurf.f:237
gridman::gridman_sp
integer, parameter, public gridman_sp
Kind parameter for integer numbers.
Definition: gridman.f:95
Generated on Thu Oct 5 2017 09:49:56 for GRIDMAN by   doxygen 1.8.9.1