The TELEMAC-MASCARET system  trunk
ecrdeb.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE ecrdeb
3 ! *****************
4 !
5  &(canal,fformat,titcas,nbvar,c2dh,textlu,ic,n)
6 !
7 !***********************************************************************
8 ! POSTEL3D VERSION 5.1 01/09/99 T. DENOT (LNH) 01 30 87 74 89
9 ! FORTRAN90
10 !***********************************************************************
11 !
12 ! FONCTION : OUVERTURE D'UN FICHIER POUR UNE COUPE
13 ! + ECRITURE DU DEBUT DE l'ENTETE (TITRE,NBV,TEXTE).
14 !
15 !-----------------------------------------------------------------------
16 ! ARGUMENTS
17 ! .________________.____.______________________________________________.
18 ! ! NOM !MODE! ROLE !
19 ! !________________!____!______________________________________________!
20 ! ! CANAL ! -->! CANAL DE SORTIE !
21 ! ! FFORMAT ! -->! FORMAT DU FICHIER POUR LES COUPES !
22 ! ! TITCAS ! -->! TITRE LU DANS LE FICHIER DE RESULTATS !
23 ! ! NBV ! -->! NOMBRE DE VARIABLES EN SORTIE !
24 ! ! SORG3D ! -->! INDICATEUR DES VARIABLES ENREGISTREES !
25 ! ! C2DH ! -->! INDICATEUR DE LA NATURE DE LA COUPE (H OU V) !
26 ! !________________!____!______________________________________________!
27 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
28 !-----------------------------------------------------------------------
29 !
30 ! SOUS-PROGRAMME APPELE PAR : PRE2DH , COUPEV
31 ! SOUS-PROGRAMME APPELES : ECRI2
32 !
33 !history Y AUDOUIN (LNHE)
34 !+ 25/05/2015
35 !+ V7P0
36 !+ Modification to comply with the hermes module
37 !
38 !***********************************************************************
39 !
40  USE bief
42 !
44  IMPLICIT NONE
45 !
46 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
47 !
48  INTEGER ,INTENT(IN) :: NBVAR
49  INTEGER, INTENT(INOUT) :: CANAL
50  INTEGER, INTENT(IN) :: IC,N
51  LOGICAL, INTENT(IN) :: C2DH
52  CHARACTER(LEN=72), INTENT(IN) :: TITCAS
53  CHARACTER(LEN=32), INTENT(IN) :: TEXTLU(100)
54  CHARACTER(LEN=8), INTENT(INOUT) :: FFORMAT
55 !
56 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
57 !
58  INTEGER :: I
59  CHARACTER(LEN=80) TITRE
60  CHARACTER(LEN=15) NOMCOU
61 !
62  CHARACTER(LEN=3) :: EXTEN1
63  CHARACTER(LEN=7) :: EXTEN2
64  EXTERNAL exten1,exten2
65  CHARACTER(LEN=32), ALLOCATABLE :: VAR_NAME(:)
66  INTEGER :: IVAR, IERR
67 !
68 !-----------------------------------------------------------------------
69 !
70 ! OUVERTURE DU FICHIER D'UNE COUPE
71 !
72  IF(c2dh) THEN
73  nomcou = 'POSHOR_' // exten1(ic) // ' '
74  ELSE
75  nomcou = 'POSVER_' // exten2(ic,n+1)
76  ENDIF
77 !
78  CALL open_mesh(fformat,nomcou,canal,'WRITE ',ierr)
79  CALL check_call(ierr,'ECRDEB:OPEN_MESH')
80 !
81 !-----------------------------------------------------------------------
82 !
83 ! ECRITURE DU TITRE
84 !
85  titre = titcas // fformat
86 !
87 !-----------------------------------------------------------------------
88 !
89 ! ECRITURE DU NOMBRE DE VARIABLES EN SORTIE
90 !
91 !
92  ivar = 1
93 !
94 !-----------------------------------------------------------------------
95 !
96 ! ECRITURE DES TEXTES
97 !
98  IF (c2dh) THEN
99  ALLOCATE(var_name(nbvar+1),stat=ierr)
100  CALL check_allocate(ierr,'ECRDEB:VAR_NAME')
101 !
102  IF (lng.EQ.lng_fr) var_name(ivar) =
103  & 'INDICATEUR DOM. '
104  IF (lng.EQ.lng_en) var_name(ivar) =
105  & 'DOMAIN INDICATOR '
106  ivar = ivar + 1
107 !
108  ELSE
109  ALLOCATE(var_name(nbvar),stat=ierr)
110  CALL check_allocate(ierr,'ECRDEB:VAR_NAME')
111 !
112  IF (lng.EQ.lng_fr) var_name(ivar) =
113  & 'VITESSE UT M/S '
114  IF (lng.EQ.lng_en) var_name(ivar) =
115  & 'VELOCITY UT M/S '
116  ivar = ivar + 1
117 !
118  IF (lng.EQ.lng_fr) var_name(ivar) =
119  & 'VITESSE W M/S '
120  IF (lng.EQ.lng_en) var_name(ivar) =
121  & 'VELOCITY W M/S '
122  ivar = ivar + 1
123 !
124  IF (lng.EQ.lng_fr) var_name(ivar) =
125  & 'VITESSE UN M/S '
126  IF (lng.EQ.lng_en) var_name(ivar) =
127  & 'VELOCITY UN M/S '
128  ivar = ivar + 1
129 !
130  ENDIF
131 !
132 ! Adding z
133  var_name(ivar) = textlu(1)
134  ivar = ivar + 1
135  IF (c2dh) THEN
136  DO i=2,nbvar
137  var_name(ivar) = textlu(i)
138  ivar = ivar + 1
139  ENDDO
140  ELSE
141  IF (nbvar.GT.4) THEN
142  ! Adding the rest of the variable skipping velocity
143  DO i=5,nbvar
144  var_name(ivar) = textlu(i)
145  ivar = ivar + 1
146  ENDDO
147  ENDIF
148  ENDIF
149  CALL set_header(fformat,canal,titre,ivar-1,
150  & var_name(1:ivar-1),ierr)
151  CALL check_call(ierr,'ECRDEB:SET_HEADER')
152 !
153 !-----------------------------------------------------------------------
154 !
155  RETURN
156  END
integer, parameter lng_en
subroutine ecrdeb(CANAL, FFORMAT, TITCAS, NBVAR, C2DH, TEXTLU, IC, N)
Definition: ecrdeb.f:7
integer, parameter lng_fr
Y. AUDOUIN & J-M HERVOUET (EDF LAB, LNHE) 09/05/2014 V7P0 First version.
subroutine set_header(FFORMAT, FILE_ID, TITLE, NVAR, VAR_NAME, IERR)
Definition: set_header.f:7
subroutine open_mesh(FFORMAT, FILE_NAME, FILE_ID, OPENMODE, IERR, MESH_NUMBER)
Definition: open_mesh.f:7
Definition: bief.f:3