1 : C LINUAG SOURCE PV 05/04/13 21:15:55 5073 2 : SUBROUTINE LINUAG(IORES,ITLACC,IMAX1,IRET,IFORM) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C======================================================================= 6 : C BUT : LECTURE D UN NUAGE 7 : C APPELE PAR : LIPIL 8 : C APPELLE : LFCDIM LFCDIE LFCDI2 9 : C======================================================================= 10 : C======================================================================= 11 : -INC SMNUAGE 12 : -INC CCFXDR 13 : C 14 : C 15 : C======================================================================= 16 : SEGMENT/ITBBE1/( ITABE1(NN)) 17 : SEGMENT/ITBBM1/( ITABM1(NM)) 18 : segment itbbc1 19 : character*4 itabc1(nm) 20 : endsegment 21 : SEGMENT/ITLACC/( ITLAC(0)) 22 : DIMENSION ILENA(2) 23 : CHARACTER*8 CTYP 24 : C-------------------------------------------------------------------- 25 : IRET=0 26 : DO 1101 IEL=1,IMAX1 27 : * write(6,fmt='('' nuage numero '',i6)') iel 28 : NTOTO=2 28 : CALL LFCDIE(IORES,NTOTO,ILENA,IRETOU,IFORM) 29 : IF (IRETOU.NE.0) GO TO 1000 30 : NVAR = ILENA(1) 31 : NBCOUP=ILENA(2) 32 : * write(6,fmt='( ''nvar nbcoup '' , 2I6)') nvar,nbcoup 33 : NM = 4*NVAR 34 : SEGINI ITBBM1,itbbc1 35 : SEGINI MNUAGE 35 : if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM) 36 : if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4)) 37 : * write(6,fmt='('' nuanomtyp '',/,(6a10))') (itabm1(lk),lk=1,nm) 38 : IF(IRETOU.NE.0) GOTO 1000 39 : DO 1 I=1,NVAR 40 : J = 4*I-3 41 : if (iform.ne.2) then 42 : WRITE (NUANOM(I),FMT='(2A4)') ITABM1(J),ITABM1(J+1) 43 : WRITE (NUATYP(I),FMT='(2A4)') ITABM1(J+2),ITABM1(J+3) 44 : else 45 : nuanom(i)(1:4)=itabc1(j) 46 : nuanom(i)(5:8)=itabc1(j+1) 47 : nuatyp(i)(1:4)=itabc1(j+2) 48 : nuatyp(i)(5:8)=itabc1(j+3) 49 : endif 50 : 1 CONTINUE 51 : SEGSUP ITBBM1,itbbc1 52 : DO 2 I= 1,NVAR 53 : CTYP = NUATYP(I) 54 : IF( CTYP.EQ.'FLOTTANT') THEN 55 : SEGINI NUAVFL 56 : NUAPOI(I)= NUAVFL 56 : CALL LFCDI2(IORES,NBCOUP,NUAFLO,IRETOU,IFORM) 57 : IF(IRETOU.NE.0) GOTO 1000 58 : SEGDES NUAVFL 59 : ELSEIF(CTYP.EQ.'MOT ') THEN 60 : SEGINI NUAVMO 61 : NUAPOI(I)=NUAVMO 62 : NM = NBCOUP*2 63 : SEGINI ITBBM1,itbbc1 63 : if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM) 64 : if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4)) 65 : IF(IRETOU.NE.0) GOTO 1000 66 : DO 3 K=1,NBCOUP 67 : J=2*K -1 68 : if (iform.ne.2) then 69 : WRITE (NUAMOT(K),FMT='(2A4)') ITABM1(J),ITABM1(J+1) 70 : else 71 : nuamot(k)(1:4)=itabc1(j) 72 : nuamot(k)(5:8)=itabc1(j+1) 73 : endif 74 : 3 CONTINUE 75 : SEGDES NUAVMO 76 : SEGSUP ITBBM1,itbbc1 77 : ELSEIF(CTYP.EQ.'LOGIQUE ') THEN 78 : SEGINI NUAVLO 79 : NUAPOI(I)= NUAVLO 80 : NN=NBCOUP 81 : SEGINI ITBBE1 81 : CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM) 82 : IF(IRETOU.NE.0) GOTO 1000 83 : DO 4 K=1,NN 84 : IF( ITABE1(K).EQ.1) THEN 85 : NUALOG(K)=.TRUE. 86 : ELSE 87 : NUALOG(K)=.FALSE. 88 : ENDIF 89 : 4 CONTINUE 90 : SEGSUP ITBBE1 91 : SEGDES NUAVLO 92 : ELSE 93 : SEGINI NUAVIN 94 : NUAPOI(I)=NUAVIN 94 : CALL LFCDIE(IORES,NBCOUP,NUAINT,IRETOU,IFORM) 95 : IF(IRETOU.NE.0) GOTO 1000 96 : SEGDES NUAVIN 97 : ENDIF 98 : 2 CONTINUE 99 : SEGDES MNUAGE 100 : ITLAC(**)=MNUAGE 101 : * write(6,fmt='('' fin du nuage'')') 102 : 1101 CONTINUE 103 : RETURN 104 : 1000 CONTINUE 105 : IRET=1 106 : IF(MNUAGE.NE.0) SEGSUP MNUAGE 107 : RETURN 108 : C ------------------------------------------------------- 109 : END 110 : 111 : 112 :
© Cast3M 2003 - All rights reserved.
Disclaimer