Télécharger la plaquette Cast3M


fr en

Télécharger quesuq.eso

Retour à la liste

Numérotation des lignes : 

quesuq

  1. C QUESUQ    SOURCE    CB215821  24/04/12    21:17:01     11897          
  2.       SUBROUTINE QUESUQ(IPMODE,IPCHE1,ISUP,ICOND,MOMOT,lesupp,IRET,
  3.      $ IRET2)
  4. *______________________________________________________________________
  5. *
  6. *         VERIFICATION DU LIEU SUPPORT DES MCHAML
  7. *
  8. *   IPMODE  POINTEUR SUR UNE ZONE ELEMENTAIRE DU MODELE
  9. *           ACTIF EN ENTREE ACTIF EN SORTIE
  10. *   IPCHE1  POINTEUR SUR LE MCHAML DONT ON SOUHAITE VERIFIER LE SUPPORT
  11. *           DE CERTAINES COMPOSANTES
  12. *          (LIEU DU MINTE)
  13. *   ISUP > 0  :
  14. *
  15. *   ISUP    = 1 ON SOUHAITE QUE IPCHE1 SOIT AUX NOEUDS
  16. *           = 2 ON SOUHAITE QUE IPCHE1 SOIT AUX CENTRE DE GRAVITE
  17. *           = 3 ON SOUHAITE QUE IPCHE1 SOIT AUX POINTS DE GAUSS POUR
  18. *               LA RIGIDITE
  19. *           = 4 ON SOUHAITE QUE IPCHE1 SOIT AUX POINTS DE GAUSS POUR
  20. *               LA MASSE
  21. *           = 5 ON SOUHAITE QUE IPCHE1 SOIT AUX POINTS DE GAUSS POUR
  22. *               LES CONTRAINTES
  23. *   ISUP     = 0 ON VEUDRAIT CONNAITRE LE SUPPORT
  24. *
  25. *   ICOND   = 0 SI LE MCHAML PEUT ETRE SUR LE SUPPORT DEMANDE OU AUX
  26. *               NOEUDS(UTILISE UNIQUEMENT QUAND ISUP >0)
  27. *             1 SI LE MCHAML DOIT ETRE IMPERATIVEMENT SUR LE SUPPORT
  28. *               VOULU (CAS NOTAMENT DES MATRICE DE HOOKES ET DES
  29. *               DES MATRICES DE HOOKES TANGENTES)
  30. *
  31. *   MOMOT   :  POINTEUR SUR SEGMENT DES NOMS DES COMPOSANTES A EXAMINER
  32. *              ACTIF EN ENTREE ACTIF EN SORTIE
  33. *
  34. *   IPINF   :  POINTEUR SUR SEGMENT INFO
  35. *
  36. *
  37. *   DANS LE CAS ISUP > 0
  38. *
  39. *   IRET    = 1   IPCHE1 SE TROUVE AUX NOEUDS
  40. *           = 0   IPCHE1 EST BIEN SUR LE SUPPORT DEMANDE
  41. *           = 9999 LE SUPPORT DE UNE OU PLUSIEURS SOUS ZONE N'EST
  42. *                   PAS LE BON
  43. *   DANS LE CAS ISUP = 0
  44. *
  45. *   IRET    > 0   IL DONNE LE NUMERO DU SUPPORT
  46. *           = 0   LE CHAMP EST CONSTANT
  47. *           = 9999 LE CHAMELEM N'EST PAS HOMOGENE AU NIVEAU SUPPORT
  48. *
  49. *
  50. *   IRET2   > 0   IL DONNE LE NUMERO DU SUPPORT
  51. *           = 9999 LE CHAMELEM N'EST PAS HOMOGENE AU NIVEAU SUPPORT
  52. *
  53. *   REMARQUE : SI IPCHE1 EST AUX NOEUDS LE PASSAGE DES VALEURS SUR LE
  54. *              SUPPORT VOULU SE FAIT DANS VALCHE ET/OU VALMEL SAUF DANS
  55. *              LE CAS DES MATRICE DE HOOKES
  56. *
  57. *
  58. *   INSPIRE DE QUESUP
  59. *_______________________________________________________________________
  60. *
  61.       IMPLICIT INTEGER(I-N)
  62.       IMPLICIT REAL*8(A-H,O-Z)
  63.  
  64. -INC PPARAM
  65. -INC CCOPTIO
  66. -INC SMCHAML
  67. -INC SMINTE
  68. -INC SMMODEL
  69.       SEGMENT/MTEST/(ITEST(NTEST))
  70. *
  71.       CHARACTER*16 CONCH
  72. *
  73.       IRET=0
  74.       IRET2=0
  75.       ICONST=1
  76. *
  77.       NOMID = MOMOT
  78.       NBROBL = LESOBL(/2)
  79.       NBRFAC = LESFAC(/2)
  80. *
  81.       MCHELM=IPCHE1
  82.       SEGACT MCHELM
  83.       NSOUS=ICHAML(/1)
  84.  
  85.       NTEST=NSOUS
  86.       SEGINI,MTEST
  87. *
  88. *   si le chamelem est constant sur l'element quelque soit le
  89. *   support demande  on est bon
  90. *
  91.       DO  10 ISOUS=1,NSOUS
  92.        MCHAML=ICHAML(ISOUS)
  93.        SEGACT MCHAML
  94.        NCOMP=IELVAL(/1)
  95.         DO 20 ICOMP=1,NCOMP
  96. *
  97. *       TEST SUR LES NOMS DE COMPOSANTES
  98. *
  99.            JELAI=0
  100.            DO 21 ICOCO=1,NBROBL
  101.               IF(NOMCHE(ICOMP).EQ.LESOBL(ICOCO)) JELAI=1
  102.  21        CONTINUE
  103.            IF(JELAI.EQ.0) THEN
  104.              DO 22 ICOCO=1,NBRFAC
  105.                 IF(NOMCHE(ICOMP).EQ.LESFAC(ICOCO)) JELAI=1
  106.  22          CONTINUE
  107.            ENDIF
  108.            IF(JELAI.EQ.0) GO TO 20
  109.            ITEST(ISOUS)=MAX(ITEST(ISOUS),JELAI)
  110. *
  111.          MELVAL=IELVAL(ICOMP)
  112.          IF(MELVAL.NE.0)THEN
  113.           SEGACT MELVAL
  114.           IF(TYPCHE(ICOMP)(1:8).NE.'POINTEUR')THEN
  115.             IPOIN=VELCHE(/1)
  116.           ELSE
  117.             IPOIN=IELCHE(/1)
  118.           ENDIF
  119.           IF(IPOIN.NE.1)THEN
  120.            ICONST=0
  121.            GOTO 500
  122.           ENDIF
  123.          ENDIF
  124.   20   CONTINUE
  125.   10  CONTINUE
  126. *
  127.  500  CONTINUE
  128.       N3=INFCHE(/2)
  129.       IF (N3.LT.4) GOTO 1000
  130.       IF(N3.GE.6) THEN
  131.         ISUP1=INFCHE(1,6)
  132.         IRET2=ISUP1
  133.         IF (ICONST.EQ.1) GOTO 666
  134.       ELSE
  135.         GOTO 3000
  136.       ENDIF
  137. *
  138.       IFLAG=0
  139. *
  140. *   CAS ISUP = 0
  141. *   ------------
  142. *
  143.       IF(ISUP.EQ.0)THEN
  144.         IF(N3.GE.6)ISUP1=INFCHE(1,6)
  145.         DO 1 ISOUS=1,NSOUS
  146.          IF (INFCHE(ISOUS,4).EQ.0) GOTO 1
  147.          IF (ITEST(ISOUS).EQ.0) GOTO 1
  148.          IF (N3.GE.6) THEN
  149.             INFCH=INFCHE(ISOUS,6)
  150.             IF (INFCH.EQ.1) GOTO 1
  151.             IF (INFCH.NE.ISUP1) THEN
  152.                 MINTE=INFCHE(1,4)
  153.                 MINTE1=INFCHE(ISOUS,4)
  154.                 SEGACT MINTE
  155.                 SEGACT MINTE1
  156.                 NBPGAU=POIGAU(/1)
  157.                 NBPGA1=MINTE1.POIGAU(/1)
  158.                 IF(NBPGAU.EQ.NBPGA1)THEN
  159.                   IFLAG=IFLAG+1
  160.                 ELSE
  161.                   GOTO 2000
  162.                 ENDIF
  163.             ELSE
  164.                IFLAG=IFLAG+1
  165.             ENDIF
  166.          ELSE
  167.             GOTO 3000
  168.          ENDIF
  169.  1    CONTINUE
  170. *
  171. *       TOUTES LES SOUS ZONES DOIVENT ETRE SUR LE BON SUPPORT
  172. *
  173.         IF (IFLAG.EQ.0) GOTO 1000
  174.         IF (IFLAG.EQ.NSOUS) THEN
  175.            IF(ISUP.EQ.0) THEN
  176.                IRET=ISUP1
  177.                IRET2=ISUP1
  178.            ENDIF
  179.            GOTO 666
  180.         ELSE
  181.            GOTO 2000
  182.         ENDIF
  183. *
  184. *    CAS ISUP > 0
  185. *    ------------
  186. *    DANS CE CAS CE SONT LES ZONES DU MODELE QUI PILOTENT
  187. *
  188.       ELSE
  189.         ISUP1=ISUP
  190. *
  191. *       ETUDE DE LA SOUS ZONE DU MODELE
  192. *
  193.           IMODEL=IPMODE
  194.           MELE=NEFMOD
  195. *
  196. *         BOUCLE SUR LES ZONES DU CHAMELEM
  197. *
  198.           DO 2 ISOUS=1,NSOUS
  199.             CONCH=CONCHE(ISOUS)
  200.             IPMAIL=IMACHE(ISOUS)
  201.             IF(IMAMOD.NE.IPMAIL.OR.CONCH.NE.CONMOD)GOTO 2
  202.             IF (INFCHE(ISOUS,4).EQ.0) GOTO 2
  203.             IF (ITEST(ISOUS).EQ.0) GOTO 2
  204. *
  205.              IF (N3.GE.6) THEN
  206.                INFCH=INFCHE(ISOUS,6)
  207.                IF (INFCH.EQ.1) GOTO 2
  208.                IF (INFCH.NE.ISUP1) THEN
  209.                   IF(ISUP1.EQ.6)THEN
  210.                     CALL TSHAPE(MELE,'GAUSS',IPMIN1)
  211.                   ELSE
  212. *                    INFO=IPINF
  213.                     IPMIN1=INFMOD(lesupp+2)
  214.                   ENDIF
  215.                   MINTE=INFCHE(ISOUS,4)
  216.                   MINTE1=IPMIN1
  217.                   SEGACT MINTE
  218.                   SEGACT MINTE1
  219.                   NBPGAU=POIGAU(/1)
  220.                   NBPGA1=MINTE1.POIGAU(/1)
  221.                   IF(NBPGAU.EQ.NBPGA1)THEN
  222.                     IRT=1
  223.                   ELSE
  224.                     IRT=0
  225.                   ENDIF
  226.                   IF(IRT.EQ.1)THEN
  227.                     IFLAG=IFLAG+1
  228.                   ELSE
  229.                     GOTO 2000
  230.                   ENDIF
  231.                ELSE
  232.                  IFLAG=IFLAG+1
  233.                ENDIF
  234.            ELSE
  235.              GOTO 3000
  236.            ENDIF
  237.  2      CONTINUE
  238. *
  239. *       LA SOUS-ZONE DOIT ETRE SUR LE BON SUPPORT
  240. *
  241.         IF (IFLAG.EQ.0) GOTO 1000
  242.         IF (IFLAG.EQ.1)  THEN
  243.            IF(ISUP.EQ.0) THEN
  244.                IRET=ISUP1
  245.                IRET2=ISUP1
  246.            ENDIF
  247.            GOTO 666
  248.         ELSE
  249.            GOTO 2000
  250.         ENDIF
  251.       ENDIF
  252. *
  253.  1000 CONTINUE
  254. *
  255. *     IPCHE1 EST AUX NOEUDS
  256. *
  257.       IRET=1
  258.       IF (ISUP.EQ.1) IRET=0
  259.       IF (ICOND.EQ.1.AND.IRET.EQ.1.AND.ISUP.NE.0) GOTO 2000
  260.       GOTO 666
  261. *
  262.  2000 CONTINUE
  263. *
  264.       IF(ISUP.NE.0)THEN
  265. *
  266. *     IPCHE1 EST SUR UN AUTRE SUPPORT QUE CELUI VOULU ET PAS AUX NOEUDS
  267. *
  268. *     ==> MESSAGE D'ERREUR POUR QUE L'ON DONNE LE CHAMELEM SUR UN
  269. *         SUPPORT CORRECT
  270. *
  271.         MOTERR(1:8)=TITCHE
  272.         CALL ERREUR(124)
  273.       ELSE
  274. *
  275. *  LES DIFFERENTS SOUS-ZONES DU CHAMELEM ONT DES POINTS SUPPORTS DIFFERENTS
  276. *
  277.          CALL ERREUR(560)
  278.       ENDIF
  279.       IRET=9999
  280.       IRET2=9999
  281.       RETURN
  282. *
  283.  3000 CONTINUE
  284. *
  285. *     IPCHE1 A UN POINTEUR SUR UN MINTE <> 0 MAIS L'INFCHE(..,6)
  286. *     N'EST PAS RENSEIGNE (NE DOIT PAS ARRIVE NORMALEMENT)
  287. *
  288.       IRET=9999
  289.       IRET2=9999
  290.       CALL ERREUR(53)
  291. *
  292.  666  CONTINUE
  293.       SEGSUP,MTEST
  294.       END
  295.  
  296.  
  297.  
  298.  
  299.  

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