Download tchamr.eso

Back to the list

   1 : C TCHAMR    SOURCE    PV        09/03/12    21:35:27     6325           
   2 :       SUBROUTINE TCHAMR(ICHAM,ICLE)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : 
   6 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   7 : C                                                               C
   8 : C But : Traiter (activer ou désactiver entièrement)un CHAMp de  C
   9 : C       Rayonnement qui est un MCHAML de MCHAML.                C
  10 : C                                                               C
  11 : C Arguments : ICHAM - pointeur sur le champ                     C
  12 : C             ICLE  - O -> desactivation                        C
  13 : C                     1 -> activation                           C
  14 : C                                                               C
  15 : C Date : Mars 1995                                              C
  16 : C                                                               C
  17 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  18 : 
  19 : -INC SMCHAML
  20 : 
  21 :       MCHELM=ICHAM
  22 :       SEGACT,MCHELM
  23 :       NBSZEL=IMACHE(/1)
  24 : 
  25 :       DO 1000 I1=1,NBSZEL
  26 : 
  27 :         MCHAML=ICHAML(I1)
  28 :         SEGACT,MCHAML
  29 :         NC1=IELVAL(/1)
  30 : 
  31 : C   ... On s'occupe de la surface qui est la dernière ...
  32 :         MELVAL=IELVAL(NC1)
  33 :         IF(ICLE.EQ.0) THEN
  34 :           SEGDES,MELVAL
  35 :         ELSE
  36 :           SEGACT,MELVAL
  37 :         ENDIF
  38 : 
  39 : C   ... Maintanant on parcourt les NC1-1 autres composantes qui sont des MCHELM ...
  40 :         DO 1100 IC1=1,NC1-1
  41 :           MELVAL=IELVAL(IC1)
  42 :           SEGACT,MELVAL
  43 :           N2EL=IELCHE(/2)
  44 : 
  45 :           DO 1200 IEL1=1,N2EL
  46 :             MCHEL2=IELCHE(1,IEL1)
  47 :             SEGACT,MCHEL2
  48 : 
  49 :             DO 1300 I2=1,NBSZEL
  50 :                MCHAM2=MCHEL2.ICHAML(I2)
  51 :                SEGACT,MCHAM2
  52 : 
  53 :                NC2=MCHAM2.IELVAL(/1)
  54 :                DO 1400 IC2=1,NC2
  55 : 
  56 :                   MELVA2=MCHAM2.IELVAL(IC2)
  57 :                   IF(ICLE.EQ.0) THEN
  58 :                      SEGDES,MELVA2
  59 :                   ELSE
  60 :                      SEGACT,MELVA2
  61 :                   ENDIF
  62 : 
  63 :  1400          CONTINUE
  64 :  
  65 :                IF(ICLE.EQ.0) SEGDES,MCHAM2
  66 :  1300       CONTINUE
  67 :           
  68 :             IF(ICLE.EQ.0) SEGDES,MCHEL2
  69 :  1200     CONTINUE
  70 : 
  71 :           IF(ICLE.EQ.0) SEGDES,MELVAL
  72 :  1100   CONTINUE
  73 : 
  74 :         IF(ICLE.EQ.0) SEGDES,MCHAML
  75 :  1000 CONTINUE
  76 : 
  77 :       IF(ICLE.EQ.0) SEGDES,MCHELM
  78 : 
  79 :       RETURN
  80 :       END
  81 :  
  82 :  
  83 :  

© Cast3M 2003 - All rights reserved.
Disclaimer