Download krchp1.eso

Back to the list

   1 : C KRCHP1    SOURCE    CHAT      05/01/13    01:05:51     5004           
   2 :       SUBROUTINE KRCHP1(TYPE,IGEOM,MCHPOI,MLMOTS)
   3 : C*************************************************************************
   4 : C     
   5 : C Ce SP cree un champoint
   6 : C     
   7 : C*************************************************************************
   8 :       IMPLICIT INTEGER(I-N)
   9 : -INC CCOPTIO
  10 : -INC SMCHPOI
  11 : -INC SMELEME
  12 : -INC SMLMOTS
  13 : C
  14 :       INTEGER IGEOM,NC, NAT, NSOUPO,N,I,NBSOUS
  15 :       CHARACTER*8 TYPE
  16 : C
  17 :       SEGACT MLMOTS
  18 :       NC = MLMOTS.MOTS(/2)
  19 :       IPT1 = IGEOM
  20 :       IF((IPT1 .LE. 0) .OR. (NC .EQ. 0))THEN
  21 : C
  22 : C******* Creation d'un CHPOINT vide
  23 : C
  24 :          NAT=2
  25 :          NSOUPO=0
  26 :          SEGINI MCHPOI
  27 :          JATTRI(1)=2
  28 :          IFOPOI = IFOUR
  29 :          SEGDES MCHPOI
  30 :       ELSE
  31 : C
  32 : C******* Creation d'un CHPOINT 
  33 : C        de type TYPE,
  34 : C           tytre blanc
  35 : C        defini sur le maillage des POI1 de IGEOM
  36 : C        de composantes MLMOTS
  37 : C        avec MPOVAL zero
  38 : C
  39 : C
  40 :          SEGACT IPT1
  41 :          NBSOUS = IPT1.LISOUS(/1)
  42 :          IF ( (NBSOUS .NE. 0) .OR. (IPT1.ITYPEL .NE. 1)) THEN
  42 :             CALL CHANGE(IPT1,1)
  43 :             IF (IERR.NE.0) GOTO 9999
  44 :          ENDIF
  45 :          N=IPT1.NUM(/2)
  46 :          SEGDES IPT1
  47 :          NSOUPO=1
  48 :          NAT=2
  49 :          SEGINI MCHPOI,MSOUPO,MPOVAL
  50 :          MCHPOI.JATTRI(1)=2
  51 : *        Nature discret
  52 :          MCHPOI.IFOPOI=IFOMOD
  53 :          MCHPOI.MTYPOI=TYPE
  54 :          MCHPOI.MOCHDE=
  55 :      $'                                                                '
  56 :          MCHPOI.IPCHP(1)=MSOUPO
  57 :          MSOUPO.IGEOC=IPT1
  58 :          MSOUPO.IPOVAL=MPOVAL
  59 :          DO 1 I=1,NC,1
  60 :             MSOUPO.NOCOMP(I)= MLMOTS.MOTS(I)
  61 :  1       CONTINUE
  62 :          SEGDES MCHPOI,MSOUPO,MPOVAL
  63 :       ENDIF
  64 :       SEGDES MLMOTS
  65 :  9999 RETURN
  66 :       END
  67 : 
  68 :  
  69 :  
  70 :  
  71 :  
  72 :  

© Cast3M 2003 - All rights reserved.
Disclaimer