C NUAGE SOURCE CHAT 05/01/13 02:02:47 5004 SUBROUTINE NUAGE IMPLICIT INTEGER(I-N) -INC PPARAM -INC CCOPTIO -INC SMNUAGE CHARACTER*8 NOM,ITYPE,NOP CHARACTER*4 MO(2) REAL*8 XIJ LOGICAL LIJ DATA MO/'COMP','* '/ NVAR=0 NBCOUP=0 * * lecture dans le cas d'un champ par point * CALL LIROBJ('CHPOINT', MCHPOI, 0, IRETOU) IF (IERR .NE. 0) RETURN IF (IRETOU .NE. 0) THEN CALL NUACHP(MCHPOI) GOTO 200 ENDIF SEGINI MNUAGE CALL LIRMOT ( MO,1,IVA,0) IF(IVA.EQ.1) GO TO 50 * * lecture dans le cas d'un champ par élément * CALL LIROBJ('MCHAML', MCHEML, 0, IRETOU) IF (IERR .NE. 0) RETURN IF (IRETOU .NE. 0) THEN CALL NUACHL(MCHEML) goto 200 ENDIF SEGINI MNUAGE CALL LIRMOT ( MO,1,IVA,0) IF(IVA.EQ.1) GO TO 50 * * lecture n-uplets par n-uplets on commence par nom*type * 51 CONTINUE * write(6,fmt='('' on passe par la '')') CALL QUETYP(ITYPE,0,IRETOU) * write(6,fmt='('' itype de quetyp '',a8)')itype IF(IRETOU.EQ.0) GO TO 52 IF(ITYPE.NE.'MOT ') GO TO 52 CALL LIRCHA( NOM,0,IRETOU) * write(6,fmt='('' nom '',a8)')nom CALL LIRMOT(MO(2),1,IVA,0) * write(6,fmt='('' iva '',i8)')iva IF(IVA.EQ.0) THEN CALL ECRCHA( NOM) GO TO 52 ENDIF CALL LIRCHA(ITYPE,1,IRETOU) * write(6,fmt='('' itype '',a8)')itype IF(IERR.NE.0) GO TO 1000 NVAR=NVAR+1 SEGADJ MNUAGE NUANOM( NVAR)=NOM NUATYP(NVAR)=ITYPE IF(ITYPE.EQ.'FLOTTANT') THEN SEGINI NUAVFL NUAPOI(NVAR)= NUAVFL ELSEIF(ITYPE.EQ.'MOT ') THEN SEGINI NUAVMO NUAPOI(NVAR)= NUAVMO ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN SEGINI NUAVLO NUAPOI(NVAR)= NUAVLO ELSE SEGINI NUAVIN NUAPOI(NVAR)= NUAVIN ENDIF GO TO 51 52 CONTINUE DO 53 K=1,NVAR ITYPE= NUATYP(K) IF(K.EQ.1) NBCOUP=NBCOUP+1 ICODE=0 IF(K.NE.1) ICODE=1 IF(ITYPE.EQ.'FLOTTANT') THEN CALL LIRREE( XIJ,ICODE,IRETOU) IF( IERR.NE.0) GO TO 1000 IF( IRETOU.EQ.0) GO TO 54 NUAVFL=NUAPOI(K) SEGADJ NUAVFL NUAFLO(NBCOUP)=XIJ ELSEIF(ITYPE.EQ.'MOT ') THEN CALL LIRCHA(NOP,ICODE,IRETOU) IF( IERR.NE.0) GO TO 1000 IF( IRETOU.EQ.0) GO TO 54 NUAVMO=NUAPOI(K) SEGADJ NUAVMO NUAMOT(NBCOUP)=NOP ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN CALL LIRLOG(LIJ,ICODE,IRETOU) IF( IERR.NE.0) GO TO 1000 IF( IRETOU.EQ.0) GO TO 54 NUAVLO=NUAPOI(K) SEGADJ NUAVLO NUALOG(NBCOUP)=LIJ ELSEIF(ITYPE.EQ.'ENTIER ') THEN CALL LIRENT(IJ,ICODE,IRETOU) IF( IERR.NE.0) GO TO 1000 IF( IRETOU.EQ.0) GO TO 54 NUAVIN=NUAPOI(K) SEGADJ NUAVIN NUAINT(NBCOUP)=IJ ELSE CALL LIROBJ(ITYPE,IJ,ICODE,IRETOU) IF( IERR.NE.0) GO TO 1000 IF( IRETOU.EQ.0) GO TO 54 NUAVIN=NUAPOI(K) SEGADJ NUAVIN NUAINT(NBCOUP)=IJ ENDIF 53 CONTINUE GO TO 52 54 CONTINUE DO 55 IJ=1,NVAR ITYPE=NUATYP(IJ) IF(ITYPE.EQ.'FLOTTANT') THEN NUAVFL=NUAPOI(IJ) SEGDES NUAVFL ELSEIF(ITYPE.EQ.'MOT ') THEN NUAVMO=NUAPOI(IJ) SEGDES NUAVMO ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN NUAVLO=NUAPOI(IJ) SEGDES NUAVLO ELSE NUAVIN=NUAPOI(IJ) SEGDES NUAVIN ENDIF 55 CONTINUE SEGDES MNUAGE CALL ECROBJ('NUAGE ',MNUAGE) RETURN * * lecture par definition composantes par composantes * 1 CONTINUE CALL LIRMOT ( MO,1,IVA,0) IF( IVA.EQ.0) THEN IF(NVAR.EQ.0) THEN CALL ERREUR(626) SEGSUP MNUAGE ELSE SEGDES MNUAGE CALL ECROBJ('NUAGE ',MNUAGE) ENDIF RETURN ENDIF 50 CONTINUE CALL LIRCHA( NOM,0,IRETOU) IF( IRETOU.EQ.0) THEN IF(NVAR.EQ.0) CALL ERREUR(6) SEGSUP MNUAGE RETURN ENDIF NVAR=NVAR + 1 SEGADJ MNUAGE CALL QUETYP (ITYPE,1, IRETOU) IF(IERR.NE.0) THEN SEGSUP MNUAGE RETURN ENDIF NUANOM( NVAR)=NOM NUATYP(NVAR)=ITYPE NLU=0 IF(ITYPE.EQ.'FLOTTANT') THEN SEGINI NUAVFL NUAPOI(NVAR)= NUAVFL ELSEIF(ITYPE.EQ.'MOT ') THEN SEGINI NUAVMO NUAPOI(NVAR)= NUAVMO ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN SEGINI NUAVLO NUAPOI(NVAR)= NUAVLO ELSE SEGINI NUAVIN NUAPOI(NVAR)= NUAVIN ENDIF 2 CONTINUE IF(ITYPE.EQ.'FLOTTANT') THEN CALL LIRREE( XIJ,0,IRETOU) IF( IRETOU.EQ.0) GO TO 10 NLU=NLU+1 IF(NLU.GT.NBCOUP) THEN IF(NVAR.NE.1) GO TO 1000 NBCOUP=NBCOUP+20 SEGADJ NUAVFL ENDIF NUAFLO(NLU)=XIJ ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN CALL LIRLOG(LIJ,0,IRETOU) IF( IRETOU.EQ.0) GO TO 10 NLU=NLU+1 IF(NLU.GT.NBCOUP) THEN IF(NVAR.NE.1) GO TO 1000 NBCOUP=NBCOUP+20 SEGADJ NUAVLO ENDIF NUALOG(NLU)=LIJ ELSEIF(ITYPE.EQ.'MOT ') THEN CALL LIRCHA(NOP,0,IRETOU) IF( IRETOU.EQ.0) GO TO 10 IF( NOP(1:4).EQ.'COMP')THEN CALL REFUS GO TO 10 ENDIF NLU=NLU+1 IF(NLU.GT.NBCOUP) THEN IF(NVAR.NE.1) GO TO 1000 NBCOUP=NBCOUP+20 SEGADJ NUAVMO ENDIF NUAMOT(NLU)=NOP ELSEIF(ITYPE.EQ.'ENTIER ') THEN CALL LIRENT(IJ,0,IRETOU) IF( IRETOU.EQ.0) GO TO 10 NLU=NLU+1 IF(NLU.GT.NBCOUP) THEN IF(NVAR.NE.1) GO TO 1000 NBCOUP=NBCOUP+20 SEGADJ NUAVIN ENDIF NUAINT(NLU)=IJ ELSE CALL LIROBJ(ITYPE,IRET,0,IRETOU) IF( IRETOU.EQ.0) GO TO 10 NLU=NLU+1 IF(NLU.GT.NBCOUP) THEN IF(NVAR.NE.1) GO TO 1000 NBCOUP=NBCOUP+20 SEGADJ NUAVIN ENDIF NUAINT(NLU)=IRET ENDIF GO TO 2 10 CONTINUE IF( NVAR.EQ.1) THEN IF(NLU.NE.NBCOUP) THEN NBCOUP=NLU IF(ITYPE.EQ.'FLOTTANT') THEN SEGADJ NUAVFL ELSEIF(ITYPE.EQ.'MOT ') THEN SEGADJ NUAVMO ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN SEGADJ NUAVLO ELSE SEGADJ NUAVIN ENDIF ENDIF ELSE IF( NBCOUP.NE.NLU) GO TO 1000 ENDIF IF(ITYPE.EQ.'FLOTTANT') THEN SEGDES NUAVFL ELSEIF(ITYPE.EQ.'MOT ') THEN SEGDES NUAVMO ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN SEGDES NUAVLO ELSE SEGDES NUAVIN ENDIF GO TO 1 1000 continue CALL ERREUR(625) DO 11 IJ=1,NVAR ITYPE= NUATYP(IJ) IF(ITYPE.EQ.'FLOTTANT') THEN NUAVFL=NUAPOI(IJ) SEGSUP NUAVFL ELSEIF(ITYPE.EQ.'MOT ') THEN NUAVMO=NUAPOI(IJ) SEGSUP NUAVMO ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN NUAVLO=NUAPOI(IJ) SEGSUP NUAVLO ELSE NUAVIN=NUAPOI(IJ) SEGSUP NUAVIN ENDIF SEGSUP MNUAGE 11 CONTINUE 200 CONTINUE RETURN END