Sources Esope | Cast3M

arcorc
C ARCORC    SOURCE    CB215821  20/11/25    13:18:22     10792          
      SUBROUTINE ARCORC (IPCHPT,REF)
 
***********************************************************************
*
*                          A R C O R C
*
* FONCTION:
* ---------
*
*     MISE A ZERO, S'ILS EXISTENT, DES ELEMENTS RELATIFS A UNE INCONNUE
*     'NOMDU'
*
*
* PARAMETRES:  (E)=ENTREE   (S)=SORTIE
* -----------
*
*     IPCHPT  ENTIER     (E/S)    CHPOINT DE TRAVAIL
*
*     REF     ENTIER     (E)      NUMERO DE L'INCONNUE A METTRE A ZERO
*
*
* SOUS-PROGRAMMES APPELES:
* ------------------------
*
*     ANCHPO
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL BOUDA     11 SEPTEMBRE 2015
*
* LANGAGE:
* --------
*
*     FORTRAN 77 & 90
*
***********************************************************************
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC CCHAMP
 
 
      INTEGER IPCHPT
      INTEGER REF
 
      INTEGER IINC
      INTEGER IPBUFF
      CHARACTER*(LOCOMP) MOC
 
      IINC=0
 
      MCHPOI=IPCHPT
      SEGACT MCHPOI
      NSOUPO=IPCHP(/1)
 
      DO 10 ISOUPO=1,NSOUPO
        MSOUPO= IPCHP(ISOUPO)
        SEGACT MSOUPO
        MPOVAL=IPOVAL
        SEGACT MPOVAL
        NC = NOCOMP(/2)
 
        DO 20 IC = 1,NC
          MOC=NOCOMP(IC)
          IF ( MOC .EQ. NOMDU(REF) ) THEN
            IINC=IINC+VPOCHA(/1)
          ENDIF
20      CONTINUE
10    CONTINUE
 
 
*Mise a zero des eventuels elments
      IF (IINC .NE. 0) THEN
        IPBUFF=IPCHPT
        CALL ANCHPO(IPBUFF,NOMDU(REF),IPCHPT)
      ENDIF
 
      END