C IDMAT2 SOURCE CHAT 12/06/07 21:15:24 7389 SUBROUTINE IDMAT2(IPMODE,ICARA,NUDIR1,NUMP1,NUMP2, 1 NUDIR2,NUMP3,ANG,IPCARA,RFLAG) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) *--------------------------------------------------------------------* * CREATION DU MCHAML CORRESPONDANT A UN MATERIAU ORTHOTROPE * * APPELE PAR MATCAR * *--------------------------------------------------------------------* * * * ENTREES: * * -------- * * * * IPMODE POINTEUR SUR UN MMODEL * * ICARA POINTEUR SUR UN MCHELM DE CARACTERISTIQUE (INCOMPLET) * * NUDIR1 NUMERO DE LA DIRECTIVE UTILISE:"DIRECTION"OU RADIAL" * * NUMP1 NUMERO DU POINT P1 ASSOCIE A LA DIRECTIVE NIDIR1 * * NUMP2 NUMERO DU POINT P2 ASSOCIE A LA DIRECTIVE NIDIR1 * * NUDIR2 NUMERO DE LA DIRECTIVE UTILISE "PARALLELE" "PERPENDIC"* * "INCLINE" * * NUMP3 NUMERO DU POINT P ASSOCIE A LA DIRECTIVE INCLINE * * ANG ANGLE UTILISE DANS LES DIRECTIONS D ORTHOTROPIE * * (EN RADIAN) * * * * * * SORTIES: * * -------- * * * * IPCARA POINTEUR SUR UN MCHELM MATERIAU * * * * * * AUTEUR JM CAMPENON LE 29 08 90 * * * * ANISOTROPIE DANS LES ELEMENTS MASSIFS, P. DOWLATYARI OCT. 90 * * * *--------------------------------------------------------------------* * -INC CCOPTIO -INC CCHAMP -INC SMCHAML -INC SMINTE -INC SMELEME -INC SMMODEL C SEGMENT INFO INTEGER INFELL(JG) ENDSEGMENT C SEGMENT XVAL REAL*8 CVAL(NPG2,NEL2),SVAL(NPG2,NEL2) ENDSEGMENT C SEGMENT YVAL REAL*8 VLOC1(IDIM,NPG2,NEL2),VLOC2(IDIM,NPG2,NEL2) ENDSEGMENT C INTEGER NUDIR1,NUMP1,NUMP2,NUDIR2,NUMP3 LOGICAL RFLAG REAL*8 ANG INTEGER NPG2,IPVAL PARAMETER ( NINF=3 ) INTEGER INFOS(NINF) CHARACTER*8 CMATE,CHARIN CHARACTER*(NCONCH) CONM C IPINF=0 IPINF2=0 C C ACTIVATION DU MCHELM C MCHEL2=ICARA SEGACT MCHEL2 C C CREATION DU MCHELM C N1=MCHEL2.ICHAML(/1) L1=16 N3=6 SEGINI MCHEL1 IPCARA=MCHEL1 MCHEL1.TITCHE=MCHEL2.TITCHE MCHEL1.IFOCHE=MCHEL2.IFOCHE C C BOUCLE SUR LES <> SOUS ZONES C MMODEL=IPMODE NSOUS=KMODEL(/1) C C DEBUT DE LA BOUCLE SUR LES DIFFERENTES SOUS ZONES C isous=0 DO 10 kSOUS=1,NSOUS IMODEL=KMODEL(kSOUS) if (nefmod.eq.22) go to 10 isous=isous+1 * AM 4/5/93 MINTE=0 C MCHEL1.IMACHE(ISOUS)=MCHEL2.IMACHE(ISOUS) MCHEL1.CONCHE(ISOUS)=MCHEL2.CONCHE(ISOUS) DO 1 I=1,N3 MCHEL1.INFCHE(ISOUS,I)=MCHEL2.INFCHE(ISOUS,I) 1 CONTINUE C IPMAIL=IMAMOD CONM =CONMOD NFOR=FORMOD(/2) NMAT=MATMOD(/2) C C DANS LE CAS DE CONVECTION ON NE REMPLIT PAS MATMOD, C ON SAUTE DONC CE CAS LA C iplc=0 iplr=0 IF(formod(1).eq.'THERMIQUE') then call place(matmod,nmat,iplc,'CONVECTION') call place(matmod,nmat,iplr,'RAYONNEMENT') endif MATE=1 IF (FORMOD(1).NE.'CONVECTION'.and.iplr+iplc.eq.0) THEN * CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT) MATE = IMATEE INAT = INATUU CMATE = CMATEE IF (CMATE.EQ.' ') THEN CALL ERREUR(251) RETURN ENDIF ENDIF C C COQUE INTEGREE OU PAS ? C IF(INFMOD(/1).NE.0)THEN NPINT=INFMOD(1) ELSE NPINT=0 ENDIF C_______________________________________________________________________ C C TRAITEMENT PARTICULIER POUR LES MATERIAU ORTHOTROPE OU ANISOT. C_______________________________________________________________________ C IF (MATE.EQ.2.OR.MATE.EQ.3.OR.MATE.EQ.4.OR.RFLAG)THEN MELE=NEFMOD MELEME=IPMAIL SEGACT MELEME NBELEM=NUM(/2) NBNN=NUM(/1) CALL IDENT (IPMAIL,CONM,ICARA,0,INFOS,IRTD) IF (IRTD.EQ.0) THEN SEGDES,MELEME,MCHEL2 SEGSUP,MCHEL1,INFO RETURN ENDIF C ITHER=0 IF(FORMOD(1).EQ.'THERMIQUE')ITHER=1 C C INFORMATION SUR L ELEMENT FINI C MFR =NUMMFR(MELE) C IF (MFR.EQ.75) THEN CALL ELQUOI(MELE,0,2,IPINF,IMODEL) IF (IERR.NE.0) THEN SEGDES,MELEME,MCHEL2 SEGSUP,MCHEL1 RETURN ENDIF INFO=IPINF NBPGAU = INFELL(6) * ELSE IF (MFR.EQ.1.OR.MFR.EQ.31) THEN NBPGAU=1 NLG=NUMGEO(MELE) CALL RESHPT (NBPGAU,NBNN,NLG,MELE,NPINT,IPT1,IRT1) MINTE=IPT1 ELSEIF(MFR.EQ.45)THEN NBPGAU=1 NLG=NUMGEO(MELE) SEGDES MELEME C on va récuperer le maillage des sommet pour le calcul C des fonctions de formes dans le cas DARCY CALL LEKMOD(MMODEL,IPTABL,INEFMD) CHARIN = 'MAILLAGE' CALL LEKTAB(IPTABL,CHARIN, IOBRE) IF (IERR.NE.0) RETURN IPT2 = IOBRE SEGACT IPT2 MELEME=IPT2 IF(IPT2.LISOUS(/1).NE.0)THEN MELEME= IPT2.LISOUS(ISOUS) SEGACT MELEME SEGDES IPT2 ENDIF NBNN=NUM(/1) CALL RESHPT (NBPGAU,NBNN,NLG,NLG,NPINT,IPT1,IRT1) MINTE=IPT1 ELSE IF(MFR.EQ.33)THEN * CALL ELQUOI(MELE,0,2,IPINF,IMODEL) IF (IERR.NE.0) THEN SEGDES,MELEME,MCHEL2 SEGSUP,MCHEL1 RETURN ENDIF * INFO=IPINF NBPGAU=1 * MINTE=INFELE(11) MINTE=INFMOD(4) ELSEIF(MFR.EQ.3.OR.MFR.EQ.9.OR.MFR.EQ.5.OR.MFR.EQ.35) THEN IF(ITHER.EQ.0)THEN if(infmod(/1).lt.5)then CALL ELQUOI(MELE,0,3,IPINF,IMODEL) IF (IERR.NE.0) THEN SEGDES,MELEME,MCHEL2 SEGSUP,MCHEL1 RETURN ENDIF INFO=IPINF NBPGAU=INFELL(6) MINTE=INFELL(11) MINTE1=INFELL(12) segsup info else NBPGAU=INFELE(6) MINTE=INFMOD(5) MINTE1=INFMOD(8) endif ELSE CALL TSHAPE(MELE,'GAUSS',IPT1) MINTE=IPT1 SEGACT,MINTE NBPGAU=POIGAU(/1) SEGDES MINTE IF(MFR.EQ.5)THEN CALL TSHAPE(MELE,'NOEUD',IPT2) MINTE1=IPT2 ELSE MINTE1=0 ENDIF ENDIF ENDIF * * CAS 'RADIAL' EN MASSIF * ON CHERCHE LES POINTS DE GAUSS * MINTE2=0 IF(NUDIR1.EQ.2.AND. . (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33.OR.MFR.EQ.45)) THEN melele=mele IF (MFR.EQ.45)melele=nlg if(infmod(/1).lt.5) then CALL ELQUOI(melele,0,3,IPINF2,IMODEL) IF (IERR.NE.0) THEN SEGDES,MELEME,MCHEL2 SEGSUP,MCHEL1 RETURN ENDIF INFO=IPINF2 MINTE2=INFELL(11) segsup info else minte2=infmod(5) endif SEGACT MINTE2 NBPGA2=MINTE2.POIGAU(/1) SEGDES MINTE2 ENDIF C C VERIFICATION DE LA COHERENCE DES INFORMATIONS C IF (MFR.EQ.3.AND.IDIM.NE.3) THEN IF (NUDIR1.NE.0.AND.NUDIR1.NE.1) THEN CALL ERREUR(21) GOTO 9990 ENDIF NUDIR1=1 IF (NUDIR2.EQ.3) THEN CALL ERREUR(21) GOTO 9990 ENDIF ELSE * IF (NUDIR1.EQ.0) THEN C DIRECTIONS D ORTHOTROPIE NON FOURNIES CALL ERREUR(346) GOTO 9990 ENDIF ENDIF IF (NUDIR2.EQ.0) THEN C OPTION PARALLELE PAR DEFAUT NUDIR2=1 ENDIF IF(MFR.EQ.35)THEN IF(NUDIR1.EQ.2)THEN * CETTE DEFINITION DU REPERE D'ORTH. N'EST PAS VALABLE POUR * LES ELEMENTS JOINTS (CAR ILS SONT PLANS) CALL ERREUR (523) GO TO 9990 ENDIF ENDIF C_______________________________________________________________________ C C_______________________________________________________________________ C MCHAM2=MCHEL2.ICHAML(ISOUS) SEGACT MCHAM2 NCOMP=MCHAM2.NOMCHE(/2) N2=NCOMP C C CREATION DU MCHAML : ON PREVOIT ICI QUE L'ON DOIT CREER 2 OU 6 C COMPOSANTES SUPPLEMENTAIRES C IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9.OR.MFR.EQ.35) THEN N2=NCOMP+2 ELSE IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33 & .OR.MFR.EQ.45.OR.MFR.EQ.75) THEN IF (IDIM.EQ.2) N2=NCOMP+2 IF (IDIM.EQ.3) N2=NCOMP+6 ENDIF SEGINI MCHAM1 MCHEL1.ICHAML(ISOUS)=MCHAM1 C C ON RECOPIE TOUS LES NOMS DE COMPOSANTE DE 1 A NCOMP C IPEPAI=0 IPEXCE=0 DO 100 ICOMP=1,NCOMP MCHAM1.NOMCHE(ICOMP)=MCHAM2.NOMCHE(ICOMP) MCHAM1.TYPCHE(ICOMP)=MCHAM2.TYPCHE(ICOMP) MELVA2=MCHAM2.IELVAL(ICOMP) IF(MFR.EQ.5)THEN IF(MCHAM2.NOMCHE(ICOMP).EQ.'EPAI')THEN IPEPAI=MELVA2 ELSEIF(MCHAM2.NOMCHE(ICOMP).EQ.'EXCE')THEN IPEXCE=MELVA2 ENDIF ENDIF SEGACT MELVA2 IF (MCHAM2.TYPCHE(ICOMP).EQ.'REAL*8') THEN N1PTEL=MELVA2.VELCHE(/1) N1EL =MELVA2.VELCHE(/2) N2PTEL=0 N2EL =0 C SEGINI MELVA1 MCHAM1.IELVAL(ICOMP)=MELVA1 DO 13 J=1,N1PTEL DO 13 K=1,N1EL MELVA1.VELCHE(J,K)=MELVA2.VELCHE(J,K) 13 CONTINUE ELSE N2PTEL=MELVA2.IELCHE(/1) N2EL =MELVA2.IELCHE(/2) N1PTEL=0 N1EL =0 SEGINI MELVA1 C MCHAM1.IELVAL(ICOMP)=MELVA1 DO 14 J=1,N2PTEL DO 14 K=1,N2EL MELVA1.IELCHE(J,K)=MELVA2.IELCHE(J,K) 14 CONTINUE ENDIF 100 CONTINUE IF(MFR.EQ.5.AND.IPEPAI.EQ.0)THEN *DANS LE CAS DES ELEMENTS COQUES EPAISSES ORTHOTROPES IL FAUT DONNER *L'EPAISSEUR EN MEME TEMPS QUE LES PROPRIETES MATERIELLES CALL ERREUR (526 ) DO 311 ICOMP=1,NCOMP MELVA2=MCHAM2.IELVAL(ICOMP) MELVA1=MCHAM1.IELVAL(ICOMP) SEGDES,MELVA2 SEGSUP,MELVA1 311 CONTINUE SEGDES MCHAM2 SEGSUP MCHAM1 GOTO 9990 ENDIF C_______________________________________________________________________ C C ON TRAITE ICI LES COMPOSANTES 'V1X' ET 'V1Y'POUR LES ELEMENTS C COQUES ET 'V1X','V1Y','V1Z','V2X','V2Y','V2Z' POUR LES MASSIF C_______________________________________________________________________ C C_______________________________________________________________________ C C -- TRAITEMENT PARTICULIER SELON LE TYPE DES ELEMENTS -- C_______________________________________________________________________ C C IF(MFR.EQ.3.OR.MFR.EQ.9.OR.MFR.EQ.35)THEN IF (NUDIR1.EQ.1) THEN NPG2=1 ENDIF IF (NUDIR1.EQ.2) THEN NPG2=NBPGAU ENDIF C IF (MELE.EQ.27.OR.MELE.EQ.28.OR.MELE.EQ.49.OR.MELE.EQ.93 . .OR.MELE.EQ.87.OR.MELE.EQ.88.OR.MELE.EQ.128) THEN ICALC=0 ELSE IF (MELE.EQ.44) THEN ICALC=1 ENDIF C_______________________________________________________________________ C C LE FLAG ICALC SERT A INDIQUER L OPTION DE CALCUL A CHOISIR C DANS LA ROUTINE IDMAT3 (IDEM MATEO2 ET COBIOR POUR MATE) C_______________________________________________________________________ C IPVAL=0 CALL IDMAT3 (NUDIR1,NUMP1,NUDIR2,NUMP3,ANG, 1 MELEME,MINTE,NPG2,ICALC,MFR,IPVAL) IF (IERR.NE.0) THEN DO 300 ICOMP=1,NCOMP MELVA2=MCHAM2.IELVAL(ICOMP) MELVA1=MCHAM1.IELVAL(ICOMP) SEGDES,MELVA2 SEGSUP,MELVA1 300 CONTINUE SEGDES MCHAM2 SEGSUP MCHAM1 GOTO 9990 ENDIF ELSEIF(MFR.EQ.5)THEN NPG2=NBPGAU IPVAL=0 CALL IDMAT5(NUDIR1,NUMP1,NUDIR2,NUMP3,ANG, 1 MELEME,MINTE,MINTE1,IPEPAI,IPEXCE,NPG2,ITHER,IPVAL) IF (IERR.NE.0) THEN DO 312 ICOMP=1,NCOMP MELVA2=MCHAM2.IELVAL(ICOMP) MELVA1=MCHAM1.IELVAL(ICOMP) SEGDES,MELVA2 SEGSUP,MELVA1 312 CONTINUE SEGDES MCHAM2 SEGSUP MCHAM1 GOTO 9990 ENDIF ELSE IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33.OR.MFR.EQ.45)THEN IPVAL=0 NPG2=1 IF(NUDIR1.EQ.2) NPG2=NBPGA2 CALL IDMAT4(NUMP1,NUMP2,NUDIR1,NUDIR2,ANG,MELEME,MINTE, . IPVAL,NPG2,MINTE2) IF (IERR.NE.0) THEN DO 310 ICOMP=1,NCOMP MELVA2=MCHAM2.IELVAL(ICOMP) MELVA1=MCHAM1.IELVAL(ICOMP) SEGDES,MELVA2 SEGSUP,MELVA1 310 CONTINUE SEGDES MCHAM2 SEGSUP MCHAM1 GOTO 9990 ENDIF ELSE IF (MFR.EQ.75)THEN IPVAL=0 NPG2=NBPGAU CALL IDMAT6(NUMP1,NUMP2,NUDIR1,NUDIR2,ANG,MELEME, . IPVAL,NPG2) IF (IERR.NE.0) THEN DO 375 ICOMP=1,NCOMP MELVA2=MCHAM2.IELVAL(ICOMP) MELVA1=MCHAM1.IELVAL(ICOMP) SEGDES,MELVA2 SEGSUP,MELVA1 375 CONTINUE SEGDES MCHAM2 SEGSUP MCHAM1 GOTO 9990 ENDIF ELSE MOTERR(5:8) = NOMTP(MELE) MOTERR(1:4) = 'ORTH' CALL ERREUR (71) DO 320 ICOMP=1,NCOMP MELVA2=MCHAM2.IELVAL(ICOMP) MELVA1=MCHAM1.IELVAL(ICOMP) SEGDES,MELVA2 SEGSUP,MELVA1 320 CONTINUE SEGDES MCHAM2 SEGSUP MCHAM1 GOTO 9990 ENDIF C IF (MFR.EQ.3 .OR.MFR.EQ.9.OR.MFR.EQ.5.OR.MFR.EQ.35 )THEN C C ON CREE LES COMPOSANTES V1X ET V1Y C IF (RFLAG) THEN MCHAM1.NOMCHE(N2-1 )='W1X ' MCHAM1.NOMCHE(N2 )='W1Y ' ELSE MCHAM1.NOMCHE(N2-1 )='V1X ' MCHAM1.NOMCHE(N2 )='V1Y ' ENDIF MCHAM1.TYPCHE(N2-1 )='REAL*8' MCHAM1.TYPCHE(N2 )='REAL*8' C C REMPLISSAGE DU SEGMENT MELVA1 CONTENANT LES COMPOSANTES C N1PTEL=NPG2 N1EL = NBELEM N2PTEL=0 N2EL =0 C XVAL=IPVAL SEGACT XVAL C SEGINI MELVA1 MCHAM1.IELVAL(N2-1)=MELVA1 DO 1110 IB=1,NBELEM DO 1110 IGAU=1,NPG2 IGMN=MIN(IGAU,MELVA1.VELCHE(/1)) IBMN=MIN(IB ,MELVA1.VELCHE(/2)) MELVA1.VELCHE(IGMN,IBMN)=CVAL(IGAU,IB) 1110 CONTINUE C SEGINI MELVA1 MCHAM1.IELVAL(N2)=MELVA1 DO 2110 IB=1,NBELEM DO 2110 IGAU=1,NPG2 IGMN=MIN(IGAU,MELVA1.VELCHE(/1)) IBMN=MIN(IB ,MELVA1.VELCHE(/2)) MELVA1.VELCHE(IGMN,IBMN)=SVAL(IGAU,IB) 2110 CONTINUE C SEGSUP XVAL ELSE IF(MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33 & .OR.MFR.EQ.45.OR.MFR.EQ.75)THEN C C ON CREE LES COMPOSANTES V1X,V1Y,V1Z, . . . C IF(IDIM.EQ.2)THEN NCOMPV=2 IF (RFLAG) THEN MCHAM1.NOMCHE(N2-1 )='W1X ' MCHAM1.NOMCHE(N2 )='W1Y ' ELSE MCHAM1.NOMCHE(N2-1 )='V1X ' MCHAM1.NOMCHE(N2 )='V1Y ' ENDIF C ELSEIF(IDIM.EQ.3)THEN NCOMPV=6 C IF (RFLAG) THEN MCHAM1.NOMCHE(N2-5 )='W1X ' MCHAM1.NOMCHE(N2-4 )='W1Y ' MCHAM1.NOMCHE(N2-3 )='W1Z ' MCHAM1.NOMCHE(N2-2 )='W2X ' MCHAM1.NOMCHE(N2-1 )='W2Y ' MCHAM1.NOMCHE(N2 )='W2Z ' ELSE MCHAM1.NOMCHE(N2-5 )='V1X ' MCHAM1.NOMCHE(N2-4 )='V1Y ' MCHAM1.NOMCHE(N2-3 )='V1Z ' MCHAM1.NOMCHE(N2-2 )='V2X ' MCHAM1.NOMCHE(N2-1 )='V2Y ' MCHAM1.NOMCHE(N2 )='V2Z ' ENDIF C ENDIF DO 200 ICOMP =1,NCOMPV MCHAM1.TYPCHE(N2-(NCOMPV-ICOMP))='REAL*8' 200 CONTINUE C C REMPLISSAGE DU SEGMENT MELVA1 CONTENANT LES COMPOSANTES C N1PTEL=NPG2 N1EL =NBELEM N2PTEL=0 N2EL =0 YVAL=IPVAL SEGACT YVAL C DO 210 ICOMP=1,NCOMPV SEGINI MELVA1 MCHAM1.IELVAL(N2-(NCOMPV-ICOMP))=MELVA1 DO 220 IB=1,NBELEM DO 230 IG=1,NPG2 IF(ICOMP.LE.3)THEN MELVA1.VELCHE(IG,IB)=VLOC1(ICOMP,IG,IB) ELSE MELVA1.VELCHE(IG,IB)=VLOC2((ICOMP-3),IG,IB) ENDIF 230 CONTINUE 220 CONTINUE 210 CONTINUE SEGSUP YVAL * ENDIF SEGDES MELEME * IF (IPINF.NE.0) THEN * INFO=IPINF * SEGSUP INFO * ENDIF * IF (IPINF2.NE.0) THEN * INFO=IPINF2 * SEGSUP INFO * ENDIF C C_______________________________________________________________________ C_______________________________________________________________________ C ELSE C C ON RECOPIE LE CHAMELEM ICARA DANS LE CHAMELEM IPCARA C DO 17 I=1,N3 MCHEL1.INFCHE(ISOUS,I)=MCHEL2.INFCHE(ISOUS,I) 17 CONTINUE C C ACTIVATION DU MCHAML C MCHAM2=MCHEL2.ICHAML(ISOUS) SEGACT MCHAM2 N2=MCHAM2.NOMCHE(/2) C SEGINI MCHAM1 MCHEL1.ICHAML(ISOUS)=MCHAM1 DO 2 ICOMP=1,N2 MCHAM1.NOMCHE(ICOMP)=MCHAM2.NOMCHE(ICOMP) MCHAM1.TYPCHE(ICOMP)=MCHAM2.TYPCHE(ICOMP) C C ACTIVATION DU MELVAL C MELVA2=MCHAM2.IELVAL(ICOMP) SEGACT MELVA2 IF (MCHAM2.TYPCHE(ICOMP).EQ.'REAL*8') THEN N1PTEL=MELVA2.VELCHE(/1) N1EL =MELVA2.VELCHE(/2) N2PTEL=0 N2EL =0 C SEGINI MELVA1 MCHAM1.IELVAL(ICOMP)=MELVA1 DO 5 J=1,N1PTEL DO 5 K=1,N1EL MELVA1.VELCHE(J,K)=MELVA2.VELCHE(J,K) 5 CONTINUE ELSE N2PTEL=MELVA2.IELCHE(/1) N2EL =MELVA2.IELCHE(/2) N1PTEL=0 N1EL =0 SEGINI MELVA1 C MCHAM1.IELVAL(ICOMP)=MELVA1 DO 4 J=1,N2PTEL DO 4 K=1,N2EL MELVA1.IELCHE(J,K)=MELVA2.IELCHE(J,K) 4 CONTINUE ENDIF 2 CONTINUE ENDIF C C DESACTIVATION DES SEGMENTS NCOMP2=MCHAM2.NOMCHE(/2) DO 330 ICOMP=1,NCOMP2 MELVA2=MCHAM2.IELVAL(ICOMP) SEGDES,MELVA2 330 CONTINUE NCOMP1=MCHAM1.NOMCHE(/2) DO 340 ICOMP=1,NCOMP1 MELVA1=MCHAM1.IELVAL(ICOMP) SEGDES,MELVA1 340 CONTINUE C SEGDES,MCHAM1,MCHAM2 C 10 CONTINUE C SEGDES,MCHEL1,MCHEL2 RETURN C C ERREUR DANS UNE SOUS ZONE DESACTIVATION ET RETOUR C 9990 CONTINUE SEGDES MELEME IF (MINTE.NE.0) SEGDES MINTE * IF (IPINF.NE.0) SEGSUP INFO SEGSUP MCHEL1 SEGDES MCHEL2 RETURN END