GRIDMAN
grid managment library
convgrid.f
Go to the documentation of this file.
1 C> @file apps/convgrid.f
2 C> Convert grids from one format into another,
3 C> including legacy B2-EIRENE formats, and visualization
4 C>
5 C> Based on GRIDMAN library
6 C Author: Vladislav Kotov, v.kotov@fz-juelich.de
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> Main program
28 C>
29 C> Usage ./convgrid < convgrid.parameters (namelist initialization)
30 C> Input parameters are described in congrid.parameters.description
31 C***************************************************************************************
32 
33  MODULE convgrid_mod
34  INTEGER,PARAMETER :: file_length=1024 !MAXIMUM LENGTH OF THE FILE NAME
35  END MODULE convgrid_mod
36 
37  PROGRAM convgrid
38 
39  USE gridman,ONLY:gridman_grid,gridman_dp,gridman_sp,
40  u gridman_unit,gridman_dbg
41  USE gridman_lib,ONLY:gridman_grid_deallocate,gridman_grid_metadata
42  USE convgrid_mod,ONLY:file_length
43  IMPLICIT NONE
44  INTRINSIC len_trim,get_command_argument
45 C
46  INTERFACE
47  SUBROUTINE convgrid_read(INPUTMOD,
48  c grid_in,sonnet_in,fort30_in,
49  c fort33_in,fort34_in,fort35_in,
50  c eirene_in,template_in,
51  c leirene,rlbnd,grid)
52  USE gridman,ONLY:gridman_grid
53  USE convgrid_mod,ONLY:file_length
54  INTEGER,INTENT(IN) :: inputmod
55  CHARACTER(LEN=FILE_LENGTH),INTENT(IN) ::
56  c grid_in,sonnet_in,fort30_in,
57  c fort33_in,fort34_in,fort35_in,
58  c eirene_in,template_in
59  LOGICAL,INTENT(IN) :: leirene
60  INTEGER,INTENT(IN) :: rlbnd
61  TYPE(gridman_grid) :: grid
62  END SUBROUTINE convgrid_read
63 C
64  SUBROUTINE convgrid_indexes(GRID,IEIND,ICIND)
65  USE gridman,ONLY:gridman_grid
66  TYPE(gridman_grid) :: grid
67  INTEGER,INTENT(IN) :: ieind,icind
68  END SUBROUTINE convgrid_indexes
69 C
70  SUBROUTINE convgrid_exclude(NEXCLUDE,IXE,IYE,GRID)
71  USE gridman,ONLY:gridman_grid,gridman_sp
72  INTEGER(GRIDMAN_SP),INTENT(IN) :: nexclude
73  INTEGER(GRIDMAN_SP),INTENT(IN) :: ixe(2,nexclude),iye(2,nexclude)
74  TYPE(gridman_grid) :: grid
75  END SUBROUTINE convgrid_exclude
76 C
77  SUBROUTINE convgrid_triang(GRID)
78  USE gridman,ONLY:gridman_grid
79  TYPE(gridman_grid) :: grid
80  END SUBROUTINE convgrid_triang
81 C
82  SUBROUTINE convgrid_output(VTK_OUT,GRID_OUT,
83  s fort33_out,fort34_out,fort35_out,
84  s template_out,grid)
85  USE gridman,ONLY:gridman_grid
86  USE convgrid_mod,ONLY:file_length
87  CHARACTER(LEN=FILE_LENGTH),INTENT(IN) :: vtk_out,grid_out,
88  c fort33_out,fort34_out,fort35_out,template_out
89  TYPE(gridman_grid) :: grid
90  END SUBROUTINE convgrid_output
91 
92  END INTERFACE
93 
94 C INPUT PARAMETERS
95  INTEGER,PARAMETER :: nexclude_max=100
96  CHARACTER(LEN=FILE_LENGTH) ::
97  c grid_in,sonnet_in,fort30_in,
98  c fort33_in,fort34_in,fort35_in,
99  c eirene_in,template_in,
100  c vtk_out,grid_out,template_out,
101  c fort33_out,fort34_out,fort35_out
102  CHARACTER(LEN=256) :: description
103  LOGICAL :: leirene,triangulate,dbgmod,lcheck
104  INTEGER(GRIDMAN_SP) :: nexclude,
105  i ixe(2,nexclude_max),iye(2,nexclude_max)
106  INTEGER :: rlbnd,ieind,icind
107  REAL(GRIDMAN_DP) :: fscale
108  CHARACTER(LEN=256) :: units
109 C LOCAL VARIABLES
110  INTEGER :: ierr,inputmod
111  TYPE(gridman_grid) :: grid
112  REAL(GRIDMAN_DP) :: ft
113  CHARACTER(LEN=FILE_LENGTH) :: ftmp
114  LOGICAL :: lmeta
115 
116  CALL set_defaults
117 C
118 C 1. READ INPUT PARAMETERS
119 C
120 
121 C INPUT VIA ARGUMENT LIST
122  lmeta=.false.
123  CALL get_command_argument(1,ftmp)
124  IF(len_trim(ftmp).GT.0) THEN
125  IF(adjustl(trim(ftmp)).EQ.'help') THEN
126  CALL print_description
127  stop
128  END IF
129  CALL set_input(grid_in,sonnet_in,fort30_in,
130  c fort33_in,fort34_in,fort35_in,
131  c eirene_in,template_in,
132  c vtk_out,template_out,rlbnd,lmeta)
133  ELSE
134 C INPUT VIA NAMELIST
135  CALL read_input
136  END IF
137 
138 C
139 C 2. DETERMINE THE INPUT MODE
140 C
141  inputmod=find_input_mode()
142 
143 C
144 C 3. READ INPUT
145 C
146  CALL convgrid_read(inputmod,
147  c grid_in,sonnet_in,fort30_in,
148  c fort33_in,fort34_in,fort35_in,
149  c eirene_in,template_in,leirene,rlbnd,
150  c grid)
151 
152 C Print metadata and exit if requested in SET_INPUT
153  IF(lmeta) THEN
154  CALL gridman_grid_metadata(grid,gridman_unit,ierr)
155  CALL gridman_grid_deallocate(grid,ierr)
156  WRITE(gridman_unit,*) "CONVGRID COMPLETED"
157  stop
158  END IF
159 C
160 C 4. SELECT INDEXES
161 C
162 
163  IF(ieind.GE.0.OR.icind.GE.0) THEN
164  WRITE(gridman_unit,*) "CONVGRID: selecting indexes"
165  CALL convgrid_indexes(grid,ieind,icind)
166  END IF
167 
168 C
169 C 5. ELIMINATE CELLS
170 C
171  IF(nexclude.GT.0) THEN
172  WRITE(gridman_unit,*) "CONVGRID: eliminating cells"
173  CALL convgrid_exclude(nexclude,ixe,iye,grid)
174  END IF
175 C
176 C 6. TRIANGULATE
177 C
178  IF(triangulate.AND.inputmod.NE.4.AND.
179  f grid%NCELLS.GT.0) THEN
180  WRITE(gridman_unit,*) "CONVGRID: triangulate"
181  CALL convgrid_triang(grid)
182  END IF
183 C
184 C 7. TRANSLATE UNITS
185 C
186  IF(len_trim(description).GT.0) grid%DESCRIPTION=description
187  IF(fscale.GT.0.) THEN
188  WRITE(gridman_unit,*) "CONVGRID: translating units"
189  ft=grid%UNIT2SI/fscale
190  grid%X=grid%X*ft
191  grid%UNIT2SI=fscale
192  grid%UNITS=units
193  END IF
194 C
195 C 8. PRINT OUTPUT
196 C
197  CALL convgrid_output(vtk_out,grid_out,
198  s fort33_out,fort34_out,fort35_out,
199  s template_out,grid)
200 
201 C CLEAN ALL
202  CALL gridman_grid_deallocate(grid,ierr)
203 
204  WRITE(gridman_unit,*) "CONVGRID COMPLETED"
205 
206  CONTAINS
207 
208 C********************************************************************
209 C Read namelist from standard input
210 C********************************************************************
211  SUBROUTINE read_input
212  USE gridman,ONLY:gridman_dbg,gridman_check
213  namelist /convgrid/ description,leirene,
214  n grid_in,sonnet_in,fort30_in,
215  n fort33_in,fort34_in,fort35_in,
216  n eirene_in,template_in,
217  n vtk_out,grid_out,template_out,
218  n fort33_out,fort34_out,fort35_out,
219  n triangulate,dbgmod,lcheck,
220  n nexclude,ixe,iye,rlbnd,ieind,icind,
221  n fscale,units
222  INTEGER :: io
223 
224  IF(gridman_dbg)
225  w WRITE(gridman_unit,*) "CONVGRID: starting READ_INPUT"
226 
227  rewind(5)
228  READ(5,nml=convgrid,iostat=io)
229  IF(io.NE.0) CALL convgrid_error("can not read namelist CONVGRID")
230 
231  gridman_dbg=dbgmod
232  gridman_check=lcheck
233 
234  IF(gridman_dbg)
235  w WRITE(gridman_unit,*) "CONVGRID: READ_INPUT finished"
236 
237  END SUBROUTINE read_input
238 
239 C
240  SUBROUTINE set_defaults
241  leirene=.false.
242  triangulate=.false.
243  dbgmod=.false.
244  lcheck=.false.
245  nexclude=0
246  description=''
247  grid_in=''
248  sonnet_in=''
249  fort30_in=''
250  fort33_in=''
251  fort34_in=''
252  fort35_in=''
253  template_in=''
254  eirene_in=''
255  vtk_out=''
256  grid_out=''
257  fort33_out=''
258  fort34_out=''
259  fort35_out=''
260  template_out=''
261  fscale=-1.
262  units='Not defined'
263  rlbnd=2
264  ieind=-1
265  icind=-1
266  END SUBROUTINE set_defaults
267 
268 C***************************************************************************************
269 C Find index of the input mode judging from the defined input files
270 C***************************************************************************************
271  FUNCTION find_input_mode()
272  INTEGER :: find_input_mode
273  INTEGER :: n,lt,lt1,lt2,lt3
274  INTRINSIC trim
275 
276  IF(gridman_dbg)
277  w WRITE(gridman_unit,*) "CONVGRID: starting FIND_INPUT_MODE"
278 
279  n=0
280  lt=len_trim(grid_in)
281  IF(lt.GT.0) THEN
282  n=n+1
283  find_input_mode=1
284  END IF
285  lt=len_trim(sonnet_in)
286  IF(lt.GT.0) THEN
287  n=n+1
288  find_input_mode=2
289  END IF
290  lt=len_trim(fort30_in)
291  IF(lt.GT.0) THEN
292  n=n+1
293  find_input_mode=3
294  END IF
295  lt1=len_trim(fort33_in)
296  lt2=len_trim(fort34_in)
297  lt3=len_trim(fort35_in)
298  lt=lt1+lt2+lt3
299  IF(lt.GT.0) THEN
300  n=n+1
301  find_input_mode=4
302  END IF
303  lt=len_trim(eirene_in)
304  IF(lt.GT.0) THEN
305  n=n+1
306  find_input_mode=5
307  END IF
308  lt=len_trim(template_in)
309  IF(lt.GT.0) THEN
310  n=n+1
311  find_input_mode=6
312  END IF
313  IF(n.GT.1) THEN
314  WRITE(gridman_unit,*) "N=",n
315  CALL convgrid_error("Ambiguity in the list of input files")
316  ELSE IF(n.EQ.0) THEN
317  CALL convgrid_error("No input grid is specified")
318  END IF
319  IF(find_input_mode.EQ.4) THEN
320  IF(lt1.EQ.0.OR.lt2.EQ.0.OR.lt3.EQ.0) THEN
321  WRITE(gridman_unit,*) "ERROR in CONVGRID: ",
322  w "not all files for input as EIRENE triangular grid are defined"
323  WRITE(gridman_unit,*) " FORT33 ",trim(fort33_in)
324  WRITE(gridman_unit,*) " FORT34 ",trim(fort34_in)
325  WRITE(gridman_unit,*) " FORT35 ",trim(fort35_in)
326  CALL convgrid_error('')
327  END IF
328  END IF
329 
330  IF(gridman_dbg)
331  f WRITE(gridman_unit,*) "CONVGRID: FIND_INPUT_MODE finished, ",
332  w "INPUTMOD ", find_input_mode
333 
334  END FUNCTION find_input_mode
335 
336  END PROGRAM convgrid
337 
338 C********************************************************************
339 C Read grid
340 C********************************************************************
341  SUBROUTINE convgrid_read(INPUTMOD,
342  c grid_in,sonnet_in,fort30_in,
343  c fort33_in,fort34_in,fort35_in,
344  c eirene_in,template_in,
345  c leirene,rlbnd,grid)
346  USE gridman,ONLY:gridman_grid,gridman_dbg,gridman_unit
347  USE gridman_lib,ONLY:gridman_grid_read,
348  u gridman_carre_readsonnet_grid,
349  u gridman_carre_read30_grid,
350  u gridman_tria_read_grid,
351  u gridman_addsurf2d_read,
352  u gridman_addsurf3d_read,
353  u gridman_template_read
354  USE convgrid_mod,ONLY:file_length
355  IMPLICIT NONE
356  INTRINSIC trim,len_trim
357 C INPUT PARAMETERS
358  INTEGER,INTENT(IN) :: inputmod
359  CHARACTER(LEN=FILE_LENGTH),INTENT(IN) ::
360  c grid_in,sonnet_in,fort30_in,
361  c fort33_in,fort34_in,fort35_in,
362  c eirene_in,template_in
363  LOGICAL,INTENT(IN) :: leirene
364  INTEGER,INTENT(IN) :: rlbnd
365 C OUTPUT PARAMETERS
366  TYPE(gridman_grid) :: grid
367 C LOCAL PARAMETERS
368  INTEGER :: ierr
369 
370  IF(gridman_dbg)
371  w WRITE(gridman_unit,*) "CONVGRID: starting CONVGRID_READ"
372 
373  SELECT CASE(inputmod)
374  CASE(1) !GRID
375  WRITE(gridman_unit,*) "CONVGRID: reading file ",trim(grid_in)
376  CALL gridman_grid_read(grid,grid_in,ierr)
377  IF(ierr.NE.0) CALL convgrid_error('')
378  CASE(2) !SONNET
379  WRITE(gridman_unit,*) "CONVGRID: reading file ",trim(sonnet_in)
380  CALL gridman_carre_readsonnet_grid(grid,sonnet_in,ierr,
381  c leir=leirene)
382  IF(ierr.NE.0) CALL convgrid_error('')
383  CASE(3) !FORT30
384  WRITE(gridman_unit,*) "CONVGRID: reading file ",trim(fort30_in)
385  CALL gridman_carre_read30_grid(grid,fort30_in,ierr,leir=leirene)
386  IF(ierr.NE.0) CALL convgrid_error('')
387  CASE(4) !FORT33,34,35
388  WRITE(gridman_unit,*) "CONVGRID: reading files ",trim(fort33_in)
389  WRITE(gridman_unit,*) "... ",trim(fort34_in),
390  w ", ",trim(fort35_in)
391  CALL gridman_tria_read_grid(grid,
392  c (/fort33_in,fort34_in,fort35_in/),ierr)
393  IF(ierr.GT.0) CALL convgrid_error('')
394  CASE(5) !EIRENE input file
395  WRITE(gridman_unit,*) "CONVGRID: reading file ",trim(eirene_in)
396  IF(rlbnd.EQ.2) THEN
397  CALL gridman_addsurf2d_read(grid,eirene_in,ierr)
398  ELSEIF(rlbnd.EQ.3) THEN
399  CALL gridman_addsurf3d_read(grid,eirene_in,ierr)
400  ELSE
401  WRITE(gridman_unit,*) " RLBND ",rlbnd
402  CALL convgrid_error('illegal value of variable RLBND')
403  END IF
404  IF(ierr.NE.0) CALL convgrid_error('')
405  CASE(6)
406  WRITE(gridman_unit,*) "CONVGRID: reading file ",
407  w trim(template_in)
408  CALL gridman_template_read(grid,template_in,ierr)
409  IF(ierr.NE.0) CALL convgrid_error('')
410  END SELECT
411 
412  IF(gridman_dbg)
413  w WRITE(gridman_unit,*) "CONVGRID: CONVGRID_READ finished"
414 
415  END SUBROUTINE convgrid_read
416 
417 C***************************************************************************************
418 C Select of exclude indexes
419 C***************************************************************************************
420  SUBROUTINE convgrid_indexes(GRID,IEIND,ICIND)
421  USE gridman,ONLY:gridman_grid,gridman_index,
422  u gridman_dbg,gridman_unit
423  USE gridman_lib,ONLY:gridman_index_deallocate
424  IMPLICIT NONE
425  TYPE(gridman_grid) :: grid
426  INTEGER,INTENT(IN) :: ieind,icind
427 
428  TYPE(gridman_index) :: indtmp
429  INTEGER :: i,ierr,st
430 
431  IF(gridman_dbg)
432  w WRITE(gridman_unit,*) "CONVGRID: starting CONVGRID_INDEXES"
433 
434  IF(ieind.GT.0) THEN
435  IF(ieind.GT.grid%NEDGEINDEX) THEN
436  WRITE(gridman_unit,*) " IEIND, NEDGEINDEX ",
437  w ieind, grid%NEDGEINDEX
438  CALL convgrid_error('edge index is out of range')
439  END IF
440  indtmp=grid%EDGEINDEX(ieind)
441  DO i=1,grid%NEDGEINDEX
442  IF(i.EQ.ieind) cycle
443  CALL gridman_index_deallocate(grid%EDGEINDEX(i),ierr)
444  END DO
445  DEALLOCATE(grid%EDGEINDEX)
446  ALLOCATE(grid%EDGEINDEX(1),stat=st)
447  IF(st.NE.0) CALL convgrid_error('memory allocation failed')
448  grid%NEDGEINDEX=1
449  grid%EDGEINDEX(1)=indtmp
450  WRITE(gridman_unit,*) "CONVGRID: selected edge index ",ieind
451  ELSEIF(ieind.EQ.0) THEN
452  DO i=1,grid%NEDGEINDEX
453  CALL gridman_index_deallocate(grid%EDGEINDEX(i),ierr)
454  END DO
455  DEALLOCATE(grid%EDGEINDEX)
456  grid%NEDGEINDEX=0
457  WRITE(gridman_unit,*) "CONVGRID: all edge indices are excluded"
458  END IF
459 
460  IF(icind.GT.0) THEN
461  IF(icind.GT.grid%NCELLINDEX) THEN
462  WRITE(gridman_unit,*) " ICIND, NCELLINDEX ",
463  w icind, grid%NCELLINDEX
464  CALL convgrid_error('edge index is out of range')
465  END IF
466  indtmp=grid%CELLINDEX(icind)
467  DO i=1,grid%NCELLINDEX
468  IF(i.EQ.icind) cycle
469  CALL gridman_index_deallocate(grid%CELLINDEX(i),ierr)
470  END DO
471  DEALLOCATE(grid%CELLINDEX)
472  ALLOCATE(grid%CELLINDEX(1),stat=st)
473  IF(st.NE.0) CALL convgrid_error('memory allocation failed')
474  grid%NCELLINDEX=1
475  grid%CELLINDEX(1)=indtmp
476  WRITE(gridman_unit,*) "CONVGRID: selected cell index ",icind
477  ELSEIF(icind.EQ.0) THEN
478  DO i=1,grid%NCELLINDEX
479  CALL gridman_index_deallocate(grid%CELLINDEX(i),ierr)
480  END DO
481  DEALLOCATE(grid%CELLINDEX)
482  grid%NCELLINDEX=0
483  WRITE(gridman_unit,*) "CONVGRID: all cell indices are excluded"
484  END IF
485 
486  IF(gridman_dbg)
487  w WRITE(gridman_unit,*) "CONVGRID: CONVGRID_INDEXES finished"
488 
489  END SUBROUTINE convgrid_indexes
490 
491 C***************************************************************************************
492 C Exclude cells defined by IXE, IYE from the GRID
493 C***************************************************************************************
494  SUBROUTINE convgrid_exclude(NEXCLUDE,IXE,IYE,GRID)
495  USE gridman,ONLY:gridman_grid,gridman_sp,gridman_dbg,gridman_unit
496  USE gridman_lib,ONLY:gridman_grid_copy,
497  u gridman_grid_eliminate_cells
498  IMPLICIT NONE
499 C INPUT
500  INTEGER(GRIDMAN_SP),INTENT(IN) :: nexclude
501  INTEGER(GRIDMAN_SP),INTENT(IN) :: ixe(2,nexclude),iye(2,nexclude)
502 C INOUT
503  TYPE(gridman_grid) :: grid
504 C LOCAL
505  LOGICAL,ALLOCATABLE :: ltake(:)
506  INTEGER(GRIDMAN_SP) :: ie,iel,icell,ix,iy,n
507  INTEGER :: is,ierr
508  TYPE(gridman_grid) :: grid2
509 
510  IF(gridman_dbg)
511  w WRITE(gridman_unit,*) "CONVGRID: starting CONVGRID_EXCLUDE"
512 
513  IF(nexclude.LT.1.OR.grid%CELLINDEX(1)%NINDEX.LT.2) RETURN
514 
515  IF(grid%CELLINDEX(1)%NINDEX.LT.2) THEN
516  WRITE(gridman_unit,*)
517  w "CONVGRID: eliminate skipped - no 2D index found"
518  END IF
519 
520  ALLOCATE(ltake(grid%NCELLS),stat=is)
521  IF(is.NE.0)
522  f CALL convgrid_error('Cannot allocate temporary array')
523  ltake=.true.
524  n=0
525  DO ie=1,nexclude
526  DO iel=1,grid%CELLINDEX(1)%NELEMENTS
527  icell=grid%CELLINDEX(1)%INDEXES(0,iel)
528  IF(icell.GT.0.AND.icell.LE.grid%NCELLS) THEN
529  ix=grid%CELLINDEX(1)%INDEXES(1,iel)
530  iy=grid%CELLINDEX(1)%INDEXES(2,iel)
531  IF(ixe(1,ie).LE.ix.AND.ix.LE.ixe(2,ie).AND.
532  f iye(1,ie).LE.iy.AND.iy.LE.iye(2,ie)) THEN
533  ltake(icell)=.false.
534  n=n+1
535  END IF
536  END IF
537  END DO
538  END DO
539  IF(n.EQ.grid%NCELLS)
540  c CALL convgrid_error('no cells left after eliminate')
541  CALL gridman_grid_copy(grid2,grid,ierr)
542  IF(ierr.NE.0) CALL convgrid_error('')
543  CALL gridman_grid_eliminate_cells(grid,grid2,ltake,ierr)
544  IF(ierr.NE.0) CALL convgrid_error('')
545 
546  CALL gridman_grid_deallocate(grid2,ierr)
547 
548  IF(gridman_dbg)
549  w WRITE(gridman_unit,*) "CONVGRID: CONVGRID_EXCLUDE finished"
550 
551  END SUBROUTINE convgrid_exclude
552 
553 C***************************************************************************************
554 C Triangulate the grid
555 C***************************************************************************************
556  SUBROUTINE convgrid_triang(GRID)
557  USE gridman,ONLY:gridman_grid,gridman_dbg,gridman_unit
558  USE gridman_lib,ONLY:gridman_grid_copy,gridman_grid2d_triang,
559  u gridman_grid_deallocate
560  IMPLICIT NONE
561 C INOUT
562  TYPE(gridman_grid) :: grid
563 C LOCAL
564  INTEGER :: ierr
565  TYPE(gridman_grid) :: grid2
566 
567  IF(gridman_dbg)
568  w WRITE(gridman_unit,*) "CONVGRID: starting CONVGRID_TRIANG"
569 
570  CALL gridman_grid_copy(grid2,grid,ierr)
571  IF(ierr.NE.0) CALL convgrid_error('')
572 
573  CALL gridman_grid2d_triang(grid,grid2,ierr)
574  IF(ierr.NE.0) CALL convgrid_error('')
575 
576  CALL gridman_grid_deallocate(grid2,ierr)
577 
578  IF(gridman_dbg)
579  w WRITE(gridman_unit,*) "CONVGRID: CONVGRID_TRIANG finished"
580 
581  END SUBROUTINE convgrid_triang
582 
583 C***************************************************************************************
584 C Print all requested output
585 C***************************************************************************************
586  SUBROUTINE convgrid_output(VTK_OUT,GRID_OUT,
587  s fort33_out,fort34_out,fort35_out,
588  s template_out,grid)
589  USE gridman,ONLY:gridman_grid,gridman_dbg,gridman_unit
590  USE gridman_lib,ONLY:gridman_vtk_grid2d_write,
591  u gridman_vtk_grid3d_write,
592  u gridman_grid_write,gridman_tria_write,
593  u gridman_template_write
594  USE convgrid_mod,ONLY:file_length
595  IMPLICIT NONE
596  INTRINSIC len_trim,max,trim
597 C INPUT
598  CHARACTER(LEN=FILE_LENGTH),INTENT(IN) ::
599  c vtk_out,grid_out,
600  c fort33_out,fort34_out,fort35_out,
601  c template_out
602  TYPE(gridman_grid) :: grid
603 C LOCAL
604  INTEGER :: lt,lt1,lt2,lt3,ierr
605 
606  IF(gridman_dbg)
607  w WRITE(gridman_unit,*) "CONVGRID: starting CONVGRID_OUTPUT"
608 
609 C 1. VTK
610  lt=len_trim(vtk_out)
611  IF(lt.GT.0) THEN
612  WRITE(gridman_unit,*) "CONVGRID: writing file ",vtk_out(1:lt)
613  IF(grid%TYPE.EQ.2) THEN
614  CALL gridman_vtk_grid2d_write(vtk_out,grid%DESCRIPTION,grid,
615  c grid%NCELLS,0,0,0,0,ierr)
616  ELSEIF(grid%TYPE.EQ.3) THEN
617  CALL gridman_vtk_grid3d_write(vtk_out,grid%DESCRIPTION,
618  c grid,grid%NEDGES,0,0,0,0,ierr)
619  ELSE
620  WRITE(gridman_unit,*) " TYPE ",grid%TYPE
621  CALL convgrid_error("unknown grid type")
622  END IF
623  IF(ierr.NE.0) CALL convgrid_error('')
624  END IF
625 C 2. GRID
626  lt=len_trim(grid_out)
627  IF(lt.GT.0) THEN
628  WRITE(gridman_unit,*) "CONVGRID: writing file ",trim(grid_out)
629  CALL gridman_grid_write(grid,grid_out,ierr)
630  IF(ierr.NE.0) CALL convgrid_error('')
631  END IF
632 C 3. EIRENE TRIANGULAR GRID
633  lt1=len_trim(fort33_out)
634  lt2=len_trim(fort34_out)
635  lt3=len_trim(fort35_out)
636  lt=lt1+lt2+lt3
637  IF(lt.GT.0) THEN
638  IF(lt1.EQ.0.OR.lt2.EQ.0.OR.lt3.EQ.0) THEN
639  WRITE(gridman_unit,*) "ERROR in CONVGRID: ",
640  w "not all files for output as EIRENE triangular grid are defined"
641  WRITE(gridman_unit,*) " FORT33 ",fort33_out(1:lt1)
642  WRITE(gridman_unit,*) " FORT34 ",fort34_out(1:lt2)
643  WRITE(gridman_unit,*) " FORT35 ",fort35_out(1:lt3)
644  CALL convgrid_error('')
645  END IF
646  END IF
647  IF(lt.GT.0) THEN
648  WRITE(gridman_unit,*) "CONVGRID: writing files ",
649  w trim(fort33_out)
650  WRITE(gridman_unit,*) "... ",trim(fort34_out),
651  w ', ',trim(fort35_out)
652  CALL gridman_tria_write(grid,
653  c (/fort33_out,fort34_out,fort35_out/),ierr)
654  IF(ierr.NE.0) CALL convgrid_error('')
655  END IF
656 C 4. TEMPLATE
657  lt=len_trim(template_out)
658  IF(lt.GT.0) THEN
659  WRITE(gridman_unit,*) "CONVGRID: writing file ",
660  w template_out(1:lt)
661  CALL gridman_template_write(grid,template_out,ierr)
662  IF(ierr.NE.0) CALL convgrid_error('')
663  END IF
664 
665  IF(gridman_dbg)
666  w WRITE(gridman_unit,*) "CONVGRID: CONVGRID_OUTPUT finished"
667 
668  END SUBROUTINE convgrid_output
669 
670 C***************************************************************************************
671 C Print error message and exit
672 C***************************************************************************************
673  SUBROUTINE convgrid_error(STR)
674  USE gridman
675  IMPLICIT NONE
676  CHARACTER(*),INTENT(IN) :: str
677  INTEGER :: lt
678  INTRINSIC len_trim
679  lt=len_trim(str)
680  IF(lt.GT.0)
681  w WRITE(gridman_unit,*) "ERROR in CONVGRID: "//str(1:lt)
682  stop "ERROR in CONVGRID - see log output. "//
683  s "Use 'convgrid help' to print documentation"
684  END SUBROUTINE convgrid_error
685 
686 C***************************************************************************************
687 C> Print manual
688 C***************************************************************************************
689  SUBROUTINE print_description
690  USE gridman,ONLY:gridman_unit,gridman_dbg
691  USE convgrid_mod,ONLY:file_length
692  INTRINSIC index,len,get_command_argument,trim
693  CHARACTER(LEN=FILE_LENGTH) :: PATH
694  CHARACTER(LEN=128) :: STR
695  INTEGER :: I,IO
696  CALL get_command_argument(0,path)
697  i=index(path,'/',.true.)
698  IF(i.GT.len(path)) THEN
699  path=''
700  ELSE
701  path=path(1:i)
702  END IF
703 
704  IF(gridman_dbg) WRITE(gridman_unit,*) " PATH:",trim(path)
705 
706  OPEN(unit=3,file=trim(path)//'convgrid.parameters.description',
707  o status='OLD',iostat=io)
708  IF(io.NE.0) GOTO 100
709 
710  DO
711  READ(3,'(A)',iostat=io,end=200) str
712  IF(io.NE.0) GOTO 200
713  WRITE(*,*) trim(str)
714  END DO
715  200 RETURN
716 
717  100 WRITE(gridman_unit,*) "convgrid <opt> <file1,2,3>"//
718  w " or convgrid < convgrid.parameters"
719  WRITE(gridman_unit,*)
720  w "<opt> = -s: Sonnet (Carre); -f: fort.30;"//
721  w " -t: triangular fort.33,34,35;"
722  WRITE(gridman_unit,*)
723  w " -e2: 2D Additional Surfaces, -e3: 3D Additional Surfaces;"
724  WRITE(gridman_unit,*) " -p: template; -g: gridman grid"
725  WRITE(gridman_unit,*)
726  w " Commands -fp, -tp, -ep produce text template files"
727  WRITE(gridman_unit,*)
728  w " Commands --s, --f, --t, --e2, --e3, --p, --g ",
729  w " only printa metadata"
730  WRITE(gridman_unit,*)
731  w "Could not find convgrid.parameters.description",
732  w trim(path)
733  WRITE(gridman_unit,*)
734  w "Use 'which convgrid' to invoke via the full path"
735 
736  END SUBROUTINE print_description
737 
738 C***************************************************************************************
739 C> Initialize input from the argument list
740 C***************************************************************************************
741  SUBROUTINE set_input(GRID_IN,SONNET_IN,FORT30_IN,
742  c fort33_in,fort34_in,fort35_in,
743  c eirene_in,template_in,
744  c vtk_out,template_out,rlbnd,lmeta)
745  USE gridman,ONLY:gridman_unit
746  USE convgrid_mod,ONLY:file_length
747  INTRINSIC get_command_argument,trim
748  CHARACTER(LEN=FILE_LENGTH),INTENT(OUT) ::
749  c grid_in,sonnet_in,fort30_in,
750  c fort33_in,fort34_in,fort35_in,
751  c eirene_in,template_in,
752  c vtk_out,template_out
753  INTEGER,INTENT(OUT) :: RLBND
754  LOGICAL,INTENT(OUT) :: LMETA
755  CHARACTER(LEN=4) :: OPT
756  CHARACTER(LEN=FILE_LENGTH) :: FNAME
757 
758  CALL get_command_argument(1,opt)
759  CALL get_command_argument(2,fname)
760  SELECT CASE(opt)
761  CASE('-s','--s')
762  sonnet_in=fname
763  CASE('-f','-fp','--f')
764  fort30_in=fname
765  CASE('-t','-tp','--t')
766  fort33_in=fname
767  CALL get_command_argument(3,fname)
768  fort34_in=fname
769  CALL get_command_argument(4,fname)
770  fort35_in=fname
771  CASE('-e2','-ep','--e2')
772  rlbnd=2
773  eirene_in=fname
774  CASE('-e3','--e3')
775  rlbnd=3
776  eirene_in=fname
777  CASE('-p','--p')
778  template_in=fname
779  CASE('-g','--g')
780  grid_in=fname
781  CASE DEFAULT
782  WRITE(gridman_unit,*) " Option ",opt
783  CALL convgrid_error("unknown input option")
784  END SELECT
785  IF(opt(3:3).eq.'p') THEN
786  template_out=trim(fname)//'.txt'
787  ELSE
788  vtk_out=trim(fname)//'.vtk'
789  END IF
790  IF(opt(1:1).EQ.'-'.AND.opt(2:2).EQ.'-') THEN
791  lmeta=.true.
792  ELSE
793  lmeta=.false.
794  END IF
795 
796  END SUBROUTINE set_input
gridman::gridman_check
logical, save, public gridman_check
Switch to enforce extra checks of input parameters.
Definition: gridman.f:133
gridman::gridman_unit
integer, save, public gridman_unit
Index of the standard output unit.
Definition: gridman.f:116
gridman_grid_eliminate_cells
subroutine gridman_grid_eliminate_cells(GRID_NEW, GRID, LTAKE, IERR)
Eliminate cells from GRIDMAN_GRID object.
Definition: grid2.f:544
gridman::gridman_dp
integer, parameter, public gridman_dp
Kind parameter for real numbers.
Definition: gridman.f:93
gridman_lib
Explicit interfaces to GRIDMAN subroutines and functions.
Definition: gridman.f:251
convgrid_mod
Main program.
Definition: convgrid.f:33
set_input
subroutine set_input(GRID_IN, SONNET_IN, FORT30_IN, FORT33_IN, FORT34_IN, FORT35_IN, EIRENE_IN, TEMPLATE_IN, VTK_OUT, TEMPLATE_OUT, RLBND, LMETA)
Initialize input from the argument list.
Definition: convgrid.f:745
gridman_tria_read_grid
subroutine gridman_tria_read_grid(GRID, FNAMES, IERR)
Read EIRENE triangular grid from fort.33-35, returns GRID object.
Definition: tria.f:558
gridman::gridman_grid
Data-type which describes a grid as a set of edges, methods in grid.f.
Definition: gridman.f:168
gridman_vtk_grid2d_write
subroutine gridman_vtk_grid2d_write(FNAME, HEADER, GRID, NELEMENTS, NCS, NCV, NPS, NPV, IERR, CELL_SCALAR, CSNAME, CELL_VECTOR, CVNAME, POINT_SCALAR, PSNAME, POINT_VECTOR, PVNAME)
Write 2D grid and data in VTK ASCII legacy format.
Definition: vtk.f:611
gridman_grid2d_triang
subroutine gridman_grid2d_triang(TRIA, GRID, IERR)
Triangulation of 2D grid.
Definition: triang.f:55
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::gridman_index
Data-type which stores indices defined on the grid cells or edges.
Definition: gridman.f:144
gridman_carre_readsonnet_grid
subroutine gridman_carre_readsonnet_grid(GRID, FNAME, IERR, LEIR)
Read CARRE grid in SONNET format, return GRID object.
Definition: carre.f:927
print_description
subroutine print_description
Print manual.
Definition: convgrid.f:690
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_vtk_grid3d_write
subroutine gridman_vtk_grid3d_write(FNAME, HEADER, GRID, NELEMENTS, NCS, NCV, NPS, NPV, IERR, CELL_SCALAR, CSNAME, CELL_VECTOR, CVNAME, POINT_SCALAR, PSNAME, POINT_VECTOR, PVNAME)
Write 3D grid and data in VTK ASCII legacy format. Only grid w/o cells is implemented at the moment !...
Definition: vtk.f:1048
gridman_carre_read30_grid
subroutine gridman_carre_read30_grid(GRID, FNAME, IERR, LEIR)
Read B2 (CARRE, SONNET) grid from fort.30, return GRID object.
Definition: carre.f:853
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