Télécharger nuage.eso

Retour à la liste

Numérotation des lignes :

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales