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.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC SMELEME
  31. SEGMENT ILIST
  32. INTEGER LIST(NLIST)
  33. ENDSEGMENT
  34. POINTEUR ILIS1.ILIST,ILIS2.ILIST,ILIS3.ILIST
  35. SEGMENT ICARA
  36. CHARACTER*4 LCARA(NCARA)
  37. ENDSEGMENT
  38. POINTEUR ICAR1.ICARA,ICAR2.ICARA,ICAR3.ICARA
  39. C
  40. ILIST = LIST1
  41. ICARA = NOMC
  42. SEGACT ICARA,ILIST
  43. IC = LCARA(/2)
  44. JC = LIST(/1)
  45. IF(JC.LT.IC) GOTO 5000
  46. C
  47. C CREATION A PARTIR DE IPOE D' UN NOUVEAU MAILLAGE IPO1
  48. C
  49. IPT1 = IPOE
  50. SEGINI,MELEME = IPT1
  51. IPO1 = MELEME
  52. C
  53. DO 1 I = 1,IC
  54. CALL ECROBJ('LISTREEL',LIST(IC+1-I))
  55. CMOT = LCARA(IC+1-I)
  56. CALL ECRCHA(CMOT)
  57. 1 CONTINUE
  58. CALL ECRENT(IC)
  59. CALL ECROBJ('MAILLAGE',IPO1)
  60. CALL MANUCH
  61. CALL LIROBJ('CHPOINT ',IPOC,1,IRETOU)
  62. RETURN
  63. 5000 CONTINUE
  64. WRITE(IOIMP,5001)
  65. 5001 FORMAT(' ERREUR DANS MANUC1 : IL MANQUE UN ( OU DES ) LISTREEL')
  66. RETURN
  67. END
  68.  
  69.  

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