Télécharger la plaquette Cast3M


fr en

Télécharger champo.eso

Retour à la liste

Numérotation des lignes : 

champo

  1. C CHAMPO    SOURCE    FD218221  25/03/14    21:15:03     12200          
  2.       SUBROUTINE CHAMPO(IPCHAM,IMOY1,IPCHPO,IRET)
  3. C=======================================================================
  4. C
  5. C     TRANSFORME UN MCHAML EN CHPOINT
  6. C
  7. C
  8. C     ATTENTION LES COMPOSANTES DE IPCHAM NE DOIVENT PAS ETRE '    '
  9. C                               ( DES MOT BLANCS )
  10. C
  11. C  ENTREES
  12. C
  13. C     IPCHAM = Pointeur sur un MCHAML
  14. C     IMOY   = 0 si somme
  15. C              1 si moyenne sur les elements
  16. C              2 si valeur maximale
  17. C             -2 si valeur minimale
  18. C
  19. C  SORTIES
  20. C
  21. C     IPCHPO=Pointeur sur un CHPOINT
  22. C     IRET=1 OU 0 suivant succes ou non
  23. C                 Message d'erreur imprime si IRET=0
  24. C
  25. C
  26. C=======================================================================
  27.       IMPLICIT INTEGER(I-N)
  28.       IMPLICIT REAL*8(A-H,O-Z)
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC SMCHAML
  33. -INC SMCHPOI
  34. -INC SMELEME
  35. -INC SMCOORD
  36. -INC TMTRAV
  37.  
  38.       SEGMENT ICPR(nbpts)
  39.       SEGMENT MTRA1
  40.         CHARACTER*(LOCOMP) ICOMP(0)
  41.       ENDSEGMENT
  42.       SEGMENT MTRA2
  43.         INTEGER     MHAR(0)
  44.       ENDSEGMENT
  45.  
  46. C     Pour de l'optimisation
  47.       CHARACTER*(LOCOMP) MO4a,MO4b
  48.  
  49. *      write(ioimp,*) 'coucou champo'
  50. *      call ecrobj('MCHAML  ',IPCHAM)
  51. *      call prlist
  52. *      CALL ACTOBJ('MCHAML  ',IPCHAM,1)
  53.  
  54.       IRET=1
  55.  
  56. C                          POUR LE CHAPEAU DU CHPOINT
  57. C     Certaines SUBROUTINES envoie IMOY1 en CONSTANT EXPRESSION donc le modifier ne fait pas bon menage
  58. C     Je le recopie IMOY <-- IMOY1
  59.       IMOY=IMOY1
  60.  
  61.       JFLAG=0
  62.       IF (IMOY.GE.10) THEN
  63.         JFLAG=1
  64.         IMOY=IMOY-10
  65.       ENDIF
  66.  
  67. *     ACTIVATION DU MCHAML
  68.  
  69.       MCHELM=IPCHAM
  70.       L1=TITCHE(/1)
  71.       N1=INFCHE(/1)
  72.       N3=INFCHE(/2)
  73.       IF (N3.NE.6) then
  74.         write(ioimp,*) 'CHAMPO : INFCHE(/2) != 6'
  75.         call erreur(5)
  76.       endif
  77.       IFACHE=IFOCHE
  78.       NSOUS =ICHAML(/1)
  79. C-----------------------------------------------------------------------
  80. C
  81. C     BOUCLE SUR LES SOUS REFERENCES DU CHAMELEM
  82. C              MISE EN PLACE DES NOMS DE COMPOSANTES DANS ICOMP
  83. C
  84. C-----------------------------------------------------------------------
  85.       CALL oooprl(1)
  86.       SEGINI MTRA1,MTRA2,ICPR
  87.       CALL oooprl(0)
  88.       NNNOE=0
  89.  
  90. *     BOUCLE SUR LES SOUS ZONES
  91.  
  92.       DO 100 ISOUS=1,NSOUS
  93.  
  94. *       ACTIVATION DU MELEME
  95.  
  96.         IVACHE = INFCHE(ISOUS,3)
  97.         MELEME = IMACHE(ISOUS)
  98.         MCHAML = ICHAML(ISOUS)
  99.         if (mchaml.le.0) goto 100
  100.  
  101. *       RECOPIE DES NOMS DE COMPOSANTES
  102.  
  103.         DO 110 IB=1,NOMCHE(/2)
  104.           MO4a = NOMCHE(IB)
  105.           DO 120 IC=1,ICOMP(/2)
  106.             MO4b=ICOMP(IC)
  107.             IF(MO4a.EQ.MO4b .AND. MHAR(IC).EQ.IVACHE) GOTO 110
  108.   120     CONTINUE
  109.           ICOMP(**)=MO4a
  110.           MHAR(**) =IVACHE
  111.   110   CONTINUE
  112.  
  113. *   RECUPERATION DES NUMEROS DE NOEUDS
  114.         DO 111 JOP= 1,NUM(/2)
  115.           DO 113 IOP = 1,NUM(/1)
  116.             IPT= NUM(IOP,JOP)
  117.             IF (ICPR(IPT).EQ.0) THEN
  118.               NNNOE=NNNOE+1
  119.               ICPR(IPT)=NNNOE
  120.             ENDIF
  121.   113     CONTINUE
  122.   111   CONTINUE
  123.  
  124.   100 CONTINUE
  125.  
  126.       NNIN=ICOMP(/2)
  127.       SEGINI MTRAV
  128.       DO 112 IOP=1,NNIN
  129.         INCO(IOP)=ICOMP(IOP)
  130.         NHAR(IOP)=MHAR(IOP)
  131.   112 CONTINUE
  132.  
  133. C-----------------------------------------------------------------------
  134. C
  135. C     BOUCLE SUR LES SOUS REFERENCES DU CHAMP PAR ELEMENT
  136. C
  137. C-----------------------------------------------------------------------
  138.       DO 300 ISOUS=1,NSOUS
  139.  
  140.          IVACHE=INFCHE(ISOUS,3)
  141.          MELEME=IMACHE(ISOUS)
  142.          MCHAML=ICHAML(ISOUS)
  143.          if (mchaml.le.0) goto 300
  144.          NCP=NOMCHE(/2)
  145.          NBNN=NUM(/1)
  146.          NBELEM=NUM(/2)
  147. C
  148. C       BOUCLE SUR LES ELEMENTS, LES NOEUDS ET LES COMPOSANTES DU CHAMPS
  149. C
  150.          DO 320 IB=1,NBELEM
  151.             DO 3201 IC=1,NBNN
  152. C              REPERAGE D UN POINT
  153.                IPT=ICPR(NUM(IC,IB))
  154.                DO 330 ID=1,NCP
  155.                   MELVAL=IELVAL(ID)
  156.                   NBPTEL=VELCHE(/1)
  157.                   NEL   =VELCHE(/2)
  158.                   IBMN=MIN(IB,NEL)
  159.                   IGMN=MIN(IC,NBPTEL)
  160.                   MO4a=NOMCHE(ID)
  161.                   DO 3301 IE=1,NNIN
  162.                      MO4b=ICOMP(IE)
  163.                      IF(MO4a.NE.MO4b .OR. IVACHE.NE.MHAR(IE)) GOTO 3301
  164. C               REMPLISSAGE DE BB POUR LES MCHAML AUX NOEUDS
  165.                      IF (JFLAG.EQ.1) THEN
  166.                         BVALT=0.D0
  167.                         DO 331 ICEL=1,NBPTEL
  168.                            BVALT=BVALT+VELCHE(ICEL,IBMN)
  169.  331                    CONTINUE
  170.                         BVALT=BVALT/NBPTEL
  171. C               SI ON VEUT LA VALEUR MAXI
  172.                         IF (IMOY.EQ.2) THEN
  173.                            IF (IBIN(IE,IPT).EQ.0) THEN
  174.                               BB(IE,IPT)=BB(IE,IPT)+BVALT
  175.                            ELSE
  176.                               BB(IE,IPT)=MAX(BB(IE,IPT),BVALT)
  177.                            ENDIF
  178. C               SI ON VEUT LA VALEUR MINI
  179.                         ELSEIF (IMOY.EQ.-2) THEN
  180.                            IF (IBIN(IE,IPT).EQ.0) THEN
  181.                               BB(IE,IPT)=BB(IE,IPT)+BVALT
  182.                            ELSE
  183.                               BB(IE,IPT)=MIN(BB(IE,IPT),BVALT)
  184.                            ENDIF
  185. C               SI ON VEUT LA SOMME OU LA MOYENNE
  186.                         ELSE
  187.                           BB(IE,IPT)=BB(IE,IPT)+BVALT
  188.                         ENDIF
  189.                      ELSE
  190. C               SI ON VEUT LA VALEUR MAXI
  191.                         IF (IMOY.EQ.2) THEN
  192.                            IF (IBIN(IE,IPT).EQ.0) THEN
  193.                             BB(IE,IPT)=BB(IE,IPT)+VELCHE(IGMN,IBMN)
  194.                            ELSE
  195.                             BB(IE,IPT)=MAX(BB(IE,IPT),VELCHE(IGMN,IBMN))
  196.                            ENDIF
  197. C               SI ON VEUT LA VALEUR MINI
  198.                         ELSEIF (IMOY.EQ.-2) THEN
  199.                            IF (IBIN(IE,IPT).EQ.0) THEN
  200.                             BB(IE,IPT)=BB(IE,IPT)+VELCHE(IGMN,IBMN)
  201.                            ELSE
  202.                             BB(IE,IPT)=MIN(BB(IE,IPT),VELCHE(IGMN,IBMN))
  203.                            ENDIF
  204. C               SI ON VEUT LA SOMME OU LA MOYENNE
  205.                         ELSE
  206.                            BB(IE,IPT)=BB(IE,IPT)+VELCHE(IGMN,IBMN)
  207.                         ENDIF
  208.                      ENDIF
  209.                      IBIN(IE,IPT)=IBIN(IE,IPT)+1
  210.  3301             CONTINUE
  211.  330           CONTINUE
  212.                IGEO(IPT)=NUM(IC,IB)
  213.  3201       CONTINUE
  214.  320     CONTINUE
  215.  300  CONTINUE
  216.  
  217.       IF (IMOY.EQ.1) THEN
  218.          DO 340 IPT=1,NNNOE
  219.             DO 3401 IE=1,NNIN
  220.                IF (IBIN(IE,IPT).NE.0) THEN
  221.                   BB(IE,IPT)=BB(IE,IPT)/IBIN(IE,IPT)
  222.                ELSE
  223.                   BB(IE,IPT)=0.D0
  224.                ENDIF
  225.  3401       CONTINUE
  226.  340     CONTINUE
  227.       ENDIF
  228. *     
  229. C     Et enfin on cree le CHPOINT
  230.       CALL CRECHP(MTRAV,IPCHPO)
  231. C     Petit nettoyage
  232.       SEGSUP MTRAV,ICPR,MTRA1,MTRA2
  233. C     Objet CHPOINT, option IFOUR, titre
  234.       MCHPOI=IPCHPO
  235.       IFOPOI=IFACHE
  236.       MTYPOI=TITCHE
  237. C     Si on fait la somme des contributions de chaque element : nature discret
  238.       IF (IMOY.EQ.0) THEN
  239.          JATTRI(1)=2
  240.       ELSE
  241. *     Dans les autres cas : nature diffus
  242.          JATTRI(1)=1
  243.       ENDIF
  244.  
  245. C      RETURN
  246.       END
  247.  
  248.  
  249.  
  250.  

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