The TELEMAC-MASCARET system  trunk
get_bnd_color.f
Go to the documentation of this file.
1 ! ************************
2  SUBROUTINE get_bnd_color
3 ! ************************
4 !
5  &(fformat,fid,typ_bnd_elem,nelebd,color,ierr)
6 !
7 !***********************************************************************
8 ! HERMES V7P0 01/05/2014
9 !***********************************************************************
10 !
11 !brief Returns an array containing
12 !+ The color of each boundary element
13 !
14 !history Y AUDOUIN (LNHE)
15 !+ 19/09/2017
16 !+ V7P3
17 !+
18 !
19 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
20 !| FFORMAT |-->| FORMAT OF THE FILE
21 !| FID |-->| FILE DESCRIPTOR
22 !| TYP_BND_ELEM |-->| TYPE OF THE BOUNDARY ELEMENT
23 !| NELEBD |-->| NUMBER OF BOUNDARY ELEMENTS
24 !| COLOR |<->| Boundary color
25 !| IERR |<--| 0 IF NO ERROR DURING THE EXECUTION
26 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
27 !
28  USE utils_serafin
29  USE utils_med
30  USE utils_cgns
32  IMPLICIT NONE
33 !
34 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
35 !
36  CHARACTER(LEN=8), INTENT(IN) :: FFORMAT
37  INTEGER, INTENT(IN) :: FID, NELEBD, TYP_BND_ELEM
38  INTEGER, INTENT(INOUT) :: COLOR(nelebd)
39  INTEGER, INTENT(OUT) :: IERR
40 !
41 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
42 !
43  INTEGER I
44 
45  DO i=1,nelebd
46  color(i) = i
47  ENDDO
48 !
49  SELECT CASE (fformat(1:7))
50  CASE ('SERAFIN')
51  CALL get_bnd_color_srf(fid,typ_bnd_elem,nelebd,color,ierr)
52  CASE ('MED ')
53  CONTINUE
54  CASE ('CGNS ')
55  CONTINUE
56  CASE DEFAULT
58  WRITE(error_message,*)
59  & 'GET_BND_NUMBERING: BAD FILE FORMAT: ',fformat
60  RETURN
61  END SELECT
62 !
63 !-----------------------------------------------------------------------
64 !
65  RETURN
66  END
67 
68 
subroutine get_bnd_color_srf(FILE_ID, TYP_BND_ELT, NELEBD, COLOR, IERR)
subroutine get_bnd_color(FFORMAT, FID, TYP_BND_ELEM, NELEBD, COLOR, IERR)
Definition: get_bnd_color.f:7
character(len=200) error_message
integer, parameter hermes_unknown_file_format_err