Télécharger la plaquette Cast3M


fr en

Télécharger borne4.eso

Retour à la liste

Numérotation des lignes : 

borne4

  1. C BORNE4    SOURCE    PV        22/01/18    21:15:01     11267          
  2.  
  3.       SUBROUTINE BORNE4 (IPCHPE,MLCOMP,MLIOPE,MLBMIN,MLBMAX, IPCHPS)
  4.  
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8(A-H,O-Z)
  7.  
  8. C*
  9. -INC PPARAM
  10. -INC CCOPTIO
  11. -INC SMCHPOI
  12. -INC SMLENTI
  13. -INC SMLMOTS
  14. -INC SMLREEL
  15.  
  16.       CHARACTER*(LOCOMP) mocomp
  17.  
  18.       IPCHPS = 0
  19.       IRETS  = 0
  20.       MCHPO1 = IPCHPE
  21.  
  22. C     Si CHPOINT vide en entree
  23.       segact,MCHPO1
  24.       NS1 = MCHPO1.IPCHP(/1)
  25.       IF (NS1.EQ.0) THEN
  26.         IPCHPS = IPCHPE
  27.         RETURN
  28.       ENDIF
  29.  
  30.       SEGINI,MCHPOI=MCHPO1
  31.  
  32. C- Quelques verifications
  33.       MLMOTS = MLCOMP
  34. C*    SEGACT,MLMOTS
  35.       DO i = 1, MOTS(/2)
  36.         mocomp = MOTS(i)
  37.         DO j = 1, i-1
  38.           IF (mocomp.EQ.MOTS(j)) MOTS(j) = '    '
  39.         ENDDO
  40.       ENDDO
  41.       NCOMP = 0
  42.       DO i = 1, MOTS(/2)
  43.         IF (MOTS(i).NE.'    ') NCOMP = NCOMP+1
  44.       ENDDO
  45.       IF (NCOMP.EQ.0) CALL ERREUR(5)
  46.  
  47.       MLENT1 = MLIOPE
  48. C*    SEGACT,MLENT1
  49.       MLREE1 = MLBMIN
  50. C*    SEGACT,MLREE1
  51.       MLREE2 = MLBMAX
  52. C*    SEGACT,MLREE2
  53.  
  54. C- Realisation du bornage des champs par point
  55.       NSOUPO = IPCHP(/1)
  56.       DO i = 1, NSOUPO
  57.         MSOUP1 = IPCHP(i)
  58.         SEGACT,MSOUP1
  59.         MPOVA1 = MSOUP1.IPOVAL
  60.         SEGACT,MPOVA1
  61.         N     = MPOVA1.VPOCHA(/1)
  62.         NCOMP = MPOVA1.VPOCHA(/2)
  63.         SEGINI,MSOUPO=MSOUP1
  64.         SEGINI,MPOVAL=MPOVA1
  65.         NC = 0
  66.         DO icour = 1, NCOMP
  67.           mocomp = MSOUP1.NOCOMP(icour)
  68. C*        IF (mocomp.EQ.'    ') GOTO 100
  69.           CALL PLACE(MOTS,MOTS(/2),ncour,mocomp)
  70.           IF (ncour.NE.0) THEN
  71.             NC = NC+1
  72.             NOCOMP(NC) = mocomp
  73.             NOHARM(NC) = MSOUP1.NOHARM(icour)
  74.             INDOPE = MLENT1.LECT(ncour)
  75.             XBMIN  = MLREE1.PROG(ncour)
  76.             XBMAX  = MLREE2.PROG(ncour)
  77. C- BORNER 'MAXIMUM' :
  78.             IF (INDOPE.EQ.1) THEN
  79.               DO j = 1, N
  80.                 VPOCHA(j,NC) = MIN( MPOVA1.VPOCHA(j,icour), XBMAX)
  81.               ENDDO
  82. C- BORNER 'MINIMUM' :
  83.             ELSE IF (INDOPE.EQ.2) THEN
  84.               DO j = 1, N
  85.                 VPOCHA(j,NC) = MAX( MPOVA1.VPOCHA(j,icour), XBMIN)
  86.               ENDDO
  87. C- BORNER 'COMPRIS' :
  88.             ELSE IF (INDOPE.EQ.3) THEN
  89.               DO j = 1, N
  90.                 x = MIN( MPOVA1.VPOCHA(j,icour), XBMAX)
  91.                 VPOCHA(j,NC) = MAX( x, XBMIN)
  92.               ENDDO
  93.             ELSE
  94.               CALL ERREUR(5)
  95.             ENDIF
  96.           ENDIF
  97. C*100     CONTINUE
  98.         ENDDO
  99.         IF (NC.NE.0) THEN
  100.           IRETS = IRETS + 1
  101.           IF (NC.NE.NCOMP) THEN
  102.             SEGADJ,MPOVAL,MSOUPO
  103.           ENDIF
  104.           IPCHP(IRETS) = MSOUPO
  105.           IPOVAL = MPOVAL
  106.         ELSE
  107.           SEGSUP,MPOVAL,MSOUPO
  108.         ENDIF
  109.       ENDDO
  110.  
  111.       IF (IRETS.GT.0) THEN
  112.         IF (IRETS.NE.NSOUPO) THEN
  113.           NSOUPO = IRETS
  114.           NAT = JATTRI(/1)
  115.           SEGADJ,MCHPOI
  116.         ENDIF
  117.         IPCHPS = MCHPOI
  118.       ELSE
  119.         CALL ERREUR(280)
  120.       ENDIF
  121.  
  122.  900  CONTINUE
  123.       IF (IPCHPS.EQ.0) SEGSUP,MCHPOI
  124.  
  125.       RETURN
  126.       END
  127.  
  128.  
  129.  

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