Télécharger chmmst.eso

Retour à la liste

Numérotation des lignes :

  1. C CHMMST SOURCE CHAT 05/01/12 21:59:36 5004
  2. SUBROUTINE CHMmST(MCHPOI,Mmsolu,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 ???
  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 SMLMOTS
  15. -INC CCOPTIO
  16. SEGMENT IPTIDX
  17. INTEGER ITDX(NXDIM)
  18. ENDSEGMENT
  19. SEGMENT ITBID
  20. INTEGER IBID(NXDIM)
  21. ENDSEGMENT
  22. MLmots=Mmsolu
  23. SEGACT MCHPOI
  24. MSOUPO=IPCHP(1)
  25. SEGACT MSOUPO
  26. NXDIM=mots(/2)
  27. SEGINI IPTIDX
  28. SEGINI ITBID
  29. CALL INITI(ITDX,NXDIM,0)
  30. CALL initi(IBID,NXDIM,1)
  31. NC=NOCOMP(/2)
  32. * write(6,*)' mots ',(mots(ik),ik=1,nxdim)
  33. * write(6,*)' comp ',(nocomp(ik),ik=1,nxdim)
  34.  
  35. DO 50 I=1,NC
  36. c
  37. c
  38. C WRITE(6,*)'COMPOSANTE ',NLL
  39. DO 20 J=1,NXDIM
  40. IF(nocomp(i).eq.mots(j))then
  41. ITDX(J)=I
  42. IBID(J)=0
  43. * write(6,*)' i j ',i,j
  44. GO TO 30
  45. ENDIF
  46. 20 CONTINUE
  47. MOTERR(1:4)=NOCOMP(I)
  48. CALL ERREUR(197)
  49. RETURN
  50. 30 CONTINUE
  51. 50 CONTINUE
  52. DO 60 J=1,NXDIM
  53. IF(ITDX(J).EQ.0)THEN
  54. WRITE(MOTERR(1:4),110)mots(J)
  55. CALL ERREUR(77)
  56. RETURN
  57. ENDIF
  58. 60 CONTINUE
  59. 110 FORMAT('X',I3.3)
  60. MPOVAL=IPOVAL
  61. SEGACT MPOVAL
  62. JPOVAL= IPOVAL
  63. SEGDES MSOUPO,MCHPOI
  64. SEGSUP ITBID
  65. * write(6,*)' ITDX ',(itdx(j),j=1,nxdim)
  66. RETURN
  67. END
  68.  
  69.  
  70.  
  71.  

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