Télécharger ecnoms.eso

Retour à la liste

Numérotation des lignes :

  1. C ECNOMS SOURCE JC220346 18/12/04 21:15:14 9991
  2. SUBROUTINE ECNOMS(NBAND,LMAX,SEGTAB,IFORM)
  3. IMPLICIT INTEGER(I-N)
  4. -INC CCOPTIO
  5. -INC CCNOYAU
  6. -INC CCFXDR
  7. SEGMENT SEGTAB
  8. CHARACTER*(LONOM) ITAB(NTOTO)
  9. END SEGMENT
  10. C SEGTA8 => pour compatibilite avec NIVE < 22
  11. SEGMENT SEGTA8
  12. CHARACTER*8 ITAB8(NTOTO8)
  13. END SEGMENT
  14. C ITAA => pour compatibilite avec NIVE < 3
  15. SEGMENT,ITAA(N)
  16. C
  17. IF (LMAX.NE.0) THEN
  18. DIMATT=DIMATT+ LMAX*2 +1
  19. IF (IONIVE.LE.2) THEN
  20. N=LMAX*2
  21. SEGINI ITAA
  22. DO 2 I=1,LMAX
  23. II=2*I
  24. READ(ITAB(I),FMT='(2A4)')ITAA(II-1),ITAA(II)
  25. 2 CONTINUE
  26. IF(IFORM.EQ.0) WRITE(NBAND)(ITAA (I),I=1,N)
  27. IF(IFORM.EQ.1) WRITE(NBAND,801)(ITAA(I),I=1,N)
  28. 801 FORMAT(16(1X,A4))
  29. if (iform.eq.2) ios= IXDRIMAT( ixdrw, n, itaa(1))
  30. SEGSUP ITAA
  31. ELSEIF (IONIVE.LE.21) THEN
  32. IF (IFORM.EQ.0) WRITE(NBAND) (ITAB(I)(1:8),I=1,LMAX)
  33. IF (IFORM.EQ.1) WRITE(NBAND,8001) (ITAB(I)(1:8),I=1,LMAX)
  34. 8001 FORMAT(8(1X,A8))
  35. if (iform.eq.2) then
  36. NTOTO8=LMAX
  37. SEGINI,SEGTA8
  38. DO K=1,LMAX
  39. ITAB8(K)=ITAB(K)(1:8)
  40. ENDDO
  41. ios= IXDRSTRING(ixdrw,itab8(1)(1:8*LMAX))
  42. endif
  43. ELSE
  44. IF (IFORM.EQ.0) WRITE(NBAND) (ITAB(I),I=1,LMAX)
  45. IF (IFORM.EQ.1) WRITE(NBAND,8002) (ITAB(I),I=1,LMAX)
  46. 8002 FORMAT(3(1X,A24))
  47. if (iform.eq.2)
  48. & ios= IXDRSTRING(ixdrw,itab(1)(1:LONOM*lmax))
  49. ENDIF
  50. ENDIF
  51. RETURN
  52. END
  53.  
  54.  
  55.  
  56.  
  57.  
  58.  
  59.  
  60.  
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  

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