Télécharger la plaquette Cast3M


fr en

Télécharger ident.eso

Retour à la liste

Numérotation des lignes : 

ident

  1. C IDENT     SOURCE    CB215821  21/08/20    21:15:08     11089          
  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.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC SMCHAML
  28. *
  29.       INTEGER INFOS(*)
  30.       character*4 cnoha
  31.       integer*4   inoha
  32.       data cnoha/'NOHA'/
  33.       equivalence(cnoha,inoha)
  34.       CHARACTER*(*) CONM
  35. *
  36.       INFOS(1)=0
  37.       INFOS(2)=0
  38.       INFOS(3)=0
  39.       IFLAG=0
  40.       IRET =1
  41. *
  42.       IF (IFOUR.NE.1) THEN
  43.         INFOS(3)=NIFOUR
  44. *
  45.       ELSE IF (IPCHE2.EQ.0) THEN
  46.         MCHELM=IPCHE1
  47.         NSOUS1=IMACHE(/1)
  48.         DO 200 ISOUS=1,NSOUS1
  49.           IF (IPMAIL.EQ.IMACHE(ISOUS).AND.CONM.EQ.CONCHE(ISOUS))
  50.      $                                     GOTO 205
  51.  200    CONTINUE
  52.         CALL ERREUR(472)
  53.         IRET=0
  54.         GOTO 9999
  55. *
  56.  205    CONTINUE
  57.         NHRM  =INFCHE(ISOUS,3)
  58.         INFOS(3)=NHRM
  59. *
  60.       ELSE IF (IPCHE1.EQ.0) THEN
  61.         MCHELM=IPCHE2
  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.  
  75.       ELSE
  76.         MCHELM=IPCHE1
  77.         MCHEL1=IPCHE2
  78.         NSOUS1=IMACHE(/1)
  79.         NSOUS2=MCHEL1.IMACHE(/1)
  80. *
  81.         DO 100 ISOUS=1,NSOUS1
  82.           IF (IPMAIL.EQ.IMACHE(ISOUS).AND.CONM.EQ.CONCHE(ISOUS))
  83.      $                                     GOTO 105
  84.  100    CONTINUE
  85.         CALL ERREUR(472)
  86.         IRET=0
  87.         GOTO 9999
  88. *
  89.  105    CONTINUE
  90.         NHRM  =INFCHE(ISOUS,3)
  91. *
  92.         DO 110 JSOUS=1,NSOUS2
  93.           IF (IPMAIL.EQ.MCHEL1.IMACHE(JSOUS) .AND.
  94.      $          CONM.EQ.MCHEL1.CONCHE(JSOUS)) GOTO 120
  95.  110    CONTINUE
  96.         CALL ERREUR(472)
  97.         IRET=0
  98.         GOTO 9999
  99. *
  100.  120    CONTINUE
  101.         IF (NHRM.EQ.MCHEL1.INFCHE(JSOUS,3).OR.NHRM.EQ.INOHA.OR.
  102.      1      MCHEL1.INFCHE(JSOUS,3).EQ.INOHA) THEN
  103.           IF (IFLAG.EQ.0) THEN
  104.             IFLAG=1
  105.             INFOS(3)=NHRM
  106.           ELSE IF (NHRM.NE.INFOS(3)) THEN
  107.             CALL ERREUR(473)
  108.             IRET=0
  109.             GOTO 9999
  110.           ENDIF
  111.         ENDIF
  112.       ENDIF
  113. *
  114. 9999  RETURN
  115.       END
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  

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