Télécharger la plaquette Cast3M


fr en

Télécharger difmod.eso

Retour à la liste

Numérotation des lignes : 

difmod

  1. C DIFMOD    SOURCE    CB215821  24/04/12    21:15:36     11897          
  2.       SUBROUTINE DIFMOD(IPMOD1,IPMOD2)
  3. C----------------------------------------------------------------------C
  4. C    DIFFERENCE SYMETRIQUE ENTRE DEUX MODELES.
  5. C
  6. C    SYNTAXE : MOD1 = DIFF 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.       SEGMENT INTESZ(NSZ1)
  21.  
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMMODEL
  26.  
  27. C Activation de l'objet :
  28.       MMODE1 = IPMOD1
  29.       MMODE2 = IPMOD2
  30.       SEGACT, MMODE1, MMODE2
  31.  
  32. C---- CAS MODELE VIDE EN ARGUMENT ----C
  33.  
  34.       NBS1 = MMODE1.KMODEL(/1)
  35.       IF (NBS1.EQ.0) THEN
  36.         CALL ECROBJ('MMODEL',IPMOD2)
  37.         RETURN
  38.       ENDIF
  39.  
  40.       NBS2 = MMODE2.KMODEL(/1)
  41.       IF (NBS2.EQ.0) THEN
  42.         CALL ECROBJ('MMODEL',IPMOD1)
  43.         RETURN
  44.       ENDIF
  45.  
  46. C---- CAS GENERAL ----C
  47.  
  48. C Creation du MMODEL resultat :
  49.       N1   = NBS1 + NBS2
  50.       SEGINI,MMODEL
  51.  
  52. C Identification des sous-zones communes :
  53.       NSZ1 = N1
  54.       SEGINI, INTESZ
  55.       DO 100 I1=1,NBS1
  56.         IMOD1 = MMODE1.KMODEL(I1)
  57.         DO 110 I2=1,NBS2
  58.           IF (INTESZ(I1).NE.0) GOTO 100
  59.           IMOD2 = MMODE2.KMODEL(I2)
  60.           IF (IMOD1.EQ.IMOD2) THEN
  61.             INTESZ(I1) = 1
  62.             INTESZ(NBS1+I2) = 1
  63.           ENDIF
  64.  110    CONTINUE
  65.  100  CONTINUE
  66.  
  67. *     write(6,*) 'INTESZ =',(INTESZ(ii),ii=1,NSZ1)
  68.  
  69. C Difference symetrique : union - intersection :
  70.       NBS0 = 0
  71.       DO 200 I1=1,NBS1
  72. *        write(6,*) 'MMODE1.KMODEL(I1) =',MMODE1.KMODEL(I1)
  73.         IF (INTESZ(I1).NE.0) GOTO 200
  74.         NBS0 = NBS0 + 1
  75.         KMODEL(NBS0) = MMODE1.KMODEL(I1)
  76.  200  CONTINUE
  77.  
  78.       DO 300 I2=1,NBS2
  79. *        write(6,*) 'MMODE2.KMODEL(I2) =',MMODE2.KMODEL(I2)
  80.         IF (INTESZ(NBS1+I2).NE.0) GOTO 300
  81.         NBS0 = NBS0 + 1
  82.         KMODEL(NBS0) = MMODE2.KMODEL(I2)
  83.  300  CONTINUE
  84.  
  85. C Ajustement segment MMODEL si besoin :
  86.       IF (NBS0.NE.N1) THEN
  87.         N1 = NBS0
  88.         SEGADJ, MMODEL
  89.       endif
  90.  
  91. C Ecriture resultat dans la pile :
  92.       CALL ECROBJ('MMODEL',MMODEL)
  93.  
  94.       RETURN
  95.       END
  96.  
  97.  
  98.  
  99.  
  100.  
  101.  
  102.  

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