Télécharger la plaquette Cast3M


fr en

Télécharger adchve.eso

Retour à la liste

Numérotation des lignes : 

adchve

  1. C ADCHVE    SOURCE    PV        20/04/03    21:15:08     10571          
  2.  
  3.       SUBROUTINE ADCHVE(IELVA1,IELVA2,XX,ICOD,IMELVA,IRET)
  4.  
  5. *_______________________________________________________________________
  6. *
  7. *             POUR VECTORISER L ADDITION DES CHAMELEMS
  8. *
  9. *   ENTREE :
  10. *   ________
  11. *
  12. *       IELVA1       POINTEUR SUR LE MELVAL DU 1IER CHAMELEM
  13. *       IELVA2       POINTEUR SUR LE MELVA DU 2IEME CHAMELEM
  14. *       XX           COEFFICIENTS MULTIPLICATEUR
  15. *       ICOD         =1 --> MELVAL DE POINTEUR SUR MLREEL
  16. *                    =2 --> MELVAL DE POINTEUR SUR UN POINT
  17. *                    =3 --> MELVAL DE POINTEUR SUR UN EVOLUTIOn
  18. *                    =0 --> AUTRE CAS
  19. *
  20. *
  21. *   SORTIES :
  22. *   ---------
  23. *
  24. *       IMELVA       POINTEUR SUR LE MELVAL RESULTAT
  25. *       IRET         = 0 SI OK / =1 SINON
  26. *                    =104 POUR DECLENCHER LE MESSAGE D'ERREUR 104
  27. *                    =197 POUR DECLENCHER LE MESSAGE D'ERREUR 197
  28. *
  29. *      EBERSOLT DECEMBRE 86
  30. *
  31. *      PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 29 10 90
  32. * +PP     EXTENSION ADDITION P.PEGON 23/11/92
  33. *
  34. *______________________________________________________________________
  35. *
  36.       IMPLICIT INTEGER(I-N)
  37.       IMPLICIT REAL*8(A-H,O-Z)
  38.  
  39.  
  40. -INC PPARAM
  41. -INC CCOPTIO
  42.  
  43. -INC SMCHAML
  44. -INC SMLREEL
  45. -INC SMCOORD
  46. -INC SMEVOLL
  47. *
  48.       IRET=0
  49.       MELVA1=IELVA1
  50.       MELVA2=IELVA2
  51.       SEGACT MELVA1
  52.       SEGACT MELVA2
  53. *
  54.       NBP1=MELVA1.VELCHE(/1)
  55.       IF (NBP1.EQ.0) THEN
  56.          NBP1=MELVA1.IELCHE(/1)
  57.          NBP2=MELVA2.IELCHE(/1)
  58.          NEL1=MELVA1.IELCHE(/2)
  59.          NEL2=MELVA2.IELCHE(/2)
  60.          N1PTEL=0
  61.          N1EL  =0
  62.          N2PTEL=MAX(NBP1,NBP2)
  63.          N2EL  =MAX(NEL1,NEL2)
  64.          SEGINI MELVAL
  65.          IF (ICOD.EQ.1) THEN
  66.            DO 1 IB = 1, N2EL
  67.              IBMN1 = MIN(IB  ,NEL1)
  68.              IBMN2 = MIN(IB  ,NEL2)
  69.  
  70.              DO 1 IGAU = 1, N2PTEL
  71.                IGMN1 = MIN(IGAU,NBP1)
  72.                IGMN2 = MIN(IGAU,NBP2)
  73. *
  74.                MLREE1 = MELVA1.IELCHE(IGMN1,IBMN1)
  75.                MLREE2 = MELVA2.IELCHE(IGMN2,IBMN2)
  76. *
  77.                IF (MLREE1.EQ.0) THEN
  78.                  MLREEL = MLREE2
  79.                ELSE IF (MLREE2.EQ.0) THEN
  80.                  MLREEL = MLREE1
  81.                ELSE
  82.                  SEGACT,MLREE1,MLREE2
  83.                  JG1 = MLREE1.PROG(/1)
  84.                  JG2 = MLREE2.PROG(/1)
  85.                  IJG = MIN(JG1,JG2)
  86. *
  87.                  JG=MAX(JG1,JG2)
  88.                  SEGINI MLREEL
  89.                  DO 2 IPROG=1,IJG
  90.                     PROG(IPROG)=MLREE1.PROG(IPROG)+XX*MLREE2.PROG(IPROG)
  91.  2               CONTINUE
  92.                  IF (JG.GT.IJG) THEN
  93.                    IF (IJG.EQ.JG1) THEN
  94.                      DO 10 IPROG=IJG+1,JG2
  95.                        PROG(IPROG)=XX*MLREE2.PROG(IPROG)
  96.  10                  CONTINUE
  97.                    ELSE
  98.                      DO 20 IPROG=IJG+1,JG1
  99.                        PROG(IPROG)=MLREE1.PROG(IPROG)
  100.  20                  CONTINUE
  101.                    ENDIF
  102.                  ENDIF
  103.                ENDIF
  104.                IELCHE(IGAU,IB)=MLREEL
  105.  1          CONTINUE
  106.  
  107.          ELSE IF (ICOD.EQ.2) THEN
  108.             IDIMP1 = IDIM + 1
  109.             mcoact=0
  110.             DO 3 IB=1,N2EL
  111.               IBMN1 = MIN(IB  ,NEL1)
  112.               IBMN2 = MIN(IB  ,NEL2)
  113.  
  114.               DO 3 IGAU=1,N2PTEL
  115.                 IGMN1 = MIN(IGAU,NBP1)
  116.                 IGMN2 = MIN(IGAU,NBP2)
  117. *
  118.                 IP1 = MELVA1.IELCHE(IGMN1,IBMN1)
  119.                 IP2 = MELVA2.IELCHE(IGMN2,IBMN2)
  120. *
  121.                 IF (IP1.EQ.0) THEN
  122.                   NUMNOE = IP2
  123.                 ELSE IF (IP2.EQ.0) THEN
  124.                   NUMNOE = IP1
  125.                 ELSE
  126.                   NUMNOE = MIN(IP1,IP2)
  127. C- Si les numeros des points sont differents, on va tester s'ils
  128. C- n'ont pas les memes coordonnees. Si non, on cree un nouveau point
  129. C- mais risque de probleme en //...
  130.                   IF (IP1.NE.IP2) THEN
  131.                     IREF1 = (IP1-1) * IDIMP1
  132.                     IREF2 = (IP2-1) * IDIMP1
  133.                     i_z = 0
  134.                     if (mcoact.eq.0) then
  135.                      mcoact=1
  136.                      segact mcoord
  137.                     endif
  138.                     DO IC = 1, IDIM
  139.                       r_z1 = MAX( ABS(XCOOR(IREF1+IC)) ,
  140.      &                            ABS(XCOOR(IREF2+IC)) )
  141.                       r_z2 = ABS( XCOOR(IREF1+IC) - XCOOR(IREF2+IC) )
  142.                       IF (r_z2 .GT. 1.D-9*r_z1) i_z = i_z + 1
  143.                     ENDDO
  144. *
  145. *                    ON CREE UN NOUVEAU POINT :
  146. *
  147.                     IF (i_z.GT.0) THEN
  148.  
  149.                       if (mcoact.ne.2) then
  150.                        mcoact=2
  151.                        segact mcoord*mod
  152.                       endif
  153.                       IREFC = NBPTS * IDIMP1
  154.                       NBPTS = NBPTS + 1
  155.                       SEGADJ,MCOORD
  156.                       DO 4 IC = 1, IDIMP1
  157.                         XCOOR(IREFC+IC) =       XCOOR(IREF1+IC)
  158.      &                                    +XX * XCOOR(IREF2+IC)
  159.  4                    CONTINUE
  160.                       NUMNOE = NBPTS
  161.                     ENDIF
  162.                   ENDIF
  163.                 ENDIF
  164.                 IELCHE(IGAU,IB) = NUMNOE
  165.  3          CONTINUE
  166.             if (mcoact.ne.0) SEGDES,MCOORD
  167.  
  168.          ELSE IF (ICOD.EQ.3) THEN
  169.             I_XX = INT(XX)
  170.             DO 6 IB=1,N2EL
  171.               IBMN1 = MIN(IB  ,NEL1)
  172.               IBMN2 = MIN(IB  ,NEL2)
  173.  
  174.               DO 6 IGAU=1,N2PTEL
  175.                 IGMN1 = MIN(IGAU,NBP1)
  176.                 IGMN2 = MIN(IGAU,NBP2)
  177. *
  178.                 MEVOL1 = MELVA1.IELCHE(IGMN1,IBMN1)
  179.                 MEVOL2 = MELVA2.IELCHE(IGMN2,IBMN2)
  180.                 CALL ADEVOL(MEVOL1,MEVOL2,IPEVAD,I_XX)
  181.                 IF (IPEVAD.EQ.0) IRET=1
  182.                 IELCHE(IGAU,IB) = IPEVAD
  183.  6          CONTINUE
  184.  
  185.          ELSE
  186. *
  187. *           Y-A-T'IL UN DES DEUX POINTEURS NUL ?
  188. *
  189.             DO IB=1,N2EL
  190.               IBMN1 = MIN(IB  ,NEL1)
  191.               IBMN2 = MIN(IB  ,NEL2)
  192.  
  193.               DO IGAU=1,N2PTEL
  194.                 IGMN1 = MIN(IGAU,NBP1)
  195.                 IGMN2 = MIN(IGAU,NBP2)
  196.  
  197.                 IEL1=MELVA1.IELCHE(IGMN1,IBMN1)
  198.                 IEL2=MELVA2.IELCHE(IGMN2,IBMN2)
  199.                 IF (IEL1.EQ.0)THEN
  200.                   IELCHE(IGAU,IB)=IEL2
  201.                 ELSEIF(IEL2.EQ.0)THEN
  202.                   IELCHE(IGAU,IB)=IEL1
  203.                 ELSE
  204. *
  205. *                 NOM DE COMPOSANTE NON RECONNU
  206. *
  207.                   IRET=197
  208.                   SEGSUP MELVAL
  209.                   RETURN
  210.                 ENDIF
  211.               ENDDO
  212.             ENDDO
  213.          ENDIF
  214.  
  215.          IMELVA=MELVAL
  216.  
  217.       ELSE
  218.          NBP1=MELVA1.VELCHE(/1)
  219.          NBP2=MELVA2.VELCHE(/1)
  220.          NEL1=MELVA1.VELCHE(/2)
  221.          NEL2=MELVA2.VELCHE(/2)
  222.          N1PTEL=MAX(NBP1,NBP2)
  223.          N1EL  =MAX(NEL1,NEL2)
  224.          N2PTEL=0
  225.          N2EL  =0
  226.          SEGINI MELVAL
  227.          DO 50 IB=1,N1EL
  228.            IBMN1 = MIN(IB  ,NEL1)
  229.            IBMN2 = MIN(IB  ,NEL2)
  230.  
  231.            DO 51 IGAU=1,N1PTEL
  232.               IGMN1 = MIN(IGAU,NBP1)
  233.               IGMN2 = MIN(IGAU,NBP2)
  234.               VELCHE(IGAU,IB)=    MELVA1.VELCHE(IGMN1,IBMN1)+
  235.      &                         XX*MELVA2.VELCHE(IGMN2,IBMN2)
  236.   51       CONTINUE
  237.   50     CONTINUE
  238.          IMELVA=MELVAL
  239.  
  240.       ENDIF
  241.  
  242.       END
  243.  
  244.  
  245.  
  246.  
  247.  

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