The TELEMAC-MASCARET system  trunk
postel3d.f
Go to the documentation of this file.
1 ! *******************
2  SUBROUTINE postel3d
3 ! *******************
4 !
5 !***********************************************************************
6 ! POSTEL3D VERSION 5.1 01/09/99 T. DENOT (LNH) 01 30 87 74 89
7 ! FORTRAN90
8 !***********************************************************************
9 !
10 ! PPPP OOO SSSS TTTTT EEEEE L 3333 DDDD
11 ! P P O O S T E L 3 D D
12 ! PPPP O O SSS T EEEE L --- 333 D D
13 ! P O O S T E L 3 D D
14 ! P OOO SSSS T EEEEE LLLLL 3333 DDDD
15 !
16 !-----------------------------------------------------------------------
17 !
18 ! SOUS-PROGRAMME APPELE PAR : HOMERE_POSTEL3D
19 ! SOUS-PROGRAMME APPELES : LIT, PRE2DH, PRE2DV, LECR3D, COUPEH, COUPEV
20 !
21 !history Y AUDOUIN (LNHE)
22 !+ 25/05/2015
23 !+ V7P0
24 !+ Modification to comply with the hermes module
25 !
26 !-----------------------------------------------------------------------
27 ! DECLARATION DES TYPES ET DIMENSIONS
28 !-----------------------------------------------------------------------
29 !
30  USE bief
35 !
37  IMPLICIT NONE
38 !
39 ! TABLEAUX DE REELS
40 !
41  DOUBLE PRECISION SHP(im,3,nc2dv)
42 !
43 ! TABLEAUX D'ENTIERS
44 !
45  INTEGER IKLES(3,nelem2) , PLINF(npoin2)
46  INTEGER IPOBO(npoin2)
47  INTEGER ELEM(im,nc2dv)
48  INTEGER N,NPRE
49 !
50 ! VARIABLES LOCALES
51 !
52  INTEGER I, K , IMSEG(49,9)
53  DOUBLE PRECISION AT
54  INTEGER :: IENRE
55 !
56 ! VARIABLES BIDON POUR LIT
57 !
58  DOUBLE PRECISION, ALLOCATABLE :: VAR(:)
59  DOUBLE PRECISION, ALLOCATABLE :: SHZ(:)
60  INTEGER ERR, IERR
61  CHARACTER(LEN=8) PRE_FMT, VER_FMT, HOR_FMT
62  CHARACTER(LEN=16),ALLOCATABLE :: VAR_NAME(:), VAR_UNIT(:)
63  INTEGER, ALLOCATABLE :: NHOR(:)
64  INTEGER, ALLOCATABLE :: NVER(:)
65 !
66 !***********************************************************************
67 ! allocate a (simple) REAL vector
68 !
69  ALLOCATE(var(npoin2),stat=err)
70  CALL check_allocate(err,'POSTEL3D:VAR')
71 !
72  ALLOCATE(shz(npoin2),stat=err)
73  CALL check_allocate(err,'POSTEL3D:SHZ')
74 !
75 !***********************************************************************
76 !
77 ! LECTURE DES DONNEES RELATIVES AU MAILLAGE
78 ! DANS LE FICHIER DE RESULTATS 3D
79 !
80  npre = pos_files(pospre)%LU
81  pre_fmt = pos_files(pospre)%FMT
82  ALLOCATE(nhor(max(nc2dh,1)),stat=ierr)
83  CALL check_allocate(ierr,"NHOR")
84  nhor(1) = pos_files(poshor)%LU
85  hor_fmt = pos_files(poshor)%FMT
86  ALLOCATE(nver(max(nc2dv,1)),stat=ierr)
87  CALL check_allocate(ierr,"NVER")
88  nver(1) = pos_files(posver)%LU
89  ver_fmt = pos_files(posver)%FMT
90 !
91 !
92  CALL get_data_nvar(pre_fmt,npre,nva3,ierr)
93  CALL check_call(ierr, 'POSTEL3D:GET_DATA_NVAR')
94 !
95 ! LEC/ECR 3 : NOMS ET UNITES DES VARIABLES
96 !
97  IF(nva3.GE.1) THEN
98  ALLOCATE(var_name(nva3),stat=ierr)
99  CALL check_allocate(ierr,'POSTEL3D:VAR_NAME')
100  ALLOCATE(var_unit(nva3),stat=ierr)
101  CALL check_allocate(ierr,'POSTEL3D:VAR_UNIT')
102  CALL get_data_var_list(pre_fmt,npre,nva3,var_name,var_unit,ierr)
103  CALL check_call(ierr, 'POSTEL3D:GET_DATA_VAR_LIST')
104  DO i=1,nva3
105  textlu(i)(1:16) = var_name(i)
106  textlu(i)(17:32) = var_unit(i)
107  ENDDO
108  DEALLOCATE(var_name,var_unit)
109  ENDIF
110 !
111 !
112  CALL get_mesh_coord(pre_fmt,npre,1,2,npoin3,x,ierr)
113  CALL check_call(ierr, 'POSTEL3D:GET_MESH_COORD:X')
114  CALL get_mesh_coord(pre_fmt,npre,2,2,npoin3,y,ierr)
115  CALL check_call(ierr, 'POSTEL3D:GET_MESH_COORD:X')
116 
117  CALL get_mesh_orig(pre_fmt,npre,x_orig,y_orig,ierr)
118  CALL check_call(ierr, 'POSTEL3D:GET_MESH_ORIG')
119 !
120 ! *****************
121 ! fin de l'en-tete
122 ! *****************
123 !
124 ! INVERSION DE IKLE3 EN IKLES
125 !
126  DO k = 1,nelem2
127  ikles(1,k) = ikle2%I(k)
128  ikles(2,k) = ikle2%I(k+nelem2)
129  ikles(3,k) = ikle2%I(k+2*nelem2)
130  ENDDO
131  ! Cancelling the opening done in bief_open_file as multiple files will be reopen
132 
133  IF(nc2dh.GE.1) THEN
134  CALL close_mesh(hor_fmt,nhor(1),ierr)
135  CALL check_call(ierr,'POSTEL3D:CLOSE_MESH')
136  ENDIF
137  IF(nc2dv.GE.1) THEN
138  CALL close_mesh(ver_fmt,nver(1),ierr)
139  CALL check_call(ierr,'POSTEL3D:CLOSE_MESH')
140  ENDIF
141 !
142 ! PREPARATION DES DONNEES POUR LES COUPES HORIZONTALES
143 !
144  IF(nc2dh.GE.1) THEN
145  DO k = 1,npoin2
146  ipobo(k) = 0
147  ENDDO
148  CALL pre2dh(x,y,ikles,ipobo,npoin2,nelem2,nc2dh,nhor,
149  & titcas,hor_fmt,nva3,textlu,x_orig,y_orig)
150  ENDIF
151 !
152 ! PREPARATION DES DONNEES POUR LES COUPES VERTICALES
153 !
154  IF(nc2dv.GE.1) THEN
155  CALL pre2dv(x,y,shp,nseg,imseg,x2dv,y2dv,
156  & ikles,elem,npoin2,nelem2,im,nc2dv)
157  ENDIF
158 !
159 !-----------------------------------------------------------------------
160 !
161 ! LECTURE ECRITURE DES RESULTATS RELATIFS AU IEME ENREGISTREMENT
162 !
163 !
164  DO k = 1,nenre
165  IF (k.GE.nuprso.AND.mod(k-nuprso,pesogr).EQ.0) THEN
166  ienre = (k-nuprso)/pesogr
167 !
168 ! LA ON SAIT QUE CET ENREGISTREMENT EST A TRANSCRIRE
169 !
170  CALL lecr3d(k-1,at,z,u%R,v%R,w%R,npoin3,npoin2,nplan,
171  & npre,pre_fmt,nva3,tab)
172 !
173  IF(nc2dh.GE.1) THEN
174  CALL coupeh (ienre,at,z,u%R,v%R,w%R,
175  & href,nplref,plinf,nc2dh,npoin2,nplan,nhor,hor_fmt,
176  & var,shz,nva3,tab,textlu)
177  ENDIF
178 !
179  IF (nc2dv.GE.1) THEN
180  DO n=1,nc2dv
181  CALL coupev(at,z,u%R,v%R,w%R,shp,
182  & imseg,x2dv,y2dv,distor,ikles,elem,nc2dv,npoin2,
183  & nelem2,nver,ver_fmt,im,jm,titcas,nva3,tab,textlu,
184  & ienre)
185  ENDDO
186  ENDIF
187  ENDIF
188  ENDDO
189 !
190  IF (nc2dh.GE.2) THEN
191  DO i=2,nc2dh
192  CALL close_mesh(hor_fmt,nhor(i),ierr)
193  CALL check_call(ierr,'POSTEL3D:CLOSE_MESH')
194  ENDDO
195  ENDIF
196  pos_files(poshor)%LU = nhor(1)
197  ! Reopening the file for bief_close_mesh
198  CALL open_mesh(ver_fmt,'POSVER',pos_files(posver)%LU,
199  & 'WRITE ',ierr)
200 !
201  DEALLOCATE(var)
202  DEALLOCATE(shz)
203  DEALLOCATE(nhor)
204  DEALLOCATE(nver)
205 !
206 !-----------------------------------------------------------------------
207 !
208  RETURN
209  END SUBROUTINE
subroutine pre2dv(X, Y, SHP, NSEG, IMSEG, X2DV, Y2DV, IKLES, ELEM, NPOIN2, NELEM2, IM, NC2DV)
Definition: pre2dv.f:8
subroutine postel3d
Definition: postel3d.f:4
subroutine get_mesh_orig(FFORMAT, FID, X_ORIG, Y_ORIG, IERR)
Definition: get_mesh_orig.f:7
double precision, dimension(:), pointer x
subroutine close_mesh(FFORMAT, FILE_ID, IERR, MESH_NUMBER)
Definition: close_mesh.f:7
subroutine get_data_nvar(FFORMAT, FID, NVAR, IERR)
Definition: get_data_nvar.f:7
integer, dimension(9) nplref
type(bief_obj), target w
subroutine get_data_var_list(FFORMAT, FID, NVAR, VARLIST, UNITLIST, IERR)
double precision, dimension(9) href
double precision, dimension(:), pointer y
type(bief_obj), target u
type(bief_file), dimension(100) pos_files
integer, dimension(9) nseg
double precision, dimension(50, 9) x2dv
type(bief_obj), target tab
character(len=32), dimension(100) textlu
double precision, dimension(:), pointer z
type(bief_obj), pointer ikle2
subroutine coupev(AT, Z, U, V, W, SHP, IMSEG, X2DV, Y2DV, DISTOR, IKLES, ELEM, NC2DV, NPOIN2, NELEM2, NCOU, FFORMAT, IM, JM, TITCAS, NVA3, TAB, TEXTLU, IENRE)
Definition: coupev.f:10
type(bief_obj), target v
subroutine get_mesh_coord(FFORMAT, FID, JDIM, NDIM, NPOIN, COORD, IERR)
Definition: get_mesh_coord.f:7
subroutine pre2dh(X, Y, IKLES, IPOBO, NPOIN2, NELEM2, NC2DH, NCOU, TITCAS, FFORMAT, NVA3, TEXTLU, X_ORIG, Y_ORIG)
Definition: pre2dh.f:8
subroutine open_mesh(FFORMAT, FILE_NAME, FILE_ID, OPENMODE, IERR, MESH_NUMBER)
Definition: open_mesh.f:7
subroutine lecr3d(IREC, AT, Z, U, V, W, NPOIN3, NPOIN2, NPLAN, NRES, FFORMAT, NVA3, TAB)
Definition: lecr3d.f:7
subroutine coupeh(IREC, AT, Z, U, V, W, HREF, NPLREF, PLINF, NC2DH, NPOIN2, NPLAN, NCOU, FFORMAT, VAR, SHZ, NVA3, TAB, TEXTELU)
Definition: coupeh.f:8
double precision, dimension(50, 9) y2dv
double precision, dimension(9) distor
Definition: bief.f:3