Télécharger la plaquette Cast3M


fr en

Télécharger intmod.eso

Retour à la liste

Numérotation des lignes : 

intmod

  1. C INTMOD    SOURCE    CB215821  24/04/12    21:16:25     11897          
  2.       SUBROUTINE INTMOD(IPMOD1,IPMOD2)
  3. C----------------------------------------------------------------------C
  4. C    INTERSECTION DEUX MODELES
  5. C
  6. C    SYNTAXE : MOD1 = INTE MOD2 MOD3
  7.  
  8. C    Rq. : l'operation est faite sur les sous-zones
  9. C
  10. C    ENTREES :
  11. C      - IPMOD1 = MOD2
  12. C      - IPMOD2 = MOD3 
  13.  
  14. C    SORTIE : le resultat est renvoye dans la pile.
  15. C
  16. C----------------------------------------------------------------------C
  17.  
  18.       IMPLICIT INTEGER(I-N)
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC SMMODEL
  23.  
  24. C Activation de l'objet :
  25.       MMODE1 = IPMOD1
  26.       MMODE2 = IPMOD2
  27.       SEGACT, MMODE1, MMODE2
  28.  
  29. C---- CAS MODELE VIDE EN ARGUMENT ----C
  30.  
  31.       NBS1 = MMODE1.KMODEL(/1)
  32.       IF (NBS1.EQ.0) THEN
  33.         CALL ECROBJ('MMODEL',IPMOD1)
  34.         RETURN
  35.       ENDIF
  36.  
  37.       NBS2 = MMODE2.KMODEL(/1)
  38.       IF (NBS2.EQ.0) THEN
  39.         CALL ECROBJ('MMODEL',IPMOD2)
  40.         RETURN
  41.       ENDIF
  42.  
  43. C---- CAS GENERAL ----C
  44.  
  45. C Creation du MMODEL resultat :
  46.       N1   = NBS1 + NBS2
  47.       SEGINI,MMODEL
  48.  
  49. C Identification des sous-zones communes :
  50.       NBS0 = 0
  51.       DO 100 I1=1,NBS1
  52.         IMOD1 = MMODE1.KMODEL(I1)
  53.         DO 110 I2=1,NBS2
  54.           IMOD2 = MMODE2.KMODEL(I2)
  55.           IF (IMOD1.EQ.IMOD2) THEN
  56.             NBS0 = NBS0 + 1
  57.             KMODEL(NBS0) = IMOD1
  58.           ENDIF
  59.  110    CONTINUE
  60.  100  CONTINUE
  61.  
  62. C Ajustement segment MMODEL si besoin :
  63.       IF (NBS0.NE.N1) THEN
  64.         N1 = NBS0
  65.         SEGADJ, MMODEL
  66.       endif
  67.  
  68. C Ecriture resultat dans la pile :
  69.       CALL ECROBJ('MMODEL',MMODEL)
  70.  
  71.       RETURN
  72.       END
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  

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