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    OF166741  26/02/19    21:15:01     12437          
  2.  
  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   MAILLAGE de la sous zone consideree                *
  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 KOMCHA           *
  19. *        IRET     1 si donnees compatibles, 0 sinon                  *
  20. *                                                                    *
  21. *--------------------------------------------------------------------*
  22.       SUBROUTINE IDENT(IPMAIL,CONM,IPCHE1,IPCHE2, INFOS,IRET)
  23.  
  24.       IMPLICIT INTEGER(I-N)
  25.       IMPLICIT REAL*8 (A-H,O-Z)
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29.  
  30. -INC SMCHAML
  31.  
  32.       INTEGER INFOS(*)
  33.       CHARACTER*(*) CONM
  34.  
  35.       CHARACTER*4 cnoha
  36.       INTEGER*4   inoha
  37.       DATA cnoha/'NOHA'/
  38.       EQUIVALENCE(cnoha,inoha)
  39.  
  40.       INFOS(1) = 0
  41.       INFOS(2) = 0
  42.       INFOS(3) = 0
  43.       IRET = 1
  44.  
  45. * Cas general :
  46.       IF (IFOUR.NE.1) THEN
  47.         INFOS(3) = NIFOUR
  48.  
  49. * Cas particulier (IFOUR = 1) :
  50.       ELSE
  51.         NHRM1 = 0
  52.         NHRM2 = 0
  53.  
  54.         IF (IPCHE1.NE.0) THEN
  55.           mchelm = IPCHE1
  56.           NSOUS = mchelm.IMACHE(/1)
  57.           DO IS = 1, NSOUS
  58.             IF (IPMAIL.EQ. mchelm.IMACHE(IS) .AND.
  59.      &          CONM  .EQ. mchelm.CONCHE(IS)) THEN
  60.               NHRM1 = mchelm.INFCHE(IS,3)
  61.               GOTO 105
  62.             ENDIF
  63.           ENDDO
  64.           IRET = 0
  65.           CALL ERREUR(472)
  66.           RETURN
  67.  105      CONTINUE
  68.         ENDIF
  69.  
  70.         IF (IPCHE2.NE.0) THEN
  71.           mchelm = IPCHE2
  72.           NSOUS = mchelm.IMACHE(/1)
  73.           DO IS = 1, NSOUS
  74.             IF (IPMAIL.EQ. mchelm.IMACHE(IS) .AND.
  75.      &          CONM  .EQ. mchelm.CONCHE(IS)) THEN
  76.               NHRM2 = mchelm.INFCHE(IS,3)
  77.               GOTO 205
  78.             ENDIF
  79.           ENDDO
  80.           IRET = 0
  81.           CALL ERREUR(472)
  82.           RETURN
  83.   205     CONTINUE
  84.         ENDIF
  85.  
  86.         IF ((IPCHE1.NE.0) .AND. (IPCHE2.NE.0)) THEN
  87.           IF (NHRM1.EQ.NHRM2 .OR. 
  88.      &        NHRM1.EQ.INOHA .OR. NHRM2.EQ.INOHA) THEN
  89.             INFOS(3) = NHRM1
  90.           ENDIF
  91.         ELSE IF (IPCHE1.NE.0) THEN
  92.           INFOS(3) = NHRM1
  93.         ELSE IF (IPCHE2.NE.0) THEN
  94.           INFOS(3) = NHRM2
  95.         ELSE
  96.           write(ioimp,*) 'IDENT : IFOUR = 1 & IPCHE1 = IPCHE2 = 0 !'
  97.           call erreur(5)
  98.         ENDIF
  99.  
  100.       ENDIF
  101.  
  102.       RETURN
  103.       END
  104.  
  105.  
  106.  

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