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    OF166741  24/10/04    21:15:02     12023          
  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.       SEGMENT INFO
  61.         INTEGER INFELL(JG)
  62.       ENDSEGMENT
  63.  
  64.       CHARACTER*(NCONCH) CONCH
  65.  
  66. *--------- Fin des declarations ----------------------
  67.  
  68.       IRET  = 0
  69.       IRET2 = 9999
  70.  
  71.       MCHELM = IPCHE1
  72.       NSOUS = mchelm.ICHAML(/1)
  73.       N3    = mchelm.INFCHE(/2)
  74.  
  75. *OF : Pour eviter de se poser la question de N3<6 a ce jour.
  76.       IF (N3.LT.6) THEN
  77.         write(ioimp,*) 'QUESUP INFCHE(.,N3) N3<6 : N3=',N3,'!'
  78.         call erreur(5)
  79.         return
  80.       ENDIF
  81. *DBG**OF A partir d'ici N3 est forcement plus grand que 6 !
  82.  
  83. *  Recherche de l'information sur le support stockee dans INFCHE(*,6) ...
  84. *  Si NSOUS = 0, champ considere constant avec le support recherche !
  85.       IF (NSOUS.GT.0) THEN
  86.         ISUPC = mchelm.INFCHE(1,6)
  87.         IRET2 = ISUPC
  88.         DO ISOUS = 2, NSOUS
  89.           IF (mchelm.INFCHE(ISOUS,6).NE.ISUPC) IRET2 = 9999
  90.         ENDDO
  91.       ELSE
  92.         ISUPC = ISUP
  93.         IRET2 = ISUPC
  94.       ENDIF
  95.       ISUP1 = ISUPC
  96.  
  97. *   si le champ est constant sur l'element quelque soit le
  98. *   support demande, on est bon
  99.       ICONST = 1
  100.       DO ISOUS = 1, NSOUS
  101.         MCHAML = mchelm.ICHAML(ISOUS)
  102.         NCOMP  = mchaml.IELVAL(/1)
  103.         DO ICOMP = 1, NCOMP
  104.           MELVAL = mchaml.IELVAL(ICOMP)
  105.           IF (MELVAL.NE.0) THEN
  106.             IF (mchaml.TYPCHE(ICOMP)(1:8).NE.'POINTEUR') THEN
  107.               iflag = melval.VELCHE(/1)
  108.             ELSE
  109.               iflag = melval.IELCHE(/1)
  110.             ENDIF
  111.             IF (iflag.NE.1) ICONST = 0
  112.           ENDIF
  113.         ENDDO
  114.       ENDDO
  115.  
  116.       IF (ICONST.EQ.1) GOTO 666
  117.  
  118.       IFLAG = 0
  119. *
  120. *   CAS ISUP = 0
  121. *   ------------
  122.       IF (ISUP.EQ.0) THEN
  123. * On a deja :       ISUP1 = ISUPC = mchelm.INFCHE(1,6)
  124.         MINTE  = mchelm.INFCHE(1,4)
  125.         IF (MINTE.NE.0) NBPGAU = minte.POIGAU(/1)
  126.         DO ISOUS = 1, NSOUS
  127.           INFCH1 = mchelm.INFCHE(ISOUS,6)
  128.           MINTE1 = mchelm.INFCHE(ISOUS,4)
  129.           IF (INFCH1.EQ.1) GOTO 10
  130.           IF (MINTE1.EQ.0) GOTO 10
  131.           IF (INFCH1.NE.ISUPC) THEN
  132.             IF (MINTE.NE.MINTE1) THEN
  133.               NBPGA1 = MINTE1.POIGAU(/1)
  134.               IF (NBPGAU.NE.NBPGA1) GOTO 2000
  135.             ENDIF
  136.           ENDIF
  137.           IFLAG=IFLAG+1
  138.  10       CONTINUE
  139.         ENDDO
  140. *
  141. *       TOUTES LES SOUS ZONES DOIVENT ETRE SUR LE BON SUPPORT
  142. *
  143.         IF (IFLAG.EQ.0) GOTO 1000
  144.         IF (IFLAG.NE.NSOUS) GOTO 2000
  145.         IRET = ISUPC
  146.         GOTO 666
  147. *
  148. *    CAS ISUP > 0
  149. *    ------------
  150. *    DANS CE CAS CE SONT LES ZONES DU MODELE QUI PILOTENT
  151.       ELSE
  152.         ISUP1 = ISUP
  153. * Cas particulier pour certaines formulations :
  154.         IF (ISUPC.EQ.6) THEN
  155.           IF (ISUP.GE.3) ISUP1 = 6
  156.         ENDIF
  157.  
  158. * On suppose que le modele est "mono-formulation"...
  159.         MMODEL = IPMODE
  160.         NSOUM  = mmodel.KMODEL(/1)
  161.         INBR   = 0
  162.         DO ISOUM = 1, NSOUM
  163.           IMODEL = mmodel.KMODEL(ISOUM)
  164.           MELE   = imodel.NEFMOD
  165.           IF (MELE.EQ.22 .OR. MELE.EQ.259) GOTO 21
  166.  
  167.           IF (ISUP1.EQ.6) THEN
  168.             CALL TSHAPE(MELE,'GAUSS',IPMIN1)
  169.           ELSE
  170.       if (imodel.INFMOD(/1).LT.7) THEN
  171. **        write(ioimp,*) 'QUESUP : INFMOD(/1) < 8',infmod(/1),2+ISUP1
  172. **        call erreur(5)
  173.       endif
  174.             IF (imodel.INFMOD(/1).LT.2+ISUP1) THEN
  175.         write(ioimp,*) ' QUESUP  IMODEL =',imodel,formod(1)
  176.               CALL ELQUOI(MELE,0,ISUP1,ipinf,IMODEL)
  177.               IF (IERR.NE.0) THEN
  178.                 IRET = 9999
  179.                 GOTO 666
  180.               ENDIF
  181.               info   = ipinf
  182.               IPMIN1 = info.INFELL(11)
  183.               SEGSUP,info
  184.             ELSE
  185.               IPMIN1 = imodel.INFMOD(2+ISUP1)
  186.             ENDIF
  187.           ENDIF
  188.           MINTE1 = IPMIN1
  189.           NBPGA1 = MINTE1.POIGAU(/1)
  190. *
  191. *         BOUCLE SUR LES ZONES DU CHAMELEM
  192. *
  193.           DO ISOUS=1,NSOUS
  194.  
  195.             IPMAIL = mchelm.IMACHE(ISOUS)
  196.             IF (IPMAIL.NE.imodel.IMAMOD) GOTO 20
  197.             CONCH = mchelm.CONCHE(ISOUS)
  198.             IF (CONCH.NE.imodel.CONMOD) GOTO 20
  199.  
  200.             INFCH = mchelm.INFCHE(ISOUS,6)
  201.             IF (INFCH.EQ.1) GOTO 20
  202.  
  203.             MINTE = mchelm.INFCHE(ISOUS,4)
  204.             IF (MINTE.EQ.0) GOTO 20
  205.  
  206.             IF (INFCH.NE.ISUP1) THEN
  207.               IF (MINTE.NE.MINTE1) THEN
  208.                 NBPGAU = minte.POIGAU(/1)
  209.                 IF (NBPGAU.NE.NBPGA1) GOTO 2000
  210.               ENDIF
  211.             ENDIF
  212.  
  213.             IFLAG = IFLAG + 1
  214.             INBR  = INBR + 1
  215.  20         CONTINUE
  216.           ENDDO
  217.  21       CONTINUE
  218.         ENDDO
  219. *
  220. *       TOUTES LES SOUS ZONES DOIVENT ETRE SUR LE BON SUPPORT
  221. *
  222.         IF (IFLAG.EQ.0) GOTO 1000
  223.         IF (IFLAG.EQ.INBR) THEN
  224.           GOTO 666
  225.         ELSE
  226.           GOTO 2000
  227.         ENDIF
  228.  
  229.       ENDIF
  230. *
  231. *     IPCHE1 EST AUX NOEUDS
  232.  1000 CONTINUE
  233.       IRET = 1
  234.       IF (ISUP.EQ.1) IRET = 0
  235.       IF (ICOND.EQ.1.AND.IRET.EQ.1.AND.ISUP.NE.0) GOTO 2000
  236.       GOTO 666
  237. *
  238. *     IPCHE1 EST SUR UN AUTRE SUPPORT QUE CELUI VOULU ET PAS AUX NOEUDS
  239. *     ==> MESSAGE D'ERREUR POUR QUE L'ON DONNE LE CHAMELEM SUR UN
  240. *         SUPPORT CORRECT
  241.  2000 CONTINUE
  242.       IF (ISUP.NE.0) THEN
  243.         MOTERR(1:8)=TITCHE
  244.         CALL ERREUR(124)
  245. *
  246. *  LES DIFFERENTS SOUS-ZONES DU CHAMELEM ONT DES POINTS SUPPORTS DIFFERENTS
  247. *
  248.       ELSE
  249.         CALL ERREUR(560)
  250.       ENDIF
  251.       IRET = 9999
  252.       GOTO 666
  253.  
  254.  666  CONTINUE
  255. c      RETURN
  256.       END
  257.  
  258.  
  259.  
  260.  

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