Télécharger difmod.eso

Retour à la liste

Numérotation des lignes :

  1. C DIFMOD SOURCE PASCAL 20/04/01 21:15:29 10568
  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(I2).NE.0) GOTO 110
  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.  

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