Télécharger la plaquette Cast3M


fr en

Télécharger raye2.eso

Retour à la liste

Numérotation des lignes : 

raye2

  1. C RAYE2     SOURCE    CB215821  24/04/12    21:17:03     11897          
  2.         SUBROUTINE RAYE2(CHAMP, MODL, INFOEL, EMIS)
  3.  
  4. C **********************************************************
  5. C ****  SUBROUTINE D'INTERFACAGE CHAMELEM -->EMISSIVITE ****
  6. C ****                                                  ****
  7. C ****  En entree : CHAMP champ par element             ****
  8. C ****              MODL modele sur lequel s'appuie le  ****
  9. C ****              probleme                            ****
  10. C ****              INFOEL pointeur contenant des       ****
  11. C ****              informations relatives au maillage  ****
  12. C ****                                                  ****
  13. C ****  En sortie : EMIS matrice des composantes        ****
  14. C ****              des emissivites                     ****
  15. C ****                                                  ****
  16. C **********************************************************
  17.  
  18.       IMPLICIT INTEGER(I-N)
  19.         IMPLICIT REAL*8 (A-H,O-Z)
  20.  
  21. C **********************************************************
  22. C ****  Structure des elements utilises                 ****
  23. C **********************************************************
  24.  
  25. -INC SMCHAML
  26. -INC SMELEME
  27. -INC SMMODEL
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31.  
  32.         SEGMENT MATR
  33.          REAL*8 VAL(NTOT)
  34.         ENDSEGMENT
  35.  
  36.         SEGMENT ADRES
  37.          INTEGER V(NBS, 3)
  38.         ENDSEGMENT
  39.  
  40. C ****  ADRES contient les informations suivantes       ****
  41. C ****          V(j,1) : Numero du type d'element dans  ****
  42. C ****                  MODL                            ****
  43. C ****          V(j,2) : Numero correspondant au meme   ****
  44. C ****                  element que le precedent mais   ****
  45. C ****                  dans le CHAMELEM                ****
  46. C ****          V(j,3) : Nombre de surfaces dans cet    ****
  47. C ****                  ensemble                        ****
  48.  
  49.         SEGMENT INFOEL
  50.          LOGICAL KCOQ(N1), KQUAD(N1)
  51.         ENDSEGMENT
  52.  
  53.         POINTEUR EMIS.MATR
  54.         POINTEUR CHAMP.MCHELM
  55.         POINTEUR PCHAMP.MCHAML
  56.         POINTEUR DCHAM.MELVAL, DCHAM1.MELVAL, DCHAM2.MELVAL
  57.         POINTEUR MAILL.MELEME, SMAILL.MELEME
  58.         POINTEUR MODL.MMODEL
  59.         POINTEUR ID0.IMODEL
  60.         CHARACTER*(LOCOMP) MOT
  61.  
  62. C **********************************************************
  63. C ****  Declaration des variables utilisees             ****
  64. C **********************************************************
  65.  
  66.         IF (IIMPI.GE.4) WRITE(6,*) 'DEBUT DE RAYE2.ESO'
  67.  
  68.         SEGACT CHAMP
  69.         NBS = CHAMP.IMACHE(/1)
  70.         SEGINI ADRES
  71.         NTOT = 0
  72.         SEGACT MODL
  73.  
  74.         NBS2 = MODL.KMODEL(/1)
  75.  
  76.         SEGACT INFOEL
  77.  
  78.         DO 10 J = 1, NBS2
  79.                 ID0 = MODL.KMODEL(J)
  80.  
  81.                 SEGACT ID0
  82.                 ID2 = ID0.IMAMOD
  83.                 DO 20 I = 1, NBS
  84.  
  85.                         ADRES.V(J,1) = J
  86.                         MAILL = CHAMP.IMACHE(I)
  87.                         ID1 = MAILL
  88.  
  89.                         IF (ID1.EQ.ID2) THEN
  90.                                 ADRES.V(J, 2) = I
  91.                                 SEGACT MAILL
  92.                                 NBSOUS = MAILL.LISOUS(/1)
  93.  
  94.                                 IF (NBSOUS.EQ.0) THEN
  95.                                         NEL = MAILL.NUM(/2)
  96.                                 ELSE
  97.                                         DO 30 L = 1, NBSOUS
  98.                                            SMAILL = MAILL.LISOUS(L)
  99.                                            SEGACT SMAILL
  100.                                            NEL = NEL + SMAILL.NUM(/2)
  101.  30                                     CONTINUE
  102.                                 ENDIF
  103.  
  104.                                 ADRES.V(J,3) = NEL
  105.  
  106.                                 IF (KCOQ(I)) NEL = NEL + NEL
  107.                         ENDIF
  108.  20             CONTINUE
  109.                 NTOT = NTOT + NEL
  110.  
  111.  10     CONTINUE
  112.  
  113. C ****  NTOT designe la dimension du vecteur EMIS       ****
  114.  
  115.         SEGDES INFOEL
  116.  
  117.         IF (IIMPI.GE.4) THEN
  118.            WRITE(6,*) 'Dimension du vecteur d''emissivite =',NTOT
  119.         ENDIF
  120.  
  121.         SEGINI EMIS
  122.         N = 1
  123.  
  124.         DO 40 K = 1, NBS
  125.                 I = ADRES.V(K,2)
  126.  
  127.                 PCHAMP = CHAMP.ICHAML(I)
  128.  
  129.                 SEGACT PCHAMP
  130.                 NBST = PCHAMP.IELVAL(/1)
  131.                 nbs2=nbsT
  132.  
  133. *
  134. *on cherche les positions des EMIS ou EINF et ESUP position ie1 ie2
  135. *
  136.                   lemis=0
  137.                   leinf=0
  138.                   lesup=0
  139.                   do iva=1,nbst
  140.                     if( PCHAMP.NOMCHE(iva).eq.'EMIS')  lemis=iva
  141.                     if( PCHAMP.NOMCHE(iva).eq.'EINF')  leinf=iva
  142.                     if( PCHAMP.NOMCHE(iva).eq.'ESUP')  lesup=iva
  143.                   enddo
  144.                   nbs2=1
  145.                   if(lemis.eq.0) then
  146.                     if( (leinf.eq.0.or.lesup.eq.0).and.nbst.ne.1) then
  147.                      moterr(1:4)='EMIS'
  148.                       call erreur( 77)
  149.                       return
  150.                     endif
  151.                     if(nbst.ne.1) nbs2=2
  152.                   endif
  153.                   if (nbs2.eq.1.and. nbst.eq.1) lemis =1
  154.                 IF (IIMPI.GE.4.AND.NBS2.GT.2) THEN
  155.                         WRITE(6,*) 'Dimensions incompatibles'
  156.                 ENDIF
  157.  
  158.                 IF (NBS2.EQ.2) THEN
  159. C ****          Il y a des elements COQ                 ****
  160.                            DCHAM1 = PCHAMP.IELVAL(lesup)
  161.                            DCHAM2 = PCHAMP.IELVAL(leinf)
  162.                            SEGACT DCHAM1, DCHAM2
  163.  
  164.                            N1PTEL = DCHAM1.VELCHE(/1)
  165.                            N1EL = DCHAM1.VELCHE(/2)
  166.  
  167.                            IF (N1EL.EQ.1) THEN
  168. *        write(6,*) 'k,, ADRES.V(K,3 dcham1', k , ADRES.V(K,3),dcham1
  169.                               DO 70 M = 1, ADRES.V(K,3)
  170.                                    EMIS.VAL(N) = DCHAM1.VELCHE(1,1)
  171.                                    IF (IIMPI.GE.4) THEN
  172.                                       WRITE(6,*) 'EMIS =',EMIS.VAL(N)
  173.                                    ENDIF
  174.                                    N = N + 1
  175.  
  176.                                    EMIS.VAL(N) = DCHAM2.VELCHE(1,1)
  177.                                    IF (IIMPI.GE.4) THEN
  178.                                       WRITE(6,*) 'EMIS =',EMIS.VAL(N)
  179.                                    ENDIF
  180.                                    N = N + 1
  181.  70                           CONTINUE
  182.                            ENDIF
  183.  
  184.                            IF (N1EL.NE.1) THEN
  185.                               DO 75 M = 1, ADRES.V(K,3)
  186.                                    EMIS.VAL(N) = DCHAM1.VELCHE(1,M)
  187.                                    IF (IIMPI.GE.4) THEN
  188.                                       WRITE(6,*) 'EMIS =',EMIS.VAL(N)
  189.                                    ENDIF
  190.                                    N = N + 1
  191.  
  192.                                    EMIS.VAL(N) = DCHAM2.VELCHE(1,M)
  193.                                    IF (IIMPI.GE.4) THEN
  194.                                       WRITE(6,*) 'EMIS =',EMIS.VAL(N)
  195.                                    ENDIF
  196.                                    N = N + 1
  197.  75                           CONTINUE
  198.  
  199.                            ENDIF
  200.                 ENDIF
  201.  
  202.                 IF (NBS2.EQ.1) THEN
  203. C ****          Il n'y a pas d'elements COQ             ****
  204.  
  205.                         MOT = PCHAMP.NOMCHE(1)
  206.                         IF (IIMPI.GE.4) WRITE(6,*) 'MOT =',MOT
  207.  
  208.                         DCHAM = PCHAMP.IELVAL(1)
  209.                         SEGACT DCHAM
  210.  
  211.                         N1PTEL = DCHAM.VELCHE(/1)
  212.                         N1EL = DCHAM.VELCHE(/2)
  213.  
  214.                         IF (N1EL.EQ.1) THEN
  215.                                 DO 90 M = 1, ADRES.V(K,3)
  216.                                    EMIS.VAL(N) = DCHAM.VELCHE(1,1)
  217.                                    IF (IIMPI.GE.4) THEN
  218.                                       WRITE(6,*) 'EMIS =',EMIS.VAL(N)
  219.                                    ENDIF
  220.                                    N = N + 1
  221.  90                             CONTINUE
  222.                         ENDIF
  223.  
  224.                         IF (N1EL.NE.1) THEN
  225.                                 DO 95 M = 1, ADRES.V(K,3)
  226.                                    EMIS.VAL(N) = DCHAM.VELCHE(1,M)
  227.                                    IF (IIMPI.GE.4) THEN
  228.                                       WRITE(6,*) 'EMIS =',EMIS.VAL(N)
  229.                                    ENDIF
  230.                                    N = N + 1
  231.  95                             CONTINUE
  232.  
  233.                         ENDIF
  234.                 ENDIF
  235.  40     CONTINUE
  236.  
  237.         IF (IIMPI.GE.4) THEN
  238.                 WRITE(6,*) 'Nombre de surfaces traitees', N - 1
  239.         ENDIF
  240.  
  241.         SEGDES EMIS,ADRES
  242.  
  243.         END
  244.  
  245.  
  246.  
  247.  
  248.  

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