Télécharger ident.eso

Retour à la liste

Numérotation des lignes :

  1. C IDENT SOURCE PV 17/06/16 14:33:46 9460
  2. SUBROUTINE IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRET)
  3. *--------------------------------------------------------------------*
  4. * *
  5. * Verfication de compatibilit{ de MCHAML du point de vue des *
  6. * tableaux INFCHE et creation du tableau INFOS pour COMCHA *
  7. * *
  8. * *
  9. * Entr{es: *
  10. * *
  11. * IPMAIL Pointeur de la sous zone consid{r{e *
  12. * CONM NOM DU CONSTITUANT *
  13. * IPCHE1 Pointeur sur un MCHAML *
  14. * IPCHE2 Pointeur sur un MCHAML *
  15. * *
  16. * Sorties: *
  17. * *
  18. * INFOS tableau de INFCHE a injecter dans COMCHA *
  19. * IRET 1 si compatibles, 0 sinon *
  20. * *
  21. *--------------------------------------------------------------------*
  22. *
  23. IMPLICIT INTEGER(I-N)
  24. -INC CCOPTIO
  25. -INC SMCHAML
  26. *
  27. INTEGER INFOS(*)
  28. character*4 cnoha
  29. integer*4 inoha
  30. data cnoha/'NOHA'/
  31. equivalence(cnoha,inoha)
  32. CHARACTER*(*) CONM
  33. *
  34. INFOS(1)=0
  35. INFOS(2)=0
  36. INFOS(3)=0
  37. IFLAG=0
  38. IRET =1
  39. *
  40. IF (IFOUR.NE.1) THEN
  41. INFOS(3)=NIFOUR
  42. *
  43. ELSE IF (IPCHE2.EQ.0) THEN
  44. MCHELM=IPCHE1
  45. SEGACT MCHELM
  46. NSOUS1=IMACHE(/1)
  47. DO 200 ISOUS=1,NSOUS1
  48. IF (IPMAIL.EQ.IMACHE(ISOUS).AND.CONM.EQ.CONCHE(ISOUS))
  49. $ GOTO 205
  50. 200 CONTINUE
  51. CALL ERREUR(472)
  52. IRET=0
  53. GOTO 9999
  54. *
  55. 205 CONTINUE
  56. NHRM =INFCHE(ISOUS,3)
  57. INFOS(3)=NHRM
  58. *
  59. ELSE IF (IPCHE1.EQ.0) THEN
  60. MCHELM=IPCHE2
  61. SEGACT MCHELM
  62. NSOUS1=IMACHE(/1)
  63. DO 300 ISOUS=1,NSOUS1
  64. IF (IPMAIL.EQ.IMACHE(ISOUS).AND.CONM.EQ.CONCHE(ISOUS))
  65. $ GOTO 305
  66. 300 CONTINUE
  67. CALL ERREUR(472)
  68. IRET=0
  69. GOTO 9999
  70. *
  71. 305 CONTINUE
  72. NHRM =INFCHE(ISOUS,3)
  73. INFOS(3)=NHRM
  74. ELSE
  75. MCHELM=IPCHE1
  76. SEGACT MCHELM
  77. MCHEL1=IPCHE2
  78. SEGACT MCHEL1
  79. NSOUS1=IMACHE(/1)
  80. NSOUS2=MCHEL1.IMACHE(/1)
  81. *
  82. DO 100 ISOUS=1,NSOUS1
  83. IF (IPMAIL.EQ.IMACHE(ISOUS).AND.CONM.EQ.CONCHE(ISOUS))
  84. $ GOTO 105
  85. 100 CONTINUE
  86. CALL ERREUR(472)
  87. IRET=0
  88. GOTO 9999
  89. *
  90. 105 CONTINUE
  91. NHRM =INFCHE(ISOUS,3)
  92. *
  93. DO 110 JSOUS=1,NSOUS2
  94. IF (IPMAIL.EQ.MCHEL1.IMACHE(JSOUS) .AND.
  95. $ CONM.EQ.MCHEL1.CONCHE(JSOUS)) GOTO 120
  96. 110 CONTINUE
  97. CALL ERREUR(472)
  98. IRET=0
  99. GOTO 9999
  100. *
  101. 120 CONTINUE
  102. IF (NHRM.EQ.MCHEL1.INFCHE(JSOUS,3).OR.NHRM.EQ.INOHA.OR.
  103. 1 MCHEL1.INFCHE(JSOUS,3).EQ.INOHA) THEN
  104. IF (IFLAG.EQ.0) THEN
  105. IFLAG=1
  106. INFOS(3)=NHRM
  107. ELSE IF (NHRM.NE.INFOS(3)) THEN
  108. CALL ERREUR(473)
  109. IRET=0
  110. GOTO 9999
  111. ENDIF
  112. ENDIF
  113. ENDIF
  114. *
  115. 9999 RETURN
  116. END
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  

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