Download trjcn1.eso

Back to the list

   1 : C TRJCN1    SOURCE    CHAT      07/10/29    21:29:56     5940           
   2 :       SUBROUTINE TRJCN1(MELEME)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   6 : C
   7 : C         CONTROLE QUE LE MAILLAGE MELEME CONVIENT AU
   8 : C                 CALCUL DES TRAJECTOIRES
   9 : C     POUR RAJOUTER UN TYPE D ELEMENT DONT LE NOMBRE DE NOEUD SERA
  10 : C      SUPERIEUR A 9 IL FAUDRA MODIFIER MNO9 DANS TRJPAR
  11 : C      ENTREES
  12 : C          MELEME POINTEUR DU MAILLAGE
  13 : C
  14 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  15 : -INC SMELEME
  16 : -INC CCOPTIO
  17 : -INC CCGEOME
  18 :       PARAMETER (NDTYP=8)
  19 :       DIMENSION IDTYP(NDTYP)
  20 :       DATA IDTYP/4,6,7,8,11,14,16,23/
  21 : C
  22 :       SEGACT MELEME
  23 :       NBSOUS=LISOUS(/1)
  24 :       NBS=NBSOUS
  25 :       IF(NBSOUS.EQ.0)NBS=1
  26 :       IPT1=MELEME
  27 :       DO 50 ISOUS=1,NBS
  28 :       IF(NBSOUS.GT.0)IPT1=LISOUS(ISOUS)
  29 :       SEGACT IPT1
  30 :       ITP=IPT1.ITYPEL
  31 :       DO 20 I=1,NDTYP
  32 :       IF(ITP.EQ.IDTYP(I))GO TO 25
  33 :    20 CONTINUE
  34 :       MOTERR(1:4)=NOMS(ITP)(1:4)
  35 :       MOTERR(5:12)='TRJCN1  '
  35 :       CALL ERREUR(86)
  36 :       RETURN
  37 :    25 CONTINUE
  38 :        SEGDES IPT1
  39 :    50 CONTINUE
  40 : C
  41 :       IF(NBSOUS.NE.0)SEGDES MELEME
  42 :       RETURN
  43 :       END
  44 :  
  45 :  
  46 :  
  47 :  
  48 :  
  49 :  
  50 :  
  51 :  

© Cast3M 2003 - All rights reserved.
Disclaimer