Télécharger la plaquette Cast3M


fr en

Télécharger evchpo.eso

Retour à la liste

Numérotation des lignes : 

evchpo

  1. C EVCHPO    SOURCE    JK148537  25/02/11    21:15:01     12149          
  2.       SUBROUTINE EVCHPO(ICOUL,IBOPOI,IPOI,MEVOLL,CMOT,NCHPT,NMAIL)
  3. C======================================================================
  4. C                OPTION CHPO DE L'OPERATEUR EVOL                      C
  5. C                                                                     C
  6. C       LA SYNTHAXE DE CETTE OPTION D'EVOL EST LA SUIVANTE :          C
  7. C                                                                     C
  8. C                                                                     C
  9. C    EV1 = EVOL (COUL) CHPO CHPT COMP LIGN;                           C
  10. C                                                                     C
  11. C                                                                     C
  12. C  + COUL   : COULEUR DE LA COURBE (FACULTATIVE)                      C
  13. C                                                                     C
  14. C  + CHPT   : CHAMP-POINT                                             C
  15. C                                                                     C
  16. C  + COMP   : COMPOSANTE DU CHAMP POINT                               C
  17. C                                                                     C
  18. C  + LIGN   : MAILLAGE D'UNE LIGNE (SEG2 ou SEG3)                     C
  19. C                                                                     C
  20. C                                                                     C
  21. C======================================================================
  22.       IMPLICIT INTEGER(I-N)
  23.       IMPLICIT REAL*8 (A-H,O-Z)
  24.  
  25. -INC CCNOYAU
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC SMEVOLL
  29. -INC SMCHPOI
  30. -INC SMLREEL
  31. -INC SMELEME
  32. -INC SMCOORD
  33. -INC SMLMOTS
  34. -INC CCASSIS
  35.  
  36.       EXTERNAL EVCHi
  37.       COMMON/EVCHC/NBTHR,ICPR1,MCHPOI,CMOT1
  38.  
  39.       SEGMENT MVOL
  40.         REAL*8            POSNO(JG)
  41.         CHARACTER*(LONOM) NOMAB(JG)
  42.       ENDSEGMENT
  43.  
  44.       SEGMENT TTRAV
  45.         INTEGER ILIS(IDIMM)
  46.       ENDSEGMENT
  47.  
  48.       SEGMENT ICPR1
  49.         INTEGER           IBIN1(nbpts),IBIN2(nbpts)
  50.         REAL*8            XVAL1(nbpts)
  51.         CHARACTER*(LONOM) CNOM2(nbpts)
  52.       ENDSEGMENT
  53.  
  54.       CHARACTER*(LOCOMP) CMOT1
  55.       CHARACTER*(LONOM)  CBLAN1
  56.       CHARACTER*8        TYP1
  57.       CHARACTER*(*)      CMOT,NCHPT,NMAIL
  58.       CHARACTER*11       UMOT1
  59.       CHARACTER*12       UMOT2
  60.       CHARACTER*5        UMOT3
  61.       CHARACTER*72       TITRE
  62.       REAL*8             PREC(3)
  63.       LOGICAL            NOMME,BCHP,BMAIL,BTHRD
  64.  
  65. C=======================================================================
  66.  
  67.       CBLAN1 =' '
  68.       TITRE  ='CREE PAR EVOL CHPO'
  69.       BCHP   = NCHPT .EQ. CBLAN1
  70.       BMAIL  = NMAIL .EQ. CBLAN1
  71.  
  72.       MCHPOI = IBOPOI
  73.       MELEME = IPOI
  74.       CALL LIGMAI(MELEME,TTRAV,1)
  75.       IF(IERR.NE.0) RETURN
  76.  
  77. C     Nombre de composantes du CHPOINT
  78.       CALL NBCOMP(MCHPOI,'CHPOINT ',NBCO)
  79.       IF(IERR.NE.0)RETURN
  80.  
  81.       IF    ( NBCO .EQ. 0)THEN
  82.         CMOT1 = ' '
  83.       ELSEIF(CMOT.EQ.' ')THEN
  84.         IF(NBCO .EQ. 1)THEN
  85.           MSOUPO = MCHPOI.IPCHP(1)
  86.           CMOT1  = MSOUPO.NOCOMP(1)
  87.         ELSE
  88. C         Dans le cas ou il y a plusieurs composantes il faut en specifier 1
  89. c          CALL ERREUR(21)
  90. c          RETURN
  91.           MSOUPO = MCHPOI.IPCHP(1)
  92.         ENDIF
  93.       ELSE
  94.         CMOT1  = CMOT
  95.         NBCO = 1 
  96.       ENDIF
  97.  
  98.       KBCO = 0
  99.       JG  =TTRAV.ILIS(/1)
  100.       SEGINI,MLREEL,ICPR1,MVOL
  101.       NBTHR=NBTHRS
  102.  
  103.  50     KBCO = KBCO + 1
  104.           IF(CMOT.EQ.' ') CMOT1 = MSOUPO.NOCOMP(KBCO)
  105.       JG  =TTRAV.ILIS(/1)
  106.       SEGINI,MLREE1
  107.  
  108.       IF((NBTHR.EQ.1).OR.(NBTHRS.EQ.1).OR. (oothrd.GT.0)) THEN
  109.         NBTHR = 1
  110.         BTHRD =.FALSE.
  111.       ELSE
  112.         BTHRD =.TRUE.
  113. C       Initialisation des threads
  114.         CALL THREADII
  115.       ENDIF
  116.  
  117.       SEGACT ITABOC*MOD,ITABOD*MOD,ITABOB*MOD
  118.       if(nbesc.ne.0) SEGACT,IPILOC
  119.       IF(BTHRD) THEN
  120. C       Lancement du travail en parallèle
  121.         DO ith=2,NBTHR
  122.           CALL THREADID(ith, EVCHi)
  123.         ENDDO
  124. C       Lancement du travail sur le maitre
  125.         CALL EVCHi(1)
  126.  
  127. C       Attente de la fin du travail des threads
  128.         DO ith=2,NBTHR
  129.           CALL THREADIF(ith)
  130.         ENDDO
  131.  
  132. C       Stop des threads
  133.         CALL THREADIS
  134.  
  135.       ELSE
  136. C       Dans les ASSISTANTS ou en SEQUENTIEL on invoque directement la
  137. C       SUBROUTINE qui fait le travail avec ses arguments
  138.         ith=1
  139.         CALL EVCH1(NBTHR,ith,ICPR1,MCHPOI,CMOT1)
  140.       ENDIF
  141.       if(nbesc.ne.0) SEGDES,IPILOC
  142.  
  143.       IF (KBCO.GT.1) GOTO 80
  144. C     BOUCLE SUR TOUS LES NOEUDS DE LA LIGNE
  145. C     IBOC : Nombre de POINTS nommes
  146.       IBOC =0
  147.       ZMABS=0.D0
  148.  
  149.       SEGACT,MCOORD
  150.       DO INOLIG=1,JG
  151.         NN=TTRAV.ILIS(INOLIG)
  152.  
  153. C       Calcul de l'agscisse curviligne
  154.         IF(INOLIG .EQ. 1) THEN
  155.           DO IT=1,IDIM
  156.             PREC(IT) = XCOOR((NN-1)*(IDIM+1) + IT)
  157.           ENDDO
  158.           ZMABS = 0.D0
  159.  
  160.         ELSE
  161.           TOTAL = 0.D0
  162.           IDEB  =(NN-1)*(IDIM+1)
  163.           DO IT=1,IDIM
  164.             XCOO     = XCOOR(IDEB + IT)
  165.             TOTAL    = TOTAL + (XCOO - PREC(IT))**2
  166.             PREC(IT) = XCOO
  167.           ENDDO
  168.           ZMABS = ZMABS + (TOTAL**0.5D0)
  169.         ENDIF
  170.  
  171. C       Le POINT est-il nomme
  172.         NOMME=(ICPR1.IBIN2(NN) .EQ. 1)
  173.         IF(NOMME)THEN
  174.           IBOC             =IBOC+1
  175.           MVOL.POSNO (IBOC)=ZMABS
  176.           MVOL.NOMAB (IBOC)=ICPR1.CNOM2(NN)
  177.         ENDIF
  178.  
  179.         MLREEL.PROG(INOLIG) = ZMABS
  180.       ENDDO
  181.       SEGDES,MCOORD
  182.  
  183. C     Construction du resultat
  184.       IF(IBOC.EQ.0) THEN
  185. *        N=1
  186.         N = NBCO
  187.       ELSE
  188. *        N=2
  189.         N = NBCO + 1
  190.       ENDIF
  191.       SEGINI,MEVOLL
  192.  
  193.  
  194.  80   CONTINUE
  195. c     ordonnee
  196.       DO INOLIG=1,JG
  197.         NN=TTRAV.ILIS(INOLIG)
  198.         IF(ICPR1.IBIN1(NN) .EQ. 1)THEN
  199. C         Le POINT est dans le CHPOINT
  200.           MLREE1.PROG(INOLIG)= ICPR1.XVAL1(NN)
  201. c          ICPR1.XVAL1(NN) = 0.D0
  202.         ELSE
  203.           MLREE1.PROG(INOLIG)= 0.D0
  204.         ENDIF
  205.       ENDDO
  206.  
  207.  
  208.  
  209. C
  210. C   CREATION DU EVOL CONTENANT LES NOMS DES POINTS
  211. C
  212.       IF(IBOC.NE.0.AND.KBCO.EQ.1) THEN
  213.          SEGINI KEVOLL
  214. *MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM          IIIIIII
  215. *   DANS NOMAB ON A LES POINTS QUALIFIES        IIIIIII
  216. *   IBOC LE NOMBRE DE POINTS QUALIFIES            IIII
  217. *   DANS POSNO LA POSITION DES POINTS QUALIFIES   IIII
  218. *   MLREEL : ABSCISSE DES POINTS                  IIII
  219. *   MLREE1 : ORDONNEE DES POINTS                 IIIIII
  220.          JGN=LONOM
  221.          JGM=IBOC
  222.          SEGINI MLMOTS
  223.          JG=IBOC
  224.          SEGINI MLREE2
  225.          IPROGX=MLREE2
  226.          IPROGY=MLMOTS
  227.          TYPX  ='LISTREEL'
  228.          TYPY  ='LISTMOTS'
  229.          IEVOLL(N)=KEVOLL
  230.          NUMEVY='MARQ'
  231.          NUMEVX=ICOUL
  232.          NOMEVX='ABS'
  233.          NOMEVY=CMOT1
  234.          DO 9   I=1,IBOC
  235.             MOTS(I)       =MVOL.NOMAB(I)
  236.             MLREE2.PROG(I)=MVOL.POSNO(I)
  237.  9       CONTINUE
  238.          KEVTEX='POINTS NOMMES APPARTENANT A LA LIGNE'
  239.          LSTYL = 1
  240.          MMARQ = 0
  241.          KTAIL = 3
  242.       ENDIF
  243.  
  244.       SEGINI KEVOLL
  245.       IEVOLL(KBCO)= KEVOLL
  246.       ITYEVO='REEL'
  247.       TYPX  ='LISTREEL'
  248.       TYPY  ='LISTREEL'
  249.       IPROGX= MLREEL
  250.       IPROGY= MLREE1
  251.       IEVTEX= TITREE
  252.       NOMEVX= 'ABS'
  253.       NOMEVY= CMOT1
  254.       NUMEVX= ICOUL
  255.       NUMEVY= 'REEL'
  256.       KEVTEX=TITRE
  257.       LSTYL = 1
  258.       MMARQ = 0
  259.       KTAIL = 3
  260.  
  261.       IF (KBCO.LT.NBCO) GOTO 50
  262.  
  263.       IF (BCHP .AND. BMAIL) THEN
  264.         UMOT1= 'COMPOSANTE '
  265.         UMOT2= ' DU CHPOINT '
  266.         UMOT3= ' SUR '
  267.         TITRE=UMOT1//CMOT1//UMOT2//NCHPT//UMOT3//NMAIL
  268.         KEVTEX=TITRE
  269.       ENDIF
  270.       SEGSUP TTRAV,MVOL,ICPR1
  271.  
  272.       END
  273.  
  274.  
  275.  
  276.  
  277.  

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