Télécharger chmlst.eso

Retour à la liste

Numérotation des lignes :

  1. C CHMLST SOURCE CHAT 05/01/12 21:59:28 5004
  2. SUBROUTINE CHMLST(MCHPOI,MLIDX,IPTIDX,JPOVAL)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C------------------------------------------------------------------
  6. C
  7. C CORRESPONDANCE ENTRE LES COMPOSANTES D' UN CHPOINT ET LES IDX
  8. C JPOVAL POINTEUR DU TABLEAU DE VALEURS DU CHPOINT
  9. C
  10. C On cherche si toutes les composantes du chpoint correspondent
  11. C a un identificateur et réciproquement .On vérifie l'unicité
  12. C------------------------------------------------------------------
  13. -INC SMCHPOI
  14. -INC SMLENTI
  15. -INC CCOPTIO
  16. SEGMENT IPTIDX
  17. INTEGER ITDX(NXDIM)
  18. ENDSEGMENT
  19. SEGMENT ITBID
  20. INTEGER IBID(NXDIM)
  21. ENDSEGMENT
  22. MLENTI=MLIDX
  23. SEGACT MCHPOI
  24. MSOUPO=IPCHP(1)
  25. SEGACT MSOUPO
  26. NXDIM=LECT(/1)
  27. SEGINI IPTIDX
  28. SEGINI ITBID
  29. CALL INITI(ITDX,NXDIM,0)
  30. CALL RSETI(IBID,LECT,NXDIM)
  31. NC=NOCOMP(/2)
  32. DO 50 I=1,NC
  33. READ(NOCOMP(I),100)NLL
  34. 100 FORMAT(1X,I3)
  35. C WRITE(6,*)'COMPOSANTE ',NLL
  36. DO 20 J=1,NXDIM
  37. IF(NLL.EQ.IBID(J))THEN
  38. ITDX(J)=I
  39. IBID(J)=0
  40. GO TO 30
  41. ENDIF
  42. 20 CONTINUE
  43. MOTERR(1:4)=NOCOMP(I)
  44. CALL ERREUR(197)
  45. RETURN
  46. 30 CONTINUE
  47. 50 CONTINUE
  48. DO 60 J=1,NXDIM
  49. IF(ITDX(J).EQ.0)THEN
  50. WRITE(MOTERR(1:4),110)LECT(J)
  51. CALL ERREUR(77)
  52. RETURN
  53. ENDIF
  54. 60 CONTINUE
  55. 110 FORMAT('X',I3.3)
  56. MPOVAL=IPOVAL
  57. SEGACT MPOVAL
  58. JPOVAL= IPOVAL
  59. SEGDES MSOUPO,MCHPOI
  60. SEGSUP ITBID
  61. C write(6,*)' ITDX ',(itdx(j),j=1,nxdim)
  62. RETURN
  63. END
  64.  
  65.  
  66.  

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