Télécharger la plaquette Cast3M


fr en

Télécharger borne5.eso

Retour à la liste

Numérotation des lignes : 

borne5

  1. C BORNE5    SOURCE    CB215821  20/11/04    21:15:14     10766          
  2.  
  3.       SUBROUTINE BORNE5 (IPCHME,MLCOMP,MLIOPE,MLBMIN,MLBMAX, IPCHMS)
  4.  
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8(A-H,O-Z)
  7.  
  8. -INC PPARAM
  9. -INC CCOPTIO
  10. -INC SMCHAML
  11. -INC SMLREEL
  12.       POINTEUR MLREE4.MLREEL,MLREE5.MLREEL
  13. -INC SMLENTI
  14. -INC SMLMOTS
  15. -INC SMEVOLL
  16.  
  17.       MACRO, (BORN_MAX, BORN_MIN, BORN_COMPRIS)
  18.  
  19.       CHARACTER*(LOCOMP)  char_A
  20.       CHARACTER*16 mot16
  21.  
  22.       IPCHMS = 0
  23.       IRETS  = 0
  24.       MCHEL1 = IPCHME
  25.       SEGINI,MCHELM=MCHEL1
  26.  
  27. C- Quelques verifications
  28.       MLMOTS = MLCOMP
  29.       NBMOTS=MOTS(/2)
  30.       DO i = 1, NBMOTS
  31.         char_A = MOTS(i)
  32.         DO j = 1, i-1
  33.           IF (char_A.EQ.MOTS(j)) MOTS(j) = '    '
  34.         ENDDO
  35.       ENDDO
  36.       NCOMP = 0
  37.       DO i = 1, NBMOTS
  38.         IF (MOTS(i).NE.'    ') NCOMP = NCOMP+1
  39.       ENDDO
  40.       IF (NCOMP.EQ.0) THEN
  41.         CALL ERREUR(21)
  42.         RETURN
  43.       ENDIF
  44.  
  45.       MLENTI = MLIOPE
  46.       MLREE1 = MLBMIN
  47.       MLREE2 = MLBMAX
  48.  
  49. C- Realisation du bornage des champs par element
  50.       N1 = ICHAML(/1)
  51.       N3 = INFCHE(/2)
  52.       DO i = 1, N1
  53.         MCHAM1 = ICHAML(i)
  54.         NCOMP = MCHAM1.NOMCHE(/2)
  55.         SEGINI,MCHAML=MCHAM1
  56.         N2 = 0
  57.         DO 100 icour = 1, NCOMP
  58.           char_A = MCHAM1.NOMCHE(icour)
  59.           CALL PLACE(MOTS,NBMOTS,ncour,char_A)
  60.           IF (ncour.EQ.0) GOTO 100
  61.           N2 = N2 + 1
  62.           NOMCHE(N2) = char_A
  63.           mot16      = MCHAM1.TYPCHE(icour)
  64.           TYPCHE(N2) = mot16
  65.           MELVA1     = MCHAM1.IELVAL(icour)
  66.  
  67.           N1PTEL     = MELVA1.VELCHE(/1)
  68.           N1EL       = MELVA1.VELCHE(/2)
  69.           N2PTEL     = MELVA1.IELCHE(/1)
  70.           N2EL       = MELVA1.IELCHE(/2)
  71.  
  72.           SEGINI,MELVAL
  73.           IELVAL(N2)   = MELVAL
  74.           INDOPE       = MLENTI.LECT(ncour)
  75.           XBMIN        = MLREE1.PROG(ncour)
  76.           XBMAX        = MLREE2.PROG(ncour)
  77.  
  78.           IF (mot16.EQ.'REAL*8          ') THEN
  79.             DO iel = 1, N1EL
  80.               DO igau = 1, N1PTEL
  81.                 X=MELVA1.VELCHE(igau,iel)
  82.                 CASE, INDOPE
  83.                   WHEN, BORN_MAX
  84.                     VELCHE(igau,iel)=MIN(X, XBMAX)
  85.                   WHEN, BORN_MIN
  86.                     VELCHE(igau,iel)=MAX(X, XBMIN)
  87.                   WHEN, BORN_COMPRIS
  88.                     VELCHE(igau,iel)=MAX(MIN(X, XBMAX), XBMIN)
  89.                 ENDCASE
  90.               ENDDO
  91.             ENDDO
  92.  
  93.           ELSEIF (mot16.EQ.'POINTEURLISTREEL') THEN
  94.             DO iel = 1, N1EL
  95.               DO igau = 1, N1PTEL
  96.                 MLREE5 = MELVA1.IELCHE(igau,iel)
  97.                 JG=MLREE5.PROG(/1)
  98.                 SEGINI,MLREEL
  99.                 DO iv=1,JG
  100.                   X=MLREE5.PROG(iv)
  101.                   CASE, INDOPE
  102.                     WHEN, BORN_MAX
  103.                       MLREEL.PROG(iv)=MIN(X, XBMAX)
  104.                     WHEN, BORN_MIN
  105.                       MLREEL.PROG(iv)=MAX(X, XBMIN)
  106.                     WHEN, BORN_COMPRIS
  107.                       MLREEL.PROG(iv)=MAX(MIN(X, XBMAX), XBMIN)
  108.                   ENDCASE
  109.                 ENDDO
  110.                 IELCHE(igau,iel) = MLREEL
  111.               ENDDO
  112.             ENDDO
  113.  
  114.           ELSEIF (mot16.EQ.'POINTEURLISTENTI') THEN
  115.             IBMIN  = NINT(XBMIN)
  116.             IBMAX  = NINT(XBMAX)
  117.             DO iel = 1, N1EL
  118.               DO igau = 1, N1PTEL
  119.                 MLENT1 = MELVA1.IELCHE(igau,iel)
  120.                 JG=MLENT1.LECT(/1)
  121.                 SEGINI,MLENTI
  122.                 DO iv=1,JG
  123.                   I1=MLENT1.LECT(iv)
  124.                   CASE, INDOPE
  125.                     WHEN, BORN_MAX
  126.                       MLENTI.LECT(iv)=MIN(I1, IBMAX)
  127.                     WHEN, BORN_MIN
  128.                       MLENTI.LECT(iv)=MAX(I1, IBMIN)
  129.                     WHEN, BORN_COMPRIS
  130.                       MLENTI.LECT(iv)=MAX(MIN(I1, IBMAX), IBMIN)
  131.                   ENDCASE
  132.                 ENDDO
  133.                 IELCHE(igau,iel) = MLENTI
  134.               ENDDO
  135.             ENDDO
  136.  
  137.           ELSEIF (mot16.EQ.'POINTEUREVOLUTIO') THEN
  138.             DO iel = 1, N1EL
  139.               DO igau = 1, N1PTEL
  140.                 MEVOL1 = MELVA1.IELCHE(igau,iel)
  141.                 N      = MEVOL1.IEVOLL(/1)
  142.                 IF(N .NE. 1) THEN
  143.                   CALL ERREUR(21)
  144.                   RETURN
  145.                 ENDIF
  146.                 KEVOL1=MEVOL1.IEVOLL(1)
  147.                 SEGINI,MEVOLL,KEVOLL
  148.                 MEVOLL.IEVOLL(1)= KEVOLL
  149.                 MEVOLL.ITYEVO   = MEVOL1.ITYEVO
  150.                 MEVOLL.IEVTEX   = MEVOL1.IEVTEX
  151.  
  152.                 KEVOLL.IPROGX=KEVOL1.IPROGX
  153.                 KEVOLL.NUMEVX=KEVOL1.NUMEVX
  154.                 KEVOLL.NUMEVY=KEVOL1.NUMEVY
  155.                 KEVOLL.TYPX  =KEVOL1.TYPX
  156.                 KEVOLL.TYPY  =KEVOL1.TYPY
  157.                 KEVOLL.NOMEVX=KEVOL1.NOMEVX
  158.                 KEVOLL.NOMEVY=KEVOL1.NOMEVY
  159.                 KEVOLL.KEVTEX=KEVOL1.KEVTEX
  160.  
  161.                 MLREE5=KEVOL1.IPROGY
  162.                 JG=MLREE5.PROG(/1)
  163.                 SEGINI,MLREEL
  164.                 DO iv=1,JG
  165.                   X=MLREE5.PROG(iv)
  166.                   CASE, INDOPE
  167.                     WHEN, BORN_MAX
  168.                       MLREEL.PROG(iv)=MIN(X, XBMAX)
  169.                     WHEN, BORN_MIN
  170.                       MLREEL.PROG(iv)=MAX(X, XBMIN)
  171.                     WHEN, BORN_COMPRIS
  172.                       MLREEL.PROG(iv)=MAX(MIN(X, XBMAX), XBMIN)
  173.                   ENDCASE
  174.                 ENDDO
  175.                 KEVOLL.IPROGY = MLREEL
  176.                 IELCHE(igau,iel) = MEVOLL
  177.               ENDDO
  178.             ENDDO
  179.  
  180.           ELSE
  181.             MOTERR(1:8)=MCHAM1.NOMCHE(icour)
  182.             CALL ERREUR(679)
  183.             IRETS = -1
  184.           ENDIF
  185.  100    CONTINUE
  186.  
  187.         IF (IRETS.NE.-1) THEN
  188.           IF (N2.NE.0) THEN
  189.             IRETS = IRETS + 1
  190.             IF (N2.NE.NCOMP) THEN
  191.               SEGADJ,MCHAML
  192.             ENDIF
  193.             ICHAML(IRETS) = MCHAML
  194.             IF (IRETS.NE.i) THEN
  195.               CONCHE(IRETS) = CONCHE(i)
  196.               IMACHE(IRETS) = IMACHE(i)
  197.               DO j = 1, N3
  198.                 INFCHE(IRETS,j) = INFCHE(i,j)
  199.               ENDDO
  200.             ENDIF
  201.           ELSE
  202.             SEGSUP,MCHAML
  203.           ENDIF
  204.         ENDIF
  205.       ENDDO
  206.  
  207.       IF (IRETS.GT.0) THEN
  208.         IF (IRETS.NE.N1) THEN
  209.           N1 = IRETS
  210.           L1 = TITCHE(/1)
  211.           SEGADJ,MCHELM
  212.         ENDIF
  213.         IPCHMS = MCHELM
  214.       ELSEIF (IRETS.EQ.0) THEN
  215.         CALL ERREUR(280)
  216.       ENDIF
  217.  
  218.  900  CONTINUE
  219.       IF (IPCHMS.EQ.0) SEGSUP,MCHELM
  220.  
  221.       END
  222.  
  223.  
  224.  

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