Sources Esope | Cast3M

inccom
C INCCOM    SOURCE    GOUNAND   12/12/06    21:15:10     7593
      SUBROUTINE INCCOM(ICPRIB,ICPRIC,ICPRID,NIUNIQ,
     $     ICOPRI,
     $     IMPR,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : INCCOM
C DESCRIPTION : Construction de ICOPRI (LISTENTI), liste des inconnues
C      appartenant à la fois à ICPRIB,ICPRIC et ICPRID
C
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELE PAR       : PROMAT
C***********************************************************************
C ENTREES            : ICPRIB, ICPRIC, ICPRID, NIUNIQ
C SORTIES            : ICOPRI
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 31/01/2000, version initiale
C HISTORIQUE : v1, 31/01/2000, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
 
-INC PPARAM
-INC CCOPTIO
-INC SMLENTI
      INTEGER JG
      POINTEUR ICPRIB.MLENTI
      POINTEUR ICPRIC.MLENTI
      POINTEUR ICPRID.MLENTI
      POINTEUR ICOPRI.MLENTI
      POINTEUR MLEWRK.MLENTI
*      POINTEUR KRPRI.MLENTI
      SEGMENT KRPRI
      LOGICAL LPRI(NINCO,NSEG)
      ENDSEGMENT
* Liste de MLENTI
      INTEGER NBMLEN
      SEGMENT MLENTS
      POINTEUR LISMLE(NBMLEN).MLENTI
      ENDSEGMENT
      POINTEUR GPMLES.MLENTS
*
      INTEGER IMPR,IRET
      LOGICAL LTEST
*
      INTEGER IBMLEN,IGWRK,IIUNIQ
      INTEGER        NGWRK,NIUNIQ
      INTEGER NUPRI,NBPRI
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inccom.eso'
* Initialisation de la liste de MLENTI (ici, il y en a trois)
      NBMLEN=2
      IF (ICPRID.NE.0) THEN
         NBMLEN=NBMLEN+1
      ENDIF
      SEGINI GPMLES
      GPMLES.LISMLE(1)=ICPRIB
      GPMLES.LISMLE(2)=ICPRIC
      IF (ICPRID.NE.0) THEN
         GPMLES.LISMLE(3)=ICPRID
      ENDIF
* NIUNIQ est la dimension de l'espace des noms d'inconnues
*      JG=NIUNIQ
*      SEGINI KRPRI
      NINCO=NIUNIQ
      NSEG=NBMLEN
      SEGINI KRPRI
      DO 2 IBMLEN=1,NBMLEN
         MLEWRK=GPMLES.LISMLE(IBMLEN)
         SEGACT MLEWRK
         NGWRK=MLEWRK.LECT(/1)
         DO 22 IGWRK=1,NGWRK
            NUPRI=MLEWRK.LECT(IGWRK)
*            KRPRI.LECT(NUPRI)=KRPRI.LECT(NUPRI)+1
            KRPRI.LPRI(NUPRI,IBMLEN)=.TRUE.
 22      CONTINUE
         SEGDES MLEWRK
 2    CONTINUE
      SEGSUP GPMLES
      JG=0
      SEGINI ICOPRI
      DO 3 IIUNIQ=1,NIUNIQ
         LTEST=.TRUE.
         DO ISEG=1,NSEG
            LTEST=LTEST.AND.KRPRI.LPRI(IIUNIQ,ISEG)
         ENDDO
*         NBPRI=KRPRI.LECT(IIUNIQ)
*         IF (NBPRI.EQ.NBMLEN) THEN
         IF (LTEST) ICOPRI.LECT(**)=IIUNIQ
*         ENDIF
 3    CONTINUE
      SEGDES ICOPRI
      SEGSUP KRPRI
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine inccom'
      RETURN
*
* End of subroutine INCCOM
*
      END