Télécharger la plaquette Cast3M


fr en

Télécharger mecham.eso

Retour à la liste

Numérotation des lignes : 

mecham

  1. C MECHAM    SOURCE    PV090527  25/01/07    12:39:25     12114          
  2.       SUBROUTINE MECHAM(ILISSE,IPLIS,IPOLAC)
  3. *--------------------------------------------------------------------*
  4. *                                                                    *
  5. *     Sous-programme de la directive MENAGE: nouveau CHAMELEM        *
  6. *     _______________________________________________________        *
  7. *                                                                    *
  8. *     Param}tres:                                                    *
  9. *                                                                    *
  10. * es  IPLIS   pointeur sur le segment ISLIS  ( suppose actif )       *
  11. * es  IPOLAC  pointeur sur le segment ICOLAC ( suppose actif )       *
  12. *                                                                    *
  13. *--------------------------------------------------------------------*
  14.       IMPLICIT INTEGER(I-N)
  15.  
  16. -INC PPARAM
  17. -INC CCOPTIO
  18. -INC SMCHAML
  19. -INC TMCOLAC
  20.       SEGMENT ISLIS(NP)
  21.       SEGMENT ISEG(0)
  22.  
  23.       ISLIS  = IPLIS
  24.       ICOLAC = IPOLAC
  25. *
  26. *     Cas du nouveau CHAMELEM : MCHAML
  27. *
  28.       ITLACC = KCOLA(39)
  29.       DO 10 I=1,ITLAC(/1)
  30.          MCHELM = ITLAC(I)
  31.          IF (MCHELM.NE.0) THEN
  32.             ISLIS(( MCHELM-1)/npgcd)=1
  33.             SEGACT,MCHELM
  34.                   ISEG=MCLCNF       
  35.                   IF(ISEG.gt.0) THEN
  36.                     ISLIS((ISEG-1)/npgcd)=1
  37.                     SEGDES ISEG
  38.                   ENDIF
  39.  
  40.             N3=INFCHE(/2)
  41.             DO 20 J=1,ICHAML(/1)
  42.                MCHAML = ICHAML(J)
  43.                IF (MCHAML.NE.0) THEN
  44.                   ISLIS((MCHAML-1)/npgcd)=1
  45.                   SEGACT,MCHAML
  46.                   ISEG=INFCHE(J,4)
  47.                   IF(ISEG.NE.0) THEN
  48.                     ISLIS((ISEG-1)/npgcd)=1
  49.                     SEGDES ISEG
  50.                   ENDIF
  51.                   DO 30 K=1,IELVAL(/1)
  52.                      MELVAL = IELVAL(K)
  53.                      IF (MELVAL.NE.0) THEN
  54.                         ISLIS((MELVAL-1)/npgcd)=1
  55.                         IF(TYPCHE(K)(1:8).EQ.'POINTEUR' .AND.
  56.      *                     TYPCHE(K)(9:13).NE.'POINT'   .AND.
  57.      *                     TYPCHE(K)(9:15).NE.'LOGIQUE' .AND.
  58.      *                     TYPCHE(K)(9:11).NE.'MOT'    ) THEN
  59.                           SEGACT MELVAL
  60.                           NAL1=IELCHE(/1)
  61.                           NAL2=IELCHE(/2)
  62.                           DO 40 I2=1,NAL2
  63.                             DO 50 I1=1,NAL1
  64.                                ISEG=IELCHE(I1,I2)
  65.                                IF(ISEG.NE.0) THEN
  66.                                  ISLIS((ISEG-1)/npgcd)=1
  67.                                  SEGDES ISEG
  68.                                ENDIF
  69.  50                         CONTINUE
  70. *
  71.  40                       CONTINUE
  72. *
  73.                         ENDIF
  74.                      SEGDES,MELVAL
  75.                      ENDIF
  76.  30                  CONTINUE
  77. *                 END DO
  78.                   SEGDES,MCHAML
  79.                ENDIF
  80.  20            CONTINUE
  81. *           END DO
  82.             SEGDES,MCHELM
  83.          ENDIF
  84.  10      CONTINUE
  85. *     END DO
  86.  
  87.       RETURN
  88.       END
  89.  
  90.  
  91.  
  92.  
  93.  

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