1      SUBROUTINE ECRITAVOIR(FICH,LFICH,HED,NUMNP,NDSMAX,XYZ,IBC,NODE
2     &                     ,NPR,NFPR,PR,NGROUP,NTYP,NEL,NDS,NUMSD
3     &                     ,IMP,IENDIAN,IERR)
4C
5C Ecriture d'un avoir
6C (par routines C -> conversion possible, bid endian, little endian)
7C
8      DIMENSION XYZ(3,*),PR(6,*)
9      INTEGER   IBC(9,*),NODE(0:NDSMAX,*),NPR(*),NFPR(6,*)
10     &         ,NGROUP(*),NTYP(*),NEL(*),NDS(*)
11      CHARACTER*80  HED,CWORK
12      CHARACTER*128 FICH
13      LOGICAL IFPR
14C
15      REAL*4  WORK(100)
16      INTEGER IWORK(100)
17      EQUIVALENCE (IWORK(1),WORK(1))
18      EQUIVALENCE (IWORK(1),CWORK)
19C
20      CALL PREMIER_LIBRE(LIBRE)
21      IF (LIBRE.LT.0) THEN
22        PRINT*,'*** Pas d''unit� libre'
23        STOP
24      ENDIF
25C
26      IF (IENDIAN.EQ.1) THEN
27        IOPTEC0 = 0
28        IOPTEC1 = 1
29      ELSE
30        IOPTEC0 = 2
31        IOPTEC1 = 2
32      ENDIF
33      CALL ouvrebin(LIBRE,FICH(1:LFICH)//CHAR(0),1,IERR)
34      IF (IERR.NE.0) THEN
35        PRINT*,'*** Erreur � l''ouverture de '//FICH(1:LFICH)
36        IERR = -1
37        RETURN
38      ENDIF
39      IF (IMP.GT.1) THEN
40        NELTOT = 0
41        DO NS=1,NUMSD
42          NELTOT = NELTOT+NEL(NS)
43        ENDDO
44        NTOTAL = NELTOT+NUMNP
45        NMOD = MAX(1000,NTOTAL/50)
46        CALL INITFLUSH
47      ENDIF
48      CWORK = HED
49      CALL ecritrecbin(LIBRE,IWORK,80,IOPTEC1)
50      IWORK(1) = NUMNP
51      IWORK(2) = 8
52      CALL ecritrecbin(LIBRE,IWORK,8,IOPTEC0)
53C
54      IF (IENDIAN.EQ.1) THEN
55        DO I=1,NUMNP
56          WORK(1) = XYZ(1,I)
57          WORK(2) = XYZ(2,I)
58          WORK(3) = XYZ(3,I)
59          DO K=1,9
60            IWORK(K+3) = IBC(K,I)
61          ENDDO
62          CALL ecritrecbin(LIBRE,IWORK,48,IOPTEC0)
63          IF (IMP.GT.1) THEN
64            IF (MOD(I,NMOD).EQ.0)
65     &           CALL MYFLUSH(100.*REAL(I)/REAL(NTOTAL))
66          ENDIF
67        ENDDO
68      ELSE
69        DO I=1,NUMNP
70          WORK(1) = XYZ(1,I)
71          WORK(2) = XYZ(2,I)
72          WORK(3) = XYZ(3,I)
73          DO K=1,9
74            IWORK(K+3) = IBC(K,I)
75          ENDDO
76          CALL ecritrecbinspeed(LIBRE,IWORK,48)
77          IF (IMP.GT.1) THEN
78            IF (MOD(I,NMOD).EQ.0)
79     &           CALL MYFLUSH(100.*REAL(I)/REAL(NTOTAL))
80          ENDIF
81        ENDDO
82      ENDIF
83      N = 0
84      DO NS=1,NUMSD
85        IWORK(1) = NGROUP(NS)
86        IWORK(2) = NTYP(NS)
87        IWORK(3) = NEL(NS)
88        IWORK(4) = NDS(NS)
89        CALL ecritrecbin(LIBRE,IWORK,16,IOPTEC0)
90        LLL0 = 4*(NDS(NS)+1)
91        LLL = LLL0
92        IFPR = NDS(NS).EQ.3.OR.NDS(NS).EQ.4.OR.NDS(NS).EQ.8
93     &     .OR.NDS(NS).EQ.6.OR.NDS(NS).EQ.16
94        IF (IENDIAN.EQ.1) THEN
95          DO I=1,NEL(NS)
96            N = N+1
97            DO K=0,NDS(NS)
98              IWORK(K+1) = NODE(K,N)
99            ENDDO
100            IF (IFPR) THEN
101              IWORK(NDS(NS)+2) = NPR(N)
102              IF (NPR(N).GT.0) THEN
103                DO K=1,NPR(N)
104                  IWORK(NDS(NS)+1+2*K) = NFPR(K,N)
105                  WORK(NDS(NS)+2+2*K)  = PR(K,N)
106                ENDDO
107              ENDIF
108              LLL = LLL0+4*(1+NPR(N)*2)
109            ENDIF
110            CALL ecritrecbin(LIBRE,IWORK,LLL,IOPTEC0)
111            IF (IMP.GT.1) THEN
112              IF (MOD(N+NUMNP,NMOD).EQ.0)
113     &             CALL MYFLUSH(100.*REAL(N+NUMNP)/REAL(NTOTAL))
114            ENDIF
115          ENDDO
116        ELSE
117          DO I=1,NEL(NS)
118            N = N+1
119            DO K=0,NDS(NS)
120              IWORK(K+1) = NODE(K,N)
121            ENDDO
122            IF (IFPR) THEN
123              IWORK(NDS(NS)+2) = NPR(N)
124              IF (NPR(N).GT.0) THEN
125                DO K=1,NPR(N)
126                  IWORK(NDS(NS)+1+2*K) = NFPR(K,N)
127                  WORK(NDS(NS)+2+2*K) = PR(K,N)
128                ENDDO
129              ENDIF
130              LLL = LLL0+4*(1+NPR(N)*2)
131            ENDIF
132            CALL ecritrecbinspeed(LIBRE,IWORK,LLL)
133            IF (IMP.GT.1) THEN
134              IF (MOD(N+NUMNP,NMOD).EQ.0)
135     &             CALL MYFLUSH(100.*REAL(N+NUMNP)/REAL(NTOTAL))
136            ENDIF
137          ENDDO
138        ENDIF
139      ENDDO
140      CALL fermebin(LIBRE)
141      IF (IMP.GT.1) CALL ENDFLUSH
142      END
143C---------------------------------------------------------------------
144      SUBROUTINE ECRITAVOIR0(FICH,LFICH,HED,NUMNP,NDSMAX,XYZ,IBC,NODE
145     &                      ,NPR,NFPR,PR,NGROUP,NTYP,NEL,NDS,NUMSD,IMP
146     &                      ,IERR)
147      DIMENSION XYZ(3,*),PR(6,*)
148      INTEGER   IBC(9,*),NODE(0:NDSMAX,*),NPR(*),NFPR(6,*)
149     &         ,NGROUP(*),NTYP(*),NEL(*),NDS(*)
150      CHARACTER*80  HED
151      CHARACTER*128 FICH
152      LOGICAL IFPR
153C
154C Version avec ecriture fortran (tres lente)
155C
156      CALL PREMIER_LIBRE(LIBRE)
157      IF (LIBRE.LT.0) THEN
158        PRINT*,'*** Pas d''unit� libre'
159        STOP
160      ENDIF
161C
162      OPEN(LIBRE,FILE=FICH(1:LFICH),FORM='UNFORMATTED',IOSTAT=IERR)
163      IF (IERR.NE.0) THEN
164        PRINT*,'*** Erreur � l''ouverture de '//FICH(1:LFICH)
165        IERR = -1
166        RETURN
167      ENDIF
168C
169      IF (IMP.GT.1) THEN
170        NELTOT = 0
171        DO NS=1,NUMSD
172          NELTOT = NELTOT+NEL(NS)
173        ENDDO
174        NTOTAL = NELTOT+NUMNP
175        NMOD = MAX(1000,NTOTAL/50)
176        CALL INITFLUSH
177      ENDIF
178C
179      WRITE(LIBRE) HED
180      WRITE(LIBRE) NUMNP,8
181      DO I=1,NUMNP
182        WRITE(LIBRE) (XYZ(K,I),K=1,3),(IBC(K,I),K=1,9)
183        IF (IMP.GT.1) THEN
184          IF (MOD(I,NMOD).EQ.0)
185     &         CALL MYFLUSH(100.*REAL(I)/REAL(NTOTAL))
186        ENDIF
187      ENDDO
188      N = 0
189      DO NS=1,NUMSD
190        WRITE(LIBRE) NGROUP(NS),NTYP(NS),NEL(NS),NDS(NS)
191        IFPR = NDS(NS).EQ.3.OR.NDS(NS).EQ.4.OR.NDS(NS).EQ.8
192     &     .OR.NDS(NS).EQ.6.OR.NDS(NS).EQ.16
193        DO I=1,NEL(NS)
194          N = N+1
195          IF (IFPR) THEN
196            IF (NPR(N).GT.0) THEN
197              WRITE(LIBRE) (NODE(K,N),K=0,NDS(NS)),NPR(N)
198     &                ,(NFPR(K,N),PR(K,N),K=1,NPR(N))
199            ELSE
200              WRITE(LIBRE) (NODE(K,N),K=0,NDS(NS)),0
201            ENDIF
202          ELSE
203            WRITE(LIBRE) (NODE(K,N),K=0,NDS(NS))
204          ENDIF
205          IF (IMP.GT.1) THEN
206            IF (MOD(N+NUMNP,NMOD).EQ.0)
207     &           CALL MYFLUSH(100.*REAL(N+NUMNP)/REAL(NTOTAL))
208          ENDIF
209        ENDDO
210      ENDDO
211      CLOSE(LIBRE)
212      IF (IMP.GT.1) CALL ENDFLUSH
213      END
214C---------------------------------------------------------------------
215      SUBROUTINE ECRITAVOIREASY(FICH,LFICH,HED,NUMNP,NEL,NDS,NDSM,X,Y,Z
216     &                         ,IBC,NODE,IERR)
217C
218C Ecriture d'un avoir version simplifiee. Un seul sous-domaine
219C pas de pressions, pas de traduction
220C
221      DIMENSION X(*),Y(*),Z(*)
222      INTEGER   IBC(9,*),NODE(NDSM,*)
223      CHARACTER*80  HED,CWORK
224      CHARACTER*128 FICH
225      LOGICAL IFPR
226C
227      REAL*4  WORK(50)
228      INTEGER IWORK(50)
229      EQUIVALENCE (IWORK(1),WORK(1))
230      EQUIVALENCE (IWORK(1),CWORK)
231C
232      CALL PREMIER_LIBRE(LIBRE)
233      IF (LIBRE.LT.0) THEN
234        PRINT*,'*** Pas d''unit� libre'
235        STOP
236      ENDIF
237C
238      CALL ouvrebin(LIBRE,FICH(1:LFICH)//CHAR(0),1,IERR)
239      IF (IERR.NE.0) THEN
240        PRINT*,'*** Erreur � l''ouverture de '//FICH(1:LFICH)
241        IERR = -1
242        RETURN
243      ENDIF
244      CWORK = HED
245      CALL ecritrecbinspeed(LIBRE,IWORK,80)
246      IWORK(1) = NUMNP
247      IWORK(2) = 8
248      CALL ecritrecbinspeed(LIBRE,IWORK,8)
249C
250      DO I=1,NUMNP
251        WORK(1) = X(I)
252        WORK(2) = Y(I)
253        WORK(3) = Z(I)
254        DO K=1,9
255          IWORK(K+3) = IBC(K,I)
256        ENDDO
257        CALL ecritrecbinspeed(LIBRE,IWORK,48)
258      ENDDO
259      IWORK(1) = 1
260      IWORK(2) = 1
261      IWORK(3) = NEL
262      IWORK(4) = NDS
263      CALL ecritrecbinspeed(LIBRE,IWORK,16)
264      IFPR = NDS.EQ.3.OR.NDS.EQ.4.OR.NDS.EQ.8
265     &   .OR.NDS.EQ.6.OR.NDS.EQ.16
266      IF (IFPR) THEN
267        LLL = 4*(NDS+2)
268      ELSE
269        LLL = 4*(NDS+1)
270      ENDIF
271      DO N=1,NEL
272        IWORK(1) = N
273        DO K=1,NDS
274          IWORK(K+1) = NODE(K,N)
275        ENDDO
276        IF (IFPR) IWORK(NDS+2) = 0
277        CALL ecritrecbinspeed(LIBRE,IWORK,LLL)
278      ENDDO
279      CALL fermebin(LIBRE)
280      END
281