Télécharger la plaquette Cast3M


fr en

Télécharger quesup.eso

Retour à la liste

Numérotation des lignes : 

quesup

  1. C QUESUP    SOURCE    MB234859  25/09/08    21:16:03     12358          
  2.  
  3. *______________________________________________________________________
  4. *
  5. *         VERIFICATION DU LIEU SUPPORT DES MCHAML
  6. *
  7. *   IPMODE  POINTEUR SUR UN OBJET MODELE (UTILISE UNIQUEMENT QUAND ISUP>0)
  8. *           ACTIF EN ENTREE ACTIF EN SORTIE
  9. *   IPCHE1  POINTEUR SUR LE MCHAML DONT ON SOUHAITE VERIFIER LE SUPPORT
  10. *
  11. *   ISUP = 0 ON VEUT CONNAITRE LE SUPPORT
  12. *   ISUP > 0 :
  13. *   ISUP    = 1 ON SOUHAITE QUE IPCHE1 SOIT AUX NOEUDS
  14. *           = 2 ON SOUHAITE QUE IPCHE1 SOIT AUX CENTRE DE GRAVITE
  15. *           = 3 ON SOUHAITE QUE IPCHE1 SOIT AUX POINTS DE GAUSS POUR
  16. *               LA RIGIDITE
  17. *           = 4 ON SOUHAITE QUE IPCHE1 SOIT AUX POINTS DE GAUSS POUR
  18. *               LA MASSE
  19. *           = 5 ON SOUHAITE QUE IPCHE1 SOIT AUX POINTS DE GAUSS POUR
  20. *               LES CONTRAINTES
  21. *
  22. *   ICOND   = 0 SI LE MCHAML PEUT ETRE SUR LE SUPPORT DEMANDE OU AUX
  23. *               NOEUDS (UTILISE UNIQUEMENT QUAND ISUP >0)
  24. *             1 SI LE MCHAML DOIT ETRE IMPERATIVEMENT SUR LE SUPPORT
  25. *               VOULU (CAS NOTAMENT DES MATRICE DE HOOKES ET DES
  26. *               DES MATRICES DE HOOKES TANGENTES)
  27. *
  28. *   DANS LE CAS ISUP > 0
  29. *   IRET    = 1   IPCHE1 SE TROUVE AUX NOEUDS
  30. *           = 0   IPCHE1 EST BIEN SUR LE SUPPORT DEMANDE
  31. *           = 9999 LE SUPPORT DE UNE OU PLUSIEURS SOUS ZONE N'EST
  32. *                   PAS LE BON
  33. *   DANS LE CAS ISUP = 0
  34. *   IRET    > 0   IL DONNE LE NUMERO DU SUPPORT
  35. *           = 0   LE CHAMP EST CONSTANT
  36. *           = 9999 LE CHAMELEM N'EST PAS HOMOGENE AU NIVEAU SUPPORT
  37. *   DANS TOUS LES CAS (ISUP >= 0)
  38. *   IRET2   > 0   IL DONNE LE NUMERO DU SUPPORT
  39. *           = 9999 LE CHAMELEM N'EST PAS HOMOGENE AU NIVEAU SUPPORT
  40. *                  OU SI LE TABLEAU INFCHE NE CONTIENT PAS CETTE
  41. *                  INFORMATION
  42. *
  43. *   REMARQUE : SI IPCHE1 EST AUX NOEUDS LE PASSAGE DES VALEURS SUR LE
  44. *              SUPPORT VOULU SE FAIT DANS VALCHE ET/OU VALMEL SAUF DANS
  45. *              LE CAS DES MATRICE DE HOOKE
  46. *_______________________________________________________________________
  47.  
  48.       SUBROUTINE QUESUP (IPMODE,IPCHE1,ISUP,ICOND,IRET,IRET2)
  49.  
  50.       IMPLICIT INTEGER(I-N)
  51.       IMPLICIT REAL*8(A-H,O-Z)
  52.  
  53. -INC PPARAM
  54. -INC CCOPTIO
  55.  
  56. -INC SMCHAML
  57. -INC SMINTE
  58. -INC SMMODEL
  59.  
  60.       CHARACTER*(NCONCH) CONCH
  61.  
  62. *--------- Fin des declarations ----------------------
  63.  
  64.       IRET  = 0
  65.       IRET2 = 9999
  66.  
  67.       MCHELM = IPCHE1
  68.       NSOUS = mchelm.ICHAML(/1)
  69.       N3    = mchelm.INFCHE(/2)
  70.  
  71. *OF : Pour eviter de se poser la question de N3<6 a ce jour.
  72.       IF (N3.LT.6) THEN
  73.         write(ioimp,*) 'QUESUP INFCHE(.,N3) N3<6 : N3=',N3,'!'
  74.         call erreur(5)
  75.         return
  76.       ENDIF
  77. *DBG**OF A partir d'ici N3 est forcement plus grand que 6 !
  78.  
  79. *  Recherche de l'information sur le support stockee dans INFCHE(*,6) ...
  80. *  Si NSOUS = 0, champ considere constant avec le support recherche !
  81.       IF (NSOUS.GT.0) THEN
  82.         ISUPC = mchelm.INFCHE(1,6)
  83.         IRET2 = ISUPC
  84.         DO ISOUS = 2, NSOUS
  85.           IF (mchelm.INFCHE(ISOUS,6).NE.ISUPC) IRET2 = 9999
  86.         ENDDO
  87.       ELSE
  88.         ISUPC = ISUP
  89.         IRET2 = ISUPC
  90.       ENDIF
  91.       ISUP1 = ISUPC
  92.  
  93. *   si le champ est constant sur l'element quelque soit le
  94. *   support demande, on est bon
  95.       ICONST = 1
  96.       DO ISOUS = 1, NSOUS
  97.         MCHAML = mchelm.ICHAML(ISOUS)
  98.         NCOMP  = mchaml.IELVAL(/1)
  99.         DO ICOMP = 1, NCOMP
  100.           MELVAL = mchaml.IELVAL(ICOMP)
  101.           IF (MELVAL.NE.0) THEN
  102.             IF (mchaml.TYPCHE(ICOMP)(1:8).NE.'POINTEUR') THEN
  103.               iflag = melval.VELCHE(/1)
  104.             ELSE
  105.               iflag = melval.IELCHE(/1)
  106.             ENDIF
  107.             IF (iflag.NE.1) ICONST = 0
  108.           ENDIF
  109.         ENDDO
  110.       ENDDO
  111.  
  112.       IF (ICONST.EQ.1) GOTO 666
  113.  
  114.       IFLAG = 0
  115. *
  116. *   CAS ISUP = 0
  117. *   ------------
  118.       IF (ISUP.EQ.0) THEN
  119. * On a deja :       ISUP1 = ISUPC = mchelm.INFCHE(1,6)
  120.         MINTE  = mchelm.INFCHE(1,4)
  121.         IF (MINTE.NE.0) NBPGAU = minte.POIGAU(/1)
  122.         DO ISOUS = 1, NSOUS
  123.           INFCH1 = mchelm.INFCHE(ISOUS,6)
  124.           MINTE1 = mchelm.INFCHE(ISOUS,4)
  125.           IF (INFCH1.EQ.1) GOTO 10
  126.           IF (MINTE1.EQ.0) GOTO 10
  127.           IF (INFCH1.NE.ISUPC) THEN
  128.             IF (MINTE.NE.MINTE1) THEN
  129.               NBPGA1 = MINTE1.POIGAU(/1)
  130.               IF (NBPGAU.NE.NBPGA1) GOTO 2000
  131.             ENDIF
  132.           ENDIF
  133.           IFLAG=IFLAG+1
  134.  10       CONTINUE
  135.         ENDDO
  136. *
  137. *       TOUTES LES SOUS ZONES DOIVENT ETRE SUR LE BON SUPPORT
  138. *
  139.         IF (IFLAG.EQ.0) GOTO 1000
  140.         IF (IFLAG.NE.NSOUS) GOTO 2000
  141.         IRET = ISUPC
  142.         GOTO 666
  143. *
  144. *    CAS ISUP > 0
  145. *    ------------
  146. *    DANS CE CAS CE SONT LES ZONES DU MODELE QUI PILOTENT
  147.       ELSE
  148.         ISUP1 = ISUP
  149. * Cas particulier pour certaines formulations :
  150.         IF (ISUPC.EQ.6) THEN
  151.           IF (ISUP.GE.3) ISUP1 = 6
  152.         ENDIF
  153.  
  154. * On suppose que le modele est "mono-formulation"...
  155.         MMODEL = IPMODE
  156.         NSOUM  = mmodel.KMODEL(/1)
  157.         INBR   = 0
  158.         DO ISOUM = 1, NSOUM
  159.           IMODEL = mmodel.KMODEL(ISOUM)
  160.           MELE   = imodel.NEFMOD
  161.           IF (MELE.EQ.22 .OR. MELE.EQ.259) GOTO 21
  162.  
  163.           IF (ISUP1.EQ.6) THEN
  164.             CALL TSHAPE(MELE,'GAUSS',IPMIN1)
  165.           ELSE
  166.       if (imodel.INFMOD(/1).LT.7) THEN
  167. **        write(ioimp,*) 'QUESUP : INFMOD(/1) < 8',infmod(/1),2+ISUP1
  168. **        call erreur(5)
  169.       endif
  170.             IPMIN1 = imodel.INFMOD(2+ISUP1)
  171.           ENDIF
  172.           MINTE1 = IPMIN1
  173.           NBPGA1 = MINTE1.POIGAU(/1)
  174. *
  175. *         BOUCLE SUR LES ZONES DU CHAMELEM
  176. *
  177.           DO ISOUS=1,NSOUS
  178.  
  179.             IPMAIL = mchelm.IMACHE(ISOUS)
  180.             IF (IPMAIL.NE.imodel.IMAMOD) GOTO 20
  181.             CONCH = mchelm.CONCHE(ISOUS)
  182.             IF (CONCH.NE.imodel.CONMOD) GOTO 20
  183.  
  184.             INFCH = mchelm.INFCHE(ISOUS,6)
  185.             IF (INFCH.EQ.1) GOTO 20
  186.  
  187.             MINTE = mchelm.INFCHE(ISOUS,4)
  188.             IF (MINTE.EQ.0) GOTO 20
  189.  
  190.             IF (INFCH.NE.ISUP1) THEN
  191.               IF (MINTE.NE.MINTE1) THEN
  192.                 NBPGAU = minte.POIGAU(/1)
  193.                 IF (NBPGAU.NE.NBPGA1) GOTO 2000
  194.               ENDIF
  195.             ENDIF
  196.  
  197.             IFLAG = IFLAG + 1
  198.             INBR  = INBR + 1
  199.  20         CONTINUE
  200.           ENDDO
  201.  21       CONTINUE
  202.         ENDDO
  203. *
  204. *       TOUTES LES SOUS ZONES DOIVENT ETRE SUR LE BON SUPPORT
  205. *
  206.         IF (IFLAG.EQ.0) GOTO 1000
  207.         IF (IFLAG.EQ.INBR) THEN
  208.           GOTO 666
  209.         ELSE
  210.           GOTO 2000
  211.         ENDIF
  212.  
  213.       ENDIF
  214. *
  215. *     IPCHE1 EST AUX NOEUDS
  216.  1000 CONTINUE
  217.       IRET = 1
  218.       IF (ISUP.EQ.1) IRET = 0
  219.       IF (ICOND.EQ.1.AND.IRET.EQ.1.AND.ISUP.NE.0) GOTO 2000
  220.       GOTO 666
  221. *
  222. *     IPCHE1 EST SUR UN AUTRE SUPPORT QUE CELUI VOULU ET PAS AUX NOEUDS
  223. *     ==> MESSAGE D'ERREUR POUR QUE L'ON DONNE LE CHAMELEM SUR UN
  224. *         SUPPORT CORRECT
  225.  2000 CONTINUE
  226.       IF (ISUP.NE.0) THEN
  227.         MOTERR(1:8)=TITCHE
  228.         CALL ERREUR(124)
  229. *
  230. *  LES DIFFERENTS SOUS-ZONES DU CHAMELEM ONT DES POINTS SUPPORTS DIFFERENTS
  231. *
  232.       ELSE
  233.         CALL ERREUR(560)
  234.       ENDIF
  235.       IRET = 9999
  236.       GOTO 666
  237.  
  238.  666  CONTINUE
  239. c      RETURN
  240.       END
  241.  
  242.  
  243.  
  244.  
  245.  

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