Télécharger la plaquette Cast3M


fr en

Télécharger evch1.eso

Retour à la liste

Numérotation des lignes : 

evch1

  1. C EVCH1     SOURCE    CB215821  21/01/28    21:15:00     10867          
  2.       SUBROUTINE EVCH1(NBTHL,ITHR,ICPR1,MCHPOI,CMOT1)
  3.  
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6.  
  7. -INC PPARAM
  8. -INC CCNOYAU
  9. -INC CCOPTIO
  10. -INC SMELEME
  11. -INC SMCHPOI
  12.  
  13.       CHARACTER*(*) CMOT1
  14.       CHARACTER*8   TYP1
  15.  
  16.       SEGMENT ICPR1
  17.         INTEGER           IBIN1(nbpts),IBIN2(nbpts)
  18.         REAL*8            XVAL1(nbpts)
  19.         CHARACTER*(LONOM) CNOM2(nbpts)
  20.       ENDSEGMENT
  21.  
  22. C     Mise en forme du CHPOINT en ICPR1
  23.       NSOUPO=MCHPOI.IPCHP(/1)
  24.       DO 10 ISOUP = 1,NSOUPO
  25.         MSOUPO = MCHPOI.IPCHP(ISOUP)
  26.         NC     = MSOUPO.NOCOMP(/2)
  27.  
  28.         DO 20 INC = 1,NC
  29.           IF(MSOUPO.NOCOMP(INC) .EQ. CMOT1)THEN
  30.             MPOVAL = MSOUPO.IPOVAL
  31.             IPT1   = MSOUPO.IGEOC
  32.             NNC    = IPT1.NUM(/2)
  33.  
  34. C           On assure le travail contigu en mémoire
  35.             IF(NBTHL .EQ. 1)THEN
  36.               IDEB  = 1
  37.               IFIN  = NNC
  38.             ELSE
  39.               NBTHR=MIN(NNC,NBTHL)
  40.               IF(ITHR .GT. NBTHR) GOTO 20
  41.               IRES = MOD(NNC,NBTHR)
  42.               IF(IRES  .EQ. 0)THEN
  43.                 ILON  = NNC / NBTHR
  44.                 IDEB  = (ITHR-1)* ILON + 1
  45.               ELSE
  46.                 IF (ITHR .LE. IRES) THEN
  47.                   ILON  = (NNC / NBTHR) + 1
  48.                   IDEB  = (ITHR-1)* ILON + 1
  49.                 ELSE
  50.                   ILON  = NNC / NBTHR
  51.                   IDEB  = (IRES * (ILON+1)) + (ITHR-IRES-1)* ILON + 1
  52.                 ENDIF
  53.               ENDIF
  54.               IFIN  = IDEB + ILON - 1
  55.             ENDIF
  56.  
  57. C           Boucle qui réalise le travail de IDEB à IFIN
  58.             DO INBEL= IDEB,IFIN
  59.               INOE  = IPT1.NUM(1,INBEL)
  60.               ICPR1.IBIN1(INOE) = 1
  61.               ICPR1.XVAL1(INOE) = MPOVAL.VPOCHA(INBEL,INC)
  62.             ENDDO
  63.           ENDIF
  64.  20     CONTINUE
  65.  10   CONTINUE
  66.  
  67.  
  68. C     Repertorie tous les points nommes
  69.       NNC=IOUEP2(/1)
  70.  
  71. C     On assure le travail contigu en mémoire
  72.       IF(NBTHL .EQ. 1)THEN
  73.         IDEB  = 1
  74.         IFIN  = NNC
  75.       ELSE
  76.         NBTHR=MIN(NNC,NBTHL)
  77.         IF(ITHR .GT. NBTHR) RETURN
  78.         IRES = MOD(NNC,NBTHR)
  79.         IF(IRES  .EQ. 0)THEN
  80.           ILON  = NNC / NBTHR
  81.           IDEB  = (ITHR-1)* ILON + 1
  82.         ELSE
  83.           IF (ITHR .LE. IRES) THEN
  84.             ILON  = (NNC / NBTHR) + 1
  85.             IDEB  = (ITHR-1)* ILON + 1
  86.           ELSE
  87.             ILON  = NNC / NBTHR
  88.             IDEB  = (IRES * (ILON+1)) + (ITHR-IRES-1)* ILON + 1
  89.           ENDIF
  90.         ENDIF
  91.         IFIN  = IDEB + ILON - 1
  92.       ENDIF
  93.  
  94.       DO 30 IOP=IDEB,IFIN
  95.         TYP1=INOOB2(IOP)
  96.         IF(TYP1.EQ.'POINT   ') THEN
  97.           INOE  =IOUEP2(IOP)
  98.           IP    =INOOB1(IOP)
  99.           IDEBCH=IPCHAR(IP)
  100.           IFINCH=IPCHAR(IP+1)-1
  101.           IF (ICHARA(IDEBCH:IDEBCH).NE.' ') THEN
  102.             IF (ICHARA(IDEBCH:IDEBCH).NE.'#') THEN
  103.               ICPR1.IBIN2(INOE)= 1
  104.               ICPR1.CNOM2(INOE)= ICHARA(IDEBCH:IFINCH)
  105.             ENDIF
  106.           ENDIF
  107.         ENDIF
  108.  30   CONTINUE
  109.       END
  110.  
  111.  

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