The TELEMAC-MASCARET system  trunk
write_mesh.f
Go to the documentation of this file.
1 ! *********************
2  SUBROUTINE write_mesh
3 ! *********************
4 !
5  &(fformat,nfile,mesh,nplan,date,time,t1,t2,
6  & parall,nptir,ngeo,geoformat,latlong)
7 !
8 !***********************************************************************
9 ! BIEF V7P1
10 !***********************************************************************
11 !
12 !brief WRITES THE MESH, DESCRIBED BY THE BIEF_MESH STRUCTURE
13 !+ INTO THE FILE. BIEF_MESH STRUCTURE CONTAINS INFORMATIONS
14 !+ ABOUT CONNECTIVITY, COORDINATES, BOUNDARY NODES. OTHER
15 !+ INFORMATIONS NEEDED : THE DATE AND TIME INFORMATION, AND
16 !+ THE ORIGIN OF THE COORDINATE SYSTEM (X_ORIG,Y_ORIG).
17 !
18 !history R NEBAUER (LNHE)
19 !+ 25/11/08
20 !+ V6P0
21 !+
22 !
23 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
24 !+ 13/07/2010
25 !+ V6P0
26 !+ Translation of French comments within the FORTRAN sources into
27 !+ English comments
28 !
29 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
30 !+ 21/08/2010
31 !+ V6P0
32 !+ Creation of DOXYGEN tags for automated documentation and
33 !+ cross-referencing of the FORTRAN sources
34 !
35 !history U.H.Merkel
36 !+ 21/07/2012
37 !+ V6P2
38 !+ Changed to work with NAG
39 !
40 !history Y AUDOUIN
41 !+ 21/05/2015
42 !+ V7P0
43 !+ Adapt code to work with the hermes module
44 !
45 !history J-M HERVOUET (EDF LAB, LNHE)
46 !+ 26/06/2015
47 !+ V7P1
48 !+ Deallocate of IPOBO must always be done.
49 !
50 !history R. ATA (EDF LAB, LNHE)
51 !+ 03/08/2017
52 !+ V7P3
53 !+ Add option that allows to give results in long/lat
54 !
55 !
56 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
57 !| FFORMAT |-->| FILE FORMAT
58 !| NFILE |-->| LOGICAL UNIT OF FILE
59 !| MESH |-->| MESH STRUCTURE
60 !| NPLAN |-->| NUMBER OF PLANES (3D)
61 !| DATE |-->| 3 INTEGERS (YEAR, MONTH, DAY)
62 !| TIME |-->| 3 INTEGERS (HOUR, MINUTE, SECOND)
63 !| PARALL !-->! If True the file we are writing is a
64 !| | | partitionned file
65 !| NPTIR !-->! Number of interfaces (only for partitionned file)
66 !| NGEO |-->| ID of the geometry file if given group
67 !| | | informations are tranfered from it to nfile
68 !| GEOFORMAT |-->| Format of the geometry file
69 !| LATLONG |-->| LAT-LONG coordinate
70 !| T1,T2 |<->| Working arrays
71 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
72 !
73  USE bief_def, ONLY :bief_mesh, bief_obj
75 !
77  IMPLICIT NONE
78 !
79 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
80 !
81  CHARACTER(LEN=8), INTENT(IN ) :: FFORMAT
82  INTEGER , INTENT(IN ) :: NFILE,NPLAN
83  TYPE(bief_mesh), INTENT(IN ) :: MESH
84  TYPE(bief_obj ), INTENT(INOUT):: T1,T2
85  INTEGER, DIMENSION(3), INTENT(IN ) :: DATE
86  INTEGER, DIMENSION(3), INTENT(IN ) :: TIME
87  LOGICAL, INTENT(IN ) :: PARALL
88  INTEGER, INTENT(IN ) :: NPTIR
89  INTEGER ,OPTIONAL, INTENT(IN ) :: NGEO
90  CHARACTER(LEN=8),OPTIONAL, INTENT(IN ) :: GEOFORMAT
91  LOGICAL ,OPTIONAL, INTENT(IN ) :: LATLONG
92 !
93 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
94 !
95  INTEGER :: IERR, I, NDP,NDIM,NPOIN,IPLAN
96  INTEGER, ALLOCATABLE :: IPOBO(:)
97  INTEGER, ALLOCATABLE :: IKLE_BND(:)
98  INTEGER :: NELEBD
99  LOGICAL :: YESLL
100 !
101 !-----------------------------------------------------------------------
102 !
103  yesll=.false.
104  IF(PRESENT(latlong))yesll=latlong
105 !
106 ! BUILDING IPOBO ONLY IN SERIAL RUN
107  IF(.NOT.parall) THEN
108  ALLOCATE(ipobo(mesh%NPOIN),stat=ierr)
109  CALL check_allocate(ierr,'IPOBO')
110  DO i=1,mesh%NPOIN
111  ipobo(i) = 0
112  END DO
113  DO i=1,mesh%NPTFR
114  ipobo(mesh%NBOR%I(i)) = i
115  END DO
116  ELSE
117  ! In case if nptir = 0 because then ipobo is written instead of knolg
118  ALLOCATE(ipobo(mesh%NPOIN),stat=ierr)
119  CALL check_allocate(ierr,'IPOBO')
120  DO i=1,mesh%NPOIN
121  ipobo(i) = mesh%KNOLG%I(i)
122  END DO
123  ENDIF
124 !
125  CALL check_allocate(ierr,'IPOBO')
126 !
127  ndp = mesh%NDS(mesh%TYPELM+1,3)
128 ! New option to write results with LAT-LONG coordinates
129 !
130  IF(yesll.AND.PRESENT(geoformat).AND.PRESENT(ngeo))THEN
131  ndim=mesh%DIM1
132  npoin=mesh%NPOIN/nplan
133  CALL cpstvc(mesh%X,t1)
134  CALL cpstvc(mesh%X,t2)
135 ! GET X COORDINATE
136  CALL get_mesh_coord(geoformat,ngeo,1,ndim,npoin,t1%R,ierr)
137  IF(ierr.NE.0) THEN
138  WRITE(lu,*) 'WRITE_MESH : ERROR WHILE READING X ARRAY'
139  CALL plante(1)
140  ENDIF
141 ! GET Y COORDINATE
142  CALL get_mesh_coord(geoformat,ngeo,2,ndim,npoin,t2%R,ierr)
143  IF(ierr.NE.0) THEN
144  WRITE(lu,*) 'WRITE_MESH : ERROR WHILE READING Y ARRAY'
145  CALL plante(1)
146  ENDIF
147 ! CALL OF CORXY
148  CALL corrxy(t1%R,t2%R,npoin)
149 !
150  IF(mesh%DIM1.EQ.3) THEN
151  DO iplan=2,nplan
152  DO i=1,npoin
153  t1%R(i+(iplan-1)*npoin) = t1%R(i)
154  t2%R(i+(iplan-1)*npoin) = t2%R(i)
155  ENDDO
156  ENDDO
157 !
158  CALL set_mesh(fformat,nfile,mesh%DIM1,mesh%TYPELM,ndp,
159  & mesh%NPTFR,nptir,mesh%NELEM,mesh%NPOIN,
160  & mesh%IKLE%I,ipobo,mesh%KNOLG%I,t1%R,t2%R,
161  & nplan,date,time,mesh%X_ORIG,mesh%Y_ORIG,
162  & ierr,z=mesh%Z%R)
163  CALL check_call(ierr,'WRITE_MESH:SET_MESH')
164  ELSE
165  CALL set_mesh(fformat,nfile,mesh%DIM1,mesh%TYPELM,ndp,
166  & mesh%NPTFR,nptir,mesh%NELEM,mesh%NPOIN,
167  & mesh%IKLE%I,ipobo,mesh%KNOLG%I,t1%R,t2%R,
168  & nplan,date,time,mesh%X_ORIG,mesh%Y_ORIG,
169  & ierr)
170  CALL check_call(ierr,'WRITE_MESH:SET_MESH')
171  ENDIF
172 !
173  ELSE
174  IF(mesh%DIM1.EQ.3) THEN
175  CALL set_mesh(fformat,nfile,mesh%DIM1,mesh%TYPELM,ndp,
176  & mesh%NPTFR,nptir,mesh%NELEM,mesh%NPOIN,
177  & mesh%IKLE%I,ipobo,mesh%KNOLG%I,mesh%X%R,mesh%Y%R,
178  & nplan,date,time,mesh%X_ORIG,mesh%Y_ORIG,
179  & ierr,z=mesh%Z%R)
180  CALL check_call(ierr,'WRITE_MESH:SET_MESH')
181  ELSE
182  CALL set_mesh(fformat,nfile,mesh%DIM1,mesh%TYPELM,ndp,
183  & mesh%NPTFR,nptir,mesh%NELEM,mesh%NPOIN,
184  & mesh%IKLE%I,ipobo,mesh%KNOLG%I,mesh%X%R,mesh%Y%R,
185  & nplan,date,time,mesh%X_ORIG,mesh%Y_ORIG,
186  & ierr)
187  CALL check_call(ierr,'WRITE_MESH:SET_MESH')
188  ENDIF
189  ENDIF
190 !
191 
192 
193  DEALLOCATE(ipobo)
194 !
195  IF(PRESENT(ngeo)) THEN
196  IF((.NOT.parall).AND.geoformat.EQ.fformat) THEN
197  ! Transfering boundary information
198  CALL get_bnd_nelem(fformat,ngeo,mesh%TYPELMBND,nelebd,ierr)
199  CALL check_call(ierr,'WRITE_MESH:GET_BND_NELEM')
200  ! Getting boundary connectivity
201  ALLOCATE(ikle_bnd(nelebd*2), stat=ierr)
202  CALL get_bnd_connectivity(fformat, ngeo, mesh%TYPELMBND,
203  & nelebd, 2, ikle_bnd, ierr)
204  CALL check_call(ierr,'WRITE_MESH:GET_BND_CONNECTIVITYO')
205 
206  CALL transfer_group_info(fformat, ngeo, nfile, mesh%TYPELM,
207  & mesh%TYPELMBND,ikle_bnd,nelebd,2,.true.,.false.,ierr)
208  CALL check_call(ierr,'WRITE_MESH:TRANSFER_GROUP_INFO')
209  DEALLOCATE(ikle_bnd)
210  ENDIF
211  ENDIF
212 !
213 !-----------------------------------------------------------------------
214 !
215  RETURN
216  END
subroutine write_mesh(FFORMAT, NFILE, MESH, NPLAN, DATE, TIME, T1, T2, PARALL, NPTIR, NGEO, GEOFORMAT, LATLONG)
Definition: write_mesh.f:8
subroutine transfer_group_info(FFORMAT, FID, FID2, TYPE_ELT, TYPE_BND_ELT, IKLE_BND, NELEBD, NDP, TRANS_ELEM, TRANS_POINT, IERR)
subroutine get_bnd_connectivity(FFORMAT, FID, TYP_BND_ELEM, NELEBD, NDP, IKLE_BND, IERR)
subroutine set_mesh(FFORMAT, FILE_ID, MESH_DIM, TYPELM, NDP, NPTFR, NPTIR, NELEM, NPOIN, IKLE, IPOBO, KNOLG, X, Y, NPLAN, DATE, TIME, X_ORIG, Y_ORIG, IERR, Z, IN_PLACE)
Definition: set_mesh.f:9
subroutine corrxy(X, Y, NPOIN)
Definition: corrxy.f:7
subroutine get_bnd_nelem(FFORMAT, FID, TYPE_BND_ELEM, NELEM, IERR)
Definition: get_bnd_nelem.f:7
subroutine cpstvc(X, Y)
Definition: cpstvc.f:7
subroutine get_mesh_coord(FFORMAT, FID, JDIM, NDIM, NPOIN, COORD, IERR)
Definition: get_mesh_coord.f:7