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

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