Télécharger la plaquette Cast3M


fr en

Télécharger manuc1.eso

Retour à la liste

Numérotation des lignes : 

manuc1

  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