1 | include(dom.inc)
   2 | 
   3 |       SUBROUTINE gray_case(mediumtype, homosyst, nfcelt, celldata,      &
   4 |      &                     all_k_abs, Lb, kabs_gray, Lo, epsil, Tf,     &
   5 |      &                     ncells, nfacemax, nkabs, bcell,bface,nbface)
   6 | 
   7 | !       Only for print test:
   8 | !       USE mod_pmm
   9 | 
  10 |         IMPLICIT NONE
  11 | 
  12 |         include 'dom_constants.h'
  13 | 
  14 | !       IN
  15 |         CHARACTER*80                          :: mediumtype
  16 |         CHARACTER*80                          :: homosyst
  17 | 
  18 |         DOM_INT                               :: ncells
  19 |         DOM_INT                               :: nfacemax
  20 |         DOM_INT                               :: nkabs, nbface
  21 |         DOM_INT, DIMENSION(ncells)            :: nfcelt
  22 | 
  23 |         DOM_REAL, DIMENSION (8,ncells)        :: celldata
  24 |         DOM_REAL, DIMENSION (ncells)          :: kabs_gray
  25 |         DOM_REAL, DIMENSION (nbface)          :: epsil, Tf
  26 |         DOM_INT , DIMENSION (nbface)          :: bcell, bface
  27 | 
  28 | !       OUT
  29 |         DOM_REAL, DIMENSION (ncells)          :: Lb
  30 |         DOM_REAL, DIMENSION (nfacemax,ncells) :: Lo
  31 |         DOM_REAL, DIMENSION (nkabs,ncells)    :: all_k_abs
  32 | 
  33 | !       LOCAL
  34 |         DOM_REAL                              :: planck
  35 |         DOM_REAL                              :: kabsorpt
  36 |         DOM_INT                               :: ielt, m, ibnd
  37 | 
  38 | !       print*, " (",pmm_rank,") homosyst   : ", homosyst
  39 | !       print*, " (",pmm_rank,") mediumtype : ", mediumtype
  40 | !       print*, " (",pmm_rank,") ncells     : ", ncells
  41 | 
  42 | !       -----------------------!
  43 | !       Non-homogeneous system !
  44 | !       -----------------------!
  45 | 
  46 |         IF (trim(homosyst).eq.'NO') THEN
  47 | 
  48 | !          print*, " (",pmm_rank,") Doing non homogeneous!"
  49 | 
  50 |           ibnd = 1
  51 | 
  52 | !         ----------------------------------!
  53 | !         Intensities at the boundary faces !
  54 | !         ----------------------------------!
  55 | 
  56 |           DO WHILE (ibnd.le.nbface)
  57 | 
  58 |             ielt = bcell(ibnd)
  59 |             m    = bface(ibnd)
  60 | 
  61 |             Lo(m,ielt)=epsil(ibnd)*planck(Tf(ibnd))
  62 |             ibnd = ibnd + 1
  63 | 
  64 |           ENDDO
  65 | 
  66 | !         ------------------------------!
  67 | !         Intensities inside the domain !
  68 | !         ------------------------------!
  69 |       
  70 |           DO ielt=1,ncells
  71 |          
  72 |             Lb(ielt)=planck(celldata(1,ielt))
  73 |             all_k_abs(:,ielt)=kabs_gray(ielt)
  74 | 
  75 |           ENDDO
  76 | 
  77 | !        -------------------!
  78 | !        Homogeneous system !
  79 | !        -------------------!
  80 | 
  81 |         ELSE IF (trim(homosyst).eq.'YES') THEN 
  82 | 
  83 |           kabsorpt = kabs_gray(1)
  84 |           ibnd = 1
  85 | 
  86 | !         ----------------------------------!
  87 | !         Intensities at the boundary faces !
  88 | !         ----------------------------------!
  89 | 
  90 |           DO WHILE (ibnd.le.nbface)
  91 | 
  92 |             ielt = bcell(ibnd)
  93 |             m    = bface(ibnd)
  94 | 
  95 |             Lo(m,ielt)=epsil(ibnd)*planck(Tf(ibnd))
  96 |             ibnd = ibnd + 1
  97 | 
  98 |           ENDDO
  99 | 
 100 | !         ------------------------------!
 101 | !         Intensities inside the domain !
 102 | !         ------------------------------!
 103 |       
 104 |           DO ielt=1,ncells
 105 |          
 106 |             Lb(ielt)=planck(celldata(1,ielt))
 107 |             all_k_abs(:,ielt) = kabsorpt
 108 | 
 109 |           ENDDO
 110 | 
 111 |         END IF
 112 | 
 113 | !       print*, " (",pmm_rank,") Gray case done!"
 114 | 
 115 |       END SUBROUTINE gray_case