1 : C NUAGE SOURCE CHAT 05/01/13 02:02:47 5004 2 : SUBROUTINE NUAGE 3 : IMPLICIT INTEGER(I-N) 4 : -INC CCOPTIO 5 : -INC SMNUAGE 6 : CHARACTER*8 NOM,ITYPE,NOP 7 : CHARACTER*4 MO(2) 8 : REAL*8 XIJ 9 : LOGICAL LIJ 10 : DATA MO/'COMP','* '/ 11 : NVAR=0 12 : NBCOUP=0 13 : * 14 : * lecture dans le cas d'un champ par point 15 : * 15 : CALL LIROBJ('CHPOINT', MCHPOI, 0, IRETOU) 16 : IF (IERR .NE. 0) RETURN 17 : IF (IRETOU .NE. 0) THEN 17 : CALL NUACHP(MCHPOI) 18 : GOTO 200 19 : ENDIF 20 : SEGINI MNUAGE 20 : CALL LIRMOT ( MO,1,IVA,0) 21 : IF(IVA.EQ.1) GO TO 50 22 : * 23 : * lecture dans le cas d'un champ par élément 24 : * 24 : CALL LIROBJ('MCHAML', MCHEML, 0, IRETOU) 25 : IF (IERR .NE. 0) RETURN 26 : IF (IRETOU .NE. 0) THEN 26 : CALL NUACHL(MCHEML) 27 : goto 200 28 : ENDIF 29 : SEGINI MNUAGE 29 : CALL LIRMOT ( MO,1,IVA,0) 30 : IF(IVA.EQ.1) GO TO 50 31 : * 32 : * lecture n-uplets par n-uplets on commence par nom*type 33 : * 34 : 51 CONTINUE 35 : * write(6,fmt='('' on passe par la '')') 35 : CALL QUETYP(ITYPE,0,IRETOU) 36 : * write(6,fmt='('' itype de quetyp '',a8)')itype 37 : IF(IRETOU.EQ.0) GO TO 52 38 : IF(ITYPE.NE.'MOT ') GO TO 52 38 : CALL LIRCHA( NOM,0,IRETOU) 39 : * write(6,fmt='('' nom '',a8)')nom 39 : CALL LIRMOT(MO(2),1,IVA,0) 40 : * write(6,fmt='('' iva '',i8)')iva 41 : IF(IVA.EQ.0) THEN 41 : CALL ECRCHA( NOM) 42 : GO TO 52 43 : ENDIF 43 : CALL LIRCHA(ITYPE,1,IRETOU) 44 : * write(6,fmt='('' itype '',a8)')itype 45 : IF(IERR.NE.0) GO TO 1000 46 : NVAR=NVAR+1 47 : SEGADJ MNUAGE 48 : NUANOM( NVAR)=NOM 49 : NUATYP(NVAR)=ITYPE 50 : IF(ITYPE.EQ.'FLOTTANT') THEN 51 : SEGINI NUAVFL 52 : NUAPOI(NVAR)= NUAVFL 53 : ELSEIF(ITYPE.EQ.'MOT ') THEN 54 : SEGINI NUAVMO 55 : NUAPOI(NVAR)= NUAVMO 56 : ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN 57 : SEGINI NUAVLO 58 : NUAPOI(NVAR)= NUAVLO 59 : ELSE 60 : SEGINI NUAVIN 61 : NUAPOI(NVAR)= NUAVIN 62 : ENDIF 63 : GO TO 51 64 : 52 CONTINUE 65 : DO 53 K=1,NVAR 66 : ITYPE= NUATYP(K) 67 : IF(K.EQ.1) NBCOUP=NBCOUP+1 68 : ICODE=0 69 : IF(K.NE.1) ICODE=1 70 : IF(ITYPE.EQ.'FLOTTANT') THEN 70 : CALL LIRREE( XIJ,ICODE,IRETOU) 71 : IF( IERR.NE.0) GO TO 1000 72 : IF( IRETOU.EQ.0) GO TO 54 73 : NUAVFL=NUAPOI(K) 74 : SEGADJ NUAVFL 75 : NUAFLO(NBCOUP)=XIJ 76 : ELSEIF(ITYPE.EQ.'MOT ') THEN 76 : CALL LIRCHA(NOP,ICODE,IRETOU) 77 : IF( IERR.NE.0) GO TO 1000 78 : IF( IRETOU.EQ.0) GO TO 54 79 : NUAVMO=NUAPOI(K) 80 : SEGADJ NUAVMO 81 : NUAMOT(NBCOUP)=NOP 82 : ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN 82 : CALL LIRLOG(LIJ,ICODE,IRETOU) 83 : IF( IERR.NE.0) GO TO 1000 84 : IF( IRETOU.EQ.0) GO TO 54 85 : NUAVLO=NUAPOI(K) 86 : SEGADJ NUAVLO 87 : NUALOG(NBCOUP)=LIJ 88 : ELSEIF(ITYPE.EQ.'ENTIER ') THEN 88 : CALL LIRENT(IJ,ICODE,IRETOU) 89 : IF( IERR.NE.0) GO TO 1000 90 : IF( IRETOU.EQ.0) GO TO 54 91 : NUAVIN=NUAPOI(K) 92 : SEGADJ NUAVIN 93 : NUAINT(NBCOUP)=IJ 94 : ELSE 94 : CALL LIROBJ(ITYPE,IJ,ICODE,IRETOU) 95 : IF( IERR.NE.0) GO TO 1000 96 : IF( IRETOU.EQ.0) GO TO 54 97 : NUAVIN=NUAPOI(K) 98 : SEGADJ NUAVIN 99 : NUAINT(NBCOUP)=IJ 100 : ENDIF 101 : 53 CONTINUE 102 : GO TO 52 103 : 54 CONTINUE 104 : DO 55 IJ=1,NVAR 105 : ITYPE=NUATYP(IJ) 106 : IF(ITYPE.EQ.'FLOTTANT') THEN 107 : NUAVFL=NUAPOI(IJ) 108 : SEGDES NUAVFL 109 : ELSEIF(ITYPE.EQ.'MOT ') THEN 110 : NUAVMO=NUAPOI(IJ) 111 : SEGDES NUAVMO 112 : ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN 113 : NUAVLO=NUAPOI(IJ) 114 : SEGDES NUAVLO 115 : ELSE 116 : NUAVIN=NUAPOI(IJ) 117 : SEGDES NUAVIN 118 : ENDIF 119 : 55 CONTINUE 120 : SEGDES MNUAGE 120 : CALL ECROBJ('NUAGE ',MNUAGE) 121 : RETURN 122 : * 123 : * lecture par definition composantes par composantes 124 : * 125 : 1 CONTINUE 125 : CALL LIRMOT ( MO,1,IVA,0) 126 : IF( IVA.EQ.0) THEN 127 : IF(NVAR.EQ.0) THEN 127 : CALL ERREUR(626) 128 : SEGSUP MNUAGE 129 : ELSE 130 : SEGDES MNUAGE 130 : CALL ECROBJ('NUAGE ',MNUAGE) 131 : ENDIF 132 : RETURN 133 : ENDIF 134 : 50 CONTINUE 134 : CALL LIRCHA( NOM,0,IRETOU) 135 : IF( IRETOU.EQ.0) THEN 135 : IF(NVAR.EQ.0) CALL ERREUR(6) 136 : SEGSUP MNUAGE 137 : RETURN 138 : ENDIF 139 : NVAR=NVAR + 1 140 : SEGADJ MNUAGE 140 : CALL QUETYP (ITYPE,1, IRETOU) 141 : IF(IERR.NE.0) THEN 142 : SEGSUP MNUAGE 143 : RETURN 144 : ENDIF 145 : NUANOM( NVAR)=NOM 146 : NUATYP(NVAR)=ITYPE 147 : NLU=0 148 : IF(ITYPE.EQ.'FLOTTANT') THEN 149 : SEGINI NUAVFL 150 : NUAPOI(NVAR)= NUAVFL 151 : ELSEIF(ITYPE.EQ.'MOT ') THEN 152 : SEGINI NUAVMO 153 : NUAPOI(NVAR)= NUAVMO 154 : ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN 155 : SEGINI NUAVLO 156 : NUAPOI(NVAR)= NUAVLO 157 : ELSE 158 : SEGINI NUAVIN 159 : NUAPOI(NVAR)= NUAVIN 160 : ENDIF 161 : 2 CONTINUE 162 : IF(ITYPE.EQ.'FLOTTANT') THEN 162 : CALL LIRREE( XIJ,0,IRETOU) 163 : IF( IRETOU.EQ.0) GO TO 10 164 : NLU=NLU+1 165 : IF(NLU.GT.NBCOUP) THEN 166 : IF(NVAR.NE.1) GO TO 1000 167 : NBCOUP=NBCOUP+20 168 : SEGADJ NUAVFL 169 : ENDIF 170 : NUAFLO(NLU)=XIJ 171 : ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN 171 : CALL LIRLOG(LIJ,0,IRETOU) 172 : IF( IRETOU.EQ.0) GO TO 10 173 : NLU=NLU+1 174 : IF(NLU.GT.NBCOUP) THEN 175 : IF(NVAR.NE.1) GO TO 1000 176 : NBCOUP=NBCOUP+20 177 : SEGADJ NUAVLO 178 : ENDIF 179 : NUALOG(NLU)=LIJ 180 : ELSEIF(ITYPE.EQ.'MOT ') THEN 180 : CALL LIRCHA(NOP,0,IRETOU) 181 : IF( IRETOU.EQ.0) GO TO 10 182 : IF( NOP(1:4).EQ.'COMP')THEN 182 : CALL REFUS 183 : GO TO 10 184 : ENDIF 185 : NLU=NLU+1 186 : IF(NLU.GT.NBCOUP) THEN 187 : IF(NVAR.NE.1) GO TO 1000 188 : NBCOUP=NBCOUP+20 189 : SEGADJ NUAVMO 190 : ENDIF 191 : NUAMOT(NLU)=NOP 192 : ELSEIF(ITYPE.EQ.'ENTIER ') THEN 192 : CALL LIRENT(IJ,0,IRETOU) 193 : IF( IRETOU.EQ.0) GO TO 10 194 : NLU=NLU+1 195 : IF(NLU.GT.NBCOUP) THEN 196 : IF(NVAR.NE.1) GO TO 1000 197 : NBCOUP=NBCOUP+20 198 : SEGADJ NUAVIN 199 : ENDIF 200 : NUAINT(NLU)=IJ 201 : ELSE 201 : CALL LIROBJ(ITYPE,IRET,0,IRETOU) 202 : IF( IRETOU.EQ.0) GO TO 10 203 : NLU=NLU+1 204 : IF(NLU.GT.NBCOUP) THEN 205 : IF(NVAR.NE.1) GO TO 1000 206 : NBCOUP=NBCOUP+20 207 : SEGADJ NUAVIN 208 : ENDIF 209 : NUAINT(NLU)=IRET 210 : ENDIF 211 : GO TO 2 212 : 10 CONTINUE 213 : IF( NVAR.EQ.1) THEN 214 : IF(NLU.NE.NBCOUP) THEN 215 : NBCOUP=NLU 216 : IF(ITYPE.EQ.'FLOTTANT') THEN 217 : SEGADJ NUAVFL 218 : ELSEIF(ITYPE.EQ.'MOT ') THEN 219 : SEGADJ NUAVMO 220 : ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN 221 : SEGADJ NUAVLO 222 : ELSE 223 : SEGADJ NUAVIN 224 : ENDIF 225 : ENDIF 226 : ELSE 227 : IF( NBCOUP.NE.NLU) GO TO 1000 228 : ENDIF 229 : IF(ITYPE.EQ.'FLOTTANT') THEN 230 : SEGDES NUAVFL 231 : ELSEIF(ITYPE.EQ.'MOT ') THEN 232 : SEGDES NUAVMO 233 : ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN 234 : SEGDES NUAVLO 235 : ELSE 236 : SEGDES NUAVIN 237 : ENDIF 238 : GO TO 1 239 : 1000 continue 239 : CALL ERREUR(625) 240 : DO 11 IJ=1,NVAR 241 : ITYPE= NUATYP(IJ) 242 : IF(ITYPE.EQ.'FLOTTANT') THEN 243 : NUAVFL=NUAPOI(IJ) 244 : SEGSUP NUAVFL 245 : ELSEIF(ITYPE.EQ.'MOT ') THEN 246 : NUAVMO=NUAPOI(IJ) 247 : SEGSUP NUAVMO 248 : ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN 249 : NUAVLO=NUAPOI(IJ) 250 : SEGSUP NUAVLO 251 : ELSE 252 : NUAVIN=NUAPOI(IJ) 253 : SEGSUP NUAVIN 254 : ENDIF 255 : SEGSUP MNUAGE 256 : 11 CONTINUE 257 : 200 CONTINUE 258 : RETURN 259 : END 260 : 261 : 262 :
© Cast3M 2003 - All rights reserved.
Disclaimer