Télécharger la plaquette Cast3M


fr en

Télécharger pridua.eso

Retour à la liste

Numérotation des lignes : 

pridua

  1. C PRIDUA    SOURCE    CB215821  20/11/25    13:36:46     10792          
  2.       SUBROUTINE PRIDUA(ICHP1,ICOD1,IPOS1)
  3. ************************************************************************
  4. * NOM         : PRIDUA
  5. * DESCRIPTION : Indique si un champ est primal ou dual
  6. ************************************************************************
  7. * APPELE PAR : pjblch.eso
  8. ************************************************************************
  9. * ENTREES : ICHP1 = pointeur vers le CHPOINT
  10. * SORTIES : ICOD1 = 0 si le CHPOINT est vide ou si toutes les
  11. *                     composantes sont a la fois primales et duales
  12. *                     (i.e. elles sont dans NOMDD et aussi dans NOMDU)
  13. *                 = 1 s'il n'y a que des primales
  14. *                 = 2 s'il n'y a que des duales
  15. *                 = -1 s'il y a a la fois des primales et des duales
  16. *           IPOS1 contient la position dans NOMDD si ICOD1 vaut 0 ou 1,
  17. *                 dans NOMDU si ICOD1 vaut 0 ou 2
  18. *                 (vaut 0 si ICOD1 vaut -1)
  19. ************************************************************************
  20.  
  21.       IMPLICIT INTEGER(I-N)
  22.       IMPLICIT REAL*8 (A-H,O-Z)
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26. -INC SMCHPOI
  27. -INC SMLENTI
  28. -INC CCHAMP
  29.  
  30.       CHARACTER*(LOCOMP) MOCOMP
  31. *
  32.       ICOTY1=0
  33. *
  34.       JG=LNOMDD
  35.       SEGINI,MLENTI
  36.       JG=0
  37. *
  38.       MCHPO1=ICHP1
  39.       SEGACT,MCHPO1
  40. *
  41.       NSOUP1=MCHPO1.IPCHP(/1)
  42.       DO J1=1,NSOUP1
  43.          MSOUP1=MCHPO1.IPCHP(J1)
  44.          SEGACT,MSOUP1
  45. *
  46.          NCO1=MSOUP1.NOCOMP(/2)
  47.          DO 10 K1=1,NCO1
  48. *
  49. *           ON CHERCHE LA COMPOSANTE DANS NOMDD ET AUSSI DANS NOMDU
  50. *           (EN MECANIQUE DES FLUIDES, LE MEME NOM EST PARFOIS DONNE
  51. *            A LA PRIMALE ET A LA DUALE)
  52.             MOCOMP=MSOUP1.NOCOMP(K1)
  53.             ICO1=0
  54.             DO IDD=1,LNOMDD
  55.                IF (MOCOMP.EQ.NOMDD(IDD)) THEN
  56.                   ICO1=1
  57.                   IPO1=IDD
  58.                   GOTO 20
  59.                ENDIF
  60.             ENDDO
  61.  20         CONTINUE
  62.             DO IDU=1,LNOMDU
  63.                IF (MOCOMP.EQ.NOMDU(IDU)) THEN
  64.                   ICO1=ICO1+2
  65.                   IPO1=IDU
  66.                   GOTO 30
  67.                ENDIF
  68.             ENDDO
  69.  30         CONTINUE
  70. *
  71. *           => LA COMPOSANTE N'EXISTE PAS DANS CCHAMP
  72.             IF (ICO1.EQ.0) THEN
  73.                MOTERR=MOCOMP
  74.                CALL ERREUR(108)
  75.                RETURN
  76. *
  77. *           => LA COMPOSANTE EST DANS LES DEUX LISTES
  78.             ELSEIF (ICO1.EQ.3) THEN
  79.                GOTO 11
  80.             ENDIF
  81. *
  82.             IF (ICOTY1.EQ.0) ICOTY1=ICO1
  83.             IF (ICOTY1.NE.ICO1) THEN
  84.                ICOD1=-1
  85.                IPOS1=0
  86.                RETURN
  87.             ENDIF
  88. *
  89. *           Incrementation de MLENTI
  90.  11         CONTINUE
  91.             DO L1=1,JG
  92.                IF (IPO1.EQ.LECT(L1)) GOTO 10
  93.             ENDDO
  94.             JG=JG+1
  95.             LECT(JG)=IPO1
  96. *
  97.  10      CONTINUE
  98.       ENDDO
  99. *
  100.       ICOD1=ICOTY1
  101.       IPOS1=MLENTI
  102.       SEGADJ,MLENTI
  103.       SEGDES,MLENTI
  104. *
  105.       RETURN
  106. *
  107.       END
  108. *
  109. *
  110.  
  111.  

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