Numérotation des lignes :

quesup
C QUESUP    SOURCE    CB215821  24/04/12    21:17:00     11897                SUBROUTINE QUESUP (IPMODE,IPCHE1,ISUP,ICOND,IRET,IRET2)*______________________________________________________________________**         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                   CALL TSHAPE(MELE,'GAUSS',IPMIN1)                  ELSE                   If(infmod(/1).lt.2+isup1) then                     CALL ELQUOI(MELE,0,ISUP1,IPINF,IMODEL)                     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        CONTINUE11      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        CALL ERREUR(124)      ELSE**  LES DIFFERENTS SOUS-ZONES DU CHAMELEM ONT DES POINTS SUPPORTS DIFFERENTS*         CALL ERREUR(560)      ENDIF      IRET=9999      RETURN* 3000 CONTINUE**     IPCHE1 A UN POINTEUR SUR UN MINTE &lt;> 0 MAIS L'INFCHE(..,6)*     N'EST PAS RENSEIGNE (NE DOIT PAS ARRIVER NORMALEMENT)*      IRET=9999      CALL ERREUR(53)* 666  CONTINUE      END     

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