The TELEMAC-MASCARET system  trunk
utils_cgns.F
Go to the documentation of this file.
1 ! *****************
2  MODULE utils_cgns
3 ! *****************
4 !
5 !***********************************************************************
6 ! HERMES V7P1
7 !***********************************************************************
8 !
9 !brief a number of subroutines dedicated to the serafin format.
10 !
11 !history YOANN AUDOUIN
12 !+ 29/10/2011
13 !+ V7P1
14 !+ Creation of the file
15 !
16 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
17 !
19  USE hash_table
20 !
21  IMPLICIT NONE
22 #if defined(HAVE_CGNS)
23  include 'cgnslib_f.h'
24 #endif
25 !
26  INTEGER, PARAMETER :: var_size = 32 ! SIZE OF A VARIABLE TEXT
27  INTEGER, PARAMETER :: title_size = 80 ! SIZE OF A TITLE
28 !
29  TYPE cgns_info
30  ! SIZE OF ELEMENTS
31  CHARACTER(LEN=250) :: file_name
32  CHARACTER(LEN=32) :: title
33  INTEGER :: index_zone
34  INTEGER :: index_base
35  INTEGER :: index_section
36  INTEGER :: index_flow
37  INTEGER :: index_field
38  INTEGER :: nelem
39  INTEGER :: npoin
40  INTEGER :: ndp
41  INTEGER :: type_elem
42  INTEGER :: ndim
43  INTEGER :: nvar
44  INTEGER :: ntimestep
45  DOUBLE PRECISION, ALLOCATABLE :: times(:)
46  CHARACTER(LEN=VAR_SIZE), ALLOCATABLE :: varname(:)
47  LOGICAL :: write_at_end
48  INTEGER :: ncli
49  INTEGER :: nptfr
50  END TYPE cgns_info
51 
52  ! HASH TABLE FOR CGNS FILES
53  INTEGER :: hash(max_file) = 0
55 !
56 !-----------------------------------------------------------------------
57 !
58  CONTAINS
59 !***********************************************************************
60 
61 !***********************************************************************
62  SUBROUTINE open_mesh_cgns
63 !***********************************************************************
64 !
65  &(file_name,file_id,openmode,ierr)
66 !
67 !***********************************************************************
68 ! HERMES V7P0 01/05/2014
69 !***********************************************************************
70 !
71 !brief OPENS A MESH FILE
72 !
73 !history Y AUDOUIN (LNHE)
74 !+ 24/03/2014
75 !+ V7P0
76 !+
77 !
78 !history S.E. BOURBAN (HRW)
79 !+ 20/06/2016
80 !+ V7P2
81 !+ Compiler specific directive added because not all compilers
82 !+ support OPEN( CONVERT= )
83 !
84 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
85 !| FILE_NAME |-->| NAME OF THE FILE
86 !| FILE_ID |-->| FILE DESCRIPTOR
87 !| OPENMODE |-->| ONE OF THE FOLLOWING VALUE 'READ','READWRITE'
88 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
89 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
90 !
91  IMPLICIT NONE
92  !
93  INTEGER, INTENT(OUT) :: FILE_ID
94  CHARACTER(LEN=9), INTENT(IN) :: OPENMODE
95  CHARACTER(LEN=*), INTENT(IN) :: FILE_NAME
96  INTEGER, INTENT(OUT) :: IERR
97  !
98 #if defined (HAVE_CGNS)
99  INTEGER :: CGNS_ID
100  CHARACTER(LEN=32) :: CGNSNAME
101  INTEGER :: IPHYSDIM
102  INTEGER :: ISIZE(3,3)
103  INTEGER :: NBDYELEM
104  INTEGER :: TYPGEO
105  INTEGER :: PARENT_FLAG
106  INTEGER :: ISTART, IEND
107  INTEGER CGNS_OPENMODE
108  !
109  ! ADD A NEW FILE TO THE HASH TABLE
110  !
111  IF(openmode(1:5).EQ.'WRITE') THEN
112  cgns_openmode = cg_mode_write
113  ELSE IF(openmode.EQ.'READWRITE') THEN
114  cgns_openmode = cg_mode_modify
115  ELSE
116  cgns_openmode = cg_mode_read
117  ENDIF
118  !
119  CALL cg_open_f(file_name,cgns_openmode,file_id,ierr)
120  IF(ierr.NE.cg_ok) CALL cg_error_print_f
121  IF(ierr.NE.0) THEN
122  error_message = 'ERROR IN '//trim(file_name)//': '//
123  & 'OPEN_MESH_CGNS:CG_OPEN_F'
124  RETURN
125  ENDIF
126  !
127  CALL add_obj(hash,file_id,cgns_id,ierr)
128  IF(ierr.NE.0) THEN
129  error_message = 'ERROR IN '//trim(file_name)//': '//
130  & 'OPEN_MESH_CGNS:ADD_CGNS_FILE'
131  RETURN
132  ENDIF
133  cgns_obj_tab(cgns_id)%FILE_NAME = file_name
134  !
135  cgns_obj_tab(cgns_id)%NTIMESTEP = 0
136  IF(openmode(1:5).EQ.'WRITE') THEN
137  cgns_obj_tab(cgns_id)%WRITE_AT_END = .true.
138  ELSE IF(openmode.EQ.'READWRITE') THEN
139  cgns_obj_tab(cgns_id)%WRITE_AT_END = .true.
140  ELSE
141  cgns_obj_tab(cgns_id)%WRITE_AT_END = .false.
142  ENDIF
143  IF(openmode(1:5).EQ.'READ ') THEN
144  !READ BASE
145  cgns_obj_tab(cgns_id)%INDEX_BASE = 1
146  CALL cg_base_read_f(file_id,cgns_obj_tab(cgns_id)%INDEX_BASE,
147  & cgnsname,cgns_obj_tab(cgns_id)%NDIM,
148  & iphysdim,ierr)
149  IF(ierr.NE.cg_ok) CALL cg_error_print_f
150  IF(ierr.NE.0) THEN
151  error_message = 'ERROR IN '//
152  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
153  & 'OPEN_MESH_CGNS:CG_BASE_READ_F'
154  RETURN
155  ENDIF
156  ! READ ZONE INFORMATION
157  cgns_obj_tab(cgns_id)%INDEX_ZONE = 1
158  CALL cg_zone_read_f(file_id,cgns_obj_tab(cgns_id)%INDEX_BASE,
159  & cgns_obj_tab(cgns_id)%INDEX_ZONE,cgnsname,
160  & isize(1,:),ierr)
161  IF(ierr.NE.cg_ok) CALL cg_error_print_f
162  IF(ierr.NE.0) THEN
163  error_message = 'ERROR IN '//
164  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
165  & 'OPEN_MESH_CGNS:CG_ZONE_READ_F'
166  RETURN
167  ENDIF
168  cgns_obj_tab(cgns_id)%NPOIN = isize(1,1)
169  cgns_obj_tab(cgns_id)%TITLE = cgnsname
170  ! IDENTIFY THE ELEMENT TYPE
171  cgns_obj_tab(cgns_id)%INDEX_SECTION = 1
172  CALL cg_section_read_f(file_id,
173  & cgns_obj_tab(cgns_id)%INDEX_BASE,
174  & cgns_obj_tab(cgns_id)%INDEX_ZONE,
175  & cgns_obj_tab(cgns_id)%INDEX_SECTION,cgnsname,typgeo,
176  & istart,iend,nbdyelem,
177  & parent_flag,ierr)
178  IF(ierr.NE.cg_ok) CALL cg_error_print_f
179  IF(ierr.NE.0) THEN
180  error_message = 'ERROR IN '//
181  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
182  & 'OPEN_MESH_CGNS:CG_SECTION_READ_F'
183  RETURN
184  ENDIF
185  ! COUNTING THE NUMBER OF ELEMENTS
186  cgns_obj_tab(cgns_id)%NELEM = iend
187  SELECT CASE (typgeo)
188  CASE(tri_3)
189  cgns_obj_tab(cgns_id)%TYPE_ELEM = triangle_elt_type
190  cgns_obj_tab(cgns_id)%NDP = 3
191  CASE(quad_4)
192  cgns_obj_tab(cgns_id)%TYPE_ELEM = quadrangle_elt_type
193  cgns_obj_tab(cgns_id)%NDP = 4
194  CASE(tetra_4)
195  cgns_obj_tab(cgns_id)%TYPE_ELEM = tetrahedron_elt_type
196  cgns_obj_tab(cgns_id)%NDP = 4
197  CASE(penta_6)
198  cgns_obj_tab(cgns_id)%TYPE_ELEM = prism_elt_type
199  cgns_obj_tab(cgns_id)%NDP = 6
200  END SELECT
201  ! READING THE NUMBER OF TIMESTEP
202  CALL cg_biter_read_f(file_id,cgns_obj_tab(cgns_id)%INDEX_BASE,
203  & cgnsname,cgns_obj_tab(cgns_id)%NTIMESTEP,ierr)
204  IF(ierr.NE.cg_ok) CALL cg_error_print_f
205  IF(ierr.NE.0) THEN
206  error_message = 'ERROR IN '//
207  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
208  & 'OPEN_MESH:CG_BITER_READ_F'
209  RETURN
210  ENDIF
211  ! IF WE HAVE RESULTS
212  IF(cgns_obj_tab(cgns_id)%NTIMESTEP.NE.0) THEN
213  CALL cg_nfields_f(file_id,cgns_obj_tab(cgns_id)%INDEX_BASE,
214  & cgns_obj_tab(cgns_id)%INDEX_ZONE,1,
215  & cgns_obj_tab(cgns_id)%NVAR,ierr)
216  IF(ierr.NE.cg_ok) CALL cg_error_print_f
217  IF(ierr.NE.0) THEN
218  error_message = 'ERROR IN '//
219  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
220  & 'OPEN_MESH:CG_NFIELDS_F'
221  RETURN
222  ENDIF
223  ! READING THE TIME TABLE
224  ! GO TO BASEITERATIVEDATA LEVEL
225  CALL cg_goto_f(file_id,cgns_obj_tab(cgns_id)%INDEX_BASE,
226  & ierr,'BaseIterativeData_t',
227  & 1,'end')
228  IF(ierr.NE.cg_ok) CALL cg_error_print_f
229  IF(ierr.NE.0) THEN
230  error_message = 'ERROR IN '//
231  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
232  & 'OPEN_MESH:CG_GOTO_F'
233  RETURN
234  ENDIF
235  ALLOCATE(cgns_obj_tab(cgns_id)%TIMES(
236  & cgns_obj_tab(cgns_id)%NTIMESTEP),stat=ierr)
237  IF(ierr.NE.0) THEN
238  error_message = 'ERROR IN '//
239  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
240  & 'ALLOCATING TIMES'
241  RETURN
242  ENDIF
243  ! THERE IS NORAMLY ONLY ONE TABLE UNDER THE BASE ITERATIVE NODE
244  CALL cg_array_read_f(1,cgns_obj_tab(cgns_id)%TIMES,ierr)
245  IF(ierr.NE.cg_ok) CALL cg_error_print_f
246  IF(ierr.NE.0) THEN
247  error_message = 'ERROR IN '//
248  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
249  & 'OPEN_MESH:CG_ARRAY_READ_F'
250  RETURN
251  ENDIF
252  ENDIF
253  ELSE
254  cgns_obj_tab(cgns_id)%INDEX_BASE = 1
255  cgns_obj_tab(cgns_id)%INDEX_ZONE = 1
256  cgns_obj_tab(cgns_id)%INDEX_SECTION = 1
257  ENDIF
258 #else
259 !
260 ! CGNS LIBRARY NOT LOADED
261  file_id = 0
263 !
264 #endif
265 
266  RETURN
267  END SUBROUTINE
268 !***********************************************************************
269  SUBROUTINE open_bnd_cgns
270 !***********************************************************************
271 !
272  &(file_name,file_id,openmode,ierr)
273 !
274 !***********************************************************************
275 ! HERMES V7P0 01/05/2014
276 !***********************************************************************
277 !
278 !brief OPENS A BOUNDARY FILE
279 !
280 !history Y AUDOUIN (LNHE)
281 !+ 24/03/2014
282 !+ V7P0
283 !+
284 !
285 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
286 !| FILE_NAME |-->| NAME OF THE BOUNDARY FILE
287 !| FILE_ID |-->| FILE DESCRIPTOR OF THE "MESH" FILE
288 !| OPENMODE |-->| ONE OF THE FOLLOWING VALUE 'READ','WRITE','READWRITE'
289 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
290 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
291 !
292  IMPLICIT NONE
293  !
294  CHARACTER(LEN=*), INTENT(IN) :: FILE_NAME
295  INTEGER, INTENT(IN) :: FILE_ID
296  CHARACTER(LEN=9), INTENT(IN) :: OPENMODE
297  INTEGER, INTENT(OUT) :: IERR
298  !
299 #if defined (HAVE_CGNS)
300  INTEGER CGNS_ID,I
301  INTEGER :: NPTFR
302  LOGICAL :: ISOPENED, IS_USED
303  !
304  isopened = .false.
305  CALL get_obj(hash,file_id,cgns_id,ierr)
306  IF(ierr.NE.0) THEN
307  error_message = 'ERROR IN '//
308  & trim(file_name)//': '//
309  & 'OPEN_BND_CGNS:GET_CGNS_OBJ'
310  RETURN
311  ENDIF
312  !
313  ! Open the boundary file with a set id available
314  ! First we check if the file is already opened
315  ! Telemac is using one boundary file for all the mesh file
316  ! so it could have been opened by another mesh before hand
317  INQUIRE(file=file_name,opened=isopened)
318  IF(isopened) THEN
319  ! Id the file is already opened get its id
320  INQUIRE(file=file_name,number=cgns_obj_tab(cgns_id)%NCLI)
321  ELSE
322  ! Otherwise open the file
323  CALL get_free_id(cgns_obj_tab(cgns_id)%NCLI)
324  OPEN(unit=cgns_obj_tab(cgns_id)%NCLI,file=file_name,
325  & form='FORMATTED',action=openmode,iostat=ierr)
326  ENDIF
327  ! If we are not in write only
328  ! We compute the number of boundary point i.e. number of line in the file
329  IF(openmode(1:5).NE.'WRITE') THEN
330  rewind(cgns_obj_tab(cgns_id)%NCLI)
331  IF(ierr.NE.0) THEN
332  error_message = 'ERROR IN '//
333  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
334  & 'OPEN_BND_CGNS:OPEN'
335  RETURN
336  ENDIF
337  nptfr = 0
338  DO
339  READ(cgns_obj_tab(cgns_id)%NCLI,*,iostat=ierr)
340  IF (ierr.LT.0) THEN
341  ! END OF FILE REACHED
342  EXIT
343  ELSE IF (ierr.GT.0) THEN
344  ! Error during read
345  IF(ierr.NE.0) THEN
346  error_message = 'ERROR IN '//
347  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
348  & 'OPEN_BND_CGNS:READ'
349  RETURN
350  ENDIF
351  ENDIF
352  nptfr = nptfr + 1
353  ENDDO
354  ierr = 0
355  cgns_obj_tab(cgns_id)%NPTFR = nptfr
356  ENDIF
357  RETURN
358  !
359 #else
360 !
361 ! CGNS LIBRARY NOT LOADED
363 !
364 #endif
365  END SUBROUTINE
366 !***********************************************************************
367  SUBROUTINE close_bnd_cgns
368 !***********************************************************************
369 !
370  &(file_id,ierr)
371 !
372 !***********************************************************************
373 ! HERMES V7P0 01/05/2014
374 !***********************************************************************
375 !
376 !BRIEF CLOSES A BOUNDARY FILE
377 !
378 !HISTORY Y AUDOUIN (LNHE)
379 !+ 24/03/2014
380 !+ V7P0
381 !+
382 !
383 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
384 !| FILE_ID |-->| FILE DESCRIPTOR
385 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
386 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
387 !
388  IMPLICIT NONE
389  !
390  INTEGER, INTENT(IN) :: FILE_ID
391  INTEGER, INTENT(OUT) :: IERR
392  !
393 #if defined (HAVE_CGNS)
394  INTEGER CGNS_ID
395  LOGICAL ISOPENED
396  !
397  CALL get_obj(hash,file_id,cgns_id,ierr)
398  IF(ierr.NE.0) THEN
399  error_message = 'ERROR WITH FILE ID '//i2char(file_id)//': '//
400  & 'CLOSE_BND_CGNS:GET_CGNS_OBJ'
401  RETURN
402  ENDIF
403  !
404  isopened = .false.
405  ! Check if the file is still opened as it could have been closed
406  ! by another mesh file (see open_bnd_CGNS for more information)
407  INQUIRE(unit=cgns_obj_tab(cgns_id)%NCLI,opened=isopened)
408  ierr = 0
409  IF(isopened) THEN
410  CLOSE(cgns_obj_tab(cgns_id)%NCLI,iostat=ierr)
411  ENDIF
412  IF(ierr.NE.0) THEN
413  error_message = 'ERROR IN '//
414  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
415  & 'CLOSE_BND_CGNS:CLOSE'
416  RETURN
417  ENDIF
418  !
419 #else
420 !
421 ! CGNS LIBRARY NOT LOADED
423 !
424 #endif
425  END SUBROUTINE
426 !***********************************************************************
427  SUBROUTINE close_mesh_cgns
428 !***********************************************************************
429 !
430  &(file_id,ierr)
431 !
432 !***********************************************************************
433 ! HERMES V7P0 01/05/2014
434 !***********************************************************************
435 !
436 !BRIEF CLOSES A MESH FILE
437 !
438 !HISTORY Y AUDOUIN (LNHE)
439 !+ 24/03/2014
440 !+ V7P0
441 !+
442 !
443 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
444 !| FILE_ID |-->| FILE DESCRIPTOR
445 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
446 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
447 !
448  IMPLICIT NONE
449  !
450  INTEGER, INTENT(IN) :: FILE_ID
451  INTEGER, INTENT(OUT) :: IERR
452  !
453 #if defined HAVE_CGNS
454  INTEGER CGNS_ID,I
455  INTEGER :: IDATA(2)
456  CHARACTER(LEN=32), ALLOCATABLE :: SOLNAME(:)
457  !
458  CALL get_obj(hash,file_id,cgns_id,ierr)
459  IF(ierr.NE.0) THEN
460  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
461  & 'CLOSE_MESH:GET_CGNS_OBJ'
462  RETURN
463  ENDIF
464  ! If we are writing a file we need to output this at the end
465  IF (cgns_obj_tab(cgns_id)%WRITE_AT_END) THEN
466  ! CREATE BASEITERATIVEDATA
467  CALL cg_biter_write_f(file_id,
468  & cgns_obj_tab(cgns_id)%INDEX_BASE,'TimeIterValues',
469  & cgns_obj_tab(cgns_id)%NTIMESTEP,ierr)
470  IF(ierr.NE.cg_ok) CALL cg_error_print_f
471  IF(ierr.NE.0) THEN
472  error_message = 'ERROR IN '//
473  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
474  & 'CLOSE_MESH:CG_BITER_WRITE_F'
475  RETURN
476  ENDIF
477  ! GO TO BASEITERATIVEDATA LEVEL AND WRITE TIME VALUES
478  CALL cg_goto_f(file_id,cgns_obj_tab(cgns_id)%INDEX_BASE,ierr,
479  & 'BaseIterativeData_t',
480  & 1,'end')
481  IF(ierr.NE.cg_ok) CALL cg_error_print_f
482  IF(ierr.NE.0) THEN
483  error_message = 'ERROR IN '//
484  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
485  & 'CLOSE_MESH:CG_GOTO_F'
486  RETURN
487  ENDIF
488  CALL cg_array_write_f('TimeValues',realdouble,1,
489  & cgns_obj_tab(cgns_id)%NTIMESTEP,
490  & cgns_obj_tab(cgns_id)%TIMES,ierr)
491  IF(ierr.NE.cg_ok) CALL cg_error_print_f
492  IF(ierr.NE.0) THEN
493  error_message = 'ERROR IN '//
494  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
495  & 'CLOSE_MESH:CG_ARRAY_WRITE_F'
496  RETURN
497  ENDIF
498  ! CREATE ZONEITERATIVEDATA
499  CALL cg_ziter_write_f(file_id,
500  & cgns_obj_tab(cgns_id)%INDEX_BASE,
501  & cgns_obj_tab(cgns_id)%INDEX_ZONE,
502  & 'ZoneIterativeData',ierr)
503  IF(ierr.NE.cg_ok) CALL cg_error_print_f
504  IF(ierr.NE.0) THEN
505  error_message = 'ERROR IN '//
506  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
507  & 'CLOSE_MESH:CG_ZITER_WRITE_F'
508  RETURN
509  ENDIF
510  ! GO TO ZONEITERATIVEDATA LEVEL AND GIVE INFO TELLING WHICH
511  ! FLOW SOLUTION CORRESPONDS WITH WHICH TIME (SOLNAME(1) CORRESPONDS
512  ! WITH TIME(1), SOLNAME(2) WITH TIME(2), AND SOLNAME(3) WITH TIME(3))
513 
514  ALLOCATE(solname(cgns_obj_tab(cgns_id)%NTIMESTEP),stat=ierr)
515  IF(ierr.NE.0) THEN
516  error_message = 'ERROR IN '//
517  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
518  & 'ALLOCATING SOLNAME'
519  RETURN
520  ENDIF
521  DO i=1,cgns_obj_tab(cgns_id)%NTIMESTEP
522  solname = repeat(' ',32)
523  solname(i) = 'Time'//i2char(i)
524  ENDDO
525  CALL cg_goto_f(file_id,cgns_obj_tab(cgns_id)%INDEX_BASE,
526  & ierr,'Zone_t',
527  & cgns_obj_tab(cgns_id)%INDEX_ZONE,
528  & 'ZoneIterativeData_t',1,'end')
529  IF(ierr.NE.cg_ok) CALL cg_error_print_f
530  IF(ierr.NE.0) THEN
531  error_message = 'ERROR IN '//
532  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
533  & 'CLOSE_MESH:CG_GOTO_F BIS'
534  RETURN
535  ENDIF
536  idata(1)=32
537  idata(2)=cgns_obj_tab(cgns_id)%NTIMESTEP
538  CALL cg_array_write_f('FlowSolutionPointers',CHARACTER,
539  & 2,idata,solname,ierr)
540  IF(ierr.NE.cg_ok) CALL cg_error_print_f
541  IF(ierr.NE.0) THEN
542  error_message = 'ERROR IN '//
543  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
544  & 'CLOSE_MESH:CG_ARRAY_WRITE_F BIS'
545  RETURN
546  ENDIF
547  ! ADD SIMULATIONTYPE
548  CALL cg_simulation_type_write_f(file_id,
549  & cgns_obj_tab(cgns_id)%INDEX_BASE,
550  & timeaccurate,ierr)
551  IF(ierr.NE.cg_ok) CALL cg_error_print_f
552  IF(ierr.NE.0) THEN
553  error_message = 'ERROR IN '//
554  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
555  & 'CLOSE_MESH:CG_SIMULATION_TYPE_WRITE_F'
556  RETURN
557  ENDIF
558  DEALLOCATE(solname)
559  ENDIF
560  ! CLOSE CGNS CFILE
561  CALL cg_close_f(file_id,ierr)
562  IF(ierr.NE.cg_ok) CALL cg_error_print_f
563  IF(ierr.NE.0) THEN
564  error_message = 'ERROR IN '//
565  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
566  & 'CLOSE_MESH:CG_CLOSE_F'
567  RETURN
568  ENDIF
569  ! Deallocating arrays
570  IF(ALLOCATED(cgns_obj_tab(cgns_id)%TIMES)) THEN
571  DEALLOCATE(cgns_obj_tab(cgns_id)%TIMES)
572  ENDIF
573  IF(ALLOCATED(cgns_obj_tab(cgns_id)%VARNAME)) THEN
574  DEALLOCATE(cgns_obj_tab(cgns_id)%VARNAME)
575  ENDIF
576 #else
577 !
578 ! CGNS LIBRARY NOT LOADED
580 !
581 #endif
582  RETURN
583  END SUBROUTINE
584 !
585 ! Mesh functions
586 !
587 !***********************************************************************
588  SUBROUTINE get_mesh_title_cgns
589 !***********************************************************************
590 !
591  &(file_id,title,ierr)
592 !
593 !***********************************************************************
594 ! HERMES V7P0 01/05/2014
595 !***********************************************************************
596 !
597 !brief Returns the title from a mesh file
598 !
599 !history Y AUDOUIN (LNHE)
600 !+ 24/03/2014
601 !+ V7P0
602 !+
603 !
604 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
605 !| FILE_ID |-->| FILE DESCRIPTOR
606 !| TITLE |<->| TITLE OF THE MESH FILE
607 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
608 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
609 !
610  IMPLICIT NONE
611  !
612  INTEGER, INTENT(IN) :: FILE_ID
613  CHARACTER(LEN=TITLE_SIZE), INTENT(INOUT) :: TITLE
614  INTEGER, INTENT(OUT) :: IERR
615  !
616 #if defined (HAVE_CGNS)
617  INTEGER(KIND=K8) :: MY_POS
618  INTEGER :: CGNS_ID
619  !
620  CALL get_obj(hash,file_id,cgns_id,ierr)
621  IF(ierr.NE.cg_ok) CALL cg_error_print_f
622  IF(ierr.NE.0) THEN
623  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
624  & 'CLOSE_MESH:GET_CGNS_OBJ'
625  RETURN
626  ENDIF
627  !
628  title = repeat(' ',title_size)
629  title(1:32) = cgns_obj_tab(cgns_id)%TITLE
630  !
631 #else
632 !
633 ! CGNS LIBRARY NOT LOADED
635 !
636 #endif
637  RETURN
638  END SUBROUTINE
639 !***********************************************************************
641 !***********************************************************************
642 !
643  &(file_id,typ_elt,nelem,ierr)
644 !
645 !***********************************************************************
646 ! HERMES V7P0 01/05/2014
647 !***********************************************************************
648 !
649 !brief Returns the number of elements of type typ_elem in the mesh file
650 !
651 !history Y AUDOUIN (LNHE)
652 !+ 24/03/2014
653 !+ V7P0
654 !+
655 !
656 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
657 !| FILE_ID |-->| FILE DESCRIPTOR
658 !| TYP_ELEM |-->| TYPE OF THE ELEMENT
659 !| NELEM |<->| THE NUMBER OF ELEMENTS
660 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
661 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
662 !
663  IMPLICIT NONE
664  !
665  INTEGER, INTENT(IN) :: FILE_ID
666  INTEGER, INTENT(IN) :: TYP_ELT
667  INTEGER, INTENT(INOUT) :: NELEM
668  INTEGER, INTENT(OUT) :: IERR
669  !
670 #if defined (HAVE_CGNS)
671  INTEGER :: CGNS_ID
672  !
673  CALL get_obj(hash,file_id,cgns_id,ierr)
674  IF(ierr.NE.0) THEN
675  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
676  & 'GET_MESH_NELEM_CGNS:GET_CGNS_OBJ'
677  RETURN
678  ENDIF
679  !
680  nelem = cgns_obj_tab(cgns_id)%NELEM
681  !
682 #else
683 !
684 ! CGNS LIBRARY NOT LOADED
686 !
687 #endif
688  RETURN
689  END SUBROUTINE
690 !***********************************************************************
692 !***********************************************************************
693 !
694  &(file_id,typ_elt,ndp,ierr)
695 !
696 !***********************************************************************
697 ! HERMES V7P0 01/05/2014
698 !***********************************************************************
699 !
700 !brief Returns the number of point per element of type typ_elem
701 !
702 !history Y AUDOUIN (LNHE)
703 !+ 24/03/2014
704 !+ V7P0
705 !+
706 !
707 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
708 !| FILE_ID |-->| FILE DESCRIPTOR
709 !| TYP_ELEM |-->| TYPE OF THE ELEMENT
710 !| NDP |<->| THE NUMBER OF POINT PER ELEMENT
711 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
712 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
713 !
714  IMPLICIT NONE
715  !
716  INTEGER, INTENT(IN) :: FILE_ID
717  INTEGER, INTENT(IN) :: TYP_ELT
718  INTEGER, INTENT(INOUT) :: NDP
719  INTEGER, INTENT(OUT) :: IERR
720  !
721 #if defined (HAVE_CGNS)
722  INTEGER :: CGNS_ID
723  !
724  CALL get_obj(hash,file_id,cgns_id,ierr)
725  IF(ierr.NE.0) THEN
726  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
727  & 'GET_MESH_NPOIN_PER_ELEMENT_CGNS:GET_CGNS_OBJ'
728  RETURN
729  ENDIF
730  !
731  ndp = cgns_obj_tab(cgns_id)%NDP
732  !
733 #else
734 !
735 ! CGNS LIBRARY NOT LOADED
737 !
738 #endif
739  RETURN
740  END SUBROUTINE
741 !***********************************************************************
742  SUBROUTINE get_mesh_connectivity_cgns
743 !***********************************************************************
744 !
745  &(file_id,typ_elt,ikle,nelem,ndp,ierr)
746 !
747 !***********************************************************************
748 ! HERMES V7P0 01/05/2014
749 !***********************************************************************
750 !
751 !brief Returns the connectivity table for
752 !+ the element of type typ_elem in the mesh
753 !+ will do nothing if there are no element of typ_elem in the mesh
754 !
755 !history Y AUDOUIN (LNHE)
756 !+ 24/03/2014
757 !+ V7P0
758 !+
759 !
760 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
761 !| FILE_ID |-->| FILE DESCRIPTOR
762 !| TYP_ELEM |-->| TYPE OF THE ELEMENT
763 !| IKLE |<->| THE CONNECTIVITY TABLE
764 !| NELEM |-->| NUMBER OF ELEMENTS
765 !| NDP |-->| NUMBER OF POINTS PER ELEMENT
766 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
767 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
768 !
769  IMPLICIT NONE
770  !
771  INTEGER, INTENT(IN) :: FILE_ID
772  INTEGER, INTENT(IN) :: TYP_ELT
773  INTEGER, INTENT(IN) :: NELEM
774  INTEGER, INTENT(IN) :: NDP
775  INTEGER, INTENT(INOUT) :: IKLE(nelem*ndp)
776  INTEGER, INTENT(OUT) :: IERR
777  !
778 #if defined (HAVE_CGNS)
779  INTEGER :: CGNS_ID
780  INTEGER, ALLOCATABLE :: IELEM(:,:)
781  INTEGER :: PARENT(1)
782  INTEGER :: I,J
783  !
784  CALL get_obj(hash,file_id,cgns_id,ierr)
785  IF(ierr.NE.0) THEN
786  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
787  & 'GET_MESH_CONNECTIVITY_CGNS:GET_CGNS_OBJ'
788  RETURN
789  ENDIF
790  !
791  ALLOCATE(ielem(cgns_obj_tab(cgns_id)%NDP,
792  & cgns_obj_tab(cgns_id)%NELEM),
793  & stat=ierr)
794  IF(ierr.NE.0) THEN
795  error_message = 'ERROR IN '//
796  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
797  & 'ALLOCATING IELEM'
798  RETURN
799  ENDIF
800  ! TODO: Check unallocated parent will cause bug in debug
801  ! READING THE CONNECTIVITY TABLE
802  CALL cg_elements_read_f(file_id,
803  & cgns_obj_tab(cgns_id)%INDEX_BASE,
804  & cgns_obj_tab(cgns_id)%INDEX_ZONE,
805  & cgns_obj_tab(cgns_id)%INDEX_SECTION,
806  & ielem,parent,ierr)
807  IF(ierr.NE.cg_ok) CALL cg_error_print_f
808  IF(ierr.NE.0) THEN
809  error_message = 'ERROR IN '//
810  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
811  & 'GET_MESH_CONNECTIVITY_CGNS:CG_ELEMENTS_READ_F'
812  RETURN
813  ENDIF
814  ! BUILDING THE CONNECTIVITY TABLE
815  DO i=1,cgns_obj_tab(cgns_id)%NELEM
816  DO j=1,cgns_obj_tab(cgns_id)%NDP
817  ikle((i-1)*cgns_obj_tab(cgns_id)%NDP+j) = ielem(j,i)
818  ENDDO
819  ENDDO
820  DEALLOCATE(ielem)
821  !
822 #else
823 !
824 ! CGNS LIBRARY NOT LOADED
826 !
827 #endif
828  RETURN
829  END SUBROUTINE
830 !***********************************************************************
831  SUBROUTINE get_mesh_npoin_cgns
832 !***********************************************************************
833 !
834  &(file_id,typ_elt,npoin,ierr)
835 !
836 !***********************************************************************
837 ! HERMES V7P0 01/05/2014
838 !***********************************************************************
839 !
840 !brief Returns the number of point for the given element type in the mesh file
841 !
842 !history Y AUDOUIN (LNHE)
843 !+ 24/03/2014
844 !+ V7P0
845 !+
846 !
847 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
848 !| FILE_ID |-->| FILE DESCRIPTOR
849 !| TYP_ELEM |-->| TYPE OF THE ELEMENT
850 !| NPOIN |<->| THE NUMBER OF POINTS
851 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
852 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
853 !
854  IMPLICIT NONE
855  !
856  INTEGER, INTENT(IN) :: FILE_ID
857  INTEGER, INTENT(IN) :: TYP_ELT
858  INTEGER, INTENT(INOUT) :: NPOIN
859  INTEGER, INTENT(OUT) :: IERR
860  !
861 #if defined (HAVE_CGNS)
862  INTEGER :: CGNS_ID
863  !
864  CALL get_obj(hash,file_id,cgns_id,ierr)
865  IF(ierr.NE.0) THEN
866  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
867  & 'GET_MESH_NPOIN_CGNS:GET_CGNS_OBJ'
868  RETURN
869  ENDIF
870  !
871  npoin = cgns_obj_tab(cgns_id)%NPOIN
872  !
873 #else
874 !
875 ! CGNS LIBRARY NOT LOADED
877 !
878 #endif
879  RETURN
880  END SUBROUTINE
881 !***********************************************************************
882  SUBROUTINE get_mesh_nplan_cgns
883 !***********************************************************************
884 !
885  &(file_id,nplan,ierr)
886 !
887 !***********************************************************************
888 ! HERMES V7P0 01/05/2014
889 !***********************************************************************
890 !
891 !brief Returns the number of layers
892 !
893 !history Y AUDOUIN (LNHE)
894 !+ 24/03/2014
895 !+ V7P0
896 !+
897 !
898 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
899 !| FILE_ID |-->| FILE DESCRIPTOR
900 !| NPLAN |<->| THE NUMBER OF LAYERS
901 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
902 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
903 !
904  IMPLICIT NONE
905  !
906  INTEGER, INTENT(IN) :: FILE_ID
907  INTEGER, INTENT(INOUT) :: NPLAN
908  INTEGER, INTENT(OUT) :: IERR
909  !
910 #if defined (HAVE_CGNS)
911  INTEGER :: CGNS_ID
912  !
913  CALL get_obj(hash,file_id,cgns_id,ierr)
914  IF(ierr.NE.0) THEN
915  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
916  & 'GET_MESH_NPLAN_CGNS:GET_CGNS_OBJ'
917  RETURN
918  ENDIF
919  !
920  ! TODO: See to that
921  !
922 #else
923 !
924 ! CGNS LIBRARY NOT LOADED
926 !
927 #endif
928  RETURN
929  END SUBROUTINE
930 !***********************************************************************
931  SUBROUTINE get_mesh_dimension_cgns
932 !***********************************************************************
933 !
934  &(file_id,ndim,ierr)
935 !
936 !***********************************************************************
937 ! HERMES V7P0 01/05/2014
938 !***********************************************************************
939 !
940 !brief Returns the number of dimensions of the space
941 !
942 !history Y AUDOUIN (LNHE)
943 !+ 24/03/2014
944 !+ V7P0
945 !+
946 !
947 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
948 !| FILE_ID |-->| FILE DESCRIPTOR
949 !| NDIM |<->| NUMBER OF DIMENSION
950 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
951 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
952 !
953  IMPLICIT NONE
954  !
955  INTEGER, INTENT(IN) :: FILE_ID
956  INTEGER, INTENT(INOUT) :: NDIM
957  INTEGER, INTENT(OUT) :: IERR
958  !
959 #if defined (HAVE_CGNS)
960  INTEGER :: CGNS_ID
961  !
962  CALL get_obj(hash,file_id,cgns_id,ierr)
963  IF(ierr.NE.0) THEN
964  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
965  & 'GET_MESH_DIMENSION_CGNS:GET_CGNS_OBJ'
966  RETURN
967  ENDIF
968  !
969  ndim = cgns_obj_tab(cgns_id)%NDIM
970  !
971 #else
972 !
973 ! CGNS LIBRARY NOT LOADED
975 !
976 #endif
977  RETURN
978  END SUBROUTINE
979 !***********************************************************************
980  SUBROUTINE get_mesh_coord_cgns
981 !***********************************************************************
982 !
983  &(file_id,jdim,npoin,coord,ierr)
984 !
985 !***********************************************************************
986 ! HERMES V7P0 01/05/2014
987 !***********************************************************************
988 !
989 !brief Returns the coordinates for the given dimension
990 !
991 !history Y AUDOUIN (LNHE)
992 !+ 24/03/2014
993 !+ V7P0
994 !+
995 !
996 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
997 !| FILE_ID |-->| FILE DESCRIPTOR
998 !| JDIM |-->| DIMENSION NUMBER
999 !| NPOIN |-->| TOTAL NUMBER OF NODES
1000 !| COORD |<->| LOCAL TO GLOBAL NUMBERING ARRAY
1001 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
1002 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1003 !
1004  IMPLICIT NONE
1005  !
1006  INTEGER, INTENT(IN) :: FILE_ID
1007  INTEGER, INTENT(IN) :: JDIM
1008  INTEGER, INTENT(IN) :: NPOIN
1009  DOUBLE PRECISION, INTENT(INOUT) :: COORD(npoin)
1010  INTEGER, INTENT(OUT) :: IERR
1011  !
1012 #if defined (HAVE_CGNS)
1013  INTEGER :: CGNS_ID
1014  CHARACTER(LEN=11) :: COORDNAME
1015  !
1016  CALL get_obj(hash,file_id,cgns_id,ierr)
1017  IF(ierr.NE.0) THEN
1018  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
1019  & 'GET_MESH_COORD_CGNS:GET_CGNS_OBJ'
1020  RETURN
1021  ENDIF
1022  !
1023  SELECT CASE(jdim)
1024  CASE(1)
1025  coordname = 'CoordinateX'
1026  CASE(2)
1027  coordname = 'CoordinateY'
1028  CASE(3)
1029  coordname = 'CoordinateZ'
1030  END SELECT
1031  CALL cg_coord_read_f(file_id,cgns_obj_tab(cgns_id)%INDEX_BASE,
1032  & cgns_obj_tab(cgns_id)%INDEX_ZONE,
1033  & coordname,
1034  & realdouble,1,npoin,coord,ierr)
1035  IF(ierr.NE.cg_ok) CALL cg_error_print_f
1036  IF(ierr.NE.0) THEN
1037  error_message = 'ERROR IN '//
1038  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
1039  & 'GET_MESH_COORD_CGNS:CG_COORD_READ_F'
1040  RETURN
1041  ENDIF
1042  !
1043 #else
1044 !
1045 ! CGNS LIBRARY NOT LOADED
1047 !
1048 #endif
1049  RETURN
1050  END SUBROUTINE
1051 !***********************************************************************
1052  SUBROUTINE get_mesh_l2g_numbering_cgns
1053 !***********************************************************************
1054 !
1055  &(file_id,knolg,npoin,ierr)
1056 !
1057 !***********************************************************************
1058 ! HERMES V7P0 01/05/2014
1059 !***********************************************************************
1060 !
1061 !brief Returns the local to global numbering array
1062 !
1063 !history Y AUDOUIN (LNHE)
1064 !+ 24/03/2014
1065 !+ V7P0
1066 !+
1067 !
1068 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1069 !| FFORMAT |-->| FORMAT OF THE FILE
1070 !| FILE_ID |-->| FILE DESCRIPTOR
1071 !| KNOLG |<->| LOCAL TO GLOBAL NUMBERING ARRAY
1072 !| NPOIN |-->| NUMBER OF NODES
1073 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
1074 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1075 !
1076  IMPLICIT NONE
1077  !
1078  INTEGER, INTENT(IN) :: FILE_ID
1079  INTEGER, INTENT(IN) :: NPOIN
1080  INTEGER, INTENT(INOUT) :: KNOLG(npoin)
1081  INTEGER, INTENT(OUT) :: IERR
1082  !
1083 #if defined (HAVE_CGNS)
1084  INTEGER :: CGNS_ID
1085  INTEGER :: DISCR_NO, INDEXU
1086  INTEGER :: INDEX_DIM
1087  !
1088  CALL get_obj(hash,file_id,cgns_id,ierr)
1089  IF(ierr.NE.0) THEN
1090  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
1091  & 'GET_MESH_L2G_NUMBERING_CGNS:GET_CGNS_OBJ'
1092  RETURN
1093  ENDIF
1094  !
1095  discr_no = 1
1096 
1097  indexu = 1
1098 
1099  CALL cg_goto_f(file_id, cgns_obj_tab(cgns_id)%INDEX_BASE,
1100  & ierr, 'Zone_t', cgns_obj_tab(cgns_id)%INDEX_ZONE,
1101  & 'DiscreteData_t', discr_no,
1102  & 'UserDefinedData_t', indexu, 'end')
1103  IF(ierr.NE.cg_ok) CALL cg_error_print_f
1104  IF(ierr.NE.0) THEN
1105  error_message = 'ERROR IN '//
1106  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
1107  & 'GET_MESH_L2G_NUMBERING:CG_GOTO_F'
1108  RETURN
1109  ENDIF
1110 
1111  index_dim = 1
1112  CALL cg_array_read_f(knolg, INTEGER, IERR)
1113  IF(ierr.NE.cg_ok) CALL cg_error_print_f
1114  IF(ierr.NE.0) THEN
1115  error_message = 'ERROR IN '//
1116  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
1117  & 'GET_MESH_L2G_NUMBERING_CGNS:CG_ARRAY_READ_F'
1118  RETURN
1119  ENDIF
1120  !
1121 #else
1123 ! CGNS LIBRARY NOT LOADED
1125 !
1126 #endif
1127  RETURN
1128  END SUBROUTINE
1129 !***********************************************************************
1130  SUBROUTINE get_mesh_nptir_cgns
1131 !***********************************************************************
1132 !
1133  &(file_id,nptir,ierr)
1134 !
1135 !***********************************************************************
1136 ! HERMES V7P0 01/05/2014
1137 !***********************************************************************
1138 !
1139 !brief Returns the number of interface point
1140 !
1141 !history Y AUDOUIN (LNHE)
1142 !+ 24/03/2014
1143 !+ V7P0
1144 !+
1145 !
1146 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1147 !| FILE_ID |-->| FILE DESCRIPTOR
1148 !| NPTIR |<->| NUMBER OF INTERFACE POINT
1149 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
1150 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1151 !
1152  IMPLICIT NONE
1153  !
1154  INTEGER, INTENT(IN) :: FILE_ID
1155  INTEGER, INTENT(INOUT) :: NPTIR
1156  INTEGER, INTENT(OUT) :: IERR
1157  !
1158 #if defined (HAVE_CGNS)
1159  INTEGER :: CGNS_ID
1160  !
1161  CALL get_obj(hash,file_id,cgns_id,ierr)
1162  IF(ierr.NE.0) THEN
1163  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
1164  & 'GET_MESH_NPTIR_CGNS:GET_CGNS_OBJ'
1165  RETURN
1166  ENDIF
1167  !
1168  ! TODO: Get how to add this in the format
1169  !
1170 #else
1171 !
1172 ! CGNS LIBRARY NOT LOADED
1174 !
1175 #endif
1176  RETURN
1177  END SUBROUTINE
1178 !
1179 ! Boundary functions
1180 !
1181 !***********************************************************************
1182  SUBROUTINE get_bnd_ipobo_cgns
1183 !***********************************************************************
1184 !
1185  &(file_id,type_bnd_elem,npoin,ipobo,ierr)
1186 !
1187 !***********************************************************************
1188 ! HERMES V7P0 01/05/2014
1189 !***********************************************************************
1190 !
1191 !brief Returns an array containing
1192 !+ 1 if a point is a boundary point 0 otherwise
1193 !
1194 !history Y AUDOUIN (LNHE)
1195 !+ 24/03/2014
1196 !+ V7P0
1197 !+
1198 !
1199 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1200 !| FILE_ID |-->| FILE DESCRIPTOR
1201 !| TYP_BND_ELEM |-->| TYPE OF THE BOUNDARY ELEMENT
1202 !| NPOIN |-->| TOTAL NUMBER OF NODES
1203 !| IPOBO |<->| AN ARRAY CONTAINING
1204 !| | | 1 IF A POINT IS A BOUNDARY POINT 0 OTHERWISE
1205 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
1206 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1207 !
1208  IMPLICIT NONE
1209  !
1210  INTEGER, INTENT(IN) :: FILE_ID
1211  INTEGER, INTENT(IN) :: NPOIN
1212  INTEGER, INTENT(IN) :: TYPE_BND_ELEM
1213  INTEGER, INTENT(INOUT) :: IPOBO(npoin)
1214  INTEGER, INTENT(OUT) :: IERR
1215  !
1216 #if defined (HAVE_CGNS)
1217  INTEGER :: CGNS_ID
1218  INTEGER :: IPTFR
1219  INTEGER :: IDUM, I
1220  DOUBLE PRECISION :: DDUM
1221  !
1222  CALL get_obj(hash,file_id,cgns_id,ierr)
1223  IF(ierr.NE.0) THEN
1224  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
1225  & 'GET_BND_IPOBO_CGNS:GET_CGNS_OBJ'
1226  RETURN
1227  ENDIF
1228  !
1229  ! Checking that we have the right element type
1230  IF(point_bnd_elt_type.NE.type_bnd_elem) THEN
1232  RETURN
1233  ENDIF
1234  ! Read the boundary file we only care about the connectivity
1235  rewind(cgns_obj_tab(cgns_id)%NCLI)
1236  DO i=1,cgns_obj_tab(cgns_id)%NPTFR
1237  READ(cgns_obj_tab(cgns_id)%NCLI,*,iostat=ierr) idum,idum,idum,
1238  & ddum ,ddum ,ddum,
1239  & ddum ,idum,ddum,ddum,ddum,
1240  & iptfr,idum
1241  ipobo(iptfr) = i
1242  IF(ierr.LT.0) THEN
1243  ! End of file reached
1244  IF(ierr.NE.0) THEN
1245  error_message = 'ERROR IN '//
1246  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
1247  & 'GET_BND_CONNECTIVITY_CGNS:READ:END OF FILE'
1248  RETURN
1249  ENDIF
1250  ELSE IF (ierr.GT.0) THEN
1251  ! Error during read
1252  IF(ierr.NE.0) THEN
1253  error_message = 'ERROR IN '//
1254  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
1255  & 'GET_BND_CONNECTIVITY_CGNS:READ'
1256  RETURN
1257  ENDIF
1258  ENDIF
1259  ENDDO
1260 #else
1261 !
1262 ! CGNS LIBRARY NOT LOADED
1264 !
1265 #endif
1266  RETURN
1267  END SUBROUTINE
1268 !
1269 !***********************************************************************
1270  SUBROUTINE get_bnd_numbering_cgns
1271 !***********************************************************************
1272 !
1273  &(file_id,typ_elem_bnd,nptfr,nbor,ierr)
1274 !
1275 !***********************************************************************
1276 ! HERMES V7P0 01/05/2014
1277 !***********************************************************************
1278 !
1279 !brief Returns an array containing
1280 !+ The association of boundary numbering to mesh numbering
1281 !
1282 !history Y AUDOUIN (LNHE)
1283 !+ 24/03/2014
1284 !+ V7P0
1285 !+
1286 !
1287 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1288 !| FILE_ID |-->| FILE DESCRIPTOR
1289 !| TYP_BND_ELEM |-->| TYPE OF THE BOUNDARY ELEMENT
1290 !| NPTFR |-->| NUMBER OF BOUNDARY POINTS
1291 !| NBOR |<->| AN ARRAY CONTAINING THE NUMBERING IN THE MESH
1292 !| | | OF ALL BOUNDARY POINTS
1293 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
1294 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1295 !
1296 !
1297  INTEGER, INTENT(IN) :: FILE_ID,NPTFR,TYP_ELEM_BND
1298  INTEGER, INTENT(INOUT) :: NBOR(nptfr)
1299  INTEGER, INTENT(OUT) :: IERR
1300  !
1301 #if defined (HAVE_CGNS)
1302  INTEGER :: TYP_ELEM
1303  INTEGER :: CGNS_ID
1304  !
1305  typ_elem = 1
1306  CALL get_obj(hash,file_id,cgns_id,ierr)
1307  IF(ierr.NE.0) THEN
1308  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
1309  & 'GET_BND_IPOBO_CGNS:GET_CGNS_OBJ'
1310  RETURN
1311  ENDIF
1312  CALL get_bnd_connectivity_cgns(file_id,typ_elem_bnd,nptfr,
1313  & typ_elem,nbor,ierr)
1314  IF(ierr.NE.0) THEN
1315  error_message = 'ERROR IN '//
1316  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
1317  & 'GET_BND_NUMBERING_CGNS:GET_BND_CONNECTIVITY_CGNS'
1318  RETURN
1319  ENDIF
1320  !
1321 #else
1322 !
1323 ! CGNS LIBRARY NOT LOADED
1325 !
1326 #endif
1327  RETURN
1328  END SUBROUTINE
1329  SUBROUTINE get_bnd_nelem_cgns(FILE_ID,TYPE_BND_ELEM, NELEM,IERR)
1330 !
1331 !***********************************************************************
1332 ! HERMES V7P0 01/05/2014
1333 !***********************************************************************
1334 !
1335 !brief Reads the number of boundary elements
1336 !
1337 !history Y AUDOUIN (LNHE)
1338 !+ 24/03/2014
1339 !+ V7P0
1340 !+
1341 !
1342 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1343 !| FILE_ID |-->| FILE DESCRIPTOR
1344 !| TYPE_BND_ELEM |-->| TYPE OF THE BOUNDARY ELEMENTS
1345 !| NELEM |<->| NUMBER OF BOUNDARY ELEMENTS
1346 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
1347 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1348 !
1349  IMPLICIT NONE
1350  !
1351  INTEGER, INTENT(IN) :: FILE_ID
1352  INTEGER, INTENT(IN) :: TYPE_BND_ELEM
1353  INTEGER, INTENT(INOUT) :: NELEM
1354  INTEGER, INTENT(OUT) :: IERR
1355  !
1356 #if defined (HAVE_CGNS)
1357  INTEGER :: CGNS_ID
1358  !
1359  CALL get_obj(hash,file_id,cgns_id,ierr)
1360  IF(ierr.NE.0) THEN
1361  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
1362  & 'GET_BND_NELEM_CGNS:GET_CGNS_OBJ'
1363  RETURN
1364  ENDIF
1365  !
1366  ! Checking that we have the right element type
1367  IF(point_bnd_elt_type.NE.type_bnd_elem) THEN
1368  nelem = 0
1369  RETURN
1370  ELSE
1371  nelem = cgns_obj_tab(cgns_id)%NPTFR
1372  ENDIF
1373  !
1374 #else
1375 !
1376 ! CGNS LIBRARY NOT LOADED
1378 !
1379 #endif
1380  RETURN
1381  END SUBROUTINE
1382 !***********************************************************************
1383  SUBROUTINE get_bnd_connectivity_cgns
1384 !***********************************************************************
1385 !
1386  &(file_id,typ_bnd_elt,nelebd,ndp,ikle,ierr)
1387 !
1388 !***********************************************************************
1389 ! HERMES V7P0 01/05/2014
1390 !***********************************************************************
1391 !
1392 !brief Reads the connectivity of the boundary elements
1393 !
1394 !history Y AUDOUIN (LNHE)
1395 !+ 24/03/2014
1396 !+ V7P0
1397 !+
1398 !
1399 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1400 !| FILE_ID |-->| FILE DESCRIPTOR
1401 !| TYP_BND_ELEM |-->| TYPE OF THE BOUNDARY ELEMENTS
1402 !| NELEBD |-->| NUMBER OF BOUNDARY ELEMENTS
1403 !| NDP |-->| NUMBER OF POINTS PER ELEMENT
1404 !| IKLE |<->| THE CONNECTIVITY OF THE BOUNDARY ELEMENTS
1405 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
1406 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1407 !
1408  IMPLICIT NONE
1409  !
1410  INTEGER, INTENT(IN) :: FILE_ID
1411  INTEGER, INTENT(IN) :: TYP_BND_ELT
1412  INTEGER, INTENT(IN) :: NELEBD
1413  INTEGER, INTENT(IN) :: NDP
1414  INTEGER, INTENT(INOUT) :: IKLE(nelebd*ndp)
1415  INTEGER, INTENT(OUT) :: IERR
1416  !
1417 #if defined (HAVE_CGNS)
1418  INTEGER :: CGNS_ID
1419  INTEGER :: IDUM, I
1420  DOUBLE PRECISION :: DDUM
1421  !
1422  CALL get_obj(hash,file_id,cgns_id,ierr)
1423  IF(ierr.NE.0) THEN
1424  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
1425  & 'GET_BND_CONNECTIVITY_CGNS:GET_CGNS_OBJ'
1426  RETURN
1427  ENDIF
1428  !
1429  ! Checking that we have the right element type
1430  IF(point_bnd_elt_type.NE.typ_bnd_elt) THEN
1432  RETURN
1433  ENDIF
1434  ! Read the boundary file we only care about the connectivity
1435  rewind(cgns_obj_tab(cgns_id)%NCLI)
1436  DO i=1,cgns_obj_tab(cgns_id)%NPTFR
1437  READ(cgns_obj_tab(cgns_id)%NCLI,*,iostat=ierr) idum,idum,idum,
1438  & ddum ,ddum ,ddum,
1439  & ddum ,idum,ddum,ddum,ddum,
1440  & ikle(i),idum
1441  IF(ierr.LT.0) THEN
1442  ! End of file reached
1443  IF(ierr.NE.0) THEN
1444  error_message = 'ERROR IN '//
1445  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
1446  & 'GET_BND_CONNECTIVITY_CGNS:READ:END OF FILE'
1447  RETURN
1448  ENDIF
1449  ELSE IF (ierr.GT.0) THEN
1450  ! Error during read
1451  IF(ierr.NE.0) THEN
1452  error_message = 'ERROR IN '//
1453  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
1454  & 'GET_BND_CONNECTIVITY_CGNS:READ'
1455  RETURN
1456  ENDIF
1457  ENDIF
1458  ENDDO
1459  !
1460 #else
1461 !
1462 ! CGNS LIBRARY NOT LOADED
1464 !
1465 #endif
1466  RETURN
1467  END SUBROUTINE
1468 !***********************************************************************
1469  SUBROUTINE get_bnd_value_cgns
1470 !***********************************************************************
1471 !
1472  &(file_id,typ_bnd_elem,nptfr,lihbor,liubor,
1473  & livbor,hbor,ubor,vbor,chbord,trac,
1474  & litbor,tbor,atbor,btbor, ierr)
1475 !
1476 !***********************************************************************
1477 ! HERMES V7P0 01/05/2014
1478 !***********************************************************************
1479 !
1480 !brief Returns an array containing the boundary type for each
1481 !+ boundary point
1482 !
1483 !history Y AUDOUIN (LNHE)
1484 !+ 24/03/2014
1485 !+ V7P0
1486 !+
1487 !
1488 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1489 !| FILE_ID |-->| FILE DESCRIPTOR
1490 !| TYP_BND_ELEM |-->| TYPE OF THE BOUNDARY ELEMENTS
1491 !| NPTFR |-->| NUMBER OF BOUNDARY POINTS
1492 !| LIHBOR |-->| TYPE OF BOUNDARY CONDITIONS ON DEPTH
1493 !| LIUBOR |-->| TYPE OF BOUNDARY CONDITIONS ON U
1494 !| LIVBOR |-->| TYPE OF BOUNDARY CONDITIONS ON V
1495 !| HBOR |<--| PRESCRIBED BOUNDARY CONDITION ON DEPTH
1496 !| UBOR |<--| PRESCRIBED BOUNDARY CONDITION ON VELOCITY U
1497 !| VBOR |<--| PRESCRIBED BOUNDARY CONDITION ON VELOCITY V
1498 !| CHBORD |<--| FRICTION COEFFICIENT AT BOUNDARY
1499 !| TRAC |-->| IF YES, THERE ARE TRACERS
1500 !| LITBOR |-->| PHYSICAL BOUNDARY CONDITIONS FOR TRACERS
1501 !| TBOR |<--| PRESCRIBED BOUNDARY CONDITION ON TRACER
1502 !| ATBOR,BTBOR |<--| THERMAL EXCHANGE COEFFICIENTS.
1503 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
1504 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1505 !
1506  !
1507  IMPLICIT NONE
1508  !
1509  INTEGER, INTENT(IN) :: FILE_ID
1510  INTEGER, INTENT(IN) :: TYP_BND_ELEM
1511  INTEGER, INTENT(IN) :: NPTFR
1512  INTEGER, INTENT(INOUT) :: LIUBOR(nptfr),LIVBOR(nptfr)
1513  INTEGER, INTENT(INOUT) :: LIHBOR(nptfr),LITBOR(*)
1514  DOUBLE PRECISION, INTENT(INOUT) :: UBOR(*),VBOR(*)
1515  DOUBLE PRECISION, INTENT(INOUT) :: HBOR(nptfr),CHBORD(nptfr)
1516  DOUBLE PRECISION, INTENT(INOUT) :: TBOR(nptfr),ATBOR(nptfr)
1517  DOUBLE PRECISION, INTENT(INOUT) :: BTBOR(nptfr)
1518  LOGICAL, INTENT(IN) :: TRAC
1519  INTEGER, INTENT(OUT) :: IERR
1520  !
1521 #if defined (HAVE_CGNS)
1522  INTEGER :: CGNS_ID
1523  INTEGER :: I, IDUM
1524  DOUBLE PRECISION :: DDUM
1525  !
1526  CALL get_obj(hash,file_id,cgns_id,ierr)
1527  IF(ierr.NE.0) THEN
1528  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
1529  & 'GET_BND_VALUE_CGNS:GET_CGNS_OBJ'
1530  RETURN
1531  ENDIF
1532  !
1533  ! Checking that we have the right element type
1534  IF(point_bnd_elt_type.NE.typ_bnd_elem) THEN
1536  RETURN
1537  ENDIF
1538  ! Reading the boundary file informations we only care
1539  ! about the boundary type li[huvt]bor
1540  rewind(cgns_obj_tab(cgns_id)%NCLI)
1541  DO i=1,cgns_obj_tab(cgns_id)%NPTFR
1542  IF(trac) THEN
1543  READ(cgns_obj_tab(cgns_id)%NCLI,*,iostat=ierr)
1544  & lihbor(i),liubor(i),livbor(i),
1545  & hbor(i) ,ubor(i) ,vbor(i),
1546  & chbord(i) ,litbor(i),
1547  & tbor(i),atbor(i),btbor(i),
1548  & idum,idum
1549  ELSE
1550  READ(cgns_obj_tab(cgns_id)%NCLI,*,iostat=ierr)
1551  & lihbor(i),liubor(i),livbor(i),
1552  & hbor(i) ,ubor(i) ,vbor(i),
1553  & chbord(i) ,idum,ddum,ddum,ddum,
1554  & idum,idum
1555  ENDIF
1556  IF(ierr.LT.0) THEN
1557  ! End of file reached
1558  IF(ierr.NE.0) THEN
1559  error_message = 'ERROR IN '//
1560  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
1561  & 'GET_BND_VALUE_CGNS:READ:END OF FILE'
1562  RETURN
1563  ENDIF
1564  ELSE IF (ierr.GT.0) THEN
1565  ! Error during read
1566  IF(ierr.NE.0) THEN
1567  error_message = 'ERROR IN '//
1568  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
1569  & 'GET_BND_VALUE_CGNS:READ'
1570  RETURN
1571  ENDIF
1572  ENDIF
1573  ENDDO
1574  !
1575 #else
1576 !
1577 ! CGNS LIBRARY NOT LOADED
1579 !
1580 #endif
1581  RETURN
1582  END SUBROUTINE
1583 !***********************************************************************
1584  SUBROUTINE get_bnd_npoin_cgns
1585 !***********************************************************************
1586 !
1587  &(file_id,type_bnd_elem,nptfr,ierr)
1588 !
1589 !***********************************************************************
1590 ! HERMES V7P0 01/05/2014
1591 !***********************************************************************
1592 !
1593 !brief Returns the number of boundary points
1594 !
1595 !history Y AUDOUIN (LNHE)
1596 !+ 24/03/2014
1597 !+ V7P0
1598 !+
1599 !
1600 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1601 !| FILE_ID |-->| FILE DESCRIPTOR
1602 !| TYPE_BND_ELEM |-->| TYPE OF THE BOUNDARY ELEMENTS
1603 !| NPTFR |<->| NUMBER OF BOUNDARY POINTS
1604 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
1605 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1606 !
1607  IMPLICIT NONE
1608  !
1609  INTEGER, INTENT(IN) :: FILE_ID
1610  INTEGER, INTENT(IN) :: TYPE_BND_ELEM
1611  INTEGER, INTENT(INOUT) :: NPTFR
1612  INTEGER, INTENT(OUT) :: IERR
1613  !
1614 #if defined (HAVE_CGNS)
1615  INTEGER :: CGNS_ID
1616  !
1617  CALL get_obj(hash,file_id,cgns_id,ierr)
1618  IF(ierr.NE.0) THEN
1619  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
1620  & 'GET_BND_NPOIN_CGNS:GET_CGNS_OBJ'
1621  RETURN
1622  ENDIF
1623  !
1624  IF(point_bnd_elt_type.EQ.type_bnd_elem) THEN
1625  nptfr = cgns_obj_tab(cgns_id)%NPTFR
1626  ELSE
1627  nptfr = 0
1628  ENDIF
1629  !
1630 #else
1631 !
1632 ! CGNS LIBRARY NOT LOADED
1634 !
1635 #endif
1636  RETURN
1637  END SUBROUTINE
1638 !
1639 ! Data functions
1640 !
1641 !***********************************************************************
1642  SUBROUTINE get_data_nvar_cgns
1643 !***********************************************************************
1644 !
1645  &(file_id,nvar,ierr)
1646 !
1647 !***********************************************************************
1648 ! HERMES V7P0 01/05/2014
1649 !***********************************************************************
1650 !
1651 !brief Returns the number of varaibles in the mesh file
1652 !
1653 !history Y AUDOUIN (LNHE)
1654 !+ 24/03/2014
1655 !+ V7P0
1656 !+
1657 !
1658 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1659 !| FILE_ID |-->| FILE DESCRIPTOR
1660 !| NVAR |<->| NUMBER OF VARIABLE
1661 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
1662 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1663 !
1664  IMPLICIT NONE
1665  !
1666  INTEGER, INTENT(IN) :: FILE_ID
1667  INTEGER, INTENT(INOUT) :: NVAR
1668  INTEGER, INTENT(OUT) :: IERR
1669  !
1670 #if defined (HAVE_CGNS)
1671  INTEGER :: CGNS_ID
1672  !
1673  CALL get_obj(hash,file_id,cgns_id,ierr)
1674  IF(ierr.NE.0) THEN
1675  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
1676  & 'GET_DATA_NVAR_CGNS:GET_CGNS_OBJ'
1677  RETURN
1678  ENDIF
1679  !
1680  nvar = cgns_obj_tab(cgns_id)%NVAR
1681  !
1682 #else
1683 !
1684 ! CGNS LIBRARY NOT LOADED
1686 !
1687 #endif
1688  RETURN
1689  END SUBROUTINE
1690 !***********************************************************************
1691  SUBROUTINE get_data_var_list_cgns
1692 !***********************************************************************
1693 !
1694  &(file_id,nvar,var_list,unit_list,ierr)
1695 !
1696 !***********************************************************************
1697 ! HERMES V7P0 01/05/2014
1698 !***********************************************************************
1699 !
1700 !brief Returns a list of all the name of the variables in the mesh file
1701 !+ and a list of their units
1702 !
1703 !history Y AUDOUIN (LNHE)
1704 !+ 24/03/2014
1705 !+ V7P0
1706 !+
1707 !
1708 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1709 !| FILE_ID |-->| FILE DESCRIPTOR
1710 !| VARLIST |<->| LIST OF VARIABLE NAME
1711 !| UNTILIST |<->| LIST OF VARIABLE UNIT
1712 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
1713 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1714 !
1715  IMPLICIT NONE
1716  !
1717  INTEGER, INTENT(IN) :: FILE_ID
1718  INTEGER, INTENT(IN) :: NVAR
1719  CHARACTER(LEN=16), INTENT(INOUT) :: VAR_LIST(nvar)
1720  CHARACTER(LEN=16), INTENT(INOUT) :: UNIT_LIST(nvar)
1721  INTEGER, INTENT(OUT) :: IERR
1722  !
1723 #if defined (HAVE_CGNS)
1724  INTEGER :: CGNS_ID
1725  INTEGER :: IVAR
1726  CHARACTER(LEN=32) :: VARNAME
1727  INTEGER :: DATATYPE
1728  !
1729  CALL get_obj(hash,file_id,cgns_id,ierr)
1730  IF(ierr.NE.0) THEN
1731  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
1732  & 'GET_DATA_VAR_LIST_CGNS:GET_CGNS_OBJ'
1733  RETURN
1734  ENDIF
1735  !
1736  ! TODO: Move into open
1737  DO ivar=1,nvar
1738  CALL cg_field_info_f(file_id,cgns_obj_tab(cgns_id)%INDEX_BASE,
1739  & cgns_obj_tab(cgns_id)%INDEX_ZONE,1,
1740  & ivar,datatype,varname,ierr)
1741  IF(ierr.NE.cg_ok) CALL cg_error_print_f
1742  IF(ierr.NE.0) THEN
1743  error_message = 'ERROR IN '//
1744  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
1745  & 'GET_DATA_VAR_LIST:CG_FIELD_INFO_F '//i2char(ivar)
1746  RETURN
1747  ENDIF
1748  var_list(ivar) = varname(1:16)
1749  unit_list(ivar) = varname(16:32)
1750  ENDDO
1751  !
1752 #else
1753 !
1754 ! CGNS LIBRARY NOT LOADED
1756 !
1757 #endif
1758  RETURN
1759  END SUBROUTINE
1760 !***********************************************************************
1761  SUBROUTINE get_data_ntimestep_cgns
1762 !***********************************************************************
1763 !
1764  &(file_id,ntimestep,ierr)
1765 !
1766 !***********************************************************************
1767 ! HERMES V7P0 01/05/2014
1768 !***********************************************************************
1769 !
1770 !brief Returns the number of time step in the mesh file
1771 !
1772 !history Y AUDOUIN (LNHE)
1773 !+ 24/03/2014
1774 !+ V7P0
1775 !+
1776 !
1777 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1778 !| FILE_ID |-->| FILE DESCRIPTOR
1779 !| NTIMESTEP |<->| THE NUMBER OF TIME STEPS
1780 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
1781 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1782 !
1783  IMPLICIT NONE
1784  !
1785  INTEGER, INTENT(IN) :: FILE_ID
1786  INTEGER, INTENT(INOUT) :: NTIMESTEP
1787  INTEGER, INTENT(OUT) :: IERR
1788  !
1789 #if defined (HAVE_CGNS)
1790  INTEGER :: CGNS_ID
1791  !
1792  CALL get_obj(hash,file_id,cgns_id,ierr)
1793  IF(ierr.NE.0) THEN
1794  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
1795  & 'GET_DATA_NTIMESTEP_CGNS:GET_CGNS_OBJ'
1796  RETURN
1797  ENDIF
1798  !
1799  ntimestep = cgns_obj_tab(cgns_id)%NTIMESTEP
1800  !
1801 #else
1802 !
1803 ! CGNS LIBRARY NOT LOADED
1805 !
1806 #endif
1807  RETURN
1808  END SUBROUTINE
1809 !***********************************************************************
1810  SUBROUTINE get_data_time_cgns
1811 !***********************************************************************
1812 !
1813  &(file_id,record,time,ierr)
1814 !
1815 !***********************************************************************
1816 ! HERMES V7P0 01/05/2014
1817 !***********************************************************************
1818 !
1819 !brief Returns the time value of a given time step
1820 !
1821 !history Y AUDOUIN (LNHE)
1822 !+ 24/03/2014
1823 !+ V7P0
1824 !+
1825 !
1826 !history R ATA (EDF R&D, LNHE)
1827 !+ 24/05/2016
1828 !+ V7P2
1829 !+ The case with no record in the file was not treated.
1830 !
1831 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1832 !| FILE_ID |-->| FILE DESCRIPTOR
1833 !| RECORD |-->| NUMBER OF THE TIME STEP
1834 !| TIME |<->| TIME IN SECOND OF THE TIME STEP
1835 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
1836 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1837 !
1838  IMPLICIT NONE
1839  !
1840  INTEGER, INTENT(IN) :: FILE_ID
1841  INTEGER, INTENT(IN) :: RECORD
1842  DOUBLE PRECISION, INTENT(INOUT) :: TIME
1843  INTEGER, INTENT(OUT) :: IERR
1844  !
1845 #if defined (HAVE_CGNS)
1846  INTEGER :: CGNS_ID
1847  !
1848  CALL get_obj(hash,file_id,cgns_id,ierr)
1849  IF(ierr.NE.0) THEN
1850  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
1851  & 'GET_DATA_TIME_CGNS:GET_CGNS_OBJ'
1852  RETURN
1853  ENDIF
1854  !
1855  IF (record.LT.0) THEN
1857  error_message = 'ERROR IN '//
1858  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
1859  & 'GET_DATA_VAR_TIME_CGNS'
1860  RETURN
1861  ENDIF
1862  IF (record.GE.cgns_obj_tab(cgns_id)%NTIMESTEP) THEN
1864  error_message = 'ERROR IN '//
1865  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
1866  & 'GET_DATA_VAR_TIME_CGNS'
1867  RETURN
1868  ENDIF
1869  time = cgns_obj_tab(cgns_id)%TIMES(record+1)
1870  !
1871 #else
1872 !
1873 ! CGNS LIBRARY NOT LOADED
1875 !
1876 #endif
1877  RETURN
1878  END SUBROUTINE
1879 !***********************************************************************
1880  SUBROUTINE get_data_value_cgns
1881 !***********************************************************************
1882 !
1883  &(file_id,record,var_name,res_value,n,ierr)
1884 !
1885 !***********************************************************************
1886 ! HERMES V7P2 01/05/2014
1887 !***********************************************************************
1888 !
1889 !brief Returns The value for each point of a given variable
1890 !+ for a given time step
1891 !
1892 !history Y AUDOUIN (LNHE)
1893 !+ 24/03/2014
1894 !+ V7P0
1895 !+ First version.
1896 !
1897 !history R ATA (EDF R&D, LNHE)
1898 !+ 24/05/2016
1899 !+ V7P2
1900 !+ The case with no record in the file was not treated.
1901 !
1902 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1903 !| FILE_ID |-->| FILE DESCRIPTOR
1904 !| RECORD |-->| TIME STEP TO READ IN THE FILE
1905 !| VAR_NAME |-->| VARIABLE FOR WHICH WE NEED THE VALUE
1906 !| RES_VALUE |<->| VALUE FOR EACH POINT AT TIME STEP RECORD
1907 !| | | FOR THE VARIABLE VAR_NAME
1908 !| N |-->| SIZE OF RES_VALUE
1909 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
1910 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1911 !
1912  IMPLICIT NONE
1913  !
1914  INTEGER, INTENT(IN) :: FILE_ID
1915  INTEGER, INTENT(IN) :: RECORD, N
1916  CHARACTER(LEN=16), INTENT(IN) :: VAR_NAME
1917  DOUBLE PRECISION, INTENT(INOUT) :: RES_VALUE(n)
1918  INTEGER, INTENT(OUT) :: IERR
1919  !
1920 #if defined (HAVE_CGNS)
1921  INTEGER :: CGNS_ID
1922  !
1923  CALL get_obj(hash,file_id,cgns_id,ierr)
1924  IF(ierr.NE.0) THEN
1925  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
1926  & 'GET_DATA_VALUE_CGNS:GET_CGNS_OBJ'
1927  RETURN
1928  ENDIF
1929  ! TODO: Check on record and var_name
1930  !
1931  CALL cg_field_read_f(file_id,cgns_obj_tab(cgns_id)%INDEX_BASE,
1932  & cgns_obj_tab(cgns_id)%INDEX_ZONE,record+1,
1933  & var_name,realdouble,1,n,
1934  & res_value,ierr)
1935  IF(ierr.NE.cg_ok) CALL cg_error_print_f
1936  IF(ierr.NE.0) THEN
1937  error_message = 'ERROR IN '//
1938  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
1939  & 'GET_DATA_VALUE_CGNS:CG_FIELD_READ_F'
1940  RETURN
1941  ENDIF
1942  !
1943 #else
1944 !
1945 ! CGNS LIBRARY NOT LOADED
1947 !
1948 #endif
1949  RETURN
1950  END SUBROUTINE
1951 !
1952 ! Writing functions
1953 !
1954 !***********************************************************************
1955  SUBROUTINE set_header_cgns
1956 !***********************************************************************
1957 !
1958  &(file_id,title,nvar,var_name,ierr)
1959 !
1960 !***********************************************************************
1961 ! HERMES V7P0 01/05/2014
1962 !***********************************************************************
1963 !
1964 !brief Writes the Title and the name and units of the variables
1965 !
1966 !history Y AUDOUIN (LNHE)
1967 !+ 24/03/2014
1968 !+ V7P0
1969 !+
1970 !
1971 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1972 !| FILE_ID |-->| FILE DESCRIPTOR
1973 !| TITLE |-->| TITLE OF THE MESH
1974 !| NVAR |-->| NUMBER OF VARIABLES
1975 !| VAR_NAME |-->| NAME AND UNITS OF THE VARIABLES
1976 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
1977 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1978 !
1979  !
1980  IMPLICIT NONE
1981  !
1982  INTEGER, INTENT(IN) :: FILE_ID
1983  CHARACTER(LEN=TITLE_SIZE), INTENT(IN) :: TITLE
1984  INTEGER, INTENT(IN) :: NVAR
1985  CHARACTER(LEN=VAR_SIZE), INTENT(IN) :: VAR_NAME(nvar)
1986  INTEGER, INTENT(OUT) :: IERR
1987  !
1988 #if defined (HAVE_CGNS)
1989  INTEGER :: CGNS_ID
1990  INTEGER :: I
1991  !
1992  !
1993  CALL get_obj(hash,file_id,cgns_id,ierr)
1994  IF(ierr.NE.0) THEN
1995  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
1996  & 'SET_HEADER_CGNS:GET_CGNS_OBJ'
1997  RETURN
1998  ENDIF
1999  !
2000  cgns_obj_tab(cgns_id)%TITLE = title(1:32)
2001  cgns_obj_tab(cgns_id)%NVAR = nvar
2002  ALLOCATE(cgns_obj_tab(cgns_id)%VARNAME(nvar),stat=ierr)
2003  IF(ierr.NE.0) THEN
2004  error_message = 'ERROR IN '//
2005  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
2006  & 'ALLOCATING VARNAME'
2007  RETURN
2008  ENDIF
2009  DO i=1,nvar
2010  cgns_obj_tab(cgns_id)%VARNAME(i) = var_name(i)
2011  ENDDO
2012 #else
2013 !
2014 ! CGNS LIBRARY NOT LOADED
2016 !
2017 #endif
2018 
2019  END SUBROUTINE
2020 !***********************************************************************
2021  SUBROUTINE set_mesh_cgns
2022 !***********************************************************************
2023 !
2024  &(file_id,mesh_dim,typelt,ndp,nptfr,nptir,nelem,npoin,
2025  & ikle,ipobo,knolg,x,y,nplan,ierr,z)
2026 !
2027 !***********************************************************************
2028 ! HERMES V7P0 01/05/2014
2029 !***********************************************************************
2030 !
2031 !brief Writes the mesh geometry in the file
2032 !
2033 !history Y AUDOUIN (LNHE)
2034 !+ 24/03/2014
2035 !+ V7P0
2036 !+
2037 !
2038 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2039 !| FILE_ID |-->| FILE DESCRIPTOR
2040 !| MESH_DIM |-->| DIMENSION OF THE MESH
2041 !| TYPELM |-->| TYPE OF THE MESH ELEMENTS
2042 !| NDP |-->| NUMBER OF POINTS PER ELEMENT
2043 !| NPTFR |-->| NUMBER OF BOUNDARY POINT
2044 !| NPTIR |-->| NUMBER OF INTERFACE POINT
2045 !| NELEM |-->| NUMBER OF ELEMENT IN THE MESH
2046 !| NPOIN |-->| NUMBER OF POINTS IN THE MESH
2047 !| IKLE |-->| CONNECTIVITY ARRAY FOR THE MAIN ELEMENT
2048 !| IPOBO |-->| IS A BOUNDARY POINT ? ARRAY
2049 !| KNOLG |-->| LOCAL TO GLOBAL NUMBERING ARRAY
2050 !| X |-->| X COORDINATES OF THE MESH POINTS
2051 !| Y |-->| Y COORDINATES OF THE MESH POINTS
2052 !| NPLAN |-->| NUMBER OF PLANES
2053 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
2054 !| Z (OPTIONAL) |-->| Z COORDINATES OF THE MESH POINTS
2055 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2056 !
2057  !
2058  IMPLICIT NONE
2059  !
2060  INTEGER , INTENT(IN) :: FILE_ID,NPLAN
2061  INTEGER, INTENT(IN) :: MESH_DIM
2062  INTEGER, INTENT(IN) :: TYPELT
2063  INTEGER, INTENT(IN) :: NDP
2064  INTEGER, INTENT(IN) :: NPTFR
2065  INTEGER, INTENT(IN) :: NPTIR
2066  INTEGER, INTENT(IN) :: NELEM
2067  INTEGER, INTENT(IN) :: NPOIN
2068  INTEGER, INTENT(IN) :: IKLE(ndp*nelem)
2069  INTEGER, INTENT(IN) :: IPOBO(*)
2070  INTEGER, INTENT(IN) :: KNOLG(*)
2071  DOUBLE PRECISION, INTENT(IN) :: X(npoin),Y(npoin)
2072  INTEGER, INTENT(OUT) :: IERR
2073  DOUBLE PRECISION, INTENT(IN), OPTIONAL :: Z(*)
2074  !
2075 #if defined (HAVE_CGNS)
2076  INTEGER :: CGNS_ID
2077  INTEGER :: ISIZE(3,3)
2078  CHARACTER(LEN=32) :: BASENAME, ZONENAME
2079  INTEGER :: ICELLDIM, IPHYSDIM
2080  INTEGER, ALLOCATABLE :: IELEM(:,:)
2081  INTEGER :: NBDYELEM
2082  INTEGER :: CGNS_TYPE_ELEM
2083  INTEGER :: I,J
2084  INTEGER :: INDEX_DIM, INDEX_COORD
2085  INTEGER :: DISCR_NO
2086  INTEGER :: INDEXU
2087  !
2088  CALL get_obj(hash,file_id,cgns_id,ierr)
2089  IF(ierr.NE.0) THEN
2090  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
2091  & 'SET_MESH_CGNS:GET_CGNS_OBJ'
2092  RETURN
2093  ENDIF
2094  !
2095  !CREATE BASE (USER CAN GIVE ANY NAME)
2096  basename='BASE'
2097  icelldim=mesh_dim
2098  iphysdim=mesh_dim
2099  CALL cg_base_write_f(file_id,basename,icelldim,iphysdim,
2100  & cgns_obj_tab(cgns_id)%INDEX_BASE,ierr)
2101  IF(ierr.NE.cg_ok) CALL cg_error_print_f
2102  IF(ierr.NE.0) THEN
2103  error_message = 'ERROR IN '//
2104  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
2105  & 'SET_MESH_CGNS:CG_BASE_WRITE_F'
2106  RETURN
2107  ENDIF
2108  ! DEFINE ZONE NAME (USER CAN GIVE ANY NAME)
2109  zonename = cgns_obj_tab(cgns_id)%TITLE(1:32)
2110  cgns_obj_tab(cgns_id)%NELEM = nelem
2111  cgns_obj_tab(cgns_id)%NPOIN = npoin
2112  cgns_obj_tab(cgns_id)%NDP = ndp
2113  isize = 0
2114  ! NUMBER OF POINTS
2115  isize(1,1) = npoin
2116  ! NUMBER OF ELEMENTS
2117  isize(1,2) = nelem
2118  ! CREATE ZONE
2119  CALL cg_zone_write_f(file_id,cgns_obj_tab(cgns_id)%INDEX_BASE,
2120  & zonename,isize,
2121  & unstructured,
2122  & cgns_obj_tab(cgns_id)%INDEX_ZONE,ierr)
2123  IF(ierr.NE.cg_ok) CALL cg_error_print_f
2124  IF(ierr.NE.0) THEN
2125  error_message = 'ERROR IN '//
2126  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
2127  & 'SET_MESH_CGNS:CG_ZONE_WRITE_F'
2128  RETURN
2129  ENDIF
2130  ! WRITE GRID COORDINATES (USER MUST USE SIDS-STANDARD NAMES HERE)
2131  CALL cg_coord_write_f(file_id,
2132  & cgns_obj_tab(cgns_id)%INDEX_BASE,
2133  & cgns_obj_tab(cgns_id)%INDEX_ZONE,
2134  & realdouble,
2135  & 'CoordinateX',x,index_coord,ierr)
2136  IF(ierr.NE.cg_ok) CALL cg_error_print_f
2137  IF(ierr.NE.0) THEN
2138  error_message = 'ERROR IN '//
2139  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
2140  & 'SET_MESH_CGNS:CG_COORD_WRITE_F X'
2141  RETURN
2142  ENDIF
2143  CALL cg_coord_write_f(file_id,
2144  & cgns_obj_tab(cgns_id)%INDEX_BASE,
2145  & cgns_obj_tab(cgns_id)%INDEX_ZONE,
2146  & realdouble,
2147  & 'CoordinateY',y,index_coord,ierr)
2148  IF(ierr.NE.cg_ok) CALL cg_error_print_f
2149  IF(ierr.NE.0) THEN
2150  error_message = 'ERROR IN '//
2151  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
2152  & 'SET_MESH_CGNS:CG_COORD_WRITE_F Y'
2153  RETURN
2154  ENDIF
2155  IF(mesh_dim.EQ.3) THEN
2156  CALL cg_coord_write_f(file_id,
2157  & cgns_obj_tab(cgns_id)%INDEX_BASE,
2158  & cgns_obj_tab(cgns_id)%INDEX_ZONE,
2159  & realdouble,
2160  & 'CoordinateZ',z,index_coord,ierr)
2161  IF(ierr.NE.cg_ok) CALL cg_error_print_f
2162  IF(ierr.NE.0) THEN
2163  error_message = 'ERROR IN '//
2164  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
2165  & 'SET_MESH_CGNS:CG_COORD_WRITE_F Z'
2166  RETURN
2167  ENDIF
2168  ENDIF
2169  ! SET ELEMENT CONNECTIVITY:
2170  ALLOCATE(ielem(ndp,nelem),stat=ierr)
2171  IF(ierr.NE.0) THEN
2172  error_message = 'ERROR IN '//
2173  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
2174  & 'ALLOCATING IELEM'
2175  RETURN
2176  ENDIF
2177  ! BUILDING THE CONNECTIVITY TABLE
2178  DO i=1,nelem
2179  DO j=1,ndp
2180  ielem(j,i) = ikle((j-1)*nelem+i)
2181  ENDDO
2182  ENDDO
2183  ! UNSORTED BOUNDARY ELEMENTS
2184  nbdyelem=0
2185  ! DEFINES THE CGNS TYPE
2186  ! WRITE ELEMENT CONNECTIVITY
2187  SELECT CASE (typelt)
2188  CASE(triangle_elt_type)
2189  cgns_type_elem = tri_3
2190  CASE(quadrangle_elt_type)
2191  cgns_type_elem = quad_4
2192  CASE(tetrahedron_elt_type)
2193  cgns_type_elem = tetra_4
2194  CASE(prism_elt_type)
2195  cgns_type_elem = penta_6
2196  END SELECT
2197  !
2198  CALL cg_section_write_f(file_id,
2199  & cgns_obj_tab(cgns_id)%INDEX_BASE,
2200  & cgns_obj_tab(cgns_id)%INDEX_ZONE,
2201  & 'Elem',cgns_type_elem,1,nelem,
2202  & nbdyelem,ielem,
2203  & cgns_obj_tab(cgns_id)%INDEX_SECTION,ierr)
2204  IF(ierr.NE.cg_ok) CALL cg_error_print_f
2205  IF(ierr.NE.0) THEN
2206  error_message = 'ERROR IN '//
2207  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
2208  & 'SET_MESH_CGNS:CG_SECTION_WRITE_F'
2209  RETURN
2210  ENDIF
2211  DEALLOCATE(ielem)
2212 
2213  ! Writing knolg/ipobo under a
2214  ! UserDefinedData_t node
2215  ! *** discrete data
2216 ! call cg_discrete_write_f(file_id,
2217 ! & CGNS_OBJ_TAB(CGNS_ID)%INDEX_BASE,
2218 ! & CGNS_OBJ_TAB(CGNS_ID)%INDEX_ZONE, 'discrete#1',
2219 ! & discr_no, ierr)
2220 ! IF(IERR.NE.CG_OK) CALL CG_ERROR_PRINT_F
2221 ! IF(IERR.NE.0) THEN
2222 ! ERROR_MESSAGE = 'ERROR IN '//
2223 ! & TRIM(CGNS_OBJ_TAB(CGNS_ID)%FILE_NAME)//': '//
2224 ! & 'set_mesh_cgns:cg_discrete_write_f'
2225 ! RETURN
2226 ! ENDIF
2227 
2228 ! ! *** discrete data arrays, defined on
2229 ! ! vertices:
2230 ! call cg_goto_f(file_id, CGNS_OBJ_TAB(CGNS_ID)%INDEX_BASE, ierr,
2231 ! & 'Zone_t', CGNS_OBJ_TAB(CGNS_ID)%INDEX_ZONE,
2232 ! & 'DiscreteData_t', discr_no, 'end')
2233 ! INDEX_DIM = 1
2234 ! IF(NPTIR.GT.0) THEN
2235 ! CALL CG_ARRAY_WRITE_F('knolgIpobo', INTEGER, INDEX_DIM,
2236 ! & NPOIN, KNOLG, IERR)
2237 ! ELSE
2238 ! CALL CG_ARRAY_WRITE_F('knolgIpobo', INTEGER, INDEX_DIM,
2239 ! & NPOIN, IPOBO, IERR)
2240 ! ENDIF
2241 ! IF(IERR.NE.CG_OK) CALL CG_ERROR_PRINT_F
2242 ! IF(IERR.NE.0) THEN
2243 ! ERROR_MESSAGE = 'ERROR IN '//
2244 ! & TRIM(CGNS_OBJ_TAB(CGNS_ID)%FILE_NAME)//': '//
2245 ! & 'SET_MESH_CGNS:CG_array_write_f'
2246 ! RETURN
2247 ! ENDIF
2248 
2249 #else
2250 !
2251 ! CGNS LIBRARY NOT LOADED
2253 !
2254 #endif
2255  END SUBROUTINE
2256 !***********************************************************************
2257  SUBROUTINE add_data_cgns
2258 !***********************************************************************
2259 !
2260  &(file_id,var_name,time,record,first_var,var_value,n,ierr)
2261 !
2262 !***********************************************************************
2263 ! HERMES V7P0 01/05/2014
2264 !***********************************************************************
2265 !
2266 !brief Add data information for a given variable and a given time on
2267 !+ all points of the mesh
2268 !
2269 !history Y AUDOUIN (LNHE)
2270 !+ 24/03/2014
2271 !+ V7P0
2272 !+
2273 !
2274 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2275 !| FILE_ID |-->| FILE DESCRIPTOR
2276 !| VAR_NAME |-->| NAME OF THE VARIABLE
2277 !| TIME |-->| TIME OF THE DATA
2278 !| RECORD |-->| TIME STEP OF THE DATA
2279 !| FIRST_VAR |-->| TRUE IF IT IS THE FIRST VARIABLE OF THE DATASET
2280 !| VAR_VALUE |-->| THE VALUE FOR EACH POINT OF THE MESH
2281 !| N |-->| SIZE OF VAR_VALUE
2282 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
2283 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2284 !
2285  !
2286  IMPLICIT NONE
2287  !
2288  INTEGER, INTENT(IN) :: FILE_ID,N
2289  CHARACTER(LEN=VAR_SIZE), INTENT(IN) :: VAR_NAME
2290  DOUBLE PRECISION, INTENT(IN) :: TIME
2291  INTEGER, INTENT(IN) :: RECORD
2292  LOGICAL, INTENT(IN) :: FIRST_VAR
2293  DOUBLE PRECISION, INTENT(IN) :: VAR_VALUE(n)
2294  INTEGER, INTENT(OUT) :: IERR
2295  !
2296 #if defined (HAVE_CGNS)
2297  INTEGER :: CGNS_ID
2298  CHARACTER(LEN=32) :: SOLNAME
2299  CHARACTER(LEN=32) :: SIDS_NAME
2300  DOUBLE PRECISION, ALLOCATABLE :: TMP(:)
2301  !
2302  CALL get_obj(hash,file_id,cgns_id,ierr)
2303  IF(ierr.NE.0) THEN
2304  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
2305  & 'ADD_DATA_CGNS:GET_CGNS_OBJ'
2306  RETURN
2307  ENDIF
2308  !
2309  solname = repeat(' ',32)
2310  solname = 'Time'//i2char(record+1)
2311  ! LOOPING FOR EACH TIME STEP
2312  IF(first_var) THEN
2313  cgns_obj_tab(cgns_id)%INDEX_FLOW = record + 1
2314  ! CREATE FLOW SOLUTION NODE
2315  CALL cg_sol_write_f(file_id,cgns_obj_tab(cgns_id)%INDEX_BASE,
2316  & cgns_obj_tab(cgns_id)%INDEX_ZONE,
2317  & solname,vertex,
2318  & cgns_obj_tab(cgns_id)%INDEX_FLOW,ierr)
2319  IF(ierr.NE.cg_ok) CALL cg_error_print_f
2320  IF(ierr.NE.0) THEN
2321  error_message = 'ERROR IN '//
2322  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
2323  & 'ADD_DATA_CGNS:CG_SOL_WRITE_F '//i2char(record)
2324  RETURN
2325  ENDIF
2326  ! Update times
2327  IF(.NOT.ALLOCATED(cgns_obj_tab(cgns_id)%TIMES)) THEN
2328  ALLOCATE(cgns_obj_tab(cgns_id)%TIMES(1))
2329  cgns_obj_tab(cgns_id)%TIMES(1) = time
2330  ELSE
2331  ALLOCATE(tmp(cgns_obj_tab(cgns_id)%NTIMESTEP))
2332  tmp = cgns_obj_tab(cgns_id)%TIMES
2333  DEALLOCATE(cgns_obj_tab(cgns_id)%TIMES)
2334  ALLOCATE(cgns_obj_tab(cgns_id)%TIMES(
2335  & cgns_obj_tab(cgns_id)%NTIMESTEP+1))
2336  cgns_obj_tab(cgns_id)%TIMES(1:cgns_obj_tab(
2337  & cgns_id)%NTIMESTEP) = tmp
2338  cgns_obj_tab(cgns_id)%TIMES(cgns_obj_tab(
2339  & cgns_id)%NTIMESTEP+1) = time
2340  DEALLOCATE(tmp)
2341  ENDIF
2342  cgns_obj_tab(cgns_id)%NTIMESTEP =
2343  & cgns_obj_tab(cgns_id)%NTIMESTEP + 1
2344  ENDIF
2345  ! WRITE FLOW SOLUTION (USER MUST USE SIDS-STANDARD NAMES HERE)
2346  CALL varname2sids(var_name,sids_name)
2347  ! DECLARING A NEW VARIABLE
2348  CALL cg_field_write_f(file_id,cgns_obj_tab(cgns_id)%INDEX_BASE,
2349  & cgns_obj_tab(cgns_id)%INDEX_ZONE,
2350  & cgns_obj_tab(cgns_id)%INDEX_FLOW,realdouble,sids_name,
2351  & var_value,cgns_obj_tab(cgns_id)%INDEX_FIELD,ierr)
2352  IF(ierr.NE.cg_ok) CALL cg_error_print_f
2353  IF(ierr.NE.0) THEN
2354  error_message = 'ERROR IN '//
2355  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
2356  & 'ADD_DATA_CGNS:CG_FIELD_WRITE_F '//var_name
2357  RETURN
2358  ENDIF
2359  !
2360 #else
2361 !
2362 ! CGNS LIBRARY NOT LOADED
2364 !
2365 #endif
2366  END SUBROUTINE
2367 !
2368 !***********************************************************************
2369  SUBROUTINE set_bnd_cgns
2370 !***********************************************************************
2371 !
2372  &(file_id,type_bnd_elt,nelebd,ndp,ikle,
2373  & lihbor,liubor,
2374  & livbor,hbor,ubor,vbor,chbord,
2375  & litbor,tbor,atbor,btbor,ierr)
2376 !
2377 !***********************************************************************
2378 ! HERMES V7P0 01/05/2014
2379 !***********************************************************************
2380 !
2381 !brief Writes the boundary information into the mesh file
2382 !
2383 !history Y AUDOUIN (LNHE)
2384 !+ 24/03/2014
2385 !+ V7P0
2386 !+
2387 !
2388 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2389 !| FILE_ID |-->| FILE DESCRIPTOR
2390 !| TYPE_BND_ELT |-->| TYPE OF THE BOUNDARY ELEMENTS
2391 !| NELEBD |-->| NUMBER OF BOUNDARY ELEMENTS
2392 !| NDP |-->| NUMBER OF POINTS PER BOUNDARY ELEMENT
2393 !| IKLE |-->| CONNECTIVITY ARRAY FOR THE BOUNDARY ELEMENTS
2394 !| LIHBOR |-->| TYPE OF BOUNDARY CONDITIONS ON DEPTH
2395 !| LIUBOR |-->| TYPE OF BOUNDARY CONDITIONS ON U
2396 !| LIVBOR |-->| TYPE OF BOUNDARY CONDITIONS ON V
2397 !| HBOR |<--| PRESCRIBED BOUNDARY CONDITION ON DEPTH
2398 !| UBOR |<--| PRESCRIBED BOUNDARY CONDITION ON VELOCITY U
2399 !| VBOR |<--| PRESCRIBED BOUNDARY CONDITION ON VELOCITY V
2400 !| CHBORD |<--| FRICTION COEFFICIENT AT BOUNDARY
2401 !| LITBOR |-->| PHYSICAL BOUNDARY CONDITIONS FOR TRACERS
2402 !| TBOR |<--| PRESCRIBED BOUNDARY CONDITION ON TRACER
2403 !| ATBOR,BTBOR |<--| THERMAL EXCHANGE COEFFICIENTS.
2404 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
2405 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2406 !
2407  !
2408  IMPLICIT NONE
2409  !
2410  INTEGER, INTENT(IN) :: FILE_ID
2411  INTEGER, INTENT(IN) :: TYPE_BND_ELT
2412  INTEGER, INTENT(IN) :: NELEBD
2413  INTEGER, INTENT(IN) :: NDP
2414  INTEGER, INTENT(IN) :: IKLE(nelebd*ndp)
2415  INTEGER, INTENT(IN) :: LIUBOR(nelebd),LIVBOR(nelebd)
2416  INTEGER, INTENT(IN) :: LIHBOR(nelebd),LITBOR(nelebd)
2417  DOUBLE PRECISION, INTENT(IN) :: UBOR(nelebd),VBOR(nelebd)
2418  DOUBLE PRECISION, INTENT(IN) :: HBOR(nelebd),CHBORD(nelebd)
2419  DOUBLE PRECISION, INTENT(IN) :: TBOR(nelebd),ATBOR(nelebd)
2420  DOUBLE PRECISION, INTENT(IN) :: BTBOR(nelebd)
2421  INTEGER, INTENT(OUT) :: IERR
2422  !
2423 #if defined (HAVE_CGNS)
2424  INTEGER :: CGNS_ID, I, NCLI
2425  !
2426  CALL get_obj(hash,file_id,cgns_id,ierr)
2427  IF(ierr.NE.0) THEN
2428  error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
2429  & 'SET_BND_CGNS:GET_CGNS_OBJ'
2430  RETURN
2431  ENDIF
2432  !
2433  ncli = cgns_obj_tab(cgns_id)%NCLI
2434  rewind(ncli)
2435  DO i=1,nelebd
2436  ! Write connectivity and bnoundary value the rest is set to 0.D0
2437  WRITE(ncli,4000,iostat=ierr) lihbor(i),liubor(i),livbor(i),
2438  & hbor(i),ubor(i),vbor(i),
2439  & chbord(i),litbor(i),
2440  & tbor(i),atbor(i),btbor(i),
2441  & ikle(i),i
2442  4000 FORMAT (1x,i2,1x,2(i1,1x),3(f24.12,1x),1x,
2443  & f24.12,3x,i1,1x,3(f24.12,1x),1i9,1x,1i9,
2444  & 1x,i10,1x,2(f27.15,1x),i8)
2445  IF(ierr.NE.0) THEN
2446  error_message = 'ERROR IN '//
2447  & trim(cgns_obj_tab(cgns_id)%FILE_NAME)//': '//
2448  & 'SET_BND_CGNS:WRITE:NCLI'
2449  RETURN
2450  ENDIF
2451  cgns_obj_tab(cgns_id)%NPTFR=nelebd
2452  ENDDO
2453 
2454 #else
2455 !
2456 ! CGNS LIBRARY NOT LOADED
2458 !
2459 #endif
2460  END SUBROUTINE
2461 !***********************************************************************
2462  SUBROUTINE varname2sids
2463 !***********************************************************************
2464 !
2465  &(var_name, sids_name)
2466 !
2467 !***********************************************************************
2468 ! HERMES V7P3
2469 !***********************************************************************
2470 !
2471 !brief Converts variable name into sids-standard name
2472 !
2473 !history Y AUDOUIN (LNHE)
2474 !+ 24/03/2014
2475 !+ V7P0
2476 !+
2477 !
2478 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2479 !| VAR_NAME |-->| Variable name
2480 !| SIDS_NAME |<--| SIDS-standard name
2481 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2482 !
2483  !
2484  IMPLICIT NONE
2485  !
2486  CHARACTER(LEN=VAR_SIZE), INTENT(IN) :: VAR_NAME
2487  CHARACTER(LEN=32), INTENT(OUT) :: SIDS_NAME
2488  !
2489  CHARACTER(LEN=16) VAR
2490  INTEGER :: I
2491 
2492  var = var_name(1:16)
2493  sids_name = repeat(' ',32)
2494  ! TODO: Add more correspondance
2495  SELECT CASE(var)
2496  CASE("VITESSE U","VELOCITY U")
2497  sids_name = "VelocityX"
2498  CASE("VITESSE V","VELOCITY V")
2499  sids_name = "VelocityY"
2500  CASE("VITESSE W","VELOCITY W")
2501  sids_name = "VelocityZ"
2502  CASE DEFAULT
2503  DO i=1,len(trim(var))
2504  IF(var(i:i).EQ.' '.OR.var(i:i).EQ."'") THEN
2505  sids_name(i:i) = '_'
2506  ELSE
2507  sids_name(i:i) = var(i:i)
2508  ENDIF
2509  ENDDO
2510  END SELECT
2511  END SUBROUTINE
2512 !
2513  END MODULE utils_cgns
integer, dimension(max_file) hash
Definition: utils_cgns.F:54
subroutine open_bnd_cgns(FILE_NAME, FILE_ID, OPENMODE, IERR)
Definition: utils_cgns.F:273
subroutine varname2sids(VAR_NAME, SIDS_NAME)
Definition: utils_cgns.F:2439
integer, parameter title_size
Definition: utils_cgns.F:28
subroutine get_bnd_connectivity_cgns(FILE_ID, TYP_BND_ELT, NELEBD, NDP, IKLE, IERR)
Definition: utils_cgns.F:1371
integer, parameter prism_elt_type
subroutine close_mesh_cgns(FILE_ID, IERR)
Definition: utils_cgns.F:429
subroutine get_bnd_nelem_cgns(FILE_ID, TYPE_BND_ELEM, NELEM, IERR)
Definition: utils_cgns.F:1315
subroutine add_obj(HASH, FILE_ID, HASHED_ID, IERR)
Definition: hash_table.f:66
subroutine get_mesh_npoin_per_element_cgns(FILE_ID, TYP_ELT, NDP, IERR)
Definition: utils_cgns.F:690
type(cgns_info), dimension(max_file) cgns_obj_tab
Definition: utils_cgns.F:55
subroutine get_bnd_ipobo_cgns(FILE_ID, TYPE_BND_ELEM, NPOIN, IPOBO, IERR)
Definition: utils_cgns.F:1173
subroutine get_obj(HASH, FILE_ID, HASHED_ID, IERR)
Definition: hash_table.f:15
integer, parameter triangle_elt_type
subroutine get_data_ntimestep_cgns(FILE_ID, NTIMESTEP, IERR)
Definition: utils_cgns.F:1744
subroutine get_mesh_nelem_cgns(FILE_ID, TYP_ELT, NELEM, IERR)
Definition: utils_cgns.F:640
character(len=200) error_message
subroutine get_bnd_npoin_cgns(FILE_ID, TYPE_BND_ELEM, NPTFR, IERR)
Definition: utils_cgns.F:1570
subroutine get_data_var_list_cgns(FILE_ID, NVAR, VAR_LIST, UNIT_LIST, IERR)
Definition: utils_cgns.F:1675
integer, parameter point_bnd_elt_type
subroutine get_bnd_numbering_cgns(FILE_ID, TYP_ELEM_BND, NPTFR, NBOR, IERR)
Definition: utils_cgns.F:1260
subroutine get_mesh_title_cgns(FILE_ID, TITLE, IERR)
Definition: utils_cgns.F:589
subroutine set_header_cgns(FILE_ID, TITLE, NVAR, VAR_NAME, IERR)
Definition: utils_cgns.F:1936
subroutine get_data_time_cgns(FILE_ID, RECORD, TIME, IERR)
Definition: utils_cgns.F:1792
subroutine get_data_value_cgns(FILE_ID, RECORD, VAR_NAME, RES_VALUE, N, IERR)
Definition: utils_cgns.F:1861
integer, parameter hermes_record_unknown_err
integer, parameter hermes_cgns_not_loaded_err
integer, parameter max_file
Definition: hash_table.f:7
subroutine get_mesh_l2g_numbering_cgns(FILE_ID, KNOLG, NPOIN, IERR)
Definition: utils_cgns.F:1045
subroutine set_mesh_cgns(FILE_ID, MESH_DIM, TYPELT, NDP, NPTFR, NPTIR, NELEM, NPOIN, IKLE, IPOBO, KNOLG, X, Y, NPLAN, IERR, Z)
Definition: utils_cgns.F:2002
subroutine get_mesh_connectivity_cgns(FILE_ID, TYP_ELT, IKLE, NELEM, NDP, IERR)
Definition: utils_cgns.F:740
subroutine close_bnd_cgns(FILE_ID, IERR)
Definition: utils_cgns.F:370
integer, parameter tetrahedron_elt_type
integer, parameter quadrangle_elt_type
subroutine get_mesh_nplan_cgns(FILE_ID, NPLAN, IERR)
Definition: utils_cgns.F:878
subroutine get_bnd_value_cgns(FILE_ID, TYP_BND_ELEM, NPTFR, LIHBOR, LIUBOR, LIVBOR, HBOR, UBOR, VBOR, CHBORD, TRAC, LITBOR, TBOR, ATBOR, BTBOR, IERR)
Definition: utils_cgns.F:1458
subroutine add_data_cgns(FILE_ID, VAR_NAME, TIME, RECORD, FIRST_VAR, VAR_VALUE, N, IERR)
Definition: utils_cgns.F:2236
integer, parameter var_size
Definition: utils_cgns.F:27
subroutine get_data_nvar_cgns(FILE_ID, NVAR, IERR)
Definition: utils_cgns.F:1627
subroutine get_mesh_nptir_cgns(FILE_ID, NPTIR, IERR)
Definition: utils_cgns.F:1122
subroutine set_bnd_cgns(FILE_ID, TYPE_BND_ELT, NELEBD, NDP, IKLE, LIHBOR, LIUBOR, LIVBOR, HBOR, UBOR, VBOR, CHBORD, LITBOR, TBOR, ATBOR, BTBOR, IERR)
Definition: utils_cgns.F:2350
integer, parameter hermes_wrong_element_type_err
subroutine open_mesh_cgns(FILE_NAME, FILE_ID, OPENMODE, IERR)
Definition: utils_cgns.F:67
subroutine get_mesh_npoin_cgns(FILE_ID, TYP_ELT, NPOIN, IERR)
Definition: utils_cgns.F:828
subroutine get_mesh_dimension_cgns(FILE_ID, NDIM, IERR)
Definition: utils_cgns.F:926
subroutine get_mesh_coord_cgns(FILE_ID, JDIM, NPOIN, COORD, IERR)
Definition: utils_cgns.F:974