Télécharger linuag.eso

Retour à la liste

Numérotation des lignes :

  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
  29. CALL LFCDIE(IORES,NTOTO,ILENA,IRETOU,IFORM)
  30. IF (IRETOU.NE.0) GO TO 1000
  31. NVAR = ILENA(1)
  32. NBCOUP=ILENA(2)
  33. * write(6,fmt='( ''nvar nbcoup '' , 2I6)') nvar,nbcoup
  34. NM = 4*NVAR
  35. SEGINI ITBBM1,itbbc1
  36. SEGINI MNUAGE
  37. if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
  38. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
  39. * write(6,fmt='('' nuanomtyp '',/,(6a10))') (itabm1(lk),lk=1,nm)
  40. IF(IRETOU.NE.0) GOTO 1000
  41. DO 1 I=1,NVAR
  42. J = 4*I-3
  43. if (iform.ne.2) then
  44. WRITE (NUANOM(I),FMT='(2A4)') ITABM1(J),ITABM1(J+1)
  45. WRITE (NUATYP(I),FMT='(2A4)') ITABM1(J+2),ITABM1(J+3)
  46. else
  47. nuanom(i)(1:4)=itabc1(j)
  48. nuanom(i)(5:8)=itabc1(j+1)
  49. nuatyp(i)(1:4)=itabc1(j+2)
  50. nuatyp(i)(5:8)=itabc1(j+3)
  51. endif
  52. 1 CONTINUE
  53. SEGSUP ITBBM1,itbbc1
  54. DO 2 I= 1,NVAR
  55. CTYP = NUATYP(I)
  56. IF( CTYP.EQ.'FLOTTANT') THEN
  57. SEGINI NUAVFL
  58. NUAPOI(I)= NUAVFL
  59. CALL LFCDI2(IORES,NBCOUP,NUAFLO,IRETOU,IFORM)
  60. IF(IRETOU.NE.0) GOTO 1000
  61. SEGDES NUAVFL
  62. ELSEIF(CTYP.EQ.'MOT ') THEN
  63. SEGINI NUAVMO
  64. NUAPOI(I)=NUAVMO
  65. NM = NBCOUP*2
  66. SEGINI ITBBM1,itbbc1
  67. if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
  68. if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
  69. IF(IRETOU.NE.0) GOTO 1000
  70. DO 3 K=1,NBCOUP
  71. J=2*K -1
  72. if (iform.ne.2) then
  73. WRITE (NUAMOT(K),FMT='(2A4)') ITABM1(J),ITABM1(J+1)
  74. else
  75. nuamot(k)(1:4)=itabc1(j)
  76. nuamot(k)(5:8)=itabc1(j+1)
  77. endif
  78. 3 CONTINUE
  79. SEGDES NUAVMO
  80. SEGSUP ITBBM1,itbbc1
  81. ELSEIF(CTYP.EQ.'LOGIQUE ') THEN
  82. SEGINI NUAVLO
  83. NUAPOI(I)= NUAVLO
  84. NN=NBCOUP
  85. SEGINI ITBBE1
  86. CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
  87. IF(IRETOU.NE.0) GOTO 1000
  88. DO 4 K=1,NN
  89. IF( ITABE1(K).EQ.1) THEN
  90. NUALOG(K)=.TRUE.
  91. ELSE
  92. NUALOG(K)=.FALSE.
  93. ENDIF
  94. 4 CONTINUE
  95. SEGSUP ITBBE1
  96. SEGDES NUAVLO
  97. ELSE
  98. SEGINI NUAVIN
  99. NUAPOI(I)=NUAVIN
  100. CALL LFCDIE(IORES,NBCOUP,NUAINT,IRETOU,IFORM)
  101. IF(IRETOU.NE.0) GOTO 1000
  102. SEGDES NUAVIN
  103. ENDIF
  104. 2 CONTINUE
  105. SEGDES MNUAGE
  106. ITLAC(**)=MNUAGE
  107. * write(6,fmt='('' fin du nuage'')')
  108. 1101 CONTINUE
  109. RETURN
  110. 1000 CONTINUE
  111. IRET=1
  112. IF(MNUAGE.NE.0) SEGSUP MNUAGE
  113. RETURN
  114. C -------------------------------------------------------
  115. END
  116.  
  117.  
  118.  
  119.  

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