C TCHAMR    SOURCE    PV        09/03/12    21:35:27     6325
      SUBROUTINE TCHAMR(ICHAM,ICLE)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                               C
C But : Traiter (activer ou désactiver entièrement)un CHAMp de  C
C       Rayonnement qui est un MCHAML de MCHAML.                C
C                                                               C
C Arguments : ICHAM - pointeur sur le champ                     C
C             ICLE  - O -> desactivation                        C
C                     1 -> activation                           C
C                                                               C
C Date : Mars 1995                                              C
C                                                               C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

-INC SMCHAML

      MCHELM=ICHAM
      SEGACT,MCHELM
      NBSZEL=IMACHE(/1)

      DO 1000 I1=1,NBSZEL

        MCHAML=ICHAML(I1)
        SEGACT,MCHAML
        NC1=IELVAL(/1)

C   ... On s'occupe de la surface qui est la dernière ...
        MELVAL=IELVAL(NC1)
        IF(ICLE.EQ.0) THEN
          SEGDES,MELVAL
        ELSE
          SEGACT,MELVAL
        ENDIF

C   ... Maintanant on parcourt les NC1-1 autres composantes qui sont des MCHELM ...
        DO 1100 IC1=1,NC1-1
          MELVAL=IELVAL(IC1)
          SEGACT,MELVAL
          N2EL=IELCHE(/2)

          DO 1200 IEL1=1,N2EL
            MCHEL2=IELCHE(1,IEL1)
            SEGACT,MCHEL2

            DO 1300 I2=1,NBSZEL
               MCHAM2=MCHEL2.ICHAML(I2)
               SEGACT,MCHAM2

               NC2=MCHAM2.IELVAL(/1)
               DO 1400 IC2=1,NC2

                  MELVA2=MCHAM2.IELVAL(IC2)
                  IF(ICLE.EQ.0) THEN
                     SEGDES,MELVA2
                  ELSE
                     SEGACT,MELVA2
                  ENDIF

 1400          CONTINUE

               IF(ICLE.EQ.0) SEGDES,MCHAM2
 1300       CONTINUE

            IF(ICLE.EQ.0) SEGDES,MCHEL2
 1200     CONTINUE

          IF(ICLE.EQ.0) SEGDES,MELVAL
 1100   CONTINUE

        IF(ICLE.EQ.0) SEGDES,MCHAML
 1000 CONTINUE

      IF(ICLE.EQ.0) SEGDES,MCHELM

      RETURN
      END