C WRATTA SOURCE CHAT 05/01/13 04:11:59 5004 SUBROUTINE WRATTA(IOSAU,ITLACC,IMAX1,IRET,IFORM,IDEB) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C======================================================================= C BUT : ECRITURE DES ATTAC SUR LE FICHIER IOSAU C APPELE PAR WRPIL C APPELLE : ECDIFE ECDIFM ECDIFR C : ECDES ECDIFP JDANSI C ECRIT PAR FARVACQUE - REPRIS PAR LENA C======================================================================= -INC SMATTAC SEGMENT/ITLACC/(ITLAC(0)),ITLAC1.ITLACC,ITLAC2.ITLACC, 1 ITLAC3.ITLACC,ITLAC4.ITLACC,ITLAC5.ITLACC,ITLAC6.ITLACC DIMENSION ILENA(10) C ***************************** MATTAC ***************************** IRET=0 6015 CONTINUE DO 150 IEL=IDEB,IMAX1 MATTAC=ITLAC(IEL) SEGACT MATTAC NN=LISATT(/1) ILENA(1)=NN CALL ECDIFE (IOSAU,1 , ILENA,IFORM) DO 151 I=1,NN MSOUMA=LISATT(I) SEGACT MSOUMA M=IPMATK(/1) N=IATREL(/1) ILENA(1)= M ILENA(2)= N CALL ECDIFE (IOSAU,2 ,ILENA ,IFORM) READ (ITYATT,FMT='(A4)') ILENA(1) CALL ECDIFM (IOSAU,1 ,ILENA ,IFORM) CALL ECDIFE (IOSAU,M ,IPMATK,IFORM) CALL ECDIFE (IOSAU,N ,IATREL,IFORM) CALL ECDIFE (IOSAU,1 ,IGEOCH,IFORM) CALL ECDIFE (IOSAU,1 ,IPHYCH,IFORM) IF(IGEOCH.EQ.0) GO TO 153 MGEOCH=IGEOCH SEGACT MGEOCH NI=INORCH(/1) NJ=RJEUCH(/1) N1=IMAPRO(/1) NP= MPOPRO(/2) NT=TAIPRO(/1) ILENA(1)= NI ILENA(2)= NJ ILENA(3)= N1 ILENA(4)= NP ILENA(5)= NT CALL ECDIFE (IOSAU,5 ,ILENA,IFORM) CALL ECDIFE (IOSAU,NI ,INORCH,IFORM) CALL ECDIFR (IOSAU,NJ ,RJEUCH,IFORM) CALL ECDIFE (IOSAU,N1 ,IMAPRO,IFORM) READ (MPOPRO,FMT='(10A4)') (ILENA(II),II=1,NP) CALL ECDIFM (IOSAU,NP ,ILENA ,IFORM) CALL ECDIFR (IOSAU,NT ,TAIPRO,IFORM) SEGDES MGEOCH 153 CONTINUE IF(IPHYCH.EQ.0) GO TO 152 MPHYCH=IPHYCH SEGACT MPHYCH NRAI=1 NA=AMOPRO(/1) NF= FROPRO(/1) ILENA(1)= NRAI ILENA(2)= NA ILENA(3)= NF CALL ECDIFE (IOSAU,3 ,ILENA,IFORM) CALL ECDIFR (IOSAU,NRAI ,RAIPRO,IFORM) CALL ECDIFR (IOSAU,NA ,AMOPRO,IFORM) CALL ECDIFR (IOSAU,NF ,FROPRO,IFORM) SEGDES MPHYCH 152 CONTINUE SEGDES MSOUMA 151 CONTINUE SEGDES MATTAC 150 CONTINUE GOTO 1098 C ****************************************************************** 1098 CONTINUE RETURN END