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    OF166741  24/10/03    21:15:38     12022          
  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. c*      SEGACT MCHELM
  83.       NSOUS = ICHAML(/1)
  84.       N3    = INFCHE(/2)
  85.       IF (N3.NE.6) THEN
  86.         write(ioimp,*) 'QUESUQ : N3 = INFCHE(/2) != 6'
  87.         call erreur(5)
  88.       ENDIF
  89.  
  90. c* CAS NSOUS = 0 - MCHELM VIDE ?
  91.  
  92.       NTEST=NSOUS
  93.       SEGINI,MTEST
  94. *
  95. *   si le chamelem est constant sur l'element quelque soit le
  96. *   support demande  on est bon
  97. *
  98.       DO  10 ISOUS=1,NSOUS
  99.        MCHAML=ICHAML(ISOUS)
  100. c*       SEGACT MCHAML
  101.        NCOMP=IELVAL(/1)
  102.         DO 20 ICOMP=1,NCOMP
  103. *
  104. *       TEST SUR LES NOMS DE COMPOSANTES
  105. *
  106.            JELAI=0
  107.            DO 21 ICOCO=1,NBROBL
  108.               IF(NOMCHE(ICOMP).EQ.LESOBL(ICOCO)) JELAI=1
  109.  21        CONTINUE
  110.            IF(JELAI.EQ.0) THEN
  111.              DO 22 ICOCO=1,NBRFAC
  112.                 IF(NOMCHE(ICOMP).EQ.LESFAC(ICOCO)) JELAI=1
  113.  22          CONTINUE
  114.            ENDIF
  115.            IF(JELAI.EQ.0) GO TO 20
  116.            ITEST(ISOUS)=MAX(ITEST(ISOUS),JELAI)
  117. *
  118.          MELVAL=IELVAL(ICOMP)
  119.          IF(MELVAL.NE.0)THEN
  120.           IF(TYPCHE(ICOMP)(1:8).NE.'POINTEUR')THEN
  121.             IPOIN=VELCHE(/1)
  122.           ELSE
  123.             IPOIN=IELCHE(/1)
  124.           ENDIF
  125.           IF(IPOIN.NE.1)THEN
  126.            ICONST=0
  127.            GOTO 500
  128.           ENDIF
  129.          ENDIF
  130.   20   CONTINUE
  131.   10  CONTINUE
  132. *
  133.  500  CONTINUE
  134.       ISUP1 = INFCHE(1,6)
  135.       IRET2 = ISUP1
  136.       IF (ICONST.EQ.1) GOTO 666
  137. *
  138.       IFLAG=0
  139. *
  140. *   CAS ISUP = 0
  141. *   ------------
  142. *
  143.       IF(ISUP.EQ.0)THEN
  144.         ISUP1=INFCHE(1,6)
  145.         MINTE1=INFCHE(1,4)
  146.         IF (MINTE1.NE.0) NBPGA1=MINTE1.POIGAU(/1)
  147.         DO 1 ISOUS=1,NSOUS
  148.           IF (ITEST(ISOUS).EQ.0) GOTO 1
  149.           MINTE=INFCHE(ISOUS,4)
  150.           INFCH=INFCHE(ISOUS,6)
  151.           IF (MINTE.EQ.0) GOTO 1
  152.           IF (INFCH.EQ.1) GOTO 1
  153.           IF (INFCH.NE.ISUP1) THEN
  154.             NBPGAU=POIGAU(/1)
  155.             IF(NBPGAU.EQ.NBPGA1)THEN
  156.               IFLAG=IFLAG+1
  157.             ELSE
  158.               GOTO 2000
  159.             ENDIF
  160.           ELSE
  161.             IFLAG=IFLAG+1
  162.           ENDIF
  163.  1      CONTINUE
  164. *
  165. *       TOUTES LES SOUS ZONES DOIVENT ETRE SUR LE BON SUPPORT
  166. *
  167.         IF (IFLAG.EQ.0) GOTO 1000
  168.         IF (IFLAG.EQ.NSOUS) THEN
  169.            IF(ISUP.EQ.0) THEN
  170.                IRET=ISUP1
  171.                IRET2=ISUP1
  172.            ENDIF
  173.            GOTO 666
  174.         ELSE
  175.            GOTO 2000
  176.         ENDIF
  177. *
  178. *    CAS ISUP > 0
  179. *    ------------
  180. *    DANS CE CAS CE SONT LES ZONES DU MODELE QUI PILOTENT
  181. *
  182.       ELSE
  183.         ISUP1=ISUP
  184. *
  185. *       ETUDE DE LA SOUS ZONE DU MODELE
  186. *
  187.           IMODEL=IPMODE
  188.           MELE=NEFMOD
  189. *
  190. *         BOUCLE SUR LES ZONES DU CHAMELEM
  191. *
  192.           DO 2 ISOUS=1,NSOUS
  193.             CONCH=CONCHE(ISOUS)
  194.             IPMAIL=IMACHE(ISOUS)
  195.             IF(IMAMOD.NE.IPMAIL.OR.CONCH.NE.CONMOD)GOTO 2
  196.             IF (INFCHE(ISOUS,4).EQ.0) GOTO 2
  197.             IF (ITEST(ISOUS).EQ.0) GOTO 2
  198. *
  199.             INFCH=INFCHE(ISOUS,6)
  200.             IF (INFCH.EQ.1) GOTO 2
  201.             IF (INFCH.NE.ISUP1) THEN
  202.               IF(ISUP1.EQ.6)THEN
  203.                 CALL TSHAPE(MELE,'GAUSS',IPMIN1)
  204.               ELSE
  205.                 IPMIN1=INFMOD(lesupp+2)
  206.               ENDIF
  207.               MINTE=INFCHE(ISOUS,4)
  208.               MINTE1=IPMIN1
  209.               NBPGAU=POIGAU(/1)
  210.               NBPGA1=MINTE1.POIGAU(/1)
  211.               IF(NBPGAU.EQ.NBPGA1)THEN
  212.                  IRT=1
  213.               ELSE
  214.                  IRT=0
  215.               ENDIF
  216.               IF(IRT.EQ.1)THEN
  217.                  IFLAG=IFLAG+1
  218.               ELSE
  219.                  GOTO 2000
  220.               ENDIF
  221.             ELSE
  222.               IFLAG=IFLAG+1
  223.             ENDIF
  224.  2      CONTINUE
  225. *
  226. *       LA SOUS-ZONE DOIT ETRE SUR LE BON SUPPORT
  227. *
  228.         IF (IFLAG.EQ.0) GOTO 1000
  229.         IF (IFLAG.EQ.1)  THEN
  230.            IF(ISUP.EQ.0) THEN
  231.                IRET=ISUP1
  232.                IRET2=ISUP1
  233.            ENDIF
  234.            GOTO 666
  235.         ELSE
  236.            GOTO 2000
  237.         ENDIF
  238.       ENDIF
  239. *
  240.  1000 CONTINUE
  241. *
  242. *     IPCHE1 EST AUX NOEUDS
  243. *
  244.       IRET=1
  245.       IF (ISUP.EQ.1) IRET=0
  246.       IF (ICOND.EQ.1.AND.IRET.EQ.1.AND.ISUP.NE.0) GOTO 2000
  247.       GOTO 666
  248. *
  249.  2000 CONTINUE
  250. *
  251.       IF(ISUP.NE.0)THEN
  252. *
  253. *     IPCHE1 EST SUR UN AUTRE SUPPORT QUE CELUI VOULU ET PAS AUX NOEUDS
  254. *
  255. *     ==> MESSAGE D'ERREUR POUR QUE L'ON DONNE LE CHAMELEM SUR UN
  256. *         SUPPORT CORRECT
  257. *
  258.         MOTERR(1:8)=TITCHE
  259.         CALL ERREUR(124)
  260.       ELSE
  261. *
  262. *  LES DIFFERENTS SOUS-ZONES DU CHAMELEM ONT DES POINTS SUPPORTS DIFFERENTS
  263. *
  264.          CALL ERREUR(560)
  265.       ENDIF
  266.       IRET=9999
  267.       IRET2=9999
  268.       RETURN
  269. *
  270.  3000 CONTINUE
  271. *
  272. *     IPCHE1 A UN POINTEUR SUR UN MINTE <> 0 MAIS L'INFCHE(..,6)
  273. *     N'EST PAS RENSEIGNE (NE DOIT PAS ARRIVE NORMALEMENT)
  274. *
  275.       IRET=9999
  276.       IRET2=9999
  277.       CALL ERREUR(53)
  278. *
  279.  666  CONTINUE
  280.       SEGSUP,MTEST
  281.  
  282.       RETURN
  283.       END
  284.  
  285.  
  286.  

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