Télécharger manuc1.eso

Retour à la liste

Numérotation des lignes :

  1. C MANUC1 SOURCE CHAT 05/01/13 01:28:23 5004
  2. SUBROUTINE MANUC1(IPOE,NOMC,LIST1,IPOC)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. CHARACTER*(4) CMOT
  6. C***********************************************************************
  7. C MANUC1 SIMULE L'APPEL DE L'OPERATEUR MANU CHPO POUR CREER UN CHPOINT *
  8. C***********************************************************************
  9. C ATTENTION : LES SEGMENTS LIST1 DOIVENT RESTER ACTIFS *
  10. C NOMC *
  11. C SINON TRANSFORMER PREPA0 *
  12. C***********************************************************************
  13. C ARGUMENT *
  14. C -------- *
  15. C ENTREE : *
  16. C IPOE = POINTEUR SUR UN OBJET GEOMETRIE *
  17. C LIST1= SEGMENT ILIST QUI CONTIENT LES POINTEURS SUR LES LIST *
  18. C REEL CONTENANT LES VALEURS DU CHPOINT(CF NOTICE MANU CHPO) *
  19. C NOMC = SEGAMENT ICARA QUI CONTIENT LE NOM DES COMPOSANTES *
  20. C ON DOIT AVOIR LIST(/1) > OU = LCARA(/2) *
  21. C SORTIE : *
  22. C IPOC = POINTEUR SUR LE MCHPOI *
  23. C (IL Y A CREATION D UNE GEOMETRIE) *
  24. C *
  25. C APPELE LES SB : CHANGE,ECRIRE,LIRE,MANUCH *
  26. C***********************************************************************
  27. -INC CCOPTIO
  28. -INC SMELEME
  29. SEGMENT ILIST
  30. INTEGER LIST(NLIST)
  31. ENDSEGMENT
  32. POINTEUR ILIS1.ILIST,ILIS2.ILIST,ILIS3.ILIST
  33. SEGMENT ICARA
  34. CHARACTER*4 LCARA(NCARA)
  35. ENDSEGMENT
  36. POINTEUR ICAR1.ICARA,ICAR2.ICARA,ICAR3.ICARA
  37. C
  38. ILIST = LIST1
  39. ICARA = NOMC
  40. SEGACT ICARA,ILIST
  41. IC = LCARA(/2)
  42. JC = LIST(/1)
  43. IF(JC.LT.IC) GOTO 5000
  44. C
  45. C CREATION A PARTIR DE IPOE D' UN NOUVEAU MAILLAGE IPO1
  46. C
  47. IPT1 = IPOE
  48. SEGINI,MELEME = IPT1
  49. IPO1 = MELEME
  50. C
  51. DO 1 I = 1,IC
  52. CALL ECROBJ('LISTREEL',LIST(IC+1-I))
  53. CMOT = LCARA(IC+1-I)
  54. CALL ECRCHA(CMOT)
  55. 1 CONTINUE
  56. CALL ECRENT(IC)
  57. CALL ECROBJ('MAILLAGE',IPO1)
  58. CALL MANUCH
  59. CALL LIROBJ('CHPOINT ',IPOC,1,IRETOU)
  60. RETURN
  61. 5000 CONTINUE
  62. WRITE(IOIMP,5001)
  63. 5001 FORMAT(' ERREUR DANS MANUC1 : IL MANQUE UN ( OU DES ) LISTREEL')
  64. RETURN
  65. END
  66.  
  67.  

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