Télécharger demch1.eso

Retour à la liste

Numérotation des lignes :

  1. C DEMCH1 SOURCE GOUNAND 16/08/01 21:15:12 9043
  2. C UTILITAIRE DE DEMCHA (GESTION NOEUD MILIEU)
  3. C
  4. SUBROUTINE DEMCH1(I1,I3,I2,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. -INC CCOPTIO
  8. -INC SMCOORD
  9. SEGMENT KONPOS(NBPTS)
  10. SEGMENT KONFIN(IKOUR)
  11. SEGMENT KONMIL(IKOUR)
  12. SEGMENT KONSUI(IKOUR)
  13. J1=MIN(I1,I3)
  14. J3=MAX(I1,I3)
  15. ITFA=KONPOS(J1)
  16. IF (ITFA.EQ.0) GOTO 90
  17. 85 CONTINUE
  18. ITF=KONSUI(ITFA)
  19. IF (KONFIN(ITFA).EQ.J3) GOTO 80
  20. IF (ITF.EQ.0) GOTO 90
  21. ITFA=ITF
  22. GOTO 85
  23. 90 KONCOU=KONCOU+1
  24. IF (KONCOU.GE.KONFIN(/1)) THEN
  25. IKOUR=KONCOU+500
  26. SEGADJ KONFIN,KONMIL,KONSUI
  27. ENDIF
  28. IF (ITFA.EQ.0) THEN
  29. KONPOS(J1)=KONCOU
  30. ELSE
  31. KONSUI(ITFA)=KONCOU
  32. ENDIF
  33. KONFIN(KONCOU)=J3
  34. * CREATION DE NOEUD
  35. NBPTS=XCOOR(/1)/(IDIM+1)+1
  36. SEGADJ MCOORD
  37. DO 100 ICOOR=1,IDIM+1
  38. XCOOR((NBPTS-1)*(IDIM+1)+ICOOR)=
  39. $ (XCOOR((J1-1)*(IDIM+1)+ICOOR)
  40. $ +XCOOR((J3-1)*(IDIM+1)+ICOOR))/2.D0
  41. 100 CONTINUE
  42. KONMIL(KONCOU)=NBPTS
  43. ITFA=KONCOU
  44. 80 CONTINUE
  45. I2=KONMIL(ITFA)
  46. END
  47.  
  48.  
  49.  

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