Numérotation des lignes :

C REDUIC    SOURCE    PV        20/03/26    21:16:19     10563                SUBROUTINE REDUIC ( IPCHE,IMEL,IRET)*______________________________________________________________________**             redu d'un chamelem sur meleme    (appele par redu)**    entrees :*    ---------*       ipche   chamelem a reduire (type mchaml)*       imel    maillage sur lequel on doit reduire (type meleme)***    sortie :*    --------*       iret    chamelem reduit*               = 0 si pb****______________________________________________________________________**                declarations*      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM-INC CCOPTIO -INC SMCHAML-INC SMELEME*      CHARACTER*(NCONCH) CONST**                    executable*      IRET = 0      CONST = ' '       MCHELM = IPCHE      SEGACT,MCHELM * Cas particulier du MCHAML vide :      NZ = IMACHE(/1)      IF (NZ.EQ.0) THEN        SEGINI,MCHEL1=MCHELM**      SEGDES MCHELM,MCHEL1        IRET = MCHEL1        RETURN      ENDIF       MELEME = IMEL      SEGACT MELEME      NBSOUS = LISOUS(/1)      IPT1 = IMEL**    boucle sur les maillages elementaires*      DO 100 I=1,(MAX(1,NBSOUS))        IF (NBSOUS .NE. 0) THEN           IPT1 = LISOUS(I)        ENDIF        CALL TESTMA(IPCHE,IPT1,.FALSE.,CONST,IRETOU,IMODI)*        IF(IRETOU.EQ.0.AND.IERR.EQ.0) THEN           CALL ERREUR(472)        ENDIF        MCHEL1 = IRETOU        IF (IERR .NE. 0) THEN              IF (IRETOU .NE. 0) THEN                SEGSUP MCHEL1              ENDIF              GOTO 990        ENDIF**    concatenation du resultat*         IF (I .EQ. 1) THEN             MCHELM = IRETOU             N1 = IMACHE(/1)             N3 = INFCHE(/2)             L1 = TITCHE(/1)         ELSE             MCHEL1 = IRETOU             NN1 = MCHEL1.IMACHE(/1)             N1 = N1 + NN1             N3 = MAX(N3,MCHEL1.INFCHE(/2))             SEGADJ MCHELM             DO 10 J=1,NN1               CONCHE(J+N1-NN1) = MCHEL1.CONCHE(J)               IMACHE(J+N1-NN1) = MCHEL1.IMACHE(J)               ICHAML(J+N1-NN1) = MCHEL1.ICHAML(J)               DO 20 K=1,MCHEL1.INFCHE(/2)                  INFCHE(J+N1-NN1,K)=MCHEL1.INFCHE(J,K)  20           CONTINUE  10         CONTINUE             SEGSUP MCHEL1         ENDIF* 100   CONTINUE*       IRET = MCHELM**     SEGDES,MCHELM* 990   CONTINUEC       MELEME = IMELC       MCHEL1 = IPCHEC       SEGDES,MELEME,MCHEL1*       RETURN       END

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