1 : C LIATTA SOURCE CHAT 05/01/13 01:16:50 5004 2 : SUBROUTINE LIATTA (IORES,ITLACC,IMAX1,IRET,IFORM) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C======================================================================= 6 : C BUT : LECTURE DES MATTAC 7 : C APPELE PAR : LIPIL 8 : C APPELLE : LFCDIM LFCDIE LFCDI2 9 : C ECRIT PAR FARVACQUE -REPRIS PAR LENA 10 : C 11 : DIMENSION ILECBI(1) 12 : -INC SMATTAC 13 : C 14 : SEGMENT/ ITLACC/(ITLAC(0)) 15 : SEGMENT /ILECB1/(ILECB2(NP)) 16 : C 17 : C======================================================================= 18 : C 19 : DIMENSION ILENA(10),IAUX(1) 20 : C-------------------------------------------------------------------- 21 : C ***************************** MATTAC ***************************** 22 : IRET=0 23 : IRETOU=0 24 : DO 150 IEL=1,IMAX1 24 : CALL LFCDIE (IORES,1 ,ILENA,IRETOU,IFORM) 25 : IF (IRETOU.NE.0) GO TO 1000 26 : N=ILENA(1) 27 : NN=N 28 : SEGINI MATTAC 29 : ITLAC(**)=MATTAC 30 : DO 151 I=1,NN 30 : CALL LFCDIE (IORES,2 ,ILENA,IRETOU,IFORM) 31 : IF (IRETOU.NE.0) GO TO 1000 32 : M=ILENA(1) 33 : N=ILENA(2) 34 : SEGINI MSOUMA 35 : LISATT(I)=MSOUMA 35 : CALL LFCDIM (IORES,1 ,ILECBI,IRETOU,IFORM) 36 : WRITE(ITYATT,FMT='(A4)')ILECBI(1) 37 : IF (IRETOU.NE.0) GO TO 1000 37 : CALL LFCDIE (IORES,M ,IPMATK,IRETOU,IFORM) 38 : IF (IRETOU.NE.0) GO TO 1000 38 : CALL LFCDIE (IORES,N ,IATREL,IRETOU,IFORM) 39 : IF (IRETOU.NE.0) GO TO 1000 39 : CALL LFCDIE (IORES,1 ,IGEOCH,IRETOU,IFORM) 40 : IF (IRETOU.NE.0) GO TO 1000 40 : CALL LFCDIE (IORES,1 ,IAUX,IRETOU,IFORM) 41 : MPHYCH=IAUX(1) 42 : IF (IRETOU.NE.0) GO TO 1000 43 : C 44 : IF (IGEOCH.EQ.0) GO TO 152 44 : CALL LFCDIE (IORES,5 ,ILENA,IRETOU,IFORM) 45 : IF (IRETOU.NE.0) GO TO 1000 46 : NI=ILENA(1) 47 : NJ=ILENA(2) 48 : N1=ILENA(3) 49 : NP=ILENA(4) 50 : NT=ILENA(5) 51 : SEGINI MGEOCH 52 : IGEOCH=MGEOCH 52 : CALL LFCDIE (IORES,NI ,INORCH,IRETOU,IFORM) 53 : IF (IRETOU.NE.0) GO TO 1000 53 : CALL LFCDI2 (IORES,NJ ,RJEUCH,IRETOU,IFORM) 54 : IF (IRETOU.NE.0) GO TO 1000 54 : CALL LFCDIE (IORES,N1 ,IMAPRO,IRETOU,IFORM) 55 : IF (IRETOU.NE.0) GO TO 1000 56 : SEGINI ILECB1 56 : CALL LFCDIM (IORES,NP ,ILECB2,IRETOU,IFORM) 57 : WRITE(MPOPRO,FMT='(18A4)')(ILECB2(IY),IY=1,NP) 58 : SEGDES ILECB1 59 : IF (IRETOU.NE.0) GO TO 1000 59 : CALL LFCDI2 (IORES,NT ,TAIPRO,IRETOU,IFORM) 60 : IF (IRETOU.NE.0) GO TO 1000 61 : SEGDES MGEOCH 62 : 152 CONTINUE 63 : C 64 : IF (MPHYCH.EQ.0) GO TO 153 64 : CALL LFCDIE (IORES,3 ,ILENA,IRETOU,IFORM) 65 : IF (IRETOU.NE.0) GO TO 1000 66 : NRAI=ILENA(1) 67 : NA=ILENA(2) 68 : NF=ILENA(3) 69 : SEGINI MPHYCH 70 : IPHYCH=MPHYCH 70 : CALL LFCDI2 (IORES,NRAI ,RAIPRO,IRETOU,IFORM) 71 : IF (IRETOU.NE.0) GO TO 1000 71 : CALL LFCDI2 (IORES,NA ,AMOPRO,IRETOU,IFORM) 72 : IF (IRETOU.NE.0) GO TO 1000 72 : CALL LFCDI2 (IORES,NF ,FROPRO,IRETOU,IFORM) 73 : IF (IRETOU.NE.0) GO TO 1000 74 : SEGDES MPHYCH 75 : 153 CONTINUE 76 : C 77 : SEGDES MSOUMA 78 : 151 CONTINUE 79 : SEGDES MATTAC 80 : 150 CONTINUE 81 : 1000 CONTINUE 82 : IRET=IRETOU 83 : RETURN 84 : C ------------------------------------------------------- 85 : END 86 :
© Cast3M 2003 - All rights reserved.
Disclaimer