Télécharger la plaquette Cast3M


fr en

Télécharger chptco.eso

Retour à la liste

Numérotation des lignes : 

chptco

  1. C CHPTCO    SOURCE    CB215821  20/11/25    13:19:37     10792          
  2.       SUBROUTINE CHPTCO(IVAL,IPOIN)
  3.       IMPLICIT INTEGER(I-N)
  4.       CHARACTER*12 CTEXT
  5.  
  6. -INC PPARAM
  7. -INC CCOPTIO
  8. -INC SMCHPOI
  9. -INC SMELEME
  10.       logical ltelq      
  11.  
  12.       MCHPOI=IPOIN
  13.       SEGACT MCHPOI
  14.       NSOUPO=IPCHP(/1)
  15. C
  16. C CAS DU CHPOINT VIDE
  17. C
  18.       IF(NSOUPO.EQ.0) THEN
  19.         NAT=1
  20.         SEGINI,MCHPO1
  21.         MCHPO1.IFOPOI=IFOUR
  22.         MCHPO1.JATTRI(1)=1
  23.         CALL ACTOBJ('CHPOINT ',MCHPO1,1)
  24.         CALL ECROBJ('CHPOINT ',MCHPO1)
  25.  
  26.         IF (IVAL.EQ.0) THEN
  27.           IF (IDIM.EQ.2) THEN
  28.             SEGINI,MCHPO2=MCHPO1
  29.             CALL ACTOBJ('CHPOINT',MCHPO2,1)
  30.             CALL ECROBJ('CHPOINT',MCHPO2)
  31.  
  32.           ELSEIF (IDIM.EQ.3) THEN
  33.             SEGINI,MCHPO2=MCHPO1
  34.             CALL ACTOBJ('CHPOINT',MCHPO2,1)
  35.             CALL ECROBJ('CHPOINT',MCHPO2)
  36.             SEGINI,MCHPO3=MCHPO1
  37.             CALL ACTOBJ('CHPOINT',MCHPO3,1)
  38.             CALL ECROBJ('CHPOINT',MCHPO3)
  39.  
  40.           ELSE
  41.             CALL ERREUR(832)
  42.             RETURN
  43.           ENDIF
  44.         ENDIF
  45.  
  46.         RETURN
  47.       ENDIF
  48. C
  49. C CAS DU CHPOINT NON VIDE
  50. C
  51.       DO 1 I=1,NSOUPO
  52.         MSOUPO=IPCHP(I)
  53.         SEGACT MSOUPO
  54.         IF(I.EQ.1) THEN
  55.           IPGEO=IGEOC
  56.         ELSE
  57.           IPGE1=IPGEO
  58.           IPGE2=IGEOC
  59.           ltelq=.false.
  60.           CALL FUSE(IPGE1,IPGE2,IPGEO,ltelq)
  61.         ENDIF
  62.    1  CONTINUE
  63.       CALL CHPCOO(IVAL,IPGEO)
  64.       END
  65.  
  66.  
  67.  
  68.  

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