quesup
C QUESUP SOURCE CB215821 20/07/29 21:16:08 10668 *______________________________________________________________________ * * VERIFICATION DU LIEU SUPPORT DES MCHAML * * IPMODE POINTEUR SUR UN OBJET MODELE (UTILISE UNIQUEMENT QUAND ISUP>0) * DESACTIVE EN SORTIE * IPCHE1 POINTEUR SUR LE MCHAML DONT ON SOUHAITE VERIFIER LE SUPPORT * (LIEU DU MINTE) * ISUP > 0 : * * ISUP = 1 ON SOUHAITE QUE IPCHE1 SOIT AUX NOEUDS * = 2 ON SOUHAITE QUE IPCHE1 SOIT AUX CENTRE DE GRAVITE * = 3 ON SOUHAITE QUE IPCHE1 SOIT AUX POINTS DE GAUSS POUR * LA RIGIDITE * = 4 ON SOUHAITE QUE IPCHE1 SOIT AUX POINTS DE GAUSS POUR * LA MASSE * = 5 ON SOUHAITE QUE IPCHE1 SOIT AUX POINTS DE GAUSS POUR * LES CONTRAINTES * ISUP = 0 ON VEUDRAIT CONNAITRE LE SUPPORT * * ICOND = 0 SI LE MCHAML PEUT ETRE SUR LE SUPPORT DEMANDE OU AUX * NOEUDS(UTILISE UNIQUEMENT QUAND ISUP >0) * 1 SI LE MCHAML DOIT ETRE IMPERATIVEMENT SUR LE SUPPORT * VOULU (CAS NOTAMENT DES MATRICE DE HOOKES ET DES * DES MATRICES DE HOOKES TANGENTES) * DANS LE CAS ISUP > 0 * * IRET = 1 IPCHE1 SE TROUVE AUX NOEUDS * = 0 IPCHE1 EST BIEN SUR LE SUPPORT DEMANDE * = 9999 LE SUPPORT DE UNE OU PLUSIEURS SOUS ZONE N'EST * PAS LE BON * DANS LE CAS ISUP = 0 * * IRET > 0 IL DONNE LE NUMERO DU SUPPORT * = 0 LE CHAMP EST CONSTANT * = 9999 LE CHAMELEM N'EST PAS HOMOGENE AU NIVEAU SUPPORT * * DANS TOUS LES CAS (ISUP >= 0) * * IRET2 > 0 IL DONNE LE NUMERO DU SUPPORT * = 9999 LE CHAMELEM N'EST PAS HOMOGENE AU NIVEAU SUPPORT * OU SI LE TABLEAU INFCHE NE CONTIENT PAS CETTE * INFORMATION * * REMARQUE : SI IPCHE1 EST AUX NOEUDS LE PASSAGE DES VALEURS SUR LE * SUPPORT VOULU SE FAIT DANS VALCHE ET/OU VALMEL SAUF DANS * LE CAS DES MATRICE DE HOOKES * * CAMPENON JM LE 02/91 * *pv on ne desactivee pas car ca va resservir tres bientot * *_______________________________________________________________________ * IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMCHAML -INC SMINTE -INC SMMODEL * SEGMENT INFO INTEGER INFELL(JG) ENDSEGMENT * CHARACTER*(NCONCH) CONCH *--------- Fin des déclarations ---------------------- IRET=0 IRET2=0 ICONST=1 * MCHELM=IPCHE1 NSOUS=ICHAML(/1) N3=INFCHE(/2) * * Recherche de l'information sur le support stockée dans INFCHE(*,6) ... * IF(N3.GE.6) THEN IRET2=INFCHE(1,6) DO 9 ISOUS=2,NSOUS IF(INFCHE(ISOUS,6).NE.IRET2) IRET2=9999 9 CONTINUE ELSE IRET2=9999 ENDIF * * si le chamelem est constant sur l'element quelque soit le * support demande on est bon * DO 10 ISOUS=1,NSOUS MCHAML=ICHAML(ISOUS) NCOMP=IELVAL(/1) DO 20 ICOMP=1,NCOMP MELVAL=IELVAL(ICOMP) IF(MELVAL.NE.0)THEN IF(TYPCHE(ICOMP)(1:8).NE.'POINTEUR')THEN IPOIN=VELCHE(/1) ELSE IPOIN=IELCHE(/1) ENDIF IF(IPOIN.NE.1)THEN ICONST=0 GOTO 500 ENDIF ENDIF 20 CONTINUE 10 CONTINUE * 500 CONTINUE IF (N3.LT.4) GOTO 1000 IF(N3.GE.6) THEN ISUP1=INFCHE(1,6) IF (ICONST.EQ.1) GOTO 666 ELSE GOTO 3000 ENDIF * IFLAG=0 * * CAS ISUP = 0 * ------------ * IF(ISUP.EQ.0)THEN IF(N3.GE.6)ISUP1=INFCHE(1,6) DO 1 ISOUS=1,NSOUS * write (6,*) ' isous n3 infche4 ',isous,n3,infche(isous,4) IF (INFCHE(ISOUS,4).EQ.0) GOTO 1 IF (N3.GE.6) THEN INFCH=INFCHE(ISOUS,6) * write (6,*) ' infch isup1 ',infch,isup1 IF (INFCH.EQ.1) GOTO 1 IF (INFCH.NE.ISUP1) THEN MINTE=INFCHE(1,4) MINTE1=INFCHE(ISOUS,4) NBPGAU=POIGAU(/1) NBPGA1=MINTE1.POIGAU(/1) IF(NBPGAU.EQ.NBPGA1)THEN IFLAG=IFLAG+1 ELSE GOTO 2000 ENDIF ELSE IFLAG=IFLAG+1 ENDIF ELSE GOTO 3000 ENDIF 1 CONTINUE * * TOUTES LES SOUS ZONES DOIVENT ETRE SUR LE BON SUPPORT * IF (IFLAG.EQ.0) GOTO 1000 IF (IFLAG.EQ.NSOUS) THEN IF(ISUP.EQ.0) THEN IRET=ISUP1 ENDIF GOTO 666 ELSE GOTO 2000 ENDIF * * CAS ISUP > 0 * ------------ * DANS CE CAS CE SONT LES ZONES DU MODELE QUI PILOTENT * ELSE ISUP1=ISUP * * ACTIVATION DU MODELE * MMODEL=IPMODE NSOUM =KMODEL(/1) INBR =0 DO 11 ISOUM=1,NSOUM IMODEL=KMODEL(ISOUM) MELE =NEFMOD if ((mele.eq.22).or.(mele.eq.259)) then goto 11 endif * * BOUCLE SUR LES ZONES DU CHAMELEM * DO 2 ISOUS=1,NSOUS CONCH =CONCHE(ISOUS) IPMAIL=IMACHE(ISOUS) * write (6,*) ' isous,imamod ipmail conch conmod infche4 ', * > isous,imamod,ipmail,conch,conmod,infche(isous,4) IF(IMAMOD.NE.IPMAIL.OR.CONCH.NE.CONMOD)GOTO 2 IF(INFCHE(ISOUS,4).EQ.0) GOTO 2 * IF (N3.GE.6) THEN INFCH=INFCHE(ISOUS,6) IF (INFCH.EQ.1) GOTO 2 INBR = INBR + 1 IF (INFCH.NE.ISUP1) THEN IF(ISUP1.EQ.6)THEN ELSE If(infmod(/1).lt.2+isup1) then IF(IERR.NE.0) THEN IRET=9999 GOTO 666 ENDIF INFO=IPINF IPMIN1=INFELL(11) segsup info else ipmin1=infmod(2+isup1) endif ENDIF MINTE=INFCHE(ISOUS,4) MINTE1=IPMIN1 NBPGAU=POIGAU(/1) NBPGA1=MINTE1.POIGAU(/1) IF(NBPGAU.EQ.NBPGA1)THEN IRT=1 ELSE IRT=0 ENDIF IF(IRT.EQ.1)THEN IFLAG=IFLAG+1 ELSE GOTO 2000 ENDIF ELSE IFLAG=IFLAG+1 ENDIF ELSE GOTO 3000 ENDIF 2 CONTINUE 11 CONTINUE * * TOUTES LES SOUS ZONES DOIVENT ETRE SUR LE BON SUPPORT * * write (6,*) ' quesup iflag isup nsous ',iflag,isup,nsous IF (IFLAG.EQ.0) GOTO 1000 IF (IFLAG.EQ.INBR) THEN IF(ISUP.EQ.0) THEN IRET=ISUP1 ENDIF GOTO 666 ELSE GOTO 2000 ENDIF ENDIF * 1000 CONTINUE * * IPCHE1 EST AUX NOEUDS * IRET=1 IF (ISUP.EQ.1) IRET=0 IF (ICOND.EQ.1.AND.IRET.EQ.1.AND.ISUP.NE.0) GOTO 2000 GOTO 666 * 2000 CONTINUE * IF(ISUP.NE.0)THEN * * IPCHE1 EST SUR UN AUTRE SUPPORT QUE CELUI VOULU ET PAS AUX NOEUDS * * ==> MESSAGE D'ERREUR POUR QUE L'ON DONNE LE CHAMELEM SUR UN * SUPPORT CORRECT * MOTERR(1:8)=TITCHE ELSE * * LES DIFFERENTS SOUS-ZONES DU CHAMELEM ONT DES POINTS SUPPORTS DIFFERENTS * ENDIF IRET=9999 RETURN * 3000 CONTINUE * * IPCHE1 A UN POINTEUR SUR UN MINTE <> 0 MAIS L'INFCHE(..,6) * N'EST PAS RENSEIGNE (NE DOIT PAS ARRIVER NORMALEMENT) * IRET=9999 * 666 CONTINUE END
© Cast3M 2003 - Tous droits réservés.
Mentions légales